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

Added a flag, simplify to the arg list of make_ratio, so that we can

Browse source 
create ratios which would otherwise somplify to integers, in order to
make ratio arithmetic easier.
This commit is contained in:
Simon Brooke 2026-02-15 23:47:28 +00:00
parent 169afc9eb4
commit 8629e33f92
11 changed files with 213 additions and 180 deletions
Download patch file Download diff file Expand all files Collapse all files

43
src/arith/peano.c
View file

@ -99,7 +99,7 @@ struct cons_pointer absolute( struct cons_pointer arg ) {
break;
case RATIOTV:
result = make_ratio( absolute( cell.payload.ratio.dividend ),
cell.payload.ratio.divisor );
cell.payload.ratio.divisor, false );
break;
case REALTV:
result = make_real( 0 - cell.payload.real.value );
@ -504,7 +504,7 @@ struct cons_pointer negative( struct cons_pointer arg ) {
break;
case RATIOTV:
result = make_ratio( negative( cell.payload.ratio.dividend ),
cell.payload.ratio.divisor );
cell.payload.ratio.divisor, false );
break;
case REALTV:
result = make_real( 0 - to_long_double( arg ) );
@ -566,7 +566,7 @@ struct cons_pointer subtract_2( struct stack_frame *frame,
case RATIOTV:{
struct cons_pointer tmp = make_ratio( arg1,
make_integer( 1,
NIL ) );
NIL ), false );
inc_ref( tmp );
result = subtract_ratio_ratio( tmp, arg2 );
dec_ref( tmp );
@ -592,7 +592,7 @@ struct cons_pointer subtract_2( struct stack_frame *frame,
case INTEGERTV:{
struct cons_pointer tmp = make_ratio( arg2,
make_integer( 1,
NIL ) );
NIL ), false );
inc_ref( tmp );
result = subtract_ratio_ratio( arg1, tmp );
dec_ref( tmp );
@ -670,21 +670,15 @@ struct cons_pointer lisp_divide( struct
result = frame->arg[1];
break;
case INTEGERTV:{
struct cons_pointer unsimplified =
result =
make_ratio( frame->arg[0],
frame->arg[1] );
/* OK, if result may be unsimplified, we should not inc_ref it
* - but if not, we should dec_ref it. */
result = simplify_ratio( unsimplified );
if ( !eq( unsimplified, result ) ) {
dec_ref( unsimplified );
}
frame->arg[1], true);
}
break;
case RATIOTV:{
struct cons_pointer one = make_integer( 1, NIL );
struct cons_pointer ratio =
make_ratio( frame->arg[0], one );
make_ratio( frame->arg[0], one, false );
inc_ref( ratio );
result = divide_ratio_ratio( ratio, frame->arg[1] );
dec_ref( ratio );
@ -709,11 +703,9 @@ struct cons_pointer lisp_divide( struct
break;
case INTEGERTV:{
struct cons_pointer one = make_integer( 1, NIL );
inc_ref( one );
struct cons_pointer ratio =
make_ratio( frame->arg[1], one );
inc_ref( ratio );
result = divide_ratio_ratio( frame->arg[0], ratio );
make_ratio( frame->arg[1], one, false);
result = divide_ratio_ratio( frame->arg[0], ratio );
dec_ref( ratio );
dec_ref( one );
}
@ -760,17 +752,18 @@ struct cons_pointer lisp_divide( struct
*/
// 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 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);
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?
if ( ratiop( rat ) ) {
result = make_real( c_ratio_to_ld( rat ) );
} // TODO: else throw an exception?
return result;
}
}

5
src/arith/peano.h
View file

@ -75,7 +75,8 @@ 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);
struct cons_pointer lisp_ratio_to_real( struct stack_frame *frame,
struct cons_pointer frame_pointer,
struct cons_pointer env );
#endif /* PEANO_H */

140
src/arith/ratio.c
View file

