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

1
Makefile
View file

@ -30,6 +30,7 @@ $(TARGET): $(OBJS) Makefile
doc: $(SRCS) Makefile Doxyfile doc: $(SRCS) Makefile Doxyfile
doxygen doxygen
tar czvf target/doc.tgz doc
format: $(SRCS) $(HDRS) Makefile format: $(SRCS) $(HDRS) Makefile
ifeq ($(shell uname -s), Darwin) ifeq ($(shell uname -s), Darwin)

21
docs/state-of-play.md
View file

@ -22,6 +22,27 @@ fractions once bignums are working.
So we're down to eight unit tests failing: the memory leak, one unimplemented So we're down to eight unit tests failing: the memory leak, one unimplemented
feature, and the bignum problem. feature, and the bignum problem.
At the end of the day I decided to chew up some memory by doing a series of
moderately large computations, to see how much memory is being successfully
deallocated.
```lisp
:: (mapcar fact '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20))
(1 2 6 24 120 720 5,040 40,320 362,880 3,628,800 39,916,800 479,001,600
1,932,053,504 1,278,945,280 2,004,310,016 2,004,189,184 4,006,445,056
3,396,534,272 109,641,728 2,192,834,560)
::
Allocation summary: allocated 10136; deallocated 548; not deallocated 9588.
```
So, about 5%. This is still a major problem, and is making me doubt my reference
counting strategy. Must do better!
Note that the reason that the numbers become eratic past about two billion is
the bignum arithmetic bug.
## 20260214 ## 20260214
### Memory leaks ### Memory leaks

27
src/arith/peano.c
View file

