mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-15 13:52:16 -08:00
Code Issues Projects Releases Packages Wiki Activity

The dispatch function for maths allows different code for bignums, fixnums and ratios

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2010-11-02 16:50:29 +01:00
parent edb7e7de44
commit 58105da96b
11 changed files with 58 additions and 46 deletions
Download patch file Download diff file Expand all files Collapse all files

20
src/c/numbers/abs.d
View file

@ -15,6 +15,7 @@
See file '../Copyright' for full details.
*/
#include <stdlib.h>
#define ECL_INCLUDE_MATH_H
#include <ecl/ecl.h>
#include <ecl/internal.h>
@ -26,10 +27,23 @@ cl_abs(cl_object x)
@(return ecl_abs(x));
}
static cl_object
ecl_abs_fixnum(cl_object x)
{
return ecl_fixnum_minusp(x)? ecl_make_integer(-fix(x)) : x;
}
static cl_object
ecl_abs_bignum(cl_object x)
{
return (_ecl_big_sign(x) < 0)? _ecl_big_negate(x) : x;
}
static cl_object
ecl_abs_rational(cl_object x)
{
return (ecl_minusp(x))? ecl_negate(x) : x;
return (ecl_minusp(x->ratio.num))?
ecl_make_ratio(ecl_negate(x->ratio.num), x->ratio.den) : x;
}
static cl_object
@ -80,6 +94,6 @@ ecl_abs_complex(cl_object x)
}
MATH_DEF_DISPATCH1(abs, @[abs], @[number],
ecl_abs_rational, ecl_abs_single_float,
ecl_abs_double_float, ecl_abs_long_float,
ecl_abs_fixnum, ecl_abs_bignum, ecl_abs_rational,
ecl_abs_single_float, ecl_abs_double_float, ecl_abs_long_float,
ecl_abs_complex);

4
src/c/numbers/cos.d
View file

@ -68,6 +68,6 @@ ecl_cos_complex(cl_object x)
}
MATH_DEF_DISPATCH1(cos, @[cos], @[number],
ecl_cos_rational, ecl_cos_single_float,
ecl_cos_double_float, ecl_cos_long_float,
ecl_cos_rational, ecl_cos_rational, ecl_cos_rational,
ecl_cos_single_float, ecl_cos_double_float, ecl_cos_long_float,
ecl_cos_complex);

4
src/c/numbers/cosh.d
View file

@ -71,6 +71,6 @@ ecl_cosh_complex(cl_object x)
}
MATH_DEF_DISPATCH1(cosh, @[cosh], @[number],
ecl_cosh_rational, ecl_cosh_single_float,
ecl_cosh_double_float, ecl_cosh_long_float,
ecl_cosh_rational, ecl_cosh_rational, ecl_cosh_rational,
ecl_cosh_single_float, ecl_cosh_double_float, ecl_cosh_long_float,
ecl_cosh_complex);

4
src/c/numbers/exp.d
View file

@ -67,6 +67,6 @@ ecl_exp_complex(cl_object x)
}
MATH_DEF_DISPATCH1(exp, @[exp], @[number],
ecl_exp_rational, ecl_exp_single_float,
ecl_exp_double_float, ecl_exp_long_float,
ecl_exp_rational, ecl_exp_rational, ecl_exp_rational,
ecl_exp_single_float, ecl_exp_double_float, ecl_exp_long_float,
ecl_exp_complex);

48
src/c/numbers/log.d
View file

@ -50,23 +50,25 @@ ecl_log1_complex_inner(cl_object r, cl_object i)
return ecl_make_complex(a, p);
}
static cl_object
ecl_log1_bignum(cl_object x)
{
if (ecl_minusp(x)) {
return ecl_log1_complex_inner(x, MAKE_FIXNUM(0));
} else {
cl_fixnum l = ecl_integer_length(x) - 1;
cl_object r = ecl_make_ratio(x, ecl_ash(MAKE_FIXNUM(1), l));
float d = logf(number_to_float(r)) + l * logf(2.0);
return ecl_make_singlefloat(d);
}
}
static cl_object
ecl_log1_rational(cl_object x)
{
if (type_of(x) == t_bignum) {
if (ecl_minusp(x)) {
return ecl_log1_complex_inner(x, MAKE_FIXNUM(0));
} else {
cl_fixnum l = ecl_integer_length(x) - 1;
cl_object r = ecl_make_ratio(x, ecl_ash(MAKE_FIXNUM(1), l));
float d = logf(number_to_float(r)) + l * logf(2.0);
return ecl_make_singlefloat(d);
}
} else {
float f = number_to_float(x);
if (f < 0) return ecl_log1_complex_inner(x, MAKE_FIXNUM(0));
return ecl_make_singlefloat(logf(number_to_float(x)));
}
float f = number_to_float(x);
if (f < 0) return ecl_log1_complex_inner(x, MAKE_FIXNUM(0));
return ecl_make_singlefloat(logf(number_to_float(x)));
}
static cl_object
@ -105,8 +107,8 @@ ecl_log1_complex(cl_object x)
}
MATH_DEF_DISPATCH1(log1, @[log], @[number],
ecl_log1_rational, ecl_log1_single_float,
ecl_log1_double_float, ecl_log1_long_float,
ecl_log1_rational, ecl_log1_bignum, ecl_log1_rational,
ecl_log1_single_float, ecl_log1_double_float, ecl_log1_long_float,
ecl_log1_complex);
cl_object
@ -177,13 +179,9 @@ ecl_log1p_simple(cl_object x)
static cl_object
ecl_log1p_rational(cl_object x)
{
if (type_of(x) == t_bignum) {
return ecl_log1p_simple(x);
} else {
float f = number_to_float(x);
if (f < -1) return ecl_log1p_simple(x);
return ecl_make_singlefloat(log1pf(number_to_float(x)));
}
float f = number_to_float(x);
if (f < -1) return ecl_log1p_simple(x);
return ecl_make_singlefloat(log1pf(number_to_float(x)));
}
static cl_object
@ -222,6 +220,6 @@ ecl_log1p_complex(cl_object x)
}
MATH_DEF_DISPATCH1(log1p, @[si::log1p], @[number],
ecl_log1p_rational, ecl_log1p_single_float,
ecl_log1p_double_float, ecl_log1p_long_float,
ecl_log1p_rational, ecl_log1p_simple, ecl_log1p_rational,
ecl_log1p_single_float, ecl_log1p_double_float, ecl_log1p_long_float,
ecl_log1p_complex);

