diff --git a/src/init.c b/src/init.c index ac811c3..f2a78e3 100644 --- a/src/init.c +++ b/src/init.c @@ -94,11 +94,11 @@ int main( int argc, char *argv[] ) { bind_function( "*", &lisp_multiply ); bind_function( "subtract", &lisp_subtract ); bind_function( "-", &lisp_subtract ); + bind_function( "apply", &lisp_apply ); /* * primitive special forms */ - bind_special( "apply", &lisp_apply ); bind_special( "eval", &lisp_eval ); bind_special( "quote", &lisp_quote ); diff --git a/src/lispops.c b/src/lispops.c index ff2e738..1c20529 100644 --- a/src/lispops.c +++ b/src/lispops.c @@ -73,9 +73,15 @@ struct cons_pointer c_cdr( struct cons_pointer arg ) { } - +/** + * Internal guts of apply. + * @param frame the stack frame, expected to have only one argument, a list + * comprising something that evaluates to a function and its arguments. + * @param env The evaluation environment. + * @return the result of evaluating the function with its arguments. + */ struct cons_pointer -eval_cons( struct stack_frame *frame, struct cons_pointer env ) { +c_apply( struct stack_frame *frame, struct cons_pointer env ) { struct cons_pointer result = NIL; struct stack_frame *fn_frame = make_empty_frame( frame, env ); @@ -143,9 +149,12 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer env ) { struct cons_pointer result = frame->arg[0]; struct cons_space_object cell = pointer2cell( frame->arg[0] ); + fputws( L"Eval: ", stderr ); + dump_frame( stderr, frame ); + switch ( cell.tag.value ) { case CONSTV: - result = eval_cons( frame, env ); + result = c_apply( frame, env ); break; case SYMBOLTV: @@ -170,37 +179,35 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer env ) { */ } + fputws( L"Eval returning ", stderr ); + print( stderr, result ); + fputws( L"\n", stderr ); + return result; } + /** * (apply fn args) * - * Special form. Apply the function which is the result of evaluating the + * function. Apply the function which is the result of evaluating the * first argoment to the list of arguments which is the result of evaluating * the second argument */ struct cons_pointer lisp_apply( struct stack_frame *frame, struct cons_pointer env ) { - struct cons_pointer result = NIL; + fputws( L"Apply: ", stderr ); + dump_frame( stderr, frame ); - if ( nilp( frame->arg[1] ) || !nilp( frame->arg[2] ) ) { - result = - lisp_throw( c_string_to_lisp_string( "(apply " ), - frame ); - } + frame->arg[0] = make_cons( frame->arg[0], frame->arg[1] ); + inc_ref( frame->arg[0] ); + frame->arg[1] = NIL; - struct stack_frame *fn_frame = make_empty_frame( frame, env ); - fn_frame->arg[0] = frame->arg[0]; - inc_ref( fn_frame->arg[0] ); - struct cons_pointer fn_pointer = lisp_eval( fn_frame, env ); - free_stack_frame( fn_frame ); + struct cons_pointer result = c_apply( frame, env ); - struct stack_frame *next_frame = - make_special_frame( frame, make_cons( fn_pointer, frame->arg[1] ), - env ); - result = eval_cons( next_frame, env ); - free_stack_frame( next_frame ); + fputws( L"Apply returning ", stderr ); + print( stderr, result ); + fputws( L"\n", stderr ); return result; } diff --git a/src/read.c b/src/read.c index 64cd547..b6cf93a 100644 --- a/src/read.c +++ b/src/read.c @@ -67,23 +67,25 @@ struct cons_pointer read_continuation( FILE * input, wint_t initial ) { result = read_string( input, fgetwc( input ) ); break; default: - if ( c == '.' ) { + if ( c == '.' ) { wint_t next = fgetwc( input ); - if ( iswdigit( next) ) { + if ( iswdigit( next ) ) { ungetwc( next, input ); result = read_number( input, c ); } else if ( iswblank( next ) ) { - result = read_continuation(input, fgetwc( input)); + /* dotted pair. TODO: this isn't right, we + * really need to backtrack up a level. */ + result = read_continuation( input, fgetwc( input ) ); } else { read_symbol( input, c ); } - } - else if ( iswdigit( c ) ) { + } else if ( iswdigit( c ) ) { result = read_number( input, c ); } else if ( iswprint( c ) ) { result = read_symbol( input, c ); } else { - fwprintf( stderr, L"Unrecognised start of input character %c\n", c ); + fwprintf( stderr, L"Unrecognised start of input character %c\n", + c ); } } @@ -206,7 +208,7 @@ struct cons_pointer read_symbol( FILE * input, wint_t initial ) { ungetwc( initial, input ); break; default: - if ( iswprint( initial ) && ! iswblank( initial ) ) { + if ( iswprint( initial ) && !iswblank( initial ) ) { result = make_symbol( initial, read_symbol( input, fgetwc( input ) ) ); } else { @@ -218,10 +220,10 @@ struct cons_pointer read_symbol( FILE * input, wint_t initial ) { } break; } - - fputws(L"Read symbol '", stderr); - print(stderr, result); - fputws(L"'\n", stderr); + + fputws( L"Read symbol '", stderr ); + print( stderr, result ); + fputws( L"'\n", stderr ); return result; } diff --git a/src/stack.c b/src/stack.c index 1b887b1..a5a301c 100644 --- a/src/stack.c +++ b/src/stack.c @@ -83,6 +83,7 @@ struct stack_frame *make_stack_frame( struct stack_frame *previous, */ struct stack_frame *arg_frame = make_empty_frame( previous, env ); arg_frame->arg[0] = cell.payload.cons.car; + inc_ref( arg_frame->arg[0] ); result->arg[i] = lisp_eval( arg_frame, env ); inc_ref( result->arg[i] ); free_stack_frame( arg_frame ); @@ -143,6 +144,22 @@ void free_stack_frame( struct stack_frame *frame ) { free( frame ); } + +/** + * Dump a stackframe to this stream for debugging + * @param output the stream + * @param frame the frame + */ +void dump_frame( FILE * output, struct stack_frame *frame ) { + fputws( L"Dumping stack frame\n", output ); + for ( int arg = 0; arg < args_in_frame; arg++ ) { + fwprintf( output, L"Arg %d:", arg ); + print( output, frame->arg[arg] ); + fputws( L"\n", output ); + } +} + + /** * Fetch a pointer to the value of the local variable at this index. */ diff --git a/src/stack.h b/src/stack.h index f227ac3..3a7f0ad 100644 --- a/src/stack.h +++ b/src/stack.h @@ -37,6 +37,14 @@ struct stack_frame *make_stack_frame( struct stack_frame *previous, struct cons_pointer args, struct cons_pointer env ); void free_stack_frame( struct stack_frame *frame ); + +/** + * Dump a stackframe to this stream for debugging + * @param output the stream + * @param frame the frame + */ +void dump_frame( FILE * output, struct stack_frame *frame ); + struct cons_pointer fetch_arg( struct stack_frame *frame, unsigned int n ); /**