@ -99,7 +99,7 @@ struct cons_pointer absolute( struct cons_pointer arg ) {
break; break;
case RATIOTV: case RATIOTV:
result = make_ratio( absolute( cell.payload.ratio.dividend ), result = make_ratio( absolute( cell.payload.ratio.dividend ),
cell.payload.ratio.divisor ); cell.payload.ratio.divisor, false );
break; break;
case REALTV: case REALTV:
result = make_real( 0 - cell.payload.real.value ); result = make_real( 0 - cell.payload.real.value );
@ -504,7 +504,7 @@ struct cons_pointer negative( struct cons_pointer arg ) {
break; break;
case RATIOTV: case RATIOTV:
result = make_ratio( negative( cell.payload.ratio.dividend ), result = make_ratio( negative( cell.payload.ratio.dividend ),
cell.payload.ratio.divisor ); cell.payload.ratio.divisor, false );
break; break;
case REALTV: case REALTV:
result = make_real( 0 - to_long_double( arg ) ); result = make_real( 0 - to_long_double( arg ) );
@ -566,7 +566,7 @@ struct cons_pointer subtract_2( struct stack_frame *frame,
case RATIOTV:{ case RATIOTV:{
struct cons_pointer tmp = make_ratio( arg1, struct cons_pointer tmp = make_ratio( arg1,
make_integer( 1, make_integer( 1,
NIL ) ); NIL ), false );
inc_ref( tmp ); inc_ref( tmp );
result = subtract_ratio_ratio( tmp, arg2 ); result = subtract_ratio_ratio( tmp, arg2 );
dec_ref( tmp ); dec_ref( tmp );
@ -592,7 +592,7 @@ struct cons_pointer subtract_2( struct stack_frame *frame,
case INTEGERTV:{ case INTEGERTV:{
struct cons_pointer tmp = make_ratio( arg2, struct cons_pointer tmp = make_ratio( arg2,
make_integer( 1, make_integer( 1,
NIL ) ); NIL ), false );
inc_ref( tmp ); inc_ref( tmp );
result = subtract_ratio_ratio( arg1, tmp ); result = subtract_ratio_ratio( arg1, tmp );
dec_ref( tmp ); dec_ref( tmp );
@ -670,21 +670,15 @@ struct cons_pointer lisp_divide( struct
result = frame->arg[1]; result = frame->arg[1];
break; break;
case INTEGERTV:{ case INTEGERTV:{
struct cons_pointer unsimplified = result =
make_ratio( frame->arg[0], make_ratio( frame->arg[0],
frame->arg[1] ); frame->arg[1], true);
/* 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 );
}
} }
break; break;
case RATIOTV:{ case RATIOTV:{
struct cons_pointer one = make_integer( 1, NIL ); struct cons_pointer one = make_integer( 1, NIL );
struct cons_pointer ratio = struct cons_pointer ratio =
make_ratio( frame->arg[0], one ); make_ratio( frame->arg[0], one, false );
inc_ref( ratio ); inc_ref( ratio );
result = divide_ratio_ratio( ratio, frame->arg[1] ); result = divide_ratio_ratio( ratio, frame->arg[1] );
dec_ref( ratio ); dec_ref( ratio );
@ -709,10 +703,8 @@ struct cons_pointer lisp_divide( struct
break; break;
case INTEGERTV:{ case INTEGERTV:{
struct cons_pointer one = make_integer( 1, NIL ); struct cons_pointer one = make_integer( 1, NIL );
inc_ref( one );
struct cons_pointer ratio = struct cons_pointer ratio =
make_ratio( frame->arg[1], one ); make_ratio( frame->arg[1], one, false);
inc_ref( ratio );
result = divide_ratio_ratio( frame->arg[0], ratio ); result = divide_ratio_ratio( frame->arg[0], ratio );
dec_ref( ratio ); dec_ref( ratio );
dec_ref( one ); dec_ref( one );
@ -760,7 +752,8 @@ struct cons_pointer lisp_divide( struct
*/ */
// struct cons_pointer lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer, // struct cons_pointer lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer,
// struct cons_pointer env ) // struct cons_pointer env )
struct cons_pointer lisp_ratio_to_real( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer lisp_ratio_to_real( struct stack_frame *frame,
struct cons_pointer frame_pointer,
struct cons_pointer env ) { struct cons_pointer env ) {
struct cons_pointer result = NIL; struct cons_pointer result = NIL;
struct cons_pointer rat = frame->arg[0]; struct cons_pointer rat = frame->arg[0];

3
src/arith/peano.h
View file

@ -75,7 +75,8 @@ struct cons_pointer
lisp_divide( struct stack_frame *frame, struct cons_pointer frame_pointer, lisp_divide( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer env ); struct cons_pointer env );
struct cons_pointer lisp_ratio_to_real( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer lisp_ratio_to_real( struct stack_frame *frame,
struct cons_pointer frame_pointer,
struct cons_pointer env ); struct cons_pointer env );
#endif /* PEANO_H */ #endif /* PEANO_H */

62
src/arith/ratio.c
View file

@ -64,14 +64,15 @@ struct cons_pointer simplify_ratio( struct cons_pointer pointer ) {
if ( gcd > 1 ) { if ( gcd > 1 ) {
if ( drrv / gcd == 1 ) { if ( drrv / gcd == 1 ) {
result = acquire_integer( (int64_t)(ddrv / gcd), NIL ); result =
acquire_integer( ( int64_t ) ( ddrv / gcd ), NIL );
} else { } else {
debug_printf( DEBUG_ARITH, debug_printf( DEBUG_ARITH,
L"simplify_ratio: %ld/%ld => %ld/%ld\n", L"simplify_ratio: %ld/%ld => %ld/%ld\n",
ddrv, drrv, ddrv / gcd, drrv / gcd ); ddrv, drrv, ddrv / gcd, drrv / gcd );
result = result =
make_ratio( acquire_integer( ddrv / gcd, NIL ), make_ratio( acquire_integer( ddrv / gcd, NIL ),
acquire_integer( drrv / gcd, NIL ) ); acquire_integer( drrv / gcd, NIL ), false);
} }
} }
} }
@ -102,16 +103,17 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer arg1,
struct cons_space_object *cell1 = &pointer2cell( arg1 ); struct cons_space_object *cell1 = &pointer2cell( arg1 );
struct cons_space_object *cell2 = &pointer2cell( arg2 ); struct cons_space_object *cell2 = &pointer2cell( arg2 );
struct cons_pointer divisor = multiply_integers( cell1->payload.ratio.divisor, cell2->payload.ratio.divisor ); struct cons_pointer divisor =
struct cons_pointer dividend = add_integers( multiply_integers( cell1->payload.ratio.divisor,
multiply_integers( cell1->payload.ratio.dividend, cell2->payload.ratio.divisor );
struct cons_pointer dividend =
add_integers( multiply_integers( cell1->payload.ratio.dividend,
cell2->payload.ratio.divisor ), cell2->payload.ratio.divisor ),
multiply_integers( cell2->payload.ratio.dividend, multiply_integers( cell2->payload.ratio.dividend,
cell1->payload.ratio.divisor ) ); cell1->payload.ratio.divisor ) );
r = make_ratio( dividend, divisor ); r = make_ratio( dividend, divisor, true );
} else { } else {
r = r = throw_exception( make_cons( c_string_to_lisp_string
throw_exception( make_cons( c_string_to_lisp_string
( L"Shouldn't happen: bad arg to add_ratio_ratio" ), ( L"Shouldn't happen: bad arg to add_ratio_ratio" ),
make_cons( arg1, make_cons( arg1,
make_cons( arg2, NIL ) ) ), make_cons( arg2, NIL ) ) ),
@ -142,9 +144,8 @@ struct cons_pointer add_integer_ratio( struct cons_pointer intarg,
debug_print_object( ratarg, DEBUG_ARITH ); debug_print_object( ratarg, DEBUG_ARITH );
if ( integerp( intarg ) && ratiop( ratarg ) ) { if ( integerp( intarg ) && ratiop( ratarg ) ) {
// TODO: not longer works
struct cons_pointer one = acquire_integer( 1, NIL ), 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 ); result = add_ratio_ratio( ratio, ratarg );
@ -181,7 +182,7 @@ struct cons_pointer divide_ratio_ratio( struct cons_pointer arg1,
// TODO: this now has to work if `arg1` is an integer // TODO: this now has to work if `arg1` is an integer
struct cons_pointer i = struct cons_pointer i =
make_ratio( pointer2cell( arg2 ).payload.ratio.divisor, 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 ); multiply_ratio_ratio( arg1, i );
dec_ref( 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 dividend = acquire_integer( ddrv, NIL );
struct cons_pointer divisor = acquire_integer( drrv, NIL ); struct cons_pointer divisor = acquire_integer( drrv, NIL );
struct cons_pointer unsimplified = make_ratio( dividend, divisor ); result = make_ratio( dividend, divisor, true );
result = simplify_ratio( unsimplified );
release_integer( dividend ); release_integer( dividend );
release_integer( divisor ); release_integer( divisor );
if ( !eq( unsimplified, result ) ) {
dec_ref( unsimplified );
}
} else { } else {
result = result =
throw_exception( c_string_to_lisp_string throw_exception( c_string_to_lisp_string
@ -265,9 +261,8 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer intarg,
debug_print_object( ratarg, DEBUG_ARITH ); debug_print_object( ratarg, DEBUG_ARITH );
if ( integerp( intarg ) && ratiop( ratarg ) ) { if ( integerp( intarg ) && ratiop( ratarg ) ) {
// TODO: no longer works; fix
struct cons_pointer one = acquire_integer( 1, NIL ), 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 ); result = multiply_ratio_ratio( ratio, ratarg );
release_integer( one ); release_integer( one );
@ -315,7 +310,14 @@ struct cons_pointer subtract_ratio_ratio( struct cons_pointer arg1,
* @exception if either `dividend` or `divisor` is not an integer. * @exception if either `dividend` or `divisor` is not an integer.
*/ */
struct cons_pointer make_ratio( struct cons_pointer dividend, 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; struct cons_pointer result;
if ( integerp( dividend ) && integerp( divisor ) ) { if ( integerp( dividend ) && integerp( divisor ) ) {
inc_ref( dividend ); inc_ref( dividend );
@ -325,18 +327,23 @@ struct cons_pointer make_ratio( struct cons_pointer dividend,
cell->payload.ratio.dividend = dividend; cell->payload.ratio.dividend = dividend;
cell->payload.ratio.divisor = divisor; cell->payload.ratio.divisor = divisor;
if ( simplify) {
result = simplify_ratio( unsimplified ); result = simplify_ratio( unsimplified );
if ( !eq( result, unsimplified ) ) { if ( !eq( result, unsimplified ) ) {
dec_ref( unsimplified ); dec_ref( unsimplified );
} }
} else {
result = unsimplified;
}
} else { } else {
result = result =
throw_exception( c_string_to_lisp_string throw_exception( c_string_to_lisp_string
( L"Dividend and divisor of a ratio must be integers" ), ( L"Dividend and divisor of a ratio must be integers" ),
NIL ); NIL );
} }
// debug_print( L"make_ratio returning:\n", DEBUG_ARITH); debug_print( L" => ", DEBUG_ALLOC);
debug_dump_object( result, DEBUG_ARITH ); debug_print_object( result, DEBUG_ALLOC );
debug_println( DEBUG_ALLOC);
return result; return result;
} }
@ -382,10 +389,14 @@ long double c_ratio_to_ld( struct cons_pointer rat) {
struct cons_pointer dd = cell_a->payload.ratio.dividend; struct cons_pointer dd = cell_a->payload.ratio.dividend;
struct cons_space_object *dd_cell = &pointer2cell( dd ); struct cons_space_object *dd_cell = &pointer2cell( dd );
if ( nilp( dv_cell->payload.integer.more) && nilp( dd_cell->payload.integer.more)) { if ( nilp( dv_cell->payload.integer.more )
result = ((long double) dd_cell->payload.integer.value) / ((long double) dv_cell->payload.integer.value);; && nilp( dd_cell->payload.integer.more ) ) {
result =
( ( long double ) dd_cell->payload.integer.value ) /
( ( long double ) dv_cell->payload.integer.value );;
} else { } 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." );
} }
} }
@ -393,4 +404,3 @@ long double c_ratio_to_ld( struct cons_pointer rat) {
return result; return result;
} }

3
src/arith/ratio.h
View file

@ -32,7 +32,8 @@ struct cons_pointer subtract_ratio_ratio( struct cons_pointer arg1,
struct cons_pointer arg2 ); struct cons_pointer arg2 );
struct cons_pointer make_ratio( struct cons_pointer dividend, 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 ); bool equal_ratio_ratio( struct cons_pointer a, struct cons_pointer b );

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] ) ) { if ( readp( frame->arg[0] ) ) {
result = result =
make_string( url_fgetwc make_string( url_fgetwc
( pointer2cell( frame->arg[0] ).payload. ( pointer2cell( frame->arg[0] ).payload.stream.
stream.stream ), NIL ); stream ), NIL );
} }
return result; return result;

4
src/io/read.c
View file

@ -370,7 +370,7 @@ struct cons_pointer read_number( struct stack_frame *frame,
( to_long_double ( to_long_double
( base ), ( base ),
places_of_decimals ), places_of_decimals ),
NIL ) ); NIL ), true);
inc_ref( div ); inc_ref( div );
result = make_real( to_long_double( div ) ); result = make_real( to_long_double( div ) );
@ -378,7 +378,7 @@ struct cons_pointer read_number( struct stack_frame *frame,
dec_ref( div ); dec_ref( div );
} else if ( integerp( dividend ) ) { } else if ( integerp( dividend ) ) {
debug_print( L"read_number: converting result to ratio\n", DEBUG_IO ); 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 ) { 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: case RATIOTV:
url_fwprintf( output, url_fwprintf( output,
L"\t\tRational cell: value %ld/%ld, count %u\n", L"\t\tRational cell: value %ld/%ld, count %u\n",
pointer2cell( cell.payload.ratio.dividend ). pointer2cell( cell.payload.ratio.dividend ).payload.
payload.integer.value, integer.value,
pointer2cell( cell.payload.ratio.divisor ). pointer2cell( cell.payload.ratio.divisor ).payload.
payload.integer.value, cell.count ); integer.value, cell.count );
break; break;
case READTV: case READTV:
url_fputws( L"\t\tInput stream; metadata: ", output ); url_fputws( L"\t\tInput stream; metadata: ", output );

23
src/ops/equal.c
View file

@ -94,12 +94,16 @@ bool equal_integer_real( struct cons_pointer a, struct cons_pointer b ){
struct cons_space_object *cell_b = &pointer2cell( b ); struct cons_space_object *cell_b = &pointer2cell( b );
if ( nilp( cell_a->payload.integer.more ) ) { if ( nilp( cell_a->payload.integer.more ) ) {
result = equal_ld_ld( (long double) cell_a->payload.integer.value, cell_b->payload.real.value); result =
equal_ld_ld( ( long double ) cell_a->payload.integer.value,
cell_b->payload.real.value );
} else { } 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; return result;
} }
@ -133,7 +137,8 @@ bool equal_integer_number( struct cons_pointer a, struct cons_pointer b ) {
break; 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; return result;
} }
@ -161,12 +166,15 @@ bool equal_real_number( struct cons_pointer a, struct cons_pointer b) {
break; break;
case REALTV:{ case REALTV:{
struct cons_space_object *cell_a = &pointer2cell( a ); struct cons_space_object *cell_a = &pointer2cell( a );
result = equal_ld_ld( cell_a->payload.real.value, cell_b->payload.real.value); result =
equal_ld_ld( cell_a->payload.real.value,
cell_b->payload.real.value );
} }
break; break;
case RATIOTV: case RATIOTV:
struct cons_space_object *cell_a = &pointer2cell( a ); struct cons_space_object *cell_a = &pointer2cell( a );
result = equal_ld_ld( c_ratio_to_ld( b), cell_a->payload.real.value); result =
equal_ld_ld( c_ratio_to_ld( b ), cell_a->payload.real.value );
break; break;
} }
@ -226,7 +234,8 @@ 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; return result;
} }

17
src/ops/lispops.c
View file

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