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

Ratio addition working perfectly; all tests pass.

Browse source
This commit is contained in:
Simon Brooke 2018-12-23 21:45:24 +00:00
parent 813b24406d
commit d725097f89
1 changed files with 67 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

75
src/peano.c
View file

@ -56,12 +56,13 @@ bool zerop( struct cons_pointer arg ) {
* not a number is passed in. * not a number is passed in.
*/ */
long double to_long_double( struct cons_pointer arg ) { long double to_long_double( struct cons_pointer arg ) {
long double result = NAN; /* not a number, as a long double */ long double result = 0; /* not a number, as a long double */
struct cons_space_object cell = pointer2cell( arg ); struct cons_space_object cell = pointer2cell( arg );
switch ( cell.tag.value ) { switch ( cell.tag.value ) {
case INTEGERTV: case INTEGERTV:
result = cell.payload.integer.value * 1.0; result = ( double ) cell.payload.integer.value;
break;
case RATIOTV: case RATIOTV:
{ {
struct cons_space_object dividend = struct cons_space_object dividend =
@ -70,15 +71,22 @@ long double to_long_double( struct cons_pointer arg ) {
pointer2cell( cell.payload.ratio.divisor ); pointer2cell( cell.payload.ratio.divisor );
result = result =
dividend.payload.integer.value / ( long double ) dividend.payload.integer.value /
divisor.payload.integer.value; divisor.payload.integer.value;
} }
break; break;
case REALTV: case REALTV:
result = cell.payload.real.value; result = cell.payload.real.value;
break; break;
default:
result = NAN;
break;
} }
fputws( L"to_long_double( ", stderr );
print( stderr, arg );
fwprintf( stderr, L") => %lf\n", result );
return result; return result;
} }
@ -128,9 +136,9 @@ long int least_common_multiple( long int m, long int n ) {
struct cons_pointer add_ratio_ratio( struct stack_frame *frame, struct cons_pointer add_ratio_ratio( struct stack_frame *frame,
struct cons_pointer arg1, struct cons_pointer arg1,
struct cons_pointer arg2 ) { struct cons_pointer arg2 ) {
fputws( L"add_ratio_ratio: srg1 = ", stderr ); fputws( L"add_ratio_ratio( arg1 = ", stderr );
print( stderr, arg1 ); print( stderr, arg1 );
fputws( L"; srg2 = ", stderr ); fputws( L"; arg2 = ", stderr );
print( stderr, arg2 ); print( stderr, arg2 );
struct cons_pointer result; struct cons_pointer result;
@ -145,10 +153,9 @@ struct cons_pointer add_ratio_ratio( struct stack_frame *frame,
dr2v = dr2v =
pointer2cell( cell2.payload.ratio.divisor ).payload.integer.value, pointer2cell( cell2.payload.ratio.divisor ).payload.integer.value,
lcm = least_common_multiple( dr1v, dr2v ), lcm = least_common_multiple( dr1v, dr2v ),
m1 = lcm / dr1v, m1 = lcm / dr1v, m2 = lcm / dr2v;
m2 = lcm / dr2v;
fwprintf(stderr , L"; lcm = %ld; m1 = %ld; m2 = %ld\n", lcm, m1, m2); fwprintf( stderr, L"); lcm = %ld; m1 = %ld; m2 = %ld", lcm, m1, m2 );
if ( dr1v == dr2v ) { if ( dr1v == dr2v ) {
result = result =
@ -156,12 +163,21 @@ struct cons_pointer add_ratio_ratio( struct stack_frame *frame,
make_integer( dd1v + dd2v ), make_integer( dd1v + dd2v ),
cell1.payload.ratio.divisor ); cell1.payload.ratio.divisor );
long int ddrv = pointer2cell(pointer2cell(result).payload.ratio.dividend).payload.integer.value, long int ddrv =
drrv = pointer2cell(pointer2cell(result).payload.ratio.divisor).payload.integer.value, pointer2cell( pointer2cell( result ).payload.ratio.
gcd = greatest_common_divisor(ddrv, drrv); dividend ).payload.integer.value, drrv =
pointer2cell( pointer2cell( result ).payload.ratio.
divisor ).payload.integer.value, gcd =
greatest_common_divisor( ddrv, drrv );
if ( gcd > 1 ) { if ( gcd > 1 ) {
result = make_ratio( frame, make_integer(ddrv/gcd),make_integer(drrv/gcd)); if ( drrv / gcd == 1 ) {
result = make_integer( ddrv / gcd );
} else {
result =
make_ratio( frame, make_integer( ddrv / gcd ),
make_integer( drrv / gcd ) );
}
} }
} else { } else {
result = add_ratio_ratio( frame, result = add_ratio_ratio( frame,
@ -173,6 +189,10 @@ struct cons_pointer add_ratio_ratio( struct stack_frame *frame,
make_integer( dr2v * m2 ) ) ); make_integer( dr2v * m2 ) ) );
} }
fputws( L" => ", stderr );
print( stderr, result );
fputws( L"\n", stderr );
return result; return result;
} }
@ -201,6 +221,11 @@ struct cons_pointer add_2( struct stack_frame *frame, 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 );
fputws( L"add_2( arg1 = ", stderr );
print( stderr, arg1 );
fputws( L"; arg2 = ", stderr );
print( stderr, arg2 );
if ( zerop( arg1 ) ) { if ( zerop( arg1 ) ) {
result = arg2; result = arg2;
} else if ( zerop( arg2 ) ) { } else if ( zerop( arg2 ) ) {
@ -217,7 +242,7 @@ struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer arg1,
result = arg2; result = arg2;
break; break;
case INTEGERTV: case INTEGERTV:
make_integer( cell1.payload.integer.value + result = make_integer( cell1.payload.integer.value +
cell2.payload.integer.value ); cell2.payload.integer.value );
break; break;
case RATIOTV: case RATIOTV:
@ -226,7 +251,7 @@ struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer arg1,
case REALTV: case REALTV:
result = result =
make_real( to_long_double( arg1 ) + make_real( to_long_double( arg1 ) +
cell2.payload.real.value ); to_long_double( arg2 ) );
break; break;
default: default:
result = lisp_throw( c_string_to_lisp_string result = lisp_throw( c_string_to_lisp_string
@ -247,13 +272,27 @@ struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer arg1,
break; break;
case REALTV: case REALTV:
result = result =
make_real( cell2.payload.real.value + make_real( to_long_double( arg1 ) +
to_long_double( arg1 ) ); to_long_double( arg2 ) );
break; break;
} }
break;
case REALTV:
result =
make_real( to_long_double( arg1 ) +
to_long_double( arg2 ) );
break;
default:
result = lisp_throw( c_string_to_lisp_string
( "Cannot add: not a number" ), frame );
} }
} }
fputws( L"}; => ", stderr );
print( stderr, arg2 );
fputws( L"\n", stderr );
return result; return result;
} }
@ -268,8 +307,8 @@ struct cons_pointer lisp_add( struct stack_frame
cons_pointer env ) { cons_pointer env ) {
struct cons_pointer result = make_integer( 0 ); struct cons_pointer result = make_integer( 0 );
for ( int i = 0; for ( int i = 0;
i < args_in_frame && !nilp( frame->arg[i] ) && !exceptionp( result ); i < args_in_frame &&
i++ ) { !nilp( frame->arg[i] ) && !exceptionp( result ); i++ ) {
result = add_2( frame, result, frame->arg[i] ); result = add_2( frame, result, frame->arg[i] );
} }