More code, closer to working, still builds.

src/c/environment/environment.c

@@ -9,8 +9,19 @@
 
 #include <stdbool.h>
 
+#include "memory/memory.h"
 #include "memory/node.h"
 #include "memory/pointer.h"
+#include "memory/pso.h"
+#include "memory/pso2.h"
+#include "memory/tags.h"
+
+#include "ops/bind.h"
+#include "ops/string_ops.h"
+
+#include "payloads/cons.h"
+#include "payloads/exception.h"
+#include "payloads/psse_string.h"
 
 /**
  * @brief Flag to prevent re-initialisation.
@@ -25,11 +36,45 @@ bool environment_initialised = false;
  */
 
 struct pso_pointer initialise_environment( uint32_t node ) {
-    struct pso_pointer result = t;
+    struct pso_pointer result = initialise_memory( node );
-    if ( environment_initialised ) {
+
-        // TODO: throw an exception "Attempt to reinitialise environment"
+    if ( !exceptionp( result ) ) {
+        struct pso_pointer n = allocate( NILTAG, 2 );
+
+        if ( ( n.page == 0 ) && ( n.offset == 0 ) ) {
+            struct pso2 *object = pointer_to_object( n );
+            object->payload.cons.car = nil;
+            object->payload.cons.cdr = nil;
+
+            nil = n;
         } else {
-        // TODO: actually initialise it.
+            result =
+                make_exception( c_string_to_lisp_string
+                                ( L"Unexpected cell while allocating `nil`." ),
+                                nil, n );
+        }
+    }
+    if ( !exceptionp( result ) ) {
+        struct pso_pointer n = allocate( TRUETAG, 2 );
+
+        if ( ( n.page == 0 ) && ( n.offset == 1 ) ) {
+            struct pso2 *object = pointer_to_object( n );
+            object->payload.string.character = L't';
+            object->payload.cons.cdr = t;
+
+            t = n;
+        } else {
+            result =
+                make_exception( c_string_to_lisp_string
+                                ( L"Unexpected cell while allocating `t`." ),
+                                nil, n );
+        }
+    }
+    if ( !exceptionp( result ) ) {
+        result = c_bind( c_string_to_lisp_symbol( L"nil" ), nil, nil );
+        result = c_bind( c_string_to_lisp_symbol( L"t" ), t, result );
+
+        environment_initialised = true;
     }
 
     return result;

src/c/memory/memory.c

@@ -13,6 +13,14 @@
 #include "memory/memory.h"
 #include "memory/node.h"
 #include "memory/pointer.h"
+#include "memory/pso.h"
+#include "memory/pso2.h"
+#include "memory/tags.h"
+
+#include "payloads/exception.h"
+
+#include "ops/bind.h"
+#include "ops/string_ops.h"
 
 /**
  * @brief Freelists for each size class.
@@ -24,6 +32,7 @@ struct pso_pointer freelists[MAX_SIZE_CLASS];
  */
 bool memory_initialised = false;
 
+
 /**
  * @brief Initialise the memory allocation system.
  *
@@ -34,8 +43,12 @@ bool memory_initialised = false;
  * @return int 
  */
 struct pso_pointer initialise_memory( uint32_t node ) {
+    struct pso_pointer result = nil;
     if ( memory_initialised ) {
-        // TODO: throw an exception
+        result =
+            make_exception( c_string_to_lisp_string
+                            ( L"Attenpt to reinitialise environment" ), nil,
+                            nil );
     } else {
         for ( uint8_t i = 0; i <= MAX_SIZE_CLASS; i++ ) {
             freelists[i] = nil;

src/c/memory/node.c

@@ -55,11 +55,7 @@ struct pso_pointer t = ( struct pso_pointer ) { 0, 0, 1 };
 struct pso_pointer initialise_node( uint32_t index ) {
     node_index = index;
 
-    struct pso_pointer result = initialise_memory( index );
+    struct pso_pointer result = initialise_environment( index );
-
-    if ( c_eq( result, t ) ) {
-        result = initialise_environment( index );
-    }
 
     return result;
 }

src/c/ops/assoc.c

@@ -74,7 +74,8 @@ struct pso_pointer c_assoc( struct pso_pointer key, struct pso_pointer store ) {
  *
  * @return a pointer to the copy of the key in the store, or nil if not found.
  */
-struct pso_pointer c_interned( struct pso_pointer key, struct pso_pointer store ) {
+struct pso_pointer c_interned( struct pso_pointer key,
+                               struct pso_pointer store ) {
     return search( key, store, true );
 }
 
@@ -97,9 +98,10 @@ bool c_internedp( struct pso_pointer key, struct pso_pointer store ) {
  */
 struct pso_pointer assoc(
 #ifndef MANAGED_POINTER_ONLY
-    struct pso4 * frame,
+                             struct pso4 *frame,
 #endif
-    struct pso_pointer frame_pointer, struct pso_pointer env) {
+                             struct pso_pointer frame_pointer,
+                             struct pso_pointer env ) {
 #ifdef MANAGED_POINTER_ONLY
     struct pso4 *frame = pointer_to_pso4( frame_pointer );
 #endif
@@ -116,9 +118,10 @@ struct pso_pointer assoc(
  */
 struct pso_pointer interned(
 #ifndef MANAGED_POINTER_ONLY
-    struct pso4 * frame,
+                                struct pso4 *frame,
 #endif
-    struct pso_pointer frame_pointer, struct pso_pointer env) {
+                                struct pso_pointer frame_pointer,
+                                struct pso_pointer env ) {
 #ifdef MANAGED_POINTER_ONLY
     struct pso4 *frame = pointer_to_pso4( frame_pointer );
 #endif
@@ -135,9 +138,10 @@ struct pso_pointer interned(
  */
 struct pso_pointer internedp(
 #ifndef MANAGED_POINTER_ONLY
-    struct pso4 * frame,
+                                 struct pso4 *frame,
 #endif
-    struct pso_pointer frame_pointer, struct pso_pointer env) {
+                                 struct pso_pointer frame_pointer,
+                                 struct pso_pointer env ) {
 #ifdef MANAGED_POINTER_ONLY
     struct pso4 *frame = pointer_to_pso4( frame_pointer );
 #endif

src/c/ops/bind.c

@@ -21,11 +21,12 @@
 #include "payloads/cons.h"
 #include "payloads/stack.h"
 
-struct pso_pointer bind( 
+struct pso_pointer lisp_bind(
 #ifndef MANAGED_POINTER_ONLY
-    struct pso4 * frame,
+                            struct pso4 *frame,
 #endif
-    struct pso_pointer frame_pointer, struct pso_pointer env) {
+                            struct pso_pointer frame_pointer,
+                            struct pso_pointer env ) {
 #ifdef MANAGED_POINTER_ONLY
     struct pso4 *frame = pointer_to_pso4( frame_pointer );
 #endif
@@ -42,9 +43,9 @@ struct pso_pointer c_bind( struct pso_pointer key,
     struct pso_pointer result = nil;
     struct pso_pointer next = make_frame( nil, key, value, store );
     inc_ref( next );
-    result = bind(
+    result = lisp_bind(
 #ifndef MANAGED_POINTER_ONLY
-        pointer_to_pso4( next),
+                      pointer_to_pso4( next ),
 #endif
                       next, nil );
     dec_ref( next );

src/c/ops/bind.h

@@ -14,17 +14,17 @@
 #include <stdbool.h>
 
 #include "memory/pointer.h"
+#include "memory/pso4.h"
 
 struct pso_pointer c_bind( struct pso_pointer key,
                            struct pso_pointer value,
                            struct pso_pointer store );
 
-struct pso_pointer bind( 
+struct pso_pointer lisp_bind(
 #ifndef MANAGED_POINTER_ONLY
-    struct pso4 * frame,
+                            struct pso4 *frame,
 #endif
                             struct pso_pointer frame_pointer,
-    struct pso_pointer env
+                            struct pso_pointer env );
-);
 
 #endif

src/c/ops/eq.c

@@ -93,9 +93,10 @@ bool c_equal( struct pso_pointer a, struct pso_pointer b ) {
  */
 struct pso_pointer eq(
 #ifndef MANAGED_POINTER_ONLY
-    struct pso4 * frame,
+                          struct pso4 *frame,
 #endif
-    struct pso_pointer frame_pointer, struct pso_pointer env) {
+                          struct pso_pointer frame_pointer,
+                          struct pso_pointer env ) {
 #ifdef MANAGED_POINTER_ONLY
     struct pso4 *frame = pointer_to_pso4( frame_pointer );
 
@@ -132,12 +133,13 @@ struct pso_pointer eq(
  */
 struct pso_pointer equal(
 #ifndef MANAGED_POINTER_ONLY
-    struct pso4 * frame,
+                             struct pso4 *frame,
 #endif
-    struct pso_pointer frame_pointer, struct pso_pointer env) {
+                             struct pso_pointer frame_pointer,
+                             struct pso_pointer env ) {
 #ifdef MANAGED_POINTER_ONLY
     struct pso4 *frame = pointer_to_pso4( frame_pointer );
 
 #endif
-    return c_equal( fetch_arg( frame, 0), fetch_arg( frame, 1)) ? t : nil;
+    return c_equal( fetch_arg( frame, 0 ), fetch_arg( frame, 1 ) ) ? t : nil;
 }

src/c/ops/eq.h

@@ -27,19 +27,17 @@ bool c_equal( struct pso_pointer a, struct pso_pointer b );
 
 struct pso_pointer eq(
 #ifndef MANAGED_POINTER_ONLY
-    struct pso4 * frame,
+                          struct pso4 *frame,
 #endif
                           struct pso_pointer frame_pointer,
-    struct pso_pointer env
+                          struct pso_pointer env );
-);
 
 struct pso_pointer equal(
 #ifndef MANAGED_POINTER_ONLY
-    struct pso4 * frame,
+                             struct pso4 *frame,
 #endif
                              struct pso_pointer frame_pointer,
-    struct pso_pointer env
+                             struct pso_pointer env );
-);
 
 
 #endif

src/c/ops/eval.c

@@ -1,76 +0,0 @@
-/**
- *  ops/eval.c
- *
- *  Post Scarcity Software Environment: eval.
- *
- *  Evaluate an arbitrary Lisp expression.
- *
- *  (c) 2026 Simon Brooke <simon@journeyman.cc>
- *  Licensed under GPL version 2.0, or, at your option, any later version.
- */
-
-#include "memory/pointer.h"
-#include "memory/pso.h"
-#include "memory/pso2.h"
-#include "memory/pso3.h"
-#include "memory/pso4.h"
-#include "memory/tags.h"
-
-#include "payloads/cons.h"
-#include "payloads/exception.h"
-#include "payloads/function.h"
-#include "payloads/keyword.h"
-#include "payloads/lambda.h"
-#include "payloads/nlambda.h"
-#include "payloads/special.h"
-#include "payloads/stack.h"
-
-#include "ops/truth.h"
-
-/**
- * @brief Despatch eval based on tag of the form in the first position.
- * 
- * @param frame The current stack frame;
- * @param frame_pointer A pointer to the current stack frame;
- * @param env the evaluation environment.
- * @return struct pso_pointer 
- */
-struct pso_pointer lisp_eval( struct pso_pointer frame_pointer,
-                              struct pso_pointer env ) {
-    struct pso4 *frame = pointer_to_pso4( frame_pointer );
-    struct pso_pointer result = frame->payload.stack_frame.arg[0];
-
-    // switch ( get_tag_value( result)) {
-    //     case CONSTV:
-    //         result = eval_cons( frame, frame_pointer, env);
-    //         break;
-    //     case KEYTV:
-    //     case SYMBOLTV:
-    //         result = eval_symbol( frame, frame_pointer, env);
-    //         break;
-    //     case LAMBDATV:
-    //         result = eval_lambda( frame, frame_pointer, env);
-    //         break;
-    //     case NLAMBDATV:
-    //         result = eval_nlambda( frame, frame_pointer, env);
-    //         break;
-    //     case SPECIALTV:
-    //         result = eval_special( frame, frame_pointer, env);
-    //         break;        
-    // }
-
-    if ( exceptionp( result ) ) {
-        struct pso3 *x =
-            ( struct pso3 * ) pointer_to_object_with_tag_value( result,
-                                                                EXCEPTIONTV );
-
-        if ( nilp( x->payload.exception.stack ) ) {
-            inc_ref( result );
-            result =
-                make_exception( x->payload.exception.message, frame_pointer,
-                                result );
-        }
-    }
-
-    return result;
-}

src/c/ops/string_ops.c

@@ -145,6 +145,25 @@ struct pso_pointer c_string_to_lisp_string( wchar_t *string ) {
     return result;
 }
 
+
+/**
+ * Return a lisp symbol representation of this wide character string. In
+ * symbols, I am accepting only lower case characters.
+ */
+struct pso_pointer c_string_to_lisp_symbol( wchar_t *symbol ) {
+    struct pso_pointer result = nil;
+
+    for ( int i = wcslen( symbol ) - 1; i >= 0; i-- ) {
+        wchar_t c = towlower( symbol[i] );
+
+        if ( iswalpha( c ) || c == L'-' ) {
+            result = make_symbol( c, result );
+        }
+    }
+
+    return result;
+}
+
 /**
  * Return a lisp keyword representation of this wide character string. In
  * keywords, I am accepting only lower case characters and numbers.

src/c/ops/string_ops.h

@@ -29,4 +29,6 @@ struct pso_pointer c_string_to_lisp_string( wchar_t *string );
 
 struct pso_pointer c_string_to_lisp_keyword( wchar_t *symbol );
 
+struct pso_pointer c_string_to_lisp_symbol( wchar_t *symbol );
+
 #endif

src/c/payloads/stack.c

@@ -52,7 +52,8 @@ struct pso_pointer make_frame( struct pso_pointer previous, ... ) {
         struct pso_pointer more_args = nil;
 
         for ( ; cursor < count; cursor++ ) {
-            more_args = c_cons( va_arg( args, struct pso_pointer ), more_args );
+            more_args =
+                c_cons( va_arg( args, struct pso_pointer ), more_args );
         }
 
         // should be frame->payload.stack_frame.more = reverse( more_args), but