From c47ef5d8f9a3de4e98abe938ab37664e4c119c38 Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Sat, 7 Jan 2017 16:09:40 +0000
Subject: [PATCH 1/7] Interning symbols (actually, not just symbols) and
 creating an oblist.

---
 src/equal.h  |   2 +
 src/intern.c | 107 +++++++++++++++++++++++++++++++++++++++++++++++++++
 src/intern.h |  48 +++++++++++++++++++++++
 3 files changed, 157 insertions(+)
 create mode 100644 src/intern.c
 create mode 100644 src/intern.h

diff --git a/src/equal.h b/src/equal.h
index 502dd32..2c4a86d 100644
--- a/src/equal.h
+++ b/src/equal.h
@@ -10,6 +10,8 @@
 #include <math.h>
 #include <stdbool.h>
 
+#include "consspaceobject.h"
+
 #ifndef __equal_h
 #define __equal_h
 
diff --git a/src/intern.c b/src/intern.c
new file mode 100644
index 0000000..6770bdf
--- /dev/null
+++ b/src/intern.c
@@ -0,0 +1,107 @@
+/**
+ * intern.c
+ *
+ * For now this implements an oblist and shallow binding; local environments can
+ * be consed onto the front of the oblist. Later, this won't do; bindings will happen
+ * in namespaces, which will probably be implemented as hash tables.
+ * 
+ * Doctrine is that cons cells are immutable, and life is a lot more simple if they are;
+ * so when a symbol is rebound in the master oblist, what in fact we do is construct
+ * a new oblist without the previous binding but with the new binding. Anything which,
+ * prior to this action, held a pointer to the old oblist (as all current threads' 
+ * environments must do) continues to hold a pointer to the old oblist, and consequently
+ * doesn't see the change. This is probably good but does mean you cannot use bindings
+ * on the oblist to signal between threads.
+ *
+ * (c) 2017 Simon Brooke <simon@journeyman.cc>
+ * Licensed under GPL version 2.0, or, at your option, any later version.
+ */
+
+#include <stdbool.h>
+
+#include "equal.h"
+#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;
+
+/**
+ * return the value associated with this key in this store. In the current 
+ * implementation a store is just an assoc list, but in future it might be a
+ * namespace, a regularity or a homogeneity.
+ * TODO: This function ultimately belongs in lispops.
+ */
+struct cons_pointer assoc( struct cons_pointer key, struct cons_pointer store) {
+  struct cons_pointer result = NIL;
+  
+  if ( consp( store)) {
+    struct cons_space_object* cell_store = &pointer2cell( store);
+
+    if ( consp( cell_store->payload.cons.car)) {
+      struct cons_space_object* binding =
+	&pointer2cell( cell_store->payload.cons.car);
+
+      if ( eq( key, binding->payload.cons.car)) {
+	result = binding->payload.cons.cdr;
+      }
+    }
+    /* top-level objects on an assoc list ought to be conses (i.e. each
+     * successive car should be a cons), but there's no need to throw a
+     * wobbly if it isn't. */
+
+    if ( nilp( result)) {
+      result = assoc( key, cell_store->payload.cons.cdr);
+    }
+  }
+
+  return result;
+}
+
+
+/**
+ * Return true if this key is present as a key in this enviroment, defaulting to
+ * the oblist if no environment is passed.
+ */
+bool internedp( struct cons_pointer key, struct cons_pointer environment) {
+  bool result = false;
+  
+  if ( nilp( environment)) {
+    if ( !nilp( oblist)) {
+      result = internedp( key, oblist);
+    }
+  } else {
+    result = !nilp( assoc( key, environment));
+  }
+      
+  return result;
+}
+
+
+/**
+ * Return a new key/value store containing all the key/value pairs in this store
+ * with this key/value pair added to the front.
+ */
+struct cons_pointer bind( struct cons_pointer key, struct cons_pointer value,
+			    struct cons_pointer store) {
+  return make_cons( make_cons( key, value), store);
+}
+
+
+/**
+ * Binds this key to this value in the global oblist, but doesn't affect the 
+ * current environment. May not be useful except in bootstrapping (and even 
+ * there it may not be especially useful).
+ */
+struct cons_pointer deep_bind( struct cons_pointer key, struct cons_pointer value) {
+  oblist = bind( key, value, oblist);
+  return oblist;
+}
diff --git a/src/intern.h b/src/intern.h
new file mode 100644
index 0000000..656fe62
--- /dev/null
+++ b/src/intern.h
@@ -0,0 +1,48 @@
+/**
+ * intern.h
+ *
+ * For now this implements an oblist and shallow binding; local environments can
+ * be consed onto the front of the oblist. Later, this won't do; bindings will happen
+ * in namespaces, which will probably be implemented as hash tables.
+ * 
+ * Doctrine is that cons cells are immutable, and life is a lot more simple if they are;
+ * so when a symbol is rebound in the master oblist, what in fact we do is construct
+ * a new oblist without the previous binding but with the new binding. Anything which,
+ * prior to this action, held a pointer to the old oblist (as all current threads' 
+ * environments must do) continues to hold a pointer to the old oblist, and consequently
+ * doesn't see the change. This is probably good but does mean you cannot use bindings
+ * on the oblist to signal between threads.
+ *
+ * (c) 2017 Simon Brooke <simon@journeyman.cc>
+ * Licensed under GPL version 2.0, or, at your option, any later version.
+ */
+
+extern struct cons_pointer oblist;
+
+/**
+ * return the value associated with this key in this store. In the current 
+ * implementation a store is just an assoc list, but in future it might be a
+ * namespace, a regularity or a homogeneity.
+ * TODO: This function ultimately belongs in lispops.
+ */
+struct cons_pointer assoc( struct cons_pointer key, struct cons_pointer store);
+
+/**
+ * Return true if this key is present as a key in this enviroment, defaulting to
+ * the oblist if no environment is passed.
+ */
+bool internedp( struct cons_pointer key, struct cons_pointer environment);
+
+/**
+ * Return a new key/value store containing all the key/value pairs in this store
+ * with this key/value pair added to the front.
+ */
+struct cons_pointer bind( struct cons_pointer key, struct cons_pointer value,
+			  struct cons_pointer store);
+
+/**
+ * Binds this key to this value in the global oblist, but doesn't affect the 
+ * current environment. May not be useful except in bootstrapping (and even 
+ * there it may not be especially useful).
+ */
+struct cons_pointer deep_bind( struct cons_pointer key, struct cons_pointer value);

From 432ccb2d44586a5a533ee40c39c28e3a7ba9869c Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Fri, 13 Jan 2017 00:45:00 +0000
Subject: [PATCH 2/7] Frustrating. I think all the conversion to 'wide' (UTF)
 character handling is done, and all the existing unit tests pass - but UTF
 characters are nevertheless not read or printed correctly.

---
 src/consspaceobject.c |  7 ++--
 src/consspaceobject.h |  5 ++-
 src/init.c            |  5 +--
 src/intern.c          | 79 ++++++++++++++++++++++++++++++++++++-------
 src/intern.h          | 17 +++++++++-
 src/lispops.c         | 19 ++++++-----
 src/print.c           |  7 ++--
 src/read.c            | 61 ++++++++++++++++-----------------
 8 files changed, 139 insertions(+), 61 deletions(-)

diff --git a/src/consspaceobject.c b/src/consspaceobject.c
index 0ef8ab1..ae2721f 100644
--- a/src/consspaceobject.c
+++ b/src/consspaceobject.c
@@ -11,6 +11,9 @@
 #include <stdint.h>
 #include <stdlib.h>
 #include <string.h>
+/* wide characters */
+#include <wchar.h>
+#include <wctype.h>
 
 #include "conspage.h"
 #include "consspaceobject.h"