4
src/c/numbers/sin.d
View file

@ -70,6 +70,6 @@ ecl_sin_complex(cl_object x)
}
MATH_DEF_DISPATCH1(sin, @[sin], @[number],
ecl_sin_rational, ecl_sin_single_float,
ecl_sin_double_float, ecl_sin_long_float,
ecl_sin_rational, ecl_sin_rational, ecl_sin_rational,
ecl_sin_single_float, ecl_sin_double_float, ecl_sin_long_float,
ecl_sin_complex);

4
src/c/numbers/sinh.d
View file

@ -71,6 +71,6 @@ ecl_sinh_complex(cl_object x)
}
MATH_DEF_DISPATCH1(sinh, @[sinh], @[number],
ecl_sinh_rational, ecl_sinh_single_float,
ecl_sinh_double_float, ecl_sinh_long_float,
ecl_sinh_rational, ecl_sinh_rational, ecl_sinh_rational,
ecl_sinh_single_float, ecl_sinh_double_float, ecl_sinh_long_float,
ecl_sinh_complex);

4
src/c/numbers/sqrt.d
View file

@ -84,6 +84,6 @@ ecl_sqrt_complex(cl_object x)
}
MATH_DEF_DISPATCH1(sqrt, @[sqrt], @[number],
ecl_sqrt_rational, ecl_sqrt_single_float,
ecl_sqrt_double_float, ecl_sqrt_long_float,
ecl_sqrt_rational, ecl_sqrt_rational, ecl_sqrt_rational,
ecl_sqrt_single_float, ecl_sqrt_double_float, ecl_sqrt_long_float,
ecl_sqrt_complex);

4
src/c/numbers/tan.d
View file

@ -75,6 +75,6 @@ ecl_tan_complex(cl_object x)
}
MATH_DEF_DISPATCH1(tan, @[tan], @[number],
ecl_tan_rational, ecl_tan_single_float,
ecl_tan_double_float, ecl_tan_long_float,
ecl_tan_rational, ecl_tan_rational, ecl_tan_rational,
ecl_tan_single_float, ecl_tan_double_float, ecl_tan_long_float,
ecl_tan_complex);

4
src/c/numbers/tanh.d
View file

@ -63,6 +63,6 @@ ecl_tanh_complex(cl_object x)
}
MATH_DEF_DISPATCH1(tanh, @[tanh], @[number],
ecl_tanh_rational, ecl_tanh_single_float,
ecl_tanh_double_float, ecl_tanh_long_float,
ecl_tanh_rational, ecl_tanh_rational, ecl_tanh_rational,
ecl_tanh_single_float, ecl_tanh_double_float, ecl_tanh_long_float,
ecl_tanh_complex);

4
src/h/impl/math_dispatch.h
View file

@ -25,7 +25,7 @@ typedef cl_object (*math_one_arg_fn)(cl_object);
#else
#define MATH_LONG_DOUBLE(opt)
#endif
#define MATH_DEF_DISPATCH1(name,id,type,rational,single_float,double_float,long_float,complex) \
#define MATH_DEF_DISPATCH1(name,id,type,fix,big,ratio,single_float,double_float,long_float,complex) \
static cl_object name##failed(cl_object x) { \
FEwrong_type_only_arg(id, x, type); \
} \
@ -33,7 +33,7 @@ typedef cl_object (*math_one_arg_fn)(cl_object);
name##failed, /* t_start */ \
name##failed, /* t_list */ \
name##failed, /* t_character */ \
rational, rational, rational, /* t_fixnum, bignum, ratio */ \
fix, big, ratio, /* t_fixnum, bignum, ratio */ \
single_float, double_float, /* t_singlefloat, t_doublefloat */ \
MATH_LONG_DOUBLE(long_float) /* t_longfloat, optional */ \
complex }; \