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

Whitespace changes only - trying to keep the format regular

Browse source
This commit is contained in:
simon 2017-09-14 19:02:03 +01:00
parent e43c9a7b33
commit 79f7492390
13 changed files with 131 additions and 133 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
src/consspaceobject.c
View file

@ -74,7 +74,7 @@ void dump_object( FILE * output, struct cons_pointer pointer ) {
cell.tag.bytes[3], cell.tag.bytes[3],
cell.tag.value, pointer.page, pointer.offset, cell.count ); cell.tag.value, pointer.page, pointer.offset, cell.count );
switch ( cell.tag.value) { switch ( cell.tag.value ) {
case CONSTV: case CONSTV:
fwprintf( output, fwprintf( output,
L"\t\tCons cell: car at page %d offset %d, cdr at page %d offset %d\n", L"\t\tCons cell: car at page %d offset %d, cdr at page %d offset %d\n",
@ -101,9 +101,9 @@ void dump_object( FILE * output, struct cons_pointer pointer ) {
cell.payload.string.character, cell.payload.string.character,
cell.payload.string.cdr.page, cell.payload.string.cdr.page,
cell.payload.string.cdr.offset ); cell.payload.string.cdr.offset );
fwprintf( output, L"\t\t value:"); fwprintf( output, L"\t\t value:" );
print(output, pointer); print( output, pointer );
fwprintf( output, L"\n"); fwprintf( output, L"\n" );
break; break;
case SYMBOLTV: case SYMBOLTV:
fwprintf( output, fwprintf( output,
@ -111,9 +111,9 @@ void dump_object( FILE * output, struct cons_pointer pointer ) {
cell.payload.string.character, cell.payload.string.character,
cell.payload.string.cdr.page, cell.payload.string.cdr.page,
cell.payload.string.cdr.offset ); cell.payload.string.cdr.offset );
fwprintf( output, L"\t\t value:"); fwprintf( output, L"\t\t value:" );
print(output, pointer); print( output, pointer );
fwprintf( output, L"\n"); fwprintf( output, L"\n" );
break; break;
} }
} }

12
src/init.c
View file

