This isn't working, but I think it's progress.

include/licence-header.txt

@@ -0,0 +1,2 @@
+(c) 2017 Simon Brooke <simon@journeyman.cc>
+Licensed under GPL version 2.0, or, at your option, any later version.

src/consspaceobject.c

@@ -19,6 +19,7 @@
 
 #include "conspage.h"
 #include "consspaceobject.h"
+#include "print.h"
 
 /**
  * Check that the tag on the cell at this pointer is this tag
@@ -73,28 +74,47 @@ void dump_object( FILE * output, struct cons_pointer pointer ) {
               cell.tag.bytes[3],
               cell.tag.value, pointer.page, pointer.offset, cell.count );
 
-    if ( check_tag( pointer, CONSTAG ) ) {
+    switch ( cell.tag.value) {
+    case CONSTV:
         fwprintf( output,
                   L"\t\tCons cell: car at page %d offset %d, cdr at page %d offset %d\n",
                   cell.payload.cons.car.page,
                   cell.payload.cons.car.offset,
                   cell.payload.cons.cdr.page, cell.payload.cons.cdr.offset );
-    } else if ( check_tag( pointer, INTEGERTAG ) ) {
+        break;
+    case INTEGERTV:
         fwprintf( output,
                   L"\t\tInteger cell: value %ld\n",
                   cell.payload.integer.value );
-    } else if ( check_tag( pointer, FREETAG ) ) {
+        break;
+    case FREETV:
         fwprintf( output, L"\t\tFree cell: next at page %d offset %d\n",
                   cell.payload.cons.cdr.page, cell.payload.cons.cdr.offset );
-    } else if ( check_tag( pointer, REALTAG ) ) {
+        break;
+    case REALTV:
         fwprintf( output, L"\t\tReal cell: value %Lf\n",
                   cell.payload.real.value );
-    } else if ( check_tag( pointer, STRINGTAG ) ) {
+        break;
+    case STRINGTV:
         fwprintf( output,
                   L"\t\tString cell: character '%1c' (%1d) next at page %2d offset %3d\n",
                   cell.payload.string.character,
                   cell.payload.string.cdr.page,
                   cell.payload.string.cdr.offset );
+        fwprintf( output, L"\t\t value:");
+        print(output, pointer);
+        fwprintf( output, L"\n");
+        break;
+    case SYMBOLTV:
+        fwprintf( output,
+                  L"\t\tSymbol cell: character '%1c' (%1d) next at page %2d offset %3d\n",
+                  cell.payload.string.character,
+                  cell.payload.string.cdr.page,
+                  cell.payload.string.cdr.offset );
+        fwprintf( output, L"\t\t value:");
+        print(output, pointer);
+        fwprintf( output, L"\n");
+        break;
     }
 }
 
@@ -150,7 +170,7 @@ make_string_like_thing( wint_t c, struct cons_pointer tail, char *tag ) {
         inc_ref( tail );
         cell->payload.string.character = c;
         cell->payload.string.cdr.page = tail.page;
-	/* TODO: There's a problem here. Sometimes the offsets on
+        /* TODO: There's a problem here. Sometimes the offsets on
          * strings are quite massively off. */
         cell->payload.string.cdr.offset = tail.offset;
     } else {

src/consspaceobject.h

@@ -156,7 +156,7 @@
 #define stringp(conspoint) (check_tag(conspoint,STRINGTAG))
 
 /**
- * true if conspointer points to a string cell, else false 
+ * true if conspointer points to a symbol cell, else false 
  */
 #define symbolp(conspoint) (check_tag(conspoint,SYMBOLTAG))
 

src/equal.c

@@ -22,6 +22,21 @@ bool eq( struct cons_pointer a, struct cons_pointer b ) {
     return ( ( a.page == b.page ) && ( a.offset == b.offset ) );
 }
 
+/**
+ * True if the objects at these two cons pointers have the same tag, else false.
+ * @param a a pointer to a cons-space object;
+ * @param b another pointer to a cons-space object.
+ * @return true if the objects at these two cons pointers have the same tag, 
+ * else false.
+ */
+bool same_type( struct cons_pointer a, struct cons_pointer b ) {
+    struct cons_space_object *cell_a = &pointer2cell( a );
+    struct cons_space_object *cell_b = &pointer2cell( b );
+
+    return cell_a->tag.value == cell_b->tag.value;
+
+}
+
 /**
  * Deep, and thus expensive, equality: true if these two objects have
  * identical structure, else false.
@@ -29,15 +44,18 @@ bool eq( struct cons_pointer a, struct cons_pointer b ) {
 bool equal( struct cons_pointer a, struct cons_pointer b ) {
     bool result = eq( a, b );
 
-    if ( !result ) {
+    if ( !result && same_type( a, b ) ) {
         struct cons_space_object *cell_a = &pointer2cell( a );
         struct cons_space_object *cell_b = &pointer2cell( b );
 
-        if ( consp( a ) && consp( b ) ) {
+        switch ( cell_a->tag.value ) {
+        case CONSTV:
             result =
                 equal( cell_a->payload.cons.car, cell_b->payload.cons.car )
                 && equal( cell_a->payload.cons.cdr, cell_b->payload.cons.cdr );
-        } else if ( stringp( a ) && stringp( b ) ) {
+            break;
+        case STRINGTV:
+        case SYMBOLTV:
             /*
              * slightly complex because a string may or may not have a '\0'
              * cell at the end, but I'll ignore that for now. I think in
@@ -48,17 +66,27 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
                 cell_b->payload.string.character
                 && equal( cell_a->payload.string.cdr,
                           cell_b->payload.string.cdr );
-        } else if ( numberp( a ) && numberp( b ) ) {
+            break;
-            double num_a = numeric_value( a );
+        case INTEGERTV:
-            double num_b = numeric_value( b );
+        case REALTV:
-            double max =
+            {
-                fabs( num_a ) > fabs( num_b ) ? fabs( num_a ) : fabs( num_b );
+                double num_a = numeric_value( a );
+                double num_b = numeric_value( b );
+                double max =
+                    fabs( num_a ) >
+                    fabs( num_b ) ? fabs( num_a ) : fabs( num_b );
 
-            /*
+                /*
-             * not more different than one part in a million - close enough 
+                 * not more different than one part in a million - close enough 
-             */
+                 */
-            result = fabs( num_a - num_b ) < ( max / 1000000.0 );
+                result = fabs( num_a - num_b ) < ( max / 1000000.0 );
+            }
+            break;
+        default:
+            result = false;
+            break;
         }
