mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-03-14 00:40:47 -07:00
Code Issues Projects Releases Packages Wiki Activity

complex float: implement unary math operators

Browse source 
- still missing: trig/hyper arcus variants
- unary < <= = >= = min max
This commit is contained in:
Daniel Kochmański 2019-04-06 11:32:58 +02:00
parent e1adfd2794
commit 800ba8e319
17 changed files with 548 additions and 75 deletions
Download patch file Download diff file Expand all files Collapse all files

34
src/c/num_co.d
View file

@ -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]);
}

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

@ -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);

28
src/c/numbers/conjugate.d
View file

@ -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);

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

@ -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);

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

@ -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);

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

@ -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);

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

@ -16,10 +16,12 @@
#define ECL_INCLUDE_MATH_H
#include <ecl/ecl.h>
#include <ecl/internal.h>
#include <complex.h>
#include <ecl/impl/math_dispatch.h>
#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);

22
src/c/numbers/negate.d
View file

@ -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);

22
src/c/numbers/one_minus.d
View file

@ -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

22
src/c/numbers/one_plus.d
View file

@ -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

2
src/c/numbers/plusp.d
View file

@ -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)

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

@ -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);

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

@ -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);

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

@ -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);

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

@ -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);

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

@ -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);

23
src/c/numbers/zerop.d
View file

@ -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)