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

Still making progress. Dropped the archive because it was causing problems.

Browse source
This commit is contained in:
Simon Brooke 2026-04-22 21:09:15 +01:00
parent eed4711fee
commit 8d2acbeb0f
97 changed files with 490 additions and 13322 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -101,13 +101,15 @@ struct pso_pointer assoc(
#ifndef MANAGED_POINTER_ONLY
struct pso4 *frame,
#endif
struct pso_pointer frame_pointer) {
struct pso_pointer frame_pointer ) {
#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 = or( make_frame( 2, frame_pointer,
fetch_arg( frame, 1 ), frame->payload.stack_frame.env));
fetch_arg( frame, 1 ),
frame->payload.
stack_frame.env ) );
return c_assoc( key, store );
}
@ -121,13 +123,15 @@ struct pso_pointer interned(
#ifndef MANAGED_POINTER_ONLY
struct pso4 *frame,
#endif
struct pso_pointer frame_pointer) {
struct pso_pointer frame_pointer ) {
#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 = or( make_frame( 2, frame_pointer,
fetch_arg( frame, 1 ), frame->payload.stack_frame.env));
fetch_arg( frame, 1 ),
frame->payload.
stack_frame.env ) );
return c_interned( key, store );
}
@ -141,13 +145,15 @@ struct pso_pointer internedp(
#ifndef MANAGED_POINTER_ONLY
struct pso4 *frame,
#endif
struct pso_pointer frame_pointer) {
struct pso_pointer frame_pointer ) {
#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 = or( make_frame( 2, frame_pointer,
fetch_arg( frame, 1 ), frame->payload.stack_frame.env));
fetch_arg( frame, 1 ),
frame->payload.
stack_frame.env ) );
return c_internedp( key, store ) ? t : nil;
}

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

@ -22,19 +22,16 @@
#include "payloads/function.h"
#include "payloads/stack.h"
struct pso_pointer bind(
#ifndef MANAGED_POINTER_ONLY
struct pso4 *frame,
#endif
struct pso_pointer frame_pointer) {
#ifdef MANAGED_POINTER_ONLY
/**
* (bind key value store)
*/
struct pso_pointer lisp_bind( struct pso_pointer frame_pointer ) {
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 );
struct pso_pointer binding = cons( make_frame( 2, frame_pointer, key, value));
struct pso_pointer binding =
cons( make_frame( 2, frame_pointer, key, value ) );
return cons( make_frame( 2, frame_pointer, binding, store));
return cons( make_frame( 2, frame_pointer, binding, store ) );
}

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

@ -16,15 +16,7 @@
#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 lisp_bind(
#ifndef MANAGED_POINTER_ONLY
struct pso4 *frame,
#endif
struct pso_pointer frame_pointer,
struct pso_pointer env );
struct pso_pointer lisp_bind( struct pso_pointer frame_pointer );
#endif

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

@ -32,7 +32,7 @@ struct pso_pointer equal(
#ifndef MANAGED_POINTER_ONLY
struct pso4 *frame,
#endif
struct pso_pointer frame_pointer);
struct pso_pointer frame_pointer );
#endif

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

