simon/post-scarcity
1
0
Fork 0
Code Issues 14 Pull requests Projects Releases Packages Wiki Activity Actions

More code, closer to working, still builds.

Browse source
This commit is contained in:
Simon Brooke 2026-04-15 22:47:44 +01:00
parent c9f50572ab
commit f751fc8a09
14 changed files with 138 additions and 133 deletions
Download patch file Download diff file Expand all files Collapse all files

53
src/c/environment/environment.c
View file

@ -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;
if ( environment_initialised ) {
// TODO: throw an exception "Attempt to reinitialise environment"
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 {
// 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;

15
src/c/memory/memory.c
View file

@ -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;

6
src/c/memory/node.c
View file

@ -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;
}

12
src/c/ops/assoc.c
View file

@ -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 );
}
@ -99,7 +100,8 @@ struct pso_pointer assoc(
#ifndef MANAGED_POINTER_ONLY
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
@ -118,7 +120,8 @@ struct pso_pointer interned(
#ifndef MANAGED_POINTER_ONLY
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
@ -137,7 +140,8 @@ struct pso_pointer internedp(
#ifndef MANAGED_POINTER_ONLY
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

7
src/c/ops/bind.c
View file

@ -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,
#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,7 +43,7 @@ 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 ),
#endif

6
src/c/ops/bind.h
View file

@ -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,
#endif
struct pso_pointer frame_pointer,
struct pso_pointer env
);
struct pso_pointer env );
#endif

6
src/c/ops/eq.c
View file

@ -95,7 +95,8 @@ struct pso_pointer eq(
#ifndef MANAGED_POINTER_ONLY
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 );
@ -134,7 +135,8 @@ struct pso_pointer equal(
#ifndef MANAGED_POINTER_ONLY
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 );

6
src/c/ops/eq.h
View file

@ -30,16 +30,14 @@ struct pso_pointer eq(
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,
#endif
struct pso_pointer frame_pointer,
struct pso_pointer env
);
struct pso_pointer env );
#endif

76
src/c/ops/eval.c
View file

@ -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;
}

19
src/c/ops/string_ops.c
View file

@ -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.

2
src/c/ops/string_ops.h
View file

@ -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

3
src/c/payloads/stack.c
View file

@ -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