@ -64,14 +64,15 @@ struct cons_pointer simplify_ratio( struct cons_pointer pointer ) {
if ( gcd > 1 ) {
if ( drrv / gcd == 1 ) {
result = acquire_integer( (int64_t)(ddrv / gcd), NIL );
result =
acquire_integer( ( int64_t ) ( ddrv / gcd ), NIL );
} else {
debug_printf( DEBUG_ARITH,
L"simplify_ratio: %ld/%ld => %ld/%ld\n",
ddrv, drrv, ddrv / gcd, drrv / gcd );
result =
make_ratio( acquire_integer( ddrv / gcd, NIL ),
acquire_integer( drrv / gcd, NIL ) );
acquire_integer( drrv / gcd, NIL ), false);
}
}
}
@ -93,25 +94,26 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer arg1,
struct cons_pointer arg2 ) {
struct cons_pointer r;
debug_print( L"\nadd_ratio_ratio: ", DEBUG_ARITH);
debug_print_object( arg1, DEBUG_ARITH);
debug_print( L" + ", DEBUG_ARITH);
debug_print_object( arg2, DEBUG_ARITH);
debug_print( L"\nadd_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 );
struct cons_space_object * cell2 = &pointer2cell( arg2 );
struct cons_pointer divisor = multiply_integers( cell1->payload.ratio.divisor, cell2->payload.ratio.divisor );
struct cons_pointer dividend = add_integers(
multiply_integers( cell1->payload.ratio.dividend,
cell2->payload.ratio.divisor),
multiply_integers( cell2->payload.ratio.dividend,
cell1->payload.ratio.divisor));
r = make_ratio( dividend, divisor );
struct cons_space_object *cell1 = &pointer2cell( arg1 );
struct cons_space_object *cell2 = &pointer2cell( arg2 );
struct cons_pointer divisor =
multiply_integers( cell1->payload.ratio.divisor,
cell2->payload.ratio.divisor );
struct cons_pointer dividend =
add_integers( multiply_integers( cell1->payload.ratio.dividend,
cell2->payload.ratio.divisor ),
multiply_integers( cell2->payload.ratio.dividend,
cell1->payload.ratio.divisor ) );
r = make_ratio( dividend, divisor, true );
} else {
r =
throw_exception( make_cons( c_string_to_lisp_string
r = throw_exception( make_cons( c_string_to_lisp_string
( L"Shouldn't happen: bad arg to add_ratio_ratio" ),
make_cons( arg1,
make_cons( arg2, NIL ) ) ),
@ -136,15 +138,14 @@ 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);
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 ),
ratio = make_ratio( intarg, one );
ratio = make_ratio( intarg, one, false );
result = add_ratio_ratio( ratio, ratarg );
@ -174,14 +175,14 @@ 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);
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,
pointer2cell( arg2 ).payload.ratio.dividend ), result =
pointer2cell( arg2 ).payload.ratio.dividend, false ), result =
multiply_ratio_ratio( arg1, i );
dec_ref( i );
@ -226,15 +227,10 @@ struct cons_pointer multiply_ratio_ratio( struct
struct cons_pointer dividend = acquire_integer( ddrv, NIL );
struct cons_pointer divisor = acquire_integer( drrv, NIL );
struct cons_pointer unsimplified = make_ratio( dividend, divisor );
result = simplify_ratio( unsimplified );
result = make_ratio( dividend, divisor, true );
release_integer( dividend );
release_integer( divisor );
if ( !eq( unsimplified, result ) ) {
dec_ref( unsimplified );
}
} else {
result =
throw_exception( c_string_to_lisp_string
@ -259,15 +255,14 @@ 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);
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 ),
ratio = make_ratio( intarg, one );
ratio = make_ratio( intarg, one, false );
result = multiply_ratio_ratio( ratio, ratarg );
release_integer( one );
@ -294,10 +289,10 @@ 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);
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 );
@ -315,7 +310,14 @@ struct cons_pointer subtract_ratio_ratio( struct cons_pointer arg1,
* @exception if either `dividend` or `divisor` is not an integer.
*/
struct cons_pointer make_ratio( struct cons_pointer dividend,
struct cons_pointer divisor ) {
struct cons_pointer divisor,
bool simplify ) {
debug_print( L"make_ratio: dividend = ", DEBUG_ALLOC);
debug_print_object( dividend, DEBUG_ALLOC);
debug_print( L"; divisor = ", DEBUG_ALLOC);
debug_print_object( divisor, DEBUG_ALLOC);
debug_printf( DEBUG_ALLOC, L"; simplify = %d\n", simplify);
struct cons_pointer result;
if ( integerp( dividend ) && integerp( divisor ) ) {
inc_ref( dividend );
@ -325,9 +327,13 @@ struct cons_pointer make_ratio( struct cons_pointer dividend,
cell->payload.ratio.dividend = dividend;
cell->payload.ratio.divisor = divisor;
result = simplify_ratio( unsimplified );
if ( !eq( result, unsimplified ) ) {
dec_ref( unsimplified );
if ( simplify) {
result = simplify_ratio( unsimplified );
if ( !eq( result, unsimplified ) ) {
dec_ref( unsimplified );
}
} else {
result = unsimplified;
}
} else {
result =
@ -335,8 +341,9 @@ struct cons_pointer make_ratio( struct cons_pointer dividend,
( L"Dividend and divisor of a ratio must be integers" ),
NIL );
}
// debug_print( L"make_ratio returning:\n", DEBUG_ARITH);
debug_dump_object( result, DEBUG_ARITH );
debug_print( L" => ", DEBUG_ALLOC);
debug_print_object( result, DEBUG_ALLOC );
debug_println( DEBUG_ALLOC);
return result;
}
@ -369,28 +376,31 @@ bool equal_ratio_ratio( struct cons_pointer a, struct cons_pointer b ) {
* @param rat a pointer to a ratio.
* @return long double
*/
long double c_ratio_to_ld( struct cons_pointer rat) {
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);
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);
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_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);;
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.");
}
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;
}

