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

Much progress! Half the unit tests pass.

Browse source
This commit is contained in:
Simon Brooke 2018-12-28 15:50:37 +00:00
parent 75abfb4050
commit e52ccce0eb
17 changed files with 296 additions and 253 deletions
Download patch file Download diff file Expand all files Collapse all files

26
src/arith/peano.c
View file

@ -89,7 +89,7 @@ long double to_long_double( struct cons_pointer arg ) {
debug_print( L"to_long_double( ", DEBUG_ARITH );
debug_print_object( arg, DEBUG_ARITH );
fwprintf( stderr, L") => %lf\n", result );
debug_printf( DEBUG_ARITH, L") => %lf\n", result );
return result;
}
@ -166,7 +166,7 @@ struct cons_pointer add_2( struct stack_frame *frame,
break;
default:
result = throw_exception( c_string_to_lisp_string
( "Cannot add: not a number" ),
( L"Cannot add: not a number" ),
frame_pointer );
break;
}
@ -190,7 +190,7 @@ struct cons_pointer add_2( struct stack_frame *frame,
break;
default:
result = throw_exception( c_string_to_lisp_string
( "Cannot add: not a number" ),
( L"Cannot add: not a number" ),
frame_pointer );
break;
}
@ -203,7 +203,7 @@ struct cons_pointer add_2( struct stack_frame *frame,
default:
result = exceptionp( arg2 ) ? arg2 :
throw_exception( c_string_to_lisp_string
( "Cannot add: not a number" ),
( L"Cannot add: not a number" ),
frame_pointer );
}
}
@ -300,7 +300,7 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
break;
default:
result = throw_exception( c_string_to_lisp_string
( "Cannot multiply: not a number" ),
( L"Cannot multiply: not a number" ),
frame_pointer );
break;
}
@ -326,7 +326,7 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
break;
default:
result = throw_exception( c_string_to_lisp_string
( "Cannot multiply: not a number" ),
( L"Cannot multiply: not a number" ),
frame_pointer );
}
break;
@ -337,7 +337,7 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
break;
default:
result = throw_exception( c_string_to_lisp_string
( "Cannot multiply: not a number" ),
( L"Cannot multiply: not a number" ),
frame_pointer );
break;
}
@ -473,7 +473,7 @@ struct cons_pointer lisp_subtract( struct
break;
default:
result = throw_exception( c_string_to_lisp_string
( "Cannot subtract: not a number" ),
( L"Cannot subtract: not a number" ),
frame_pointer );
break;
}
@ -506,7 +506,7 @@ struct cons_pointer lisp_subtract( struct
break;
default:
result = throw_exception( c_string_to_lisp_string
( "Cannot subtract: not a number" ),
( L"Cannot subtract: not a number" ),
frame_pointer );
break;
}
@ -518,7 +518,7 @@ struct cons_pointer lisp_subtract( struct
break;
default:
result = throw_exception( c_string_to_lisp_string
( "Cannot subtract: not a number" ),
( L"Cannot subtract: not a number" ),
frame_pointer );
break;
}
@ -580,7 +580,7 @@ struct cons_pointer lisp_divide( struct
break;
default:
result = throw_exception( c_string_to_lisp_string
( "Cannot divide: not a number" ),
( L"Cannot divide: not a number" ),
frame_pointer );
break;
}
@ -615,7 +615,7 @@ struct cons_pointer lisp_divide( struct
break;
default:
result = throw_exception( c_string_to_lisp_string
( "Cannot divide: not a number" ),
( L"Cannot divide: not a number" ),
frame_pointer );
break;
}
@ -627,7 +627,7 @@ struct cons_pointer lisp_divide( struct
break;
default:
result = throw_exception( c_string_to_lisp_string
( "Cannot divide: not a number" ),
( L"Cannot divide: not a number" ),
frame_pointer );
break;
}

52
src/arith/ratio.c
View file

