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

45
src/ops/lispops.c
View file

@ -193,7 +193,7 @@ struct cons_pointer
eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
struct cons_pointer frame_pointer, struct cons_pointer env ) {
struct cons_pointer result = NIL;
fwprintf( stderr, L"eval_lambda called\n" );
debug_print( L"eval_lambda called\n", DEBUG_EVAL );
struct cons_pointer new_env = env;
struct cons_pointer names = cell.payload.lambda.args;
@ -355,13 +355,12 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
break;
default:
{
char *buffer = malloc( 1024 );
memset( buffer, '\0', 1024 );
sprintf( buffer,
"Unexpected cell with tag %d (%c%c%c%c) in function position",
fn_cell.tag.value, fn_cell.tag.bytes[0],
fn_cell.tag.bytes[1], fn_cell.tag.bytes[2],
fn_cell.tag.bytes[3] );
int bs = sizeof(wchar_t) * 1024;
wchar_t *buffer = malloc( bs );
memset( buffer, '\0', bs );
swprintf( buffer, bs,
L"Unexpected cell with tag %d (%4.4s) in function position",
fn_cell.tag.value, &fn_cell.tag.bytes[0] );
struct cons_pointer message =
c_string_to_lisp_string( buffer );
free( buffer );
@ -380,13 +379,13 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
* @return As a Lisp string, the tag of the object which is at that pointer.
*/
struct cons_pointer c_type( struct cons_pointer pointer ) {
char *buffer = malloc( TAGLENGTH + 1 );
memset( buffer, 0, TAGLENGTH + 1 );
struct cons_pointer result = NIL;
struct cons_space_object cell = pointer2cell( pointer );
strncpy( buffer, cell.tag.bytes, TAGLENGTH );
struct cons_pointer result = c_string_to_lisp_string( buffer );
free( buffer );
for (int i = TAGLENGTH; i >= 0; i--)
{
result = make_string((wchar_t)cell.tag.bytes[i], result);
}
return result;
}
@ -408,14 +407,12 @@ struct cons_pointer c_type( struct cons_pointer pointer ) {
struct cons_pointer
lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer env ) {
debug_print( L"Eval: ", DEBUG_EVAL );
debug_dump_object( frame_pointer, DEBUG_EVAL );
struct cons_pointer result = frame->arg[0];
struct cons_space_object cell = pointer2cell( frame->arg[0] );
debug_print( L"Eval: ", DEBUG_EVAL );
#ifdef DEBUG
dump_frame( stderr, frame_pointer );
#endif
switch ( cell.tag.value ) {
case CONSTV:
{
@ -430,7 +427,7 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer,
if ( nilp( canonical ) ) {
struct cons_pointer message =
make_cons( c_string_to_lisp_string
( "Attempt to take value of unbound symbol." ),
( L"Attempt to take value of unbound symbol." ),
frame->arg[0] );
result = throw_exception( message, frame_pointer );
} else {
@ -522,7 +519,7 @@ lisp_set( struct stack_frame *frame, struct cons_pointer frame_pointer,
result =
make_exception( make_cons
( c_string_to_lisp_string
( "The first argument to `set!` is not a symbol: " ),
( L"The first argument to `set` is not a symbol: " ),
make_cons( frame->arg[0], NIL ) ),
frame_pointer );
}
@ -556,7 +553,7 @@ lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer,
result =
make_exception( make_cons
( c_string_to_lisp_string
( "The first argument to `set!` is not a symbol: " ),
( L"The first argument to `set!` is not a symbol: " ),
make_cons( frame->arg[0], NIL ) ),
frame_pointer );
}
@ -610,7 +607,7 @@ lisp_car( struct stack_frame *frame, struct cons_pointer frame_pointer,
result = make_string( cell.payload.string.character, NIL );
} else {
struct cons_pointer message =
c_string_to_lisp_string( "Attempt to take CAR of non sequence" );
c_string_to_lisp_string( L"Attempt to take CAR of non sequence" );
result = throw_exception( message, frame_pointer );
}
@ -635,7 +632,7 @@ lisp_cdr( struct stack_frame *frame, struct cons_pointer frame_pointer,
result = cell.payload.string.cdr;
} else {
struct cons_pointer message =
c_string_to_lisp_string( "Attempt to take CDR of non sequence" );
c_string_to_lisp_string( L"Attempt to take CDR of non sequence" );
result = throw_exception( message, frame_pointer );
}
@ -850,7 +847,7 @@ lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer,
done = true;
} else {
result = throw_exception( c_string_to_lisp_string
( "Arguments to `cond` must be lists" ),
( L"Arguments to `cond` must be lists" ),
frame_pointer );
}
}

9
src/ops/print.c
View file

@ -37,7 +37,7 @@ int print_use_colours = 0;
void print_string_contents( FILE * output, struct cons_pointer pointer ) {
while ( stringp( pointer ) || symbolp( pointer ) ) {
struct cons_space_object *cell = &pointer2cell( pointer );
wint_t c = cell->payload.string.character;
wchar_t c = cell->payload.string.character;
if ( c != '\0' ) {
fputwc( c, output );
@ -131,7 +131,7 @@ struct cons_pointer print( FILE * output, struct cons_pointer pointer ) {
fwprintf( output, L"%ld%", cell.payload.integer.value );
break;
case LAMBDATV:
print( output, make_cons( c_string_to_lisp_symbol( "lambda" ),
print( output, make_cons( c_string_to_lisp_symbol( L"lambda" ),
make_cons( cell.payload.lambda.args,
cell.payload.lambda.
body ) ) );
@ -140,7 +140,7 @@ struct cons_pointer print( FILE * output, struct cons_pointer pointer ) {
fwprintf( output, L"nil" );
break;
case NLAMBDATV:
print( output, make_cons( c_string_to_lisp_symbol( "nlambda" ),
print( output, make_cons( c_string_to_lisp_symbol( L"nlambda" ),
make_cons( cell.payload.lambda.args,
cell.payload.lambda.
body ) ) );
@ -190,6 +190,9 @@ struct cons_pointer print( FILE * output, struct cons_pointer pointer ) {
case TRUETV:
fwprintf( output, L"t" );
break;
case WRITETV:
fwprintf( output, L"(Output stream)" );
break;
default:
fwprintf( stderr,
L"%sError: Unrecognised tag value %d (%c%c%c%c)\n",

36
src/ops/read.c
View file

@ -49,7 +49,7 @@ struct cons_pointer read_symbol( FILE * input, wint_t initial );
* quote reader macro in C (!)
*/
struct cons_pointer c_quote( struct cons_pointer arg ) {
return make_cons( c_string_to_lisp_symbol( "quote" ),
return make_cons( c_string_to_lisp_symbol( L"quote" ),
make_cons( arg, NIL ) );
}
@ -71,8 +71,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
if ( feof( input ) ) {
result =
make_exception( c_string_to_lisp_string
( "End of file while reading" ), frame_pointer );
throw_exception( c_string_to_lisp_string
( L"End of file while reading" ), frame_pointer );
} else {
switch ( c ) {
case ';':
@ -81,7 +81,7 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
break;
case EOF:
result = throw_exception( c_string_to_lisp_string
( "End of input while reading" ),
( L"End of input while reading" ),
frame_pointer );
break;
case '\'':
@ -136,8 +136,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
result = read_symbol( input, c );
} else {
result =
make_exception( make_cons( c_string_to_lisp_string
( "Unrecognised start of input character" ),
throw_exception( make_cons( c_string_to_lisp_string
( L"Unrecognised start of input character" ),
make_string( c, NIL ) ),
frame_pointer );
}
@ -170,23 +170,23 @@ struct cons_pointer read_number( struct stack_frame *frame,
if ( negative ) {
initial = fgetwc( input );
}
#ifdef DEBUG
fwprintf( stderr, L"read_number starting '%c' (%d)\n", initial, initial );
#endif
debug_printf( DEBUG_IO, L"read_number starting '%c' (%d)\n", initial, initial );
for ( c = initial; iswdigit( c )
|| c == btowc( '.' ) || c == btowc( '/' ); c = fgetwc( input ) ) {
if ( c == btowc( '.' ) ) {
if ( seen_period || dividend != 0 ) {
return make_exception( c_string_to_lisp_string
( "Malformed number: too many periods" ),
return throw_exception( c_string_to_lisp_string
( L"Malformed number: too many periods" ),
frame_pointer );
} else {
seen_period = true;
}
} else if ( c == btowc( '/' ) ) {
if ( seen_period || dividend > 0 ) {
return make_exception( c_string_to_lisp_string
( "Malformed number: dividend of rational must be integer" ),
return throw_exception( c_string_to_lisp_string
( L"Malformed number: dividend of rational must be integer" ),
frame_pointer );
} else {
dividend = negative ? 0 - accumulator : accumulator;
@ -195,11 +195,11 @@ struct cons_pointer read_number( struct stack_frame *frame,
}
} else {
accumulator = accumulator * 10 + ( ( int ) c - ( int ) '0' );
#ifdef DEBUG
fwprintf( stderr,
debug_printf( DEBUG_IO,
L"Added character %c, accumulator now %ld\n",
c, accumulator );
#endif
if ( seen_period ) {
places_of_decimals++;
}
@ -243,10 +243,8 @@ struct cons_pointer read_list( struct stack_frame *frame,
FILE * input, wint_t initial ) {
struct cons_pointer result = NIL;
if ( initial != ')' ) {
#ifdef DEBUG
fwprintf( stderr,
debug_printf( DEBUG_IO,
L"read_list starting '%C' (%d)\n", initial, initial );
#endif
struct cons_pointer car =
read_continuation( frame, frame_pointer, input,
initial );