Much work on the interpreter, but it is getting messy

Going to try something radically different

src/consspaceobject.h

@@ -34,6 +34,13 @@
 #define CONSTAG     "CONS"
 #define CONSTV      1397641027
 
+/**
+ * An exception.
+ */
+#define EXCEPTIONTAG "EXEP"
+/* TODO: this is wrong */
+#define EXCEPTIONTV 1346721861
+
 /**
  * An unallocated cell on the free list - should never be encountered by a Lisp
  * function. 1162170950
@@ -117,13 +124,6 @@
 /* TODO: this is wrong */
 #define WRITETV 1414091351
 
-/**
- * An exception.
- */
-#define EXCEPTIONTAG "EXEP"
-/* TODO: this is wrong */
-#define EXCEPTIONTV 1346721861
-
 /**
  * a cons pointer which points to the special NIL cell
  */

src/equal.c

@@ -78,8 +78,8 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
                     && ( equal( cell_a->payload.string.cdr,
                                 cell_b->payload.string.cdr )
                          || ( end_of_string( cell_a->payload.string.cdr )
-                              && end_of_string( cell_b->payload.string.
+                              && end_of_string( cell_b->payload.
-                                                cdr ) ) );
+                                                string.cdr ) ) );
                 break;
             case INTEGERTV:
             case REALTV:

src/init.c

