Apply works; all unit tests pass.

src/init.c

@@ -94,11 +94,11 @@ int main( int argc, char *argv[] ) {
     bind_function( "*", &lisp_multiply );
     bind_function( "subtract", &lisp_subtract );
     bind_function( "-", &lisp_subtract );
+    bind_function( "apply", &lisp_apply );
 
     /*
      * primitive special forms 
      */
-    bind_special( "apply", &lisp_apply );
     bind_special( "eval", &lisp_eval );
     bind_special( "quote", &lisp_quote );
 

src/lispops.c

@@ -73,9 +73,15 @@ struct cons_pointer c_cdr( struct cons_pointer arg ) {
 }
 
 
-
+/**
+ * Internal guts of apply.
+ * @param frame the stack frame, expected to have only one argument, a list
+ * comprising something that evaluates to a function and its arguments.
+ * @param env The evaluation environment.
+ * @return the result of evaluating the function with its arguments.
+ */
 struct cons_pointer
-eval_cons( struct stack_frame *frame, struct cons_pointer env ) {
+c_apply( struct stack_frame *frame, struct cons_pointer env ) {
     struct cons_pointer result = NIL;
 
     struct stack_frame *fn_frame = make_empty_frame( frame, env );
@@ -143,9 +149,12 @@ 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] );
 
+    fputws( L"Eval: ", stderr );
+    dump_frame( stderr, frame );
+
     switch ( cell.tag.value ) {
     case CONSTV:
-        result = eval_cons( frame, env );
+        result = c_apply( frame, env );
         break;
 
     case SYMBOLTV:
@@ -170,37 +179,35 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer env ) {
          */
     }
 
+    fputws( L"Eval returning ", stderr );
+    print( stderr, result );
+    fputws( L"\n", stderr );
+
     return result;
 }
 
+
 /**
  * (apply fn args)
  * 
- * Special form. Apply the function which is the result of evaluating the
+ * function. Apply the function which is the result of evaluating the
  * first argoment to the list of arguments which is the result of evaluating
  * the second argument
  */
 struct cons_pointer
 lisp_apply( struct stack_frame *frame, struct cons_pointer env ) {
-    struct cons_pointer result = NIL;
+    fputws( L"Apply: ", stderr );
+    dump_frame( stderr, frame );
 
-    if ( nilp( frame->arg[1] ) || !nilp( frame->arg[2] ) ) {
+    frame->arg[0] = make_cons( frame->arg[0], frame->arg[1] );
-        result =
+    inc_ref( frame->arg[0] );
-            lisp_throw( c_string_to_lisp_string( "(apply <function> <args>" ),
+    frame->arg[1] = NIL;
-                        frame );
-    }
 
-    struct stack_frame *fn_frame = make_empty_frame( frame, env );
+    struct cons_pointer result = c_apply( frame, env );
-    fn_frame->arg[0] = frame->arg[0];
-    inc_ref( fn_frame->arg[0] );
-    struct cons_pointer fn_pointer = lisp_eval( fn_frame, env );
-    free_stack_frame( fn_frame );
 
-    struct stack_frame *next_frame =
+    fputws( L"Apply returning ", stderr );
-        make_special_frame( frame, make_cons( fn_pointer, frame->arg[1] ),
+    print( stderr, result );
-                            env );
+    fputws( L"\n", stderr );
-    result = eval_cons( next_frame, env );
-    free_stack_frame( next_frame );
 
     return result;
 }

src/read.c

@@ -67,23 +67,25 @@ struct cons_pointer read_continuation( FILE * input, wint_t initial ) {
         result = read_string( input, fgetwc( input ) );
         break;
     default:
-         if ( c == '.' ) {
+        if ( c == '.' ) {
             wint_t next = fgetwc( input );
-            if ( iswdigit( next) ) {
+            if ( iswdigit( next ) ) {
                 ungetwc( next, input );
                 result = read_number( input, c );
             } else if ( iswblank( next ) ) {
-                result = read_continuation(input, fgetwc( input));
+                /* dotted pair. TODO: this isn't right, we
+                 * really need to backtrack up a level. */
+                result = read_continuation( input, fgetwc( input ) );
             } else {
                 read_symbol( input, c );
             }
-        }
+        } else if ( iswdigit( c ) ) {
-        else if ( iswdigit( c ) ) {
             result = read_number( input, c );
         } else if ( iswprint( c ) ) {
             result = read_symbol( input, c );
         } else {
-            fwprintf( stderr, L"Unrecognised start of input character %c\n", c );
+            fwprintf( stderr, L"Unrecognised start of input character %c\n",
+                      c );
         }
     }
 
@@ -206,7 +208,7 @@ struct cons_pointer read_symbol( FILE * input, wint_t initial ) {
         ungetwc( initial, input );
         break;
     default:
-        if ( iswprint( initial ) && ! iswblank( initial ) ) {
+        if ( iswprint( initial ) && !iswblank( initial ) ) {
             result =
                 make_symbol( initial, read_symbol( input, fgetwc( input ) ) );
         } else {
@@ -218,10 +220,10 @@ struct cons_pointer read_symbol( FILE * input, wint_t initial ) {
         }
         break;
     }
-    
+
-    fputws(L"Read symbol '", stderr);
+    fputws( L"Read symbol '", stderr );
-    print(stderr, result);
+    print( stderr, result );
-    fputws(L"'\n", stderr);
+    fputws( L"'\n", stderr );
 
     return result;
 }

src/stack.c

@@ -83,6 +83,7 @@ struct stack_frame *make_stack_frame( struct stack_frame *previous,
          */
         struct stack_frame *arg_frame = make_empty_frame( previous, env );
         arg_frame->arg[0] = cell.payload.cons.car;
+        inc_ref( arg_frame->arg[0] );
         result->arg[i] = lisp_eval( arg_frame, env );
         inc_ref( result->arg[i] );
         free_stack_frame( arg_frame );
@@ -143,6 +144,22 @@ void free_stack_frame( struct stack_frame *frame ) {
     free( frame );
 }
 
+
+/**
+ * Dump a stackframe to this stream for debugging
+ * @param output the stream
+ * @param frame the frame
+ */
+void dump_frame( FILE * output, struct stack_frame *frame ) {
+    fputws( L"Dumping stack frame\n", output );
+    for ( int arg = 0; arg < args_in_frame; arg++ ) {
+        fwprintf( output, L"Arg %d:", arg );
+        print( output, frame->arg[arg] );
+        fputws( L"\n", output );
+    }
+}
+
+
 /**
  * Fetch a pointer to the value of the local variable at this index.
  */

src/stack.h

@@ -37,6 +37,14 @@ struct stack_frame *make_stack_frame( struct stack_frame *previous,
                                       struct cons_pointer args,
                                       struct cons_pointer env );
 void free_stack_frame( struct stack_frame *frame );
+
+/**
+ * Dump a stackframe to this stream for debugging
+ * @param output the stream
+ * @param frame the frame
+ */
+void dump_frame( FILE * output, struct stack_frame *frame );
+
 struct cons_pointer fetch_arg( struct stack_frame *frame, unsigned int n );
 
 /**