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

Started work on binding functions. Not yet complete.

Browse source
This commit is contained in:
Simon Brooke 2026-05-04 16:15:57 +01:00
parent f4303247b9
commit efa6a3246d
17 changed files with 321 additions and 41 deletions
Download patch file Download diff file Expand all files Collapse all files

175
src/c/environment/function_bindings.c Normal file
View file

@ -0,0 +1,175 @@
/**
* environment/function_bindings.c
*
* Post Scarcity Software Environment:
*
* Provide bindings for substrate functions. At least in theory, these
* bindings only need to be initialised on node zero.
* todo: they really ought to be in a namespace ::system:bootstrap, once I
* have namespaces and paths working.
*
* (c) 2026 Simon Brooke <simon@journeyman.cc>
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#include <stdbool.h>
#include <wchar.h>
#include "environment/privileged_keywords.h"
#include "memory/node.h"
#include "memory/pointer.h"
#include "memory/tags.h"
#include "ops/assoc.h"
#include "ops/bind.h"
#include "ops/cond.h"
#include "ops/eval_apply.h"
#include "ops/eq.h"
#include "ops/inspect.h"
#include "ops/stack_ops.h"
#include "ops/string_ops.h"
#include "payloads/cons.h"
#include "payloads/function.h"
#include "payloads/special.h"
/**
* Bind this compiled `executable` function, as a Lisp function, to
* this name in the `oblist`.
* \todo where a function is not compiled from source, we could cache
* the name on the source pointer. Would make stack frames potentially
* more readable and aid debugging generally.
*/
struct pso_pointer
bind_function(struct pso_pointer frame_pointer, wchar_t *name, wchar_t *doc,
struct pso_pointer (*executable)(struct pso_pointer)) {
struct pso_pointer result = fetch_env(frame_pointer);
struct pso_pointer n = c_string_to_lisp_symbol(frame_pointer, name);
struct pso_pointer d = c_string_to_lisp_string(frame_pointer, doc);
struct pso_pointer meta =
make_cons( frame_pointer, make_cons( frame_pointer, privileged_keyword_bootstrap, nil),
make_cons( frame_pointer, make_cons( frame_pointer, privileged_keyword_name, n),
make_cons( frame_pointer, make_cons( frame_pointer, privileged_keyword_documentation, d), nil)));
struct pso_pointer r = make_function(frame_pointer, meta, executable);
if (!exceptionp(r)) {
result = make_cons( frame_pointer, make_cons( frame_pointer, n, r), result);
}
return result;
}
/**
* Bind this compiled `executable` function, as a Lisp special form, to
* this `name` in the `oblist`.
*/
struct pso_pointer
bind_special(struct pso_pointer frame_pointer, wchar_t *name, wchar_t *doc,
struct pso_pointer (*executable)(struct pso_pointer)) {
struct pso_pointer result = fetch_env(frame_pointer);
struct pso_pointer n = c_string_to_lisp_symbol(frame_pointer, name);
struct pso_pointer d = c_string_to_lisp_string(frame_pointer, doc);
struct pso_pointer meta =
make_cons( frame_pointer, make_cons( frame_pointer, privileged_keyword_bootstrap, nil),
make_cons( frame_pointer, make_cons( frame_pointer, privileged_keyword_name, n),
make_cons( frame_pointer, make_cons( frame_pointer, privileged_keyword_documentation, d), nil)));
struct pso_pointer r = make_special(frame_pointer, meta, executable);
if (!exceptionp(r)) {
result = make_cons( frame_pointer, make_cons( frame_pointer, n, r), result);
}
return result;
}
struct function_data {
char32_t *name;
char32_t *documentation;
void* executable;
};
/* right, the problem with all those pretty '#ifdefs' which might allow us to
* simply switch functions on and off just by including or not including .h
* files is that the C compiler is too primitive to know how many items there
* are in an array. So this number must be edited manually, and must be right.
*/
#define N_FUNCTION_INITIALISERS 4
/** initialisers for functions */
struct function_data function_initialisers[] = {
#ifdef __psse_ops_assoc_h
{U"assoc",
U"(assoc key store): search `store` for the value associated with "
U"`key`.",
&assoc},
#endif
#ifdef __psse_ops_bind_h
{U"bind!",
U"(bind! key value store): bind `key` to `value` in this store, modifying "
U"the store if it is writable to the user, otherwise returning a new "
U"store",
&bind},
#endif
#ifdef __psse_ops_eq_h
{U"eq",
U"(eq args...): shallow, cheap equality; returns `t` if all `args...` "
U"are the same object, else `nil`.",
&eq},
{U"equal",
U"(equal a b): expensive, deep equality: returns `t` if objects `a` "
U"and `b` have recursively equal value.",
&equal},
#endif
#ifdef __psse_ops_eval_apply_h
// TODO: there's a lot of other stuff in eval_apply.c, which ought to be in
// other files but at present isn't.
{U"apply",
U"(apply fn args...): apply this `fn` to these `args...` and return "
U"their value.",
&lisp_apply},
{U"eval",
U"(eval expression): evaluate this `expression` and return its value",
&lisp_eval},
#endif
#ifdef __psse_ops_inspect_h
{
U"inspect",
U"(inspect expr), (inspect expr write-stream): inspect one complete "
U"lisp expression and return `nil`. If `write-stream` is specified and "
U"is a write stream, then print to that stream, else to the stream "
U"which is the value of `*out*` in the environment.",
&lisp_inspect
},
#endif
};
/* right, the problem with all those pretty '#ifdefs' which might allow us to
* simply switch functions on and off just by including or not including .h
* files is that the C compiler is too primitive to know how many items there
* are in an array */
#define N_SPECIAL_INITIALISERS 1
/** initialisers for special forms */
struct function_data special_initialisers[] = {
#ifdef __psse_ops_cond_h
{U"cond",
U"(cond clauses...): conditional. Each `clause` is expected to be a "
U"list; if the first item in such a list evaluates to non-nil, the "
U"remaining items in that list are evaluated in turn and the value of "
U"the last returned. If no arg `clause` has a first element which "
U"evaluates to non nil, then nil is returned",
&lisp_cond},
#endif
};
struct pso_pointer
initialise_function_bindings(struct pso_pointer frame_pointer) {
struct pso_pointer result = fetch_env(frame_pointer);
return result;
}

