WArning! this doesn't even build! Half way through reworking eval.

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 struct stack_frame * frame,
-                 struct cons_pointer env, struct stack_frame * frame ) ) {
+                 struct cons_pointer env  ) ) {
     struct cons_pointer pointer = allocate_cell( SPECIALTAG );
     struct cons_space_object *cell = &pointer2cell( pointer );
 

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 ( *executable ) ( struct stack_frame *,
-                                          struct cons_pointer env,
+                                          struct cons_pointer );
-                                          struct stack_frame * frame );
 };
 
 /**

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,
+eval_cons( struct stack_frame *frame, struct cons_pointer env ) {
-           struct stack_frame *my_frame ) {
     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 =
+            struct stack_frame *next = make_special_frame( frame, args, env );
-                make_special_frame( my_frame, args, env );
+            result = ( *fn_cell.payload.special.executable ) ( next, env );
-            result =
+            free_stack_frame( next );
-                ( *fn_cell.payload.special.executable ) ( args, env, frame );
         }
         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 *next = make_stack_frame( frame, args, env );
-            struct stack_frame *frame =
+            result = ( *fn_cell.payload.special.executable ) ( next, env );
-                make_stack_frame( my_frame, args, env );
+            free_stack_frame( next );
-
-            /*
-             * 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 );
         }
         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,
+lisp_eval( struct stack_frame *frame, struct cons_pointer env ) {
-           struct stack_frame *previous ) {
+    struct cons_pointer result = frame->arg[0];
-    struct cons_pointer result = s_expr;
+    struct cons_space_object cell = pointer2cell( frame->arg[0] );
-    struct cons_space_object cell = pointer2cell( s_expr );
 
     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 <function> <args>" ),
+                        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,
+lisp_quote( struct stack_frame *frame, struct cons_pointer env ) {
-            struct stack_frame *frame ) {
     return frame->arg[0];
 }
 

src/lispops.h

@@ -22,15 +22,12 @@
 /*
  * special forms 
  */
-struct cons_pointer lisp_eval( struct cons_pointer args,
+struct cons_pointer lisp_eval( struct stack_frame *frame,
-                               struct cons_pointer env,
+                               struct cons_pointer env );
-                               struct stack_frame *frame );
+struct cons_pointer lisp_apply( struct stack_frame *frame,
-struct cons_pointer lisp_apply( struct cons_pointer args,
+                                struct cons_pointer env );
-                                struct cons_pointer env,
+struct cons_pointer lisp_quote( struct stack_frame *frame,
-                                struct stack_frame *frame );
+                                struct cons_pointer env );
-struct cons_pointer lisp_quote( struct cons_pointer args,
-                                struct cons_pointer env,
-                                struct stack_frame *frame );
 
 /*
  * functions 

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

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

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,

src/stack.c

@@ -27,16 +27,17 @@
 #include "stack.h"
 
 /**
- * Allocate a new stack frame with its previous pointer set to this value,
+ * Make an empty stack frame, and return it.
- * its arguments set up from these args, evaluated in this env.
+ * @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 stack_frame *make_empty_frame( struct stack_frame *previous,
-                                      struct cons_pointer args,
                                       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 ) {
-    /*
+    struct stack_frame *result = make_empty_frame( previous, 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;
-    }
 
     for ( int i = 0; i < args_in_frame && !nilp( args ); i++ ) {
         /* iterate down the arg list filling in the arg slots in the

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