simon/post-scarcity
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Fixed bug that reading map literal didn't evaluate values.

Browse source
This commit is contained in:
Simon Brooke 2021-09-12 15:28:27 +01:00
parent 40e3502247
commit 462c0c69b4
No known key found for this signature in database
GPG key ID: A7A4F18D1D4DF987
3 changed files with 71 additions and 36 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
src/io/read.c
View file

@ -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 ) );
}

4
src/io/read.h
View file

@ -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

70
src/ops/lispops.c
View file

@ -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.
*/