@@ -53,7 +53,7 @@ int main( int argc, char *argv[] ) {
                 break;
             case 'p':
                 show_prompt = true;
-		print_use_colours = true;
+                print_use_colours = true;
                 break;
             default:
                 fwprintf( stderr, L"Unexpected option %c\n", option );
@@ -74,6 +74,7 @@ int main( int argc, char *argv[] ) {
      */
     deep_bind( c_string_to_lisp_symbol( "nil" ), NIL );
     deep_bind( c_string_to_lisp_symbol( "t" ), TRUE );
+    /* lambda is even more privileged than a special form */
     deep_bind( c_string_to_lisp_symbol( "lambda" ), LAMBDA );
 
     /*

src/lispops.c

@@ -104,26 +104,53 @@ struct cons_pointer eval_form( struct stack_frame *parent,
  * @param env the environment in which it is to be intepreted.
  */
 struct cons_pointer
-lisp_lambda( struct stack_frame *frame, struct cons_pointer lexpr,
+lisp_lambda( struct stack_frame *frame, struct cons_pointer env ) {
-             struct cons_pointer env ) {
     struct cons_pointer result = NIL;
+    struct cons_pointer lexpr = frame->arg[0];
     struct cons_pointer should_be_lambda =
         eval_form( frame, c_car( lexpr ), env );
 
+    dump_frame( stderr, frame );
+
     if ( lambdap( should_be_lambda ) ) {
         struct cons_pointer new_env = env;
+        struct cons_pointer args = c_car( c_cdr( lexpr ) );
+        struct cons_pointer body = c_cdr( c_cdr( lexpr ) );
+
+        for ( int i = 1; i < args_in_frame && consp( args ); i++ ) {
+            args = c_cdr( args );
+            struct cons_pointer arg = c_car( args );
+            print( stderr, c_string_to_lisp_string( "\n\tBinding " ) );
+            print( stderr, arg );
+            print( stderr, c_string_to_lisp_string( " to " ) );
+            print( stderr, frame->arg[i] );
+
+            new_env = make_cons( make_cons( arg, frame->arg[i] ), new_env );
+        }
+
+        while ( !nilp( body ) ) {
+            struct cons_pointer sexpr = c_car( body );
+            body = c_cdr( body );
+
+            result = eval_form( frame, sexpr, new_env );
+        }
     } else {
-        char *buffer = malloc( 1024 );
+        if ( exceptionp( should_be_lambda ) ) {
-        struct cons_space_object not_lambda = pointer2cell( should_be_lambda );
+            result = should_be_lambda;
-        memset( buffer, '\0', 1024 );
+        } else {
-        sprintf( buffer,
+            char *buffer = malloc( 1024 );
-                 "Expected lambda, but found cell with tag %d (%c%c%c%c)",
+            struct cons_space_object not_lambda =
-                 not_lambda.tag.value, not_lambda.tag.bytes[0],
+                pointer2cell( should_be_lambda );
-                 not_lambda.tag.bytes[1], not_lambda.tag.bytes[2],
+            memset( buffer, '\0', 1024 );
-                 not_lambda.tag.bytes[3] );
+            sprintf( buffer,
-        struct cons_pointer message = c_string_to_lisp_string( buffer );
+                     "Expected lambda, but found cell with tag %d (%c%c%c%c)",
-        free( buffer );
+                     not_lambda.tag.value, not_lambda.tag.bytes[0],
-        result = lisp_throw( message, frame );
+                     not_lambda.tag.bytes[1], not_lambda.tag.bytes[2],
+                     not_lambda.tag.bytes[3] );
+            struct cons_pointer message = c_string_to_lisp_string( buffer );
+            free( buffer );
+            result = lisp_throw( message, frame );
+        }
     }
     return result;
 }
@@ -159,7 +186,6 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) {
                 free_stack_frame( next );
             }
             break;
-
         case FUNCTIONTV:
             {
                 struct stack_frame *next =
@@ -168,12 +194,17 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) {
                 free_stack_frame( next );
             }
             break;
-
         case CONSTV:
             {
-                result = lisp_lambda( frame, fn_pointer, env );
+                fwprintf( stdout,
+                          L"Treating cons as lambda expression (apply)\n" );
+                result = lisp_lambda( frame, env );
             }
             break;
+        case EXCEPTIONTV:
+            /* just pass exceptions straight back */
+            result = fn_pointer;
+            break;
         default:
             {
                 char *buffer = malloc( 1024 );
@@ -235,7 +266,14 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer env ) {
 
     switch ( cell.tag.value ) {
         case CONSTV:
-            result = c_apply( frame, env );
+            print( stderr, frame->arg[0] );
+            if ( lambdap( c_car( frame->arg[0] ) ) ) {
+                fwprintf( stdout,
+                          L"Treating cons as lambda expression (eval)\n" );
+                result = lisp_lambda( frame, env );
+            } else {
+                result = c_apply( frame, env );
+            }
             break;
 
         case SYMBOLTV:

src/lispops.h

@@ -37,6 +37,16 @@ struct cons_pointer lisp_eval( struct stack_frame *frame,
                                struct cons_pointer env );
 struct cons_pointer lisp_apply( struct stack_frame *frame,
                                 struct cons_pointer env );
+                                /**
+ * The Lisp interpreter.
+ *
+ * @param frame the stack frame in which the expression is to be interpreted;
+ * @param lexpr the lambda expression to be interpreted;
+ * @param env the environment in which it is to be intepreted.
+ */
+struct cons_pointer lisp_lambda( struct stack_frame *frame,
+                                 struct cons_pointer env );
+
 struct cons_pointer lisp_quote( struct stack_frame *frame,
                                 struct cons_pointer env );
 

src/print.c

@@ -22,20 +22,34 @@
 #include "integer.h"
 #include "print.h"
 
+/**
+ * Whether or not we colorise output.
+ * TODO: this should be a Lisp symbol binding, not a C variable.
+ */
 int print_use_colours = 0;
 
+/**
+ * print all the characters in the symbol or string indicated by `pointer` 
+ * onto this `output`; if `pointer` does not indicate a string or symbol,
+ * don't print anything but just return.
+ */
 void print_string_contents( FILE * output, struct cons_pointer pointer ) {
-    if ( stringp( pointer ) || symbolp( pointer ) ) {
+    while ( stringp( pointer ) || symbolp( pointer ) ) {
         struct cons_space_object *cell = &pointer2cell( pointer );
         wint_t c = cell->payload.string.character;
 
         if ( c != '\0' ) {
             fputwc( c, output );
         }
-        print_string_contents( output, cell->payload.string.cdr );
+        pointer = cell->payload.string.cdr;
     }
 }
 
+/**
+ * print all the characters in the string indicated by `pointer` onto
+ * the stream at this `output`, prepending and appending double quote
+ * characters.
+ */
 void print_string( FILE * output, struct cons_pointer pointer ) {
     fputwc( btowc( '"' ), output );
     print_string_contents( output, pointer );
@@ -43,7 +57,9 @@ void print_string( FILE * output, struct cons_pointer pointer ) {
 }
 
 /**
- * Print a single list cell (cons cell).
+ * Print a single list cell (cons cell) indicated by `pointer` to the
+ * stream indicated by `output`. if `initial_space` is `true`, prepend 
+ * a space character.
  */
 void
 print_list_contents( FILE * output, struct cons_pointer pointer,
@@ -83,6 +99,10 @@ void print_list( FILE * output, struct cons_pointer pointer ) {
 
 }
 
+/**
+ * Print the cons-space object indicated by `pointer` to the stream indicated 
+ * by `output`.
+ */
 void print( FILE * output, struct cons_pointer pointer ) {
     struct cons_space_object cell = pointer2cell( pointer );
     char *buffer;