5
src/arith/ratio.h
View file

@ -32,10 +32,11 @@ struct cons_pointer subtract_ratio_ratio( struct cons_pointer arg1,
struct cons_pointer arg2 );
struct cons_pointer make_ratio( struct cons_pointer dividend,
struct cons_pointer divisor );
struct cons_pointer divisor,
bool simplify );
bool equal_ratio_ratio( struct cons_pointer a, struct cons_pointer b );
long double c_ratio_to_ld( struct cons_pointer rat);
long double c_ratio_to_ld( struct cons_pointer rat );
#endif

4
src/io/io.c
View file

@ -508,8 +508,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
if ( readp( frame->arg[0] ) ) {
result =
make_string( url_fgetwc
( pointer2cell( frame->arg[0] ).payload.
stream.stream ), NIL );
( pointer2cell( frame->arg[0] ).payload.stream.
stream ), NIL );
}
return result;

6
src/io/read.c
View file

@ -90,7 +90,7 @@ struct cons_pointer read_path( URL_FILE *input, wint_t initial,
switch ( initial ) {
case '/':
prefix = make_cons( c_string_to_lisp_symbol( L"oblist" ), NIL);
prefix = make_cons( c_string_to_lisp_symbol( L"oblist" ), NIL );
break;
case '$':
case LSESSION:
@ -370,7 +370,7 @@ struct cons_pointer read_number( struct stack_frame *frame,
( to_long_double
( base ),
places_of_decimals ),
NIL ) );
NIL ), true);
inc_ref( div );
result = make_real( to_long_double( div ) );
@ -378,7 +378,7 @@ struct cons_pointer read_number( struct stack_frame *frame,
dec_ref( div );
} else if ( integerp( dividend ) ) {
debug_print( L"read_number: converting result to ratio\n", DEBUG_IO );
result = make_ratio( dividend, result );
result = make_ratio( dividend, result, true );
}
if ( neg ) {

8
src/memory/dump.c
View file

@ -114,10 +114,10 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) {
case RATIOTV:
url_fwprintf( output,
L"\t\tRational cell: value %ld/%ld, count %u\n",
pointer2cell( cell.payload.ratio.dividend ).
payload.integer.value,
pointer2cell( cell.payload.ratio.divisor ).
payload.integer.value, cell.count );
pointer2cell( cell.payload.ratio.dividend ).payload.
integer.value,
pointer2cell( cell.payload.ratio.divisor ).payload.
integer.value, cell.count );
break;
case READTV:
url_fputws( L"\t\tInput stream; metadata: ", output );

