From d7e02206742339adef9455c9c0b0f90219bec210 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 15 Feb 2026 13:30:27 +0000 Subject: [PATCH] Arithmetic equality fixed. --- src/arith/peano.c | 26 ++++++++++++++ src/arith/peano.h | 3 ++ src/arith/ratio.c | 90 +++++++++++++++++++++++++++++++++++++++++------ src/arith/ratio.h | 2 ++ src/init.c | 2 ++ src/ops/equal.c | 21 +++-------- 6 files changed, 117 insertions(+), 27 deletions(-) diff --git a/src/arith/peano.c b/src/arith/peano.c index ae23a00..1a43f55 100644 --- a/src/arith/peano.c +++ b/src/arith/peano.c @@ -748,3 +748,29 @@ struct cons_pointer lisp_divide( struct return result; } + +/** + * @brief Function: return a real (approcimately) equal in value to the ratio + * which is the first argument. + * + * @param frame + * @param frame_pointer + * @param env + * @return struct cons_pointer a pointer to a real + */ +// struct cons_pointer lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer, +// struct cons_pointer env ) +struct cons_pointer lisp_ratio_to_real( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env) { + struct cons_pointer result = NIL; + struct cons_pointer rat = frame->arg[0]; + + debug_print( L"\nc_ratio_to_ld: ", DEBUG_ARITH); + debug_print_object( rat, DEBUG_ARITH); + + if ( ratiop( rat)) { + result = make_real( c_ratio_to_ld( rat)); + } // TODO: else throw an exception? + + return result; +} \ No newline at end of file diff --git a/src/arith/peano.h b/src/arith/peano.h index 5e83f0c..8b2908c 100644 --- a/src/arith/peano.h +++ b/src/arith/peano.h @@ -75,4 +75,7 @@ struct cons_pointer lisp_divide( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); +struct cons_pointer lisp_ratio_to_real( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env); + #endif /* PEANO_H */ diff --git a/src/arith/ratio.c b/src/arith/ratio.c index 5608717..9c7c524 100644 --- a/src/arith/ratio.c +++ b/src/arith/ratio.c @@ -11,15 +11,17 @@ #include #include +#include "arith/integer.h" +#include "arith/peano.h" +#include "arith/ratio.h" +#include "arith/real.h" +#include "debug.h" +#include "io/print.h" #include "memory/conspage.h" #include "memory/consspaceobject.h" -#include "debug.h" +#include "memory/stack.h" #include "ops/equal.h" -#include "arith/integer.h" #include "ops/lispops.h" -#include "arith/peano.h" -#include "io/print.h" -#include "arith/ratio.h" /** @@ -91,11 +93,10 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer arg1, struct cons_pointer arg2 ) { struct cons_pointer r, result; - debug_print( L"add_ratio_ratio( arg1 = ", DEBUG_ARITH ); - debug_print_object( arg1, DEBUG_ARITH ); - debug_print( L"; arg2 = ", DEBUG_ARITH ); - debug_print_object( arg2, DEBUG_ARITH ); - debug_print( L")\n", DEBUG_ARITH ); + debug_print( L"\naadd_ratio_ratio: ", DEBUG_ARITH); + debug_print_object( arg1, DEBUG_ARITH); + debug_print( L" + ", DEBUG_ARITH); + debug_print_object( arg2, DEBUG_ARITH); if ( ratiop( arg1 ) && ratiop( arg2 ) ) { struct cons_space_object cell1 = pointer2cell( arg1 ); @@ -111,7 +112,7 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer arg1, lcm = least_common_multiple( dr1v, dr2v ), m1 = lcm / dr1v, m2 = lcm / dr2v; - debug_printf( DEBUG_ARITH, L"); lcm = %ld; m1 = %ld; m2 = %ld", lcm, + debug_printf( DEBUG_ARITH, L"; lcm = %ld; m1 = %ld; m2 = %ld", lcm, m1, m2 ); if ( dr1v == dr2v ) { @@ -170,6 +171,11 @@ struct cons_pointer add_integer_ratio( struct cons_pointer intarg, struct cons_pointer ratarg ) { struct cons_pointer result; + debug_print( L"\nadd_integer_ratio: ", DEBUG_ARITH); + debug_print_object( intarg, DEBUG_ARITH); + debug_print( L" + ", DEBUG_ARITH); + debug_print_object( ratarg, DEBUG_ARITH); + if ( integerp( intarg ) && ratiop( ratarg ) ) { // TODO: not longer works struct cons_pointer one = acquire_integer( 1, NIL ), @@ -188,6 +194,10 @@ struct cons_pointer add_integer_ratio( struct cons_pointer intarg, NIL ) ) ), NIL ); } + debug_print( L" => ", DEBUG_ARITH ); + debug_print_object( result, DEBUG_ARITH ); + debug_print( L"\n", DEBUG_ARITH ); + return result; } @@ -199,6 +209,10 @@ struct cons_pointer add_integer_ratio( struct cons_pointer intarg, */ struct cons_pointer divide_ratio_ratio( struct cons_pointer arg1, struct cons_pointer arg2 ) { + debug_print( L"\ndivide_ratio_ratio: ", DEBUG_ARITH); + debug_print_object( arg1, DEBUG_ARITH); + debug_print( L" / ", DEBUG_ARITH); + debug_print_object( arg2, DEBUG_ARITH); // TODO: this now has to work if `arg1` is an integer struct cons_pointer i = make_ratio( pointer2cell( arg2 ).payload.ratio.divisor, @@ -207,6 +221,10 @@ struct cons_pointer divide_ratio_ratio( struct cons_pointer arg1, dec_ref( i ); + debug_print( L" => ", DEBUG_ARITH ); + debug_print_object( result, DEBUG_ARITH ); + debug_print( L"\n", DEBUG_ARITH ); + return result; } @@ -259,6 +277,10 @@ struct cons_pointer multiply_ratio_ratio( struct NIL ); } + debug_print( L" => ", DEBUG_ARITH ); + debug_print_object( result, DEBUG_ARITH ); + debug_print( L"\n", DEBUG_ARITH ); + return result; } @@ -272,6 +294,11 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer intarg, struct cons_pointer ratarg ) { struct cons_pointer result; + debug_print( L"\nmultiply_integer_ratio: ", DEBUG_ARITH); + debug_print_object( intarg, DEBUG_ARITH); + debug_print( L" * ", DEBUG_ARITH); + debug_print_object( ratarg, DEBUG_ARITH); + if ( integerp( intarg ) && ratiop( ratarg ) ) { // TODO: no longer works; fix struct cons_pointer one = acquire_integer( 1, NIL ), @@ -286,6 +313,10 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer intarg, NIL ); } + debug_print( L" => ", DEBUG_ARITH ); + debug_print_object( result, DEBUG_ARITH ); + debug_print( L"\n", DEBUG_ARITH ); + return result; } @@ -298,6 +329,11 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer intarg, */ struct cons_pointer subtract_ratio_ratio( struct cons_pointer arg1, struct cons_pointer arg2 ) { + debug_print( L"\nsubtract_ratio_ratio: ", DEBUG_ARITH); + debug_print_object( arg1, DEBUG_ARITH); + debug_print( L" * ", DEBUG_ARITH); + debug_print_object( arg2, DEBUG_ARITH); + struct cons_pointer i = negative( arg2 ), result = add_ratio_ratio( arg1, i ); @@ -361,3 +397,35 @@ bool equal_ratio_ratio( struct cons_pointer a, struct cons_pointer b ) { return result; } + +/** + * @brief convert a ratio to an equivalent long double. + * + * @param rat a pointer to a ratio. + * @return long double + */ +long double c_ratio_to_ld( struct cons_pointer rat) { + long double result = NAN; + + debug_print( L"\nc_ratio_to_ld: ", DEBUG_ARITH); + debug_print_object( rat, DEBUG_ARITH); + + if ( ratiop( rat)) { + struct cons_space_object * cell_a = & pointer2cell( rat); + struct cons_pointer dv = cell_a->payload.ratio.divisor; + struct cons_space_object * dv_cell = &pointer2cell( dv); + struct cons_pointer dd = cell_a->payload.ratio.dividend; + struct cons_space_object * dd_cell = &pointer2cell( dd); + + if ( nilp( dv_cell->payload.integer.more) && nilp( dd_cell->payload.integer.more)) { + result = ((long double) dd_cell->payload.integer.value) / ((long double) dv_cell->payload.integer.value);; + } else { + fwprintf( stderr, L"real conversion is not yet implemented for bignums rationals."); + } + } + + debug_printf( DEBUG_ARITH, L"\nc_ratio_to_ld returning %d\n", result ); + + return result; +} + diff --git a/src/arith/ratio.h b/src/arith/ratio.h index 9068bfb..8d93f44 100644 --- a/src/arith/ratio.h +++ b/src/arith/ratio.h @@ -36,4 +36,6 @@ struct cons_pointer make_ratio( struct cons_pointer dividend, bool equal_ratio_ratio( struct cons_pointer a, struct cons_pointer b ); +long double c_ratio_to_ld( struct cons_pointer rat); + #endif diff --git a/src/init.c b/src/init.c index 912ba45..2d3d394 100644 --- a/src/init.c +++ b/src/init.c @@ -20,6 +20,7 @@ /* libcurl, used for io */ #include +#include "arith/ratio.h" #include "version.h" #include "memory/conspage.h" #include "memory/consspaceobject.h" @@ -347,6 +348,7 @@ int main( int argc, char *argv[] ) { bind_function( L"print", &lisp_print ); bind_function( L"put!", lisp_hashmap_put ); bind_function( L"put-all!", &lisp_hashmap_put_all ); + bind_function( L"ratio->real", &lisp_ratio_to_real ); bind_function( L"read", &lisp_read ); bind_function( L"read-char", &lisp_read_char ); bind_function( L"repl", &lisp_repl ); diff --git a/src/ops/equal.c b/src/ops/equal.c index 4c713e8..0b21060 100644 --- a/src/ops/equal.c +++ b/src/ops/equal.c @@ -51,11 +51,11 @@ bool end_of_string( struct cons_pointer string ) { /** * @brief compare two long doubles and returns true if they are the same to - * within a tolerance of one part in a million. + * within a tolerance of one part in a billion. * * @param a * @param b - * @return true if `a` and `b` are equal to within one part in a million. + * @return true if `a` and `b` are equal to within one part in a billion. * @return false otherwise. */ bool equal_ld_ld( long double a, long double b) { @@ -66,7 +66,7 @@ bool equal_ld_ld( long double a, long double b) { /* average magnitude of the two */ long double av = (fa > fb) ? ( fa - diff) : ( fb - diff); /* amount of difference we will tolerate for equality */ - long double tolerance = av * 0.0000001; + long double tolerance = av * 0.000000001; bool result = ( fabsl( a - b) < tolerance); @@ -164,20 +164,9 @@ bool equal_real_number( struct cons_pointer a, struct cons_pointer b) { result = equal_ld_ld( cell_a->payload.real.value, cell_b->payload.real.value); } break; - case RATIOTV: { + case RATIOTV: struct cons_space_object * cell_a = & pointer2cell( a); - struct cons_pointer dv = cell_a->payload.ratio.divisor; - struct cons_space_object * dv_cell = &pointer2cell( dv); - struct cons_pointer dd = cell_a->payload.ratio.dividend; - struct cons_space_object * dd_cell = &pointer2cell( dd); - - if ( nilp( dv_cell->payload.integer.more) && nilp( dd_cell->payload.integer.more)) { - long double bv = ((long double) dv_cell->payload.integer.value) / ((long double) dd_cell->payload.integer.value); - result = equal_ld_ld( bv, cell_a->payload.real.value); - } else { - fwprintf( stderr, L"\nequality is not yet implemented for bignums rationals compared to reals."); - } - } + result = equal_ld_ld( c_ratio_to_ld( b), cell_a->payload.real.value); break; }