simon/post-scarcity
1
0
Fork 0
Code Issues 14 Pull requests Projects Releases Packages Wiki Activity Actions

Arithmetic equality fixed.

Browse source
This commit is contained in:
Simon Brooke 2026-02-15 13:30:27 +00:00
parent b97401bfde
commit d7e0220674
6 changed files with 117 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

90
src/arith/ratio.c
View file

@ -11,15 +11,17 @@
#include <math.h>
#include <stdio.h>
#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;
}