Started work on nlambda. It isn't working yet.

lisp/defun.lisp

@@ -0,0 +1,27 @@
+;; Because I don't (yet) have syntax for varargs, the body must be passed
+;; to defun as a list of sexprs.
+(set! defun!
+      (nlambda
+       (name args body)
+       (cond (symbolp name)
+         (set! name (apply lambda (cons args body))))))
+
+(defun! square (x) ((* x x)))
+
+(set! defsp!
+      (nlambda
+       (name args body)
+       (cond (symbolp name)
+         (set! name (nlambda args body)))))
+
+(defsp! cube (x) ((* x x x)))
+
+(set! p 5)
+
+(square 5) ;; should work
+
+(square p) ;; should work
+
+(cube 5) ;; should work
+
+(cube p) ;; should fail: unbound symbol

src/consspaceobject.c

@@ -215,6 +215,22 @@ struct cons_pointer make_lambda( struct cons_pointer args,
     return pointer;
 }
 
+/**
+ * Construct an nlambda (interpretable source) cell; to a
+ * lambda as a special form is to a function.
+ */
+struct cons_pointer make_nlambda( struct cons_pointer args,
+                                 struct cons_pointer body ) {
+    struct cons_pointer pointer = allocate_cell( NLAMBDATAG );
+    struct cons_space_object *cell = &pointer2cell( pointer );
+    inc_ref( args );
+    inc_ref( body );
+    cell->payload.lambda.args = args;
+    cell->payload.lambda.body = body;
+
+    return pointer;
+}
+
 /**
  * Construct a string from this character (which later will be UTF) and
  * this tail. A string is implemented as a flat list of cells each of which

src/consspaceobject.h

@@ -73,6 +73,12 @@
 #define NILTAG      "NIL "
 #define NILTV       541870414
 
+/**
+ * An nlambda cell.
+ */
+#define NLAMBDATAG  "NLMD"
+#define NLAMBDATV   1145916494
+
 /**
  * An open read stream.
  */
@@ -303,6 +309,9 @@ struct integer_payload {
     long int value;
 };
 
