From ea1d4ce7ed0812fb6692f1e4a97be6377063a7c8 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 23 Dec 2018 19:23:00 +0000 Subject: [PATCH] Doesn't compile, but I have a mess. --- src/peano.c | 301 +++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 217 insertions(+), 84 deletions(-) diff --git a/src/peano.c b/src/peano.c index 691c95f..9d272df 100644 --- a/src/peano.c +++ b/src/peano.c @@ -25,35 +25,163 @@ #include "real.h" #include "stack.h" -/** - * Internal guts of add. Dark and mysterious. - */ -struct cons_pointer add_accumulate( struct cons_pointer arg, - struct stack_frame *frame, - long int *i_accumulator, - long double *d_accumulator, int *is_int ) { - struct cons_pointer result = NIL; +long double to_long_double( struct cons_pointer arg ); +long int to_long_int( struct stack_frame *frame, struct cons_pointer arg ); + + +bool zerop( struct cons_pointer arg ) { + bool result = false; struct cons_space_object cell = pointer2cell( arg ); switch ( cell.tag.value ) { case INTEGERTV: - ( *i_accumulator ) += cell.payload.integer.value; - ( *d_accumulator ) += numeric_value( arg ); + result = cell.payload.integer.value == 0; + break; + case RATIOTV: + result = zerop( cell.payload.ratio.dividend ); break; case REALTV: - ( *d_accumulator ) += cell.payload.real.value; - ( *is_int ) &= false; + result = ( cell.payload.real.value == 0 ); 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; - default: - result = lisp_throw( c_string_to_lisp_string - ( "Cannot multiply: not a number" ), frame ); } 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 @@ -61,48 +189,38 @@ struct cons_pointer add_accumulate( struct cons_pointer arg, * @param frame the stack frame. * @return a pointer to an integer or real. */ -struct cons_pointer -lisp_add( struct stack_frame *frame, struct cons_pointer env ) { +struct cons_pointer lisp_add( struct stack_frame + *frame, struct + cons_pointer env ) { struct cons_pointer result = NIL; - long int i_accumulator = 0; - long double d_accumulator = 0; - int is_int = true; - + struct cons_pointer result = make_integer( 0 ); for ( int i = 0; i < args_in_frame && !nilp( frame->arg[i] ); i++ ) { - result = - add_accumulate( frame->arg[i], frame, &i_accumulator, - &d_accumulator, &is_int ); + result = add_q( frame, result, frame->arg[i] ); } struct cons_pointer more = frame->more; - while ( consp( more ) ) { - result = - add_accumulate( c_car( more ), frame, &i_accumulator, - &d_accumulator, &is_int ); + result = add_2( frame, result, c _car( more ) ); more = c_cdr( more ); } - if ( is_int ) { - result = make_integer( i_accumulator ); - } else { - result = make_real( d_accumulator ); - } - return result; } /** * Internal guts of multiply. Dark and mysterious. */ -struct cons_pointer multiply_accumulate( struct cons_pointer arg, - struct stack_frame *frame, - long int *i_accumulator, - long double *d_accumulator, - int *is_int ) { +struct cons_pointer multiply_accumulate( struct + cons_pointer arg, struct + stack_frame + *frame, long + int + *i_accumulator, long + double + *d_accumulator, int + *is_int ) { struct cons_pointer result = NIL; struct cons_space_object cell = pointer2cell( arg ); - switch ( cell.tag.value ) { case INTEGERTV: ( *i_accumulator ) *= cell.payload.integer.value; @@ -116,8 +234,10 @@ struct cons_pointer multiply_accumulate( struct cons_pointer arg, result = arg; break; default: - result = lisp_throw( c_string_to_lisp_string - ( "Cannot multiply: not a number" ), frame ); + result = + lisp_throw + ( c_string_to_lisp_string + ( "Cannot multiply: not a number" ), frame ); } return result; } @@ -128,27 +248,30 @@ struct cons_pointer multiply_accumulate( struct cons_pointer arg, * @param frame the stack frame. * @return a pointer to an integer or real. */ -struct cons_pointer -lisp_multiply( struct stack_frame *frame, struct cons_pointer env ) { +struct cons_pointer lisp_multiply( struct + stack_frame + *frame, struct + cons_pointer env ) { struct cons_pointer result = NIL; long int i_accumulator = 1; long double d_accumulator = 1; int is_int = true; - - for ( int i = 0; - i < args_in_frame && !nilp( frame->arg[i] ) && !exceptionp( result ); - i++ ) { + for ( int i = 0; i < args_in_frame && !nilp( frame->arg[i] ) + && !exceptionp( result ); i++ ) { result = - multiply_accumulate( frame->arg[i], frame, &i_accumulator, - &d_accumulator, &is_int ); + multiply_accumulate( frame->arg[i], + frame, + &i_accumulator, &d_accumulator, &is_int ); } struct cons_pointer more = frame->more; - - while ( consp( more ) && !exceptionp( result ) ) { + while ( consp( more ) + && !exceptionp( result ) ) { result = - multiply_accumulate( c_car( more ), frame, &i_accumulator, - &d_accumulator, &is_int ); + multiply_accumulate( c_car + ( more ), + frame, + &i_accumulator, &d_accumulator, &is_int ); more = c_cdr( more ); } @@ -169,32 +292,37 @@ lisp_multiply( struct stack_frame *frame, struct cons_pointer env ) { * @param frame the stack frame. * @return a pointer to an integer or real. */ -struct cons_pointer -lisp_subtract( struct stack_frame *frame, struct cons_pointer env ) { +struct cons_pointer lisp_subtract( struct + stack_frame + *frame, struct + cons_pointer env ) { struct cons_pointer result = NIL; - struct cons_space_object arg0 = pointer2cell( frame->arg[0] ); struct cons_space_object arg1 = pointer2cell( frame->arg[1] ); - - if ( integerp( frame->arg[0] ) && integerp( frame->arg[1] ) ) { + if ( integerp( frame->arg[0] ) + && integerp( frame->arg[1] ) ) { result = - make_integer( arg0.payload.integer.value - - arg1.payload.integer.value ); - } else if ( realp( frame->arg[0] ) && realp( frame->arg[1] ) ) { + make_integer( arg0.payload.integer.value + - arg1.payload.integer.value ); + } else if ( realp( frame->arg[0] ) + && realp( frame->arg[1] ) ) { result = 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 = - make_real( numeric_value( frame->arg[0] ) - - arg1.payload.real.value ); - } else if ( realp( frame->arg[0] ) && integerp( frame->arg[1] ) ) { + make_real( numeric_value + ( frame->arg[0] ) - arg1.payload.real.value ); + } else if ( realp( frame->arg[0] ) + && integerp( frame->arg[1] ) ) { result = make_real( arg0.payload.real.value - numeric_value( frame->arg[1] ) ); } else { /* TODO: throw an exception */ - lisp_throw( c_string_to_lisp_string - ( "Cannot subtract: not a number" ), frame ); + lisp_throw + ( c_string_to_lisp_string + ( "Cannot subtract: not a number" ), frame ); } // and if not nilp[frame->arg[2]) we also have an error. @@ -208,29 +336,34 @@ lisp_subtract( struct stack_frame *frame, struct cons_pointer env ) { * @param frame the stack frame. * @return a pointer to an integer or real. */ -struct cons_pointer -lisp_divide( struct stack_frame *frame, struct cons_pointer env ) { +struct cons_pointer lisp_divide( struct + stack_frame + *frame, struct + cons_pointer env ) { struct cons_pointer result = NIL; - struct cons_space_object arg0 = pointer2cell( frame->arg[0] ); struct cons_space_object arg1 = pointer2cell( frame->arg[1] ); - - if ( numberp( frame->arg[1] ) && numeric_value( frame->arg[1] ) == 0 ) { - lisp_throw( c_string_to_lisp_string - ( "Cannot divide: divisor is zero" ), frame ); - } else if ( numberp( frame->arg[0] ) && numberp( frame->arg[1] ) ) { - long int i = ( long int ) numeric_value( frame->arg[0] ) / - numeric_value( frame->arg[1] ); - long double r = ( long double ) numeric_value( frame->arg[0] ) / - numeric_value( frame->arg[1] ); + if ( numberp( frame->arg[1] ) + && numeric_value( frame->arg[1] ) == 0 ) { + lisp_throw + ( c_string_to_lisp_string + ( "Cannot divide: divisor is zero" ), frame ); + } else if ( numberp( frame->arg[0] ) + && numberp( frame->arg[1] ) ) { + long int i = ( long int ) + numeric_value( frame->arg[0] ) / 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 ) { result = make_integer( i ); } else { result = make_real( r ); } } else { - lisp_throw( c_string_to_lisp_string - ( "Cannot divide: not a number" ), frame ); + lisp_throw + ( c_string_to_lisp_string + ( "Cannot divide: not a number" ), frame ); } return result;