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

Another inconclusive session: still nothing works, still making progress.

Browse source
This commit is contained in:
Simon Brooke 2026-04-22 18:16:00 +01:00
parent ef59563e25
commit eed4711fee
35 changed files with 317 additions and 232 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -89,7 +89,7 @@ struct pso_pointer c_interned( struct pso_pointer key,
* @return `true` if a pointer the key was found in the store..
*/
bool c_internedp( struct pso_pointer key, struct pso_pointer store ) {
return !nilp( search( key, store, true ) );
return !c_nilp( search( key, store, true ) );
}
/**
@ -149,5 +149,5 @@ struct pso_pointer internedp(
struct pso_pointer store = or( make_frame( 2, frame_pointer,
fetch_arg( frame, 1 ), frame->payload.stack_frame.env));
return c_internedp( key, store );
return c_internedp( key, store ) ? t : nil;
}

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

@ -66,7 +66,7 @@ bool c_equal( struct pso_pointer a, struct pso_pointer b ) {
case KEYTV:
case STRINGTV:
case SYMBOLTV:
while ( result && !nilp( a ) && !nilp( b ) ) {
while ( result && !c_nilp( a ) && !c_nilp( b ) ) {
if ( pointer_to_object( a )->payload.string.character ==
pointer_to_object( b )->payload.string.character ) {
a = c_cdr( a );
@ -75,7 +75,7 @@ bool c_equal( struct pso_pointer a, struct pso_pointer b ) {
result = false;
}
}
result = result && nilp( a ) && nilp( b );
result = result && c_nilp( a ) && c_nilp( b );
break;
default:
result = false;
@ -109,7 +109,7 @@ struct pso_pointer eq(
if ( frame->payload.stack_frame.args > 1 ) {
for ( int b = 1;
( truep( result ) ) && ( b < frame->payload.stack_frame.args );
( c_truep( result ) ) && ( b < frame->payload.stack_frame.args );
b++ ) {
result =
c_eq( fetch_arg( frame, 0 ), fetch_arg( frame, b ) ) ? t : nil;

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

@ -57,9 +57,10 @@ struct pso_pointer eval(
#ifdef MANAGED_POINTER_ONLY
struct pso4 *frame = pointer_to_pso4( frame_pointer );
#endif
struct pso_pointer result = fetch_arg( frame, 0 );
struct pso_pointer arg = fetch_arg( frame, 0 );
struct pso_pointer result = nil;
switch ( get_tag_value( result ) ) {
switch ( get_tag_value( arg ) ) {
// case CONSTV:
// result = eval_cons( frame, frame_pointer, env);
// break;
@ -67,9 +68,10 @@ struct pso_pointer eval(
case KEYTV:
case STRINGTV:
// self evaluating
result = nil;
break;
case SYMBOLTV:
result = c_assoc( result, fetch_env(frame_pointer) );
arg = c_assoc( arg, fetch_env(frame_pointer) );
break;
// case LAMBDATV:
// result = eval_lambda( frame, frame_pointer, env);
@ -81,34 +83,34 @@ struct pso_pointer eval(
// result = eval_special( frame, frame_pointer, env);
// break;
default:
result =
make_exception( make_cons
( frame, c_string_to_lisp_string
( frame,
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: " ),
result ), frame_pointer, make_cons( frame,
arg ),
make_cons( frame_pointer,
make_cons
( frame,
( frame_pointer,
c_string_to_lisp_keyword
( frame,
( frame_pointer,
L"tag" ),
get_tag_string
( result ) ),
( arg ) ),
nil ),
nil );
nil ));
}
if ( exceptionp( result ) ) {
if ( exceptionp( arg ) ) {
struct pso3 *x =
( struct pso3 * ) pointer_to_object_with_tag_value( result,
( struct pso3 * ) pointer_to_object_with_tag_value( arg,
EXCEPTIONTV );
if ( nilp( x->payload.exception.stack ) ) {
result =
make_exception( x->payload.exception.message, frame_pointer,
nil, result );
if ( c_nilp( x->payload.exception.stack ) ) {
}
}
return result;
return arg;
}

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

@ -12,18 +12,21 @@
#include "memory/pso2.h"
#include "memory/pso4.h"
#include "ops/stack_ops.h"
#include "payloads/stack.h"
#include "ops/truth.h"
struct pso_pointer length( struct pso_pointer frame_pointer) {
struct pso_pointer list = fetch_arg( frame_pointer, 0);
struct pso4* frame = pointer_to_pso4(frame_pointer);
struct pso_pointer list = fetch_arg( frame, 0);
int count = 0;
for ( struct pso_pointer cursor = list; !nilp( cursor);
for ( struct pso_pointer cursor = list; !c_nilp( cursor);
cursor = cdr( make_frame( 1, frame_pointer, list))) {
count++;
}
return make_integer( pointer_to_pso4(frame_pointer), count);
return make_integer( frame_pointer, count);
}

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

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

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

@ -54,7 +54,7 @@ void c_repl( bool show_prompt ) {
// 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( NULL, oblist, nil );
consp( oblist ) ? oblist : make_cons( nil, oblist, nil );
struct pso_pointer input_stream = c_assoc( lisp_io_in, env );
struct pso_pointer output_stream = c_assoc( lisp_io_out, env );
@ -77,7 +77,7 @@ void c_repl( bool show_prompt ) {
/* bottom of stack */
struct pso_pointer frame_pointer = make_frame( 1, nil, input_stream );
if ( nilp( frame_pointer ) )
if ( c_nilp( frame_pointer ) )
break;
struct pso_pointer input = read(
#ifndef MANAGED_POINTER_ONLY
@ -86,7 +86,7 @@ void c_repl( bool show_prompt ) {
frame_pointer, env );
frame_pointer = make_frame( 1, frame_pointer, input );
if ( nilp( frame_pointer ) )
if ( c_nilp( frame_pointer ) )
break;
struct pso_pointer result = eval(

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

@ -35,39 +35,41 @@
* @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 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;
for ( struct pso_pointer cursor = sequence; !nilp( sequence );
for ( struct pso_pointer cursor = sequence; !c_nilp( sequence );
cursor = c_cdr( cursor ) ) {
struct pso2 *object = pointer_to_object( cursor );
switch ( get_tag_value( cursor ) ) {
case CONSTV:
result = make_cons( c_car( cursor ), result );
result = make_cons( frame_pointer, 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,
make_string_like_thing( frame_pointer, object->payload.string.character,
result, KEYTAG );
break;
case STRINGTV:
result =
make_string_like_thing( 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( object->payload.string.character,
make_string_like_thing( frame_pointer, object->payload.string.character,
result, SYMBOLTAG );
break;
default:
result =
make_exception( make_cons( c_string_to_lisp_string
( L"Invalid object in sequence" ),
cursor ), nil, nil, nil );
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;
}

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

@ -46,7 +46,7 @@ uint32_t calculate_hash( wint_t c, struct pso_pointer ptr ) {
case KEYTV:
case STRINGTV:
case SYMBOLTV:
if ( nilp( cell->payload.string.cdr ) ) {
if ( c_nilp( cell->payload.string.cdr ) ) {
result = ( uint32_t ) c;
} else {
result =
@ -69,12 +69,12 @@ uint32_t calculate_hash( wint_t c, struct pso_pointer ptr ) {
* char32_t in larger pso classes, so this function may be only for strings
* (and thus simpler).
*/
struct pso_pointer make_string_like_thing( struct pso4 *frame_pointer,
struct pso_pointer make_string_like_thing( struct pso_pointer frame_pointer,
wint_t c, struct pso_pointer tail,
char *tag ) {
struct pso_pointer pointer = tail;
if ( check_type( tail, tag ) || nilp( tail ) ) {
if ( check_type( tail, tag ) || c_nilp( tail ) ) {
pointer = allocate( frame_pointer, tag, CONS_SIZE_CLASS );
struct pso2 *cell = pointer_to_object( pointer );
@ -107,7 +107,7 @@ struct pso_pointer make_string_like_thing( struct pso4 *frame_pointer,
* @param c the character to add (prepend);
* @param tail the string which is being built.
*/
struct pso_pointer make_string( struct pso4 *frame_pointer, wint_t c,
struct pso_pointer make_string( struct pso_pointer frame_pointer, wint_t c,
struct pso_pointer tail ) {
return make_string_like_thing( frame_pointer, c, tail, STRINGTAG );
}
@ -120,7 +120,7 @@ struct pso_pointer make_string( struct pso4 *frame_pointer, wint_t c,
* @param c the character to add (prepend);
* @param tail the keyword which is being built.
*/
struct pso_pointer make_keyword( struct pso4 *frame_pointer, wint_t c,
struct pso_pointer make_keyword( struct pso_pointer frame_pointer, wint_t c,
struct pso_pointer tail ) {
return make_string_like_thing( frame_pointer, c, tail, KEYTAG );
}
@ -133,7 +133,7 @@ struct pso_pointer make_keyword( struct pso4 *frame_pointer, wint_t c,
* @param c the character to add (prepend);
* @param tail the symbol which is being built.
*/
struct pso_pointer make_symbol( struct pso4 *frame_pointer, wint_t c,
struct pso_pointer make_symbol( struct pso_pointer frame_pointer, wint_t c,
struct pso_pointer tail ) {
return make_string_like_thing( frame_pointer, c, tail, SYMBOLTAG );
}
@ -142,7 +142,7 @@ struct pso_pointer make_symbol( struct pso4 *frame_pointer, wint_t c,
/**
* Return a lisp string representation of this wide character string.
*/
struct pso_pointer c_string_to_lisp_string( struct pso4 *frame_pointer,
struct pso_pointer c_string_to_lisp_string( struct pso_pointer frame_pointer,
char32_t *string ) {
struct pso_pointer result = nil;
@ -164,7 +164,7 @@ struct pso_pointer c_string_to_lisp_string( struct pso4 *frame_pointer,
* 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( struct pso4 *frame_pointer,
struct pso_pointer c_string_to_lisp_symbol( struct pso_pointer frame_pointer,
char32_t *symbol ) {
struct pso_pointer result = nil;
@ -183,7 +183,7 @@ struct pso_pointer c_string_to_lisp_symbol( struct pso4 *frame_pointer,
* Return a lisp keyword representation of this wide character string. In
* keywords, I am accepting only lower case characters and numbers.
*/
struct pso_pointer c_string_to_lisp_keyword( struct pso4 *frame_pointer,
struct pso_pointer c_string_to_lisp_keyword( struct pso_pointer frame_pointer,
char32_t *symbol ) {
struct pso_pointer result = nil;

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

@ -17,26 +17,26 @@
#include <wchar.h>
#include <wctype.h>
struct pso_pointer make_string_like_thing( struct pso4 *frame_pointer,
struct pso_pointer make_string_like_thing( struct pso_pointer frame_pointer,
wint_t c, struct pso_pointer tail,
char *tag );
struct pso_pointer make_string( struct pso4 *frame_pointer, wint_t c,
struct pso_pointer make_string( struct pso_pointer frame_pointer, wint_t c,
struct pso_pointer tail );
struct pso_pointer make_keyword( struct pso4 *frame_pointer, wint_t c,
struct pso_pointer make_keyword( struct pso_pointer frame_pointer, wint_t c,
struct pso_pointer tail );
struct pso_pointer make_symbol( struct pso4 *frame_pointer, wint_t c,
struct pso_pointer make_symbol( struct pso_pointer frame_pointer, wint_t c,
struct pso_pointer tail );
struct pso_pointer c_string_to_lisp_string( struct pso4 *frame_pointer,
struct pso_pointer c_string_to_lisp_string( struct pso_pointer frame_pointer,
char32_t * string );
struct pso_pointer c_string_to_lisp_keyword( struct pso4 *frame_pointer,
struct pso_pointer c_string_to_lisp_keyword( struct pso_pointer frame_pointer,
char32_t * symbol );
struct pso_pointer c_string_to_lisp_symbol( struct pso4 *frame_pointer,
struct pso_pointer c_string_to_lisp_symbol( struct pso_pointer frame_pointer,
char32_t * symbol );
#endif

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

@ -27,21 +27,10 @@
* @return true if `p` points to `nil`.
* @return false otherwise.
*/
bool nilp( struct pso_pointer p ) {
bool c_nilp(struct pso_pointer p) {
return ( p.page == 0 && p.offset == 0 );
}
/**
* @brief Return `true` if `p` points to `nil`, else `false`.
*
* @param p a pointer
* @return true if `p` points to `nil`;
* @return false otherwise.
*/
bool not( struct pso_pointer p ) {
return !nilp( p );
}
/**
* @brief `true` if `p` points to `t`, else `false`.
*
@ -56,52 +45,82 @@ bool not( struct pso_pointer p ) {
* @return true if `p` points to `t`.
* @return false otherwise.
*/
bool truep( struct pso_pointer p ) {
bool c_truep( struct pso_pointer p ) {
return ( p.page == 0 && p.offset == 4 );
}
/**
* @brief return `t` if the first argument in this frame is `nil`, else `t`.
*
* @param frame The current stack frame;
* @param frame_pointer A pointer to the current stack frame;
* @param env the evaluation environment.
* @return `t` if the first argument in this frame is `nil`, else `t`
*/
struct pso_pointer lisp_nilp( struct pso_pointer frame_pointer,
struct pso_pointer env ) {
struct pso_pointer nilp( struct pso_pointer frame_pointer ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
return ( nilp( fetch_arg( frame, 0 ) ) ? t : nil );
return ( c_nilp( fetch_arg( frame, 0 ) ) ? t : nil );
}
/**
* @brief return `t` if the first argument in this frame is `t`, else `nil`.
*
* @param frame The current stack frame;
* @param frame_pointer A pointer to the current stack frame;
* @param env the evaluation environment.
* @return `t` if the first argument in this frame is `t`, else `nil`.
*/
struct pso_pointer lisp_truep( struct pso_pointer frame_pointer,
struct pso_pointer env ) {
struct pso_pointer truep( struct pso_pointer frame_pointer ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
return ( truep( fetch_arg( frame, 0 ) ) ? t : nil );
return ( c_truep( fetch_arg( frame, 0 ) ) ? t : nil );
}
/**
* @brief return `t` if the first argument in this frame is not `nil`, else
* `t`.
*
* @param frame The current stack frame;
* @param frame_pointer A pointer to the current stack frame;
* @param env the evaluation environment.
* @return `t` if the first argument in this frame is not `nil`, else `t`.
*/
struct pso_pointer lisp_not( struct pso_pointer frame_pointer,
struct pso_pointer env ) {
struct pso_pointer not( struct pso_pointer frame_pointer) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
return ( not( fetch_arg( frame, 0 ) ) ? t : nil );
return ( !c_nilp( fetch_arg( frame, 0 ) ) ? t : nil );
}
/**
* @brief (and args...)
*
* @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;
}
/**
* @brief (or args...)
*
* @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;
}

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

@ -14,21 +14,18 @@
#include <stdbool.h>
#include "memory/pointer.h"
#include "memory/pso4.h"
bool nilp( struct pso_pointer p );
struct pso_pointer nilp( struct pso_pointer frame_pointer );
struct pso_pointer lisp_nilp( struct pso_pointer frame_pointer,
struct pso_pointer env );
struct pso_pointer not( struct pso_pointer frame_pointer );
bool not( struct pso_pointer p );
struct pso_pointer truep( struct pso_pointer frame_pointer );
struct pso_pointer lisp_not( struct pso_pointer frame_pointer,
struct pso_pointer env );
struct pso_pointer and( struct pso_pointer frame_pointer );
bool truep( struct pso_pointer p );
struct pso_pointer or( struct pso_pointer frame_pointer );
struct pso_pointer lisp_truep( struct pso_pointer frame_pointer,
struct pso_pointer env );
bool c_nilp(struct pso_pointer p);
bool c_truep(struct pso_pointer p);
#endif