+
         /*
          * there's only supposed ever to be one T and one NIL cell, so each
          * should be caught by eq; equality of vector-space objects is a whole 

src/init.c

@@ -54,14 +54,14 @@ int main( int argc, char *argv[] ) {
             show_prompt = true;
             break;
         default:
-            fprintf( stderr, "Unexpected option %c\n", option );
+            fwprintf( stderr, L"Unexpected option %c\n", option );
             break;
         }
     }
 
     if ( show_prompt ) {
-        fprintf( stdout,
+        fwprintf( stdout,
-                 "Post scarcity software environment version %s\n\n",
+                 L"Post scarcity software environment version %s\n\n",
                  VERSION );
     }
 
@@ -70,12 +70,17 @@ int main( int argc, char *argv[] ) {
     /*
      * 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 );
+     */
+    struct cons_pointer lisp_symbol = c_string_to_lisp_symbol( "oblist");
+    deep_bind( lisp_symbol, &oblist);
 
     /*
      * primitive function operations 
      */
+    /*
     bind_function( "assoc", &lisp_assoc );
     bind_function( "car", &lisp_car );
     bind_function( "cdr", &lisp_cdr );
@@ -84,14 +89,20 @@ int main( int argc, char *argv[] ) {
     bind_function( "equal", &lisp_equal );
     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 );
-
+    */
+    if ( show_prompt) {
+        fwprintf( stderr, L"Oblist: ");
+        print(stderr, *oblist);
+    }
+    
     repl( stdin, stdout, stderr, show_prompt );
 
     if ( dump_at_end ) {

src/integer.c

@@ -41,7 +41,7 @@ struct cons_pointer make_integer( long int value ) {
     struct cons_space_object *cell = &pointer2cell( result );
     cell->payload.integer.value = value;
 
-    dump_object( stderr, result);
+    dump_object( stderr, result );
 
     return result;
 }

src/intern.c

@@ -32,7 +32,7 @@
  * 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;
+struct cons_pointer oblist = & NIL;
 
 /**
  * Implementation of interned? in C. The final implementation if interned? will
@@ -91,7 +91,7 @@ struct cons_pointer c_assoc( struct cons_pointer key,
  * 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
+struct cons_pointer 
 bind( struct cons_pointer key, struct cons_pointer value,
       struct cons_pointer store ) {
     return make_cons( make_cons( key, value ), store );
@@ -104,7 +104,7 @@ bind( struct cons_pointer key, struct cons_pointer value,
  */
 struct cons_pointer
 deep_bind( struct cons_pointer key, struct cons_pointer value ) {
-    oblist = bind( key, value, oblist );
+    oblist = &bind( key, value, *oblist );
     return oblist;
 }
 

src/intern.h

@@ -20,7 +20,7 @@
 #ifndef __intern_h
 #define __intern_h
 
-extern struct cons_pointer oblist;
+extern struct cons_pointer * oblist;
 
 /**
  * return the value associated with this key in this store. In the current 

src/lispops.c

@@ -104,8 +104,7 @@ eval_cons( struct cons_pointer s_expr, struct cons_pointer env,
         {
             struct cons_space_object special = pointer2cell( fn_pointer );
             result =
-                ( *special.payload.special.executable ) ( args, env,
+                ( *special.payload.special.executable ) ( args, env, my_frame );
-                                                          my_frame );
         }
         break;
 
@@ -164,15 +163,15 @@ lisp_eval( struct cons_pointer s_expr, struct cons_pointer env,
     struct cons_pointer result = s_expr;
     struct cons_space_object cell = pointer2cell( s_expr );
 
-    fprintf( stderr, "In eval; about to make stack frame" );
-
-    struct stack_frame *frame = make_stack_frame( previous, s_expr, env );
-
-    fprintf( stderr, "In eval; stack frame made" );
-
     switch ( cell.tag.value ) {
     case CONSTV:
+        fwprintf( stderr, L"In eval; about to make stack frame" );
+        struct stack_frame *frame = make_stack_frame( previous, s_expr, env );
+        fwprintf( stderr, L"In eval; stack frame made" );
+
         result = eval_cons( s_expr, env, frame );
+
+        free_stack_frame( frame );
         break;
 
     case SYMBOLTV:
@@ -197,8 +196,6 @@ lisp_eval( struct cons_pointer s_expr, struct cons_pointer env,
          */
     }
 
