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

Still grinding incrementally forward, through barbed wire entanglements.

Browse source 
Morale fading.
This commit is contained in:
Simon Brooke 2026-05-03 17:26:53 +01:00
parent ab0ea09bd4
commit 92490ebd5f
9 changed files with 104 additions and 48 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -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λ" ),
make_cons( frame_pointer, cell->payload.lambda.args,
cell->payload.lambda.body ) ) );
result = make_cons( frame_pointer,
c_string_to_lisp_symbol( frame_pointer, L"nλ" ),
make_cons( frame_pointer,
cell->payload.lambda.args,
cell->payload.lambda.body ) );
break;
}
push_local( frame_pointer, result );
@ -942,39 +943,41 @@ 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 frame_pointer,
struct pso_pointer env ) {
struct pso_pointer bindings = env;
struct pso_pointer lisp_let( struct pso_pointer frame_pointer ) {
struct pso4* frame = pointer_to_pso4( frame_pointer);
struct pso_pointer bindings = fetch_env(frame_pointer);
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 ),
bindings );
eval_form( next_pointer );
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" ),
c_string_to_lisp_string
( L"Let: cannot bind, not a symbol" ),
throw_exception( c_string_to_lisp_symbol( frame_pointer, L"let" ),
c_string_to_lisp_string( frame_pointer, L"Let: cannot bind, not a symbol" ),
frame_pointer );
break;
}
}
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);
progn_frame = pointer_to_pso4(progn_pointer);
struct pso_pointer progn_pointer = make_frame_with_env( 0, frame_pointer, bindings);
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);
@ -982,17 +985,11 @@ struct pso_pointer lisp_let( struct pso4 *frame,
}
if ( a < frame->payload.stack_frame.args) {
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);
}
/* i.e., no exception yet */
for ( int form = 1;
!exceptionp( result ) && form < frame->payload.stack_frame.args;
form++ ) {
result =
eval_form( frame, frame_pointer, fetch_arg( frame, form ),
bindings );
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 ) );
}

2
src/c/ops/mapcar.c
View file

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

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

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

4
src/c/ops/reverse.h
View file

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

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

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

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

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

1
src/c/payloads/cons.h
View file

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

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

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

2
src/c/payloads/stack.h
View file

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