From 462c0c69b4e0513c34c27d75fa4a291a04ae50d9 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 12 Sep 2021 15:28:27 +0100 Subject: [PATCH] Fixed bug that reading map literal didn't evaluate values. --- src/io/read.c | 33 ++++++++++++++-------- src/io/read.h | 4 ++- src/ops/lispops.c | 70 +++++++++++++++++++++++++++++++---------------- 3 files changed, 71 insertions(+), 36 deletions(-) diff --git a/src/io/read.c b/src/io/read.c index 45d1045..df0735b 100644 --- a/src/io/read.c +++ b/src/io/read.c @@ -48,9 +48,11 @@ struct cons_pointer read_number( struct stack_frame *frame, bool seen_period ); struct cons_pointer read_list( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env, URL_FILE * input, wint_t initial ); struct cons_pointer read_map( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env, URL_FILE * input, wint_t initial ); struct cons_pointer read_string( URL_FILE * input, wint_t initial ); struct cons_pointer read_symbol_or_key( URL_FILE * input, uint32_t tag, @@ -142,6 +144,7 @@ struct cons_pointer read_path( URL_FILE * input, wint_t initial, */ struct cons_pointer read_continuation( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env, URL_FILE * input, wint_t initial ) { debug_print( L"entering read_continuation\n", DEBUG_IO ); struct cons_pointer result = NIL; @@ -171,16 +174,16 @@ struct cons_pointer read_continuation( struct stack_frame *frame, case '\'': result = c_quote( read_continuation - ( frame, frame_pointer, input, + ( frame, frame_pointer, env, input, url_fgetwc( input ) ) ); break; case '(': result = - read_list( frame, frame_pointer, input, + read_list( frame, frame_pointer, env, input, url_fgetwc( input ) ); break; case '{': - result = read_map( frame, frame_pointer, input, + result = read_map( frame, frame_pointer, env, input, url_fgetwc( input ) ); break; case '"': @@ -210,8 +213,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame, /* dotted pair. \todo this isn't right, we * really need to backtrack up a level. */ result = - read_continuation( frame, frame_pointer, input, - url_fgetwc( input ) ); + read_continuation( frame, frame_pointer, env, + input, url_fgetwc( input ) ); debug_print ( L"read_continuation: dotted pair; read cdr ", DEBUG_IO ); @@ -383,6 +386,7 @@ struct cons_pointer read_number( struct stack_frame *frame, */ struct cons_pointer read_list( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env, URL_FILE * input, wint_t initial ) { struct cons_pointer result = NIL; wint_t c; @@ -391,7 +395,7 @@ struct cons_pointer read_list( struct stack_frame *frame, debug_printf( DEBUG_IO, L"read_list starting '%C' (%d)\n", initial, initial ); struct cons_pointer car = - read_continuation( frame, frame_pointer, input, + read_continuation( frame, frame_pointer, env, input, initial ); /* skip whitespace */ @@ -406,10 +410,12 @@ struct cons_pointer read_list( struct stack_frame *frame, make_cons( car, c_car( read_list( frame, frame_pointer, + env, input, url_fgetwc( input ) ) ) ); } else { result = - make_cons( car, read_list( frame, frame_pointer, input, c ) ); + make_cons( car, + read_list( frame, frame_pointer, env, input, c ) ); } } else { debug_print( L"End of list detected\n", DEBUG_IO ); @@ -420,6 +426,7 @@ struct cons_pointer read_list( struct stack_frame *frame, struct cons_pointer read_map( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env, URL_FILE * input, wint_t initial ) { // set write ACL to true whilst creating to prevent GC churn struct cons_pointer result = @@ -428,21 +435,23 @@ struct cons_pointer read_map( struct stack_frame *frame, while ( c != L'}' ) { struct cons_pointer key = - read_continuation( frame, frame_pointer, input, c ); + read_continuation( frame, frame_pointer, env, input, c ); /* skip whitespace */ for ( c = url_fgetwc( input ); iswblank( c ) || iswcntrl( c ); c = url_fgetwc( input ) ); struct cons_pointer value = - read_continuation( frame, frame_pointer, input, c ); + read_continuation( frame, frame_pointer, env, input, c ); /* skip commaa and whitespace at this point. */ for ( c = url_fgetwc( input ); c == L',' || iswblank( c ) || iswcntrl( c ); c = url_fgetwc( input ) ); - result = hashmap_put( result, key, value ); + result = + hashmap_put( result, key, + eval_form( frame, frame_pointer, value, env ) ); } // default write ACL for maps should be NIL. @@ -536,7 +545,7 @@ struct cons_pointer read_symbol_or_key( URL_FILE * input, uint32_t tag, struct cons_pointer read( struct stack_frame *frame, struct cons_pointer frame_pointer, - URL_FILE * input ) { - return read_continuation( frame, frame_pointer, input, + struct cons_pointer env, URL_FILE * input ) { + return read_continuation( frame, frame_pointer, env, input, url_fgetwc( input ) ); } diff --git a/src/io/read.h b/src/io/read.h index 64f36b0..031bb4f 100644 --- a/src/io/read.h +++ b/src/io/read.h @@ -11,11 +11,13 @@ #ifndef __read_h #define __read_h +#include "memory/consspaceobject.h" + /** * read the next object on this input stream and return a cons_pointer to it. */ struct cons_pointer read( struct stack_frame *frame, struct cons_pointer frame_pointer, - URL_FILE * input ); + struct cons_pointer env, URL_FILE * input ); #endif diff --git a/src/ops/lispops.c b/src/ops/lispops.c index c4ca4f3..436f4df 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -63,21 +63,45 @@ struct cons_pointer eval_form( struct stack_frame *parent, debug_print_object( form, DEBUG_EVAL ); debug_println( DEBUG_EVAL ); - struct cons_pointer result = NIL; - struct cons_pointer next_pointer = make_empty_frame( parent_pointer ); - inc_ref( next_pointer ); + struct cons_pointer result = form; + switch ( pointer2cell( form ).tag.value ) { + /* things which evaluate to themselves */ + case EXCEPTIONTV: + case FREETV: // shouldn't happen, but anyway... + // FUNCTIONTV, LAMBDATV, NLAMBDATV, SPECIALTV ? + case INTEGERTV: + case KEYTV: + case LOOPTV: // don't think this should happen... + case NILTV: + case RATIOTV: + case REALTV: + case READTV: + case STRINGTV: + case TIMETV: + case TRUETV: + // case VECTORPOINTTV: ? + case WRITETV: + break; + default: + { + struct cons_pointer next_pointer = + make_empty_frame( parent_pointer ); + inc_ref( next_pointer ); - struct stack_frame *next = get_stack_frame( next_pointer ); - set_reg( next, 0, form ); - next->args = 1; + struct stack_frame *next = get_stack_frame( next_pointer ); + set_reg( next, 0, form ); + next->args = 1; - result = lisp_eval( next, next_pointer, env ); + result = lisp_eval( next, next_pointer, env ); - if ( !exceptionp( result ) ) { - /* if we're returning an exception, we should NOT free the - * stack frame. Corollary is, when we free an exception, we - * should free all the frames it's holding on to. */ - dec_ref( next_pointer ); + if ( !exceptionp( result ) ) { + /* if we're returning an exception, we should NOT free the + * stack frame. Corollary is, when we free an exception, we + * should free all the frames it's holding on to. */ + dec_ref( next_pointer ); + } + } + break; } debug_print( L"eval_form returning: ", DEBUG_EVAL ); @@ -113,16 +137,16 @@ struct cons_pointer eval_forms( struct stack_frame *frame, } /** - * OK, the idea here (and I know this is less than perfect) is that the basic `try` - * function in PSSE takes two arguments, the first, `body`, being a list of forms, - * and the second, `catch`, being a catch handler (which is also a list of forms). - * Forms from `body` are evaluated in turn until one returns an exception object, + * OK, the idea here (and I know this is less than perfect) is that the basic `try` + * function in PSSE takes two arguments, the first, `body`, being a list of forms, + * and the second, `catch`, being a catch handler (which is also a list of forms). + * Forms from `body` are evaluated in turn until one returns an exception object, * or until the list is exhausted. If the list was exhausted, then the value of - * evaluating the last form in `body` is returned. If an exception was encountered, - * then each of the forms in `catch` is evaluated and the value of the last of + * evaluating the last form in `body` is returned. If an exception was encountered, + * then each of the forms in `catch` is evaluated and the value of the last of * those is returned. - * - * This is experimental. It almost certainly WILL change. + * + * This is experimental. It almost certainly WILL change. */ struct cons_pointer lisp_try( struct stack_frame *frame, struct cons_pointer frame_pointer, @@ -891,7 +915,7 @@ lisp_read( struct stack_frame *frame, struct cons_pointer frame_pointer, input = file_to_url_file( stdin ); } - struct cons_pointer result = read( frame, frame_pointer, input ); + struct cons_pointer result = read( frame, frame_pointer, env, input ); debug_print( L"lisp_read returning\n", DEBUG_IO ); debug_dump_object( result, DEBUG_IO ); @@ -1406,7 +1430,7 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) { } /** - * should really be overwritten with a version in Lisp, since this is much easier to write in Lisp + * should really be overwritten with a version in Lisp, since this is much easier to write in Lisp */ struct cons_pointer lisp_append( struct stack_frame *frame, struct cons_pointer frame_pointer, @@ -1476,7 +1500,7 @@ struct cons_pointer lisp_list( struct stack_frame *frame, } /** - * Special form: evaluate a series of forms in an environment in which + * Special form: evaluate a series of forms in an environment in which * these bindings are bound. * This is `let*` in Common Lisp parlance; `let` in Clojure parlance. */