Doesn't compile, but I have a mess.

This commit is contained in:
Simon Brooke 2018-12-23 19:23:00 +00:00
parent 2c001a5f98
commit ea1d4ce7ed

View file

@ -25,35 +25,163 @@
#include "real.h" #include "real.h"
#include "stack.h" #include "stack.h"
/** long double to_long_double( struct cons_pointer arg );
* Internal guts of add. Dark and mysterious. long int to_long_int( struct stack_frame *frame, struct cons_pointer arg );
*/
struct cons_pointer add_accumulate( struct cons_pointer arg,
struct stack_frame *frame, bool zerop( struct cons_pointer arg ) {
long int *i_accumulator, bool result = false;
long double *d_accumulator, int *is_int ) {
struct cons_pointer result = NIL;
struct cons_space_object cell = pointer2cell( arg ); struct cons_space_object cell = pointer2cell( arg );
switch ( cell.tag.value ) { switch ( cell.tag.value ) {
case INTEGERTV: case INTEGERTV:
( *i_accumulator ) += cell.payload.integer.value; result = cell.payload.integer.value == 0;
( *d_accumulator ) += numeric_value( arg ); break;
case RATIOTV:
result = zerop( cell.payload.ratio.dividend );
break; break;
case REALTV: case REALTV:
( *d_accumulator ) += cell.payload.real.value; result = ( cell.payload.real.value == 0 );
( *is_int ) &= false;
break; break;
case EXCEPTIONTV: }
result = arg;
return result;
}
/**
* TODO: cannot throw an exception out of here, which is a problem
* if a ratio may legally have zero as a divisor, or something which is
* not a number is passed in.
*/
long double to_long_double( struct cons_pointer arg ) {
long double result = NAN; /* not a number, as a long double */
struct cons_space_object cell = pointer2cell( arg );
switch ( cell.tag.value ) {
case INTEGERTV:
result = cell.payload.integer.value * 1.0;
case RATIOTV:
{
struct cons_space_object dividend =
pointer2cell( cell.payload.ratio.dividend );
struct cons_space_object divisor =
pointer2cell( cell.payload.ratio.divisor );
result =
dividend.payload.integer.value /
divisor.payload.integer.value;
}
break;
case REALTV:
result = cell.payload.real.value;
break;
}
return result;
}
/**
* TODO: cannot throw an exception out of here, which is a problem
* if a ratio may legally have zero as a divisor, or something which is
* not a number (or is a big number) is passed in.
*/
long int to_long_int( struct stack_frame *frame, struct cons_pointer arg ) {
long int result = 0;
struct cons_space_object cell = pointer2cell( arg );
switch ( cell.tag.value ) {
case INTEGERTV:
result = cell.payload.integer.value;
break;
case RATIOTV:
result = lroundl( to_long_double( arg ) );
break;
case REALTV:
result = lroundl( cell.payload.real.value );
break; break;
default:
result = lisp_throw( c_string_to_lisp_string
( "Cannot multiply: not a number" ), frame );
} }
return result; return result;
} }
long int greatest_common_divisor( long int m, long int n ) {
int o;
while ( m ) {
o = m;
m = n % m;
n = o;
}
return o;
}
long int least_common_multiplier( long int m, long int n ) {
return m / greatest_common_divisor( m, n ) * n;
}
/**
* return a cons_pointer indicating a number which is the sum of
* the numbers indicated by `arg1` and `arg2`.
*/
struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer arg1,
struct cons_pointer arg2 ) {
struct cons_pointer result;
struct cons_space_object cell1 = pointer2cell( arg1 );
struct cons_space_object cell2 = pointer2cell( arg2 );
if ( zerop( arg1 ) ) {
result = arg2;
} else if ( zerop( arg2 ) ) {
result = arg1;
} else {
switch ( cell1.tag.value ) {
case EXCEPTIONTV:
result = cell1;
break;
case INTEGERTV:
switch ( cell2.tag.value ) {
case EXCEPTIONTV:
result = cell2;
break;
case INTEGERTV:
make_integer( cell1.payload.integer.value +
cell2.payload.integer.value );
break;
case RATIOTV:
result = add_integer_ratio( arg1, arg2 );
break;
case REALTV:
result =
make_real( cell1.payload.integer.value +
cell2.payload.real.value );
break;
default:
result = lisp_throw( c_string_to_lisp_string
( "Cannot add: not a number" ),
frame );
}
break;
case RATIOTV:
switch ( cell2.tag.value ) {
case EXCEPTIONTV:
result = cell2;
break;
case INTEGERTV:
result = add_integer_ratio( arg1, arg2 );
break;
case RATIOTV:
break;
case REALTV:
result =
make_real( cell2.payload.real.value +
ratio_to_long_double( arg1 ) );
break;
}
}
}
return result;
}
/** /**
* Add an indefinite number of numbers together * Add an indefinite number of numbers together
@ -61,48 +189,38 @@ struct cons_pointer add_accumulate( struct cons_pointer arg,
* @param frame the stack frame. * @param frame the stack frame.
* @return a pointer to an integer or real. * @return a pointer to an integer or real.
*/ */
struct cons_pointer struct cons_pointer lisp_add( struct stack_frame
lisp_add( struct stack_frame *frame, struct cons_pointer env ) { *frame, struct
cons_pointer env ) {
struct cons_pointer result = NIL; struct cons_pointer result = NIL;
long int i_accumulator = 0; struct cons_pointer result = make_integer( 0 );
long double d_accumulator = 0;
int is_int = true;
for ( int i = 0; i < args_in_frame && !nilp( frame->arg[i] ); i++ ) { for ( int i = 0; i < args_in_frame && !nilp( frame->arg[i] ); i++ ) {
result = result = add_q( frame, result, frame->arg[i] );
add_accumulate( frame->arg[i], frame, &i_accumulator,
&d_accumulator, &is_int );
} }
struct cons_pointer more = frame->more; struct cons_pointer more = frame->more;
while ( consp( more ) ) { while ( consp( more ) ) {
result = result = add_2( frame, result, c _car( more ) );
add_accumulate( c_car( more ), frame, &i_accumulator,
&d_accumulator, &is_int );
more = c_cdr( more ); more = c_cdr( more );
} }
if ( is_int ) {
result = make_integer( i_accumulator );
} else {
result = make_real( d_accumulator );
}
return result; return result;
} }
/** /**
* Internal guts of multiply. Dark and mysterious. * Internal guts of multiply. Dark and mysterious.
*/ */
struct cons_pointer multiply_accumulate( struct cons_pointer arg, struct cons_pointer multiply_accumulate( struct
struct stack_frame *frame, cons_pointer arg, struct
long int *i_accumulator, stack_frame
long double *d_accumulator, *frame, long
int *is_int ) { int
*i_accumulator, long
double
*d_accumulator, int
*is_int ) {
struct cons_pointer result = NIL; struct cons_pointer result = NIL;
struct cons_space_object cell = pointer2cell( arg ); struct cons_space_object cell = pointer2cell( arg );
switch ( cell.tag.value ) { switch ( cell.tag.value ) {
case INTEGERTV: case INTEGERTV:
( *i_accumulator ) *= cell.payload.integer.value; ( *i_accumulator ) *= cell.payload.integer.value;
@ -116,7 +234,9 @@ struct cons_pointer multiply_accumulate( struct cons_pointer arg,
result = arg; result = arg;
break; break;
default: default:
result = lisp_throw( c_string_to_lisp_string result =
lisp_throw
( c_string_to_lisp_string
( "Cannot multiply: not a number" ), frame ); ( "Cannot multiply: not a number" ), frame );
} }
return result; return result;
@ -128,27 +248,30 @@ struct cons_pointer multiply_accumulate( struct cons_pointer arg,
* @param frame the stack frame. * @param frame the stack frame.
* @return a pointer to an integer or real. * @return a pointer to an integer or real.
*/ */
struct cons_pointer struct cons_pointer lisp_multiply( struct
lisp_multiply( struct stack_frame *frame, struct cons_pointer env ) { stack_frame
*frame, struct
cons_pointer env ) {
struct cons_pointer result = NIL; struct cons_pointer result = NIL;
long int i_accumulator = 1; long int i_accumulator = 1;
long double d_accumulator = 1; long double d_accumulator = 1;
int is_int = true; int is_int = true;
for ( int i = 0; i < args_in_frame && !nilp( frame->arg[i] )
for ( int i = 0; && !exceptionp( result ); i++ ) {
i < args_in_frame && !nilp( frame->arg[i] ) && !exceptionp( result );
i++ ) {
result = result =
multiply_accumulate( frame->arg[i], frame, &i_accumulator, multiply_accumulate( frame->arg[i],
&d_accumulator, &is_int ); frame,
&i_accumulator, &d_accumulator, &is_int );
} }
struct cons_pointer more = frame->more; struct cons_pointer more = frame->more;
while ( consp( more )
while ( consp( more ) && !exceptionp( result ) ) { && !exceptionp( result ) ) {
result = result =
multiply_accumulate( c_car( more ), frame, &i_accumulator, multiply_accumulate( c_car
&d_accumulator, &is_int ); ( more ),
frame,
&i_accumulator, &d_accumulator, &is_int );
more = c_cdr( more ); more = c_cdr( more );
} }
@ -169,31 +292,36 @@ lisp_multiply( struct stack_frame *frame, struct cons_pointer env ) {
* @param frame the stack frame. * @param frame the stack frame.
* @return a pointer to an integer or real. * @return a pointer to an integer or real.
*/ */
struct cons_pointer struct cons_pointer lisp_subtract( struct
lisp_subtract( struct stack_frame *frame, struct cons_pointer env ) { stack_frame
*frame, struct
cons_pointer env ) {
struct cons_pointer result = NIL; struct cons_pointer result = NIL;
struct cons_space_object arg0 = pointer2cell( frame->arg[0] ); struct cons_space_object arg0 = pointer2cell( frame->arg[0] );
struct cons_space_object arg1 = pointer2cell( frame->arg[1] ); struct cons_space_object arg1 = pointer2cell( frame->arg[1] );
if ( integerp( frame->arg[0] )
if ( integerp( frame->arg[0] ) && integerp( frame->arg[1] ) ) { && integerp( frame->arg[1] ) ) {
result = result =
make_integer( arg0.payload.integer.value - make_integer( arg0.payload.integer.value
arg1.payload.integer.value ); - arg1.payload.integer.value );
} else if ( realp( frame->arg[0] ) && realp( frame->arg[1] ) ) { } else if ( realp( frame->arg[0] )
&& realp( frame->arg[1] ) ) {
result = result =
make_real( arg0.payload.real.value - arg1.payload.real.value ); make_real( arg0.payload.real.value - arg1.payload.real.value );
} else if ( integerp( frame->arg[0] ) && realp( frame->arg[1] ) ) { } else if ( integerp( frame->arg[0] )
&& realp( frame->arg[1] ) ) {
result = result =
make_real( numeric_value( frame->arg[0] ) - make_real( numeric_value
arg1.payload.real.value ); ( frame->arg[0] ) - arg1.payload.real.value );
} else if ( realp( frame->arg[0] ) && integerp( frame->arg[1] ) ) { } else if ( realp( frame->arg[0] )
&& integerp( frame->arg[1] ) ) {
result = result =
make_real( arg0.payload.real.value - make_real( arg0.payload.real.value -
numeric_value( frame->arg[1] ) ); numeric_value( frame->arg[1] ) );
} else { } else {
/* TODO: throw an exception */ /* TODO: throw an exception */
lisp_throw( c_string_to_lisp_string lisp_throw
( c_string_to_lisp_string
( "Cannot subtract: not a number" ), frame ); ( "Cannot subtract: not a number" ), frame );
} }
@ -208,28 +336,33 @@ lisp_subtract( struct stack_frame *frame, struct cons_pointer env ) {
* @param frame the stack frame. * @param frame the stack frame.
* @return a pointer to an integer or real. * @return a pointer to an integer or real.
*/ */
struct cons_pointer struct cons_pointer lisp_divide( struct
lisp_divide( struct stack_frame *frame, struct cons_pointer env ) { stack_frame
*frame, struct
cons_pointer env ) {
struct cons_pointer result = NIL; struct cons_pointer result = NIL;
struct cons_space_object arg0 = pointer2cell( frame->arg[0] ); struct cons_space_object arg0 = pointer2cell( frame->arg[0] );
struct cons_space_object arg1 = pointer2cell( frame->arg[1] ); struct cons_space_object arg1 = pointer2cell( frame->arg[1] );
if ( numberp( frame->arg[1] )
if ( numberp( frame->arg[1] ) && numeric_value( frame->arg[1] ) == 0 ) { && numeric_value( frame->arg[1] ) == 0 ) {
lisp_throw( c_string_to_lisp_string lisp_throw
( c_string_to_lisp_string
( "Cannot divide: divisor is zero" ), frame ); ( "Cannot divide: divisor is zero" ), frame );
} else if ( numberp( frame->arg[0] ) && numberp( frame->arg[1] ) ) { } else if ( numberp( frame->arg[0] )
long int i = ( long int ) numeric_value( frame->arg[0] ) / && numberp( frame->arg[1] ) ) {
numeric_value( frame->arg[1] ); long int i = ( long int )
long double r = ( long double ) numeric_value( frame->arg[0] ) / numeric_value( frame->arg[0] ) / numeric_value( frame->arg[1] );
numeric_value( frame->arg[1] ); long double r = ( long double )
numeric_value( frame->arg[0] )
/ numeric_value( frame->arg[1] );
if ( fabsl( ( long double ) i - r ) < 0.0000000001 ) { if ( fabsl( ( long double ) i - r ) < 0.0000000001 ) {
result = make_integer( i ); result = make_integer( i );
} else { } else {
result = make_real( r ); result = make_real( r );
} }
} else { } else {
lisp_throw( c_string_to_lisp_string lisp_throw
( c_string_to_lisp_string
( "Cannot divide: not a number" ), frame ); ( "Cannot divide: not a number" ), frame );
} }