141
src/ops/equal.c
View file

@ -58,17 +58,17 @@ bool end_of_string( struct cons_pointer string ) {
* @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) {
long double fa = fabsl( a);
long double fb = fabsl( b);
bool equal_ld_ld( long double a, long double b ) {
long double fa = fabsl( a );
long double fb = fabsl( b );
/* difference of magnitudes */
long double diff = fabsl( fa - fb);
long double diff = fabsl( fa - fb );
/* average magnitude of the two */
long double av = (fa > fb) ? ( fa - diff) : ( fb - diff);
long double av = ( fa > fb ) ? ( fa - diff ) : ( fb - diff );
/* amount of difference we will tolerate for equality */
long double tolerance = av * 0.000000001;
bool result = ( fabsl( a - b) < tolerance);
bool result = ( fabsl( a - b ) < tolerance );
debug_printf( DEBUG_ARITH, L"\nequal_ld_ld returning %d\n", result );
@ -84,22 +84,26 @@ bool equal_ld_ld( long double a, long double b) {
* @return true if the two numbers have equal value.
* @return false if they don't.
*/
bool equal_integer_real( struct cons_pointer a, struct cons_pointer b ){
debug_print( L"\nequal_integer_real: ", DEBUG_ARITH);
debug_print_object( a, DEBUG_ARITH);
debug_print( L" = ", DEBUG_ARITH);
debug_print_object( b, DEBUG_ARITH);
bool equal_integer_real( struct cons_pointer a, struct cons_pointer b ) {
debug_print( L"\nequal_integer_real: ", DEBUG_ARITH );
debug_print_object( a, DEBUG_ARITH );
debug_print( L" = ", DEBUG_ARITH );
debug_print_object( b, DEBUG_ARITH );
bool result = false;
struct cons_space_object * cell_a = &pointer2cell( a);
struct cons_space_object * cell_b = & pointer2cell( b);
struct cons_space_object *cell_a = &pointer2cell( a );
struct cons_space_object *cell_b = &pointer2cell( b );
if (nilp( cell_a->payload.integer.more)) {
result = equal_ld_ld( (long double) cell_a->payload.integer.value, cell_b->payload.real.value);
if ( nilp( cell_a->payload.integer.more ) ) {
result =
equal_ld_ld( ( long double ) cell_a->payload.integer.value,
cell_b->payload.real.value );
} else {
fwprintf( stderr, L"\nequality is not yet implemented for bignums compared to reals.");
fwprintf( stderr,
L"\nequality is not yet implemented for bignums compared to reals." );
}
debug_printf( DEBUG_ARITH, L"\nequal_integer_real returning %d\n", result );
debug_printf( DEBUG_ARITH, L"\nequal_integer_real returning %d\n",
result );
return result;
}
@ -114,26 +118,27 @@ bool equal_integer_real( struct cons_pointer a, struct cons_pointer b ){
* @return false if they don't.
*/
bool equal_integer_number( struct cons_pointer a, struct cons_pointer b ) {
debug_print( L"\nequal_integer_number: ", DEBUG_ARITH);
debug_print_object( a, DEBUG_ARITH);
debug_print( L" = ", DEBUG_ARITH);
debug_print_object( b, DEBUG_ARITH);
debug_print( L"\nequal_integer_number: ", DEBUG_ARITH );
debug_print_object( a, DEBUG_ARITH );
debug_print( L" = ", DEBUG_ARITH );
debug_print_object( b, DEBUG_ARITH );
bool result = false;
struct cons_space_object * cell_b = & pointer2cell( b);
struct cons_space_object *cell_b = &pointer2cell( b );
switch ( cell_b->tag.value) {
switch ( cell_b->tag.value ) {
case INTEGERTV:
result = equal_integer_integer( a, b);
result = equal_integer_integer( a, b );
break;
case REALTV:
result = equal_integer_real( a, b);
case REALTV:
result = equal_integer_real( a, b );
break;
case RATIOTV:
result = false;
break;
}
debug_printf( DEBUG_ARITH, L"\nequal_integer_number returning %d\n", result );
debug_printf( DEBUG_ARITH, L"\nequal_integer_number returning %d\n",
result );
return result;
}
@ -147,30 +152,33 @@ bool equal_integer_number( struct cons_pointer a, struct cons_pointer b ) {
* @return true if the two numbers have equal value.
* @return false if they don't.
*/
bool equal_real_number( struct cons_pointer a, struct cons_pointer b) {
debug_print( L"\nequal_real_number: ", DEBUG_ARITH);
debug_print_object( a, DEBUG_ARITH);
debug_print( L" = ", DEBUG_ARITH);
debug_print_object( b, DEBUG_ARITH);
bool equal_real_number( struct cons_pointer a, struct cons_pointer b ) {
debug_print( L"\nequal_real_number: ", DEBUG_ARITH );
debug_print_object( a, DEBUG_ARITH );
debug_print( L" = ", DEBUG_ARITH );
debug_print_object( b, DEBUG_ARITH );
bool result = false;
struct cons_space_object * cell_b = & pointer2cell( b);
struct cons_space_object *cell_b = &pointer2cell( b );
switch ( cell_b->tag.value) {
switch ( cell_b->tag.value ) {
case INTEGERTV:
result = equal_integer_real( b, a);
result = equal_integer_real( b, a );
break;
case REALTV: {
struct cons_space_object * cell_a = & pointer2cell( a);
result = equal_ld_ld( cell_a->payload.real.value, cell_b->payload.real.value);
case REALTV:{
struct cons_space_object *cell_a = &pointer2cell( a );
result =
equal_ld_ld( cell_a->payload.real.value,
cell_b->payload.real.value );
}
break;
case RATIOTV:
struct cons_space_object * cell_a = & pointer2cell( a);
result = equal_ld_ld( c_ratio_to_ld( b), cell_a->payload.real.value);
case RATIOTV:
struct cons_space_object *cell_a = &pointer2cell( a );
result =
equal_ld_ld( c_ratio_to_ld( b ), cell_a->payload.real.value );
break;
}
}
debug_printf( DEBUG_ARITH, L"\nequal_real_number returning %d\n", result );
debug_printf( DEBUG_ARITH, L"\nequal_real_number returning %d\n", result );
return result;
}
@ -187,24 +195,24 @@ bool equal_real_number( struct cons_pointer a, struct cons_pointer b) {
bool equal_number_number( struct cons_pointer a, struct cons_pointer b ) {
bool result = eq( a, b );
debug_print( L"\nequal_number_number: ", DEBUG_ARITH);
debug_print_object( a, DEBUG_ARITH);
debug_print( L" = ", DEBUG_ARITH);
debug_print_object( b, DEBUG_ARITH);
debug_print( L"\nequal_number_number: ", DEBUG_ARITH );
debug_print_object( a, DEBUG_ARITH );
debug_print( L" = ", DEBUG_ARITH );
debug_print_object( b, DEBUG_ARITH );
if ( !result ) {
struct cons_space_object * cell_a = & pointer2cell( a);
struct cons_space_object * cell_b = & pointer2cell( b);
struct cons_space_object *cell_a = &pointer2cell( a );
struct cons_space_object *cell_b = &pointer2cell( b );
switch ( cell_a->tag.value) {
case INTEGERTV:
result = equal_integer_number( a, b);
switch ( cell_a->tag.value ) {
case INTEGERTV:
result = equal_integer_number( a, b );
break;
case REALTV:
result = equal_real_number( a, b);
result = equal_real_number( a, b );
break;
case RATIOTV:
switch( cell_b->tag.value) {
switch ( cell_b->tag.value ) {
case INTEGERTV:
/* as all ratios are simplified by make_ratio, any
* ratio that would simplify to an integer is an
@ -212,13 +220,13 @@ bool equal_number_number( struct cons_pointer a, struct cons_pointer b ) {
result = false;
break;
case REALTV:
result = equal_real_number( b, a);
result = equal_real_number( b, a );
break;
case RATIOTV:
result = equal_ratio_ratio( a, b);
result = equal_ratio_ratio( a, b );
break;
/* can't throw an exception from here, but non-numbers
* shouldn't have been passed in anyway, so no default. */
/* can't throw an exception from here, but non-numbers
* shouldn't have been passed in anyway, so no default. */
}
break;
/* can't throw an exception from here, but non-numbers
@ -226,20 +234,21 @@ bool equal_number_number( struct cons_pointer a, struct cons_pointer b ) {
}
}
debug_printf( DEBUG_ARITH, L"\nequal_number_number returning %d\n", result );
debug_printf( DEBUG_ARITH, L"\nequal_number_number returning %d\n",
result );
return result;
}
/**
* Deep, and thus expensive, equality: true if these two objects have
* identical structure, else false.
*/
bool equal( struct cons_pointer a, struct cons_pointer b ) {
debug_print( L"\nequal: ", DEBUG_ARITH);
debug_print_object( a, DEBUG_ARITH);
debug_print( L" = ", DEBUG_ARITH);
debug_print_object( b, DEBUG_ARITH);
debug_print( L"\nequal: ", DEBUG_ARITH );
debug_print_object( a, DEBUG_ARITH );
debug_print( L" = ", DEBUG_ARITH );
debug_print_object( b, DEBUG_ARITH );
bool result = eq( a, b );
@ -309,7 +318,7 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
break;
}
} else if ( numberp( a ) && numberp( b ) ) {
result = equal_number_number( a, b);
result = equal_number_number( a, b );
}
/*

19
src/ops/lispops.c
View file

@ -446,10 +446,9 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
result = next_pointer;
} else {
result =
( *fn_cell.payload.
special.executable ) ( get_stack_frame
( next_pointer ),
next_pointer, env );
( *fn_cell.payload.special.
executable ) ( get_stack_frame( next_pointer ),
next_pointer, env );
debug_print( L"Special form returning: ", DEBUG_EVAL );
debug_print_object( result, DEBUG_EVAL );
debug_println( DEBUG_EVAL );
@ -1246,8 +1245,7 @@ lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer env ) {
struct cons_pointer message = frame->arg[0];
return exceptionp( message ) ? message : throw_exception( message,
frame->
previous );
frame->previous );
}
/**
@ -1430,14 +1428,13 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) {
if ( nilp( c_cdr( l1 ) ) ) {
return
make_string_like_thing( ( pointer2cell( l1 ).
payload.string.character ),
l2,
make_string_like_thing( ( pointer2cell( l1 ).payload.
string.character ), l2,
pointer2cell( l1 ).tag.value );
} else {
return
make_string_like_thing( ( pointer2cell( l1 ).
payload.string.character ),
make_string_like_thing( ( pointer2cell( l1 ).payload.
string.character ),
c_append( c_cdr( l1 ), l2 ),
pointer2cell( l1 ).tag.value );
}