-    free_stack_frame( frame );
-
     return result;
 }
 
@@ -212,7 +209,7 @@ lisp_eval( struct cons_pointer s_expr, struct cons_pointer env,
 struct cons_pointer
 lisp_quote( struct cons_pointer args, struct cons_pointer env,
             struct stack_frame *frame ) {
-    return c_car( args );
+    return frame->arg[0];
 }
 
 /**
@@ -360,10 +357,10 @@ lisp_print( struct stack_frame *frame, struct cons_pointer env ) {
  */
 struct cons_pointer
 lisp_throw( struct cons_pointer message, struct stack_frame *frame ) {
-    fprintf( stderr, "\nERROR: " );
+    fwprintf( stderr, L"\nERROR: " );
     print( stderr, message );
-    fprintf( stderr,
+    fwprintf( stderr,
-             "\n\nAn exception was thrown and I've no idea what to do now\n" );
+             L"\n\nAn exception was thrown and I've no idea what to do now\n" );
 
     exit( 1 );
 }

src/peano.c

@@ -0,0 +1,35 @@
+/**
+ * peano.c
+ *
+ * Basic peano arithmetic
+ *
+ * (c) 2017 Simon Brooke <simon@journeyman.cc>
+ * Licensed under GPL version 2.0, or, at your option, any later version.
+ */
+
+#include <ctype.h>
+#include <stdbool.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "consspaceobject.h"
+#include "conspage.h"
+#include "equal.h"
+#include "integer.h"
+#include "intern.h"
+#include "lispops.h"
+#include "print.h"
+#include "read.h"
+#include "stack.h"
+
+/*
+struct cons_pointer
+lisp_plus( struct cons_pointer s_expr, struct cons_pointer env,
+           struct stack_frame *frame ) {
+    struct cons_space_object cell = pointer2cell( s_expr );
+    struct cons_space_object result = NIL;
+    
+    
+}
+*/

src/print.c

@@ -100,6 +100,12 @@ void print( FILE * output, struct cons_pointer pointer ) {
     case TRUETV:
         fwprintf( output, L"t" );
         break;
+    case FUNCTIONTV:
+        fwprintf( output, L"(Function)");
+        break;
+    case SPECIALTV:
+        fwprintf( output, L"(Special form)");
+        break;
     default:
         fwprintf( stderr,
                   L"Error: Unrecognised tag value %d (%c%c%c%c)\n",

src/read.c

@@ -96,7 +96,8 @@ struct cons_pointer read_number( FILE * input, wint_t initial ) {
         } else {
             accumulator = accumulator * 10 + ( ( int ) c - ( int ) '0' );
 
-            fprintf( stderr, "Added character %c, accumulator now %ld\n", c, accumulator);
+            fprintf( stderr, "Added character %c, accumulator now %ld\n", c,
+                     accumulator );
 
             if ( seen_period ) {
                 places_of_decimals++;

src/repl.c

@@ -35,13 +35,13 @@ repl( FILE * in_stream, FILE * out_stream, FILE * error_stream,
             fwprintf( out_stream, L"\n-> " );
         }
 
-	/* OK, I think what's going wrong here is we're passing by 
+        /* OK, I think what's going wrong here is we're passing by 
-	 * value and I think we should be passing by reference.
+         * value and I think we should be passing by reference.
          * I'm not certain about that, and as it will be a really
          * major change I'm going to think some more before making
-	 * in */
+         * in */
-        // print( out_stream, lisp_eval(input, oblist, NULL));
+        print( out_stream, lisp_eval( input, oblist, NULL ) );
-        print( out_stream, input );
+        // print( out_stream, input );
         fwprintf( out_stream, L"\n" );
         fwprintf( error_stream, L"\neval {%d,%d}=> ", input.page,
                   input.offset );