diff --git a/src/c/Makefile.in b/src/c/Makefile.in index a3f68f801..f5c2dd0ed 100644 --- a/src/c/Makefile.in +++ b/src/c/Makefile.in @@ -54,6 +54,8 @@ OBJS = main.o symbol.o package.o list.o\ numbers/exp.o numbers/expt.o numbers/log.o \ numbers/sqrt.o numbers/abs.o \ numbers/zerop.o numbers/plusp.o numbers/minusp.o \ + numbers/negate.o numbers/conjugate.o \ + numbers/one_plus.o numbers/one_minus.o \ typespec.o assignment.o \ predicate.o number.o\ num_pred.o num_comp.o num_arith.o num_co.o\ diff --git a/src/c/num_arith.d b/src/c/num_arith.d index d171d2565..fdd0e6f74 100644 --- a/src/c/num_arith.d +++ b/src/c/num_arith.d @@ -525,65 +525,6 @@ ecl_minus(cl_object x, cl_object y) } } -cl_object -cl_conjugate(cl_object c) -{ - switch (type_of(c)) { - case t_complex: - c = ecl_make_complex(c->complex.real, - ecl_negate(c->complex.imag)); - case t_fixnum: - case t_bignum: - case t_ratio: - case t_singlefloat: - case t_doublefloat: -#ifdef ECL_LONG_FLOAT - case t_longfloat: -#endif - break; - default: - FEwrong_type_only_arg(@[conjugate], c, @[number]); - } - @(return c) -} - -cl_object -ecl_negate(cl_object x) -{ - cl_object z, z1; - - switch (type_of(x)) { - case t_fixnum: - return ecl_make_integer(-fix(x)); - case t_bignum: - return _ecl_big_negate(x); - case t_ratio: - z1 = ecl_negate(x->ratio.num); - z = ecl_alloc_object(t_ratio); - z->ratio.num = z1; - z->ratio.den = x->ratio.den; - return z; - case t_singlefloat: - z = ecl_alloc_object(t_singlefloat); - sf(z) = -sf(x); - return z; - case t_doublefloat: - z = ecl_alloc_object(t_doublefloat); - df(z) = -df(x); - return z; -#ifdef ECL_LONG_FLOAT - case t_longfloat: - return ecl_make_longfloat(-ecl_long_float(x)); -#endif - case t_complex: - z = ecl_negate(x->complex.real); - z1 = ecl_negate(x->complex.imag); - return ecl_make_complex(z, z1); - default: - FEwrong_type_only_arg(@[-], x, @[number]); - } -} - /* (/ ) */ @(defun / (num &rest nums) @ @@ -816,107 +757,6 @@ ecl_gcd(cl_object x, cl_object y) return _ecl_big_gcd(x, y); } -/* (1+ x) */ -cl_object -@1+(cl_object x) -{ - /* INV: type check is in ecl_one_plus() */ - @(return ecl_one_plus(x)) -} - - -cl_object -ecl_one_plus(cl_object x) -{ - cl_object z; - - switch (type_of(x)) { - - case t_fixnum: - if (x == MAKE_FIXNUM(MOST_POSITIVE_FIXNUM)) - return ecl_make_integer(MOST_POSITIVE_FIXNUM+1); - return (cl_object)((cl_fixnum)x + ((cl_fixnum)MAKE_FIXNUM(1) - FIXNUM_TAG)); - case t_bignum: - return(ecl_plus(x, MAKE_FIXNUM(1))); - - case t_ratio: - z = ecl_plus(x->ratio.num, x->ratio.den); - return ecl_make_ratio(z, x->ratio.den); - - case t_singlefloat: - z = ecl_alloc_object(t_singlefloat); - sf(z) = sf(x) + 1.0; - return(z); - - case t_doublefloat: - z = ecl_alloc_object(t_doublefloat); - df(z) = df(x) + 1.0; - return(z); - -#ifdef ECL_LONG_FLOAT - case t_longfloat: - return ecl_make_longfloat(1.0 + ecl_long_float(x)); -#endif - - case t_complex: - z = ecl_one_plus(x->complex.real); - return ecl_make_complex(z, x->complex.imag); - - default: - FEwrong_type_only_arg(@[1+], x, @[number]); - } -} - -/* (1- x) */ -cl_object -@1-(cl_object x) -{ /* INV: type check is in ecl_one_minus() */ - @(return ecl_one_minus(x)) -} - -cl_object -ecl_one_minus(cl_object x) -{ - cl_object z; - - switch (type_of(x)) { - - case t_fixnum: - if (x == MAKE_FIXNUM(MOST_NEGATIVE_FIXNUM)) - return ecl_make_integer(MOST_NEGATIVE_FIXNUM-1); - return (cl_object)((cl_fixnum)x - ((cl_fixnum)MAKE_FIXNUM(1) - FIXNUM_TAG)); - - case t_bignum: - return ecl_minus(x, MAKE_FIXNUM(1)); - - case t_ratio: - z = ecl_minus(x->ratio.num, x->ratio.den); - return ecl_make_ratio(z, x->ratio.den); - - case t_singlefloat: - z = ecl_alloc_object(t_singlefloat); - sf(z) = sf(x) - 1.0; - return(z); - - case t_doublefloat: - z = ecl_alloc_object(t_doublefloat); - df(z) = df(x) - 1.0; - return(z); - -#ifdef ECL_LONG_FLOAT - case t_longfloat: - return ecl_make_longfloat(ecl_long_float(x) - 1.0); -#endif - - case t_complex: - z = ecl_one_minus(x->complex.real); - return ecl_make_complex(z, x->complex.imag); - - default: - FEwrong_type_only_arg(@[1-], x, @[number]); - } -} - @(defun lcm (&rest nums) cl_object lcm; @ diff --git a/src/c/numbers/abs.d b/src/c/numbers/abs.d index 454142000..3f861588e 100644 --- a/src/c/numbers/abs.d +++ b/src/c/numbers/abs.d @@ -93,7 +93,7 @@ ecl_abs_complex(cl_object x) } } -MATH_DEF_DISPATCH1(abs, @[abs], @[number], - ecl_abs_fixnum, ecl_abs_bignum, ecl_abs_rational, - ecl_abs_single_float, ecl_abs_double_float, ecl_abs_long_float, - ecl_abs_complex); +MATH_DEF_DISPATCH1_NE(abs, @[abs], @[number], + ecl_abs_fixnum, ecl_abs_bignum, ecl_abs_rational, + ecl_abs_single_float, ecl_abs_double_float, ecl_abs_long_float, + ecl_abs_complex); diff --git a/src/c/numbers/conjugate.d b/src/c/numbers/conjugate.d new file mode 100644 index 000000000..bb184fc8c --- /dev/null +++ b/src/c/numbers/conjugate.d @@ -0,0 +1,43 @@ +/* -*- mode: c; c-basic-offset: 8 -*- */ +/* + conjugate.d -- Trascendental functions: conjugateine +*/ +/* + Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya. + Copyright (c) 1990, Giuseppe Attardi. + Copyright (c) 2001, Juan Jose Garcia Ripoll. + + ECL is free software; you can redistribute it and/or + modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + See file '../Copyright' for full details. +*/ + +#include +#include + +cl_object +cl_conjugate(cl_object x) +{ + @(return ecl_conjugate(x)); +} + +static cl_object +ecl_conjugate_real(cl_object x) +{ + return x; +} + +static cl_object +ecl_conjugate_complex(cl_object x) +{ + return ecl_make_complex(x->complex.real, ecl_negate(x->complex.imag)); +} + +MATH_DEF_DISPATCH1_NE(conjugate, @[conjugate], @[number], + ecl_conjugate_real, ecl_conjugate_real, ecl_conjugate_real, + ecl_conjugate_real, ecl_conjugate_real, + ecl_conjugate_real, + ecl_conjugate_complex); diff --git a/src/c/numbers/negate.d b/src/c/numbers/negate.d new file mode 100644 index 000000000..9c9a12ca8 --- /dev/null +++ b/src/c/numbers/negate.d @@ -0,0 +1,70 @@ +/* -*- mode: c; c-basic-offset: 8 -*- */ +/* + negate.d -- Trascendental functions: negateine +*/ +/* + Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya. + Copyright (c) 1990, Giuseppe Attardi. + Copyright (c) 2001, Juan Jose Garcia Ripoll. + + ECL is free software; you can redistribute it and/or + modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + See file '../Copyright' for full details. +*/ + +#include +#include + +static cl_object +ecl_negate_fix(cl_object x) +{ + return ecl_make_integer(-fix(x)); +} + +static cl_object +ecl_negate_big(cl_object x) +{ + return _ecl_big_negate(x); +} + +static cl_object +ecl_negate_ratio(cl_object x) +{ + return ecl_make_ratio(ecl_negate(x->ratio.num), x->ratio.den); +} + +static cl_object +ecl_negate_single_float(cl_object x) +{ + return ecl_make_singlefloat(-sf(x)); +} + +static cl_object +ecl_negate_double_float(cl_object x) +{ + return ecl_make_doublefloat(-df(x)); +} + +#ifdef ECL_LONG_FLOAT +static cl_object +ecl_negate_long_float(cl_object x) +{ + return ecl_make_longfloat(-ecl_long_float(x)); +} +#endif + +static cl_object +ecl_negate_complex(cl_object x) +{ + return ecl_make_complex(ecl_negate(x->complex.real), + ecl_negate(x->complex.imag)); +} + +MATH_DEF_DISPATCH1_NE(negate, @[-], @[number], + ecl_negate_fix, ecl_negate_big, ecl_negate_ratio, + ecl_negate_single_float, ecl_negate_double_float, + ecl_negate_long_float, + ecl_negate_complex); diff --git a/src/c/numbers/one_minus.d b/src/c/numbers/one_minus.d new file mode 100644 index 000000000..70c51ccd3 --- /dev/null +++ b/src/c/numbers/one_minus.d @@ -0,0 +1,80 @@ +/* -*- mode: c; c-basic-offset: 8 -*- */ +/* + one_minus.d -- Implementation of CL:1- +*/ +/* + Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya. + Copyright (c) 1990, Giuseppe Attardi. + Copyright (c) 2001, Juan Jose Garcia Ripoll. + + ECL is free software; you can redistribute it and/or + modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + See file '../Copyright' for full details. +*/ + +#include +#include + +static cl_object +ecl_one_minus_fix(cl_object x) +{ + if (x == MAKE_FIXNUM(MOST_NEGATIVE_FIXNUM)) + return ecl_make_integer(MOST_NEGATIVE_FIXNUM-1); + return (cl_object)((cl_fixnum)x - ((cl_fixnum)MAKE_FIXNUM(1) - FIXNUM_TAG)); +} + +static cl_object +ecl_one_minus_big(cl_object x) +{ + return ecl_minus(x, MAKE_FIXNUM(1)); +} + +static cl_object +ecl_one_minus_ratio(cl_object x) +{ + return ecl_make_ratio(ecl_minus(x->ratio.num,x->ratio.den), x->ratio.den); +} + +static cl_object +ecl_one_minus_single_float(cl_object x) +{ + return ecl_make_singlefloat(ecl_single_float(x) - 1); +} + +static cl_object +ecl_one_minus_double_float(cl_object x) +{ + return ecl_make_doublefloat(ecl_double_float(x) - 1); +} + +#ifdef ECL_LONG_FLOAT +static cl_object +ecl_one_minus_long_float(cl_object x) +{ + return ecl_make_longfloat(ecl_long_float(x) - 1); +} +#endif + +static cl_object +ecl_one_minus_complex(cl_object x) +{ + return ecl_make_complex(ecl_one_minus(x->complex.real), + x->complex.imag); +} + +MATH_DEF_DISPATCH1_NE(one_minus, @[1-], @[number], + ecl_one_minus_fix, ecl_one_minus_big, ecl_one_minus_ratio, + ecl_one_minus_single_float, ecl_one_minus_double_float, + ecl_one_minus_long_float, + ecl_one_minus_complex); + +/* (1- x) */ +cl_object +@1-(cl_object x) +{ /* INV: type check is in ecl_one_minus() */ + @(return ecl_one_minus(x)) +} + diff --git a/src/c/numbers/one_plus.d b/src/c/numbers/one_plus.d new file mode 100644 index 000000000..7306371a7 --- /dev/null +++ b/src/c/numbers/one_plus.d @@ -0,0 +1,80 @@ +/* -*- mode: c; c-basic-offset: 8 -*- */ +/* + one_plus.d -- Implementation of CL:1+ +*/ +/* + Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya. + Copyright (c) 1990, Giuseppe Attardi. + Copyright (c) 2001, Juan Jose Garcia Ripoll. + + ECL is free software; you can redistribute it and/or + modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + See file '../Copyright' for full details. +*/ + +#include +#include + +static cl_object +ecl_one_plus_fix(cl_object x) +{ + if (x == MAKE_FIXNUM(MOST_POSITIVE_FIXNUM)) + return ecl_make_integer(MOST_POSITIVE_FIXNUM+1); + return (cl_object)((cl_fixnum)x + ((cl_fixnum)MAKE_FIXNUM(1) - FIXNUM_TAG)); +} + +static cl_object +ecl_one_plus_big(cl_object x) +{ + return ecl_plus(x, MAKE_FIXNUM(1)); +} + +static cl_object +ecl_one_plus_ratio(cl_object x) +{ + return ecl_make_ratio(ecl_plus(x->ratio.num,x->ratio.den), x->ratio.den); +} + +static cl_object +ecl_one_plus_single_float(cl_object x) +{ + return ecl_make_singlefloat(ecl_single_float(x) + 1); +} + +static cl_object +ecl_one_plus_double_float(cl_object x) +{ + return ecl_make_doublefloat(ecl_double_float(x) + 1); +} + +#ifdef ECL_LONG_FLOAT +static cl_object +ecl_one_plus_long_float(cl_object x) +{ + return ecl_make_longfloat(ecl_long_float(x) + 1); +} +#endif + +static cl_object +ecl_one_plus_complex(cl_object x) +{ + return ecl_make_complex(ecl_one_plus(x->complex.real), + x->complex.imag); +} + +MATH_DEF_DISPATCH1_NE(one_plus, @[1+], @[number], + ecl_one_plus_fix, ecl_one_plus_big, ecl_one_plus_ratio, + ecl_one_plus_single_float, ecl_one_plus_double_float, + ecl_one_plus_long_float, + ecl_one_plus_complex); + +/* (1+ x) */ +cl_object +@1+(cl_object x) +{ + /* INV: type check is in ecl_one_plus() */ + @(return ecl_one_plus(x)) +} diff --git a/src/h/external.h b/src/h/external.h index f24897cf8..f4bf2132f 100755 --- a/src/h/external.h +++ b/src/h/external.h @@ -1016,6 +1016,7 @@ extern ECL_API cl_object ecl_integer_divide(cl_object x, cl_object y); extern ECL_API cl_object ecl_gcd(cl_object x, cl_object y); extern ECL_API cl_object ecl_one_plus(cl_object x); extern ECL_API cl_object ecl_one_minus(cl_object x); +extern ECL_API cl_object ecl_conjugate(cl_object x); /* number.c */