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

73
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,57 +943,53 @@ 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;
}
}
debug_print( L"\nlet: bindings complete.\n", DEBUG_BIND, 0 );
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);
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);
progn_frame->payload.stack_frame.args ++;
}
if ( a < frame->payload.stack_frame.args) {
progn_frame->payload.stack_frame.arg[a-1] = fetch_arg( frame, a);
}
struct pso_pointer progn_pointer = make_frame_with_env( 0, frame_pointer, bindings);
struct pso4* progn_frame = pointer_to_pso4(progn_pointer);
/* 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 );
}
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);
progn_frame->payload.stack_frame.args ++;
}
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);
}
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

4
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"
@ -67,7 +69,7 @@ uint32_t calculate_hash( wint_t c, struct pso_pointer ptr ) {
* has one character and a pointer to the next; in the last cell the
* pointer to next is nil.
*
* NOTE THAT: in 0.1.X, we may allocate symbols and keywords as arrays of
* NOTE THAT: in 0.1.X, we may allocate symbols and keywords as arrays of
* char32_t in larger pso classes, so this function may be only for strings
* (and thus simpler).
*/

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