From 800ba8e319fff33f5a60f94ff19e578f384be1c8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sat, 6 Apr 2019 11:32:58 +0200 Subject: [PATCH] complex float: implement unary math operators - still missing: trig/hyper arcus variants - unary < <= = >= = min max --- src/c/num_co.d | 34 ++++++ src/c/numbers/abs.d | 28 ++++- src/c/numbers/conjugate.d | 28 ++++- src/c/numbers/cos.d | 28 ++++- src/c/numbers/cosh.d | 28 ++++- src/c/numbers/exp.d | 28 ++++- src/c/numbers/log.d | 218 +++++++++++++++++++++++++++----------- src/c/numbers/negate.d | 22 +++- src/c/numbers/one_minus.d | 22 +++- src/c/numbers/one_plus.d | 22 +++- src/c/numbers/plusp.d | 2 +- src/c/numbers/sin.d | 28 ++++- src/c/numbers/sinh.d | 28 ++++- src/c/numbers/sqrt.d | 28 ++++- src/c/numbers/tan.d | 28 ++++- src/c/numbers/tanh.d | 28 ++++- src/c/numbers/zerop.d | 23 +++- 17 files changed, 548 insertions(+), 75 deletions(-) diff --git a/src/c/num_co.d b/src/c/num_co.d index 75c9bed33..ea8fb8ba5 100644 --- a/src/c/num_co.d +++ b/src/c/num_co.d @@ -436,6 +436,23 @@ cl_realpart(cl_object x) case t_complex: x = x->gencomplex.real; break; +#ifdef ECL_COMPLEX_FLOAT + case t_csfloat: { + float f = crealf(ecl_csfloat(x)); + x = ecl_make_single_float(f); + break; + } + case t_cdfloat: { + double f = creal(ecl_cdfloat(x)); + x = ecl_make_double_float(f); + break; + } + case t_clfloat: { + long double f = creall(ecl_clfloat(x)); + x = ecl_make_long_float(f); + break; + } +#endif default: FEwrong_type_only_arg(@[realpart],x,@[number]); } @@ -474,6 +491,23 @@ cl_imagpart(cl_object x) case t_complex: x = x->gencomplex.imag; break; +#ifdef ECL_COMPLEX_FLOAT + case t_csfloat: { + float f = cimagf(ecl_csfloat(x)); + x = ecl_make_single_float(f); + break; + } + case t_cdfloat: { + double f = cimag(ecl_cdfloat(x)); + x = ecl_make_double_float(f); + break; + } + case t_clfloat: { + long double f = cimagl(ecl_clfloat(x)); + x = ecl_make_long_float(f); + break; + } +#endif default: FEwrong_type_only_arg(@[imagpart],x,@[number]); } diff --git a/src/c/numbers/abs.d b/src/c/numbers/abs.d index 41bc188d2..1c49739ae 100644 --- a/src/c/numbers/abs.d +++ b/src/c/numbers/abs.d @@ -99,8 +99,34 @@ ecl_abs_complex(cl_object x) } } +#ifdef ECL_COMPLEX_FLOAT +static cl_object +ecl_abs_csfloat(cl_object x) +{ + float f = crealf(cabsf(ecl_csfloat(x))); + x = ecl_make_single_float(f); + return x; +} + +static cl_object +ecl_abs_cdfloat(cl_object x) +{ + double f = creal(cabs(ecl_cdfloat(x))); + x = ecl_make_double_float(f); + return x; +} + +static cl_object +ecl_abs_clfloat(cl_object x) +{ + long double f = creall(cabsl(ecl_clfloat(x))); + x = ecl_make_long_float(f); + return x; +} +#endif + 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, - /* implementme */ absfailed, absfailed, absfailed); + ecl_abs_csfloat, ecl_abs_cdfloat, ecl_abs_clfloat); diff --git a/src/c/numbers/conjugate.d b/src/c/numbers/conjugate.d index 9fe3da30d..5e1a72a0a 100644 --- a/src/c/numbers/conjugate.d +++ b/src/c/numbers/conjugate.d @@ -33,9 +33,35 @@ ecl_conjugate_complex(cl_object x) return ecl_make_complex(x->gencomplex.real, ecl_negate(x->gencomplex.imag)); } +#ifdef ECL_COMPLEX_FLOAT +static cl_object +ecl_conjugate_csfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_csfloat); + ecl_csfloat(result) = conjf(ecl_csfloat(x)); + return result; +} + +static cl_object +ecl_conjugate_cdfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_cdfloat); + ecl_cdfloat(result) = conj(ecl_cdfloat(x)); + return result; +} + +static cl_object +ecl_conjugate_clfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_clfloat); + ecl_clfloat(result) = conjl(ecl_clfloat(x)); + return result; +} +#endif + 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, - /* implementme */ conjugatefailed, conjugatefailed, conjugatefailed); + ecl_conjugate_csfloat, ecl_conjugate_cdfloat, ecl_conjugate_clfloat); diff --git a/src/c/numbers/cos.d b/src/c/numbers/cos.d index 25e1687b1..39942489c 100644 --- a/src/c/numbers/cos.d +++ b/src/c/numbers/cos.d @@ -64,8 +64,34 @@ ecl_cos_complex(cl_object x) return ecl_make_complex(a, b); } +#ifdef ECL_COMPLEX_FLOAT +static cl_object +ecl_cos_csfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_csfloat); + ecl_csfloat(result) = ccosf(ecl_csfloat(x)); + return result; +} + +static cl_object +ecl_cos_cdfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_cdfloat); + ecl_cdfloat(result) = ccos(ecl_cdfloat(x)); + return result; +} + +static cl_object +ecl_cos_clfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_clfloat); + ecl_clfloat(result) = ccosl(ecl_clfloat(x)); + return result; +} +#endif + MATH_DEF_DISPATCH1(cos, @[cos], @[number], ecl_cos_rational, ecl_cos_rational, ecl_cos_rational, ecl_cos_single_float, ecl_cos_double_float, ecl_cos_long_float, ecl_cos_complex, - /* implementme */ cos_nefailed, cos_nefailed, cos_nefailed); + ecl_cos_csfloat, ecl_cos_cdfloat, ecl_cos_clfloat); diff --git a/src/c/numbers/cosh.d b/src/c/numbers/cosh.d index 7ebe66f61..3c8ed64ba 100644 --- a/src/c/numbers/cosh.d +++ b/src/c/numbers/cosh.d @@ -67,8 +67,34 @@ ecl_cosh_complex(cl_object x) return ecl_make_complex(a, b); } +#ifdef ECL_COMPLEX_FLOAT +static cl_object +ecl_cosh_csfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_csfloat); + ecl_csfloat(result) = ccoshf(ecl_csfloat(x)); + return result; +} + +static cl_object +ecl_cosh_cdfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_cdfloat); + ecl_cdfloat(result) = ccosh(ecl_cdfloat(x)); + return result; +} + +static cl_object +ecl_cosh_clfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_clfloat); + ecl_clfloat(result) = ccoshl(ecl_clfloat(x)); + return result; +} +#endif + MATH_DEF_DISPATCH1(cosh, @[cosh], @[number], ecl_cosh_rational, ecl_cosh_rational, ecl_cosh_rational, ecl_cosh_single_float, ecl_cosh_double_float, ecl_cosh_long_float, ecl_cosh_complex, - /* implementme */ cosh_nefailed, cosh_nefailed, cosh_nefailed); + ecl_cosh_csfloat, ecl_cosh_cdfloat, ecl_cosh_clfloat); diff --git a/src/c/numbers/exp.d b/src/c/numbers/exp.d index 779d3de0d..03ab5fba5 100644 --- a/src/c/numbers/exp.d +++ b/src/c/numbers/exp.d @@ -63,8 +63,34 @@ ecl_exp_complex(cl_object x) return ecl_times(x, y); } +#ifdef ECL_COMPLEX_FLOAT +static cl_object +ecl_exp_csfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_csfloat); + ecl_csfloat(result) = cexpf(ecl_csfloat(x)); + return result; +} + +static cl_object +ecl_exp_cdfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_cdfloat); + ecl_cdfloat(result) = cexp(ecl_cdfloat(x)); + return result; +} + +static cl_object +ecl_exp_clfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_clfloat); + ecl_clfloat(result) = cexpl(ecl_clfloat(x)); + return result; +} +#endif + MATH_DEF_DISPATCH1(exp, @[exp], @[number], ecl_exp_rational, ecl_exp_rational, ecl_exp_rational, ecl_exp_single_float, ecl_exp_double_float, ecl_exp_long_float, ecl_exp_complex, - /* implementme */ exp_nefailed, exp_nefailed, exp_nefailed); + ecl_exp_csfloat, ecl_exp_cdfloat, ecl_exp_clfloat); diff --git a/src/c/numbers/log.d b/src/c/numbers/log.d index 5ac48ce1a..3b39b84cc 100644 --- a/src/c/numbers/log.d +++ b/src/c/numbers/log.d @@ -16,10 +16,12 @@ #define ECL_INCLUDE_MATH_H #include #include +#include #include #pragma STDC FENV_ACCESS ON +#ifndef ECL_COMPLEX_FLOAT static cl_object ecl_log1_complex_inner(cl_object r, cl_object i) { @@ -47,12 +49,20 @@ ecl_log1_complex_inner(cl_object r, cl_object i) p = ecl_atan2(i, r); return ecl_make_complex(a, p); } +#endif static cl_object ecl_log1_bignum(cl_object x) { if (ecl_minusp(x)) { +#ifdef ECL_COMPLEX_FLOAT + cl_object result = ecl_alloc_object(t_csfloat); + float _Complex fc = ecl_to_float(x); + ecl_csfloat(result) = clogf(fc); + return result; +#else return ecl_log1_complex_inner(x, ecl_make_fixnum(0)); +#endif } else { cl_fixnum l = ecl_integer_length(x) - 1; cl_object r = ecl_make_ratio(x, ecl_ash(ecl_make_fixnum(1), l)); @@ -62,10 +72,19 @@ ecl_log1_bignum(cl_object x) } static cl_object -ecl_log1_rational(cl_object x) +ecl_log1_simple(cl_object x) { float f = ecl_to_float(x); - if (f < 0) return ecl_log1_complex_inner(x, ecl_make_fixnum(0)); + if (f < 0) { +#ifdef ECL_COMPLEX_FLOAT + cl_object result = ecl_alloc_object(t_csfloat); + float _Complex fc = ecl_to_float(x); + ecl_csfloat(result) = clogf(fc); + return result; +#else + return ecl_log1_complex_inner(x, ecl_make_fixnum(0)); +#endif + } return ecl_make_single_float(logf(ecl_to_float(x))); } @@ -74,7 +93,16 @@ ecl_log1_single_float(cl_object x) { float f = ecl_single_float(x); if (isnan(f)) return x; - if (f < 0) return ecl_log1_complex_inner(x, ecl_make_fixnum(0)); + if (f < 0) { +#ifdef ECL_COMPLEX_FLOAT + cl_object result = ecl_alloc_object(t_csfloat); + float _Complex fc = f; + ecl_csfloat(result) = clogf(fc); + return result; +#else + return ecl_log1_complex_inner(x, ecl_make_fixnum(0)); +#endif + } return ecl_make_single_float(logf(f)); } @@ -83,7 +111,16 @@ ecl_log1_double_float(cl_object x) { double f = ecl_double_float(x); if (isnan(f)) return x; - if (f < 0) return ecl_log1_complex_inner(x, ecl_make_fixnum(0)); + if (f < 0) { +#ifdef ECL_COMPLEX_FLOAT + cl_object result = ecl_alloc_object(t_cdfloat); + double _Complex fc = f; + ecl_cdfloat(result) = clog(fc); + return result; +#else + return ecl_log1_complex_inner(x, ecl_make_fixnum(0)); +#endif + } return ecl_make_double_float(log(f)); } @@ -93,7 +130,16 @@ ecl_log1_long_float(cl_object x) { long double f = ecl_long_float(x); if (isnan(f)) return x; - if (f < 0) return ecl_log1_complex_inner(x, ecl_make_fixnum(0)); + if (f < 0) { +#ifdef ECL_COMPLEX_FLOAT + cl_object result = ecl_alloc_object(t_clfloat); + long double _Complex fc = f; + ecl_clfloat(result) = clogl(fc); + return result; +#else + return ecl_log1_complex_inner(x, ecl_make_fixnum(0)); +#endif + } return ecl_make_long_float(logl(f)); } #endif @@ -101,14 +147,47 @@ ecl_log1_long_float(cl_object x) static cl_object ecl_log1_complex(cl_object x) { +#ifdef ECL_COMPLEX_FLOAT + cl_object result = ecl_alloc_object(t_csfloat); + float _Complex fc = ecl_to_float(x->gencomplex.real) + I * ecl_to_float(x->gencomplex.real); + ecl_csfloat(result) = clogf(fc); + return result; +#else return ecl_log1_complex_inner(x->gencomplex.real, x->gencomplex.imag); +#endif } +#ifdef ECL_COMPLEX_FLOAT +static cl_object +ecl_log1_csfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_csfloat); + ecl_csfloat(result) = clogf(ecl_csfloat(x)); + return result; +} + +static cl_object +ecl_log1_cdfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_cdfloat); + ecl_cdfloat(result) = clog(ecl_cdfloat(x)); + return result; +} + +static cl_object +ecl_log1_clfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_clfloat); + ecl_clfloat(result) = clogl(ecl_clfloat(x)); + return result; +} +#endif + MATH_DEF_DISPATCH1(log1, @[log], @[number], - ecl_log1_rational, ecl_log1_bignum, ecl_log1_rational, + ecl_log1_simple, ecl_log1_bignum, ecl_log1_simple, ecl_log1_single_float, ecl_log1_double_float, ecl_log1_long_float, ecl_log1_complex, - /* implementme */ log1_nefailed, log1_nefailed, log1_nefailed); + ecl_log1_csfloat, ecl_log1_cdfloat, ecl_log1_clfloat); cl_object ecl_log2(cl_object x, cl_object y) @@ -124,46 +203,6 @@ ecl_log2(cl_object x, cl_object y) @(return ecl_log2(y, x)) @) - -#ifndef HAVE_LOG1P -double -log1p(double x) -{ - double u = 1.0 + x; - if (u == 1) { - return 0.0; - } else { - return (log(u) * x)/(u - 1.0); - } -} -#endif - -#ifndef HAVE_LOG1PF -float -log1pf(float x) -{ - float u = (float)1 + x; - if (u == 1) { - return (float)0; - } else { - return (logf(u) * x)/(u - (float)1); - } -} -#endif - -#if !defined(HAVE_LOG1PL) && defined(ECL_LONG_FLOAT) -long double -log1pl(long double x) -{ - long double u = (long double)1 + x; - if (u == 1) { - return (long double)1; - } else { - return (logl(u) * x)/(u - (long double)1); - } -} -#endif - cl_object si_log1p(cl_object x) { @@ -172,15 +211,17 @@ si_log1p(cl_object x) static cl_object ecl_log1p_simple(cl_object x) -{ - return ecl_log1_complex_inner(ecl_one_plus(x), ecl_make_fixnum(0)); -} - -static cl_object -ecl_log1p_rational(cl_object x) { float f = ecl_to_float(x); - if (f < -1) return ecl_log1p_simple(x); + if (f < -1) { +#ifdef ECL_COMPLEX_FLOAT + cl_object result = ecl_alloc_object(t_csfloat); + ecl_csfloat(result) = clogf(1.0+f); + return result; +#else + return ecl_log1_complex_inner(ecl_one_plus(x), ecl_make_fixnum(0)); +#endif + } return ecl_make_single_float(log1pf(ecl_to_float(x))); } @@ -189,7 +230,15 @@ ecl_log1p_single_float(cl_object x) { float f = ecl_single_float(x); if (isnan(f)) return x; - if (f < -1) return ecl_log1p_simple(x); + if (f < -1) { +#ifdef ECL_COMPLEX_FLOAT + cl_object result = ecl_alloc_object(t_csfloat); + ecl_csfloat(result) = clogf(1+f); + return result; +#else + return ecl_log1_complex_inner(ecl_one_plus(x), ecl_make_fixnum(0)); +#endif + } return ecl_make_single_float(log1pf(f)); } @@ -198,7 +247,15 @@ ecl_log1p_double_float(cl_object x) { double f = ecl_double_float(x); if (isnan(f)) return x; - if (f < -1) return ecl_log1p_simple(x); + if (f < -1) { +#ifdef ECL_COMPLEX_FLOAT + cl_object result = ecl_alloc_object(t_cdfloat); + ecl_cdfloat(result) = clog(1+f); + return result; +#else + return ecl_log1_complex_inner(ecl_one_plus(x), ecl_make_fixnum(0)); +#endif + } return ecl_make_double_float(log1p(f)); } @@ -208,7 +265,15 @@ ecl_log1p_long_float(cl_object x) { long double f = ecl_long_float(x); if (isnan(f)) return x; - if (f < -1) return ecl_log1p_simple(x); + if (f < -1) { +#ifdef ECL_COMPLEX_FLOAT + cl_object result = ecl_alloc_object(t_clfloat); + ecl_clfloat(result) = clogl(1+f); + return result; +#else + return ecl_log1_complex_inner(ecl_one_plus(x), ecl_make_fixnum(0)); +#endif + } return ecl_make_long_float(log1pl(f)); } #endif @@ -216,11 +281,44 @@ ecl_log1p_long_float(cl_object x) static cl_object ecl_log1p_complex(cl_object x) { - return ecl_log1_complex_inner(ecl_one_plus(x->gencomplex.real), x->gencomplex.imag); +#ifdef ECL_COMPLEX_FLOAT + cl_object result = ecl_alloc_object(t_csfloat); + float _Complex fc = ecl_to_float(x->gencomplex.real) + I * ecl_to_float(x->gencomplex.real); + ecl_csfloat(result) = clogf(1+fc); + return result; +#else + return ecl_log1_complex_inner(ecl_one_plus(x), ecl_make_fixnum(0)); +#endif } +#ifdef ECL_COMPLEX_FLOAT +static cl_object +ecl_log1p_csfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_csfloat); + ecl_csfloat(result) = clogf(1+ecl_csfloat(x)); + return result; +} + +static cl_object +ecl_log1p_cdfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_cdfloat); + ecl_cdfloat(result) = clog(1+ecl_cdfloat(x)); + return result; +} + +static cl_object +ecl_log1p_clfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_clfloat); + ecl_clfloat(result) = clogl(1+ecl_clfloat(x)); + return result; +} +#endif + MATH_DEF_DISPATCH1(log1p, @[si::log1p], @[number], - ecl_log1p_rational, ecl_log1p_simple, ecl_log1p_rational, + ecl_log1p_simple, ecl_log1p_simple, ecl_log1p_simple, ecl_log1p_single_float, ecl_log1p_double_float, ecl_log1p_long_float, ecl_log1p_complex, - /* implementme */ log1p_nefailed, log1p_nefailed, log1p_nefailed); + ecl_log1p_csfloat, ecl_log1p_cdfloat, ecl_log1p_clfloat); diff --git a/src/c/numbers/negate.d b/src/c/numbers/negate.d index 001bc9a2c..c1b990e81 100644 --- a/src/c/numbers/negate.d +++ b/src/c/numbers/negate.d @@ -60,9 +60,29 @@ ecl_negate_complex(cl_object x) ecl_negate(x->gencomplex.imag)); } +#ifdef ECL_COMPLEX_FLOAT +static cl_object +ecl_negate_csfloat(cl_object x) +{ + return ecl_make_csfloat(-ecl_csfloat(x)); +} + +static cl_object +ecl_negate_cdfloat(cl_object x) +{ + return ecl_make_cdfloat(-ecl_cdfloat(x)); +} + +static cl_object +ecl_negate_clfloat(cl_object x) +{ + return ecl_make_clfloat(-ecl_clfloat(x)); +} +#endif + 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, - /* implementme */ negatefailed, negatefailed, negatefailed); + ecl_negate_csfloat, ecl_negate_cdfloat, ecl_negate_clfloat); diff --git a/src/c/numbers/one_minus.d b/src/c/numbers/one_minus.d index bccc2d668..e49c0846f 100644 --- a/src/c/numbers/one_minus.d +++ b/src/c/numbers/one_minus.d @@ -63,12 +63,32 @@ ecl_one_minus_complex(cl_object x) x->gencomplex.imag); } +#ifdef ECL_COMPLEX_FLOAT +static cl_object +ecl_one_minus_csfloat(cl_object x) +{ + return ecl_make_csfloat(ecl_csfloat(x) - 1); +} + +static cl_object +ecl_one_minus_cdfloat(cl_object x) +{ + return ecl_make_cdfloat(ecl_cdfloat(x) - 1); +} + +static cl_object +ecl_one_minus_clfloat(cl_object x) +{ + return ecl_make_clfloat(ecl_clfloat(x) - 1); +} +#endif + 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, - /* implementme */ one_minusfailed, one_minusfailed, one_minusfailed); + ecl_one_minus_csfloat, ecl_one_minus_cdfloat, ecl_one_minus_clfloat); /* (1- x) */ cl_object diff --git a/src/c/numbers/one_plus.d b/src/c/numbers/one_plus.d index d8d87e3a4..db5630354 100644 --- a/src/c/numbers/one_plus.d +++ b/src/c/numbers/one_plus.d @@ -63,12 +63,32 @@ ecl_one_plus_complex(cl_object x) x->gencomplex.imag); } +#ifdef ECL_COMPLEX_FLOAT +static cl_object +ecl_one_plus_csfloat(cl_object x) +{ + return ecl_make_csfloat(ecl_csfloat(x) + 1); +} + +static cl_object +ecl_one_plus_cdfloat(cl_object x) +{ + return ecl_make_cdfloat(ecl_cdfloat(x) + 1); +} + +static cl_object +ecl_one_plus_clfloat(cl_object x) +{ + return ecl_make_clfloat(ecl_clfloat(x) + 1); +} +#endif + 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, - /* implementme */ one_plusfailed, one_plusfailed, one_plusfailed); + ecl_one_plus_csfloat, ecl_one_plus_cdfloat, ecl_one_plus_clfloat); /* (1+ x) */ cl_object diff --git a/src/c/numbers/plusp.d b/src/c/numbers/plusp.d index 80b5ee0c0..a6e287f7f 100644 --- a/src/c/numbers/plusp.d +++ b/src/c/numbers/plusp.d @@ -64,4 +64,4 @@ MATH_DEF_DISPATCH1_BOOL(plusp, @[plusp], @[real], ecl_plusp_single_float, ecl_plusp_double_float, ecl_plusp_long_float, pluspfailed, - /* implementme*/ pluspfailed, pluspfailed, pluspfailed) + pluspfailed, pluspfailed, pluspfailed) diff --git a/src/c/numbers/sin.d b/src/c/numbers/sin.d index 2824b8e8a..c6edd4621 100644 --- a/src/c/numbers/sin.d +++ b/src/c/numbers/sin.d @@ -67,8 +67,34 @@ ecl_sin_complex(cl_object x) return ecl_make_complex(a, b); } +#ifdef ECL_COMPLEX_FLOAT +static cl_object +ecl_sin_csfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_csfloat); + ecl_csfloat(result) = csinf(ecl_csfloat(x)); + return result; +} + +static cl_object +ecl_sin_cdfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_cdfloat); + ecl_cdfloat(result) = csin(ecl_cdfloat(x)); + return result; +} + +static cl_object +ecl_sin_clfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_clfloat); + ecl_clfloat(result) = csinl(ecl_clfloat(x)); + return result; +} +#endif + MATH_DEF_DISPATCH1(sin, @[sin], @[number], ecl_sin_rational, ecl_sin_rational, ecl_sin_rational, ecl_sin_single_float, ecl_sin_double_float, ecl_sin_long_float, ecl_sin_complex, - /* implementme */ sin_nefailed, sin_nefailed, sin_nefailed); + ecl_sin_csfloat, ecl_sin_cdfloat, ecl_sin_clfloat); diff --git a/src/c/numbers/sinh.d b/src/c/numbers/sinh.d index 6735962ac..76d5d8dad 100644 --- a/src/c/numbers/sinh.d +++ b/src/c/numbers/sinh.d @@ -68,8 +68,34 @@ ecl_sinh_complex(cl_object x) return ecl_make_complex(a, b); } +#ifdef ECL_COMPLEX_FLOAT +static cl_object +ecl_sinh_csfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_csfloat); + ecl_csfloat(result) = csinhf(ecl_csfloat(x)); + return result; +} + +static cl_object +ecl_sinh_cdfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_cdfloat); + ecl_cdfloat(result) = csinh(ecl_cdfloat(x)); + return result; +} + +static cl_object +ecl_sinh_clfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_clfloat); + ecl_clfloat(result) = csinhl(ecl_clfloat(x)); + return result; +} +#endif + MATH_DEF_DISPATCH1(sinh, @[sinh], @[number], ecl_sinh_rational, ecl_sinh_rational, ecl_sinh_rational, ecl_sinh_single_float, ecl_sinh_double_float, ecl_sinh_long_float, ecl_sinh_complex, - /* implementme */ sinh_nefailed, sinh_nefailed, sinh_nefailed); + ecl_sinh_csfloat, ecl_sinh_cdfloat, ecl_sinh_clfloat); diff --git a/src/c/numbers/sqrt.d b/src/c/numbers/sqrt.d index da3546c76..fdb72d818 100644 --- a/src/c/numbers/sqrt.d +++ b/src/c/numbers/sqrt.d @@ -81,8 +81,34 @@ ecl_sqrt_complex(cl_object x) return ecl_expt(x, cl_core.plus_half); } +#ifdef ECL_COMPLEX_FLOAT +static cl_object +ecl_sqrt_csfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_csfloat); + ecl_csfloat(result) = csqrtf(ecl_csfloat(x)); + return result; +} + +static cl_object +ecl_sqrt_cdfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_cdfloat); + ecl_cdfloat(result) = csqrt(ecl_cdfloat(x)); + return result; +} + +static cl_object +ecl_sqrt_clfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_clfloat); + ecl_clfloat(result) = csqrtl(ecl_clfloat(x)); + return result; +} +#endif + MATH_DEF_DISPATCH1(sqrt, @[sqrt], @[number], ecl_sqrt_rational, ecl_sqrt_rational, ecl_sqrt_rational, ecl_sqrt_single_float, ecl_sqrt_double_float, ecl_sqrt_long_float, ecl_sqrt_complex, - /* implementme */ sqrt_nefailed, sqrt_nefailed, sqrt_nefailed); + ecl_sqrt_csfloat, ecl_sqrt_cdfloat, ecl_sqrt_clfloat); diff --git a/src/c/numbers/tan.d b/src/c/numbers/tan.d index ec23801ed..dcbd7f449 100644 --- a/src/c/numbers/tan.d +++ b/src/c/numbers/tan.d @@ -74,8 +74,34 @@ ecl_tan_complex(cl_object x) return ecl_divide(a, b); } +#ifdef ECL_COMPLEX_FLOAT +static cl_object +ecl_tan_csfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_csfloat); + ecl_csfloat(result) = ctanf(ecl_csfloat(x)); + return result; +} + +static cl_object +ecl_tan_cdfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_cdfloat); + ecl_cdfloat(result) = ctan(ecl_cdfloat(x)); + return result; +} + +static cl_object +ecl_tan_clfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_clfloat); + ecl_clfloat(result) = ctanl(ecl_clfloat(x)); + return result; +} +#endif + MATH_DEF_DISPATCH1(tan, @[tan], @[number], ecl_tan_rational, ecl_tan_rational, ecl_tan_rational, ecl_tan_single_float, ecl_tan_double_float, ecl_tan_long_float, ecl_tan_complex, - /* implementme */ tan_nefailed, tan_nefailed, tan_nefailed); + ecl_tan_csfloat, ecl_tan_cdfloat, ecl_tan_clfloat); diff --git a/src/c/numbers/tanh.d b/src/c/numbers/tanh.d index abc849e32..80730eed4 100644 --- a/src/c/numbers/tanh.d +++ b/src/c/numbers/tanh.d @@ -60,8 +60,34 @@ ecl_tanh_complex(cl_object x) return ecl_divide(a, b); } +#ifdef ECL_COMPLEX_FLOAT +static cl_object +ecl_tanh_csfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_csfloat); + ecl_csfloat(result) = ctanhf(ecl_csfloat(x)); + return result; +} + +static cl_object +ecl_tanh_cdfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_cdfloat); + ecl_cdfloat(result) = ctanh(ecl_cdfloat(x)); + return result; +} + +static cl_object +ecl_tanh_clfloat(cl_object x) +{ + cl_object result = ecl_alloc_object(t_clfloat); + ecl_clfloat(result) = ctanhl(ecl_clfloat(x)); + return result; +} +#endif + MATH_DEF_DISPATCH1(tanh, @[tanh], @[number], ecl_tanh_rational, ecl_tanh_rational, ecl_tanh_rational, ecl_tanh_single_float, ecl_tanh_double_float, ecl_tanh_long_float, ecl_tanh_complex, - /* implementme */ tanh_nefailed, tanh_nefailed, tanh_nefailed); + ecl_tanh_csfloat, ecl_tanh_cdfloat, ecl_tanh_clfloat); diff --git a/src/c/numbers/zerop.d b/src/c/numbers/zerop.d index 36067615c..695aa7398 100644 --- a/src/c/numbers/zerop.d +++ b/src/c/numbers/zerop.d @@ -59,9 +59,30 @@ ecl_zerop_complex(cl_object x) return ecl_zerop(x->gencomplex.real) && ecl_zerop(x->gencomplex.imag); } +#ifdef ECL_COMPLEX_FLOAT +static int +ecl_zerop_csfloat(cl_object x) +{ + return ecl_csfloat(x) == 0; +} + +static int +ecl_zerop_cdfloat(cl_object x) +{ + return ecl_cdfloat(x) == 0; +} + +static int +ecl_zerop_clfloat(cl_object x) +{ + return ecl_clfloat(x) == 0; +} +#endif + + MATH_DEF_DISPATCH1_BOOL(zerop, @[zerop], @[number], ecl_zerop_fixnum, ecl_zerop_ratio, ecl_zerop_ratio, ecl_zerop_single_float, ecl_zerop_double_float, ecl_zerop_long_float, ecl_zerop_complex, - /* implementme */ zeropfailed, zeropfailed, zeropfailed) + ecl_zerop_csfloat, ecl_zerop_cdfloat, ecl_zerop_clfloat)