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

@@ -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;
+}

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,7 +239,34 @@ 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 */
@@ -163,6 +274,20 @@ struct string_payload {
   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

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

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

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);
+/* special forms */
-struct cons_pointer lisp_cons( struct cons_pointer args, struct cons_pointer env);
+struct cons_pointer lisp_eval( struct cons_pointer args, struct cons_pointer env,
-struct cons_pointer lisp_car( struct cons_pointer args, struct cons_pointer env);
+			       struct stack_frame* frame);
-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_apply( struct cons_pointer args, struct cons_pointer env);
+				struct stack_frame* frame);
-struct cons_pointer lisp_throw( struct cons_pointer args, struct cons_pointer env);
+/*
+ * 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
+ * Implementation of car in C. If arg is not a cons, does not error but returns nil.
- * args), but it helps bootstrapping.
  */
-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)) {
+  if ( consp(arg)) {
-    result = make_cons( lisp_eval( lisp_car( args, env), env),
+    result = pointer2cell( arg).payload.cons.car;
-			i_eval_args( lisp_cdr( args, env), tail, env));
+  }
+
+  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
+ * I'm now confused about whether at this stage I actually need an apply special form,
- * object in read.
+ * 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 lisp_eval( struct cons_pointer s_expr, struct cons_pointer env,
-  struct cons_pointer result = args;
+			       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);
+    struct cons_pointer fn_pointer = lisp_eval( c_car( s_expr), env, my_frame);
-    args = lisp_cdr( args, env);
+    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);
+      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;
+}
+
+/**
+ * (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 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 ( 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 {
+    result = make_cons( car, cdr);
+  }
+
   return result;
 }
 
 /**
- * Apply cons to this argsument list. Effectively, create a cons cell comprising
+ * (car s_expr)
- * (car args) (cadr args).
+ * 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_cons( 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)) {
+  if ( consp( frame->arg[ 0])) {
-    struct cons_space_object cell = pointer2cell( args);
+    struct cons_space_object cell = pointer2cell( frame->arg[ 0]);
-    struct cons_pointer a = cell.payload.cons.car;
+    result = cell.payload.cons.car;
-    struct cons_pointer d = pointer2cell( cell.payload.cons.cdr).payload.cons.car;
+  } else if ( stringp( frame->arg[ 0])) {
-    result = make_cons( a, d);
+    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;
-}
-
-/**
- * Apply car to this argsument list. Effectively, (car (car args))
- */
-struct cons_pointer lisp_car( struct cons_pointer args, 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;
-  } else {
-    lisp_throw( args, env);
   }
 
   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)) {
+  if ( consp( frame->arg[ 0])) {
-    struct cons_space_object cell = pointer2cell( args);
+    struct cons_space_object cell = pointer2cell( frame->arg[ 0]);
-    result =  pointer2cell( cell.payload.cons.cdr).payload.cons.car;
+    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) {
+struct cons_pointer lisp_throw( struct cons_pointer message, struct stack_frame* frame) {
-  fprintf( stderr, "An exception was thrown and I've no idea what to do now\n");
+  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);
 }
 

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);
+

src/read.c

@@ -145,10 +145,6 @@ struct cons_pointer read( FILE* input) {
 }
 
     
-struct cons_pointer lisp_read( struct cons_pointer args, struct cons_pointer env) {
-  return( read( stdin));
-}
-    
 
 
     

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++) {
+  for ( int i = 0; i < args_in_frame; i++) {
-    result->local[i] = NIL;
+    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) {
+  if ( index < args_in_frame) {
-    result = frame->local[ index];
+    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;
     }
 

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 */
+struct stack_frame* make_stack_frame( struct stack_frame* previous,
-#define locals_in_frame 8
+				      struct cons_pointer args,
-
+				      struct cons_pointer env);
-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 cons_pointer fetch_arg( struct stack_frame* frame, unsigned int n);
 
-struct stack_frame {
+/* struct stack_frame is defined in consspaceobject.h to break circularity
-  struct stack_frame* previous;         /* the previous frame */
+ * TODO: refactor. */
-  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