Still grinding incrementally forward, through barbed wire entanglements.

Morale fading.

src/c/ops/eval_apply.c

@@ -246,7 +246,7 @@ struct pso_pointer eval_forms( struct pso_pointer frame_pointer ) {
         dec_ref( next_pointer );
     }
 
-    return c_reverse( result );
+    return c_reverse( frame_pointer, result );
 }
 
 /**
@@ -546,11 +546,10 @@ struct pso_pointer make_fn_frame(struct pso_pointer previous,
             args++;
 		}
 
-		new_frame->payload.stack_frame.more = inc_ref( c_reverse( more));
+		new_frame->payload.stack_frame.more = push_local( previous, c_reverse( previous, more));
 	}
 
 	new_frame->payload.stack_frame.args = args;
-	dec_ref(next_pointer);
 
 	return new_pointer;
 }
@@ -905,9 +904,11 @@ struct pso_pointer lisp_source( struct pso_pointer frame_pointer) {
                                 cell->payload.lambda.body ) );
             break;
         case NLAMBDATV:
-            result = make_cons( frame_pointer, c_string_to_lisp_symbol( frame_pointer, L"nλ" ),
+            result = make_cons( frame_pointer,
-                           make_cons( frame_pointer, cell->payload.lambda.args,
+                            c_string_to_lisp_symbol( frame_pointer, L"nλ" ),
-                                 cell->payload.lambda.body ) ) );
+                            make_cons( frame_pointer,
+                               cell->payload.lambda.args,
+                               cell->payload.lambda.body ) );
             break;
     }
     push_local( frame_pointer, result );
@@ -942,57 +943,53 @@ struct pso_pointer lisp_list( struct pso_pointer frame_pointer ) {
  * these bindings are bound.
  * This is `let*` in Common Lisp parlance; `let` in Clojure parlance.
  */