@ -31,14 +31,7 @@
*
* * (apply fn args)
*/
struct pso_pointer apply(
#ifndef MANAGED_POINTER_ONLY
struct pso4 *frame,
#endif
struct pso_pointer frame_pointer) {
#ifdef MANAGED_POINTER_ONLY
struct pso4 *frame = pointer_to_pso4( frame_pointer );
#endif
struct pso_pointer apply( struct pso_pointer frame_pointer ) {
// TODO.
@ -49,16 +42,11 @@ struct pso_pointer apply(
*
* * (eval form)
*/
struct pso_pointer eval(
#ifndef MANAGED_POINTER_ONLY
struct pso4 *frame,
#endif
struct pso_pointer frame_pointer) {
#ifdef MANAGED_POINTER_ONLY
struct pso_pointer eval( struct pso_pointer frame_pointer ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
#endif
struct pso_pointer arg = fetch_arg( frame, 0 );
struct pso_pointer result = nil;
struct pso_pointer result = nil;
switch ( get_tag_value( arg ) ) {
// case CONSTV:
@ -68,10 +56,10 @@ struct pso_pointer eval(
case KEYTV:
case STRINGTV:
// self evaluating
result = nil;
result = nil;
break;
case SYMBOLTV:
arg = c_assoc( arg, fetch_env(frame_pointer) );
arg = c_assoc( arg, fetch_env( frame_pointer ) );
break;
// case LAMBDATV:
// result = eval_lambda( frame, frame_pointer, env);
@ -84,22 +72,22 @@ struct pso_pointer eval(
// break;
default:
arg =
make_exception(
make_frame(1, frame_pointer,
make_cons( frame_pointer,
c_string_to_lisp_string( frame_pointer,
L"Can't yet evaluate things of this type: " ),
arg ),
make_cons( frame_pointer,
make_cons
( frame_pointer,
c_string_to_lisp_keyword
( frame_pointer,
L"tag" ),
get_tag_string
( arg ) ),
nil ),
nil ));
make_exception( make_frame( 1, frame_pointer,
make_cons( frame_pointer,
c_string_to_lisp_string
( frame_pointer,
L"Can't yet evaluate things of this type: " ),
arg ),
make_cons( frame_pointer,
make_cons
( frame_pointer,
c_string_to_lisp_keyword
( frame_pointer,
L"tag" ),
get_tag_string
( frame_pointer,
arg ) ), nil ),
nil ) );
}
if ( exceptionp( arg ) ) {
@ -108,7 +96,7 @@ struct pso_pointer eval(
EXCEPTIONTV );
if ( c_nilp( x->payload.exception.stack ) ) {
}
}

14
src/c/ops/eval_apply.h
View file

@ -17,20 +17,10 @@
#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 apply( struct pso_pointer frame_pointer );
struct pso_pointer eval(
#ifndef MANAGED_POINTER_ONLY
struct pso4 *frame,
#endif
struct pso_pointer frame_pointer,
struct pso_pointer env );
struct pso_pointer eval( struct pso_pointer frame_pointer );
#endif

20
src/c/ops/list_ops.c
View file

@ -17,16 +17,16 @@
#include "ops/truth.h"
struct pso_pointer length( struct pso_pointer frame_pointer) {
struct pso4* frame = pointer_to_pso4(frame_pointer);
struct pso_pointer list = fetch_arg( frame, 0);
int count = 0;
struct pso_pointer length( struct pso_pointer frame_pointer ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
for ( struct pso_pointer cursor = list; !c_nilp( cursor);
cursor = cdr( make_frame( 1, frame_pointer, list))) {
count++;
}
struct pso_pointer list = fetch_arg( frame, 0 );
int count = 0;
return make_integer( frame_pointer, count);
for ( struct pso_pointer cursor = list; !c_nilp( cursor );
cursor = cdr( make_frame( 1, frame_pointer, list ) ) ) {
count++;
}
return make_integer( frame_pointer, count );
}

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

@ -17,6 +17,6 @@
#include "payloads/function.h"
struct pso_pointer length( struct pso_pointer frame_pointer);
struct pso_pointer length( struct pso_pointer frame_pointer );
#endif

51
src/c/ops/repl.c
View file

@ -33,6 +33,7 @@
#include "ops/assoc.h"
#include "ops/eval_apply.h"
#include "ops/stack_ops.h"
#include "ops/truth.h"
/**
@ -47,14 +48,14 @@ void int_handler( int dummy ) {
/**
* Very simple read/eval/print loop for bootstrapping.
*/
void c_repl( bool show_prompt ) {
void repl( struct pso_pointer frame_pointer ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
bool show_prompt = c_truep( fetch_arg( frame, 0 ) );
// todo: issue #21: must have stack frame passed in.
signal( SIGINT, int_handler );
debug_print( L"Entered repl\n", DEBUG_REPL, 0 );
// TODO: NULL is not OK here, but will do until we have a REPL in Lisp.
struct pso_pointer env =
consp( oblist ) ? oblist : make_cons( nil, oblist, nil );
struct pso_pointer env = fetch_env( frame_pointer );
struct pso_pointer input_stream = c_assoc( lisp_io_in, env );
struct pso_pointer output_stream = c_assoc( lisp_io_out, env );
@ -72,32 +73,28 @@ void c_repl( bool show_prompt ) {
while ( readp( input_stream ) &&
!url_feof( stream_get_url_file( input_stream ) ) ) {
if ( show_prompt )
c_princ( c_assoc( lisp_io_prompt, env ), output_stream );
princ( make_frame( 2, frame_pointer,
c_assoc( lisp_io_prompt, env ),
output_stream ) );
/* bottom of stack */
struct pso_pointer frame_pointer = make_frame( 1, nil, input_stream );
/* the reason for initialising a new stack for each REPL input is to
* be sure the old stack is fully torn down and reclaimed. Once I'm
* confident of that, TODO: do not start a new stack base each time!
*/
struct pso_pointer base_of_stack =
inc_ref( make_frame_with_env( 0, nil,
consp( oblist ) ? oblist :
make_cons( nil, oblist, nil ) ) );
if ( c_nilp( frame_pointer ) )
break;
struct pso_pointer input = read(
#ifndef MANAGED_POINTER_ONLY
pointer_to_pso4( frame_pointer ),
#endif
frame_pointer, env );
print( make_frame
( 2, base_of_stack,
eval( make_frame
( 1, base_of_stack,
read( make_frame
( 1, base_of_stack, input_stream ) ) ) ),
output_stream ) );
frame_pointer = make_frame( 1, frame_pointer, input );
if ( c_nilp( frame_pointer ) )
break;
struct pso_pointer result = eval(
#ifndef MANAGED_POINTER_ONLY
pointer_to_pso4( frame_pointer ),
#endif
frame_pointer, oblist );
c_print( result, output_stream );
dec_ref( frame_pointer );
dec_ref( base_of_stack );
}
debug_print( L"Leaving repl\n", DEBUG_REPL, 0 );

3
src/c/ops/repl.h
View file

@ -13,8 +13,7 @@
#define SRC_C_OPS_REPL_H_
// todo: issue #21: must have stack frame passed in.
void c_repl( );
void repl( struct pso_pointer frame_pointer );
#endif /* SRC_C_OPS_REPL_H_ */

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

@ -35,7 +35,8 @@
* @return a sequence like the `sequence` passed, but reversed; or `nil` if
* the argument was not a sequence.
*/
struct pso_pointer c_reverse( struct pso_pointer frame_pointer, struct pso_pointer sequence ) {
struct pso_pointer c_reverse( struct pso_pointer frame_pointer,
struct pso_pointer sequence ) {
// todo: issue #21: must have stack frame passed in.
struct pso_pointer result = nil;
@ -49,27 +50,31 @@ struct pso_pointer c_reverse( struct pso_pointer frame_pointer, struct pso_point
case KEYTV:
// TODO: should you be able to reverse keywords and symbols?
result =
make_string_like_thing( frame_pointer, object->payload.string.character,
make_string_like_thing( frame_pointer,
object->payload.string.character,
result, KEYTAG );
break;
case STRINGTV:
result =
make_string_like_thing( frame_pointer, object->payload.string.character,
make_string_like_thing( frame_pointer,
object->payload.string.character,
result, STRINGTAG );
break;
case SYMBOLTV:
// TODO: should you be able to reverse keywords and symbols?
result =
make_string_like_thing( frame_pointer, object->payload.string.character,
make_string_like_thing( frame_pointer,
object->payload.string.character,
result, SYMBOLTAG );
break;
default:
result =
make_exception( make_frame( 1, frame_pointer,
make_cons( frame_pointer,
c_string_to_lisp_string
( frame_pointer, L"Invalid object in sequence" ),
cursor ) ));
make_exception( make_frame( 1, frame_pointer,
make_cons( frame_pointer,
c_string_to_lisp_string
( frame_pointer,
L"Invalid object in sequence" ),
cursor ) ) );
goto exit;
break;
}

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

@ -50,8 +50,7 @@ struct pso_pointer fetch_arg( struct pso4 *frame, unsigned int index ) {
*
* @param frame_pointer a pointer to a stack frame.
*/
struct pso_pointer fetch_env( struct pso_pointer frame_pointer) {
return stackp(frame_pointer) ?
pointer_to_pso4(frame_pointer)->payload.stack_frame.env :
nil;
struct pso_pointer fetch_env( struct pso_pointer frame_pointer ) {
return stackp( frame_pointer ) ?
pointer_to_pso4( frame_pointer )->payload.stack_frame.env : nil;
}

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

@ -27,6 +27,6 @@ extern uint32_t stack_limit;
struct pso_pointer fetch_arg( struct pso4 *frame, unsigned int index );
struct pso_pointer fetch_env( struct pso_pointer frame_pointer);
struct pso_pointer fetch_env( struct pso_pointer frame_pointer );
#endif

54
src/c/ops/truth.c
View file

@ -27,7 +27,7 @@
* @return true if `p` points to `nil`.
* @return false otherwise.
*/
bool c_nilp(struct pso_pointer p) {
bool c_nilp( struct pso_pointer p ) {
return ( p.page == 0 && p.offset == 0 );
}
@ -80,7 +80,7 @@ struct pso_pointer truep( struct pso_pointer frame_pointer ) {
* @param frame_pointer A pointer to the current stack frame;
* @return `t` if the first argument in this frame is not `nil`, else `t`.
*/
struct pso_pointer not( struct pso_pointer frame_pointer) {
struct pso_pointer not( struct pso_pointer frame_pointer ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
return ( !c_nilp( fetch_arg( frame, 0 ) ) ? t : nil );
@ -91,18 +91,19 @@ struct pso_pointer not( struct pso_pointer frame_pointer) {
*
* @return `nil` if any `arg` is `nil`, else `t`.
*/
struct pso_pointer and( struct pso_pointer frame_pointer) {
struct pso4* frame = pointer_to_pso4( frame_pointer);
struct pso_pointer result = t;
for (int arg = 0; c_truep(result) && arg < frame->payload.stack_frame.args; arg++) {
if (c_nilp(fetch_arg(frame, arg))) {
result = nil;
break;
}
}
return result;
struct pso_pointer and( struct pso_pointer frame_pointer ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso_pointer result = t;
for ( int arg = 0;
c_truep( result ) && arg < frame->payload.stack_frame.args; arg++ ) {
if ( c_nilp( fetch_arg( frame, arg ) ) ) {
result = nil;
break;
}
}
return result;
}
@ -111,16 +112,17 @@ struct pso_pointer and( struct pso_pointer frame_pointer) {
*
* @return `t` if any `arg` is non-nil, else `nil`.
*/
struct pso_pointer or( struct pso_pointer frame_pointer) {
struct pso4* frame = pointer_to_pso4( frame_pointer);
struct pso_pointer result = nil;
for (int arg = 0; c_truep(result) && arg < frame->payload.stack_frame.args; arg++) {
if (!c_nilp(fetch_arg(frame, arg))) {
result = t;
break;
}
}
return result;
struct pso_pointer or( struct pso_pointer frame_pointer ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso_pointer result = nil;
for ( int arg = 0;
c_truep( result ) && arg < frame->payload.stack_frame.args; arg++ ) {
if ( !c_nilp( fetch_arg( frame, arg ) ) ) {
result = t;
break;
}
}
return result;
}

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

@ -25,7 +25,7 @@ struct pso_pointer and( struct pso_pointer frame_pointer );
struct pso_pointer or( struct pso_pointer frame_pointer );
bool c_nilp(struct pso_pointer p);
bool c_truep(struct pso_pointer p);
bool c_nilp( struct pso_pointer p );
bool c_truep( struct pso_pointer p );
#endif