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

Horribly broken, may have to rethink.

Browse source
This commit is contained in:
Simon Brooke 2018-12-26 21:10:24 +00:00
parent 9937f344dc
commit 3d5c27cb10
19 changed files with 568 additions and 413 deletions
Download patch file Download diff file Expand all files Collapse all files

104
src/arith/peano.c
View file

@ -28,7 +28,9 @@
long double to_long_double( struct cons_pointer arg );
int64_t to_long_int( struct cons_pointer arg );
struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer arg1,
struct cons_pointer add_2( struct stack_frame *frame,
struct cons_pointer frame_pointer,
struct cons_pointer arg1,
struct cons_pointer arg2 );
@ -119,7 +121,9 @@ int64_t to_long_int( struct cons_pointer arg ) {
* return a cons_pointer indicating a number which is the sum of
* the numbers indicated by `arg1` and `arg2`.
*/
struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer arg1,
struct cons_pointer add_2( struct stack_frame *frame,
struct cons_pointer frame_pointer,
struct cons_pointer arg1,
struct cons_pointer arg2 ) {
struct cons_pointer result;
struct cons_space_object cell1 = pointer2cell( arg1 );
@ -153,7 +157,8 @@ struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer frame_
cell2.payload.integer.value );
break;
case RATIOTV:
result = add_integer_ratio( frame_pointer, arg1, arg2 );
result =
add_integer_ratio( frame_pointer, arg1, arg2 );
break;
case REALTV:
result =
@ -162,8 +167,8 @@ struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer frame_
break;
default:
result = throw_exception( c_string_to_lisp_string
( "Cannot add: not a number" ),
frame_pointer );
( "Cannot add: not a number" ),
frame_pointer );
break;
}
break;
@ -173,7 +178,8 @@ struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer frame_
result = arg2;
break;
case INTEGERTV:
result = add_integer_ratio( frame_pointer, arg2, arg1 );
result =
add_integer_ratio( frame_pointer, arg2, arg1 );
break;
case RATIOTV:
result = add_ratio_ratio( frame_pointer, arg1, arg2 );
@ -185,8 +191,8 @@ struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer frame_
break;
default:
result = throw_exception( c_string_to_lisp_string
( "Cannot add: not a number" ),
frame_pointer );
( "Cannot add: not a number" ),
frame_pointer );
break;
}
break;
@ -198,7 +204,8 @@ struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer frame_
default:
result = exceptionp( arg2 ) ? arg2 :
throw_exception( c_string_to_lisp_string
( "Cannot add: not a number" ), frame_pointer );
( "Cannot add: not a number" ),
frame_pointer );
}
}
@ -252,7 +259,8 @@ struct cons_pointer lisp_add( struct stack_frame
* return a cons_pointer indicating a number which is the product of
* the numbers indicated by `arg1` and `arg2`.
*/
struct cons_pointer multiply_2( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer multiply_2( struct stack_frame *frame,
struct cons_pointer frame_pointer,
struct cons_pointer arg1,
struct cons_pointer arg2 ) {
struct cons_pointer result;
@ -286,7 +294,9 @@ struct cons_pointer multiply_2( struct stack_frame *frame, struct cons_pointer f
cell2.payload.integer.value );
break;
case RATIOTV:
result = multiply_integer_ratio( frame_pointer, arg1, arg2 );
result =
multiply_integer_ratio( frame_pointer, arg1,
arg2 );
break;
case REALTV:
result =
@ -295,8 +305,8 @@ struct cons_pointer multiply_2( struct stack_frame *frame, struct cons_pointer f
break;
default:
result = throw_exception( c_string_to_lisp_string
( "Cannot multiply: not a number" ),
frame_pointer );
( "Cannot multiply: not a number" ),
frame_pointer );
break;
}
break;
@ -306,10 +316,13 @@ struct cons_pointer multiply_2( struct stack_frame *frame, struct cons_pointer f
result = arg2;
break;
case INTEGERTV:
result = multiply_integer_ratio( frame_pointer, arg2, arg1 );
result =
multiply_integer_ratio( frame_pointer, arg2,
arg1 );
break;
case RATIOTV:
result = multiply_ratio_ratio( frame_pointer, arg1, arg2 );
result =
multiply_ratio_ratio( frame_pointer, arg1, arg2 );
break;
case REALTV:
result =
@ -318,8 +331,8 @@ struct cons_pointer multiply_2( struct stack_frame *frame, struct cons_pointer f
break;
default:
result = throw_exception( c_string_to_lisp_string
( "Cannot multiply: not a number" ),
frame_pointer );
( "Cannot multiply: not a number" ),
frame_pointer );
}
break;
case REALTV:
@ -329,8 +342,8 @@ struct cons_pointer multiply_2( struct stack_frame *frame, struct cons_pointer f
break;
default:
result = throw_exception( c_string_to_lisp_string
( "Cannot multiply: not a number" ),
frame_pointer );
( "Cannot multiply: not a number" ),
frame_pointer );
break;
}
}
@ -406,8 +419,8 @@ struct cons_pointer inverse( struct cons_pointer frame,
case RATIOTV:
result = make_ratio( frame,
make_integer( 0 -
to_long_int( cell.payload.ratio.
dividend ) ),
to_long_int( cell.payload.
ratio.dividend ) ),
cell.payload.ratio.divisor );
break;
case REALTV:
@ -453,9 +466,10 @@ struct cons_pointer lisp_subtract( struct
struct cons_pointer tmp =
make_ratio( frame_pointer, frame->arg[0],
make_integer( 1 ) );
inc_ref(tmp);
inc_ref( tmp );
result =
subtract_ratio_ratio( frame_pointer, tmp, frame->arg[1] );
subtract_ratio_ratio( frame_pointer, tmp,
frame->arg[1] );
dec_ref( tmp );
}
break;
@ -466,8 +480,8 @@ struct cons_pointer lisp_subtract( struct
break;
default:
result = throw_exception( c_string_to_lisp_string
( "Cannot subtract: not a number" ),
frame_pointer );
( "Cannot subtract: not a number" ),
frame_pointer );
break;
}
break;
@ -480,9 +494,10 @@ struct cons_pointer lisp_subtract( struct
struct cons_pointer tmp =
make_ratio( frame_pointer, frame->arg[1],
make_integer( 1 ) );
inc_ref(tmp);
inc_ref( tmp );
result =
subtract_ratio_ratio( frame_pointer, frame->arg[0], tmp );
subtract_ratio_ratio( frame_pointer, frame->arg[0],
tmp );
dec_ref( tmp );
}
break;
@ -498,8 +513,8 @@ struct cons_pointer lisp_subtract( struct
break;
default:
result = throw_exception( c_string_to_lisp_string
( "Cannot subtract: not a number" ),
frame_pointer );
( "Cannot subtract: not a number" ),
frame_pointer );
break;
}
break;
@ -510,7 +525,8 @@ struct cons_pointer lisp_subtract( struct
break;
default:
result = throw_exception( c_string_to_lisp_string
( "Cannot subtract: not a number" ), frame_pointer );
( "Cannot subtract: not a number" ),
frame_pointer );
break;
}
@ -527,7 +543,7 @@ struct cons_pointer lisp_subtract( struct
*/
struct cons_pointer lisp_divide( struct
stack_frame
*frame, struct cons_pointer frame_pointer, struct
*frame, struct cons_pointer frame_pointer, struct
cons_pointer env ) {
struct cons_pointer result = NIL;
struct cons_space_object arg0 = pointer2cell( frame->arg[0] );
@ -544,7 +560,8 @@ struct cons_pointer lisp_divide( struct
break;
case INTEGERTV:{
struct cons_pointer unsimplified =
make_ratio( frame_pointer, frame->arg[0], frame->arg[1] );
make_ratio( frame_pointer, 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( frame_pointer, unsimplified );
@ -558,7 +575,8 @@ struct cons_pointer lisp_divide( struct
struct cons_pointer ratio =
make_ratio( frame_pointer, frame->arg[0], one );
result =
divide_ratio_ratio( frame_pointer, ratio, frame->arg[1] );
divide_ratio_ratio( frame_pointer, ratio,
frame->arg[1] );
dec_ref( ratio );
}
break;
@ -569,8 +587,8 @@ struct cons_pointer lisp_divide( struct
break;
default:
result = throw_exception( c_string_to_lisp_string
( "Cannot divide: not a number" ),
frame_pointer );
( "Cannot divide: not a number" ),
frame_pointer );
break;
}
break;
@ -581,14 +599,15 @@ struct cons_pointer lisp_divide( struct
break;
case INTEGERTV:{
struct cons_pointer one = make_integer( 1 );
inc_ref( one);
inc_ref( one );
struct cons_pointer ratio =
make_ratio( frame_pointer, frame->arg[1], one );
inc_ref(ratio);
inc_ref( ratio );
result =
divide_ratio_ratio( frame_pointer, frame->arg[0], ratio );
divide_ratio_ratio( frame_pointer, frame->arg[0],
ratio );
dec_ref( ratio );
dec_ref(one);
dec_ref( one );
}
break;
case RATIOTV:
@ -603,8 +622,8 @@ struct cons_pointer lisp_divide( struct
break;
default:
result = throw_exception( c_string_to_lisp_string
( "Cannot divide: not a number" ),
frame_pointer );
( "Cannot divide: not a number" ),
frame_pointer );
break;
}
break;
@ -615,7 +634,8 @@ struct cons_pointer lisp_divide( struct
break;
default:
result = throw_exception( c_string_to_lisp_string
( "Cannot divide: not a number" ), frame_pointer );
( "Cannot divide: not a number" ),
frame_pointer );
break;
}

14
src/arith/peano.h
View file

@ -23,7 +23,8 @@ extern "C" {
* @return a pointer to an integer or real.
*/
struct cons_pointer
lisp_add( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env );
lisp_add( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer env );
/**
* Multiply an indefinite number of numbers together
@ -32,7 +33,9 @@ extern "C" {
* @return a pointer to an integer or real.
*/
struct cons_pointer
lisp_multiply( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env );
lisp_multiply( struct stack_frame *frame,
struct cons_pointer frame_pointer,
struct cons_pointer env );
/**
* Subtract one number from another.
@ -41,7 +44,9 @@ extern "C" {
* @return a pointer to an integer or real.
*/
struct cons_pointer
lisp_subtract( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env );
lisp_subtract( struct stack_frame *frame,
struct cons_pointer frame_pointer,
struct cons_pointer env );
/**
* Divide one number by another.
@ -50,7 +55,8 @@ extern "C" {
* @return a pointer to an integer or real.
*/
struct cons_pointer
lisp_divide( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env );
lisp_divide( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer env );
#ifdef __cplusplus
}

69
src/arith/ratio.c
View file

@ -61,10 +61,10 @@ struct cons_pointer simplify_ratio( struct cons_pointer frame_pointer,
if ( ratiop( arg ) ) {
int64_t ddrv =
pointer2cell( pointer2cell( arg ).payload.ratio.dividend ).payload.
integer.value, drrv =
pointer2cell( pointer2cell( arg ).payload.ratio.divisor ).payload.
integer.value, gcd = greatest_common_divisor( ddrv, drrv );
pointer2cell( pointer2cell( arg ).payload.ratio.dividend ).
payload.integer.value, drrv =
pointer2cell( pointer2cell( arg ).payload.ratio.divisor ).
payload.integer.value, gcd = greatest_common_divisor( ddrv, drrv );
if ( gcd > 1 ) {
if ( drrv / gcd == 1 ) {
@ -78,8 +78,8 @@ 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" ),
arg ), frame_pointer );
( "Shouldn't happen: bad arg to simplify_ratio" ),
arg ), frame_pointer );
}
return result;
@ -124,7 +124,7 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer frame_pointer,
#endif
if ( dr1v == dr2v ) {
r = make_ratio( frame_pointer,
r = make_ratio( frame_pointer,
make_integer( dd1v + dd2v ),
cell1.payload.ratio.divisor );
} else {
@ -132,8 +132,8 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer frame_pointer,
dr1vm = make_integer( dr1v * m1 ),
dd2vm = make_integer( dd2v * m2 ),
dr2vm = make_integer( dr2v * m2 ),
r1 = make_ratio( frame_pointer, dd1vm, dr1vm ),
r2 = make_ratio( frame_pointer, dd2vm, dr2vm );
r1 = make_ratio( frame_pointer, dd1vm, dr1vm ),
r2 = make_ratio( frame_pointer, dd2vm, dr2vm );
r = add_ratio_ratio( frame_pointer, r1, r2 );
@ -144,17 +144,17 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer frame_pointer,
dec_ref( r2 );
}
result = simplify_ratio( frame_pointer, r );
result = simplify_ratio( frame_pointer, r );
if ( !eq( r, result ) ) {
dec_ref( r );
}
} else {
result =
throw_exception( make_cons( c_string_to_lisp_string
( "Shouldn't happen: bad arg to add_ratio_ratio" ),
make_cons( arg1,
make_cons( arg2, NIL ) ) ),
frame_pointer );
( "Shouldn't happen: bad arg to add_ratio_ratio" ),
make_cons( arg1,
make_cons( arg2, NIL ) ) ),
frame_pointer );
}
#ifdef DEBUG
@ -181,17 +181,18 @@ struct cons_pointer add_integer_ratio( struct cons_pointer frame_pointer,
struct cons_pointer one = make_integer( 1 ),
ratio = make_ratio( frame_pointer, intarg, one );
result = add_ratio_ratio( frame_pointer, ratio, ratarg );
result = add_ratio_ratio( frame_pointer, ratio, ratarg );
dec_ref( one );
dec_ref( ratio );
} else {
result =
throw_exception( make_cons( c_string_to_lisp_string
( "Shouldn't happen: bad arg to add_integer_ratio" ),
make_cons( intarg,
make_cons( ratarg, NIL ) ) ),
frame_pointer );
( "Shouldn't happen: bad arg to add_integer_ratio" ),
make_cons( intarg,
make_cons( ratarg,
NIL ) ) ),
frame_pointer );
}
return result;
@ -205,12 +206,12 @@ struct cons_pointer add_integer_ratio( struct cons_pointer frame_pointer,
struct cons_pointer divide_ratio_ratio( struct cons_pointer frame_pointer,
struct cons_pointer arg1,
struct cons_pointer arg2 ) {
struct cons_pointer i = make_ratio( frame_pointer,
pointer2cell( arg2 ).payload.ratio.
divisor,
pointer2cell( arg2 ).payload.ratio.
dividend ), result =
multiply_ratio_ratio( frame_pointer, arg1, i );
struct cons_pointer i = make_ratio( frame_pointer,
pointer2cell( arg2 ).payload.
ratio.divisor,
pointer2cell( arg2 ).payload.
ratio.dividend ), result =
multiply_ratio_ratio( frame_pointer, arg1, i );
dec_ref( i );
@ -248,7 +249,7 @@ struct cons_pointer multiply_ratio_ratio( struct cons_pointer frame_pointer, str
ddrv = dd1v * dd2v, drrv = dr1v * dr2v;
struct cons_pointer unsimplified =
make_ratio( frame_pointer, make_integer( ddrv ),
make_ratio( frame_pointer, make_integer( ddrv ),
make_integer( drrv ) );
result = simplify_ratio( frame_pointer, unsimplified );
@ -258,8 +259,8 @@ 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" ),
frame_pointer );
( "Shouldn't happen: bad arg to multiply_ratio_ratio" ),
frame_pointer );
}
return result;
@ -278,15 +279,15 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer frame_pointer,
if ( integerp( intarg ) && ratiop( ratarg ) ) {
struct cons_pointer one = make_integer( 1 ),
ratio = make_ratio( frame_pointer, intarg, one );
result = multiply_ratio_ratio( frame_pointer, ratio, ratarg );
result = multiply_ratio_ratio( frame_pointer, ratio, ratarg );
dec_ref( one );
dec_ref( ratio );
} else {
result =
throw_exception( c_string_to_lisp_string
( "Shouldn't happen: bad arg to multiply_integer_ratio" ),
frame_pointer );
( "Shouldn't happen: bad arg to multiply_integer_ratio" ),
frame_pointer );
}
return result;
@ -302,7 +303,7 @@ struct cons_pointer subtract_ratio_ratio( struct cons_pointer frame_pointer,
struct cons_pointer arg1,
struct cons_pointer arg2 ) {
struct cons_pointer i = inverse( frame_pointer, arg2 ),
result = add_ratio_ratio( frame_pointer, arg1, i );
result = add_ratio_ratio( frame_pointer, arg1, i );
dec_ref( i );
@ -328,8 +329,8 @@ 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" ),
frame_pointer );
( "Dividend and divisor of a ratio must be integers" ),
frame_pointer );
}
#ifdef DEBUG
dump_object( stderr, result );