-struct pso_pointer lisp_let( struct pso4 *frame,
+struct pso_pointer lisp_let( struct pso_pointer frame_pointer ) {
-                             struct pso_pointer frame_pointer,
+    struct pso4* frame = pointer_to_pso4( frame_pointer);
-                             struct pso_pointer env ) {
+    struct pso_pointer bindings = fetch_env(frame_pointer);
-    struct pso_pointer bindings = env;
     struct pso_pointer result = nil;
 
     for ( struct pso_pointer cursor = fetch_arg( frame, 0);
-          tp( cursor ); cursor = c_cdr( cursor ) ) {
+          c_truep( cursor ); cursor = c_cdr( cursor ) ) {
         struct pso_pointer pair = c_car( cursor );
         struct pso_pointer symbol = c_car( pair );
 
+        struct pso_pointer next_pointer = push_local( frame_pointer, make_frame_with_env( 0, frame_pointer, bindings));
+
         if ( symbolp( symbol ) ) {
+            add_arg(next_pointer, c_cdr(pair));
             struct pso_pointer val =
-                eval_form( frame, frame_pointer, c_cdr( pair ),
+                eval_form( next_pointer );
-                           bindings );
 
-            debug_print_binding( symbol, val, false, DEBUG_BIND );
+            // debug_print_binding( symbol, val, false, DEBUG_BIND );
 
-            bindings = cons( cons( symbol, val ), bindings );
+            bindings = make_cons( frame_pointer, make_cons( frame_pointer, symbol, val ), bindings );
         } else {
             result =
-                throw_exception( c_string_to_lisp_symbol( L"let" ),
+                throw_exception( c_string_to_lisp_symbol( frame_pointer, L"let" ),
-                                 c_string_to_lisp_string
+                                 c_string_to_lisp_string( frame_pointer, L"Let: cannot bind, not a symbol" ),
-                                 ( L"Let: cannot bind, not a symbol" ),
                                  frame_pointer );
             break;
         }
     }
 
-    debug_print( L"\nlet: bindings complete.\n", DEBUG_BIND, 0 );
+    if (!exceptionp(result)) {
+        debug_print( L"\nlet: bindings complete.\n", DEBUG_BIND, 0 );
 
-    struct pso_pointer progn_pointer = make_frame_with_env( 0, frame_pointer, env);
+        struct pso_pointer progn_pointer = make_frame_with_env( 0, frame_pointer, bindings);
-    progn_frame = pointer_to_pso4(progn_pointer);
+        struct pso4* progn_frame = pointer_to_pso4(progn_pointer);
-    int a = 1;
-    for (; a < frame->payload.stack_frame.args && a < args_in_frame; a++) {
-        progn_frame->payload.stack_frame.arg[a-1] = fetch_arg( frame, a);
-        progn_frame->payload.stack_frame.args ++;
-    }
-    if ( a < frame->payload.stack_frame.args) {
-        progn_frame->payload.stack_frame.arg[a-1] = fetch_arg( frame, a);
-    }
 
-    /* i.e., no exception yet */
+        int a = 1;
-    for ( int form = 1;
+        for (; a < frame->payload.stack_frame.args && a < args_in_frame; a++) {
-          !exceptionp( result ) && form < frame->payload.stack_frame.args;
+            progn_frame->payload.stack_frame.arg[a-1] = fetch_arg( frame, a);
-          form++ ) {
+            progn_frame->payload.stack_frame.args ++;
-        result =
+        }
-            eval_form( frame, frame_pointer, fetch_arg( frame, form ),
+        if ( a < frame->payload.stack_frame.args) {
-                       bindings );
+            progn_frame->payload.stack_frame.arg[a-1] = fetch_arg( frame, a);
-    }
+            progn_frame->payload.stack_frame.more = c_cdr( frame->payload.stack_frame.more);
+        }
 
+        result = lisp_progn(progn_pointer);
+    }
     return result;
 
 }
@@ -1011,7 +1008,7 @@ struct pso_pointer lisp_and( struct pso4 *frame,
     bool accumulator = true;
     struct pso_pointer result = frame->payload.stack_frame.more;
 
-    for ( int a = 0; accumulator == t && a < frame->payload.stack_frame.args;
+    for ( int a = 0; accumulator == true && a < frame->payload.stack_frame.args;
           a++ ) {
         accumulator = truthy( fetch_arg( frame, a ) );
     }

src/c/ops/mapcar.c

@@ -30,7 +30,7 @@ struct pso_pointer lisp_mapcar( struct pso_pointer frame_pointer ) {
     for ( struct pso_pointer c = frame->payload.stack_frame.arg[1]; c_truep( c );
           c = c_cdr( c ) ) {
         struct pso_pointer expr =
-            cons( frame->payload.stack_frame.arg[0], cons( c_car( c ), nil ) );
+            cons( frame->payload.stack_frame.arg[0], make_cons( frame_pointer, c_car( c ), nil ) );
 
         debug_printf( DEBUG_EVAL, 0, U"Mapcar %d, evaluating ", i );
         debug_print_object( expr, DEBUG_EVAL, 0 );

src/c/ops/reverse.c

@@ -27,7 +27,11 @@
 #include "ops/string_ops.h"
 #include "ops/truth.h"
 
-
+/**
+ * @brief reverse a sequence
+ *
+ * (reverse sequence)
+ */
 struct pso_pointer reverse( struct pso_pointer frame_pointer ) {
     struct pso_pointer result = nil;
     struct pso_pointer sequence =

src/c/ops/reverse.h

@@ -16,6 +16,8 @@
 
 #include "memory/pointer.h"
 
-struct pso_pointer c_reverse( struct pso_pointer sequence );
+struct pso_pointer reverse( struct pso_pointer frame_pointer );
 
+struct pso_pointer c_reverse( struct pso_pointer frame_pointer,
+                              struct pso_pointer sequence );
 #endif

src/c/ops/string_ops.c

@@ -25,7 +25,9 @@
 
 #include "ops/truth.h"
 
+#include "payloads/cons.h"
 #include "payloads/exception.h"
+#include "payloads/keyword.h"
 #include "payloads/symbol.h"
 
 

src/c/ops/truth.h

@@ -28,4 +28,6 @@ struct pso_pointer or( struct pso_pointer frame_pointer );
 bool c_nilp( struct pso_pointer p );
 bool c_truep( struct pso_pointer p );
 
+#define truthy(p)(!c_nilp(p))
+
 #endif

src/c/payloads/cons.h

@@ -11,6 +11,7 @@
 #define __psse_payloads_cons_h
 #include <stdbool.h>
 
+#include "memory/node.h"
 #include "memory/pointer.h"
 #include "memory/pso2.h"
 #include "memory/pso4.h"

src/c/payloads/stack.c

@@ -24,6 +24,40 @@
 
 #include "ops/reverse.h"
 #include "ops/list_ops.h"
+#include "ops/stack_ops.h"
+
+/**
+ * @brief Add an argument to this (already initialised) stack frame, updating
+ * the args count.
+ *
+ * TODO: unit test this to death and back!
+ *
+ * @param frame_pointer a pointer to the frame to be modified.
+ * @param arg_pointer the pointer to the arg to be added.
+ *
+ * @return `nil` on success; potentially an exception on failure.
+ */
+struct pso_pointer add_arg( struct pso_pointer frame_pointer, struct pso_pointer arg_pointer) {
+    struct pso4* frame = pointer_to_pso4( frame_pointer);
+    struct pso_pointer result = nil;
+
+    if (frame->payload.stack_frame.args < args_in_frame) {
+        frame->payload.stack_frame.arg[frame->payload.stack_frame.args++] = push_local(frame_pointer, arg_pointer);
+    } else {
+        struct pso_pointer new_more = c_reverse( frame_pointer,
+            make_cons( frame_pointer,
+                arg_pointer,
+                c_reverse( frame_pointer, frame->payload.stack_frame.more)));
+        if (exceptionp(new_more)) {
+            result = new_more;
+        } else {
+            frame->payload.stack_frame.more =
+                push_local( frame_pointer, new_more);
+        }
+    }
+
+    return result;
+}
 
 /**
  * @brief Construct a stack frame with this `previous` pointer, and arguments
@@ -42,6 +76,9 @@ struct pso_pointer make_frame( int arg_count, struct pso_pointer previous,
     va_list args;
     va_start( args, previous );
 
+    /* NOTE! It is really important not to `push_local` the new_pointer here,
+     * since that would stop stack frames and all the temporary objects they
+     * curate ever being garbage collected! */
     struct pso_pointer new_pointer = allocate( previous, STACKTAG, 4 );
     struct pso4 *new_frame = pointer_to_pso4( new_pointer );
 
@@ -85,7 +122,7 @@ struct pso_pointer make_frame( int arg_count, struct pso_pointer previous,
                            more_args );
         }
 
-        new_frame->payload.stack_frame.more = c_reverse( more_args );
+        new_frame->payload.stack_frame.more = c_reverse( previous, more_args );
     } else {
         for ( ; cursor < args_in_frame; cursor++ ) {
             new_frame->payload.stack_frame.arg[cursor] = nil;
@@ -104,6 +141,9 @@ struct pso_pointer make_frame( int arg_count, struct pso_pointer previous,
  * be called by functions like `binding` which add bindings to their upstack
  * environment.
  *
+ * TODO: someone who really understood how C varargs functions work could save
+ * a lot of potentially error prone code by having this call `make_frame`, q.v.
+ *
  * @param arg_count the count of arguments to the Lisp function.
  * @param previous the parent stack frame.
  * @param env the modified environment
@@ -119,6 +159,9 @@ struct pso_pointer make_frame_with_env( int arg_count,
     va_start( args, env );
 
     struct pso4 *prev_frame = pointer_to_pso4( previous );
+    /* NOTE! It is really important not to `push_local` the new_pointer here,
+     * since that would stop stack frames and all the temporary objects they
+     * curate ever being garbage collected! */
     struct pso_pointer new_pointer = allocate( previous, STACKTAG, 4 );
     struct pso4 *new_frame = pointer_to_pso4( new_pointer );
 
@@ -159,7 +202,7 @@ struct pso_pointer make_frame_with_env( int arg_count,
                            more_args );
         }
 
-        new_frame->payload.stack_frame.more = c_reverse( more_args );
+        new_frame->payload.stack_frame.more = c_reverse( previous, more_args );
     } else {
         for ( ; cursor < args_in_frame; cursor++ ) {
             new_frame->payload.stack_frame.arg[cursor] = nil;
@@ -189,6 +232,9 @@ struct pso_pointer make_frame_with_arglist_and_env( struct pso_pointer
                                                     argvalues,
                                                     struct pso_pointer env ) {
     struct pso4 *prev_frame = pointer_to_pso4( previous );
+    /* NOTE! It is really important not to `push_local` the new_pointer here,
+     * since that would stop stack frames and all the temporary objects they
+     * curate ever being garbage collected! */
     struct pso_pointer new_pointer = allocate( previous, STACKTAG, 4 );
     struct pso4 *new_frame = pointer_to_pso4( new_pointer );
     struct pso_pointer arg_length =

src/c/payloads/stack.h

@@ -60,4 +60,6 @@ struct pso_pointer make_frame_with_arglist( struct pso_pointer previous,
 struct pso_pointer destroy_stack_frame( struct pso_pointer fp,
                                         struct pso_pointer env );
 
+struct pso_pointer add_arg( struct pso_pointer frame_pointer, struct pso_pointer arg_pointer);
+
 #endif