From f751fc8a09573b7960bd1e5c757694d22a88dc6a Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 15 Apr 2026 22:47:44 +0100 Subject: [PATCH] More code, closer to working, still builds. --- src/c/environment/environment.c | 55 +++++++++++++++++++++--- src/c/io/io.c | 4 +- src/c/memory/memory.c | 15 ++++++- src/c/memory/node.c | 6 +-- src/c/ops/assoc.c | 26 ++++++----- src/c/ops/assoc.h | 4 +- src/c/ops/bind.c | 13 +++--- src/c/ops/bind.h | 10 ++--- src/c/ops/eq.c | 20 +++++---- src/c/ops/eq.h | 18 ++++---- src/c/ops/eval.c | 76 --------------------------------- src/c/ops/string_ops.c | 19 +++++++++ src/c/ops/string_ops.h | 2 + src/c/payloads/stack.c | 3 +- 14 files changed, 138 insertions(+), 133 deletions(-) delete mode 100644 src/c/ops/eval.c diff --git a/src/c/environment/environment.c b/src/c/environment/environment.c index cf512c4..28c453f 100644 --- a/src/c/environment/environment.c +++ b/src/c/environment/environment.c @@ -9,8 +9,19 @@ #include +#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; - if ( environment_initialised ) { - // TODO: throw an exception "Attempt to reinitialise environment" - } else { - // TODO: actually initialise it. + struct pso_pointer result = initialise_memory( node ); + + 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 { + 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; diff --git a/src/c/io/io.c b/src/c/io/io.c index 3f31d2c..2a897f7 100644 --- a/src/c/io/io.c +++ b/src/c/io/io.c @@ -329,7 +329,7 @@ struct pso_pointer add_meta_integer( struct pso_pointer meta, wchar_t *key, long int value ) { return c_cons( c_cons( c_string_to_lisp_keyword( key ), - make_integer( value ) ), meta ); + make_integer( value ) ), meta ); } struct pso_pointer add_meta_string( struct pso_pointer meta, wchar_t *key, @@ -339,7 +339,7 @@ struct pso_pointer add_meta_string( struct pso_pointer meta, wchar_t *key, mbstowcs( buffer, value, strlen( value ) + 1 ); return c_cons( c_cons( c_string_to_lisp_keyword( key ), - c_string_to_lisp_string( buffer ) ), meta ); + c_string_to_lisp_string( buffer ) ), meta ); } struct pso_pointer add_meta_time( struct pso_pointer meta, wchar_t *key, diff --git a/src/c/memory/memory.c b/src/c/memory/memory.c index ca41d67..6d48334 100644 --- a/src/c/memory/memory.c +++ b/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; diff --git a/src/c/memory/node.c b/src/c/memory/node.c index 2a650a0..5c70ec5 100644 --- a/src/c/memory/node.c +++ b/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 ); - - if ( c_eq( result, t ) ) { - result = initialise_environment( index ); - } + struct pso_pointer result = initialise_environment( index ); return result; } diff --git a/src/c/ops/assoc.c b/src/c/ops/assoc.c index 004fa3e..fb63afc 100644 --- a/src/c/ops/assoc.c +++ b/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 ); } @@ -95,11 +96,12 @@ bool c_internedp( struct pso_pointer key, struct pso_pointer store ) { * * @return a pointer to the value of the key in the store, or nil if not found */ -struct pso_pointer assoc( +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 @@ -114,11 +116,12 @@ struct pso_pointer assoc( * * @return a pointer to the copy of the key in the store, or nil if not found. */ -struct pso_pointer interned( +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 @@ -133,11 +136,12 @@ struct pso_pointer interned( * * @return `t` if a pointer to a copy of `key` is found in the store, or `nil` if not found. */ -struct pso_pointer internedp( +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 @@ -145,4 +149,4 @@ struct pso_pointer internedp( struct pso_pointer store = fetch_arg( frame, 1 ); return c_interned( key, store ); -} \ No newline at end of file +} diff --git a/src/c/ops/assoc.h b/src/c/ops/assoc.h index ab59c40..746a6ea 100644 --- a/src/c/ops/assoc.h +++ b/src/c/ops/assoc.h @@ -17,12 +17,12 @@ #include "memory/pointer.h" struct pso_pointer search( struct pso_pointer key, - struct pso_pointer store, bool return_key ); + struct pso_pointer store, bool return_key ); struct pso_pointer c_assoc( struct pso_pointer key, struct pso_pointer store ); struct pso_pointer c_interned( struct pso_pointer key, - struct pso_pointer store ); + struct pso_pointer store ); bool c_internedp( struct pso_pointer key, struct pso_pointer store ); #endif diff --git a/src/c/ops/bind.c b/src/c/ops/bind.c index 75aa476..799c418 100644 --- a/src/c/ops/bind.c +++ b/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,11 +43,11 @@ 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 ); + next, nil ); dec_ref( next ); return result; diff --git a/src/c/ops/bind.h b/src/c/ops/bind.h index e8e6839..f2a799f 100644 --- a/src/c/ops/bind.h +++ b/src/c/ops/bind.h @@ -14,17 +14,17 @@ #include #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 frame_pointer, + struct pso_pointer env ); #endif diff --git a/src/c/ops/eq.c b/src/c/ops/eq.c index ab8702c..d5b348e 100644 --- a/src/c/ops/eq.c +++ b/src/c/ops/eq.c @@ -91,14 +91,15 @@ bool c_equal( struct pso_pointer a, struct pso_pointer b ) { * * @return `t` if all args are pointers to the same object, else `nil`; */ -struct pso_pointer eq( +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 ); - + #endif struct pso_pointer result = t; @@ -130,14 +131,15 @@ struct pso_pointer eq( * * @return `t` if all args are pointers to the same object, else `nil`; */ -struct pso_pointer equal( +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; } diff --git a/src/c/ops/eq.h b/src/c/ops/eq.h index 90885c5..a669a10 100644 --- a/src/c/ops/eq.h +++ b/src/c/ops/eq.h @@ -25,21 +25,19 @@ struct pso_pointer eq( struct pso_pointer frame_pointer, bool c_equal( struct pso_pointer a, struct pso_pointer b ); -struct pso_pointer eq( +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 ); -struct pso_pointer equal( +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 ); #endif diff --git a/src/c/ops/eval.c b/src/c/ops/eval.c deleted file mode 100644 index 830cceb..0000000 --- a/src/c/ops/eval.c +++ /dev/null @@ -1,76 +0,0 @@ -/** - * ops/eval.c - * - * Post Scarcity Software Environment: eval. - * - * Evaluate an arbitrary Lisp expression. - * - * (c) 2026 Simon Brooke - * 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; -} diff --git a/src/c/ops/string_ops.c b/src/c/ops/string_ops.c index 14d12a3..0f6741a 100644 --- a/src/c/ops/string_ops.c +++ b/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. diff --git a/src/c/ops/string_ops.h b/src/c/ops/string_ops.h index 59ce837..e80692e 100644 --- a/src/c/ops/string_ops.h +++ b/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 diff --git a/src/c/payloads/stack.c b/src/c/payloads/stack.c index 70abaa3..3f144df 100644 --- a/src/c/payloads/stack.c +++ b/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