@ -78,7 +78,7 @@ struct cons_pointer simplify_ratio( struct cons_pointer frame_pointer,
} else {
result =
throw_exception( make_cons( c_string_to_lisp_string
( "Shouldn't happen: bad arg to simplify_ratio" ),
( L"Shouldn't happen: bad arg to simplify_ratio" ),
arg ), frame_pointer );
}
@ -97,13 +97,11 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer frame_pointer,
struct cons_pointer arg2 ) {
struct cons_pointer r, result;
#ifdef DEBUG
fputws( L"add_ratio_ratio( arg1 = ", stderr );
print( stderr, arg1 );
fputws( L"; arg2 = ", stderr );
print( stderr, arg2 );
fputws( L")\n", stderr );
#endif
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 );
if ( ratiop( arg1 ) && ratiop( arg2 ) ) {
struct cons_space_object cell1 = pointer2cell( arg1 );
@ -119,9 +117,7 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer frame_pointer,
lcm = least_common_multiple( dr1v, dr2v ),
m1 = lcm / dr1v, m2 = lcm / dr2v;
#ifdef DEBUG
fwprintf( stderr, L"); lcm = %ld; m1 = %ld; m2 = %ld", lcm, m1, m2 );
#endif
debug_printf( DEBUG_ARITH, L"); lcm = %ld; m1 = %ld; m2 = %ld", lcm, m1, m2 );
if ( dr1v == dr2v ) {
r = make_ratio( frame_pointer,
@ -151,17 +147,15 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer frame_pointer,
} else {
result =
throw_exception( make_cons( c_string_to_lisp_string
( "Shouldn't happen: bad arg to add_ratio_ratio" ),
( L"Shouldn't happen: bad arg to add_ratio_ratio" ),
make_cons( arg1,
make_cons( arg2, NIL ) ) ),
frame_pointer );
}
#ifdef DEBUG
fputws( L" => ", stderr );
print( stderr, result );
fputws( L"\n", stderr );
#endif
debug_print( L" => ", DEBUG_ARITH );
debug_print_object( result, DEBUG_ARITH );
debug_print( L"\n", DEBUG_ARITH );
return result;
}
@ -188,7 +182,7 @@ struct cons_pointer add_integer_ratio( struct cons_pointer frame_pointer,
} else {
result =
throw_exception( make_cons( c_string_to_lisp_string
( "Shouldn't happen: bad arg to add_integer_ratio" ),
( L"Shouldn't happen: bad arg to add_integer_ratio" ),
make_cons( intarg,
make_cons( ratarg,
NIL ) ) ),
@ -210,7 +204,8 @@ struct cons_pointer divide_ratio_ratio( struct cons_pointer frame_pointer,
pointer2cell( arg2 ).payload.
ratio.divisor,
pointer2cell( arg2 ).payload.
ratio.dividend ), result =
ratio.dividend ),
result =
multiply_ratio_ratio( frame_pointer, arg1, i );
dec_ref( i );
@ -228,13 +223,12 @@ struct cons_pointer multiply_ratio_ratio( struct cons_pointer frame_pointer, str
cons_pointer arg2 ) {
struct cons_pointer result;
#ifdef DEBUG
fputws( L"multiply_ratio_ratio( arg1 = ", stderr );
print( stderr, arg1 );
fputws( L"; arg2 = ", stderr );
print( stderr, arg2 );
fputws( L")\n", stderr );
#endif
debug_print( L"multiply_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 );
if ( ratiop( arg1 ) && ratiop( arg2 ) ) {
struct cons_space_object cell1 = pointer2cell( arg1 );
struct cons_space_object cell2 = pointer2cell( arg2 );
@ -259,7 +253,7 @@ struct cons_pointer multiply_ratio_ratio( struct cons_pointer frame_pointer, str
} else {
result =
throw_exception( c_string_to_lisp_string
( "Shouldn't happen: bad arg to multiply_ratio_ratio" ),
( L"Shouldn't happen: bad arg to multiply_ratio_ratio" ),
frame_pointer );
}
@ -286,7 +280,7 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer frame_pointer,
} else {
result =
throw_exception( c_string_to_lisp_string
( "Shouldn't happen: bad arg to multiply_integer_ratio" ),
( L"Shouldn't happen: bad arg to multiply_integer_ratio" ),
frame_pointer );
}
@ -329,7 +323,7 @@ struct cons_pointer make_ratio( struct cons_pointer frame_pointer,
} else {
result =
throw_exception( c_string_to_lisp_string
( "Dividend and divisor of a ratio must be integers" ),
( L"Dividend and divisor of a ratio must be integers" ),
frame_pointer );
}
debug_dump_object( result, DEBUG_ARITH );