0
src/c/environment/function_bindings.h Normal file
View file

11
src/c/environment/privileged_keywords.c
View file

@ -23,6 +23,13 @@
#include "ops/string_ops.h"
/**
* layer metadata for functions written in C
*/
struct pso_pointer privileged_keyword_bootstrap;
struct pso_pointer privileged_keyword_documentation;
/**
* location metadata for exceptions (and possibly location in other contexts).
*/
@ -37,7 +44,9 @@ struct pso_pointer privileged_keyword_name;
#define load_and_lock(var,val)var = lock_object(c_string_to_lisp_keyword(nil, val))
struct pso_pointer initialise_privileged_keywords( struct pso_pointer env){
struct pso_pointer initialise_privileged_keywords(struct pso_pointer env) {
load_and_lock(privileged_keyword_bootstrap, PK_BOOTSTRAP);
load_and_lock(privileged_keyword_documentation, PK_DOCUMENTATION);
load_and_lock(privileged_keyword_location, PK_LOCATION);
load_and_lock( privileged_keyword_name, PK_NAME);
}

8
src/c/environment/privileged_keywords.h
View file

@ -3,7 +3,7 @@
*
* Post Scarcity Soctware Environment
*
* TODO: Edit purpose.
* Keywords guaranteed to be present in the environment on each node.
*
* Copyright (c): 27 Apr 2026 Simon Brooke <simon@journeyman.cc>
* Licensed under GPL version 2.0, or, at your option, any later version.
@ -11,11 +11,15 @@
#ifndef SRC_C_ENVIRONMENT_PRIVILEGED_KEYWORDS_H_
#define SRC_C_ENVIRONMENT_PRIVILEGED_KEYWORDS_H_
#include "memory/pointer.h"
#define PK_BOOTSTRAP U"bootstrap"
#define PK_DOCUMENTATION U"documentation"
#define PK_LOCATION U"location"
#define PK_NAME U"name"
#include "memory/pointer.h"
extern struct pso_pointer privileged_keyword_bootstrap;
extern struct pso_pointer privileged_keyword_documentation;
extern struct pso_pointer privileged_keyword_location;
extern struct pso_pointer privileged_keyword_name;

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

@ -115,13 +115,8 @@ bool c_internedp( struct pso_pointer key, struct pso_pointer store ) {
* @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 ) {
#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 ),

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

@ -16,6 +16,8 @@
#include "memory/pointer.h"
struct pso_pointer assoc(struct pso_pointer frame_pointer);
struct pso_pointer search( struct pso_pointer key,
struct pso_pointer store, bool return_key );

31
src/c/ops/cond.c
View file

@ -8,6 +8,7 @@
#include "memory/node.h"
#include "memory/pointer.h"
#include "memory/pso2.h"
#include "memory/pso4.h"
#include "memory/tags.h"
#include "ops/eval_apply.h"
@ -29,12 +30,12 @@
*/
struct pso_pointer eval_cond_clause( struct pso_pointer clause,
struct pso4 *frame,
struct pso_pointer frame_pointer,
struct pso_pointer env ) {
struct pso_pointer result = nil;
struct pso_pointer frame_pointer) {
struct pso_pointer result = nil;
struct pso_pointer env = fetch_env(frame_pointer);
#ifdef DEBUG
debug_print( L"\n\tCond clause: ", DEBUG_EVAL, 0 );
debug_print( U"\n\tCond clause: ", DEBUG_EVAL, 0 );
debug_print_object( clause, DEBUG_EVAL, 0 );
debug_println( DEBUG_EVAL);
#endif
@ -49,19 +50,19 @@ struct pso_pointer eval_cond_clause( struct pso_pointer clause,
c_progn( frame, frame_pointer, c_cdr( clause ), env ) );
#ifdef DEBUG
debug_print( L"\n\t\tCond clause ", DEBUG_EVAL, 0 );
debug_print( U"\n\t\tCond clause ", DEBUG_EVAL, 0 );
debug_print_object( clause, DEBUG_EVAL, 0 );
debug_print( L" succeeded; returning: ", DEBUG_EVAL, 0 );
debug_print( U" succeeded; returning: ", DEBUG_EVAL, 0 );
debug_print_object( result, DEBUG_EVAL, 0 );
debug_println( DEBUG_EVAL);
} else {
debug_print( L"\n\t\tCond clause ", DEBUG_EVAL, 0 );
debug_print( U"\n\t\tCond clause ", DEBUG_EVAL, 0 );
debug_print_object( clause, DEBUG_EVAL, 0 );
debug_print( L" failed.\n", DEBUG_EVAL, 0 );
debug_print( U" failed.\n", DEBUG_EVAL, 0 );
#endif
}
} else {
result = throw_exception( c_string_to_lisp_symbol( frame_pointer, L"cond" ),
result = throw_exception( c_string_to_lisp_symbol( frame_pointer, U"cond" ),
c_string_to_lisp_string
(frame_pointer, L"Arguments to `cond` must be lists" ),
frame_pointer );
@ -78,14 +79,10 @@ struct pso_pointer eval_cond_clause( struct pso_pointer clause,
*
* * (cond clauses...)
*
* @param frame my stack frame.
* @param frame_pointer a pointer to my pso4.
* @param env the environment in which arguments will be evaluated.
* @return the value of the last expression of the first successful `clause`.
*/
struct pso_pointer
lisp_cond( struct pso4 *frame, struct pso_pointer frame_pointer,
struct pso_pointer env ) {
struct pso_pointer lisp_cond(struct pso_pointer frame_pointer) {
struct pso4 *frame = pointer_to_pso4(frame_pointer);
struct pso_pointer result = nil;
bool done = false;
@ -97,7 +94,7 @@ lisp_cond( struct pso4 *frame, struct pso_pointer frame_pointer,
// to nil, the form still succeeded and we should still exit `cond`.
//
result = eval_cond_clause( clause_pointer, frame, frame_pointer, env );
result = eval_cond_clause( clause_pointer, frame, frame_pointer );
if ( !c_nilp( result ) && c_truep( c_car( result ) ) ) {
result = c_cdr( result );
@ -106,7 +103,7 @@ lisp_cond( struct pso4 *frame, struct pso_pointer frame_pointer,
}
}
#ifdef DEBUG
debug_print( L"\tCond returning: ", DEBUG_EVAL, 0 );
debug_print( U"\tCond returning: ", DEBUG_EVAL, 0 );
debug_print_object( result, DEBUG_EVAL, 0 );
debug_println( DEBUG_EVAL);
#endif

20
src/c/ops/cond.h Normal file
View file

@ -0,0 +1,20 @@
/**
* ops/cond.h
*
* Post Scarcity Software Environment: cond.
*
* cond a name to a value in a store.
*
* (c) 2026 Simon Brooke <simon@journeyman.cc>
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#ifndef __psse_ops_cond_h
#define __psse_ops_cond_h
#include "memory/pointer.h"
struct pso_pointer lisp_cond( struct pso_pointer frame_pointer );
#endif

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

@ -131,7 +131,7 @@ struct pso_pointer eq(
* * symbols
* * strings
*
* * (equal? arg1 qrg2)
* * (equal? arg1 arg2)
*
* @return `t` if all args are pointers to the same object, else `nil`;
*/

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

@ -260,8 +260,7 @@ struct pso_pointer eval_forms( struct pso_pointer frame_pointer ) {
*
* This is experimental. It almost certainly WILL change.
*/
struct pso_pointer lisp_try( struct pso_pointer frame_pointer,
struct pso_pointer env ) {
struct pso_pointer lisp_try( struct pso_pointer frame_pointer) {
struct pso_pointer result = nil;
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso_pointer body_frame =
@ -301,8 +300,7 @@ struct pso_pointer lisp_try( struct pso_pointer frame_pointer,
* @return the root namespace.
*/
struct pso_pointer
lisp_oblist( struct pso4 *frame, struct pso_pointer frame_pointer,
struct pso_pointer env ) {
lisp_oblist( struct pso4 *frame, struct pso_pointer frame_pointer) {
return oblist;
}
@ -750,9 +748,6 @@ struct pso_pointer lisp_apply( struct pso_pointer frame_pointer) {
*
* * (eval expression)
*
* @param frame my pso4.
* @param frame_pointer a pointer to my pso4.
* @param env my environment.
* @return
* * If `expression` is a number, string, `nil`, or `t`, returns `expression`.
* * If `expression` is a symbol, returns the value that expression is bound

5
src/c/ops/inspect.c
View file

@ -21,10 +21,7 @@
#include "ops/stack_ops.h"
/**
* Function: dump/inspect one complete lisp expression and return nil. If
* write-stream is specified and is a write stream, then print to that stream,
* else the stream which is the value of
* `*out*` in the environment.
* Function: dump/
*
* * (inspect expr)
* * (inspect expr write-stream)

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

@ -9,8 +9,8 @@
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#ifndef psse_ops_inspect
#define psse_ops_inspect
#ifndef psse_ops_inspect_h
#define psse_ops_inspect_h
#include "memory/pointer.h"

25
src/c/payloads/function.c Normal file
View file

@ -0,0 +1,25 @@
/**
* payloads/function.c
*
* an ordinary Lisp function - one whose arguments are pre-evaluated.
*
* (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/tags.h"
struct pso_pointer make_function(
struct pso_pointer frame_pointer, struct pso_pointer meta,
struct pso_pointer (*executable)(struct pso_pointer frame_pointer)) {
struct pso_pointer result = allocate(frame_pointer, FUNCTIONTAG, 2);
struct pso2 *object = pointer_to_object(result);
object->payload.function.meta = meta;
object->payload.function.executable = executable;
return result;
}

4
src/c/payloads/function.h
View file

@ -39,4 +39,8 @@ struct function_payload {
struct pso_pointer ( *executable ) ( struct pso_pointer frame_pointer );
};
struct pso_pointer make_function(
struct pso_pointer frame_pointer, struct pso_pointer meta,
struct pso_pointer (*executable)(struct pso_pointer frame_pointer));
#endif

25
src/c/payloads/special.c Normal file
View file

@ -0,0 +1,25 @@
/**
* payloads/special.c
*
* a special Lisp function - one whose arguments are **not** pre-evaluated.
*
* (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/tags.h"
struct pso_pointer make_special(
struct pso_pointer frame_pointer, struct pso_pointer meta,
struct pso_pointer (*executable)(struct pso_pointer frame_pointer)) {
struct pso_pointer result = allocate(frame_pointer, SPECIALTAG, 2);
struct pso2 *object = pointer_to_object(result);
object->payload.special.meta = meta;
object->payload.special.executable = executable;
return result;
}

6
src/c/payloads/special.h
View file

@ -18,8 +18,12 @@
/**
* A special form - one whose arguments are not pre-evaluated but passed as
* provided.
* provided. Shares payload with function, q.v.
* \see NLAMBDATAG.
*/
struct pso_pointer make_special(
struct pso_pointer frame_pointer, struct pso_pointer meta,
struct pso_pointer (*executable)(struct pso_pointer frame_pointer));
#endif