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

Initialisation almost succeeds. nil and t are successfully instantiated.

Browse source 
We then go into a mess of exceptions which trigger exceptions until we run out
of allocatable memory, but all those exceptions and stack frames are correctly
allocated and torn down again afterwards, so.... sort of good?
This commit is contained in:
Simon Brooke 2026-04-16 11:39:01 +01:00
commit ba985474f6
31 changed files with 869 additions and 199 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -19,6 +19,7 @@
#include "payloads/cons.h"
#include "ops/eq.h"
#include "ops/stack_ops.h"
#include "ops/truth.h"
/**
@ -40,12 +41,12 @@ struct pso_pointer search( struct pso_pointer key,
if ( consp( store ) ) {
for ( struct pso_pointer cursor = store;
consp( store ) && found == false; cursor = cdr( cursor ) ) {
struct pso_pointer pair = car( cursor );
consp( store ) && found == false; cursor = c_cdr( cursor ) ) {
struct pso_pointer pair = c_car( cursor );
if ( consp( pair ) && c_equal( car( pair ), key ) ) {
if ( consp( pair ) && c_equal( c_car( pair ), key ) ) {
found = true;
result = return_key ? car( pair ) : cdr( pair );
result = return_key ? c_car( pair ) : c_cdr( pair );
}
}
}
@ -61,7 +62,7 @@ struct pso_pointer search( struct pso_pointer key,
*
* @return a pointer to the value of the key in the store, or nil if not found
*/
struct pso_pointer assoc( struct pso_pointer key, struct pso_pointer store ) {
struct pso_pointer c_assoc( struct pso_pointer key, struct pso_pointer store ) {
return search( key, store, false );
}
@ -73,7 +74,8 @@ struct pso_pointer 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 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 );
}
@ -85,6 +87,66 @@ struct pso_pointer interned( struct pso_pointer key, struct pso_pointer store )
*
* @return `true` if a pointer the key was found in the store..
*/
bool internedp( struct pso_pointer key, struct pso_pointer store ) {
bool c_internedp( struct pso_pointer key, struct pso_pointer store ) {
return !nilp( search( key, store, true ) );
}
/**
* @prief: bootstap layer assoc; Lisp calling signature.
*
* @return a pointer to the value of the key in the store, or nil if not found
*/
struct pso_pointer assoc(
#ifndef MANAGED_POINTER_ONLY
struct pso4 *frame,
#endif
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 key = fetch_arg( frame, 0 );
struct pso_pointer store = fetch_arg( frame, 1 );
return c_assoc( key, store );
}
/**
* @prief: bootstap layer interned; Lisp calling signature.
*
* @return a pointer to the copy of the key in the store, or nil if not found.
*/
struct pso_pointer interned(
#ifndef MANAGED_POINTER_ONLY
struct pso4 *frame,
#endif
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 key = fetch_arg( frame, 0 );
struct pso_pointer store = fetch_arg( frame, 1 );
return c_interned( key, store );
}
/**
* @prief: bootstap layer interned?; Lisp calling signature.
*
* @return `t` if a pointer to a copy of `key` is found in the store, or `nil` if not found.
*/
struct pso_pointer internedp(
#ifndef MANAGED_POINTER_ONLY
struct pso4 *frame,
#endif
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 key = fetch_arg( frame, 0 );
struct pso_pointer store = fetch_arg( frame, 1 );
return c_interned( key, store );
}

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

@ -16,13 +16,13 @@
#include "memory/pointer.h"
struct cons_pointer search( struct pso_pointer key,
struct pso_pointer store, bool return_key );
struct pso_pointer search( struct pso_pointer key,
struct pso_pointer store, bool return_key );
struct pso_pointer assoc( struct pso_pointer key, struct pso_pointer store );
struct pso_pointer c_assoc( struct pso_pointer key, struct pso_pointer store );
struct pso_pointer interned( struct pso_pointer key,
struct pso_pointer store );
struct pso_pointer c_interned( struct pso_pointer key,
struct pso_pointer store );
bool internedp( struct pso_pointer key, struct pso_pointer store );
bool c_internedp( struct pso_pointer key, struct pso_pointer store );
#endif

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

@ -21,14 +21,20 @@
#include "payloads/cons.h"
#include "payloads/stack.h"
struct pso_pointer bind( struct pso_pointer frame_pointer,
struct pso_pointer env ) {
struct pso_pointer lisp_bind(
#ifndef MANAGED_POINTER_ONLY
struct pso4 *frame,
#endif
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 key = fetch_arg( frame, 0 );
struct pso_pointer value = fetch_arg( frame, 1 );
struct pso_pointer store = fetch_arg( frame, 2 );
return cons( cons( key, value ), store );
return c_cons( c_cons( key, value ), store );
}
struct pso_pointer c_bind( struct pso_pointer key,
@ -37,7 +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( next, nil );
result = lisp_bind(
#ifndef MANAGED_POINTER_ONLY
pointer_to_pso4( next ),
#endif
next, nil );
dec_ref( next );
return result;

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

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

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

@ -16,6 +16,7 @@
#include "memory/tags.h"
#include "payloads/cons.h"
#include "payloads/function.h"
#include "payloads/integer.h"
#include "payloads/stack.h"
#include "ops/stack_ops.h"
@ -26,6 +27,8 @@
*
* Shallow, cheap equality.
*
* Bootstrap function: only knows about character, cons, integer, and
* string-like-thing equality.
* TODO: if either of these pointers points to a cache cell, then what
* we need to check is the cached value, which is not so cheap. Ouch!
*
@ -53,8 +56,8 @@ bool c_equal( struct pso_pointer a, struct pso_pointer b ) {
ob->payload.character.character );
break;
case CONSTV:
result = ( c_equal( car( a ), car( b ) )
&& c_equal( cdr( a ), cdr( b ) ) );
result = ( c_equal( c_car( a ), c_car( b ) )
&& c_equal( c_cdr( a ), c_cdr( b ) ) );
break;
case INTEGERTV:
result = ( oa->payload.integer.value
@ -63,11 +66,11 @@ bool c_equal( struct pso_pointer a, struct pso_pointer b ) {
case KEYTV:
case STRINGTV:
case SYMBOLTV:
while ( result == false && !nilp( a ) && !nilp( b ) ) {
while ( !nilp( a ) && !nilp( b ) ) {
if ( pointer_to_object( a )->payload.string.character ==
pointer_to_object( b )->payload.string.character ) {
a = cdr( a );
b = cdr( b );
a = c_cdr( a );
b = c_cdr( b );
}
}
result = nilp( a ) && nilp( b );
@ -86,15 +89,19 @@ bool c_equal( struct pso_pointer a, struct pso_pointer b ) {
*
* * (eq? args...)
*
* @param frame my stack_frame.
* @param frame_pointer a pointer to my stack_frame.
* @param env my environment (ignored).
* @return `t` if all args are pointers to the same object, else `nil`;
*/
struct pso_pointer eq( struct pso_pointer frame_pointer,
struct pso_pointer env ) {
struct pso_pointer eq(
#ifndef MANAGED_POINTER_ONLY
struct pso4 *frame,
#endif
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;
if ( frame->payload.stack_frame.args > 1 ) {
@ -108,3 +115,31 @@ struct pso_pointer eq( struct pso_pointer frame_pointer,
return result;
}
/**
* Function; do all arguments to this finction point to the same object?
*
* Deep, expensive equality. Bootstrap version: only knows
* * cons cells
* * integers
* * keywords
* * symbols
* * strings
*
* * (equal? arg1 qrg2)
*
* @return `t` if all args are pointers to the same object, else `nil`;
*/
struct pso_pointer equal(
#ifndef MANAGED_POINTER_ONLY
struct pso4 *frame,
#endif
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;
}

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

@ -16,10 +16,28 @@
#include "memory/pointer.h"
#include "memory/pso4.h"
#include "payloads/function.h"
bool c_eq( struct pso_pointer a, struct pso_pointer b );
struct pso_pointer eq( struct pso_pointer frame_pointer,
struct pso_pointer env );
bool c_equal( struct pso_pointer a, struct pso_pointer b );
struct pso_pointer eq(
#ifndef MANAGED_POINTER_ONLY
struct pso4 *frame,
#endif
struct pso_pointer frame_pointer,
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 );
#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_pointer, env);
break;
case LAMBDATV:
result = eval_lambda( frame_pointer, env);
break;
case NLAMBDATV:
result = eval_nlambda( 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;
}

106
src/c/ops/eval_apply.c Normal file
View file

@ -0,0 +1,106 @@
/**
* ops/apply.c
*
* Post Scarcity Software Environment: apply.
*
* Add a applying for a key/value pair to a store -- at this stage, just an
* association list.
*
* (c) 2026 Simon Brooke <simon@journeyman.cc>
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#include "memory/node.h"
#include "memory/pointer.h"
#include "memory/pso.h"
#include "memory/pso3.h"
#include "memory/pso4.h"
#include "memory/tags.h"
#include "ops/assoc.h"
#include "ops/stack_ops.h"
#include "ops/string_ops.h"
#include "ops/truth.h"
#include "payloads/cons.h"
#include "payloads/stack.h"
/**
* @brief Apply a function to arguments in an environment.
*
* * (apply fn args)
*/
struct pso_pointer apply(
#ifndef MANAGED_POINTER_ONLY
struct pso4 *frame,
#endif
struct pso_pointer frame_pointer,
struct pso_pointer env ) {
#ifdef MANAGED_POINTER_ONLY
struct pso4 *frame = pointer_to_pso4( frame_pointer );
#endif
// TODO.
}
/**
* @brief Evaluate a form, in an environment
*
* * (eval form)
*/
struct pso_pointer eval(
#ifndef MANAGED_POINTER_ONLY
struct pso4 *frame,
#endif
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 = fetch_arg( frame, 0 );
switch ( get_tag_value( result ) ) {
// case CONSTV:
// result = eval_cons( frame, frame_pointer, env);
// break;
case INTEGERTV:
case KEYTV:
case STRINGTV:
// self evaluating
break;
case SYMBOLTV:
result = c_assoc( result, 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;
default:
result =
make_exception( c_cons
( c_string_to_lisp_string
( L"Can't yet evaluate things of this type: " ),
result ), frame_pointer, nil );
}
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;
}

36
src/c/ops/eval_apply.h Normal file
View file

@ -0,0 +1,36 @@
/**
* ops/eval_apply.h
*
* Post Scarcity Software Environment: eval, apply.
*
* apply: Apply a function to arguments in an environment.
* eval: Evaluate a form in an environment.
*
* (c) 2026 Simon Brooke <simon@journeyman.cc>
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#ifndef __psse_ops_eval_apply_h
#define __psse_ops_eval_apply_h
#include "memory/pointer.h"
#include "memory/pso4.h"
#include "payloads/function.h"
struct pso_pointer apply(
#ifndef MANAGED_POINTER_ONLY
struct pso4 *frame,
#endif
struct pso_pointer frame_pointer,
struct pso_pointer env );
struct pso_pointer eval(
#ifndef MANAGED_POINTER_ONLY
struct pso4 *frame,
#endif
struct pso_pointer frame_pointer,
struct pso_pointer env );
#endif

72
src/c/ops/list_ops.c Normal file
View file

@ -0,0 +1,72 @@
/**
* ops/list_ops.h
*
* Post Scarcity Software Environment: list_ops.
*
* Operations on cons cells.
*
* (c) 2026 Simon Brooke <simon@journeyman.cc>
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#ifndef __psse_ops_list_ops_h
#define __psse_ops_list_ops_h
#include "memory/pointer.h"
#include "memory/pso.h"
#include "memory/pso4.h"
#include "memory/tags.h"
#include "ops/stack_ops.h"
#include "payloads/cons.h"
#include "payloads/stack.h"
struct pso_pointer car(
#ifndef MANAGED_POINTER_ONLY
struct pso4 *frame,
#endif
struct pso_pointer frame_pointer,
struct pso_pointer env ) {
#ifdef MANAGED_POINTER_ONLY
struct pso4 *frame = pointer_to_pso4( frame_pointer );
#endif
return c_car( fetch_arg( frame, 0 ) );
}
struct pso_pointer cdr(
#ifndef MANAGED_POINTER_ONLY
struct pso4 *frame,
#endif
struct pso_pointer frame_pointer,
struct pso_pointer env ) {
#ifdef MANAGED_POINTER_ONLY
struct pso4 *frame = pointer_to_pso4( frame_pointer );
#endif
return c_cdr( fetch_arg( frame, 0 ) );
}
/**
* @brief allocate a cons cell from the first two args in this frame, and
* return a pointer to it.
*
* Lisp calling conventions.
*
* @return struct pso_pointer a pointer to the newly allocated cons cell.
*/
struct pso_pointer cons(
#ifndef MANAGED_POINTER_ONLY
struct pso4 *frame,
#endif
struct pso_pointer frame_pointer,
struct pso_pointer env ) {
#ifdef MANAGED_POINTER_ONLY
struct pso4 *frame = pointer_to_pso4( frame_pointer );
#endif
return c_cons( fetch_arg( frame, 0 ), fetch_arg( frame, 1 ) );
}
#endif

39
src/c/ops/list_ops.h Normal file
View file

@ -0,0 +1,39 @@
/**
* ops/list_ops.h
*
* Post Scarcity Software Environment: list_ops.
*
* Operations on cons cells.
*
* (c) 2026 Simon Brooke <simon@journeyman.cc>
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#ifndef __psse_ops_list_ops_h
#define __psse_ops_list_ops_h
#include "memory/pointer.h"
#include "memory/pso4.h"
struct pso_pointer car(
#ifndef MANAGED_POINTER_ONLY
struct pso4 *frame,
#endif
struct pso_pointer frame_pointer,
struct pso_pointer env );
struct pso_pointer cdr(
#ifndef MANAGED_POINTER_ONLY
struct pso4 *frame,
#endif
struct pso_pointer frame_pointer,
struct pso_pointer env );
struct pso_pointer cons(
#ifndef MANAGED_POINTER_ONLY
struct pso4 *frame,
#endif
struct pso_pointer frame_pointer,
struct pso_pointer env );
#endif

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

@ -39,13 +39,14 @@ struct pso_pointer reverse( struct pso_pointer sequence ) {
struct pso_pointer result = nil;
for ( struct pso_pointer cursor = sequence; !nilp( sequence );
cursor = cdr( cursor ) ) {
cursor = c_cdr( cursor ) ) {
struct pso2 *object = pointer_to_object( cursor );
switch ( get_tag_value( cursor ) ) {
case CONSTV:
result = cons( car( cursor ), result );
result = c_cons( c_car( cursor ), result );
break;
case KEYTV:
// TODO: should you be able to reverse keywords and symbols?
result =
make_string_like_thing( object->payload.string.character,
result, KEYTAG );
@ -56,6 +57,7 @@ struct pso_pointer reverse( struct pso_pointer sequence ) {
result, STRINGTAG );
break;
case SYMBOLTV:
// TODO: should you be able to reverse keywords and symbols?
result =
make_string_like_thing( object->payload.string.character,
result, SYMBOLTAG );

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

@ -73,7 +73,7 @@ struct pso_pointer make_string_like_thing( wint_t c, struct pso_pointer tail,
char *tag ) {
struct pso_pointer pointer = nil;
if ( check_type( tail, tag ) || check_tag( tail, NILTV ) ) {
if ( check_type( tail, tag ) || nilp(tail) ) {
pointer = allocate( tag, CONS_SIZE_CLASS );
struct pso2 *cell = pointer_to_object( pointer );
@ -85,9 +85,10 @@ struct pso_pointer make_string_like_thing( wint_t c, struct pso_pointer tail,
debug_println( DEBUG_ALLOC );
} else {
// \todo should throw an exception!
struct pso2* tobj = pointer_to_object( tail);
debug_printf( DEBUG_ALLOC, 0,
L"Warning: only %4.4s can be prepended to %4.4s\n",
tag, tag );
L"Warning: %3.3s cannot be prepended to %3.3s\n",
tag, tobj->header.tag.bytes.mnemonic );
}
return pointer;
@ -145,6 +146,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