Lisp-ops bound on oblist but not yet being used. All unit tests still pass.

src/consspaceobject.c

@@ -101,14 +101,33 @@ void dump_object( FILE* output, struct cons_pointer pointer) {
  * Construct a cons cell from this pair of pointers.
  */
 struct cons_pointer make_cons( struct cons_pointer car, struct cons_pointer cdr) {
-  struct cons_pointer pointer = allocate_cell( CONSTAG);
+  struct cons_pointer pointer = NIL;
 
-  struct cons_space_object* cell = &conspages[pointer.page]->cell[pointer.offset];
+  if ( ! ( nilp( car) && nilp( cdr))) {
+   pointer = allocate_cell( CONSTAG);
 
-  inc_ref(car);
-  inc_ref(cdr);
-  cell->payload.cons.car = car;
-  cell->payload.cons.cdr = cdr;
+   struct cons_space_object* cell = &conspages[pointer.page]->cell[pointer.offset];
+
+   inc_ref(car);
+   inc_ref(cdr);
+   cell->payload.cons.car = car;
+   cell->payload.cons.cdr = cdr;
+  }
+
+  return pointer;
+}
+
+/**
+ * Construct a cell which points to an executable Lisp special form.
+ */
+struct cons_pointer make_function( struct cons_pointer src,
+				     struct cons_pointer (*executable)
+				   (struct stack_frame*, struct cons_pointer)) {
+  struct cons_pointer pointer = allocate_cell( FUNCTIONTAG);
+  struct cons_space_object* cell = &pointer2cell(pointer);
+
+  cell->payload.function.source = src;
+  cell->payload.function.executable = executable;
 
   return pointer;
 }
@@ -137,6 +156,23 @@ struct cons_pointer make_string( wint_t c, struct cons_pointer tail) {
   return pointer;
 }
 
+/**
+ * Construct a cell which points to an executable Lisp special form.
+ */
+struct cons_pointer make_special( struct cons_pointer src,
+				  struct cons_pointer (*executable)
+				  (struct cons_pointer s_expr,
+				   struct cons_pointer env,
+				   struct stack_frame* frame)) {
+  struct cons_pointer pointer = allocate_cell( SPECIALTAG);
+  struct cons_space_object* cell = &pointer2cell(pointer);
+
+  cell->payload.special.source = src;
+  cell->payload.special.executable = executable;
+    
+  return pointer;
+}
+
 /**
  * Return a lisp string representation of this old skool ASCII string.
  */

src/consspaceobject.h

@@ -350,6 +350,13 @@ void dump_object( FILE* output, struct cons_pointer pointer);
 
 struct cons_pointer make_cons( struct cons_pointer car, struct cons_pointer cdr);
 
+/**
+ * Construct a cell which points to an executable Lisp special form.
+ */
+struct cons_pointer make_function( struct cons_pointer src,
+				     struct cons_pointer (*executable)
+				   (struct stack_frame*, struct cons_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
@@ -358,6 +365,15 @@ struct cons_pointer make_cons( struct cons_pointer car, struct cons_pointer cdr)
  */
 struct cons_pointer make_string( wint_t c, struct cons_pointer tail);
 
+/**
+ * Construct a cell which points to an executable Lisp special form.
+ */
+struct cons_pointer make_special( struct cons_pointer src,
+				  struct cons_pointer (*executable)
+				  (struct cons_pointer s_expr,
+				   struct cons_pointer env,
+				   struct stack_frame* frame));
+
 /**
  * Return a lisp string representation of this old skool ASCII string.
  */

src/init.c

@@ -14,14 +14,40 @@
 #include "version.h"
 #include "conspage.h"
 #include "consspaceobject.h"
+#include "intern.h"
+#include "lispops.h"
 #include "print.h"
 #include "read.h"
-#include "lispops.h"
+
+void bind_function( char* name, struct cons_pointer (*executable)
+		    (struct stack_frame*, struct cons_pointer)) {
+  deep_bind( intern( c_string_to_lisp_string( name), oblist ),
+	     make_function( NIL, executable));
+}
+
+void bind_special( char* name, struct cons_pointer (*executable)
+		   (struct cons_pointer s_expr, struct cons_pointer env,
+		    struct stack_frame* frame)) {
+  deep_bind( intern( c_string_to_lisp_string( name), oblist ),
+	     make_special( NIL, executable));
+}
 
 int main (int argc, char *argv[]) {
   fprintf( stderr, "Post scarcity software environment version %s\n", VERSION);
   initialise_cons_pages();
 
+  bind_function( "assoc", &lisp_assoc);
+  bind_function( "car", &lisp_car);
+  bind_function( "cdr", &lisp_cdr);
+  bind_function( "cons", &lisp_cons);
+  bind_function( "eq", &lisp_eq);
+  bind_function( "equal", &lisp_equal);
+  bind_function( "read", &lisp_read);
+  bind_function( "print", &lisp_print);
+
+  bind_special( "apply", &lisp_apply);
+  bind_special( "eval", &lisp_eval);
+
   fprintf( stderr, "\n:: ");
   struct cons_pointer input = read( stdin);
   fprintf( stderr, "\n{%d,%d}=> ", input.page, input.offset);

src/intern.c

@@ -23,6 +23,17 @@
 #include "conspage.h"
 #include "consspaceobject.h"
 
+/**
+ * The object list. What is added to this during system setup is 'global', that is, 
+ * visible to all sessions/threads. What is added during a session/thread is local to
+ * that session/thread (because shallow binding). There must be some way for a user to
+ * make the contents of their own environment persistent between threads but I don't
+ * know what it is yet. At some stage there must be a way to rebind deep values so
+ * they're visible to all users/threads, but again I don't yet have any idea how 
+ * that will work.
+ */
+struct cons_pointer oblist = NIL;
+
 /**
  * Implementation of interned? in C. The final implementation if interned? will
  * deal with stores which can be association lists or hashtables or hybrids of
@@ -75,17 +86,6 @@ struct cons_pointer c_assoc( struct cons_pointer key, struct cons_pointer store)
   return result;
 }
 
-/**
- * The object list. What is added to this during system setup is 'global', that is, 
- * visible to all sessions/threads. What is added during a session/thread is local to
- * that session/thread (because shallow binding). There must be some way for a user to
- * make the contents of their own environment persistent between threads but I don't
- * know what it is yet. At some stage there must be a way to rebind deep values so
- * they're visible to all users/threads, but again I don't yet have any idea how 
- * that will work.
- */
-struct cons_pointer oblist = NIL;
-
 
 /**
  * Return a new key/value store containing all the key/value pairs in this store

src/lispops.c

@@ -28,15 +28,11 @@
 #include "equal.h"
 #include "integer.h"
 #include "intern.h"
+#include "lispops.h"
 #include "print.h"
 #include "read.h"
 #include "stack.h"
 
-/* special forms */
-struct cons_pointer lisp_eval( struct cons_pointer args, struct cons_pointer env,
-			       struct stack_frame* frame);
-struct cons_pointer lisp_apply( struct cons_pointer args, struct cons_pointer env,
-				struct stack_frame* frame);
 /*
  * also to create in this section:
  * struct cons_pointer lisp_cond( struct cons_pointer args, struct cons_pointer env,
@@ -49,19 +45,6 @@ struct cons_pointer lisp_apply( struct cons_pointer args, struct cons_pointer en
  * and others I haven't thought of yet.
  */
 
-/* functions */
-struct cons_pointer lisp_cons( struct stack_frame* frame, struct cons_pointer env);
-struct cons_pointer lisp_car( struct stack_frame* frame, struct cons_pointer env);
-struct cons_pointer lisp_cdr( struct stack_frame* frame, struct cons_pointer env);
-struct cons_pointer lisp_assoc( struct stack_frame* frame, struct cons_pointer env);
-struct cons_pointer lisp_eq( struct stack_frame* frame, struct cons_pointer env);
-struct cons_pointer lisp_equal( struct stack_frame* frame, struct cons_pointer env);
-struct cons_pointer lisp_read( struct stack_frame* frame, struct cons_pointer env);
-struct cons_pointer lisp_print( struct stack_frame* frame, struct cons_pointer env);
-
-/* neither, at this stage, really */
-struct cons_pointer lisp_throw( struct cons_pointer message, struct stack_frame* frame);
-
 /**
  * Implementation of car in C. If arg is not a cons, does not error but returns nil.
  */

src/lispops.h

@@ -19,5 +19,21 @@
  * Licensed under GPL version 2.0, or, at your option, any later version.
  */
 
-struct cons_pointer lisp_eval( struct cons_pointer args, struct cons_pointer env);
+/* special forms */
+struct cons_pointer lisp_eval( struct cons_pointer args, struct cons_pointer env,
+			       struct stack_frame* frame);
+struct cons_pointer lisp_apply( struct cons_pointer args, struct cons_pointer env,
+				struct stack_frame* frame);
 
+/* functions */
+struct cons_pointer lisp_cons( struct stack_frame* frame, struct cons_pointer env);
+struct cons_pointer lisp_car( struct stack_frame* frame, struct cons_pointer env);
+struct cons_pointer lisp_cdr( struct stack_frame* frame, struct cons_pointer env);
+struct cons_pointer lisp_assoc( struct stack_frame* frame, struct cons_pointer env);
+struct cons_pointer lisp_eq( struct stack_frame* frame, struct cons_pointer env);
+struct cons_pointer lisp_equal( struct stack_frame* frame, struct cons_pointer env);
+struct cons_pointer lisp_read( struct stack_frame* frame, struct cons_pointer env);
+struct cons_pointer lisp_print( struct stack_frame* frame, struct cons_pointer env);
+
+/* neither, at this stage, really */
+struct cons_pointer lisp_throw( struct cons_pointer message, struct stack_frame* frame);

src/stack.c

@@ -59,7 +59,7 @@ 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 */
-      result->arg[i] = lisp_eval( cell.payload.cons.car, env);
+      result->arg[i] = lisp_eval( cell.payload.cons.car, env, result);
       /* TODO: later, going to have to mess with reference counts */
       args = cell.payload.cons.cdr;
     } else {