mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-04-19 08:20:36 -07:00
New functions for type errors with error recovery (ecl_type_error, si:wrong-type-argument). Incorporated this facility to all functions in num_sfun.d and num_co.d, as well as to make_complex()
This commit is contained in:
jgarcia
parent
d42cc3de90
commit
ffa984809d
8 changed files with 314 additions and 207 deletions
|
|
@ -139,6 +139,12 @@ ECL 1.0:
|
|||
|
||||
- The debugger now prints a list of available restarts.
|
||||
|
||||
- Added restarts to the errors signaled by these functions: SIN, COS, EXP,
|
||||
EXPT, TAN, TANH, SINH, COSH, LOG, ATAN, RATIONAL, NUMERATOR, DENOMINATOR,
|
||||
FLOOR, CEILING, ROUND, TRUNCATE, FLOAT-PRECISION, FLOAT-SIGN, DECODE-FLOAT,
|
||||
SCALE-FLOAT, FLOAT-RADIX, FLOAT-DIGITS, INTEGER-DECODE-FLOAT, REALPART,
|
||||
IMAGPART, COMPLEX.
|
||||
|
||||
- C functions which disappear: si_set_compiled_function_name(),
|
||||
si_extended_string_concatenate()
|
||||
|
||||
|
|
@ -149,7 +155,8 @@ ECL 1.0:
|
|||
ecl_type_error().
|
||||
|
||||
- Functions renamed: backup_fopen() -> ecl_backup_fopen()
|
||||
char_code() -> ecl_char_code()
|
||||
char_code() -> ecl_char_code(), cl_log1() -> ecl_log1(),
|
||||
cl_log2() -> ecl_log2(), NUMBER_TYPE() -> ECL_NUMBER_TYPE_P()
|
||||
|
||||
* Contributed code:
|
||||
|
||||
|
|
|
|||
161
src/c/num_co.d
161
src/c/num_co.d
|
|
@ -57,14 +57,13 @@ number_remainder(cl_object x, cl_object y, cl_object q)
|
|||
otherwise coerce to same float type as second arg */
|
||||
|
||||
@(defun float (x &optional (y OBJNULL))
|
||||
cl_type t, tx;
|
||||
double d;
|
||||
/* TODO: LONG_FLOAT SHORT_FLOAT */
|
||||
cl_type ty, tx;
|
||||
@
|
||||
AGAIN:
|
||||
if (y != OBJNULL) {
|
||||
t = type_of(y);
|
||||
ty = type_of(y);
|
||||
} else {
|
||||
t = t_singlefloat;
|
||||
ty = t_singlefloat;
|
||||
}
|
||||
switch (tx = type_of(x)) {
|
||||
#ifdef ECL_SHORT_FLOAT
|
||||
|
|
@ -75,12 +74,12 @@ number_remainder(cl_object x, cl_object y, cl_object q)
|
|||
#ifdef ECL_LONG_FLOAT
|
||||
case t_longfloat:
|
||||
#endif
|
||||
if (y == OBJNULL || t == tx)
|
||||
if (y == OBJNULL || ty == tx)
|
||||
break;
|
||||
case t_fixnum:
|
||||
case t_bignum:
|
||||
case t_ratio:
|
||||
switch (t) {
|
||||
switch (ty) {
|
||||
#ifdef ECL_SHORT_FLOAT
|
||||
case t_shortfloat:
|
||||
x = make_shortfloat(number_to_double(x)); break;
|
||||
|
|
@ -90,18 +89,17 @@ number_remainder(cl_object x, cl_object y, cl_object q)
|
|||
case t_doublefloat:
|
||||
x = make_doublefloat(number_to_double(x)); break;
|
||||
#ifdef ECL_LONG_FLOAT
|
||||
case t_longfloat: {
|
||||
/* FIXME! We lose precision! */
|
||||
volatile double y = number_to_double(x);
|
||||
x = make_longfloat(y); break;
|
||||
}
|
||||
case t_longfloat:
|
||||
x = make_longfloat(number_to_long_double(x)); break;
|
||||
#endif
|
||||
default:
|
||||
FEtype_error_float(y);
|
||||
y = ecl_type_error(@'float',"prototype",y,@'float');
|
||||
goto AGAIN;
|
||||
}
|
||||
break;
|
||||
default:
|
||||
FEtype_error_real(x);
|
||||
x = ecl_type_error(@'float',"argument",x,@'real');
|
||||
goto AGAIN;
|
||||
}
|
||||
@(return x)
|
||||
@)
|
||||
|
|
@ -109,44 +107,44 @@ number_remainder(cl_object x, cl_object y, cl_object q)
|
|||
cl_object
|
||||
cl_numerator(cl_object x)
|
||||
{
|
||||
cl_object out;
|
||||
|
||||
AGAIN:
|
||||
switch (type_of(x)) {
|
||||
case t_ratio:
|
||||
out = x->ratio.num;
|
||||
x = x->ratio.num;
|
||||
break;
|
||||
case t_fixnum:
|
||||
case t_bignum:
|
||||
out = x;
|
||||
break;
|
||||
default:
|
||||
FEwrong_type_argument(@'rational', x);
|
||||
x = ecl_type_error(@'numerator',"argument",x,@'rational');
|
||||
goto AGAIN;
|
||||
}
|
||||
@(return out)
|
||||
@(return x)
|
||||
}
|
||||
|
||||
cl_object
|
||||
cl_denominator(cl_object x)
|
||||
{
|
||||
cl_object out;
|
||||
|
||||
AGAIN:
|
||||
switch (type_of(x)) {
|
||||
case t_ratio:
|
||||
out = x->ratio.den;
|
||||
x = x->ratio.den;
|
||||
break;
|
||||
case t_fixnum:
|
||||
case t_bignum:
|
||||
out = MAKE_FIXNUM(1);
|
||||
x = MAKE_FIXNUM(1);
|
||||
break;
|
||||
default:
|
||||
FEwrong_type_argument(@'rational', x);
|
||||
x = ecl_type_error(@'numerator',"argument",x,@'rational');
|
||||
goto AGAIN;
|
||||
}
|
||||
@(return out)
|
||||
@(return x)
|
||||
}
|
||||
|
||||
cl_object
|
||||
floor1(cl_object x)
|
||||
{
|
||||
AGAIN:
|
||||
switch (type_of(x)) {
|
||||
case t_fixnum:
|
||||
case t_bignum:
|
||||
|
|
@ -190,7 +188,8 @@ floor1(cl_object x)
|
|||
}
|
||||
#endif
|
||||
default:
|
||||
FEtype_error_real(x);
|
||||
x = ecl_type_error(@'floor',"argument",x,@'real');
|
||||
goto AGAIN;
|
||||
}
|
||||
NVALUES = 2;
|
||||
return VALUES(0);
|
||||
|
|
@ -199,9 +198,14 @@ floor1(cl_object x)
|
|||
cl_object
|
||||
floor2(cl_object x, cl_object y)
|
||||
{
|
||||
cl_type ty;
|
||||
AGAIN:
|
||||
while ((ty = type_of(y), !ECL_NUMBER_TYPE_P(ty))) {
|
||||
y = ecl_type_error(@'floor',"divisor",y,@'real');
|
||||
}
|
||||
switch(type_of(x)) {
|
||||
case t_fixnum:
|
||||
switch(type_of(y)) {
|
||||
switch(ty) {
|
||||
case t_fixnum: { /* FIX / FIX */
|
||||
cl_fixnum a = fix(x), b = fix(y);
|
||||
cl_fixnum q = a / b, r = a % b;
|
||||
|
|
@ -275,11 +279,11 @@ floor2(cl_object x, cl_object y)
|
|||
}
|
||||
#endif
|
||||
default:
|
||||
FEtype_error_real(y);
|
||||
(void)0; /* Never reached */
|
||||
}
|
||||
break;
|
||||
case t_bignum:
|
||||
switch(type_of(y)) {
|
||||
switch(ty) {
|
||||
case t_fixnum: { /* BIG / FIX */
|
||||
cl_object q = big_register0_get();
|
||||
cl_object r = big_register1_get();
|
||||
|
|
@ -349,11 +353,11 @@ floor2(cl_object x, cl_object y)
|
|||
}
|
||||
#endif
|
||||
default:
|
||||
FEtype_error_real(y);
|
||||
(void)0; /* Never reached */
|
||||
}
|
||||
break;
|
||||
case t_ratio:
|
||||
switch(type_of(y)) {
|
||||
switch(ty) {
|
||||
case t_ratio: /* RAT / RAT */
|
||||
floor2(number_times(x->ratio.num, y->ratio.den),
|
||||
number_times(x->ratio.den, y->ratio.num));
|
||||
|
|
@ -401,7 +405,8 @@ floor2(cl_object x, cl_object y)
|
|||
}
|
||||
#endif
|
||||
default:
|
||||
FEtype_error_real(x);
|
||||
x = ecl_type_error(@'floor',"argument",x,@'real');
|
||||
goto AGAIN;
|
||||
}
|
||||
NVALUES = 2;
|
||||
return VALUES(0);
|
||||
|
|
@ -419,6 +424,7 @@ floor2(cl_object x, cl_object y)
|
|||
cl_object
|
||||
ceiling1(cl_object x)
|
||||
{
|
||||
AGAIN:
|
||||
switch (type_of(x)) {
|
||||
case t_fixnum:
|
||||
case t_bignum:
|
||||
|
|
@ -462,7 +468,8 @@ ceiling1(cl_object x)
|
|||
}
|
||||
#endif
|
||||
default:
|
||||
FEtype_error_real(x);
|
||||
x = ecl_type_error(@'ceiling',"argument",x,@'real');
|
||||
goto AGAIN;
|
||||
}
|
||||
NVALUES = 2;
|
||||
return VALUES(0);
|
||||
|
|
@ -471,9 +478,14 @@ ceiling1(cl_object x)
|
|||
cl_object
|
||||
ceiling2(cl_object x, cl_object y)
|
||||
{
|
||||
cl_type ty;
|
||||
AGAIN:
|
||||
while ((ty = type_of(y), !ECL_NUMBER_TYPE_P(ty))) {
|
||||
y = ecl_type_error(@'ceiling',"divisor",y,@'real');
|
||||
}
|
||||
switch(type_of(x)) {
|
||||
case t_fixnum:
|
||||
switch(type_of(y)) {
|
||||
switch(ty) {
|
||||
case t_fixnum: { /* FIX / FIX */
|
||||
cl_fixnum a = fix(x); cl_fixnum b = fix(y);
|
||||
cl_fixnum q = a / b; cl_fixnum r = a % b;
|
||||
|
|
@ -547,7 +559,7 @@ ceiling2(cl_object x, cl_object y)
|
|||
}
|
||||
#endif
|
||||
default:
|
||||
FEtype_error_real(y);
|
||||
(void)0; /*Never reached */
|
||||
}
|
||||
break;
|
||||
case t_bignum:
|
||||
|
|
@ -621,7 +633,7 @@ ceiling2(cl_object x, cl_object y)
|
|||
}
|
||||
#endif
|
||||
default:
|
||||
FEtype_error_real(y);
|
||||
(void)0; /*Never reached */
|
||||
}
|
||||
break;
|
||||
case t_ratio:
|
||||
|
|
@ -673,7 +685,8 @@ ceiling2(cl_object x, cl_object y)
|
|||
}
|
||||
#endif
|
||||
default:
|
||||
FEtype_error_real(x);
|
||||
x = ecl_type_error(@'ceiling',"argument",x,@'real');
|
||||
goto AGAIN;
|
||||
}
|
||||
NVALUES = 2;
|
||||
return VALUES(0);
|
||||
|
|
@ -691,6 +704,7 @@ ceiling2(cl_object x, cl_object y)
|
|||
cl_object
|
||||
truncate1(cl_object x)
|
||||
{
|
||||
AGAIN:
|
||||
switch (type_of(x)) {
|
||||
case t_fixnum:
|
||||
case t_bignum:
|
||||
|
|
@ -734,7 +748,8 @@ truncate1(cl_object x)
|
|||
}
|
||||
#endif
|
||||
default:
|
||||
FEtype_error_real(x);
|
||||
x = ecl_type_error(@'truncate',"argument",x,@'real');
|
||||
goto AGAIN;
|
||||
}
|
||||
NVALUES = 2;
|
||||
return VALUES(0);
|
||||
|
|
@ -801,6 +816,7 @@ round_long_double(long double d)
|
|||
cl_object
|
||||
round1(cl_object x)
|
||||
{
|
||||
AGAIN:
|
||||
switch (type_of(x)) {
|
||||
case t_fixnum:
|
||||
case t_bignum:
|
||||
|
|
@ -840,7 +856,8 @@ round1(cl_object x)
|
|||
}
|
||||
#endif
|
||||
default:
|
||||
FEtype_error_real(x);
|
||||
x = ecl_type_error(@'round',"argument",x,@'real');
|
||||
goto AGAIN;
|
||||
}
|
||||
NVALUES = 2;
|
||||
return VALUES(0);
|
||||
|
|
@ -916,7 +933,7 @@ cl_decode_float(cl_object x)
|
|||
cl_type tx = type_of(x);
|
||||
float f;
|
||||
double d;
|
||||
|
||||
AGAIN:
|
||||
switch (tx) {
|
||||
#ifdef ECL_SHORT_FLOAT
|
||||
case t_shortfloat:
|
||||
|
|
@ -963,7 +980,8 @@ cl_decode_float(cl_object x)
|
|||
}
|
||||
#endif
|
||||
default:
|
||||
FEtype_error_float(x);
|
||||
x = ecl_type_error(@'decode-float',"argument",x,@'float');
|
||||
goto AGAIN;
|
||||
}
|
||||
@(return x MAKE_FIXNUM(e) make_singlefloat(s))
|
||||
}
|
||||
|
|
@ -972,11 +990,13 @@ cl_object
|
|||
cl_scale_float(cl_object x, cl_object y)
|
||||
{
|
||||
cl_fixnum k;
|
||||
|
||||
if (FIXNUMP(y))
|
||||
AGAIN:
|
||||
if (FIXNUMP(y)) {
|
||||
k = fix(y);
|
||||
else
|
||||
FEerror("~S is an illegal exponent.", 1, y);
|
||||
} else {
|
||||
y = ecl_type_error(@'scale-float',"exponent",y,@'fixnum');
|
||||
goto AGAIN;
|
||||
}
|
||||
switch (type_of(x)) {
|
||||
#ifdef ECL_SHORT_FLOAT
|
||||
case t_shortfloat:
|
||||
|
|
@ -995,7 +1015,8 @@ cl_scale_float(cl_object x, cl_object y)
|
|||
break;
|
||||
#endif
|
||||
default:
|
||||
FEtype_error_float(x);
|
||||
x = ecl_type_error(@'scale-float',"argument",x,@'float');
|
||||
goto AGAIN;
|
||||
}
|
||||
@(return x)
|
||||
}
|
||||
|
|
@ -1003,14 +1024,16 @@ cl_scale_float(cl_object x, cl_object y)
|
|||
cl_object
|
||||
cl_float_radix(cl_object x)
|
||||
{
|
||||
if (cl_floatp(x) != Ct)
|
||||
FEtype_error_float(x);
|
||||
while (cl_floatp(x) != Ct) {
|
||||
x = ecl_type_error(@'float-radix',"argument",x,@'float');
|
||||
}
|
||||
@(return MAKE_FIXNUM(FLT_RADIX))
|
||||
}
|
||||
|
||||
@(defun float_sign (x &optional (y x))
|
||||
int negativep;
|
||||
@
|
||||
AGAIN:
|
||||
switch (type_of(x)) {
|
||||
#ifdef ECL_SHORT_FLOAT
|
||||
case t_shortfloat:
|
||||
|
|
@ -1025,37 +1048,45 @@ cl_float_radix(cl_object x)
|
|||
negativep = ecl_long_float(x) < 0; break;
|
||||
#endif
|
||||
default:
|
||||
FEtype_error_float(x);
|
||||
x = ecl_type_error(@'float-sign',"argument",x,@'float');
|
||||
goto AGAIN;
|
||||
}
|
||||
switch (type_of(y)) {
|
||||
#ifdef ECL_SHORT_FLOAT
|
||||
case t_shortfloat: {
|
||||
float f = ecl_short_float(y);
|
||||
@(return make_shortfloat(negativep? -fabsf(f) : fabsf(f)))
|
||||
x = make_shortfloat(negativep? -fabsf(f) : fabsf(f));
|
||||
break;
|
||||
}
|
||||
#endif
|
||||
case t_singlefloat: {
|
||||
float f = sf(y);
|
||||
@(return make_singlefloat(negativep? -fabsf(f) : fabsf(f)))
|
||||
x = make_singlefloat(negativep? -fabsf(f) : fabsf(f));
|
||||
break;
|
||||
}
|
||||
case t_doublefloat: {
|
||||
double f = df(y);
|
||||
@(return make_doublefloat(negativep? -fabs(f) : fabs(f)))
|
||||
x = make_doublefloat(negativep? -fabs(f) : fabs(f));
|
||||
break;
|
||||
}
|
||||
#ifdef ECL_LONG_FLOAT
|
||||
case t_longfloat: {
|
||||
long double f = ecl_long_float(y);
|
||||
@(return make_longfloat(negativep? -fabsl(f) : fabsl(f)))
|
||||
x = make_longfloat(negativep? -fabsl(f) : fabsl(f));
|
||||
break;
|
||||
}
|
||||
#endif
|
||||
default:
|
||||
FEtype_error_float(x);
|
||||
y = ecl_type_error(@'float-sign',"prototype",y,@'float');
|
||||
goto AGAIN;
|
||||
}
|
||||
@(return x);
|
||||
@)
|
||||
|
||||
cl_object
|
||||
cl_float_digits(cl_object x)
|
||||
{
|
||||
AGAIN:
|
||||
switch (type_of(x)) {
|
||||
#ifdef ECL_SHORT_FLOAT
|
||||
case t_shortfloat:
|
||||
|
|
@ -1072,7 +1103,8 @@ cl_float_digits(cl_object x)
|
|||
break;
|
||||
#endif
|
||||
default:
|
||||
FEtype_error_float(x);
|
||||
x = ecl_type_error(@'float-digits',"argument",x,@'float');
|
||||
goto AGAIN;
|
||||
}
|
||||
@(return x)
|
||||
}
|
||||
|
|
@ -1082,6 +1114,7 @@ cl_float_precision(cl_object x)
|
|||
{
|
||||
int precision;
|
||||
float f; double d;
|
||||
AGAIN:
|
||||
switch (type_of(x)) {
|
||||
#ifdef ECL_SHORT_FLOAT
|
||||
case t_shortfloat: {
|
||||
|
|
@ -1148,7 +1181,8 @@ cl_float_precision(cl_object x)
|
|||
}
|
||||
#endif
|
||||
default:
|
||||
FEtype_error_float(x);
|
||||
x = ecl_type_error(@'float-precision',"argument",x,@'float');
|
||||
goto AGAIN;
|
||||
}
|
||||
@(return MAKE_FIXNUM(precision))
|
||||
}
|
||||
|
|
@ -1157,7 +1191,7 @@ cl_object
|
|||
cl_integer_decode_float(cl_object x)
|
||||
{
|
||||
int e, s;
|
||||
|
||||
AGAIN:
|
||||
switch (type_of(x)) {
|
||||
#ifdef ECL_LONG_FLOAT
|
||||
case t_longfloat: {
|
||||
|
|
@ -1241,7 +1275,8 @@ cl_integer_decode_float(cl_object x)
|
|||
}
|
||||
#endif
|
||||
default:
|
||||
FEtype_error_float(x);
|
||||
x = ecl_type_error(@'integer-decode-float',"argument",x,@'float');
|
||||
goto AGAIN;
|
||||
}
|
||||
@(return x MAKE_FIXNUM(e) MAKE_FIXNUM(s))
|
||||
}
|
||||
|
|
@ -1255,6 +1290,7 @@ cl_integer_decode_float(cl_object x)
|
|||
cl_object
|
||||
cl_realpart(cl_object x)
|
||||
{
|
||||
AGAIN:
|
||||
switch (type_of(x)) {
|
||||
case t_fixnum:
|
||||
case t_bignum:
|
||||
|
|
@ -1272,7 +1308,8 @@ cl_realpart(cl_object x)
|
|||
x = x->complex.real;
|
||||
break;
|
||||
default:
|
||||
FEtype_error_number(x);
|
||||
x = ecl_type_error(@'realpart',"argument",x,@'number');
|
||||
goto AGAIN;
|
||||
}
|
||||
@(return x)
|
||||
}
|
||||
|
|
@ -1280,6 +1317,7 @@ cl_realpart(cl_object x)
|
|||
cl_object
|
||||
cl_imagpart(cl_object x)
|
||||
{
|
||||
AGAIN:
|
||||
switch (type_of(x)) {
|
||||
case t_fixnum:
|
||||
case t_bignum:
|
||||
|
|
@ -1305,7 +1343,8 @@ cl_imagpart(cl_object x)
|
|||
x = x->complex.imag;
|
||||
break;
|
||||
default:
|
||||
FEtype_error_number(x);
|
||||
x = ecl_type_error(@'imagpart',"argument",x,@'number');
|
||||
goto AGAIN;
|
||||
}
|
||||
@(return x)
|
||||
}
|
||||
|
|
|
|||
319
src/c/num_sfun.d
319
src/c/num_sfun.d
|
|
@ -69,51 +69,57 @@ fixnum_expt(cl_fixnum x, cl_fixnum y)
|
|||
cl_object
|
||||
cl_exp(cl_object x)
|
||||
{
|
||||
cl_object output;
|
||||
AGAIN:
|
||||
switch (type_of(x)) {
|
||||
case t_fixnum:
|
||||
case t_bignum:
|
||||
case t_ratio:
|
||||
return1(make_singlefloat(expf(number_to_double(x))));
|
||||
output = make_singlefloat(expf(number_to_float(x))); break;
|
||||
#ifdef ECL_SHORT_FLOAT
|
||||
case t_shortfloat:
|
||||
return1(make_shortfloat(expf(ecl_short_float(x))));
|
||||
output = make_shortfloat(expf(ecl_short_float(x))); break;
|
||||
#endif
|
||||
case t_singlefloat:
|
||||
return1(make_singlefloat(expf(sf(x))));
|
||||
|
||||
output = make_singlefloat(expf(sf(x))); break;
|
||||
case t_doublefloat:
|
||||
return1(make_doublefloat(exp(df(x))));
|
||||
output = make_doublefloat(exp(df(x))); break;
|
||||
#ifdef ECL_LONG_FLOAT
|
||||
case t_longfloat:
|
||||
return1(make_longfloat(expl(ecl_long_float(x))));
|
||||
output = make_longfloat(expl(ecl_long_float(x))); break;
|
||||
#endif
|
||||
case t_complex: {
|
||||
cl_object y, y1;
|
||||
|
||||
y = x->complex.imag;
|
||||
x = x->complex.real;
|
||||
x = cl_exp(x);
|
||||
output = cl_exp(x->complex.real);
|
||||
y1 = cl_cos(y);
|
||||
y = cl_sin(y);
|
||||
y = make_complex(y1, y);
|
||||
x = number_times(x, y);
|
||||
return1(x);
|
||||
output = number_times(output, y);
|
||||
break;
|
||||
}
|
||||
|
||||
default:
|
||||
FEtype_error_number(x);
|
||||
x = ecl_type_error(@'exp',"exponent",x,@'number');
|
||||
goto AGAIN;
|
||||
}
|
||||
@(return output)
|
||||
}
|
||||
|
||||
cl_object
|
||||
cl_expt(cl_object x, cl_object y)
|
||||
{
|
||||
cl_type ty = type_of(y);
|
||||
cl_type ty, tx;
|
||||
cl_object z;
|
||||
|
||||
AGAIN:
|
||||
while ((ty = type_of(y), !ECL_NUMBER_TYPE_P(ty))) {
|
||||
y = ecl_type_error(@'exp',"exponent",y,@'number');
|
||||
}
|
||||
while ((tx = type_of(x), !ECL_NUMBER_TYPE_P(tx))) {
|
||||
x = ecl_type_error(@'exp',"basis",x,@'number');
|
||||
}
|
||||
if (number_zerop(y)) {
|
||||
/* INV: The most specific numeric types come first. */
|
||||
cl_type tx = type_of(x);
|
||||
switch ((ty > tx)? ty : tx) {
|
||||
case t_fixnum:
|
||||
case t_bignum:
|
||||
|
|
@ -137,14 +143,15 @@ cl_expt(cl_object x, cl_object y)
|
|||
z = make_complex(z, MAKE_FIXNUM(0));
|
||||
break;
|
||||
default:
|
||||
FEtype_error_number(x);
|
||||
/* We will never reach this */
|
||||
(void)0;
|
||||
}
|
||||
} else if (number_zerop(x)) {
|
||||
if (!number_plusp(ty==t_complex?y->complex.real:y))
|
||||
FEerror("Cannot raise zero to the power ~S.", 1, y);
|
||||
z = number_times(x, y);
|
||||
} else if (ty != t_fixnum && ty != t_bignum) {
|
||||
z = cl_log1(x);
|
||||
z = ecl_log1(x);
|
||||
z = number_times(z, y);
|
||||
z = cl_exp(z);
|
||||
} else if (number_minusp(y)) {
|
||||
|
|
@ -162,103 +169,110 @@ cl_expt(cl_object x, cl_object y)
|
|||
x = number_times(x, x);
|
||||
} while (1);
|
||||
}
|
||||
return1(z);
|
||||
@(return z);
|
||||
}
|
||||
|
||||
static cl_object
|
||||
ecl_log1_complex(cl_object r, cl_object i)
|
||||
{
|
||||
cl_object a = number_times(r, r);
|
||||
cl_object p = number_times(i, i);
|
||||
a = number_plus(a, p);
|
||||
a = ecl_log1(a);
|
||||
a = number_divide(a, MAKE_FIXNUM(2));
|
||||
p = ecl_atan2(i, r);
|
||||
return make_complex(a, p);
|
||||
}
|
||||
|
||||
cl_object
|
||||
cl_log1(cl_object x)
|
||||
ecl_log1(cl_object x)
|
||||
{
|
||||
cl_object r, i, a, p;
|
||||
|
||||
if (type_of(x) == t_complex) {
|
||||
r = x->complex.real;
|
||||
i = x->complex.imag;
|
||||
goto COMPLEX;
|
||||
cl_type tx;
|
||||
AGAIN:
|
||||
tx = type_of(x);
|
||||
if (!ECL_NUMBER_TYPE_P(tx)) {
|
||||
x = ecl_type_error(@'log',"argument",x,@'number');
|
||||
goto AGAIN;
|
||||
}
|
||||
if (number_zerop(x))
|
||||
if (tx == t_complex) {
|
||||
return ecl_log1_complex(x->complex.real, x->complex.imag);
|
||||
} else if (number_zerop(x)) {
|
||||
FEerror("Zero is the logarithmic singularity.", 0);
|
||||
if (number_minusp(x)) {
|
||||
r = x;
|
||||
i = MAKE_FIXNUM(0);
|
||||
goto COMPLEX;
|
||||
}
|
||||
switch (type_of(x)) {
|
||||
} else if (number_minusp(x)) {
|
||||
return ecl_log1_complex(x, MAKE_FIXNUM(0));
|
||||
} else switch (tx) {
|
||||
case t_fixnum:
|
||||
case t_bignum:
|
||||
case t_ratio:
|
||||
return1(make_singlefloat(log(number_to_double(x))));
|
||||
return make_singlefloat(logf(number_to_float(x)));
|
||||
#ifdef ECL_SHORT_FLOAT
|
||||
case t_shortfloat:
|
||||
return1(make_shortfloat(logf(ecl_short_float(x))));
|
||||
return make_shortfloat(logf(ecl_short_float(x)));
|
||||
#endif
|
||||
case t_singlefloat:
|
||||
return1(make_singlefloat(logf(sf(x))));
|
||||
return make_singlefloat(logf(sf(x)));
|
||||
case t_doublefloat:
|
||||
return1(make_doublefloat(log(df(x))));
|
||||
return make_doublefloat(log(df(x)));
|
||||
#ifdef ECL_LONG_FLOAT
|
||||
case t_longfloat:
|
||||
return1(make_longfloat(logl(ecl_long_float(x))));
|
||||
return make_longfloat(logl(ecl_long_float(x)));
|
||||
#endif
|
||||
default:
|
||||
FEtype_error_number(x);
|
||||
/* We do not reach here */
|
||||
(void)0;
|
||||
}
|
||||
COMPLEX:
|
||||
a = number_times(r, r);
|
||||
p = number_times(i, i);
|
||||
a = number_plus(a, p);
|
||||
a = cl_log1(a);
|
||||
a = number_divide(a, MAKE_FIXNUM(2));
|
||||
p = cl_atan2(i, r);
|
||||
x = make_complex(a, p);
|
||||
return1(x);
|
||||
}
|
||||
|
||||
cl_object
|
||||
cl_log2(cl_object x, cl_object y)
|
||||
ecl_log2(cl_object x, cl_object y)
|
||||
{
|
||||
if (number_zerop(y))
|
||||
FEerror("Zero is the logarithmic singularity.", 0);
|
||||
return1(number_divide(cl_log1(y), cl_log1(x)));
|
||||
return number_divide(ecl_log1(y), ecl_log1(x));
|
||||
}
|
||||
|
||||
cl_object
|
||||
cl_sqrt(cl_object x)
|
||||
{
|
||||
cl_object z;
|
||||
|
||||
if (type_of(x) == t_complex)
|
||||
goto COMPLEX;
|
||||
if (number_minusp(x))
|
||||
return1(make_complex(MAKE_FIXNUM(0), cl_sqrt(number_negate(x))));
|
||||
switch (type_of(x)) {
|
||||
cl_type tx;
|
||||
AGAIN:
|
||||
tx = type_of(x);
|
||||
if (!ECL_NUMBER_TYPE_P(tx)) {
|
||||
x = ecl_type_error(@'sqrt',"argument",x,@'number');
|
||||
goto AGAIN;
|
||||
}
|
||||
if (tx == t_complex) {
|
||||
z = make_ratio(MAKE_FIXNUM(1), MAKE_FIXNUM(2));
|
||||
z = cl_expt(x, z);
|
||||
} else if (number_minusp(x)) {
|
||||
z = make_complex(MAKE_FIXNUM(0), cl_sqrt(number_negate(x)));
|
||||
} else switch (type_of(x)) {
|
||||
case t_fixnum:
|
||||
case t_bignum:
|
||||
case t_ratio:
|
||||
return1(make_singlefloat(sqrtf(number_to_double(x))));
|
||||
z = make_singlefloat(sqrtf(number_to_float(x))); break;
|
||||
#ifdef ECL_SHORT_FLOAT
|
||||
case t_shortfloat:
|
||||
return1(make_shortfloat(sqrtf(ecl_short_float(x))));
|
||||
z = make_shortfloat(sqrtf(ecl_short_float(x))); break;;
|
||||
#endif
|
||||
case t_singlefloat:
|
||||
return1(make_singlefloat(sqrtf(sf(x))));
|
||||
z = make_singlefloat(sqrtf(sf(x))); break;
|
||||
case t_doublefloat:
|
||||
return1(make_doublefloat(sqrt(df(x))));
|
||||
z = make_doublefloat(sqrt(df(x))); break;
|
||||
#ifdef ECL_LONG_FLOAT
|
||||
case t_longfloat:
|
||||
return1(make_longfloat(sqrtl(ecl_long_float(x))));
|
||||
z = make_longfloat(sqrtl(ecl_long_float(x))); break;
|
||||
#endif
|
||||
default:
|
||||
FEtype_error_number(x);
|
||||
/* Never reaches this */
|
||||
(void)0;
|
||||
}
|
||||
|
||||
COMPLEX:
|
||||
z = make_ratio(MAKE_FIXNUM(1), MAKE_FIXNUM(2));
|
||||
z = cl_expt(x, z);
|
||||
return1(z);
|
||||
@(return z);
|
||||
}
|
||||
|
||||
cl_object
|
||||
cl_atan2(cl_object y, cl_object x)
|
||||
ecl_atan2(cl_object y, cl_object x)
|
||||
{
|
||||
cl_object z;
|
||||
double dy, dx, dz;
|
||||
|
|
@ -287,57 +301,57 @@ cl_atan2(cl_object y, cl_object x)
|
|||
else
|
||||
dz = -M_PI + atan(-dy / -dx);
|
||||
if (type_of(x) == t_doublefloat || type_of(y) == t_doublefloat)
|
||||
z = make_doublefloat(dz);
|
||||
return make_doublefloat(dz);
|
||||
else
|
||||
z = make_singlefloat(dz);
|
||||
return1(z);
|
||||
return make_singlefloat(dz);
|
||||
}
|
||||
|
||||
cl_object
|
||||
cl_atan1(cl_object y)
|
||||
ecl_atan1(cl_object y)
|
||||
{
|
||||
cl_object z, z1;
|
||||
|
||||
if (type_of(y) == t_complex) {
|
||||
#if 0 /* FIXME! ANSI states it should be this first part */
|
||||
z = number_times(cl_core.imag_unit, y);
|
||||
z = cl_log1(one_plus(z)) +
|
||||
cl_log1(number_minus(MAKE_FIXNUM(1), z));
|
||||
z = ecl_log1(one_plus(z)) +
|
||||
ecl_log1(number_minus(MAKE_FIXNUM(1), z));
|
||||
z = number_divide(z, number_times(MAKE_FIXNUM(2), cl_core.imag_unit));
|
||||
#else
|
||||
z = number_times(cl_core.imag_unit, y);
|
||||
cl_object z1, z = number_times(cl_core.imag_unit, y);
|
||||
z = one_plus(z);
|
||||
z1 = number_times(y, y);
|
||||
z1 = one_plus(z1);
|
||||
z1 = cl_sqrt(z1);
|
||||
z = number_divide(z, z1);
|
||||
z = cl_log1(z);
|
||||
z = ecl_log1(z);
|
||||
z = number_times(cl_core.minus_imag_unit, z);
|
||||
#endif /* ANSI */
|
||||
return1(z);
|
||||
return z;
|
||||
} else {
|
||||
return ecl_atan2(y, MAKE_FIXNUM(1));
|
||||
}
|
||||
return1(cl_atan2(y, MAKE_FIXNUM(1)));
|
||||
}
|
||||
|
||||
cl_object
|
||||
cl_sin(cl_object x)
|
||||
{
|
||||
cl_object output;
|
||||
AGAIN:
|
||||
switch (type_of(x)) {
|
||||
case t_fixnum:
|
||||
case t_bignum:
|
||||
case t_ratio:
|
||||
return1(make_singlefloat(sinf(number_to_double(x))));
|
||||
output = make_singlefloat(sinf(number_to_float(x))); break;
|
||||
#ifdef ECL_SHORT_FLOAT
|
||||
case t_shortfloat:
|
||||
return1(make_shortfloat(sinf(ecl_short_float(x))));
|
||||
output = make_shortfloat(sinf(ecl_short_float(x))); break;
|
||||
#endif
|
||||
case t_singlefloat:
|
||||
return1(make_singlefloat(sinf(sf(x))));
|
||||
output = make_singlefloat(sinf(sf(x))); break;
|
||||
case t_doublefloat:
|
||||
return1(make_doublefloat(sin(df(x))));
|
||||
output = make_doublefloat(sin(df(x))); break;
|
||||
#ifdef ECL_LONG_FLOAT
|
||||
case t_longfloat:
|
||||
return1(make_longfloat(sinf(ecl_long_float(x))));
|
||||
output = make_longfloat(sinf(ecl_long_float(x))); break;
|
||||
#endif
|
||||
case t_complex: {
|
||||
/*
|
||||
|
|
@ -350,33 +364,41 @@ cl_sin(cl_object x)
|
|||
double a = sin(dx) * cosh(dy);
|
||||
double b = cos(dx) * sinh(dy);
|
||||
if (type_of(x->complex.real) != t_doublefloat)
|
||||
return1(make_complex(make_singlefloat(a), make_singlefloat(b)));
|
||||
return1(make_complex(make_doublefloat(a), make_doublefloat(b)));
|
||||
output = make_complex(make_singlefloat(a),
|
||||
make_singlefloat(b));
|
||||
else
|
||||
output = make_complex(make_doublefloat(a),
|
||||
make_doublefloat(b));
|
||||
break;
|
||||
}
|
||||
default:
|
||||
FEtype_error_number(x);
|
||||
x = ecl_type_error(@'sin',"argument",x,@'number');
|
||||
goto AGAIN;
|
||||
}
|
||||
@(return output)
|
||||
}
|
||||
|
||||
cl_object
|
||||
cl_cos(cl_object x)
|
||||
{
|
||||
cl_object output;
|
||||
AGAIN:
|
||||
switch (type_of(x)) {
|
||||
case t_fixnum:
|
||||
case t_bignum:
|
||||
case t_ratio:
|
||||
return1(make_singlefloat(cosf(number_to_double(x))));
|
||||
output = make_singlefloat(cosf(number_to_float(x))); break;
|
||||
#ifdef ECL_SHORT_FLOAT
|
||||
case t_shortfloat:
|
||||
return1(make_shortfloat(cosf(ecl_short_float(x))));
|
||||
output = make_shortfloat(cosf(ecl_short_float(x))); break;
|
||||
#endif
|
||||
case t_singlefloat:
|
||||
return1(make_singlefloat(cosf(sf(x))));
|
||||
output = make_singlefloat(cosf(sf(x))); break;
|
||||
case t_doublefloat:
|
||||
return1(make_doublefloat(cos(df(x))));
|
||||
output = make_doublefloat(cos(df(x))); break;
|
||||
#ifdef ECL_LONG_FLOAT
|
||||
case t_longfloat:
|
||||
return1(make_longfloat(cosl(ecl_long_float(x))));
|
||||
output = make_longfloat(cosl(ecl_long_float(x))); break;
|
||||
#endif
|
||||
case t_complex: {
|
||||
/*
|
||||
|
|
@ -388,64 +410,76 @@ cl_cos(cl_object x)
|
|||
double a = cos(dx) * cosh(dy);
|
||||
double b = -sin(dx) * sinh(dy);
|
||||
if (type_of(x->complex.real) != t_doublefloat)
|
||||
return1(make_complex(make_singlefloat(a), make_singlefloat(b)));
|
||||
return1(make_complex(make_doublefloat(a), make_doublefloat(b)));
|
||||
output = make_complex(make_singlefloat(a),
|
||||
make_singlefloat(b));
|
||||
else
|
||||
output = make_complex(make_doublefloat(a),
|
||||
make_doublefloat(b));
|
||||
break;
|
||||
}
|
||||
default:
|
||||
FEtype_error_number(x);
|
||||
x = ecl_type_error(@'cos',"argument",x,@'number');
|
||||
goto AGAIN;
|
||||
}
|
||||
@(return output)
|
||||
}
|
||||
|
||||
cl_object
|
||||
cl_tan(cl_object x)
|
||||
{
|
||||
cl_object output;
|
||||
AGAIN:
|
||||
switch (type_of(x)) {
|
||||
case t_fixnum:
|
||||
case t_bignum:
|
||||
case t_ratio:
|
||||
return1(make_singlefloat(tanf(number_to_double(x))));
|
||||
output = make_singlefloat(tanf(number_to_float(x))); break;
|
||||
#ifdef ECL_SHORT_FLOAT
|
||||
case t_shortfloat:
|
||||
return1(make_shortfloat(tanf(ecl_short_float(x))));
|
||||
output = make_shortfloat(tanf(ecl_short_float(x))); break;
|
||||
#endif
|
||||
case t_singlefloat:
|
||||
return1(make_singlefloat(tanf(sf(x))));
|
||||
output = make_singlefloat(tanf(sf(x))); break;
|
||||
case t_doublefloat:
|
||||
return1(make_doublefloat(tan(df(x))));
|
||||
output = make_doublefloat(tan(df(x))); break;
|
||||
#ifdef ECL_LONG_FLOAT
|
||||
case t_longfloat:
|
||||
return1(make_longfloat(tanl(ecl_long_float(x))));
|
||||
output = make_longfloat(tanl(ecl_long_float(x))); break;
|
||||
#endif
|
||||
case t_complex: {
|
||||
cl_object a = cl_sin(x);
|
||||
cl_object b = cl_cos(x);
|
||||
return1(number_divide(a, b));
|
||||
output = number_divide(a, b);
|
||||
break;
|
||||
}
|
||||
default:
|
||||
FEtype_error_number(x);
|
||||
x = ecl_type_error(@'tan',"argument",x,@'number');
|
||||
goto AGAIN;
|
||||
}
|
||||
@(return output)
|
||||
}
|
||||
|
||||
cl_object
|
||||
cl_sinh(cl_object x)
|
||||
{
|
||||
|
||||
cl_object output;
|
||||
AGAIN:
|
||||
switch (type_of(x)) {
|
||||
case t_fixnum:
|
||||
case t_bignum:
|
||||
case t_ratio:
|
||||
return1(make_singlefloat(sinhf(number_to_double(x))));
|
||||
output = make_singlefloat(sinhf(number_to_float(x))); break;
|
||||
#ifdef ECL_SHORT_FLOAT
|
||||
case t_shortfloat:
|
||||
return1(make_shortfloat(sinhf(ecl_short_float(x))));
|
||||
output = make_shortfloat(sinhf(ecl_short_float(x))); break;
|
||||
#endif
|
||||
case t_singlefloat:
|
||||
return1(make_singlefloat(sinhf(sf(x))));
|
||||
output = make_singlefloat(sinhf(sf(x))); break;
|
||||
case t_doublefloat:
|
||||
return1(make_doublefloat(sinh(df(x))));
|
||||
output = make_doublefloat(sinh(df(x))); break;
|
||||
#ifdef ECL_LONG_FLOAT
|
||||
case t_longfloat:
|
||||
return1(make_longfloat(sinhf(ecl_long_float(x))));
|
||||
output = make_longfloat(sinhf(ecl_long_float(x))); break;
|
||||
#endif
|
||||
case t_complex: {
|
||||
/*
|
||||
|
|
@ -459,33 +493,41 @@ cl_sinh(cl_object x)
|
|||
double a = sinh(dx) * cos(dy);
|
||||
double b = cosh(dx) * sin(dy);
|
||||
if (type_of(x->complex.real) != t_doublefloat)
|
||||
return1(make_complex(make_singlefloat(a), make_singlefloat(b)));
|
||||
return1(make_complex(make_doublefloat(a), make_doublefloat(b)));
|
||||
output = make_complex(make_singlefloat(a),
|
||||
make_singlefloat(b));
|
||||
else
|
||||
output = make_complex(make_doublefloat(a),
|
||||
make_doublefloat(b));
|
||||
break;
|
||||
}
|
||||
default:
|
||||
FEtype_error_number(x);
|
||||
x = ecl_type_error(@'sinh',"argument",x,@'number');
|
||||
goto AGAIN;
|
||||
}
|
||||
@(return output)
|
||||
}
|
||||
|
||||
cl_object
|
||||
cl_cosh(cl_object x)
|
||||
{
|
||||
cl_object output;
|
||||
AGAIN:
|
||||
switch (type_of(x)) {
|
||||
case t_fixnum:
|
||||
case t_bignum:
|
||||
case t_ratio:
|
||||
return1(make_singlefloat(coshf(number_to_double(x))));
|
||||
output = make_singlefloat(coshf(number_to_float(x))); break;
|
||||
#ifdef ECL_SHORT_FLOAT
|
||||
case t_shortfloat:
|
||||
return1(make_shortfloat(coshf(ecl_short_float(x))));
|
||||
output = make_shortfloat(coshf(ecl_short_float(x))); break;
|
||||
#endif
|
||||
case t_singlefloat:
|
||||
return1(make_singlefloat(coshf(sf(x))));
|
||||
output = make_singlefloat(coshf(sf(x))); break;
|
||||
case t_doublefloat:
|
||||
return1(make_doublefloat(cosh(df(x))));
|
||||
output = make_doublefloat(cosh(df(x))); break;
|
||||
#ifdef ECL_LONG_FLOAT
|
||||
case t_longfloat:
|
||||
return1(make_longfloat(coshl(ecl_long_float(x))));
|
||||
output = make_longfloat(coshl(ecl_long_float(x))); break;
|
||||
#endif
|
||||
case t_complex: {
|
||||
/*
|
||||
|
|
@ -499,54 +541,67 @@ cl_cosh(cl_object x)
|
|||
double a = cosh(dx) * cos(dy);
|
||||
double b = sinh(dx) * sin(dy);
|
||||
if (type_of(x->complex.real) != t_doublefloat)
|
||||
return1(make_complex(make_singlefloat(a), make_singlefloat(b)));
|
||||
return1(make_complex(make_doublefloat(a), make_doublefloat(b)));
|
||||
output = make_complex(make_singlefloat(a),
|
||||
make_singlefloat(b));
|
||||
else
|
||||
output = make_complex(make_doublefloat(a),
|
||||
make_doublefloat(b));
|
||||
break;
|
||||
}
|
||||
default:
|
||||
FEtype_error_number(x);
|
||||
x = ecl_type_error(@'cosh',"argument",x,@'number');
|
||||
goto AGAIN;
|
||||
}
|
||||
@(return output)
|
||||
}
|
||||
|
||||
cl_object
|
||||
cl_tanh(cl_object x)
|
||||
{
|
||||
cl_object output;
|
||||
AGAIN:
|
||||
switch (type_of(x)) {
|
||||
case t_fixnum:
|
||||
case t_bignum:
|
||||
case t_ratio:
|
||||
return1(make_singlefloat(tanhf(number_to_double(x))));
|
||||
output = make_singlefloat(tanhf(number_to_float(x))); break;
|
||||
#ifdef ECL_SHORT_FLOAT
|
||||
case t_shortfloat:
|
||||
return1(make_shortfloat(tanhf(ecl_short_float(x))));
|
||||
output = make_shortfloat(tanhf(ecl_short_float(x))); break;
|
||||
#endif
|
||||
case t_singlefloat:
|
||||
return1(make_singlefloat(tanhf(sf(x))));
|
||||
output = make_singlefloat(tanhf(sf(x))); break;
|
||||
case t_doublefloat:
|
||||
return1(make_doublefloat(tanh(df(x))));
|
||||
output = make_doublefloat(tanh(df(x))); break;
|
||||
#ifdef ECL_LONG_FLOAT
|
||||
case t_longfloat:
|
||||
return1(make_longfloat(coshl(ecl_long_float(x))));
|
||||
output = make_longfloat(coshl(ecl_long_float(x))); break;
|
||||
#endif
|
||||
case t_complex: {
|
||||
cl_object a = cl_sinh(x);
|
||||
cl_object b = cl_cosh(x);
|
||||
return1(number_divide(a, b));
|
||||
output = number_divide(a, b);
|
||||
break;
|
||||
}
|
||||
default:
|
||||
FEtype_error_number(x);
|
||||
x = ecl_type_error(@'tanh',"argument",x,@'number');
|
||||
goto AGAIN;
|
||||
}
|
||||
@(return output)
|
||||
}
|
||||
|
||||
@(defun log (x &optional (y OBJNULL))
|
||||
@ /* INV: type check in cl_log1() and cl_log2() */
|
||||
@ /* INV: type check in ecl_log1() and ecl_log2() */
|
||||
if (y == OBJNULL)
|
||||
@(return cl_log1(x))
|
||||
@(return cl_log2(y, x))
|
||||
@(return ecl_log1(x))
|
||||
@(return ecl_log2(y, x))
|
||||
@)
|
||||
|
||||
@(defun atan (x &optional (y OBJNULL))
|
||||
@ /* INV: type check in cl_atan() & cl_atan2() */
|
||||
@ /* INV: type check in ecl_atan() & ecl_atan2() */
|
||||
/* FIXME ecl_atan() and ecl_atan2() produce generic errors
|
||||
without recovery and function information. */
|
||||
if (y == OBJNULL)
|
||||
@(return cl_atan1(x))
|
||||
@(return cl_atan2(x, y))
|
||||
@(return ecl_atan1(x))
|
||||
@(return ecl_atan2(x, y))
|
||||
@)
|
||||
|
|
|
|||
|
|
@ -392,7 +392,7 @@ cl_object
|
|||
cl_rational(cl_object x)
|
||||
{
|
||||
double d;
|
||||
|
||||
AGAIN:
|
||||
switch (type_of(x)) {
|
||||
case t_fixnum:
|
||||
case t_bignum:
|
||||
|
|
@ -441,7 +441,8 @@ cl_rational(cl_object x)
|
|||
}
|
||||
#endif
|
||||
default:
|
||||
FEtype_error_number(x);
|
||||
x = ecl_type_error(@'rational',"argument",x,@'number');
|
||||
goto AGAIN;
|
||||
}
|
||||
@(return x)
|
||||
}
|
||||
|
|
|
|||
|
|
@ -56,14 +56,14 @@ cl_object
|
|||
cl_numberp(cl_object x)
|
||||
{
|
||||
cl_type t = type_of(x);
|
||||
@(return (NUMBER_TYPE(t) ? Ct : Cnil))
|
||||
@(return (ECL_NUMBER_TYPE_P(t) ? Ct : Cnil))
|
||||
}
|
||||
|
||||
/* Used in compiled code */
|
||||
bool numberp(cl_object x)
|
||||
{
|
||||
cl_type t = type_of(x);
|
||||
return(NUMBER_TYPE(t));
|
||||
return ECL_NUMBER_TYPE_P(t);
|
||||
}
|
||||
|
||||
cl_object
|
||||
|
|
@ -442,7 +442,7 @@ BEGIN:
|
|||
case t_longfloat:
|
||||
#endif
|
||||
case t_complex:
|
||||
if (NUMBER_TYPE(ty))
|
||||
if (ECL_NUMBER_TYPE_P(ty))
|
||||
return number_equalp(x, y);
|
||||
else
|
||||
return FALSE;
|
||||
|
|
|
|||
|
|
@ -859,6 +859,7 @@ extern cl_object make_complex(cl_object r, cl_object i);
|
|||
extern cl_object cl_rational(cl_object x);
|
||||
#define cl_rationalize cl_rational
|
||||
extern double number_to_double(cl_object x);
|
||||
#define number_to_float(x) ((float)number_to_double(x))
|
||||
#ifdef ECL_SHORT_FLOAT
|
||||
extern cl_object make_shortfloat(float f);
|
||||
extern float ecl_short_float(cl_object o);
|
||||
|
|
@ -990,11 +991,7 @@ extern cl_object make_random_state(cl_object rs);
|
|||
extern cl_fixnum fixnum_expt(cl_fixnum x, cl_fixnum y);
|
||||
extern cl_object cl_exp(cl_object x);
|
||||
extern cl_object cl_expt(cl_object x, cl_object y);
|
||||
extern cl_object cl_log1(cl_object x);
|
||||
extern cl_object cl_log2(cl_object x, cl_object y);
|
||||
extern cl_object cl_sqrt(cl_object x);
|
||||
extern cl_object cl_atan2(cl_object y, cl_object x);
|
||||
extern cl_object cl_atan1(cl_object y);
|
||||
extern cl_object cl_sin(cl_object x);
|
||||
extern cl_object cl_cos(cl_object x);
|
||||
extern cl_object cl_tan(cl_object x);
|
||||
|
|
@ -1004,6 +1001,11 @@ extern cl_object cl_tanh(cl_object x);
|
|||
extern cl_object cl_atan _ARGS((cl_narg narg, cl_object x, ...));
|
||||
extern cl_object cl_log _ARGS((cl_narg narg, cl_object x, ...));
|
||||
|
||||
extern cl_object ecl_log1(cl_object x);
|
||||
extern cl_object ecl_log2(cl_object x, cl_object y);
|
||||
extern cl_object ecl_atan2(cl_object y, cl_object x);
|
||||
extern cl_object ecl_atan1(cl_object y);
|
||||
|
||||
|
||||
/* package.c */
|
||||
|
||||
|
|
|
|||
|
|
@ -72,7 +72,7 @@ typedef cl_object (*cl_objectfn_fixed)();
|
|||
#define CHAR_CODE(obje) ((((cl_fixnum)(obje)) >> 2) & 0xff)
|
||||
#endif
|
||||
|
||||
#define NUMBER_TYPE(t) (t >= t_fixnum && t <= t_complex)
|
||||
#define ECL_NUMBER_TYPE_P(t) (t >= t_fixnum && t <= t_complex)
|
||||
#define REAL_TYPE(t) (t >= t_fixnum && t < t_complex)
|
||||
#define ARRAY_TYPE(t) (t >= t_array && t <= t_bitvector)
|
||||
#define ARRAYP(x) ((IMMEDIATE(x) == 0) && (x)->d.t >= t_array && (x)->d.t <= t_bitvector)
|
||||
|
|
|
|||
|
|
@ -19,10 +19,13 @@
|
|||
(restart-case
|
||||
(error 'simple-type-error
|
||||
:format-control "In ~:[an anonymous function~;~:*function ~A~], ~:[found object~;~:*the value of ~A is~]~%~8t~S~%which is not of expected type ~A"
|
||||
:format-arguments (list function place object type))
|
||||
(store-value (value)
|
||||
:format-arguments (list function place object type)
|
||||
:datum object
|
||||
:expected-type type
|
||||
)
|
||||
(use-value (value)
|
||||
:report (lambda (stream)
|
||||
(format stream "Supply a new value ~@[of ~A~]." place))
|
||||
(format stream "Supply a new value of type ~A." type))
|
||||
:interactive read-evaluated-form
|
||||
(setf object value)
|
||||
(unless (typep object type)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue