Merge branch 'develop' of github.com:simon-brooke/post-scarcity into develop

.gitignore

@@ -16,3 +16,5 @@ src/\.#*
 \.idea/
 
 post-scarcity\.iml
+
+doc/

Makefile

@@ -3,9 +3,12 @@ TARGET ?= target/psse
 SRC_DIRS ?= ./src
 
 SRCS := $(shell find $(SRC_DIRS) -name *.cpp -or -name *.c -or -name *.s)
+HDRS := $(shell find $(SRC_DIRS) -name *.h)
 OBJS := $(addsuffix .o,$(basename $(SRCS)))
 DEPS := $(OBJS:.o=.d)
 
+TESTS := $(shell find unit-tests -name *.sh)
+
 INC_DIRS := $(shell find $(SRC_DIRS) -type d)
 INC_FLAGS := $(addprefix -I,$(INC_DIRS))
 INDENT_FLAGS := -kr -br -brf -brs -ce -cdw -npsl -nut -prs -l79 -ts2
@@ -18,10 +21,13 @@ LDFLAGS := -lm
 $(TARGET): $(OBJS) Makefile
 	$(CC) $(LDFLAGS) $(OBJS) -DVERSION=$(VERSION) -o $@ $(LDFLAGS) $(LOADLIBES) $(LDLIBS)
 
-format:
+doc: $(SRCS) Makefile
-	indent $(INDENT_FLAGS) $(SRCS) src/*.h
+	doxygen
 
-test:
+format: $(SRCS) $(HDRS) Makefile
+	indent $(INDENT_FLAGS) $(SRCS) $(HDRS)
+
+test: $(OBJS) $(TESTS) Makefile
 	bash ./unit-tests.sh
 
 .PHONY: clean

src/conspage.c

@@ -1,4 +1,4 @@
-/**
+/*
  * conspage.c
  *
  * Setup and tear down cons pages, and (FOR NOW) do primitive 

src/consspaceobject.c

@@ -1,4 +1,4 @@
-/**
+/*
  *  consspaceobject.c
  *
  *  Structures common to all cons space objects.

src/equal.c

@@ -1,4 +1,4 @@
-/**
+/*
  * equal.c
  *
  * Checks for shallow and deep equality
@@ -38,13 +38,13 @@ bool same_type( struct cons_pointer a, struct cons_pointer b ) {
 }
 
 /**
- * Some string will be null terminated and some will be NIL terminated... ooops!
+ * Some strings will be null terminated and some will be NIL terminated... ooops!
  * @param string the string to test
  * @return true if it's the end of a string.
  */
-bool end_of_string( struct cons_pointer string) {
+bool end_of_string( struct cons_pointer string ) {
-    return nilp( string) ||
+    return nilp( string ) ||
-            pointer2cell(string).payload.string.character == '\0';
+        pointer2cell( string ).payload.string.character == '\0';
 }
 
 /**
@@ -74,10 +74,10 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
             result =
                 cell_a->payload.string.character ==
                 cell_b->payload.string.character
-                && (equal( cell_a->payload.string.cdr,
+                && ( equal( cell_a->payload.string.cdr,
-                          cell_b->payload.string.cdr ) 
+                            cell_b->payload.string.cdr )
-                    || ( end_of_string(cell_a->payload.string.cdr)
+                     || ( end_of_string( cell_a->payload.string.cdr )
-                    && end_of_string(cell_b->payload.string.cdr)));
+                          && end_of_string( cell_b->payload.string.cdr ) ) );
             break;
         case INTEGERTV:
         case REALTV:
@@ -102,7 +102,7 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
         /*
          * 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 
-         * other ball game so we won't deal with it now (and indeedmay never). 
+         * other ball game so we won't deal with it now (and indeed may never). 
          * I'm not certain what equality means for read and write streams, so
          * I'll ignore them, too, for now.
          */

src/init.c

@@ -1,4 +1,4 @@
-/**
+/*
  * init.c
  *
  * Start up and initialise the environement - just enough to get working

src/integer.c

@@ -1,4 +1,4 @@
-/**
+/*
  * integer.c
  *
  * functions for integer cells.

src/intern.c

@@ -1,4 +1,4 @@
-/**
+/*
  * intern.c
  *
  * For now this implements an oblist and shallow binding; local environments can
@@ -49,29 +49,29 @@ struct cons_pointer
 internedp( struct cons_pointer key, struct cons_pointer store ) {
     struct cons_pointer result = NIL;
 
-    if (symbolp(key)) {
+    if ( symbolp( key ) ) {
         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 );
 
-            fputws( L"Internedp: checking whether `", stderr);
+            fputws( L"Internedp: checking whether `", stderr );
-            print(stderr, key);
+            print( stderr, key );
-            fputws( L"` equals `", stderr);
+            fputws( L"` equals `", stderr );
-            print( stderr, entry.payload.cons.car);
+            print( stderr, entry.payload.cons.car );
-            fputws( L"`\n", stderr);
+            fputws( L"`\n", stderr );
 
             if ( equal( key, entry.payload.cons.car ) ) {
                 result = entry.payload.cons.car;
             }
         }
     } else {
-        fputws(L"`", stderr);
+        fputws( L"`", stderr );
         print( stderr, key );
-        fputws( L"` is a ", stderr);
+        fputws( L"` is a ", stderr );
-        print( stderr, c_type( key));
+        print( stderr, c_type( key ) );
-        fputws( L", not a SYMB", stderr);
+        fputws( L", not a SYMB", stderr );
     }
 
     return result;

src/lispops.c

@@ -1,4 +1,4 @@
-/**
+/*
  * lispops.c
  *
  * List processing operations.
@@ -81,17 +81,19 @@ struct cons_pointer c_cdr( struct cons_pointer arg ) {
  * @param env the evaluation environment.
  * @return the result of evaluating the form.
  */
-struct cons_pointer eval_form( struct stack_frame *parent, struct cons_pointer form, struct cons_pointer env) {
+struct cons_pointer eval_form( struct stack_frame *parent,
-    fputws(L"eval_form: ", stderr);
+                               struct cons_pointer form,
-    print( stderr, form);
+                               struct cons_pointer env ) {
-    fputws(L"\n", stderr);
+    fputws( L"eval_form: ", stderr );
+    print( stderr, form );
+    fputws( L"\n", stderr );
 
     struct cons_pointer result = NIL;
-    struct stack_frame * next = make_empty_frame(parent, env);
+    struct stack_frame *next = make_empty_frame( parent, env );
     next->arg[0] = form;
     inc_ref( next->arg[0] );
-    result = lisp_eval(next, env);        
+    result = lisp_eval( next, env );
-    free_stack_frame( next);
+    free_stack_frame( next );
 
     return result;
 }
@@ -161,8 +163,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) {
  * @param pointer a pointer to the object whose type is requested.
  * @return As a Lisp string, the tag of the object which is at that pointer.
  */
-struct cons_pointer
+struct cons_pointer c_type( struct cons_pointer pointer ) {
-c_type( struct cons_pointer pointer) {
     char *buffer = malloc( TAGLENGTH + 1 );
     memset( buffer, 0, TAGLENGTH + 1 );
     struct cons_space_object cell = pointer2cell( pointer );
@@ -199,6 +200,17 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer env ) {
     switch ( cell.tag.value ) {
     case CONSTV:
         result = c_apply( frame, env );
+        /* I have a profound misunderstanding of how quote and eval should interact!  
+         * if ( equal( c_car(frame->arg[0]), c_string_to_lisp_symbol("quote"))) 
+         *   /\* car is QUOTE. TODO: It is ABSURDLY expensive to 'equal' each time! *\/ 
+         *        { 
+         *   /\* we need to eval it again *\/ 
+         *   frame->arg[0] = result; 
+         *   fputws( L"quote - re-evaling", stderr); 
+         *   dump_frame( stderr, frame ); 
+         *   result = c_apply(frame, env); 
+         *        } */
+
         break;
 
     case SYMBOLTV:
@@ -436,9 +448,9 @@ lisp_progn( struct stack_frame *frame, struct cons_pointer env ) {
     struct cons_pointer remaining = frame->arg[0];
     struct cons_pointer result = NIL;
 
-    while ( consp(remaining)) {
+    while ( consp( remaining ) ) {
         struct cons_space_object cell = pointer2cell( remaining );
-        result = eval_form(frame, cell.payload.cons.car, env);
+        result = eval_form( frame, cell.payload.cons.car, env );
 
         remaining = cell.payload.cons.cdr;
     }
@@ -460,27 +472,26 @@ lisp_cond( struct stack_frame *frame, struct cons_pointer env ) {
     struct cons_pointer result = NIL;
     bool done = false;
 
-    for (int i = 0; i < args_in_frame && !done; i++) {
+    for ( int i = 0; i < args_in_frame && !done; i++ ) {
         struct cons_pointer clause_pointer = frame->arg[i];
-        fputws(L"Cond clause: ", stderr);
+        fputws( L"Cond clause: ", stderr );
-        print( stderr, clause_pointer);
+        print( stderr, clause_pointer );
 
-        if (consp(clause_pointer)) {
+        if ( consp( clause_pointer ) ) {
             struct cons_space_object cell = pointer2cell( clause_pointer );
 
-            if (!nilp( eval_form(frame, cell.payload.cons.car, env))) {
+            if ( !nilp( eval_form( frame, cell.payload.cons.car, env ) ) ) {
-                struct stack_frame * next = make_empty_frame(frame, env);
+                struct stack_frame *next = make_empty_frame( frame, env );
                 next->arg[0] = cell.payload.cons.cdr;
-                inc_ref(next->arg[0]);
+                inc_ref( next->arg[0] );
-                result = lisp_progn( next, env);
+                result = lisp_progn( next, env );
                 done = true;
             }
-        } else if (nilp(clause_pointer)) {
+        } else if ( nilp( clause_pointer ) ) {
             done = true;
         } else {
-            lisp_throw( 
+            lisp_throw( c_string_to_lisp_string
-                    c_string_to_lisp_string( "Arguments to `cond` must be lists"), 
+                        ( "Arguments to `cond` must be lists" ), frame );
-                       frame);
         }
     }
     /* TODO: if there are more than 8 clauses we need to continue into the

src/lispops.h

@@ -28,8 +28,7 @@
  * @param pointer a pointer to the object whose type is requested.
  * @return As a Lisp string, the tag of the object which is at that pointer.
  */
-struct cons_pointer
+struct cons_pointer c_type( struct cons_pointer pointer );
-c_type( struct cons_pointer pointer);
 
 /*
  * special forms 

src/peano.c

@@ -1,4 +1,4 @@
-/**
+/*
  * peano.c
  *
  * Basic peano arithmetic

src/print.c

@@ -1,9 +1,8 @@
-/**
+/*
  * print.c
  *
  * First pass at a printer, for bootstrapping.
  *
- *
  * (c) 2017 Simon Brooke <simon@journeyman.cc>
  * Licensed under GPL version 2.0, or, at your option, any later version.
  */

src/read.c

@@ -1,4 +1,4 @@
-/**
+/*
  * read.c
  *
  * First pass at a reader, for bootstrapping.

src/real.c

@@ -1,7 +1,10 @@
 /*
- * To change this license header, choose License Headers in Project Properties.
+ * real.c
- * To change this template file, choose Tools | Templates
+ *
- * and open the template in the editor.
+ * functions for real number cells.
+ *
+ * (c) 2017 Simon Brooke <simon@journeyman.cc>
+ * Licensed under GPL version 2.0, or, at your option, any later version.
  */
 
 #include "conspage.h"

src/repl.c

@@ -1,8 +1,12 @@
 /*
- * To change this license header, choose License Headers in Project Properties.
+ * repl.c
- * To change this template file, choose Tools | Templates
+ *
- * and open the template in the editor.
+ * the read/eval/print loop
+ *
+ * (c) 2017 Simon Brooke <simon@journeyman.cc>
+ * Licensed under GPL version 2.0, or, at your option, any later version.
  */
+
 #include <stdbool.h>
 #include <stdio.h>
 #include <wchar.h>

src/stack.c

@@ -1,4 +1,4 @@
-/**
+/*
  * stack.c
  *
  * The Lisp evaluation stack.
@@ -153,7 +153,12 @@ void free_stack_frame( struct stack_frame *frame ) {
 void dump_frame( FILE * output, struct stack_frame *frame ) {
     fputws( L"Dumping stack frame\n", output );
     for ( int arg = 0; arg < args_in_frame; arg++ ) {
-        fwprintf( output, L"Arg %d:", arg );
+        struct cons_space_object cell = pointer2cell( frame->arg[arg] );
+
+        fwprintf( output, L"Arg %d:\t%c%c%c%c\t", arg,
+                  cell.tag.bytes[0],
+                  cell.tag.bytes[1], cell.tag.bytes[2], cell.tag.bytes[3] );
+
         print( output, frame->arg[arg] );
         fputws( L"\n", output );
     }