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

Ratio division

Browse source
This commit is contained in:
Simon Brooke 2018-12-24 12:32:41 +00:00
parent 7e98207f7e
commit 7b1cdf4440
4 changed files with 154 additions and 59 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
src/consspaceobject.c
View file

@ -136,10 +136,10 @@ void dump_object( FILE * output, struct cons_pointer pointer ) {
case RATIOTV: case RATIOTV:
fwprintf( output, 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:
fwprintf( output, L"\t\tInput stream\n" ); fwprintf( output, L"\t\tInput stream\n" );

4
src/equal.c
View file

@ -80,8 +80,8 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
&& ( equal( cell_a->payload.string.cdr, && ( equal( cell_a->payload.string.cdr,
cell_b->payload.string.cdr ) cell_b->payload.string.cdr )
|| ( end_of_string( cell_a->payload.string.cdr ) || ( end_of_string( cell_a->payload.string.cdr )
&& end_of_string( cell_b->payload. && end_of_string( cell_b->payload.string.
string.cdr ) ) ); cdr ) ) );
break; break;
case INTEGERTV: case INTEGERTV:
result = result =

187
src/peano.c
View file

@ -132,10 +132,10 @@ struct cons_pointer simplify_ratio( struct stack_frame *frame,
struct cons_pointer arg ) { struct cons_pointer arg ) {
struct cons_pointer result = arg; struct cons_pointer result = arg;
long int ddrv = long int ddrv =
pointer2cell( pointer2cell( arg ).payload.ratio.dividend ). pointer2cell( pointer2cell( arg ).payload.ratio.dividend ).payload.
payload.integer.value, drrv = integer.value, drrv =
pointer2cell( pointer2cell( arg ).payload.ratio.divisor ). pointer2cell( pointer2cell( arg ).payload.ratio.divisor ).payload.
payload.integer.value, gcd = greatest_common_divisor( ddrv, drrv ); integer.value, gcd = greatest_common_divisor( ddrv, drrv );
if ( gcd > 1 ) { if ( gcd > 1 ) {
if ( drrv / gcd == 1 ) { if ( drrv / gcd == 1 ) {
@ -163,7 +163,7 @@ struct cons_pointer add_ratio_ratio( struct stack_frame *frame,
fputws( L"; arg2 = ", stderr ); fputws( L"; arg2 = ", stderr );
print( stderr, arg2 ); print( stderr, arg2 );
struct cons_pointer r1, result; struct cons_pointer r, result;
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 );
long int dd1v = long int dd1v =
@ -180,22 +180,29 @@ struct cons_pointer add_ratio_ratio( struct stack_frame *frame,
fwprintf( stderr, L"); lcm = %ld; m1 = %ld; m2 = %ld", lcm, m1, m2 ); fwprintf( stderr, L"); lcm = %ld; m1 = %ld; m2 = %ld", lcm, m1, m2 );
if ( dr1v == dr2v ) { if ( dr1v == dr2v ) {
r1 = make_ratio( frame, r = make_ratio( frame,
make_integer( dd1v + dd2v ), make_integer( dd1v + dd2v ),
cell1.payload.ratio.divisor ); cell1.payload.ratio.divisor );
} else { } else {
r1 = add_ratio_ratio( frame, struct cons_pointer dd1vm = make_integer( dd1v * m1 ),
make_ratio( frame, dr1vm = make_integer( dr1v * m1 ),
make_integer( dd1v * m1 ), dd2vm = make_integer( dd2v * m2 ),
make_integer( dr1v * m1 ) ), dr2vm = make_integer( dr2v * m2 ),
make_ratio( frame, r1 = make_ratio( frame, dd1vm, dr1vm ),
make_integer( dd2v * m2 ), r2 = make_ratio( frame, dd2vm, dr2vm );
make_integer( dr2v * m2 ) ) );
r = add_ratio_ratio( frame, r1, r2 );
/* because the references on dd1vm, dr1vm, dd2vm and dr2vm were
* never incremented except when making r1 and r2, decrementing
* r1 and r2 should be enought to garbage collect them. */
dec_ref( r1 );
dec_ref( r2 );
} }
result = simplify_ratio( frame, r1 ); result = simplify_ratio( frame, r );
if ( !eq( r1, result ) ) { if ( !eq( r, result ) ) {
dec_ref( r1 ); dec_ref( r );
} }
fputws( L" => ", stderr ); fputws( L" => ", stderr );
@ -214,9 +221,13 @@ struct cons_pointer add_ratio_ratio( struct stack_frame *frame,
struct cons_pointer add_integer_ratio( struct stack_frame *frame, struct cons_pointer add_integer_ratio( struct stack_frame *frame,
struct cons_pointer intarg, struct cons_pointer intarg,
struct cons_pointer ratarg ) { struct cons_pointer ratarg ) {
return add_ratio_ratio( frame, struct cons_pointer one = make_integer( 1 ),
make_ratio( frame, intarg, make_integer( 1 ) ), ratio = make_ratio( frame, intarg, one ),
ratarg ); result = add_ratio_ratio( frame, ratio, ratarg );
dec_ref( one );
dec_ref( ratio );
return result;
} }
@ -298,7 +309,8 @@ struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer arg1,
to_long_double( arg2 ) ); to_long_double( arg2 ) );
break; break;
default: default:
result = lisp_throw( c_string_to_lisp_string result = exceptionp( arg2 ) ? arg2 :
lisp_throw( c_string_to_lisp_string
( "Cannot add: not a number" ), frame ); ( "Cannot add: not a number" ), frame );
} }
} }
@ -388,9 +400,14 @@ struct cons_pointer multiply_ratio_ratio( struct
struct cons_pointer multiply_integer_ratio( struct stack_frame *frame, struct cons_pointer multiply_integer_ratio( struct stack_frame *frame,
struct cons_pointer intarg, struct cons_pointer intarg,
struct cons_pointer ratarg ) { struct cons_pointer ratarg ) {
return multiply_ratio_ratio( frame, struct cons_pointer one = make_integer( 1 ),
make_ratio( frame, intarg, ratio = make_ratio( frame, intarg, one ),
make_integer( 1 ) ), ratarg ); result = multiply_ratio_ratio( frame, ratio, ratarg );
dec_ref( one);
dec_ref( ratio);
return result;
} }
@ -467,7 +484,7 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
} }
break; break;
case REALTV: case REALTV:
result = result = exceptionp( arg2 ) ? arg2 :
make_real( to_long_double( arg1 ) * make_real( to_long_double( arg1 ) *
to_long_double( arg2 ) ); to_long_double( arg2 ) );
break; break;
@ -515,6 +532,7 @@ struct cons_pointer lisp_multiply( struct
&& !exceptionp( result ) ) { && !exceptionp( result ) ) {
tmp = result; tmp = result;
result = multiply_2( frame, result, c_car( more ) ); result = multiply_2( frame, result, c_car( more ) );
if ( !eq( tmp, result ) ) { if ( !eq( tmp, result ) ) {
dec_ref( tmp ); dec_ref( tmp );
} }
@ -543,8 +561,8 @@ struct cons_pointer inverse( struct stack_frame *frame,
case RATIOTV: case RATIOTV:
result = make_ratio( frame, result = make_ratio( frame,
make_integer( 0 - make_integer( 0 -
to_long_int( cell.payload. to_long_int( cell.payload.ratio.
ratio.dividend ) ), dividend ) ),
cell.payload.ratio.divisor ); cell.payload.ratio.divisor );
break; break;
case REALTV: case REALTV:
@ -650,7 +668,7 @@ struct cons_pointer lisp_subtract( struct
} }
break; break;
case REALTV: case REALTV:
result = result = exceptionp( frame->arg[1] ) ? frame->arg[1] :
make_real( to_long_double( frame->arg[0] ) - make_real( to_long_double( frame->arg[0] ) -
to_long_double( frame->arg[1] ) ); to_long_double( frame->arg[1] ) );
break; break;
@ -665,6 +683,26 @@ struct cons_pointer lisp_subtract( struct
return result; return result;
} }
/**
* return a cons_pointer to a ratio which represents the value of the ratio
* indicated by `arg1` divided by the ratio indicated by `arg2`. If either
* of these aren't RTIO cells, something horrid will happen and it is YOUR FAULT.
*/
struct cons_pointer divide_ratio_ratio( struct stack_frame *frame,
struct cons_pointer arg1,
struct cons_pointer arg2 ) {
struct cons_pointer i = make_ratio( frame,
pointer2cell( arg2 ).payload.ratio.
divisor,
pointer2cell( arg2 ).payload.ratio.
dividend ), result =
multiply_ratio_ratio( frame, arg1, i );
dec_ref( i );
return result;
}
/** /**
* Divide one number by another. * Divide one number by another.
* @param env the evaluation environment - ignored; * @param env the evaluation environment - ignored;
@ -678,27 +716,84 @@ struct cons_pointer lisp_divide( struct
struct cons_pointer result = NIL; struct cons_pointer result = NIL;
struct cons_space_object arg0 = pointer2cell( frame->arg[0] ); struct cons_space_object arg0 = pointer2cell( frame->arg[0] );
struct cons_space_object arg1 = pointer2cell( frame->arg[1] ); struct cons_space_object arg1 = pointer2cell( frame->arg[1] );
if ( numberp( frame->arg[1] )
&& numeric_value( frame->arg[1] ) == 0 ) { switch ( arg0.tag.value ) {
lisp_throw case EXCEPTIONTV:
( c_string_to_lisp_string result = frame->arg[0];
( "Cannot divide: divisor is zero" ), frame ); break;
} else if ( numberp( frame->arg[0] ) case INTEGERTV:
&& numberp( frame->arg[1] ) ) { switch ( arg1.tag.value ) {
long int i = ( long int ) case EXCEPTIONTV:
numeric_value( frame->arg[0] ) / numeric_value( frame->arg[1] ); result = frame->arg[1];
long double r = ( long double ) break;
numeric_value( frame->arg[0] ) case INTEGERTV: {
/ numeric_value( frame->arg[1] ); struct cons_pointer unsimplified = make_ratio( frame, frame->arg[0], frame->arg[1] );
if ( fabsl( ( long double ) i - r ) < 0.0000000001 ) { result = simplify_ratio(frame, unsimplified);
result = make_integer( i ); if (!eq(unsimplified,result)){
} else { dec_ref(unsimplified);
result = make_real( r );
} }
} else { }
lisp_throw break;
( c_string_to_lisp_string case RATIOTV: {
struct cons_pointer one = make_integer( 1 );
struct cons_pointer ratio =
make_ratio( frame, frame->arg[0], one );
result =
divide_ratio_ratio( frame, ratio, frame->arg[1] );
dec_ref( ratio );
}
break;
case REALTV:
result =
make_real( to_long_double( frame->arg[0] ) /
to_long_double( frame->arg[1] ) );
break;
default:
result = lisp_throw( c_string_to_lisp_string
( "Cannot divide: not a number" ),
frame );
break;
}
break;
case RATIOTV:
switch ( arg1.tag.value ) {
case EXCEPTIONTV:
result = frame->arg[1];
break;
case INTEGERTV: {
struct cons_pointer one = make_integer( 1 );
struct cons_pointer ratio =
make_ratio( frame, frame->arg[1], one );
result = divide_ratio_ratio( frame, frame->arg[0], ratio );
dec_ref( ratio );
}
break;
case RATIOTV:
result =
divide_ratio_ratio( frame, frame->arg[0],
frame->arg[1] );
break;
case REALTV:
result =
make_real( to_long_double( frame->arg[0] ) /
to_long_double( frame->arg[1] ) );
break;
default:
result = lisp_throw( c_string_to_lisp_string
( "Cannot divide: not a number" ),
frame );
break;
}
break;
case REALTV:
result = exceptionp( frame->arg[1] ) ? frame->arg[1] :
make_real( to_long_double( frame->arg[0] ) /
to_long_double( frame->arg[1] ) );
break;
default:
result = lisp_throw( c_string_to_lisp_string
( "Cannot divide: not a number" ), frame ); ( "Cannot divide: not a number" ), frame );
break;
} }
return result; return result;

8
src/print.c
View file

@ -132,8 +132,8 @@ struct cons_pointer print( FILE * output, struct cons_pointer pointer ) {
case LAMBDATV: case LAMBDATV:
print( output, make_cons( c_string_to_lisp_symbol( "lambda" ), print( output, make_cons( c_string_to_lisp_symbol( "lambda" ),
make_cons( cell.payload.lambda.args, make_cons( cell.payload.lambda.args,
cell.payload.lambda. cell.payload.
body ) ) ); lambda.body ) ) );
break; break;
case NILTV: case NILTV:
fwprintf( output, L"nil" ); fwprintf( output, L"nil" );
@ -141,8 +141,8 @@ struct cons_pointer print( FILE * output, struct cons_pointer pointer ) {
case NLAMBDATV: case NLAMBDATV:
print( output, make_cons( c_string_to_lisp_symbol( "nlambda" ), print( output, make_cons( c_string_to_lisp_symbol( "nlambda" ),
make_cons( cell.payload.lambda.args, make_cons( cell.payload.lambda.args,
cell.payload.lambda. cell.payload.
body ) ) ); lambda.body ) ) );
break; break;
case RATIOTV: case RATIOTV:
print( output, cell.payload.ratio.dividend ); print( output, cell.payload.ratio.dividend );