From b713c1822dd015a86b38c2acd571431c84c6c3c9 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 17 Sep 2017 20:18:15 +0100 Subject: [PATCH] WArning! this doesn't even build! Half way through reworking eval. --- src/consspaceobject.c | 4 +- src/consspaceobject.h | 5 +-- src/lispops.c | 95 +++++++++++++++++++++++-------------------- src/lispops.h | 15 +++---- src/peano.c | 2 + src/read.c | 2 +- src/repl.c | 5 ++- src/stack.c | 54 +++++++++++++----------- src/stack.h | 9 ++++ 9 files changed, 106 insertions(+), 85 deletions(-) diff --git a/src/consspaceobject.c b/src/consspaceobject.c index 2c12621..da0be0b 100644 --- a/src/consspaceobject.c +++ b/src/consspaceobject.c @@ -204,8 +204,8 @@ struct cons_pointer make_symbol( wint_t c, struct cons_pointer tail ) { */ struct cons_pointer make_special( struct cons_pointer src, struct cons_pointer ( *executable ) - ( struct cons_pointer s_expr, - struct cons_pointer env, struct stack_frame * frame ) ) { + ( struct struct stack_frame * frame, + struct cons_pointer env ) ) { struct cons_pointer pointer = allocate_cell( SPECIALTAG ); struct cons_space_object *cell = &pointer2cell( pointer ); diff --git a/src/consspaceobject.h b/src/consspaceobject.h index 4e4dc9c..e87255a 100644 --- a/src/consspaceobject.h +++ b/src/consspaceobject.h @@ -290,9 +290,8 @@ struct real_payload { */ struct special_payload { struct cons_pointer source; - struct cons_pointer ( *executable ) ( struct cons_pointer s_expr, - struct cons_pointer env, - struct stack_frame * frame ); + struct cons_pointer ( *executable ) ( struct stack_frame *, + struct cons_pointer ); }; /** diff --git a/src/lispops.c b/src/lispops.c index c73914c..725fd31 100644 --- a/src/lispops.c +++ b/src/lispops.c @@ -72,40 +72,26 @@ struct cons_pointer c_cdr( struct cons_pointer arg ) { return result; } -/** - * (apply fn args...) - * - * I'm now confused about whether at this stage I actually need an apply special form, - * and if so how it differs from eval. - */ -struct cons_pointer -lisp_apply( struct cons_pointer args, struct cons_pointer env, - struct stack_frame *frame ) { - struct cons_pointer result = args; - if ( consp( args ) ) { - lisp_eval( args, env, frame ); - } - - return result; -} struct cons_pointer -eval_cons( struct cons_pointer s_expr, struct cons_pointer env, - struct stack_frame *my_frame ) { +eval_cons( struct stack_frame *frame, struct cons_pointer env ) { struct cons_pointer result = NIL; - struct cons_pointer fn_pointer = - lisp_eval( c_car( s_expr ), env, my_frame ); + + struct stack_frame *fn_frame = make_empty_frame( frame, env ); + fn_frame->arg[0] = c_car( frame->arg[0] ); + struct cons_pointer fn_pointer = lisp_eval( fn_frame, env ); + free_stack_frame( fn_frame ); + struct cons_space_object fn_cell = pointer2cell( fn_pointer ); - struct cons_pointer args = c_cdr( s_expr ); + struct cons_pointer args = c_cdr( frame->arg[0] ); switch ( fn_cell.tag.value ) { case SPECIALTV: { - struct stack_frame *frame = - make_special_frame( my_frame, args, env ); - result = - ( *fn_cell.payload.special.executable ) ( args, env, frame ); + struct stack_frame *next = make_special_frame( frame, args, env ); + result = ( *fn_cell.payload.special.executable ) ( next, env ); + free_stack_frame( next ); } break; @@ -114,16 +100,9 @@ eval_cons( struct cons_pointer s_expr, struct cons_pointer env, * actually, this is apply */ { - struct cons_space_object function = pointer2cell( fn_pointer ); - struct stack_frame *frame = - make_stack_frame( my_frame, args, env ); - - /* - * the trick: pass the remaining arguments and environment to the - * executable code which is the payload of the function object. - */ - result = ( *fn_cell.payload.function.executable ) ( frame, env ); - free_stack_frame( frame ); + struct stack_frame *next = make_stack_frame( frame, args, env ); + result = ( *fn_cell.payload.special.executable ) ( next, env ); + free_stack_frame( next ); } break; @@ -138,7 +117,7 @@ eval_cons( struct cons_pointer s_expr, struct cons_pointer env, fn_cell.tag.bytes[3] ); struct cons_pointer message = c_string_to_lisp_string( buffer ); free( buffer ); - result = lisp_throw( message, my_frame ); + result = lisp_throw( message, frame ); } } @@ -159,24 +138,23 @@ eval_cons( struct cons_pointer s_expr, struct cons_pointer env, * If a special form, passes the cdr of s_expr to the special form as argument. */ struct cons_pointer -lisp_eval( struct cons_pointer s_expr, struct cons_pointer env, - struct stack_frame *previous ) { - struct cons_pointer result = s_expr; - struct cons_space_object cell = pointer2cell( s_expr ); +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] ); switch ( cell.tag.value ) { case CONSTV: - result = eval_cons( s_expr, env, previous ); + result = eval_cons( frame, env ); break; case SYMBOLTV: { - struct cons_pointer canonical = internedp( s_expr, env ); + struct cons_pointer canonical = internedp( frame->arg[0], env ); if ( nilp( canonical ) ) { struct cons_pointer message = c_string_to_lisp_string ( "Attempt to take value of unbound symbol." ); - result = lisp_throw( message, previous ); + result = lisp_throw( message, frame ); } else { result = c_assoc( canonical, env ); } @@ -194,6 +172,34 @@ lisp_eval( struct cons_pointer s_expr, struct cons_pointer env, return result; } +/** + * (apply fn args) + */ +struct cons_pointer +lisp_apply( struct stack_frame *frame, struct cons_pointer env ) { + struct cons_pointer result = NIL; + + if ( nilp( frame->arg[1] ) || !nilp( frame->arg[2] ) ) { + result = + lisp_throw( c_string_to_lisp_string( "(apply " ), + frame ); + } + + struct stack_frame *fn_frame = make_empty_frame( frame, env ); + fn_frame->arg[0] = frame->arg[0]; + struct cons_pointer fn_pointer = lisp_eval( fn_frame, env ); + free_stack_frame( fn_frame ); + + 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 ); + + return result; +} + + /** * (quote a) * @@ -202,8 +208,7 @@ lisp_eval( struct cons_pointer s_expr, struct cons_pointer env, * this isn't at this stage checked) unevaluated. */ struct cons_pointer -lisp_quote( struct cons_pointer args, struct cons_pointer env, - struct stack_frame *frame ) { +lisp_quote( struct stack_frame *frame, struct cons_pointer env ) { return frame->arg[0]; } diff --git a/src/lispops.h b/src/lispops.h index f3e5200..e808a1a 100644 --- a/src/lispops.h +++ b/src/lispops.h @@ -22,15 +22,12 @@ /* * special forms */ -struct cons_pointer lisp_eval( struct cons_pointer args, - struct cons_pointer env, - struct stack_frame *frame ); -struct cons_pointer lisp_apply( struct cons_pointer args, - struct cons_pointer env, - struct stack_frame *frame ); -struct cons_pointer lisp_quote( struct cons_pointer args, - struct cons_pointer env, - struct stack_frame *frame ); +struct cons_pointer lisp_eval( struct stack_frame *frame, + struct cons_pointer env ); +struct cons_pointer lisp_apply( struct stack_frame *frame, + struct cons_pointer env ); +struct cons_pointer lisp_quote( struct stack_frame *frame, + struct cons_pointer env ); /* * functions diff --git a/src/peano.c b/src/peano.c index b01a951..409abf9 100644 --- a/src/peano.c +++ b/src/peano.c @@ -49,6 +49,7 @@ lisp_add( struct stack_frame *frame, struct cons_pointer env ) { case REALTV: d_accumulator += current.payload.real.value; is_int = false; + break; default: lisp_throw( c_string_to_lisp_string( "Cannot add: not a number" ), frame ); @@ -93,6 +94,7 @@ lisp_multiply( struct stack_frame *frame, struct cons_pointer env ) { case REALTV: d_accumulator *= arg.payload.real.value; is_int = false; + break; default: lisp_throw( c_string_to_lisp_string ( "Cannot multiply: not a number" ), frame ); diff --git a/src/read.c b/src/read.c index fb3e6d3..24d7ece 100644 --- a/src/read.c +++ b/src/read.c @@ -66,7 +66,7 @@ struct cons_pointer read_continuation( FILE * input, wint_t initial ) { result = read_string( input, fgetwc( input ) ); break; default: - if ( iswdigit( c ) ) { + if ( iswdigit( c ) || c == '.' ) { result = read_number( input, c ); } else if ( iswprint( c ) ) { result = read_symbol( input, c ); diff --git a/src/repl.c b/src/repl.c index 6cedc8e..968306d 100644 --- a/src/repl.c +++ b/src/repl.c @@ -33,7 +33,10 @@ repl( FILE * in_stream, FILE * out_stream, FILE * error_stream, input.offset ); print( error_stream, input ); - struct cons_pointer value = lisp_eval( input, oblist, NULL ); + struct stack_frame *frame = make_empty_frame( NIL, oblist ); + frame->arg[0] = input; + struct cons_pointer value = lisp_eval( frame, oblist ); + free_stack_frame( frame ); // print( out_stream, input ); fwprintf( out_stream, L"\n" ); fwprintf( error_stream, L"\neval {%d,%d}=> ", input.page, diff --git a/src/stack.c b/src/stack.c index c47adbd..bed6307 100644 --- a/src/stack.c +++ b/src/stack.c @@ -27,16 +27,17 @@ #include "stack.h" /** - * Allocate a new stack frame with its previous pointer set to this value, - * its arguments set up from these args, evaluated in this env. + * Make an empty stack frame, and return it. + * @param previous the current top-of-stack; + * @param env the environment in which evaluation happens. + * @return the new frame. */ -struct stack_frame *make_stack_frame( struct stack_frame *previous, - struct cons_pointer args, +struct stack_frame *make_empty_frame( struct stack_frame *previous, struct cons_pointer env ) { + struct stack_frame *result = malloc( sizeof( struct stack_frame ) ); /* * TODO: later, pop a frame off a free-list of stack frames */ - struct stack_frame *result = malloc( sizeof( struct stack_frame ) ); result->previous = previous; @@ -51,6 +52,23 @@ struct stack_frame *make_stack_frame( struct stack_frame *previous, result->arg[i] = NIL; } + return result; +} + + +/** + * Allocate a new stack frame with its previous pointer set to this value, + * its arguments set up from these args, evaluated in this env. + * @param previous the current top-of-stack; + * @args the arguments to load into this frame; + * @param env the environment in which evaluation happens. + * @return the new frame. + */ +struct stack_frame *make_stack_frame( struct stack_frame *previous, + struct cons_pointer args, + struct cons_pointer env ) { + struct stack_frame *result = make_empty_frame( previous, env ); + for ( int i = 0; i < args_in_frame && !nilp( args ); i++ ) { /* iterate down the arg list filling in the arg slots in the * frame. When there are no more slots, if there are still args, @@ -60,9 +78,13 @@ struct stack_frame *make_stack_frame( struct stack_frame *previous, /* * TODO: if we were running on real massively parallel hardware, * each arg except the first should be handed off to another - * processor to be evaled in parallel + * processor to be evaled in parallel; but see notes here: + * https://github.com/simon-brooke/post-scarcity/wiki/parallelism */ - result->arg[i] = lisp_eval( cell.payload.cons.car, env, result ); + struct stack_frame *arg_frame = make_empty_frame( previous, env ); + arg_frame->arg[0] = cell.payload.cons.car; + result->arg[i] = lisp_eval( arg_frame, env ); + free_stack_frame( arg_frame ); inc_ref( result->arg[i] ); args = cell.payload.cons.cdr; @@ -87,23 +109,7 @@ struct stack_frame *make_stack_frame( struct stack_frame *previous, struct stack_frame *make_special_frame( struct stack_frame *previous, struct cons_pointer args, struct cons_pointer env ) { - /* - * TODO: later, pop a frame off a free-list of stack frames - */ - struct stack_frame *result = malloc( sizeof( struct stack_frame ) ); - - result->previous = previous; - - /* - * clearing the frame with memset would probably be slightly quicker, but - * this is clear. - */ - result->more = NIL; - result->function = NIL; - - for ( int i = 0; i < args_in_frame; i++ ) { - result->arg[i] = NIL; - } + struct stack_frame *result = make_empty_frame( previous, env ); for ( int i = 0; i < args_in_frame && !nilp( args ); i++ ) { /* iterate down the arg list filling in the arg slots in the diff --git a/src/stack.h b/src/stack.h index a7fc82b..f227ac3 100644 --- a/src/stack.h +++ b/src/stack.h @@ -24,6 +24,15 @@ #ifndef __stack_h #define __stack_h +/** + * Make an empty stack frame, and return it. + * @param previous the current top-of-stack; + * @param env the environment in which evaluation happens. + * @return the new frame. + */ +struct stack_frame *make_empty_frame( struct stack_frame *previous, + struct cons_pointer env ); + struct stack_frame *make_stack_frame( struct stack_frame *previous, struct cons_pointer args, struct cons_pointer env );