#include "factor.h" BIGNUM* fixnum_to_bignum(CELL n); RATIO* fixnum_to_ratio(CELL n); FLOAT* fixnum_to_float(CELL n); FIXNUM bignum_to_fixnum(CELL tagged); RATIO* bignum_to_ratio(CELL n); FLOAT* bignum_to_float(CELL n); FLOAT* ratio_to_float(CELL n); #define CELL_TO_INTEGER(result) \ FIXNUM _result = (result); \ if(_result < FIXNUM_MIN || _result > FIXNUM_MAX) \ return tag_object(fixnum_to_bignum(_result)); \ else \ return tag_fixnum(_result); #define BIGNUM_2_TO_INTEGER(result) \ BIGNUM_2 _result = (result); \ if(_result < FIXNUM_MIN || _result > FIXNUM_MAX) \ return tag_object(bignum(_result)); \ else \ return tag_fixnum(_result); #define BINARY_OP(OP,anytype,integerOnly) \ CELL OP(CELL x, CELL y) \ { \ switch(type_of(x)) \ { \ case FIXNUM_TYPE: \ \ switch(type_of(y)) \ { \ case FIXNUM_TYPE: \ return OP##_fixnum(x,y); \ case RATIO_TYPE: \ if(integerOnly) \ { \ type_error(INTEGER_TYPE,y); \ return F; \ } \ else \ return OP##_ratio((CELL)fixnum_to_ratio(x),y); \ case COMPLEX_TYPE: \ if(integerOnly) \ { \ type_error(INTEGER_TYPE,y); \ return F; \ } \ else \ return OP##_complex((CELL)complex(x,tag_fixnum(0)),y); \ case BIGNUM_TYPE: \ return OP##_bignum((CELL)fixnum_to_bignum(x),y); \ case FLOAT_TYPE: \ if(integerOnly) \ { \ type_error(INTEGER_TYPE,y); \ return F; \ } \ else \ return OP##_float((CELL)fixnum_to_float(x),y); \ default: \ if(anytype) \ return OP##_anytype(x,y); \ else \ { \ type_error(NUMBER_TYPE,x); \ return F; \ } \ } \ \ case RATIO_TYPE: \ \ if(integerOnly) \ { \ type_error(INTEGER_TYPE,x); \ return F; \ } \ \ switch(type_of(y)) \ { \ case FIXNUM_TYPE: \ return OP##_ratio(x,(CELL)fixnum_to_ratio(y)); \ case RATIO_TYPE: \ return OP##_ratio(x,y); \ case COMPLEX_TYPE: \ return OP##_complex((CELL)complex(x,tag_fixnum(0)),y); \ case BIGNUM_TYPE: \ return OP##_ratio(x,(CELL)bignum_to_ratio(y)); \ case FLOAT_TYPE: \ return OP##_float((CELL)ratio_to_float(x),y); \ default: \ if(anytype) \ return OP##_anytype(x,y); \ else \ { \ type_error(NUMBER_TYPE,x); \ return F; \ } \ } \ \ case COMPLEX_TYPE: \ \ if(integerOnly) \ { \ type_error(INTEGER_TYPE,x); \ return F; \ } \ \ switch(type_of(y)) \ { \ case FIXNUM_TYPE: \ return OP##_complex(x,(CELL)complex(y,tag_fixnum(0))); \ case RATIO_TYPE: \ return OP##_complex(x,(CELL)complex(y,tag_fixnum(0))); \ case COMPLEX_TYPE: \ return OP##_complex(x,y); \ case BIGNUM_TYPE: \ return OP##_complex(x,(CELL)complex(y,tag_fixnum(0))); \ case FLOAT_TYPE: \ return OP##_complex(x,(CELL)complex(y,tag_fixnum(0))); \ default: \ if(anytype) \ return OP##_anytype(x,y); \ else \ { \ type_error(NUMBER_TYPE,x); \ return F; \ } \ } \ \ case BIGNUM_TYPE: \ \ switch(type_of(y)) \ { \ case FIXNUM_TYPE: \ return OP##_bignum(x,(CELL)fixnum_to_bignum(y)); \ case RATIO_TYPE: \ if(integerOnly) \ { \ type_error(INTEGER_TYPE,y); \ return F; \ } \ else \ return OP##_ratio((CELL)bignum_to_ratio(x),y); \ case COMPLEX_TYPE: \ if(integerOnly) \ { \ type_error(INTEGER_TYPE,y); \ return F; \ } \ else \ return OP##_complex((CELL)complex(x,tag_fixnum(0)),y); \ case BIGNUM_TYPE: \ return OP##_bignum(x,y); \ case FLOAT_TYPE: \ if(integerOnly) \ { \ type_error(INTEGER_TYPE,y); \ return F; \ } \ else \ return OP##_float((CELL)bignum_to_float(x),y); \ default: \ if(anytype) \ return OP##_anytype(x,y); \ else \ { \ type_error(NUMBER_TYPE,x); \ return F; \ } \ } \ \ case FLOAT_TYPE: \ \ if(integerOnly) \ { \ type_error(INTEGER_TYPE,x); \ return F; \ } \ \ switch(type_of(y)) \ { \ case FIXNUM_TYPE: \ return OP##_float(x,(CELL)fixnum_to_float(y)); \ case RATIO_TYPE: \ return OP##_float(x,(CELL)ratio_to_float(y)); \ case COMPLEX_TYPE: \ return OP##_complex((CELL)complex(x,tag_fixnum(0)),y); \ case BIGNUM_TYPE: \ return OP##_float(x,(CELL)bignum_to_float(y)); \ case FLOAT_TYPE: \ return OP##_float(x,y); \ default: \ if(anytype) \ return OP##_anytype(x,y); \ else \ { \ type_error(NUMBER_TYPE,x); \ return F; \ } \ } \ \ default: \ \ if(anytype) \ return OP##_anytype(x,y); \ else \ { \ type_error(NUMBER_TYPE,x); \ return F; \ } \ } \ } \ \ void primitive_##OP(void) \ { \ CELL x = dpop(), y = env.dt; \ env.dt = OP(x,y); \ } #define UNARY_OP(OP,anytype,integerOnly) \ CELL OP(CELL x) \ { \ switch(type_of(x)) \ { \ case FIXNUM_TYPE: \ return OP##_fixnum(x); \ case RATIO_TYPE: \ if(integerOnly) \ { \ type_error(INTEGER_TYPE,x); \ return F; \ } \ else \ return OP##_ratio(x); \ case COMPLEX_TYPE: \ if(integerOnly) \ { \ type_error(INTEGER_TYPE,x); \ return F; \ } \ else \ return OP##_complex(x); \ case BIGNUM_TYPE: \ return OP##_bignum(x); \ case FLOAT_TYPE: \ if(integerOnly) \ { \ type_error(INTEGER_TYPE,x); \ return F; \ } \ else \ return OP##_float(x); \ default: \ if(anytype) \ return OP##_anytype(x); \ else \ { \ type_error(NUMBER_TYPE,x); \ return F; \ } \ } \ } \ \ void primitive_##OP(void) \ { \ env.dt = OP(env.dt); \ } bool realp(CELL tagged); bool numberp(CELL tagged); void primitive_numberp(void); bool zerop(CELL tagged); FIXNUM to_fixnum(CELL tagged); void primitive_to_fixnum(void); BIGNUM* to_bignum(CELL tagged); void primitive_to_bignum(void); CELL to_integer(CELL tagged); void primitive_to_integer(void); CELL number_eq(CELL x, CELL y); void primitive_number_eq(void); CELL add(CELL x, CELL y); void primitive_add(void); CELL subtract(CELL x, CELL y); void primitive_subtract(void); CELL multiply(CELL x, CELL y); void primitive_multiply(void); CELL divide(CELL x, CELL y); void primitive_divmod(void); CELL divint(CELL x, CELL y); void primitive_divint(void); CELL divfloat(CELL x, CELL y); void primitive_divfloat(void); CELL divide(CELL x, CELL y); void primitive_divide(void); CELL less(CELL x, CELL y); void primitive_less(void); CELL lesseq(CELL x, CELL y); void primitive_lesseq(void); CELL greater(CELL x, CELL y); void primitive_greater(void); CELL greatereq(CELL x, CELL y); void primitive_greatereq(void); CELL mod(CELL x, CELL y); void primitive_mod(void); CELL and(CELL x, CELL y); void primitive_and(void); CELL or(CELL x, CELL y); void primitive_or(void); CELL xor(CELL x, CELL y); void primitive_xor(void); CELL shiftleft(CELL x, CELL y); void primitive_shiftleft(void); CELL shiftright(CELL x, CELL y); void primitive_shiftright(void); CELL gcd(CELL x, CELL y); void primitive_gcd(void);