@@ -87,7 +90,7 @@ void dump_object( FILE* output, struct cons_pointer pointer) {
   } else if ( check_tag(pointer, REALTAG)) {
     fprintf( output, "\t\tReal cell: value %Lf\n", cell.payload.real.value);
   } else if ( check_tag( pointer, STRINGTAG)) {
-    fprintf( output, "\t\tString cell: character '%c' next at page %d offset %d\n",
+    fwprintf( output, L"\t\tString cell: character '%C' next at page %d offset %d\n",
 	     cell.payload.string.character, cell.payload.string.cdr.page,
 	     cell.payload.string.cdr.offset);
   };
@@ -124,7 +127,7 @@ struct cons_pointer make_string( char c, struct cons_pointer tail) {
     struct cons_space_object* cell = &pointer2cell(pointer);
 
     inc_ref(tail);
-    cell->payload.string.character = (uint32_t) c;
+    cell->payload.string.character = (wint_t) c;
     cell->payload.string.cdr.page = tail.page;
     cell->payload.string.cdr.offset = tail.offset;
   } else {
diff --git a/src/consspaceobject.h b/src/consspaceobject.h
index e151fc4..bc7d6be 100644
--- a/src/consspaceobject.h
+++ b/src/consspaceobject.h
@@ -11,6 +11,9 @@
 #include <stdbool.h>
 #include <stdint.h>
 #include <stdio.h>
+/* wide characters */
+#include <wchar.h>
+#include <wctype.h>
 
 #ifndef __consspaceobject_h
 #define __consspaceobject_h
@@ -155,7 +158,7 @@ struct real_payload {
  * payload of a string cell. At least at first, only one UTF character will be stored in each cell.
  */
 struct string_payload {
-  uint32_t character;          /* the actual character stored in this cell */
+  wint_t character;          /* the actual character stored in this cell */
   uint32_t padding;            /* unused padding to word-align the cdr */
   struct cons_pointer cdr;
 };
diff --git a/src/init.c b/src/init.c
index 63b8558..33c9836 100644
--- a/src/init.c
+++ b/src/init.c
@@ -1,8 +1,8 @@
 /**
  * init.c
  *
- * Start up and initialise the environement - just enough to get working and (ultimately)
- * hand off to the executive.
+ * Start up and initialise the environement - just enough to get working 
+ * and (ultimately) hand off to the executive.
  *
  *
  * (c) 2017 Simon Brooke <simon@journeyman.cc>
@@ -16,6 +16,7 @@
 #include "consspaceobject.h"
 #include "print.h"
 #include "read.h"
+#include "lispops.h"
 
 int main (int argc, char *argv[]) {
   fprintf( stderr, "Post scarcity software environment version %s\n", VERSION);
diff --git a/src/intern.c b/src/intern.c
index 6770bdf..bf5b9f4 100644
--- a/src/intern.c
+++ b/src/intern.c
@@ -22,6 +22,7 @@
 #include "equal.h"
 #include "conspage.h"
 #include "consspaceobject.h"
+#include "equal.h"
 
 /**
  * The object list. What is added to this during system setup is 'global', that is, 
@@ -67,21 +68,56 @@ struct cons_pointer assoc( struct cons_pointer key, struct cons_pointer store) {
 }
 
 
-/**
- * Return true if this key is present as a key in this enviroment, defaulting to
- * the oblist if no environment is passed.
+/** 
+ * Internal workings of internedp, q.v. Not intended to be called from anywhere
+ * else. Note that this is VERY similar to assoc, but returns the car (key) of
+ * the binding rather than the cdr (value).
  */
-bool internedp( struct cons_pointer key, struct cons_pointer environment) {
-  bool result = false;
-  
-  if ( nilp( environment)) {
-    if ( !nilp( oblist)) {
-      result = internedp( key, oblist);
+struct cons_pointer __internedp( struct cons_pointer key,
+				 struct cons_pointer store) {
+  struct cons_pointer result = NIL;
+
+  if ( consp( store)) {
+    struct cons_space_object* cell_store = &pointer2cell( store);
+
+    if ( consp( cell_store->payload.cons.car)) {
+      struct cons_space_object* binding =
+	&pointer2cell( cell_store->payload.cons.car);
+
+      if ( equal( key, binding->payload.cons.car)) {
+	result = binding->payload.cons.car;
+      }
+    }
+    /* top-level objects on an assoc list ought to be conses (i.e. each
+     * successive car should be a cons), but there's no need to throw a
+     * wobbly if it isn't. */
+
+    if ( nilp( result)) {
+      result = assoc( key, cell_store->payload.cons.cdr);
     }
-  } else {
-    result = !nilp( assoc( key, environment));
   }
-      
+
+  return result;  
+}
+
+
+/**
+ * Return the canonical version of this key if ut is present as a key in this 
+ * enviroment, defaulting to the oblist if no environment is passed. Key is
+ * expected to be a string.
+ */
+struct cons_pointer internedp( struct cons_pointer key,
+			       struct cons_pointer environment) {
+  struct cons_pointer result = NIL;
+
+  if ( stringp( key)) {
+    if ( nilp( environment)) {
+      result = __internedp( key, oblist);
+    } else {
+      result = __internedp( key, environment);
+    }
+  }
+  
   return result;
 }
 
@@ -105,3 +141,22 @@ struct cons_pointer deep_bind( struct cons_pointer key, struct cons_pointer valu
   oblist = bind( key, value, oblist);
   return oblist;
 }
+
+
+/**
+ * Ensure that a canonical copy of this key is bound in this environment, and
+ * return that canonical copy. If there is currently no such binding, create one
+ * with the value NIL.
+ */
+struct cons_pointer intern( struct cons_pointer key,
+			    struct cons_pointer environment) {
+  struct cons_pointer result = environment;
+  struct cons_pointer canonical = internedp( key, environment);
+
+  if ( nilp( canonical)) {
+    /* not currently bound */
+    result = bind( key, NIL, environment);
+  }
+
+  return result;
+}
diff --git a/src/intern.h b/src/intern.h
index 656fe62..148f05f 100644
--- a/src/intern.h
+++ b/src/intern.h
@@ -17,6 +17,10 @@
  * Licensed under GPL version 2.0, or, at your option, any later version.
  */
 
+
+#ifndef __intern_h
+#define __intern_h
+
 extern struct cons_pointer oblist;
 
 /**
@@ -31,7 +35,8 @@ struct cons_pointer assoc( struct cons_pointer key, struct cons_pointer store);
  * Return true if this key is present as a key in this enviroment, defaulting to
  * the oblist if no environment is passed.
  */
-bool internedp( struct cons_pointer key, struct cons_pointer environment);
+struct cons_pointer internedp( struct cons_pointer key,
+			       struct cons_pointer environment);
 
 /**
  * Return a new key/value store containing all the key/value pairs in this store
@@ -46,3 +51,13 @@ struct cons_pointer bind( struct cons_pointer key, struct cons_pointer value,
  * there it may not be especially useful).
  */
 struct cons_pointer deep_bind( struct cons_pointer key, struct cons_pointer value);
+
+/**
+ * Ensure that a canonical copy of this key is bound in this environment, and
+ * return that canonical copy. If there is currently no such binding, create one
+ * with the value NIL.
+ */
+struct cons_pointer intern( struct cons_pointer key,
+			    struct cons_pointer environment);
+
+#endif
diff --git a/src/lispops.c b/src/lispops.c
index b59137d..b4efd11 100644
--- a/src/lispops.c
+++ b/src/lispops.c
@@ -43,7 +43,8 @@ struct cons_pointer i_eval_args( struct cons_pointer args, struct cons_pointer t
   struct cons_pointer result = NIL;
   
   if ( ! nilp( args)) {
-    result = make_cons( lisp_eval( lisp_car( args)), i_eval_args( lisp_cdr( args), tail));
+    result = make_cons( lisp_eval( lisp_car( args, env), env),
+			i_eval_args( lisp_cdr( args, env), tail, env));
   }
 
   return result;
@@ -59,7 +60,7 @@ struct cons_pointer lisp_apply( struct cons_pointer args, struct cons_pointer en
   struct cons_pointer result = args;
   
   if ( consp( args)) {
-    lisp_eval( make_cons( lisp_car( args), i_eval_args( lisp_cdr( args), NIL)));
+    lisp_eval( make_cons( lisp_car( args, env), i_eval_args( lisp_cdr( args, env), NIL, env)), env);
   }
 
   return result;
@@ -74,8 +75,8 @@ struct cons_pointer lisp_eval( struct cons_pointer args, struct cons_pointer env
   if ( consp( args)) {
     /* the hard bit. Sort out what function is required and pass the
      * args to it. */
-    struct cons_pointer fn_pointer lisp_car( args);
-    args = lisp_cdr( args);
+    struct cons_pointer fn_pointer = lisp_car( args, env);
+    args = lisp_cdr( args, env);
 
     if ( functionp( fn_pointer)) {
       struct cons_space_object function = pointer2cell( fn_pointer);
@@ -90,8 +91,8 @@ struct cons_pointer lisp_eval( struct cons_pointer args, struct cons_pointer env
        * also if the object is a consp it could be interpretable
        * source code but in the long run I don't want an interpreter,
        * and if I can get away without so much the better. */
-      result = lisp_throw( args, env)
-        }
+      result = lisp_throw( args, env);
+    }
   }
 
   return result;
@@ -110,7 +111,7 @@ struct cons_pointer lisp_cons( struct cons_pointer args, struct cons_pointer env
     struct cons_pointer d = pointer2cell( cell.payload.cons.cdr).payload.cons.car;
     result = make_cons( a, d);
   } else {
-    lisp_throw( args);
+    lisp_throw( args, env);
   }
 
   return result;
@@ -126,7 +127,7 @@ struct cons_pointer lisp_car( struct cons_pointer args, struct cons_pointer env)
     struct cons_space_object cell = pointer2cell( args);
     result =  pointer2cell( cell.payload.cons.car).payload.cons.car;
   } else {
-    lisp_throw( args);
+    lisp_throw( args, env);
   }
 
   return result;
@@ -143,7 +144,7 @@ struct cons_pointer lisp_cdr( struct cons_pointer args, struct cons_pointer env)
     struct cons_space_object cell = pointer2cell( args);
     result =  pointer2cell( cell.payload.cons.cdr).payload.cons.car;
   } else {
-    lisp_throw( args);
+    lisp_throw( args, env);
   }
 
   return result;
diff --git a/src/print.c b/src/print.c
index 479454e..a263d6f 100644
--- a/src/print.c
+++ b/src/print.c
@@ -11,6 +11,9 @@
 #include <ctype.h>
 #include <stdio.h>
 #include <string.h>
+/* wide characters */
+#include <wchar.h>
+#include <wctype.h>
 
 #include "conspage.h"
 #include "consspaceobject.h"
@@ -20,10 +23,10 @@
 void print_string_contents( FILE* output, struct cons_pointer pointer) {
   if ( check_tag( pointer, STRINGTAG)) {
     struct cons_space_object* cell = &pointer2cell(pointer);
-    char c = cell->payload.string.character;
+    wint_t c = cell->payload.string.character;
 
     if ( c != '\0') {
-      fputc( c, output);
+      fputwc( c, output);
     }
     print_string_contents( output, cell->payload.string.cdr);
   }
diff --git a/src/read.c b/src/read.c
index 2354420..f7a572f 100644
--- a/src/read.c
+++ b/src/read.c
@@ -8,9 +8,11 @@
  * Licensed under GPL version 2.0, or, at your option, any later version.
  */
 
-#include <ctype.h>
 #include <stdbool.h>
 #include <stdio.h>
+/* wide characters */
+#include <wchar.h>
+#include <wctype.h>
 
 #include "consspaceobject.h"
 #include "integer.h"
@@ -22,9 +24,9 @@
    lists
    Can't read atoms because I don't yet know what an atom is or how it's stored. */
 
-struct cons_pointer read_number( FILE* input, char initial);
-struct cons_pointer read_list( FILE* input, char initial);
-struct cons_pointer read_string( FILE* input, char initial);
+struct cons_pointer read_number( FILE* input, wint_t initial);
+struct cons_pointer read_list( FILE* input, wint_t initial);
+struct cons_pointer read_string( FILE* input, wint_t initial);
 
 
 /**
@@ -32,34 +34,24 @@ struct cons_pointer read_string( FILE* input, char initial);
  * treating this initial character as the first character of the object
  * representation.
  */
-struct cons_pointer read_continuation( FILE* input, char initial) {
+struct cons_pointer read_continuation( FILE* input, wint_t initial) {
   struct cons_pointer result = NIL;
 
-  char c;
+  wint_t c;
 
-  for (c = initial; c == '\0' || isblank( c); c = fgetc( input));
+  for (c = initial; c == '\0' || iswblank( c); c = fgetwc( input));
   
   switch( c) {
   case '(' :
   case ')':
-    result = read_list(input, fgetc( input));
+    result = read_list(input, fgetwc( input));
     break;
-  case '"': result = read_string(input, fgetc( input));
-    break;
-  case '0':
-  case '1':
-  case '2':
-  case '3':
-  case '4':
-  case '5':
-  case '6':
-  case '7':
-  case '8':
-  case '9':
-    // case '.':
-    result = read_number( input, c);
+  case '"': result = read_string(input, fgetwc( input));
     break;
   default:
+    if ( iswdigit( c)) {
+      result = read_number( input, c);
+    } 
     fprintf( stderr, "Unrecognised start of input character %c\n", c);
   }
 
@@ -70,15 +62,15 @@ struct cons_pointer read_continuation( FILE* input, char initial) {
 /**
  * read a number from this input stream, given this initial character.
  */
-struct cons_pointer read_number( FILE* input, char initial) {
+struct cons_pointer read_number( FILE* input, wint_t initial) {
   int accumulator = 0;
   int places_of_decimals = 0;
   bool seen_period = false;
-  char c;
+  wint_t c;
 
   fprintf( stderr, "read_number starting '%c' (%d)\n", initial, initial);
   
-  for (c = initial; isdigit( c); c = fgetc( input)) {
+  for (c = initial; iswdigit( c); c = fgetwc( input)) {
     if ( c == '.') {
       seen_period = true;
     } else {
@@ -91,7 +83,7 @@ struct cons_pointer read_number( FILE* input, char initial) {
   }
 
   /* push back the character read which was not a digit */
-  fputc( c, input);
+  fputwc( c, input);
 
   return make_integer( accumulator);
 }
@@ -101,15 +93,15 @@ struct cons_pointer read_number( FILE* input, char initial) {
  * Read a list from this input stream, which no longer contains the opening
  * left parenthesis.
  */
-struct cons_pointer read_list( FILE* input, char initial) {
+struct cons_pointer read_list( FILE* input, wint_t initial) {
   struct cons_pointer cdr = NIL;
   struct cons_pointer result= NIL;
 
-  fprintf( stderr, "read_list starting '%c' (%d)\n", initial, initial);
+  fwprintf( stderr, L"read_list starting '%C' (%d)\n", initial, initial);
   
   if ( initial != ')' ) {
     struct cons_pointer car = read_continuation( input, initial);
-    cdr = read_list( input, fgetc( input));
+    cdr = read_list( input, fgetwc( input));
     result = make_cons( car, cdr);
   }
 
@@ -123,11 +115,11 @@ struct cons_pointer read_list( FILE* input, char initial) {
  * representation of a string, which is that there's no obvious representation of
  * an empty string.
  */
-struct cons_pointer read_string( FILE* input, char initial) {
+struct cons_pointer read_string( FILE* input, wint_t initial) {
   struct cons_pointer cdr = NIL;
   struct cons_pointer result;
 
-  fprintf( stderr, "read_string starting '%c' (%d)\n", initial, initial);
+  fwprintf( stderr, L"read_string starting '%C' (%d)\n", initial, initial);
 
   switch ( initial) {
   case '\0':
@@ -137,7 +129,7 @@ struct cons_pointer read_string( FILE* input, char initial) {
     result = make_string( '\0', NIL);
     break;
   default:
-    result = make_string( initial, read_string( input, fgetc( input)));
+    result = make_string( initial, read_string( input, fgetwc( input)));
     break;
   }
 
@@ -151,6 +143,11 @@ struct cons_pointer read_string( FILE* input, char initial) {
 struct cons_pointer read( FILE* input) {
   return read_continuation( input, '\0');
 }
+
+
+struct cons_pointer lisp_read( struct cons_pointer args, struct cons_pointer env) {
+  return( read( stdin));
+}
     
 
 

From 7e53ce2c4fb4f2032fda8b87832920e8cd919fad Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Fri, 13 Jan 2017 08:44:56 +0000
Subject: [PATCH 3/7] Added stuff for a lisp stack, but not yet integrated.

---
 src/consspaceobject.h | 16 ++++-----
 src/stack.c           | 75 +++++++++++++++++++++++++++++++++++++++++++
 src/stack.h           | 42 ++++++++++++++++++++++++
 3 files changed, 125 insertions(+), 8 deletions(-)
 create mode 100644 src/stack.c
 create mode 100644 src/stack.h

diff --git a/src/consspaceobject.h b/src/consspaceobject.h
index bc7d6be..fb696e6 100644
--- a/src/consspaceobject.h
+++ b/src/consspaceobject.h
@@ -26,17 +26,17 @@
 /**
  * tag values, all of which must be 4 bytes. Must not collide with vector space tag values
  */
-#define CONSTAG  "CONS"
-#define FREETAG  "FREE"
+#define CONSTAG     "CONS"
+#define FREETAG     "FREE"
 #define FUNCTIONTAG "FUNC"
 #define INTEGERTAG  "INTR"
-#define NILTAG  "NIL "
-#define READTAG  "READ"
-#define REALTAG  "REAL"
-#define STRINGTAG  "STRG"
-#define TRUETAG  "TRUE"
+#define NILTAG      "NIL "
+#define READTAG     "READ"
+#define REALTAG     "REAL"
+#define STRINGTAG   "STRG"
+#define TRUETAG     "TRUE"
 #define VECTORPOINTTAG  "VECP"
-#define WRITETAG  "WRIT"
+#define WRITETAG    "WRIT"
 
 /**
  * a cons pointer which points to the special NIL cell
diff --git a/src/stack.c b/src/stack.c
new file mode 100644
index 0000000..7e24574
--- /dev/null
+++ b/src/stack.c
@@ -0,0 +1,75 @@
+/**
+ * stack.c
+ *
+ * The Lisp evaluation stack.
+ *
+ * Stack frames could be implemented in cons space; indeed, the stack
+ * could simply be an assoc list consed onto the front of the environment. 
+ * But such a stack would be costly to search. The design sketched here, 
+ * with stack frames as special objects, SHOULD be substantially more 
+ * efficient, but does imply we need to generalise the idea of cons pages
+ * with freelists to a more general 'equal sized object pages', so that
+ * allocating/freeing stack frames can be more efficient.
+ * 
+ * Stack frames are not yet a first class object; they have no VECP pointer
+ * in cons space.
+ *
+ * (c) 2017 Simon Brooke <simon@journeyman.cc>
+ * Licensed under GPL version 2.0, or, at your option, any later version.
+ */
+
+#include <stdlib.h>
+
+#include "consspaceobject.h"
+#include "conspage.h"
+#include "stack.h"
+
+/**
+ * Allocate a new stack frame with its previous pointer set to this value
+ */
+struct stack_frame* make_stack_frame(struct stack_frame* previous) {
+  /* 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 < locals_in_frame; i++) {
+    result->local[i] = NIL;
+  }
+
+  return result;
+}
+
+/**
+ * Free this stack frame.
+ */
+void free_stack_frame( struct stack_frame* frame) {
+  /* TODO: later, push it back on the stack-frame freelist */
+  free( frame);
+}
+
+/**
+ * Fetch a pointer to the value of the local variable at this index.
+ */
+struct cons_pointer fetch_local( struct stack_frame* frame, unsigned int index) {
+  struct cons_pointer result = NIL;
+  
+  if ( index < locals_in_frame) {
+    result = frame->local[ index];
+  } else {
+    struct cons_pointer p = frame->more;
+    
+    for ( int i = locals_in_frame; i < index; i++) {
+      p = pointer2cell( p).payload.cons.cdr;
+    }
+
+    result = pointer2cell( p).payload.cons.car;
+  }
+
+  return result;
+}
diff --git a/src/stack.h b/src/stack.h
new file mode 100644
index 0000000..ec3d956
--- /dev/null
+++ b/src/stack.h
@@ -0,0 +1,42 @@
+/**
+ * stack.h
+ *
+ * The Lisp evaluation stack.
+ *
+ * Stack frames could be implemented in cons space; indeed, the stack
+ * could simply be an assoc list consed onto the front of the environment. 
+ * But such a stack would be costly to search. The design sketched here, 
+ * with stack frames as special objects, SHOULD be substantially more 
+ * efficient, but does imply we need to generalise the idea of cons pages
+ * with freelists to a more general 'equal sized object pages', so that
+ * allocating/freeing stack frames can be more efficient.
+ * 
+ * Stack frames are not yet a first class object; they have no VECP pointer
+ * in cons space.
+ *
+ * (c) 2017 Simon Brooke <simon@journeyman.cc>
+ * Licensed under GPL version 2.0, or, at your option, any later version.
+ */
+
+#include "consspaceobject.h"
+
+#ifndef __stack_h
+#define __stack_h
+
+/* number of local variables stored in a stack frame */
+#define locals_in_frame 8
+
+struct stack_frame* make_stack_frame(struct stack_frame* previous);
+void free_stack_frame( struct stack_frame* frame);
+struct cons_pointer fetch_local( struct stack_frame* frame, unsigned int n);
+
+struct stack_frame {
+  struct stack_frame* previous;         /* the previous frame */
+  struct cons_pointer local[locals_in_frame];
+                                        /* first 8 local variable bindings */
+  struct cons_pointer more;             /* list of any further local 
+					 * variable bindings */
+  struct cons_pointer function;         /* the function to be called */
+};
+
+#endif

From 1133a07752857c5dc217a39ddd06c9041eda2167 Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Fri, 13 Jan 2017 17:40:49 +0000
Subject: [PATCH 4/7] Enough lisp operations implemented that it's now probably
 possible to try a read-eval-print loop. Read still isn't correctly reading
 UTF characters, but so long as I don't use UTF characters it's OK (bug needs
 fixing, but).

---
 src/consspaceobject.c |  17 ++-
 src/consspaceobject.h | 146 +++++++++++++++++++++++-
 src/intern.c          | 139 +++++++++--------------
 src/intern.h          |   3 +-
 src/lispops.c         | 252 +++++++++++++++++++++++++++++++++---------
 src/lispops.h         |  23 ++++
 src/read.c            |   4 -
 src/stack.c           |  44 ++++++--
 src/stack.h           |  20 ++--
 9 files changed, 474 insertions(+), 174 deletions(-)
 create mode 100644 src/lispops.h

diff --git a/src/consspaceobject.c b/src/consspaceobject.c
index ae2721f..68b32b9 100644
--- a/src/consspaceobject.c
+++ b/src/consspaceobject.c
@@ -119,7 +119,7 @@ struct cons_pointer make_cons( struct cons_pointer car, struct cons_pointer cdr)
  * has one character and a pointer to the next; in the last cell the 
  * pointer to next is NIL.
  */
-struct cons_pointer make_string( char c, struct cons_pointer tail) {
+struct cons_pointer make_string( wint_t c, struct cons_pointer tail) {
   struct cons_pointer pointer = NIL;
   
   if ( check_tag( tail, STRINGTAG) || check_tag( tail, NILTAG)) {
@@ -127,7 +127,7 @@ struct cons_pointer make_string( char c, struct cons_pointer tail) {
     struct cons_space_object* cell = &pointer2cell(pointer);
 
     inc_ref(tail);
-    cell->payload.string.character = (wint_t) c;
+    cell->payload.string.character = c;
     cell->payload.string.cdr.page = tail.page;
     cell->payload.string.cdr.offset = tail.offset;
   } else {
@@ -136,3 +136,16 @@ struct cons_pointer make_string( char c, struct cons_pointer tail) {
   
   return pointer;
 }
+
+/**
+ * Return a lisp string representation of this old skool ASCII string.
+ */
+struct cons_pointer c_string_to_lisp_string( char* string) {
+  struct cons_pointer result = NIL;
+
+  for ( int i = strlen( string); i > 0; i--) {
+    result = make_string( (wint_t)string[ i - 1], result);
+  }
+
+  return result;
+}
diff --git a/src/consspaceobject.h b/src/consspaceobject.h
index fb696e6..fe055c2 100644
--- a/src/consspaceobject.h
+++ b/src/consspaceobject.h
@@ -26,16 +26,56 @@
 /**
  * tag values, all of which must be 4 bytes. Must not collide with vector space tag values
  */
+/**
+ * An ordinary cons cell
+ */
 #define CONSTAG     "CONS"
+/**
+ * An unallocated cell on the free list - should never be encountered by a Lisp
+ * function
+ */
 #define FREETAG     "FREE"
+/**
+ * An ordinary Lisp function - one whose arguments are pre-evaluated and passed as
+ * a stack frame.
+ */
 #define FUNCTIONTAG "FUNC"
+/**
+ * An integer number.
+ */
 #define INTEGERTAG  "INTR"
+/**
+ * The special cons cell at address {0,0} whose car and cdr both point to itself.
+ */
 #define NILTAG      "NIL "
+/**
+ * An open read stream.
+ */
 #define READTAG     "READ"
+/**
+ * A real number.
+ */
 #define REALTAG     "REAL"
+/**
+ * A special form - one whose arguments are not pre-evaluated but passed as a
+ * s-expression.
+ */
+#define SPECIALTAG  "SPFM"
+/**
+ * A string of characters, organised as a linked list.
+ */
 #define STRINGTAG   "STRG"
+/**
+ * The special cons cell at address {0,1} which is canonically different from NIL
+ */
 #define TRUETAG     "TRUE"
+/**
+ * A pointer to an object in vector space.
+ */
 #define VECTORPOINTTAG  "VECP"
+/**
+ * An open write stream.
+ */
 #define WRITETAG    "WRIT"
 
 /**
@@ -43,6 +83,11 @@
  */
 #define NIL (struct cons_pointer){ 0, 0}
 
+/**
+ * a cons pointer which points to the special T cell
+ */
+#define TRUE (struct cons_pointer){ 0, 1}
+
 /**
  * the maximum possible value of a reference count
  */
@@ -71,6 +116,11 @@
  */
 #define functionp(conspoint) (check_tag(conspoint,FUNCTIONTAG))
 
+/**
+ * true if conspointer points to a special form cell, else false 
+ */
+#define specialp(conspoint) (check_tag(conspoint,SPECIALTAG))
+
 /**
  * true if conspointer points to a string cell, else false 
  */
@@ -81,6 +131,11 @@
  */
 #define integerp(conspoint) (check_tag(conspoint,INTEGERTAG))
 
+/**
+ * true if conspointer points to a read stream cell, else false 
+ */
+#define readp(conspoint) (check_tag(conspoint,READTAG))
+
 /**
  * true if conspointer points to a real number cell, else false 
  */
@@ -92,6 +147,12 @@
  */
 #define numberp(conspoint) (check_tag(conspoint,INTEGERTAG)||check_tag(conspoint,REALTAG))
 
+/**
+ * true if conspointer points to a write stream cell, else false 
+ */
+#define writep(conspoint) (check_tag(conspoint,WRITETAG))
+
+
 /**
  * true if conspointer points to a true cell, else false 
  * (there should only be one of these so it's slightly redundant).
@@ -113,6 +174,21 @@ struct cons_pointer {
   uint32_t offset;             /* the index of the cell within the page */
 };
 
+/* number of arguments stored in a stack frame */
+#define args_in_frame 8
+
+/**
+ * A stack frame. Yes, I know it isn't a cons-space object, but it's defined
+ * here to avoid circularity. TODO: refactor.
+ */
+struct stack_frame {
+  struct stack_frame* previous;         /* the previous frame */
+  struct cons_pointer arg[args_in_frame];
+                                        /* first 8 arument bindings */
+  struct cons_pointer more;             /* list of any further argument 
+					 * bindings */
+  struct cons_pointer function;         /* the function to be called */
+};
 
 /**
  * payload of a cons cell.
@@ -122,9 +198,18 @@ struct cons_payload {
   struct cons_pointer cdr;
 };
 
+/**
+ * Payload of a function cell. 
+ * source points to the source from which the function was compiled, or NIL 
+ * if it is a primitive.
+ * executable points to a function which takes a pointer to a stack frame
+ * (representing its stack frame) and a cons pointer (representing its 
+ * environment) as arguments and returns a cons pointer (representing its
+ * result).
+ */ 
 struct function_payload {
   struct cons_pointer source;
-  struct cons_pointer (*executable)(struct cons_pointer, struct cons_pointer);
+  struct cons_pointer (*executable)(struct stack_frame*, struct cons_pointer);
 };
 
 /**
@@ -145,7 +230,6 @@ struct integer_payload {
   long int value;
 };
 
-
 /**
  * payload for a real number cell. Internals of this liable to change to give 128 bits
  * precision, but I'm not sure of the detail.
@@ -155,14 +239,55 @@ struct real_payload {
 };
 
 /**
- * payload of a string cell. At least at first, only one UTF character will be stored in each cell.
+ * Payload of a special form cell. 
+ * source points to the source from which the function was compiled, or NIL 
+ * if it is a primitive.
+ * executable points to a function which takes a cons pointer (representing
+ * its argument list) and a cons pointer (representing its environment) and a
+ * stack frame (representing the previous stack frame) as arguments and returns
+ * a cons pointer (representing its result).
+ *
+ * NOTE that this means that special forms do not appear on the lisp stack,
+ * which may be confusing. TODO: think about this.
+ */ 
+struct special_payload {
+  struct cons_pointer source;
+  struct cons_pointer (*executable)(struct cons_pointer s_expr,
+				      struct cons_pointer env,
+				      struct stack_frame* frame);
+};
+
+/**
+ * payload of a read or write stream cell.
+ */
+struct stream_payload {
+  FILE * stream;
+};
+
+/**
+ * payload of a string cell. At least at first, only one UTF character will
+ * be stored in each cell.
  */
 struct string_payload {
-  wint_t character;          /* the actual character stored in this cell */
+  wint_t character;            /* the actual character stored in this cell */
   uint32_t padding;            /* unused padding to word-align the cdr */
   struct cons_pointer cdr;
 };
 
+struct vectorp_payload {
+  union {
+    char bytes[TAGLENGTH];     /* the tag (type) of the vector-space 
+				* object this cell points to, considered 
+				* as bytes. NOTE that the vector space
+				* object should itself have the identical tag. */
+    uint32_t value;            /* the tag considered as a number */
+  } tag;
+  uint64_t address;            /* the address of the actual vector space
+				* object (TODO: will change when I actually
+				* implement vector space) */
+};
+
+
 /**
  * an object in cons space.
  */
@@ -184,12 +309,18 @@ struct cons_space_object {
     struct integer_payload integer;
     /* if tag == NILTAG; we'll treat the special cell NIL as just a cons */
     struct cons_payload nil;
+/* if tag == READTAG || tag == WRITETAG */
+struct stream_payload stream;
     /* if tag == REALTAG */
     struct real_payload real;
+    /* if tag == SPECIALTAG */
+    struct special_payload special;
     /* if tag == STRINGTAG */
     struct string_payload string;
     /* if tag == TRUETAG; we'll treat the special cell T as just a cons */
     struct cons_payload t;
+    /* if tag == VECTORPTAG */
+    struct vectorp_payload vectorp;
   } payload;
 };
 
@@ -225,6 +356,11 @@ struct cons_pointer make_cons( struct cons_pointer car, struct cons_pointer cdr)
  * has one character and a pointer to the next; in the last cell the 
  * pointer to next is NIL.
  */
-struct cons_pointer make_string( char c, struct cons_pointer tail);
+struct cons_pointer make_string( wint_t c, struct cons_pointer tail);
+
+/**
+ * Return a lisp string representation of this old skool ASCII string.
+ */
+struct cons_pointer c_string_to_lisp_string( char* string);
 
 #endif
diff --git a/src/intern.c b/src/intern.c
index bf5b9f4..862c43a 100644
--- a/src/intern.c
+++ b/src/intern.c
@@ -22,7 +22,58 @@
 #include "equal.h"
 #include "conspage.h"
 #include "consspaceobject.h"
-#include "equal.h"
+
+/**
+ * Implementation of interned? in C. The final implementation if interned? will
+ * deal with stores which can be association lists or hashtables or hybrids of
+ * the two, but that will almost certainly be implemented in lisp.
+ *
+ * If this key is lexically identical to a key in this store, return the key
+ * from the store (so that later when we want to retrieve a value, an eq test
+ * will work); otherwise return NIL.
+ */
+struct cons_pointer internedp( struct cons_pointer key, struct cons_pointer store) {
+  struct cons_pointer result = NIL;
+
+  for ( struct cons_pointer next = store;
+	nilp( result) && consp( next);
+	next = pointer2cell( next).payload.cons.cdr) {
+    struct cons_space_object entry =
+      pointer2cell( pointer2cell( next).payload.cons.car);
+
+    if ( equal( key, entry.payload.cons.car)) {
+      result = entry.payload.cons.car;
+    }
+  }
+
+  return result;
+}
+
+/**
+ * Implementation of assoc in C. Like interned?, the final implementation will
+ * deal with stores which can be association lists or hashtables or hybrids of
+ * the two, but that will almost certainly be implemented in lisp.
+ *
+ * If this key is lexically identical to a key in this store, return the value
+ * of that key from the store; otherwise return NIL.
+ */
+struct cons_pointer c_assoc( struct cons_pointer key, struct cons_pointer store) {
+  struct cons_pointer result = NIL;
+
+  for ( struct cons_pointer next = store;
+	consp( next);
+	next = pointer2cell( next).payload.cons.cdr) {
+    struct cons_space_object entry =
+      pointer2cell( pointer2cell( next).payload.cons.car);
+
+    if ( equal( key, entry.payload.cons.car)) {
+      result = entry.payload.cons.cdr;
+      break;
+    }
+  }
+
+  return result;
+}
 
 /**
  * The object list. What is added to this during system setup is 'global', that is, 
@@ -35,92 +86,6 @@
  */
 struct cons_pointer oblist = NIL;
 
-/**
- * return the value associated with this key in this store. In the current 
- * implementation a store is just an assoc list, but in future it might be a
- * namespace, a regularity or a homogeneity.
- * TODO: This function ultimately belongs in lispops.
- */
-struct cons_pointer assoc( struct cons_pointer key, struct cons_pointer store) {
-  struct cons_pointer result = NIL;
-  
-  if ( consp( store)) {
-    struct cons_space_object* cell_store = &pointer2cell( store);
-
-    if ( consp( cell_store->payload.cons.car)) {
-      struct cons_space_object* binding =
-	&pointer2cell( cell_store->payload.cons.car);
-
-      if ( eq( key, binding->payload.cons.car)) {
-	result = binding->payload.cons.cdr;
-      }
-    }
-    /* top-level objects on an assoc list ought to be conses (i.e. each
-     * successive car should be a cons), but there's no need to throw a
-     * wobbly if it isn't. */
-
-    if ( nilp( result)) {
-      result = assoc( key, cell_store->payload.cons.cdr);
-    }
-  }
-
-  return result;
-}
-
-
-/** 
- * Internal workings of internedp, q.v. Not intended to be called from anywhere
- * else. Note that this is VERY similar to assoc, but returns the car (key) of
- * the binding rather than the cdr (value).
- */
-struct cons_pointer __internedp( struct cons_pointer key,
-				 struct cons_pointer store) {
-  struct cons_pointer result = NIL;
-
-  if ( consp( store)) {
-    struct cons_space_object* cell_store = &pointer2cell( store);
-
-    if ( consp( cell_store->payload.cons.car)) {
-      struct cons_space_object* binding =
-	&pointer2cell( cell_store->payload.cons.car);
-
-      if ( equal( key, binding->payload.cons.car)) {
-	result = binding->payload.cons.car;
-      }
-    }
-    /* top-level objects on an assoc list ought to be conses (i.e. each
-     * successive car should be a cons), but there's no need to throw a
-     * wobbly if it isn't. */
-
-    if ( nilp( result)) {
-      result = assoc( key, cell_store->payload.cons.cdr);
-    }
-  }
-
-  return result;  
-}
-
-
-/**
- * Return the canonical version of this key if ut is present as a key in this 
- * enviroment, defaulting to the oblist if no environment is passed. Key is
- * expected to be a string.
- */
-struct cons_pointer internedp( struct cons_pointer key,
-			       struct cons_pointer environment) {
-  struct cons_pointer result = NIL;
-
-  if ( stringp( key)) {
-    if ( nilp( environment)) {
-      result = __internedp( key, oblist);
-    } else {
-      result = __internedp( key, environment);
-    }
-  }
-  
-  return result;
-}
-
 
 /**
  * Return a new key/value store containing all the key/value pairs in this store
diff --git a/src/intern.h b/src/intern.h
index 148f05f..56adb33 100644
--- a/src/intern.h
+++ b/src/intern.h
@@ -27,9 +27,8 @@ extern struct cons_pointer oblist;
  * return the value associated with this key in this store. In the current 
  * implementation a store is just an assoc list, but in future it might be a
  * namespace, a regularity or a homogeneity.
- * TODO: This function ultimately belongs in lispops.
  */
-struct cons_pointer assoc( struct cons_pointer key, struct cons_pointer store);
+struct cons_pointer c_assoc( struct cons_pointer key, struct cons_pointer store);
 
 /**
  * Return true if this key is present as a key in this enviroment, defaulting to
diff --git a/src/lispops.c b/src/lispops.c
index b4efd11..f91ba02 100644
--- a/src/lispops.c
+++ b/src/lispops.c
@@ -14,7 +14,6 @@
  * They must all have the same signature so that I can call them as
  * function pointers.
  *
- *
  * (c) 2017 Simon Brooke <simon@journeyman.cc>
  * Licensed under GPL version 2.0, or, at your option, any later version.
  */
@@ -22,29 +21,68 @@
 #include <ctype.h>
 #include <stdbool.h>
 #include <stdio.h>
+#include <stdlib.h>
 
 #include "consspaceobject.h"
 #include "conspage.h"
+#include "equal.h"
 #include "integer.h"
+#include "intern.h"
+#include "print.h"
 #include "read.h"
+#include "stack.h"
 
-struct cons_pointer lisp_eval( struct cons_pointer args, struct cons_pointer env);
-struct cons_pointer lisp_cons( struct cons_pointer args, struct cons_pointer env);
-struct cons_pointer lisp_car( struct cons_pointer args, struct cons_pointer env);
-struct cons_pointer lisp_cdr( struct cons_pointer args, struct cons_pointer env);
-struct cons_pointer lisp_apply( struct cons_pointer args, struct cons_pointer env);
-struct cons_pointer lisp_throw( 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);
+/*
+ * also to create in this section:
+ * struct cons_pointer lisp_cond( struct cons_pointer args, struct cons_pointer env,
+			       struct stack_frame* frame);
+ * struct cons_pointer lisp_let( struct cons_pointer args, struct cons_pointer env,
+			       struct stack_frame* frame);
+ * struct cons_pointer lisp_mapcar( struct cons_pointer args, struct cons_pointer env,
+			       struct stack_frame* frame);
+ *
+ * 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);
 
 /**
- * in the long run this becomes redundant because it's just (map eval
- * args), but it helps bootstrapping.
+ * Implementation of car in C. If arg is not a cons, does not error but returns nil.
  */
-struct cons_pointer i_eval_args( struct cons_pointer args, struct cons_pointer tail, struct cons_pointer env) {
+struct cons_pointer c_car( struct cons_pointer arg) {
   struct cons_pointer result = NIL;
   
-  if ( ! nilp( args)) {
-    result = make_cons( lisp_eval( lisp_car( args, env), env),
-			i_eval_args( lisp_cdr( args, env), tail, env));
+  if ( consp(arg)) {
+    result = pointer2cell( arg).payload.cons.car;
+  }
+
+  return result;
+}
+
+/**
+ * Implementation of cdr in C. If arg is not a cons, does not error but returns nil.
+ */
+struct cons_pointer c_cdr( struct cons_pointer arg) {
+  struct cons_pointer result = NIL;
+  
+  if ( consp(arg)) {
+    result = pointer2cell( arg).payload.cons.cdr;
   }
 
   return result;
@@ -52,82 +90,123 @@ struct cons_pointer i_eval_args( struct cons_pointer args, struct cons_pointer t
 
 /**
  * (apply fn args...)
- * I'm assuming that the function should be protected from evaluation
- * in apply because its name has already been resolved to the function
- * object in read.
+ *
+ * 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 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( make_cons( lisp_car( args, env), i_eval_args( lisp_cdr( args, env), NIL, env)), env);
+    lisp_eval( args, env, frame);
   }
 
   return result;
 }
 
 /**
- * (eval args)
+ * (eval s_expr)
+ *
+ * Special form.
+ * If s_expr is a number, NIL, or T, returns s_expr.
+ * If s_expr is an unprotected string, returns the value that s_expr is bound
+ * to in the evaluation environment (env).
+ * If s_expr is a list, expects the car to be something that evaluates to a 
+ * function or special form.
+ * If a function, evaluates all the other top level elements in s_expr and
+ * passes them in a stack frame as arguments to the function.
+ * If a special form, passes the cdr of s_expr to the special form as argument.
  */
-struct cons_pointer lisp_eval( struct cons_pointer args, struct cons_pointer env) {
-  struct cons_pointer result = args;
+struct cons_pointer lisp_eval( struct cons_pointer s_expr, struct cons_pointer env,
+			       struct stack_frame* previous) {
+  struct cons_pointer result = s_expr;
+  struct stack_frame* my_frame =
+    make_stack_frame( previous, make_cons( s_expr, NIL), env);
   
-  if ( consp( args)) {
+  if ( consp( s_expr)) {
     /* the hard bit. Sort out what function is required and pass the
      * args to it. */
-    struct cons_pointer fn_pointer = lisp_car( args, env);
-    args = lisp_cdr( args, env);
+    struct cons_pointer fn_pointer = lisp_eval( c_car( s_expr), env, my_frame);
+    struct cons_pointer args = c_cdr( s_expr);
 
-    if ( functionp( fn_pointer)) {
+    if ( specialp( fn_pointer)) {
+      struct cons_space_object special = pointer2cell( fn_pointer);
+      result = (*special.payload.special.executable)( args, env, previous);
+    } else if ( functionp( fn_pointer)) {
       struct cons_space_object function = pointer2cell( fn_pointer);
+      struct stack_frame* frame = make_stack_frame( my_frame, args, env);
 
       /* the trick: pass the remaining arguments and environment to
          the executable code which is the payload of the function
          object. */
-      result = (*function.payload.function.executable)( args, env);
-    } else {
+      result = (*function.payload.function.executable)( frame, env);
+      free_stack_frame( frame);
+    } else if ( stringp( s_expr)) {
+      struct cons_pointer canonical = internedp( s_expr, env);
+      if ( !nilp( canonical)) {
+	result = c_assoc( canonical, env);
+      } else {
+	struct cons_pointer message =
+	  c_string_to_lisp_string( "Attempt to value of unbound name.");
+	result = lisp_throw( message, my_frame);
+      }
       /* the Clojure practice of having a map serve in the function
        * place of an s-expression is a good one and I should adopt it;
        * also if the object is a consp it could be interpretable
        * source code but in the long run I don't want an interpreter,
        * and if I can get away without so much the better. */
-      result = lisp_throw( args, env);
     }
   }
 
+  free_stack_frame( my_frame);
+  
   return result;
 }
 
 /**
- * Apply cons to this argsument list. Effectively, create a cons cell comprising
- * (car args) (cadr args).
+ * (cons a b)
+ *
+ * Function.
+ * Returns a cell constructed from a and b. If a is of type string but its
+ * cdr is nill, and b is of type string, then returns a new string cell;
+ * otherwise returns a new cons cell.
  */ 
-struct cons_pointer lisp_cons( struct cons_pointer args, struct cons_pointer env) {
-  struct cons_pointer result = NIL;
+struct cons_pointer lisp_cons(struct stack_frame* frame, struct cons_pointer env) {
+  struct cons_pointer car = frame->arg[0];
+  struct cons_pointer cdr = frame->arg[1];
+  struct cons_pointer result;
 
-  if ( consp( args)) {
-    struct cons_space_object cell = pointer2cell( args);
-    struct cons_pointer a = cell.payload.cons.car;
-    struct cons_pointer d = pointer2cell( cell.payload.cons.cdr).payload.cons.car;
-    result = make_cons( a, d);
+  if ( nilp( car) && nilp( cdr)) {
+    return NIL;
+  } else if ( stringp( car) && stringp( cdr) &&
+	      nilp( pointer2cell( car).payload.string.cdr)) {
+    result = make_string( pointer2cell( car).payload.string.character, cdr);
   } else {
-    lisp_throw( args, env);
+    result = make_cons( car, cdr);
   }
 
   return result;
 }
 
 /**
- * Apply car to this argsument list. Effectively, (car (car args))
+ * (car s_expr)
+ * Returns the first item (head) of a sequence. Valid for cons cells,
+ * strings, and TODO read streams and other things which can be considered as sequences.
  */
-struct cons_pointer lisp_car( struct cons_pointer args, struct cons_pointer env) {
+struct cons_pointer lisp_car(struct stack_frame* frame, struct cons_pointer env) {
   struct cons_pointer result = NIL;
 
-  if ( consp( args)) {
-    struct cons_space_object cell = pointer2cell( args);
-    result =  pointer2cell( cell.payload.cons.car).payload.cons.car;
+  if ( consp( frame->arg[ 0])) {
+    struct cons_space_object cell = pointer2cell( frame->arg[ 0]);
+    result = cell.payload.cons.car;
+  } else if ( stringp( frame->arg[ 0])) {
+    struct cons_space_object cell = pointer2cell( frame->arg[ 0]);
+    result = make_string( cell.payload.string.character, NIL);
   } else {
-    lisp_throw( args, env);
+    struct cons_pointer message =
+      c_string_to_lisp_string( "Attempt to take CAR/CDR of non sequence");
+    result = lisp_throw( message, frame);
   }
 
   return result;
@@ -135,28 +214,95 @@ struct cons_pointer lisp_car( struct cons_pointer args, struct cons_pointer env)
 
 
 /**
- * Apply cdr to this argsument list. Effectively, (cdr (car args))
+ * (cdr s_expr)
+ * Returns the remainder of a sequence when the head is removed. Valid for cons cells,
+ * strings, and TODO read streams and other things which can be considered as sequences.
  */
-struct cons_pointer lisp_cdr( struct cons_pointer args, struct cons_pointer env) {
+struct cons_pointer lisp_cdr(struct stack_frame* frame, struct cons_pointer env) {
   struct cons_pointer result = NIL;
 
-  if ( consp( args)) {
-    struct cons_space_object cell = pointer2cell( args);
-    result =  pointer2cell( cell.payload.cons.cdr).payload.cons.car;
+  if ( consp( frame->arg[ 0])) {
+    struct cons_space_object cell = pointer2cell( frame->arg[ 0]);
+    result = cell.payload.cons.car;
+  } else if ( stringp( frame->arg[ 0])) {
+    struct cons_space_object cell = pointer2cell( frame->arg[ 0]);
+    result = cell.payload.string.cdr;
   } else {
-    lisp_throw( args, env);
+    struct cons_pointer message =
+      c_string_to_lisp_string( "Attempt to take CAR/CDR of non sequence");
+    result = lisp_throw( message, frame);
   }
 
   return result;
 }
 
+/**
+ * (assoc key store)
+ * Returns the value associated with key in store, or NIL if not found.
+ */
+struct cons_pointer lisp_assoc( struct stack_frame* frame, struct cons_pointer env) {
+  return c_assoc( frame->arg[ 0], frame->arg[ 1]);
+}
+
+/**
+ * (eq a b)
+ * Returns T if a and b are pointers to the same object, else NIL
+ */
+struct cons_pointer lisp_eq( struct stack_frame* frame, struct cons_pointer env) {
+  return eq( frame->arg[ 0], frame->arg[ 1]) ? TRUE : NIL;
+}
+
+/**
+ * (eq a b)
+ * Returns T if a and b are pointers to structurally identical objects, else NIL
+ */
+struct cons_pointer lisp_equal( struct stack_frame* frame, struct cons_pointer env) {
+  return equal( frame->arg[ 0], frame->arg[ 1]) ? TRUE : NIL;
+}
+
+/**
+ * (read)
+ * (read read-stream)
+ * Read one complete lisp form and return it. If read-stream is specified and 
+ * is a read stream, then read from that stream, else stdin.
+ */
+struct cons_pointer lisp_read( struct stack_frame* frame, struct cons_pointer env) {
+  FILE* input = stdin;
+
+  if ( readp( frame->arg[0])) {
+    input = pointer2cell( frame->arg[0]).payload.stream.stream;
+  }
+
+  return read( input);
+}
+
+/**
+ * (print expr)
+ * (print expr write-stream)
+ * Print one complete lisp form and return NIL. If write-stream is specified and 
+ * is a write stream, then print to that stream, else stdout.
+ */
+struct cons_pointer lisp_print( struct stack_frame* frame, struct cons_pointer env) {
+  FILE* output = stdout;
+
+  if ( writep( frame->arg[1])) {
+    output = pointer2cell( frame->arg[1]).payload.stream.stream;
+  }
+
+  print( output, frame->arg[0]);
+  
+  return NIL;
+}
+
 
 /**
  * TODO: make this do something sensible somehow.
  */
-struct cons_pointer lisp_throw( struct cons_pointer args, struct cons_pointer env) {
-  fprintf( stderr, "An exception was thrown and I've no idea what to do now\n");
+struct cons_pointer lisp_throw( struct cons_pointer message, struct stack_frame* frame) {
+  fprintf( stderr, "\nERROR: ");
+  print( stderr, message);
+  fprintf( stderr, "\n\nAn exception was thrown and I've no idea what to do now\n");
 
-  return NIL;
+  exit( 1);
 }
 
diff --git a/src/lispops.h b/src/lispops.h
new file mode 100644
index 0000000..c9da923
--- /dev/null
+++ b/src/lispops.h
@@ -0,0 +1,23 @@
+/**
+ * lispops.h
+ *
+ * List processing operations.
+ *
+ * The general idea here is that a list processing operation is a
+ * function which takes two arguments, both cons_pointers:
+ *
+ * 1. args, the argument list to this function;
+ * 2. env, the environment in which this function should be evaluated;
+ *
+ * and returns a cons_pointer, the result.
+ *
+ * They must all have the same signature so that I can call them as
+ * function pointers.
+ *
+ *
+ * (c) 2017 Simon Brooke <simon@journeyman.cc>
+ * 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);
+
diff --git a/src/read.c b/src/read.c
index f7a572f..6fdfe76 100644
--- a/src/read.c
+++ b/src/read.c
@@ -144,10 +144,6 @@ struct cons_pointer read( FILE* input) {
   return read_continuation( input, '\0');
 }
 
-
-struct cons_pointer lisp_read( struct cons_pointer args, struct cons_pointer env) {
-  return( read( stdin));
-}
     
 
 
diff --git a/src/stack.c b/src/stack.c
index 7e24574..148ef41 100644
--- a/src/stack.c
+++ b/src/stack.c
@@ -22,12 +22,16 @@
 
 #include "consspaceobject.h"
 #include "conspage.h"
+#include "lispops.h"
 #include "stack.h"
 
 /**
- * Allocate a new stack frame with its previous pointer set to this value
+ * Allocate a new stack frame with its previous pointer set to this value,
+ * its arguments set up from these args, evaluated in this env.
  */
-struct stack_frame* make_stack_frame(struct stack_frame* previous) {
+struct stack_frame* make_stack_frame( struct stack_frame* previous,
+				      struct cons_pointer args,
+				      struct cons_pointer env) {
   /* TODO: later, pop a frame off a free-list of stack frames */
   struct stack_frame* result = malloc( sizeof( struct stack_frame));
 
@@ -38,8 +42,31 @@ struct stack_frame* make_stack_frame(struct stack_frame* previous) {
   result->more = NIL;
   result->function = NIL;
 
-  for ( int i = 0; i < locals_in_frame; i++) {
-    result->local[i] = NIL;
+  for ( int i = 0; i < args_in_frame; i++) {
+    result->arg[i] = NIL;
+  }
+
+  int i = 0;                            /* still an index into args, so same
+					 * name will do */
+  
+  while ( ! nilp( args)) {              /* iterate down the arg list filling in
+					 * the arg slots in the frame. When there
+					 * are no more slots, if there are still
+					 * args, stash them on more */
+    struct cons_space_object cell = pointer2cell( args);
+
+    if ( i < args_in_frame) {
+      /* 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);
+      /* TODO: later, going to have to mess with reference counts */
+      args = cell.payload.cons.cdr;
+    } else {
+      /* TODO: this isn't right. These args should also each be evaled. */
+      result->more = args;
+      args = NIL;
+    }
   }
 
   return result;
@@ -49,6 +76,7 @@ struct stack_frame* make_stack_frame(struct stack_frame* previous) {
  * Free this stack frame.
  */
 void free_stack_frame( struct stack_frame* frame) {
+  /* TODO: later, mess with reference counts on locals */
   /* TODO: later, push it back on the stack-frame freelist */
   free( frame);
 }
@@ -56,15 +84,15 @@ void free_stack_frame( struct stack_frame* frame) {
 /**
  * Fetch a pointer to the value of the local variable at this index.
  */
-struct cons_pointer fetch_local( struct stack_frame* frame, unsigned int index) {
+struct cons_pointer fetch_arg( struct stack_frame* frame, unsigned int index) {
   struct cons_pointer result = NIL;
   
-  if ( index < locals_in_frame) {
-    result = frame->local[ index];
+  if ( index < args_in_frame) {
+    result = frame->arg[ index];
   } else {
     struct cons_pointer p = frame->more;
     
-    for ( int i = locals_in_frame; i < index; i++) {
+    for ( int i = args_in_frame; i < index; i++) {
       p = pointer2cell( p).payload.cons.cdr;
     }
 
diff --git a/src/stack.h b/src/stack.h
index ec3d956..9cb95a1 100644
--- a/src/stack.h
+++ b/src/stack.h
@@ -19,24 +19,18 @@
  */
 
 #include "consspaceobject.h"
+#include "conspage.h"
 
 #ifndef __stack_h
 #define __stack_h
 
-/* number of local variables stored in a stack frame */
-#define locals_in_frame 8
-
-struct stack_frame* make_stack_frame(struct stack_frame* previous);
+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);
-struct cons_pointer fetch_local( struct stack_frame* frame, unsigned int n);
+struct cons_pointer fetch_arg( struct stack_frame* frame, unsigned int n);
 
-struct stack_frame {
-  struct stack_frame* previous;         /* the previous frame */
-  struct cons_pointer local[locals_in_frame];
-                                        /* first 8 local variable bindings */
-  struct cons_pointer more;             /* list of any further local 
-					 * variable bindings */
-  struct cons_pointer function;         /* the function to be called */
-};
+/* struct stack_frame is defined in consspaceobject.h to break circularity
+ * TODO: refactor. */
 
 #endif

From 03dfe37045a5918cad358f1cd02f244490f10455 Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Fri, 20 Jan 2017 12:05:10 +0000
Subject: [PATCH 5/7] Lisp-ops bound on oblist but not yet being used. All unit
 tests still pass.

---
 src/consspaceobject.c | 48 +++++++++++++++++++++++++++++++++++++------
 src/consspaceobject.h | 16 +++++++++++++++
 src/init.c            | 28 ++++++++++++++++++++++++-
 src/intern.c          | 22 ++++++++++----------
 src/lispops.c         | 19 +----------------
 src/lispops.h         | 18 +++++++++++++++-
 src/stack.c           |  2 +-
 7 files changed, 115 insertions(+), 38 deletions(-)

diff --git a/src/consspaceobject.c b/src/consspaceobject.c
index 68b32b9..d4e9d50 100644
--- a/src/consspaceobject.c
+++ b/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.
  */
diff --git a/src/consspaceobject.h b/src/consspaceobject.h
index fe055c2..628474c 100644
--- a/src/consspaceobject.h
+++ b/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.
  */
diff --git a/src/init.c b/src/init.c
index 33c9836..a5c3c40 100644
--- a/src/init.c
+++ b/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);
diff --git a/src/intern.c b/src/intern.c
index 862c43a..3cc9379 100644
--- a/src/intern.c
+++ b/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
diff --git a/src/lispops.c b/src/lispops.c
index f91ba02..6dd4d88 100644
--- a/src/lispops.c
+++ b/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.
  */
diff --git a/src/lispops.h b/src/lispops.h
index c9da923..1268b7e 100644
--- a/src/lispops.h
+++ b/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);
diff --git a/src/stack.c b/src/stack.c
index 148ef41..2f8b926 100644
--- a/src/stack.c
+++ b/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 {

From 770767c11e377919e6776c15562b439bf5954e36 Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Fri, 20 Jan 2017 12:27:09 +0000
Subject: [PATCH 6/7] Now have quote. Everything still seems to work. Unit
 tests still pass.

---
 src/init.c    |  7 +++++++
 src/lispops.c | 13 +++++++++++++
 src/lispops.h |  2 ++
 3 files changed, 22 insertions(+)

diff --git a/src/init.c b/src/init.c
index a5c3c40..237cc03 100644
--- a/src/init.c
+++ b/src/init.c
@@ -36,6 +36,11 @@ int main (int argc, char *argv[]) {
   fprintf( stderr, "Post scarcity software environment version %s\n", VERSION);
   initialise_cons_pages();
 
+  /* privileged variables (keywords) */
+  deep_bind( intern( c_string_to_lisp_string( "nil"), oblist), NIL);
+  deep_bind( intern( c_string_to_lisp_string( "t"), oblist), TRUE);
+
+  /* primitive function operations */
   bind_function( "assoc", &lisp_assoc);
   bind_function( "car", &lisp_car);
   bind_function( "cdr", &lisp_cdr);
@@ -45,8 +50,10 @@ int main (int argc, char *argv[]) {
   bind_function( "read", &lisp_read);
   bind_function( "print", &lisp_print);
 
+  /* primitive special forms */
   bind_special( "apply", &lisp_apply);
   bind_special( "eval", &lisp_eval);
+  bind_special( "quote", &lisp_quote);
 
   fprintf( stderr, "\n:: ");
   struct cons_pointer input = read( stdin);
diff --git a/src/lispops.c b/src/lispops.c
index 6dd4d88..0399b21 100644
--- a/src/lispops.c
+++ b/src/lispops.c
@@ -117,6 +117,7 @@ struct cons_pointer lisp_eval( struct cons_pointer s_expr, struct cons_pointer e
       struct cons_space_object special = pointer2cell( fn_pointer);
       result = (*special.payload.special.executable)( args, env, previous);
     } else if ( functionp( fn_pointer)) {
+      /* actually, this is apply */
       struct cons_space_object function = pointer2cell( fn_pointer);
       struct stack_frame* frame = make_stack_frame( my_frame, args, env);
 
@@ -147,6 +148,18 @@ struct cons_pointer lisp_eval( struct cons_pointer s_expr, struct cons_pointer e
   return result;
 }
 
+/**
+ * (quote a)
+ *
+ * Special form
+ * Returns its argument (strictly first argument - only one is expected but
+ * this isn't at this stage checked) unevaluated.
+ */
+struct cons_pointer lisp_quote( struct cons_pointer args, struct cons_pointer env,
+				struct stack_frame* frame) {
+  return c_car( args);
+}
+
 /**
  * (cons a b)
  *
diff --git a/src/lispops.h b/src/lispops.h
index 1268b7e..597d67f 100644
--- a/src/lispops.h
+++ b/src/lispops.h
@@ -24,6 +24,8 @@ 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);
+struct cons_pointer lisp_quote( 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);

From e968b30bbcc4f7b534fdfd2312a331b06925f8fa Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Fri, 20 Jan 2017 18:24:48 +0000
Subject: [PATCH 7/7] Sorted out some interesting buglets in read and print
 (although there is still one I know of). More unit tests, and all pass. Not
 evalling yet.

Good day's work.
---
 src/consspaceobject.c      | 55 ++++++++++++++++++-----
 src/consspaceobject.h      | 84 +++++++++++++++++++++++++---------
 src/init.c                 |  8 ++--
 src/lispops.c              | 92 ++++++++++++++++++++++++++------------
 src/print.c                | 59 ++++++++++++++++--------
 src/read.c                 | 88 +++++++++++++++++++++++++++++-------
 src/stack.c                | 11 ++++-
 unit-tests/complex-list.sh |  4 +-
 unit-tests/nil.sh          |  2 +-
 unit-tests/quote.sh        | 13 ++++++
 unit-tests/quoted-list.sh  | 13 ++++++
 unit-tests/simple-list.sh  |  2 +-
 12 files changed, 325 insertions(+), 106 deletions(-)
 create mode 100644 unit-tests/quote.sh
 create mode 100644 unit-tests/quoted-list.sh

diff --git a/src/consspaceobject.c b/src/consspaceobject.c
index d4e9d50..f9420d6 100644
--- a/src/consspaceobject.c
+++ b/src/consspaceobject.c
@@ -103,16 +103,14 @@ void dump_object( FILE* output, struct cons_pointer pointer) {
 struct cons_pointer make_cons( struct cons_pointer car, struct cons_pointer cdr) {
   struct cons_pointer pointer = NIL;
 
-  if ( ! ( nilp( car) && nilp( cdr))) {
-   pointer = allocate_cell( CONSTAG);
+  pointer = allocate_cell( CONSTAG);
 
-   struct cons_space_object* cell = &conspages[pointer.page]->cell[pointer.offset];
+  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;
-  }
+  inc_ref(car);
+  inc_ref(cdr);
+  cell->payload.cons.car = car;
+  cell->payload.cons.cdr = cdr;
 
   return pointer;
 }
@@ -138,11 +136,13 @@ struct cons_pointer make_function( struct cons_pointer src,
  * has one character and a pointer to the next; in the last cell the 
  * pointer to next is NIL.
  */
-struct cons_pointer make_string( wint_t c, struct cons_pointer tail) {
+struct cons_pointer make_string_like_thing( wint_t c,
+					    struct cons_pointer tail,
+					    char* tag) {
   struct cons_pointer pointer = NIL;
   
-  if ( check_tag( tail, STRINGTAG) || check_tag( tail, NILTAG)) {
-    pointer = allocate_cell( STRINGTAG);
+  if ( check_tag( tail, tag) || check_tag( tail, NILTAG)) {
+    pointer = allocate_cell( tag);
     struct cons_space_object* cell = &pointer2cell(pointer);
 
     inc_ref(tail);
@@ -150,12 +150,30 @@ struct cons_pointer make_string( wint_t c, struct cons_pointer tail) {
     cell->payload.string.cdr.page = tail.page;
     cell->payload.string.cdr.offset = tail.offset;
   } else {
-    fprintf( stderr, "Warning: only NIL and STRING can be appended to STRING\n");
+    fprintf( stderr, "Warning: only NIL and %s can be appended to %s\n",
+	     tag, tag);
   }
   
   return pointer;
 }
 
+/**
+ * Construct a string from this character and
+ * this tail. A string is implemented as a flat list of cells each of which
+ * has one character and a pointer to the next; in the last cell the 
+ * pointer to next is NIL.
+ */
+struct cons_pointer make_string( wint_t c, struct cons_pointer tail) {
+  return make_string_like_thing( c, tail, STRINGTAG);
+}
+
+/**
+ * Construct a symbol from this character and this tail. 
+ */
+struct cons_pointer make_symbol( wint_t c, struct cons_pointer tail) {
+  return make_string_like_thing( c, tail, SYMBOLTAG);
+}
+
 /**
  * Construct a cell which points to an executable Lisp special form.
  */
@@ -185,3 +203,16 @@ struct cons_pointer c_string_to_lisp_string( char* string) {
 
   return result;
 }
+
+/**
+ * Return a lisp symbol representation of this old skool ASCII string.
+ */
+struct cons_pointer c_string_to_lisp_symbol( char* symbol) {
+  struct cons_pointer result = NIL;
+
+  for ( int i = strlen( symbol); i > 0; i--) {
+    result = make_symbol( (wint_t)symbol[ i - 1], result);
+  }
+
+  return result;
+}
diff --git a/src/consspaceobject.h b/src/consspaceobject.h
index 628474c..4729061 100644
--- a/src/consspaceobject.h
+++ b/src/consspaceobject.h
@@ -27,52 +27,78 @@
  * tag values, all of which must be 4 bytes. Must not collide with vector space tag values
  */
 /**
- * An ordinary cons cell
+ * An ordinary cons cell: 1397641027
  */
 #define CONSTAG     "CONS"
+#define CONSTV      1397641027
+
 /**
  * An unallocated cell on the free list - should never be encountered by a Lisp
- * function
+ * function. 1162170950
  */
 #define FREETAG     "FREE"
+#define FREETV      1162170950
+
 /**
  * An ordinary Lisp function - one whose arguments are pre-evaluated and passed as
- * a stack frame.
+ * a stack frame. 1129207110
  */
 #define FUNCTIONTAG "FUNC"
+#define FUNCTIONTV  1129207110
 /**
- * An integer number.
+ * An integer number. 1381256777
  */
 #define INTEGERTAG  "INTR"
+#define INTEGERTV   1381256777
+
 /**
  * The special cons cell at address {0,0} whose car and cdr both point to itself.
+ * 541870414
  */
 #define NILTAG      "NIL "
+#define NILTV       541870414
+
 /**
  * An open read stream.
  */
 #define READTAG     "READ"
+
 /**
  * A real number.
  */
 #define REALTAG     "REAL"
+
 /**
  * A special form - one whose arguments are not pre-evaluated but passed as a
- * s-expression.
+ * s-expression. 1296453715
  */
 #define SPECIALTAG  "SPFM"
+#define SPECIALTV   1296453715
+
 /**
- * A string of characters, organised as a linked list.
+ * A string of characters, organised as a linked list. 1196577875
  */
 #define STRINGTAG   "STRG"
+#define STRINGTV    1196577875
+
 /**
- * The special cons cell at address {0,1} which is canonically different from NIL
+ * A symbol is just like a string except not self-evaluating. 1112365395 
+ */
+#define SYMBOLTAG   "SYMB"
+#define SYMBOLTV    1112365395
+
+/**
+ * The special cons cell at address {0,1} which is canonically different from NIL.
+ * 1163219540
  */
 #define TRUETAG     "TRUE"
+#define TRUETV      1163219540
+
 /**
  * A pointer to an object in vector space.
  */
 #define VECTORPOINTTAG  "VECP"
+
 /**
  * An open write stream.
  */
@@ -126,6 +152,11 @@
  */
 #define stringp(conspoint) (check_tag(conspoint,STRINGTAG))
 
+/**
+ * true if conspointer points to a string cell, else false 
+ */
+#define symbolp(conspoint) (check_tag(conspoint,SYMBOLTAG))
+
 /**
  * true if conspointer points to an integer cell, else false 
  */
@@ -148,11 +179,10 @@
 #define numberp(conspoint) (check_tag(conspoint,INTEGERTAG)||check_tag(conspoint,REALTAG))
 
 /**
- * true if conspointer points to a write stream cell, else false 
+ * true if conspointer points to a write stream cell, else false.
  */
 #define writep(conspoint) (check_tag(conspoint,WRITETAG))
 
-
 /**
  * true if conspointer points to a true cell, else false 
  * (there should only be one of these so it's slightly redundant).
@@ -266,7 +296,9 @@ struct stream_payload {
 
 /**
  * payload of a string cell. At least at first, only one UTF character will
- * be stored in each cell.
+ * be stored in each cell. The doctrine that 'a symbol is just a string'
+ * didn't work; however, the payload of a symbol cell is identical to the
+ * payload of a string cell.
  */
 struct string_payload {
   wint_t character;            /* the actual character stored in this cell */
@@ -309,13 +341,13 @@ struct cons_space_object {
     struct integer_payload integer;
     /* if tag == NILTAG; we'll treat the special cell NIL as just a cons */
     struct cons_payload nil;
-/* if tag == READTAG || tag == WRITETAG */
-struct stream_payload stream;
+    /* if tag == READTAG || tag == WRITETAG */
+    struct stream_payload stream;
     /* if tag == REALTAG */
     struct real_payload real;
     /* if tag == SPECIALTAG */
     struct special_payload special;
-    /* if tag == STRINGTAG */
+    /* if tag == STRINGTAG || tag == SYMBOLTAG */
     struct string_payload string;
     /* if tag == TRUETAG; we'll treat the special cell T as just a cons */
     struct cons_payload t;
@@ -357,14 +389,6 @@ 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
- * has one character and a pointer to the next; in the last cell the 
- * pointer to next is NIL.
- */
-struct cons_pointer make_string( wint_t c, struct cons_pointer tail);
-
 /**
  * Construct a cell which points to an executable Lisp special form.
  */
@@ -374,9 +398,27 @@ struct cons_pointer make_special( struct cons_pointer src,
 				   struct cons_pointer env,
 				   struct stack_frame* frame));
 
+/**
+ * Construct a string from this character and this tail. A string is
+ * implemented as a flat list of cells each of which has one character and a 
+ * pointer to the next; in the last cell the pointer to next is NIL.
+ */
+struct cons_pointer make_string( wint_t c, struct cons_pointer tail);
+
+/**
+ * Construct a symbol from this character and this tail. A symbol is identical
+ * to a string except for having a different tag.
+ */
+struct cons_pointer make_symbol( wint_t c, struct cons_pointer tail);
+
 /**
  * Return a lisp string representation of this old skool ASCII string.
  */
 struct cons_pointer c_string_to_lisp_string( char* string);
 
+/**
+ * Return a lisp symbol representation of this old skool ASCII string.
+ */
+struct cons_pointer c_string_to_lisp_symbol( char* symbol);
+
 #endif
diff --git a/src/init.c b/src/init.c
index 237cc03..1cee833 100644
--- a/src/init.c
+++ b/src/init.c
@@ -21,14 +21,14 @@
 
 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 ),
+  deep_bind( intern( c_string_to_lisp_symbol( 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 ),
+  deep_bind( intern( c_string_to_lisp_symbol( name), oblist ),
 	     make_special( NIL, executable));
 }
 
@@ -57,8 +57,10 @@ int main (int argc, char *argv[]) {
 
   fprintf( stderr, "\n:: ");
   struct cons_pointer input = read( stdin);
-  fprintf( stderr, "\n{%d,%d}=> ", input.page, input.offset);
+  fprintf( stderr, "\nread {%d,%d}=> ", input.page, input.offset);
   print( stdout, input);
+  fprintf( stderr, "\neval {%d,%d}=> ", input.page, input.offset);
+  // print( stdout, lisp_eval( input, oblist, NULL));
 
   dump_pages(stderr);
   
diff --git a/src/lispops.c b/src/lispops.c
index 0399b21..d85d9ac 100644
--- a/src/lispops.c
+++ b/src/lispops.c
@@ -22,6 +22,7 @@
 #include <stdbool.h>
 #include <stdio.h>
 #include <stdlib.h>
+#include <string.h>
 
 #include "consspaceobject.h"
 #include "conspage.h"
@@ -88,6 +89,52 @@ struct cons_pointer lisp_apply( struct cons_pointer args, struct cons_pointer en
   return result;
 }
 
+struct cons_pointer eval_cons( struct cons_pointer s_expr, 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 cons_space_object fn_cell = pointer2cell( fn_pointer);
+  struct cons_pointer args = c_cdr( s_expr);
+
+  switch ( fn_cell.tag.value) {
+  case SPECIALTV :
+    {
+      struct cons_space_object special = pointer2cell( fn_pointer);
+      result = (*special.payload.special.executable)( args, env, my_frame);
+    }
+    break;
+
+  case FUNCTIONTV :
+    /* actually, this is apply */
+    {
+      struct cons_space_object function = pointer2cell( fn_pointer);
+      struct stack_frame* frame = make_stack_frame( my_frame, args, env);
+
+      /* the trick: pass the remaining arguments and environment to
+	 the executable code which is the payload of the function
+	 object. */
+      result = (*function.payload.function.executable)( frame, env);
+      free_stack_frame( frame);
+    }
+    break;
+
+  default :
+    {
+      char* buffer = malloc( 1024);
+      memset( buffer, '\0', 1024);
+      sprintf( buffer,
+	       "Unexpected cell with tag %d (%c%c%c%c) in function position",
+	       fn_cell.tag.value, fn_cell.tag.bytes[0], fn_cell.tag.bytes[1],
+	       fn_cell.tag.bytes[2], fn_cell.tag.bytes[3]);
+      struct cons_pointer message = c_string_to_lisp_string( buffer);
+      free( buffer);
+      result = lisp_throw( message, my_frame);
+    }
+  }
+
+  return result;
+}
+
 /**
  * (eval s_expr)
  *
@@ -104,43 +151,32 @@ struct cons_pointer lisp_apply( struct cons_pointer args, struct cons_pointer en
 struct cons_pointer lisp_eval( struct cons_pointer s_expr, struct cons_pointer env,
 			       struct stack_frame* previous) {
   struct cons_pointer result = s_expr;
+  struct cons_space_object cell = pointer2cell( s_expr);
   struct stack_frame* my_frame =
     make_stack_frame( previous, make_cons( s_expr, NIL), env);
-  
-  if ( consp( s_expr)) {
-    /* the hard bit. Sort out what function is required and pass the
-     * args to it. */
-    struct cons_pointer fn_pointer = lisp_eval( c_car( s_expr), env, my_frame);
-    struct cons_pointer args = c_cdr( s_expr);
 
-    if ( specialp( fn_pointer)) {
-      struct cons_space_object special = pointer2cell( fn_pointer);
-      result = (*special.payload.special.executable)( args, env, previous);
-    } else if ( functionp( fn_pointer)) {
-      /* actually, this is apply */
-      struct cons_space_object function = pointer2cell( fn_pointer);
-      struct stack_frame* frame = make_stack_frame( my_frame, args, env);
+  switch ( cell.tag.value) {
+  case CONSTV :
+    result = eval_cons( s_expr, env, my_frame);
+    break;
 
-      /* the trick: pass the remaining arguments and environment to
-         the executable code which is the payload of the function
-         object. */
-      result = (*function.payload.function.executable)( frame, env);
-      free_stack_frame( frame);
-    } else if ( stringp( s_expr)) {
+  case SYMBOLTV :
+    {
       struct cons_pointer canonical = internedp( s_expr, env);
-      if ( !nilp( canonical)) {
-	result = c_assoc( canonical, env);
-      } else {
+      if ( nilp( canonical)) {
 	struct cons_pointer message =
-	  c_string_to_lisp_string( "Attempt to value of unbound name.");
+	  c_string_to_lisp_string( "Attempt to take value of unbound symbol.");
 	result = lisp_throw( message, my_frame);
+      } else {
+	result = c_assoc( canonical, env);
       }
-      /* the Clojure practice of having a map serve in the function
-       * place of an s-expression is a good one and I should adopt it;
-       * also if the object is a consp it could be interpretable
-       * source code but in the long run I don't want an interpreter,
-       * and if I can get away without so much the better. */
     }
+    break;
+    /* the Clojure practice of having a map serve in the function
+     * place of an s-expression is a good one and I should adopt it;
+     * also if the object is a consp it could be interpretable
+     * source code but in the long run I don't want an interpreter,
+     * and if I can get away without so much the better. */
   }
 
   free_stack_frame( my_frame);
diff --git a/src/print.c b/src/print.c
index a263d6f..36e0fa9 100644
--- a/src/print.c
+++ b/src/print.c
@@ -21,7 +21,7 @@
 #include "print.h"
 
 void print_string_contents( FILE* output, struct cons_pointer pointer) {
-  if ( check_tag( pointer, STRINGTAG)) {
+  if ( stringp( pointer) || symbolp( pointer)) {
     struct cons_space_object* cell = &pointer2cell(pointer);
     wint_t c = cell->payload.string.character;
 
@@ -39,24 +39,34 @@ void print_string( FILE* output, struct cons_pointer pointer) {
   fputc( '"', output);
 }
 
+/**
+ * Print a single list cell (cons cell). TODO: does not handle dotted pairs.
+ */
+void print_list_contents( FILE* output, struct cons_pointer pointer,
+			  bool initial_space) {
+  struct cons_space_object* cell = &pointer2cell(pointer);
 
-void print_list_contents( FILE* output, struct cons_pointer pointer) {
-  if ( check_tag( pointer, CONSTAG)) {
-    struct cons_space_object* cell = &pointer2cell(pointer);
-
+  switch ( cell->tag.value) {
+  case CONSTV :
+    if (initial_space) {
+      fputc( ' ', output);
+    }      
     print( output, cell->payload.cons.car);
 
-    if ( !nilp( cell->payload.cons.cdr)) {
-      fputc( ' ', output);
-    }
-    print_list_contents( output, cell->payload.cons.cdr);
+    print_list_contents( output, cell->payload.cons.cdr, true);
+    break;
+  case NILTV:
+    break;
+  default:
+    fprintf( output, " . ");
+    print( output, pointer);
   }
 }
 
 
 void print_list( FILE* output, struct cons_pointer pointer) {
   fputc( '(', output);
-  print_list_contents( output, pointer);
+  print_list_contents( output, pointer, false);
   fputc( ')', output);
 }
 
@@ -66,17 +76,28 @@ void print( FILE* output, struct cons_pointer pointer) {
   /* Because tags have values as well as bytes, this if ... else if
    * statement can ultimately be replaced by a switch, which will
    * be neater. */
-  if ( check_tag( pointer, CONSTAG)) {
+  switch ( cell.tag.value) {
+  case CONSTV :
     print_list( output, pointer);
-  } else if ( check_tag( pointer, INTEGERTAG)) {
+    break;
+  case INTEGERTV :
     fprintf( output, "%ld", cell.payload.integer.value);
-  } else if ( check_tag( pointer, NILTAG)) {
-    fprintf( output, "NIL");
-  } else if ( check_tag( pointer, REALTAG)) {
-    fprintf( output, "%Lf", cell.payload.real.value);
-  } else if ( check_tag( pointer, STRINGTAG)) {
+    break;
+  case NILTV :
+    fprintf( output, "nil");
+    break;
+  case STRINGTV :
     print_string( output, pointer);
-  } else if ( check_tag( pointer, TRUETAG)) {
-    fprintf( output, "T");
+    break;
+  case SYMBOLTV :
+    print_string_contents( output, pointer);
+    break;
+  case TRUETV :
+    fprintf( output, "t");
+    break;
+  default :
+    fprintf( stderr, "Error: Unrecognised tag value %d (%c%c%c%c)\n",
+	     cell.tag.value, cell.tag.bytes[0], cell.tag.bytes[1],
+	     cell.tag.bytes[2], cell.tag.bytes[3]);
   }
 }
diff --git a/src/read.c b/src/read.c
index 6fdfe76..d45b628 100644
--- a/src/read.c
+++ b/src/read.c
@@ -16,6 +16,7 @@
 
 #include "consspaceobject.h"
 #include "integer.h"
+#include "intern.h"
 #include "read.h"
 
 /* for the time being things which may be read are:
@@ -27,7 +28,15 @@
 struct cons_pointer read_number( FILE* input, wint_t initial);
 struct cons_pointer read_list( FILE* input, wint_t initial);
 struct cons_pointer read_string( FILE* input, wint_t initial);
+struct cons_pointer read_symbol( FILE* input, wint_t initial);
 
+/**
+ * quote reader macro in C (!)
+ */
+struct cons_pointer c_quote( struct cons_pointer arg) {
+  return make_cons( c_string_to_lisp_symbol( "quote"),
+		    make_cons( arg, NIL));
+}
 
 /**
  * Read the next object on this input stream and return a cons_pointer to it,
@@ -39,20 +48,28 @@ struct cons_pointer read_continuation( FILE* input, wint_t initial) {
 
   wint_t c;
 
-  for (c = initial; c == '\0' || iswblank( c); c = fgetwc( input));
+  for (c = initial;
+       c == '\0' || iswblank( c) || iswcntrl(c); 
+       c = fgetwc( input));
   
   switch( c) {
+  case '\'':
+    result = c_quote( read_continuation( input, fgetwc( input)));
+    break;
   case '(' :
-  case ')':
     result = read_list(input, fgetwc( input));
     break;
-  case '"': result = read_string(input, fgetwc( input));
+  case '"':
+    result = read_string(input, fgetwc( input));
     break;
   default:
     if ( iswdigit( c)) {
       result = read_number( input, c);
-    } 
-    fprintf( stderr, "Unrecognised start of input character %c\n", c);
+    } else if (iswprint( c)) {
+      result = read_symbol( input, c);
+    } else {
+      fprintf( stderr, "Unrecognised start of input character %c\n", c);
+    }
   }
 
   return result;
@@ -83,7 +100,7 @@ struct cons_pointer read_number( FILE* input, wint_t initial) {
   }
 
   /* push back the character read which was not a digit */
-  fputwc( c, input);
+  ungetwc( c, input);
 
   return make_integer( accumulator);
 }
@@ -94,15 +111,14 @@ struct cons_pointer read_number( FILE* input, wint_t initial) {
  * left parenthesis.
  */
 struct cons_pointer read_list( FILE* input, wint_t initial) {
-  struct cons_pointer cdr = NIL;
   struct cons_pointer result= NIL;
 
-  fwprintf( stderr, L"read_list starting '%C' (%d)\n", initial, initial);
-  
   if ( initial != ')' ) {
+    fwprintf( stderr, L"read_list starting '%C' (%d)\n", initial, initial);
     struct cons_pointer car = read_continuation( input, initial);
-    cdr = read_list( input, fgetwc( input));
-    result = make_cons( car, cdr);
+    result = make_cons( car, read_list( input, fgetwc( input)));
+  } else {
+    fprintf( stderr, "End of list detected\n");
   }
 
   return result;
@@ -110,16 +126,18 @@ struct cons_pointer read_list( FILE* input, wint_t initial) {
 
 
 /** 
- * Read a string from this input stream, which no longer contains the opening
- * double quote. Note that there is (for now) a problem with the list
- * representation of a string, which is that there's no obvious representation of
- * an empty string.
+ * Read a string. This means either a string delimited by double quotes 
+ * (is_quoted == true), in which case it may contain whitespace but may
+ * not contain a double quote character (unless escaped), or one not
+ * so delimited in which case it may not contain whitespace (unless escaped)
+ * but may contain a double quote character (probably not a good idea!)
  */
 struct cons_pointer read_string( FILE* input, wint_t initial) {
   struct cons_pointer cdr = NIL;
   struct cons_pointer result;
 
-  fwprintf( stderr, L"read_string starting '%C' (%d)\n", initial, initial);
+  fwprintf( stderr, L"read_string starting '%C' (%d)\n",
+	    initial, initial);
 
   switch ( initial) {
   case '\0':
@@ -137,11 +155,47 @@ struct cons_pointer read_string( FILE* input, wint_t initial) {
 }
 
 
+struct cons_pointer read_symbol( FILE* input, wint_t initial) {
+  struct cons_pointer cdr = NIL;
+  struct cons_pointer result;
+
+  fwprintf( stderr, L"read_symbol starting '%C' (%d)\n",
+	    initial, initial);
+
+  switch ( initial) {
+  case '\0':
+    result = make_symbol( initial, NIL);
+    break;
+  case '"':
+    /* THIS IS NOT A GOOD IDEA, but is legal */
+    result = make_symbol( initial, read_symbol( input, fgetwc( input)));
+    break;
+  case ')' :
+    /* unquoted strings may not include right-parenthesis */
+    result = make_symbol( '\0', NIL);
+    /* push back the character read */
+    ungetwc( initial, input);
+    break;
+  default:
+    if ( iswblank( initial) || !iswprint( initial)) {
+      result = make_symbol( '\0', NIL);
+      /* push back the character read */
+      ungetwc( initial, input);
+    } else {
+      result = make_symbol( initial, read_symbol( input, fgetwc( input)));
+    }
+    break;
+  }
+
+  return result;
+}
+
+
 /**
  * Read the next object on this input stream and return a cons_pointer to it.
  */
 struct cons_pointer read( FILE* input) {
-  return read_continuation( input, '\0');
+  return read_continuation( input, fgetwc( input));
 }
 
     
diff --git a/src/stack.c b/src/stack.c
index 2f8b926..8894ff3 100644
--- a/src/stack.c
+++ b/src/stack.c
@@ -60,11 +60,14 @@ struct stack_frame* make_stack_frame( struct stack_frame* previous,
        * 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);
-      /* TODO: later, going to have to mess with reference counts */
+      inc_ref( result->arg[i]);
+
       args = cell.payload.cons.cdr;
     } else {
       /* TODO: this isn't right. These args should also each be evaled. */
       result->more = args;
+      inc_ref( result->more);
+      
       args = NIL;
     }
   }
@@ -76,8 +79,12 @@ struct stack_frame* make_stack_frame( struct stack_frame* previous,
  * Free this stack frame.
  */
 void free_stack_frame( struct stack_frame* frame) {
-  /* TODO: later, mess with reference counts on locals */
   /* TODO: later, push it back on the stack-frame freelist */
+  for ( int i = 0; i < args_in_frame; i++) {
+    dec_ref( frame->arg[ i]);
+  }
+  dec_ref( frame->more);
+  
   free( frame);
 }
 
diff --git a/unit-tests/complex-list.sh b/unit-tests/complex-list.sh
index dd9c7e1..6376fd6 100644
--- a/unit-tests/complex-list.sh
+++ b/unit-tests/complex-list.sh
@@ -1,7 +1,7 @@
 #!/bin/bash
 
-expected='(1 2 3 ("Fred") NIL 77354)'
-actual=`echo '(1 2 3 ("Fred") () 77354 )' | target/psse 2> /dev/null`
+expected='(1 2 3 ("Fred") nil 77354)'
+actual=`echo '(1 2 3 ("Fred") () 77354)' | target/psse 2> /dev/null`
 
 if [ "${expected}" = "${actual}" ]
 then
diff --git a/unit-tests/nil.sh b/unit-tests/nil.sh
index 0ecd516..5449330 100644
--- a/unit-tests/nil.sh
+++ b/unit-tests/nil.sh
@@ -1,6 +1,6 @@
 #!/bin/bash
 
-expected=NIL
+expected=nil
 actual=`echo '()' | target/psse 2> /dev/null`
 
 if [ "${expected}" = "${actual}" ]
diff --git a/unit-tests/quote.sh b/unit-tests/quote.sh
new file mode 100644
index 0000000..624bdfb
--- /dev/null
+++ b/unit-tests/quote.sh
@@ -0,0 +1,13 @@
+#!/bin/bash
+
+expected='(quote Fred)'
+actual=`echo "'Fred" | target/psse 2> /dev/null`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+    exit 0
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    exit 1
+fi
diff --git a/unit-tests/quoted-list.sh b/unit-tests/quoted-list.sh
new file mode 100644
index 0000000..eb4e7f3
--- /dev/null
+++ b/unit-tests/quoted-list.sh
@@ -0,0 +1,13 @@
+#!/bin/bash
+
+expected='(quote (123 (4 (5 nil)) Fred))'
+actual=`echo "'(123 (4 (5 ())) Fred)" | target/psse 2> /dev/null`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+    exit 0
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    exit 1
+fi
diff --git a/unit-tests/simple-list.sh b/unit-tests/simple-list.sh
index 9ea89a9..9ee9719 100644
--- a/unit-tests/simple-list.sh
+++ b/unit-tests/simple-list.sh
@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected="(1 2 3)"
-actual=`echo '(1 2 3 )' | target/psse 2> /dev/null`
+actual=`echo '(1 2 3)' | target/psse 2> /dev/null`
 
 if [ "${expected}" = "${actual}" ]
 then