mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-02 15:40:55 -08:00
309 lines
6.9 KiB
D
309 lines
6.9 KiB
D
/*
|
|
number.c -- Numeric constants.
|
|
*/
|
|
/*
|
|
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 <math.h>
|
|
#include "ecl.h"
|
|
#include <float.h>
|
|
|
|
#ifndef HAVE_ISNANF
|
|
#define isnanf(x) isnan(x)
|
|
#endif
|
|
|
|
#ifndef M_PI
|
|
# ifdef PI
|
|
# define M_PI PI
|
|
# else
|
|
# define M_PI 3.14159265358979323846
|
|
# endif
|
|
#endif
|
|
|
|
cl_fixnum
|
|
fixint(cl_object x)
|
|
{
|
|
if (FIXNUMP(x))
|
|
return fix(x);
|
|
if (type_of(x) == t_bignum) {
|
|
if (x->big.big_size == 1 || x->big.big_size == -1)
|
|
return big_to_long(x);
|
|
}
|
|
FEwrong_type_argument(@'fixnum', x);
|
|
}
|
|
|
|
cl_index
|
|
fixnnint(cl_object x)
|
|
{
|
|
if (FIXNUMP(x)) {
|
|
cl_fixnum i = fix(x);
|
|
if (i >= 0)
|
|
return i;
|
|
} else if (type_of(x) == t_bignum) {
|
|
if (x->big.big_size == 1)
|
|
return big_to_ulong(x);
|
|
}
|
|
cl_error(9, @'simple-type-error', @':format-control',
|
|
make_simple_string("Not a non-negative fixnum ~S"),
|
|
@':format-arguments', cl_list(1,x),
|
|
@':expected-type', @'fixnum', @':datum', x);
|
|
}
|
|
|
|
cl_object
|
|
make_integer(cl_fixnum l)
|
|
{
|
|
if (l > MOST_POSITIVE_FIXNUM || l < MOST_NEGATIVE_FIXNUM) {
|
|
cl_object z = cl_alloc_object(t_bignum);
|
|
mpz_init_set_si(z->big.big_num, l);
|
|
return z;
|
|
}
|
|
return MAKE_FIXNUM(l);
|
|
}
|
|
|
|
cl_object
|
|
make_unsigned_integer(cl_index l)
|
|
{
|
|
if (l > MOST_POSITIVE_FIXNUM) {
|
|
cl_object z = cl_alloc_object(t_bignum);
|
|
mpz_init_set_ui(z->big.big_num, l);
|
|
return z;
|
|
}
|
|
return MAKE_FIXNUM(l);
|
|
}
|
|
|
|
cl_object
|
|
make_ratio(cl_object num, cl_object den)
|
|
{
|
|
cl_object g, r;
|
|
|
|
/* INV: the arguments NUM & DEN are integers */
|
|
if (den == MAKE_FIXNUM(0))
|
|
FEdivision_by_zero(num, den);
|
|
if (num == MAKE_FIXNUM(0) || den == MAKE_FIXNUM(1))
|
|
return(num);
|
|
if (number_minusp(den)) {
|
|
num = number_negate(num);
|
|
den = number_negate(den);
|
|
}
|
|
g = get_gcd(num, den);
|
|
num = integer_divide(num, g);
|
|
den = integer_divide(den, g);
|
|
if (den == MAKE_FIXNUM(1))
|
|
return num;
|
|
if (den == MAKE_FIXNUM(-1))
|
|
return number_negate(num);
|
|
r = cl_alloc_object(t_ratio);
|
|
r->ratio.num = num;
|
|
r->ratio.den = den;
|
|
return(r);
|
|
}
|
|
|
|
cl_object
|
|
make_shortfloat(float f)
|
|
{
|
|
cl_object x;
|
|
|
|
if (f == (float)0.0)
|
|
return(cl_core.shortfloat_zero);
|
|
if (isnanf(f) || !finite(f))
|
|
FEerror("Not a number.",0);
|
|
x = cl_alloc_object(t_shortfloat);
|
|
sf(x) = f;
|
|
return(x);
|
|
}
|
|
|
|
cl_object
|
|
make_longfloat(double f)
|
|
{
|
|
cl_object x;
|
|
|
|
if (f == (double)0.0)
|
|
return(cl_core.longfloat_zero);
|
|
if (isnan(f) || !finite(f))
|
|
FEerror("Not a number.",0);
|
|
x = cl_alloc_object(t_longfloat);
|
|
lf(x) = f;
|
|
return(x);
|
|
}
|
|
|
|
cl_object
|
|
make_complex(cl_object r, cl_object i)
|
|
{
|
|
cl_object c;
|
|
|
|
/* Both R and I are promoted to a common type */
|
|
switch (type_of(r)) {
|
|
case t_fixnum:
|
|
case t_bignum:
|
|
case t_ratio:
|
|
switch (type_of(i)) {
|
|
case t_fixnum:
|
|
if (i == MAKE_FIXNUM(0))
|
|
return(r);
|
|
case t_bignum:
|
|
case t_ratio:
|
|
break;
|
|
case t_shortfloat:
|
|
r = make_shortfloat((float)number_to_double(r));
|
|
break;
|
|
case t_longfloat:
|
|
r = make_longfloat(number_to_double(r));
|
|
break;
|
|
default:
|
|
FEtype_error_real(i);
|
|
}
|
|
break;
|
|
case t_shortfloat:
|
|
switch (type_of(i)) {
|
|
case t_fixnum:
|
|
case t_bignum:
|
|
case t_ratio:
|
|
i = make_shortfloat((float)number_to_double(i));
|
|
case t_shortfloat:
|
|
break;
|
|
case t_longfloat:
|
|
r = make_longfloat((double)(sf(r)));
|
|
break;
|
|
default:
|
|
FEtype_error_real(i);
|
|
}
|
|
break;
|
|
case t_longfloat:
|
|
switch (type_of(i)) {
|
|
case t_fixnum:
|
|
case t_bignum:
|
|
case t_ratio:
|
|
case t_shortfloat:
|
|
i = make_longfloat(number_to_double(i));
|
|
case t_longfloat:
|
|
break;
|
|
default:
|
|
FEtype_error_real(i);
|
|
}
|
|
break;
|
|
default:
|
|
FEtype_error_real(r);
|
|
}
|
|
c = cl_alloc_object(t_complex);
|
|
c->complex.real = r;
|
|
c->complex.imag = i;
|
|
return(c);
|
|
}
|
|
|
|
double
|
|
number_to_double(cl_object x)
|
|
{
|
|
switch(type_of(x)) {
|
|
case t_fixnum:
|
|
return((double)(fix(x)));
|
|
|
|
case t_bignum:
|
|
return(big_to_double(x));
|
|
|
|
case t_ratio:
|
|
return(number_to_double(x->ratio.num) /
|
|
number_to_double(x->ratio.den));
|
|
|
|
case t_shortfloat:
|
|
return((double)(sf(x)));
|
|
|
|
case t_longfloat:
|
|
return(lf(x));
|
|
|
|
default:
|
|
FEtype_error_real(x);
|
|
}
|
|
}
|
|
|
|
|
|
|
|
void
|
|
init_number(void)
|
|
{
|
|
cl_object num;
|
|
|
|
num = make_shortfloat(FLT_MAX);
|
|
ECL_SET(@'MOST-POSITIVE-SHORT-FLOAT', num);
|
|
ECL_SET(@'MOST-POSITIVE-SINGLE-FLOAT', num);
|
|
|
|
num = make_shortfloat(-FLT_MAX);
|
|
ECL_SET(@'MOST-NEGATIVE-SHORT-FLOAT', num);
|
|
ECL_SET(@'MOST-NEGATIVE-SINGLE-FLOAT', num);
|
|
|
|
num = make_shortfloat(FLT_MIN);
|
|
ECL_SET(@'LEAST-POSITIVE-SHORT-FLOAT', num);
|
|
ECL_SET(@'LEAST-POSITIVE-SINGLE-FLOAT', num);
|
|
ECL_SET(@'LEAST-POSITIVE-NORMALIZED-SHORT-FLOAT', num);
|
|
ECL_SET(@'LEAST-POSITIVE-NORMALIZED-SINGLE-FLOAT', num);
|
|
|
|
num = make_shortfloat(-FLT_MIN);
|
|
ECL_SET(@'LEAST-NEGATIVE-SHORT-FLOAT', num);
|
|
ECL_SET(@'LEAST-NEGATIVE-SINGLE-FLOAT', num);
|
|
ECL_SET(@'LEAST-NEGATIVE-NORMALIZED-SHORT-FLOAT', num);
|
|
ECL_SET(@'LEAST-NEGATIVE-NORMALIZED-SINGLE-FLOAT', num);
|
|
|
|
num = make_longfloat(DBL_MAX);
|
|
ECL_SET(@'MOST-POSITIVE-DOUBLE-FLOAT', num);
|
|
ECL_SET(@'MOST-POSITIVE-LONG-FLOAT', num);
|
|
|
|
num = make_longfloat(-DBL_MAX);
|
|
ECL_SET(@'MOST-NEGATIVE-DOUBLE-FLOAT', num);
|
|
ECL_SET(@'MOST-NEGATIVE-LONG-FLOAT', num);
|
|
|
|
num = make_longfloat(DBL_MIN);
|
|
ECL_SET(@'LEAST-POSITIVE-DOUBLE-FLOAT', num);
|
|
ECL_SET(@'LEAST-POSITIVE-LONG-FLOAT', num);
|
|
ECL_SET(@'LEAST-POSITIVE-NORMALIZED-DOUBLE-FLOAT', num);
|
|
ECL_SET(@'LEAST-POSITIVE-NORMALIZED-LONG-FLOAT', num);
|
|
|
|
num = make_longfloat(-DBL_MIN);
|
|
ECL_SET(@'LEAST-NEGATIVE-DOUBLE-FLOAT', num);
|
|
ECL_SET(@'LEAST-NEGATIVE-LONG-FLOAT', num);
|
|
ECL_SET(@'LEAST-NEGATIVE-NORMALIZED-DOUBLE-FLOAT', num);
|
|
ECL_SET(@'LEAST-NEGATIVE-NORMALIZED-LONG-FLOAT', num);
|
|
|
|
num = make_shortfloat(FLT_EPSILON);
|
|
ECL_SET(@'SHORT-FLOAT-EPSILON', num);
|
|
ECL_SET(@'SINGLE-FLOAT-EPSILON', num);
|
|
|
|
num = make_shortfloat(-FLT_EPSILON);
|
|
ECL_SET(@'SHORT-FLOAT-NEGATIVE-EPSILON', num);
|
|
ECL_SET(@'SINGLE-FLOAT-NEGATIVE-EPSILON', num);
|
|
|
|
num = make_longfloat(DBL_EPSILON);
|
|
ECL_SET(@'DOUBLE-FLOAT-EPSILON', num);
|
|
ECL_SET(@'LONG-FLOAT-EPSILON', num);
|
|
|
|
num = make_longfloat(-DBL_EPSILON);
|
|
ECL_SET(@'DOUBLE-FLOAT-NEGATIVE-EPSILON', num);
|
|
ECL_SET(@'LONG-FLOAT-NEGATIVE-EPSILON', num);
|
|
|
|
cl_core.shortfloat_zero = cl_alloc_object(t_shortfloat);
|
|
sf(cl_core.shortfloat_zero) = (float)0.0;
|
|
cl_core.longfloat_zero = cl_alloc_object(t_longfloat);
|
|
lf(cl_core.longfloat_zero) = (double)0.0;
|
|
cl_core.plus_half = make_ratio(MAKE_FIXNUM(1), MAKE_FIXNUM(2));
|
|
cl_core.minus_half = make_ratio(MAKE_FIXNUM(-1), MAKE_FIXNUM(2));
|
|
cl_core.imag_unit =
|
|
make_complex(make_shortfloat(0.0), make_shortfloat(1.0));
|
|
cl_core.minus_imag_unit =
|
|
make_complex(make_shortfloat(0.0), make_shortfloat(-1.0));
|
|
cl_core.imag_two =
|
|
make_complex(make_shortfloat(0.0), make_shortfloat(2.0));
|
|
|
|
ECL_SET(@'pi', make_longfloat(M_PI));
|
|
|
|
init_big();
|
|
|
|
ECL_SET(@'*random-state*', make_random_state(Ct));
|
|
}
|