10
src/arith/ratio.h
View file

@ -14,15 +14,15 @@
struct cons_pointer simplify_ratio( struct cons_pointer frame_pointer,
struct cons_pointer arg );
struct cons_pointer add_ratio_ratio( struct cons_pointer frame_pointer,
struct cons_pointer add_ratio_ratio( struct cons_pointer frame_pointer,
struct cons_pointer arg1,
struct cons_pointer arg2 );
struct cons_pointer add_integer_ratio( struct cons_pointer frame_pointer,
struct cons_pointer add_integer_ratio( struct cons_pointer frame_pointer,
struct cons_pointer intarg,
struct cons_pointer ratarg );
struct cons_pointer divide_ratio_ratio( struct cons_pointer frame_pointer,
struct cons_pointer divide_ratio_ratio( struct cons_pointer frame_pointer,
struct cons_pointer arg1,
struct cons_pointer arg2 );
@ -30,11 +30,11 @@ struct cons_pointer multiply_ratio_ratio( struct cons_pointer frame_pointer, str
cons_pointer arg1, struct
cons_pointer arg2 );
struct cons_pointer multiply_integer_ratio( struct cons_pointer frame_pointer,
struct cons_pointer multiply_integer_ratio( struct cons_pointer frame_pointer,
struct cons_pointer intarg,
struct cons_pointer ratarg );
struct cons_pointer subtract_ratio_ratio( struct cons_pointer frame_pointer,
struct cons_pointer subtract_ratio_ratio( struct cons_pointer frame_pointer,
struct cons_pointer arg1,
struct cons_pointer arg2 );

1
src/arith/real.c
View file

@ -9,6 +9,7 @@
#include "conspage.h"
#include "consspaceobject.h"
#include "dump.h"
#include "read.h"
/**