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