+/**
+ * payload for lambda and nlambda cells
+ */
 struct lambda_payload {
     struct cons_pointer args;
     struct cons_pointer body;
@@ -402,7 +411,7 @@ struct cons_space_object {
          */
         struct integer_payload integer;
         /*
-         * if tag == LAMBDATAG 
+         * if tag == LAMBDATAG or NLAMBDATAG
          */
         struct lambda_payload lambda;
         /*
@@ -481,6 +490,13 @@ struct cons_pointer make_lambda( struct cons_pointer args,
                                  struct cons_pointer body );
 
 /**
+ * Construct an nlambda (interpretable source) cell; to a
+ * lambda as a special form is to a function.
+ */
+struct cons_pointer make_nlambda( struct cons_pointer args,
+                                 struct cons_pointer body );
+
+  /**
  * Construct a cell which points to an executable Lisp special form.
  */
 struct cons_pointer make_special( struct cons_pointer src,

src/init.c

@@ -107,6 +107,7 @@ int main( int argc, char *argv[] ) {
      */
     bind_special( "cond", &lisp_cond );
     bind_special( "lambda", &lisp_lambda );
+    bind_special( "nlambda", &lisp_nlambda );
     bind_special( "quote", &lisp_quote );
     bind_special( "set!", &lisp_set_shriek );
 

src/lispops.c

@@ -96,15 +96,7 @@ struct cons_pointer eval_form( struct stack_frame *parent,
     return result;
 }
 
-/**
- * The Lisp interpreter.
- *
- * @param frame the stack frame in which the expression is 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 ) {
-    dump_frame( stderr, frame );
+struct cons_pointer compose_body(  struct stack_frame *frame ) {
     struct cons_pointer body =
         !nilp( frame->arg[args_in_frame - 1] ) ? frame->more : NIL;
 
@@ -112,10 +104,31 @@ lisp_lambda( struct stack_frame *frame, struct cons_pointer env ) {
         if ( !nilp( frame->arg[i] ) ) {
             body = make_cons( frame->arg[i], body );
         }
-
     }
 
-    return make_lambda( frame->arg[0], body );
+  return body;
+}
+
+/**
+ * Construct an interpretable function.
+ *
+ * @param frame the stack frame in which the expression is 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 ) {
+    return make_lambda( frame->arg[0], compose_body( frame ) );
+}
+
+/**
+ * Construct an interpretable special form.
+ *
+ * @param frame the stack frame in which the expression is to be interpreted;
+ * @param env the environment in which it is to be intepreted.
+ */
+struct cons_pointer
+lisp_nlambda( struct stack_frame *frame, struct cons_pointer env ) {
+    return make_nlambda( frame->arg[0], compose_body( frame ) );
 }
 
 
@@ -153,7 +166,6 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
 }
 
 
-
 /**
  * Internal guts of apply.
  * @param frame the stack frame, expected to have only one argument, a list
@@ -197,6 +209,14 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) {
                 free_stack_frame( next );
             }
             break;
+        case NLAMBDATV:
+            {
+                struct stack_frame *next =
+                    make_special_frame( frame, args, env );
+                result = ( *fn_cell.payload.special.executable ) ( next, env );
+                free_stack_frame( next );
+            }
+            break;
         case SPECIALTV:
             {
                 struct stack_frame *next =

src/lispops.h

@@ -42,7 +42,7 @@ struct cons_pointer
 lisp_set_shriek( struct stack_frame *frame, struct cons_pointer env );
 
 /**
- * The Lisp interpreter.
+ * Construct an interpretable function.
  *
  * @param frame the stack frame in which the expression is to be interpreted;
  * @param lexpr the lambda expression to be interpreted;
@@ -51,6 +51,15 @@ lisp_set_shriek( struct stack_frame *frame, struct cons_pointer env );
 struct cons_pointer lisp_lambda( struct stack_frame *frame,
                                  struct cons_pointer env );
 
+/**
+ * Construct an interpretable special form.
+ *
+ * @param frame the stack frame in which the expression is to be interpreted;
+ * @param env the environment in which it is to be intepreted.
+ */
+struct cons_pointer
+lisp_nlambda( struct stack_frame *frame, struct cons_pointer env );
+
 struct cons_pointer lisp_quote( struct stack_frame *frame,
                                 struct cons_pointer env );
 

src/print.c

@@ -29,7 +29,7 @@
 int print_use_colours = 0;
 
 /**
- * print all the characters in the symbol or string indicated by `pointer` 
+ * 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.
  */
@@ -58,7 +58,7 @@ void print_string( FILE * output, struct cons_pointer pointer ) {
 
 /**
  * Print a single list cell (cons cell) indicated by `pointer` to the
- * stream indicated by `output`. if `initial_space` is `true`, prepend 
+ * stream indicated by `output`. if `initial_space` is `true`, prepend
  * a space character.
  */
 void
@@ -100,7 +100,7 @@ void print_list( FILE * output, struct cons_pointer pointer ) {
 }
 
 /**
- * Print the cons-space object indicated by `pointer` to the stream indicated 
+ * Print the cons-space object indicated by `pointer` to the stream indicated
  * by `output`.
  */
 void print( FILE * output, struct cons_pointer pointer ) {
@@ -131,15 +131,18 @@ void print( FILE * output, struct cons_pointer pointer ) {
             }
             break;
         case LAMBDATV:
-            fputws( L"(lambda ", output );
-            print( output, cell.payload.lambda.args );
-            fputws( L" ", output );
-            print( output, cell.payload.lambda.body );
-            fputws( L")", output );
+            print( output, make_cons( c_string_to_lisp_symbol("lambda"),
+                                     make_cons( cell.payload.lambda.args,
+                                               cell.payload.lambda.body ) ) );
             break;
         case NILTV:
             fwprintf( output, L"nil" );
             break;
+        case NLAMBDATV:
+            print( output, make_cons( c_string_to_lisp_symbol("nlambda"),
+                                     make_cons( cell.payload.lambda.args,
+                                               cell.payload.lambda.body ) ) );
+            break;
         case REALTV:
             /* TODO: using the C heap is a bad plan because it will fragment.
              * As soon as I have working vector space I'll use a special purpose

src/read.c

@@ -60,6 +60,10 @@ struct cons_pointer read_continuation( struct stack_frame *frame, FILE * input,
           c == '\0' || iswblank( c ) || iswcntrl( c ); c = fgetwc( input ) );
 
     switch ( c ) {
+        case ';':
+            for ( c= fgetwc( input ); c != '\n';  c= fgetwc( input ));
+            /* skip all characters from semi-colon to the end of the line */
+            break;
         case EOF:
             result = lisp_throw( c_string_to_lisp_string
                                  ( "End of input while reading" ), frame );