@ -26,14 +26,14 @@
void bind_function( char *name, struct cons_pointer ( *executable ) void bind_function( char *name, struct cons_pointer ( *executable )
( struct stack_frame *, struct cons_pointer ) ) { ( struct stack_frame *, struct cons_pointer ) ) {
deep_bind( c_string_to_lisp_symbol( name ), deep_bind( c_string_to_lisp_symbol( name ),
make_function( NIL, executable )); make_function( NIL, executable ) );
} }
void bind_special( char *name, struct cons_pointer ( *executable ) void bind_special( char *name, struct cons_pointer ( *executable )
( struct cons_pointer s_expr, struct cons_pointer env, ( struct cons_pointer s_expr, struct cons_pointer env,
struct stack_frame * frame ) ) { struct stack_frame * frame ) ) {
deep_bind( c_string_to_lisp_symbol( name ), deep_bind( c_string_to_lisp_symbol( name ),
make_special( NIL, executable )); make_special( NIL, executable ) );
} }
int main( int argc, char *argv[] ) { int main( int argc, char *argv[] ) {
@ -88,9 +88,9 @@ int main( int argc, char *argv[] ) {
bind_function( "read", &lisp_read ); bind_function( "read", &lisp_read );
bind_function( "print", &lisp_print ); bind_function( "print", &lisp_print );
bind_function( "add", &lisp_add); bind_function( "add", &lisp_add );
bind_function( "multiply", &lisp_multiply); bind_function( "multiply", &lisp_multiply );
bind_function( "subtract", &lisp_subtract); bind_function( "subtract", &lisp_subtract );
/* /*
* primitive special forms * primitive special forms
@ -102,7 +102,7 @@ int main( int argc, char *argv[] ) {
/* bind the oblist last, at this stage. Something clever needs to be done /* bind the oblist last, at this stage. Something clever needs to be done
* here and I'm not sure what it is. */ * here and I'm not sure what it is. */
deep_bind( c_string_to_lisp_symbol( "oblist"), oblist); deep_bind( c_string_to_lisp_symbol( "oblist" ), oblist );
repl( stdin, stdout, stderr, show_prompt ); repl( stdin, stdout, stderr, show_prompt );

2
src/lispops.c
View file

@ -166,7 +166,7 @@ lisp_eval( struct cons_pointer s_expr, struct cons_pointer env,
switch ( cell.tag.value ) { switch ( cell.tag.value ) {
case CONSTV: case CONSTV:
result = eval_cons( s_expr, env, previous); result = eval_cons( s_expr, env, previous );
break; break;
case SYMBOLTV: case SYMBOLTV:

88
src/peano.c
View file

@ -32,39 +32,37 @@
* @return a pointer to an integer or real. * @return a pointer to an integer or real.
*/ */
struct cons_pointer struct cons_pointer
lisp_add(struct stack_frame *frame, struct cons_pointer env) { lisp_add( struct stack_frame *frame, struct cons_pointer env ) {
struct cons_pointer result = NIL; struct cons_pointer result = NIL;
long int i_accumulator = 0; long int i_accumulator = 0;
long double d_accumulator = 0; long double d_accumulator = 0;
bool is_int = true; bool is_int = true;
for (int i = 0; i < args_in_frame && !nilp(frame->arg[i]); i++) { for ( int i = 0; i < args_in_frame && !nilp( frame->arg[i] ); i++ ) {
struct cons_space_object arg = pointer2cell(frame->arg[i]); struct cons_space_object arg = pointer2cell( frame->arg[i] );
switch (arg.tag.value) { switch ( arg.tag.value ) {
case INTEGERTV: case INTEGERTV:
i_accumulator += arg.payload.integer.value; i_accumulator += arg.payload.integer.value;
d_accumulator += numeric_value( frame->arg[i]); d_accumulator += numeric_value( frame->arg[i] );
break; break;
case REALTV: case REALTV:
d_accumulator += arg.payload.real.value; d_accumulator += arg.payload.real.value;
is_int = false; is_int = false;
default: default:
lisp_throw( lisp_throw( c_string_to_lisp_string( "Cannot add: not a number" ),
c_string_to_lisp_string("Cannot add: not a number"), frame );
frame);
} }
if (! nilp(frame->more)) { if ( !nilp( frame->more ) ) {
lisp_throw( lisp_throw( c_string_to_lisp_string
c_string_to_lisp_string("Cannot yet add more than 8 numbers"), ( "Cannot yet add more than 8 numbers" ), frame );
frame);
} }
if ( is_int) { if ( is_int ) {
result = make_integer( i_accumulator); result = make_integer( i_accumulator );
} else { } else {
result = make_real( d_accumulator); result = make_real( d_accumulator );
} }
} }
@ -78,39 +76,37 @@ lisp_add(struct stack_frame *frame, struct cons_pointer env) {
* @return a pointer to an integer or real. * @return a pointer to an integer or real.
*/ */
struct cons_pointer struct cons_pointer
lisp_multiply(struct stack_frame *frame, struct cons_pointer env) { lisp_multiply( struct stack_frame *frame, struct cons_pointer env ) {
struct cons_pointer result = NIL; struct cons_pointer result = NIL;
long int i_accumulator = 1; long int i_accumulator = 1;
long double d_accumulator = 1; long double d_accumulator = 1;
bool is_int = true; bool is_int = true;
for (int i = 0; i < args_in_frame && !nilp(frame->arg[i]); i++) { for ( int i = 0; i < args_in_frame && !nilp( frame->arg[i] ); i++ ) {
struct cons_space_object arg = pointer2cell(frame->arg[i]); struct cons_space_object arg = pointer2cell( frame->arg[i] );
switch (arg.tag.value) { switch ( arg.tag.value ) {
case INTEGERTV: case INTEGERTV:
i_accumulator *= arg.payload.integer.value; i_accumulator *= arg.payload.integer.value;
d_accumulator *= numeric_value( frame->arg[i]); d_accumulator *= numeric_value( frame->arg[i] );
break; break;
case REALTV: case REALTV:
d_accumulator *= arg.payload.real.value; d_accumulator *= arg.payload.real.value;
is_int = false; is_int = false;
default: default:
lisp_throw( lisp_throw( c_string_to_lisp_string
c_string_to_lisp_string("Cannot multiply: not a number"), ( "Cannot multiply: not a number" ), frame );
frame);
} }
if (! nilp(frame->more)) { if ( !nilp( frame->more ) ) {
lisp_throw( lisp_throw( c_string_to_lisp_string
c_string_to_lisp_string("Cannot yet multiply more than 8 numbers"), ( "Cannot yet multiply more than 8 numbers" ), frame );
frame);
} }
if ( is_int) { if ( is_int ) {
result = make_integer( i_accumulator); result = make_integer( i_accumulator );
} else { } else {
result = make_real( d_accumulator); result = make_real( d_accumulator );
} }
} }
@ -124,26 +120,30 @@ lisp_multiply(struct stack_frame *frame, struct cons_pointer env) {
* @return a pointer to an integer or real. * @return a pointer to an integer or real.
*/ */
struct cons_pointer struct cons_pointer
lisp_subtract(struct stack_frame *frame, struct cons_pointer env) { lisp_subtract( struct stack_frame *frame, struct cons_pointer env ) {
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 ( integerp(frame->arg[0]) && integerp(frame->arg[1])) { if ( integerp( frame->arg[0] ) && integerp( frame->arg[1] ) ) {
result = make_integer(arg0.payload.integer.value - arg1.payload.integer.value); result =
} else if ( realp(frame->arg[0]) && realp(frame->arg[1])) { make_integer( arg0.payload.integer.value -
result = make_real(arg0.payload.real.value - arg1.payload.real.value); arg1.payload.integer.value );
} else if (integerp(frame->arg[0]) && realp(frame->arg[1])) { } else if ( realp( frame->arg[0] ) && realp( frame->arg[1] ) ) {
result = make_real( numeric_value(frame->arg[0]) - arg1.payload.real.value); result =
} else if (realp(frame->arg[0]) && integerp(frame->arg[1])) { make_real( arg0.payload.real.value - arg1.payload.real.value );
result = make_real( arg0.payload.real.value - numeric_value(frame->arg[0])); } else if ( integerp( frame->arg[0] ) && realp( frame->arg[1] ) ) {
result =
make_real( numeric_value( frame->arg[0] ) -
arg1.payload.real.value );
} else if ( realp( frame->arg[0] ) && integerp( frame->arg[1] ) ) {
result =
make_real( arg0.payload.real.value -
numeric_value( frame->arg[0] ) );
} // else we have an error! } // else we have an error!
// and if not nilp[frame->arg[2]) we also have an error. // and if not nilp[frame->arg[2]) we also have an error.
return result; return result;
} }

14
src/peano.h
View file

@ -22,8 +22,8 @@ extern "C" {
* @param frame the stack frame. * @param frame the stack frame.
* @return a pointer to an integer or real. * @return a pointer to an integer or real.
*/ */
struct cons_pointer struct cons_pointer
lisp_add(struct stack_frame *frame, struct cons_pointer env); lisp_add( struct stack_frame *frame, struct cons_pointer env );
/** /**
* Multiply an indefinite number of numbers together * Multiply an indefinite number of numbers together
@ -31,8 +31,8 @@ lisp_add(struct stack_frame *frame, struct cons_pointer env);
* @param frame the stack frame. * @param frame the stack frame.
* @return a pointer to an integer or real. * @return a pointer to an integer or real.
*/ */
struct cons_pointer struct cons_pointer
lisp_multiply(struct stack_frame *frame, struct cons_pointer env); lisp_multiply( struct stack_frame *frame, struct cons_pointer env );
/** /**
* Subtract one number from another. * Subtract one number from another.
@ -40,12 +40,10 @@ lisp_multiply(struct stack_frame *frame, struct cons_pointer env);
* @param frame the stack frame. * @param frame the stack frame.
* @return a pointer to an integer or real. * @return a pointer to an integer or real.
*/ */
struct cons_pointer struct cons_pointer
lisp_subtract(struct stack_frame *frame, struct cons_pointer env); lisp_subtract( struct stack_frame *frame, struct cons_pointer env );
#ifdef __cplusplus #ifdef __cplusplus
} }
#endif #endif
#endif /* PEANO_H */ #endif /* PEANO_H */

4
src/print.c
View file

@ -101,10 +101,10 @@ void print( FILE * output, struct cons_pointer pointer ) {
fwprintf( output, L"t" ); fwprintf( output, L"t" );
break; break;
case FUNCTIONTV: case FUNCTIONTV:
fwprintf( output, L"(Function)"); fwprintf( output, L"(Function)" );
break; break;
case SPECIALTV: case SPECIALTV:
fwprintf( output, L"(Special form)"); fwprintf( output, L"(Special form)" );
break; break;
default: default:
fwprintf( stderr, fwprintf( stderr,

8
src/read.c
View file

@ -112,11 +112,11 @@ struct cons_pointer read_number( FILE * input, wint_t initial ) {
ungetwc( c, input ); ungetwc( c, input );
if ( seen_period ) { if ( seen_period ) {
long double rv = (long double) long double rv = ( long double )
( accumulator / pow(10, places_of_decimals) ); ( accumulator / pow( 10, places_of_decimals ) );
fwprintf( stderr, L"read_numer returning %Lf\n", rv); fwprintf( stderr, L"read_numer returning %Lf\n", rv );
result = make_real( rv); result = make_real( rv );
} else { } else {
result = make_integer( accumulator ); result = make_integer( accumulator );
} }

2
src/real.h
View file

@ -24,7 +24,7 @@ extern "C" {
* @param value the value to wrap; * @param value the value to wrap;
* @return a real number cell wrapping this value. * @return a real number cell wrapping this value.
*/ */
struct cons_pointer make_real( double value ); struct cons_pointer make_real( double value );
#ifdef __cplusplus #ifdef __cplusplus
} }

4
src/repl.c
View file

@ -31,13 +31,13 @@ repl( FILE * in_stream, FILE * out_stream, FILE * error_stream,
struct cons_pointer input = read( in_stream ); struct cons_pointer input = read( in_stream );
fwprintf( error_stream, L"\nread {%d,%d}=> ", input.page, fwprintf( error_stream, L"\nread {%d,%d}=> ", input.page,
input.offset ); input.offset );
print( error_stream, input); print( error_stream, input );
struct cons_pointer value = lisp_eval( input, oblist, NULL ); struct cons_pointer value = lisp_eval( input, oblist, NULL );
// print( out_stream, input ); // print( out_stream, input );
fwprintf( out_stream, L"\n" ); fwprintf( out_stream, L"\n" );
fwprintf( error_stream, L"\neval {%d,%d}=> ", input.page, fwprintf( error_stream, L"\neval {%d,%d}=> ", input.page,
input.offset ); input.offset );
print( out_stream, value); print( out_stream, value );
} }
} }

6
src/stack.c
View file

@ -51,7 +51,7 @@ struct stack_frame *make_stack_frame( struct stack_frame *previous,
result->arg[i] = NIL; result->arg[i] = NIL;
} }
for (int i = 0; i < args_in_frame && !nilp( args ); i++ ) { for ( int i = 0; i < args_in_frame && !nilp( args ); i++ ) {
/* iterate down the arg list filling in the arg slots in the /* iterate down the arg list filling in the arg slots in the
* frame. When there are no more slots, if there are still args, * frame. When there are no more slots, if there are still args,
* stash them on more */ * stash them on more */
@ -105,7 +105,7 @@ struct stack_frame *make_special_frame( struct stack_frame *previous,
result->arg[i] = NIL; result->arg[i] = NIL;
} }
for (int i = 0; i < args_in_frame && !nilp( args ); i++ ) { for ( int i = 0; i < args_in_frame && !nilp( args ); i++ ) {
/* iterate down the arg list filling in the arg slots in the /* iterate down the arg list filling in the arg slots in the
* frame. When there are no more slots, if there are still args, * frame. When there are no more slots, if there are still args,
* stash them on more */ * stash them on more */
@ -117,7 +117,7 @@ struct stack_frame *make_special_frame( struct stack_frame *previous,
args = cell.payload.cons.cdr; args = cell.payload.cons.cdr;
} }
result->more = args; result->more = args;
inc_ref(args); inc_ref( args );
return result; return result;
} }