Compiles, most tests break

This commit is contained in:
Simon Brooke 2019-01-27 17:22:13 +00:00
parent b8f241c2c5
commit 0e11adea1c
22 changed files with 902 additions and 714 deletions

View file

@ -29,6 +29,7 @@
#include "debug.h"
#include "dump.h"
#include "equal.h"
#include "fopen.h"
#include "integer.h"
#include "intern.h"
#include "lispops.h"
@ -231,7 +232,7 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
struct cons_pointer name = c_car( names );
struct cons_pointer val = frame->arg[i];
new_env = bind( name, val, new_env );
new_env = set( name, val, new_env );
log_binding( name, val );
names = c_cdr( names );
@ -256,7 +257,7 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
}
}
new_env = bind( names, vals, new_env );
new_env = set( names, vals, new_env );
inc_ref( new_env );
}
@ -377,10 +378,9 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
result = next_pointer;
} else {
result =
( *fn_cell.payload.
special.executable ) ( get_stack_frame
( next_pointer ),
next_pointer, env );
( *fn_cell.payload.special.
executable ) ( get_stack_frame( next_pointer ),
next_pointer, env );
debug_print( L"Special form returning: ", DEBUG_EVAL );
debug_print_object( result, DEBUG_EVAL );
debug_println( DEBUG_EVAL );
@ -627,10 +627,10 @@ lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer,
* @return true if `arg` represents an end of string, else false.
* \todo candidate for moving to a memory/string.c file
*/
bool end_of_stringp(struct cons_pointer arg) {
return nilp(arg) ||
( stringp( arg ) &&
pointer2cell(arg).payload.string.character == (wint_t)'\0');
bool end_of_stringp( struct cons_pointer arg ) {
return nilp( arg ) ||
( stringp( arg ) &&
pointer2cell( arg ).payload.string.character == ( wint_t ) '\0' );
}
/**
@ -656,8 +656,8 @@ lisp_cons( struct stack_frame *frame, struct cons_pointer frame_pointer,
if ( nilp( car ) && nilp( cdr ) ) {
return NIL;
} else if ( stringp( car ) && stringp( cdr ) &&
end_of_stringp( c_cdr( car)) ) {
// \todo check that car is of length 1
end_of_stringp( c_cdr( car ) ) ) {
// \todo check that car is of length 1
result =
make_string( pointer2cell( car ).payload.string.character, cdr );
} else {
@ -691,7 +691,8 @@ lisp_car( struct stack_frame *frame, struct cons_pointer frame_pointer,
result = cell.payload.cons.car;
break;
case READTV:
result = make_string( fgetwc( cell.payload.stream.stream ), NIL );
result =
make_string( url_fgetwc( cell.payload.stream.stream ), NIL );
break;
case NILTV:
break;
@ -734,7 +735,7 @@ lisp_cdr( struct stack_frame *frame, struct cons_pointer frame_pointer,
result = cell.payload.cons.cdr;
break;
case READTV:
fgetwc( cell.payload.stream.stream );
url_fgetwc( cell.payload.stream.stream );
result = frame->arg[0];
break;
case STRINGTV:
@ -839,7 +840,8 @@ lisp_read( struct stack_frame *frame, struct cons_pointer frame_pointer,
#ifdef DEBUG
debug_print( L"entering lisp_read\n", DEBUG_IO );
#endif
URL_FILE *input = stdin;
URL_FILE *input;
struct cons_pointer in_stream = readp( frame->arg[0] ) ?
frame->arg[0] : get_default_stream( true, env );
@ -848,6 +850,8 @@ lisp_read( struct stack_frame *frame, struct cons_pointer frame_pointer,
debug_dump_object( in_stream, DEBUG_IO );
input = pointer2cell( in_stream ).payload.stream.stream;
inc_ref( in_stream );
} else {
input = file_to_url_file( stdin );
}
struct cons_pointer result = read( frame, frame_pointer, input );
@ -856,8 +860,11 @@ lisp_read( struct stack_frame *frame, struct cons_pointer frame_pointer,
if ( readp( in_stream ) ) {
dec_ref( in_stream );
} else {
free( input );
}
return result;
}
@ -922,7 +929,7 @@ lisp_print( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer env ) {
debug_print( L"Entering print\n", DEBUG_IO );
struct cons_pointer result = NIL;
URL_FILE *output = stdout;
URL_FILE *output;
struct cons_pointer out_stream = writep( frame->arg[1] ) ?
frame->arg[1] : get_default_stream( false, env );
@ -931,6 +938,8 @@ lisp_print( struct stack_frame *frame, struct cons_pointer frame_pointer,
debug_dump_object( out_stream, DEBUG_IO );
output = pointer2cell( out_stream ).payload.stream.stream;
inc_ref( out_stream );
} else {
output = file_to_url_file( stderr );
}
debug_print( L"lisp_print: about to print\n", DEBUG_IO );
@ -943,6 +952,8 @@ lisp_print( struct stack_frame *frame, struct cons_pointer frame_pointer,
if ( writep( out_stream ) ) {
dec_ref( out_stream );
} else {
free( output );
}
return result;
@ -1035,7 +1046,7 @@ lisp_progn( struct stack_frame *frame, struct cons_pointer frame_pointer,
* @return the value of the last expression of the first successful `clause`.
*/
struct cons_pointer
lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer,
lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer env ) {
struct cons_pointer result = NIL;
bool done = false;
@ -1165,7 +1176,7 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
* print as parent.
*/
while ( readp( input ) && writep( output )
&& !feof( pointer2cell( input ).payload.stream.stream ) ) {
&& !url_feof( pointer2cell( input ).payload.stream.stream ) ) {
/* OK, here's a really subtle problem: because lists are immutable, anything
* bound in the oblist subsequent to this function being invoked isn't in the
* environment. So, for example, changes to *prompt* or *log* made in the oblist
@ -1203,7 +1214,7 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
inc_ref( expr );
if ( exceptionp( expr )
&& feof( pointer2cell( input ).payload.stream.stream ) ) {
&& url_feof( pointer2cell( input ).payload.stream.stream ) ) {
/* suppress printing end of stream exception */
break;
}
@ -1282,7 +1293,7 @@ struct cons_pointer lisp_inspect( struct stack_frame *frame,
struct cons_pointer frame_pointer,
struct cons_pointer env ) {
debug_print( L"Entering print\n", DEBUG_IO );
URL_FILE *output = stdout;
URL_FILE *output;
struct cons_pointer out_stream = writep( frame->arg[1] ) ?
frame->arg[1] : get_default_stream( false, env );
@ -1291,11 +1302,16 @@ struct cons_pointer lisp_inspect( struct stack_frame *frame,
debug_dump_object( out_stream, DEBUG_IO );
output = pointer2cell( out_stream ).payload.stream.stream;
inc_ref( out_stream );
} else {
output = file_to_url_file( stdout );
}
dump_object( output, frame->arg[0] );
if ( writep( out_stream ) ) {
dec_ref( out_stream );
} else {
free( output );
}
return frame->arg[0];