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

I *think* that's all the bootstrap functions being bound in the environment.

Browse source
This commit is contained in:
Simon Brooke 2026-05-04 18:23:46 +01:00
parent efa6a3246d
commit fcfdb43b05
8 changed files with 184 additions and 54 deletions
Download patch file Download diff file Expand all files Collapse all files

34
src/c/environment/environment.c
View file

@ -11,6 +11,7 @@
#include "debug.h" #include "debug.h"
#include "environment/function_bindings.h"
#include "memory/memory.h" #include "memory/memory.h"
#include "memory/node.h" #include "memory/node.h"
#include "memory/pointer.h" #include "memory/pointer.h"
@ -21,11 +22,11 @@
#include "ops/bind.h" #include "ops/bind.h"
#include "ops/string_ops.h" #include "ops/string_ops.h"
#include "payloads/cons.h"
#include "payloads/exception.h"
#include "payloads/psse_string.h" #include "payloads/psse_string.h"
#include "ops/stack_ops.h"
#include "ops/truth.h" #include "ops/truth.h"
#include "payloads/stack.h"
/** /**
* @brief Flag to prevent re-initialisation. * @brief Flag to prevent re-initialisation.
@ -44,7 +45,7 @@ struct pso_pointer initialise_environment( uint32_t node ) {
struct pso_pointer frame_pointer = nil; // can't have a frame pointer before we've initialised nil and t struct pso_pointer frame_pointer = nil; // can't have a frame pointer before we've initialised nil and t
if ( c_truep( result ) ) { if ( c_truep( result ) ) {
debug_print( L"Initialising `nil`... ", DEBUG_BOOTSTRAP, 0 ); debug_print( U"Initialising `nil`... ", DEBUG_BOOTSTRAP, 0 );
struct pso_pointer n = allocate( frame_pointer, NILTAG, 2 ); struct pso_pointer n = allocate( frame_pointer, NILTAG, 2 );
if ( ( n.page == 0 ) && ( n.offset == 0 ) ) { if ( ( n.page == 0 ) && ( n.offset == 0 ) ) {
@ -54,14 +55,14 @@ struct pso_pointer initialise_environment( uint32_t node ) {
nil = n; nil = n;
lock_object( nil ); lock_object( nil );
debug_print( L"success\n", DEBUG_BOOTSTRAP, 0 ); debug_print( U"success\n", DEBUG_BOOTSTRAP, 0 );
} else { } else {
result = nil; result = nil;
debug_print( L"fail\n", DEBUG_BOOTSTRAP, 0 ); debug_print( U"fail\n", DEBUG_BOOTSTRAP, 0 );
} }
} }
if ( !c_nilp( result ) ) { if ( !c_nilp( result ) ) {
debug_print( L"Initialising `t`... ", DEBUG_BOOTSTRAP, 0 ); debug_print( U"Initialising `t`... ", DEBUG_BOOTSTRAP, 0 );
struct pso_pointer n = allocate( frame_pointer, TRUETAG, 2 ); struct pso_pointer n = allocate( frame_pointer, TRUETAG, 2 );
// offset is in words, and size of a pso2 is four words // offset is in words, and size of a pso2 is four words
@ -72,36 +73,39 @@ struct pso_pointer initialise_environment( uint32_t node ) {
t = n; t = n;
lock_object( t ); lock_object( t );
debug_print( L"success\n", DEBUG_BOOTSTRAP, 0 ); debug_print( U"success\n", DEBUG_BOOTSTRAP, 0 );
} else { } else {
result = nil; result = nil;
debug_print( L"fail\n", DEBUG_BOOTSTRAP, 0 ); debug_print( U"fail\n", DEBUG_BOOTSTRAP, 0 );
} }
} }
if ( !exceptionp( result ) ) { if ( !exceptionp( result ) ) {
result = result =
lisp_bind( make_frame lisp_bind( make_frame
( 3, frame_pointer, ( 3, frame_pointer,
c_string_to_lisp_symbol( frame_pointer, L"nil" ), nil, c_string_to_lisp_symbol( frame_pointer, U"niU" ), nil,
nil ) ); nil ) );
debug_print( L"Environment after binding `nil`: ", DEBUG_BOOTSTRAP, debug_print( U"Environment after binding `nil`: ", DEBUG_BOOTSTRAP,
0 ); 0 );
debug_print_object( result, DEBUG_BOOTSTRAP, 0 ); debug_print_object( result, DEBUG_BOOTSTRAP, 0 );
result = result =
lisp_bind( make_frame lisp_bind( make_frame
( 3, frame_pointer, ( 3, frame_pointer,
c_string_to_lisp_symbol( frame_pointer, L"t" ), t, c_string_to_lisp_symbol( frame_pointer, U"t" ), t,
result ) ); result ) );
environment_initialised = true; environment_initialised = true;
debug_print( L"Environment after binding `t`: ", DEBUG_BOOTSTRAP, 0 ); debug_print( U"Environment after binding `t`: ", DEBUG_BOOTSTRAP, 0 );
debug_print_object( result, DEBUG_BOOTSTRAP, 0 ); debug_print_object( result, DEBUG_BOOTSTRAP, 0 );
debug_print( L"\nEnvironment initialised successfully.\n", debug_print( U"\nEnvironment initialised successfully.\n",
DEBUG_BOOTSTRAP, 0 ); DEBUG_BOOTSTRAP, 0 );
} }
dec_ref( frame_pointer ); result = initialise_function_bindings(push_local(
frame_pointer, make_frame_with_env(0, frame_pointer, result)));
return result; dec_ref(frame_pointer);
return result;
} }

155
src/c/environment/function_bindings.c
View file

@ -13,8 +13,10 @@
*/ */
#include <stdbool.h> #include <stdbool.h>
#include <stdlib.h>
#include <wchar.h> #include <wchar.h>
#include "debug.h"
#include "environment/privileged_keywords.h" #include "environment/privileged_keywords.h"
#include "memory/node.h" #include "memory/node.h"
#include "memory/pointer.h" #include "memory/pointer.h"
@ -23,15 +25,24 @@
#include "ops/assoc.h" #include "ops/assoc.h"
#include "ops/bind.h" #include "ops/bind.h"
#include "ops/cond.h" #include "ops/cond.h"
#include "ops/eval_apply.h"
#include "ops/eq.h" #include "ops/eq.h"
#include "ops/eval_apply.h"
#include "ops/inspect.h" #include "ops/inspect.h"
#include "ops/keys.h"
#include "ops/list_ops.h"
#include "ops/mapcar.h"
#include "ops/progn.h"
#include "ops/quote.h"
#include "ops/repl.h"
#include "ops/reverse.h"
#include "ops/stack_ops.h" #include "ops/stack_ops.h"
#include "ops/string_ops.h" #include "ops/string_ops.h"
#include "ops/truth.h"
#include "payloads/cons.h" #include "payloads/cons.h"
#include "payloads/function.h" #include "payloads/function.h"
#include "payloads/special.h" #include "payloads/special.h"
#include "payloads/stack.h"
/** /**
* Bind this compiled `executable` function, as a Lisp function, to * Bind this compiled `executable` function, as a Lisp function, to
@ -42,21 +53,31 @@
*/ */
struct pso_pointer struct pso_pointer
bind_function(struct pso_pointer frame_pointer, wchar_t *name, wchar_t *doc, bind_function(struct pso_pointer frame_pointer, char32_t *name, char32_t *doc,
struct pso_pointer (*executable)(struct pso_pointer)) { struct pso_pointer (*executable)(struct pso_pointer)) {
struct pso_pointer result = fetch_env(frame_pointer); struct pso_pointer result = fetch_env(frame_pointer);
struct pso_pointer n = c_string_to_lisp_symbol(frame_pointer, name); 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 d = c_string_to_lisp_string(frame_pointer, doc);
struct pso_pointer meta = struct pso_pointer meta = make_cons(
make_cons( frame_pointer, make_cons( frame_pointer, privileged_keyword_bootstrap, nil), frame_pointer,
make_cons( frame_pointer, make_cons( frame_pointer, privileged_keyword_name, n), make_cons(frame_pointer, privileged_keyword_bootstrap, nil),
make_cons( frame_pointer, make_cons( frame_pointer, privileged_keyword_documentation, d), 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); struct pso_pointer r = make_function(frame_pointer, meta, executable);
debug_print(doc, DEBUG_BOOTSTRAP, 0);
if (!exceptionp(r)) { if (!exceptionp(r)) {
result = make_cons( frame_pointer, make_cons( frame_pointer, n, r), result); debug_print(U"... bound\n", DEBUG_BOOTSTRAP, 0);
result =
make_cons(frame_pointer, make_cons(frame_pointer, n, r), result);
} else {
debug_print(U"... failed to bind\n", DEBUG_BOOTSTRAP, 0);
} }
return result; return result;
@ -67,21 +88,31 @@ bind_function(struct pso_pointer frame_pointer, wchar_t *name, wchar_t *doc,
* this `name` in the `oblist`. * this `name` in the `oblist`.
*/ */
struct pso_pointer struct pso_pointer
bind_special(struct pso_pointer frame_pointer, wchar_t *name, wchar_t *doc, bind_special(struct pso_pointer frame_pointer, char32_t *name, char32_t *doc,
struct pso_pointer (*executable)(struct pso_pointer)) { struct pso_pointer (*executable)(struct pso_pointer)) {
struct pso_pointer result = fetch_env(frame_pointer); struct pso_pointer result = fetch_env(frame_pointer);
struct pso_pointer n = c_string_to_lisp_symbol(frame_pointer, name); 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 d = c_string_to_lisp_string(frame_pointer, doc);
struct pso_pointer meta = struct pso_pointer meta = make_cons(
make_cons( frame_pointer, make_cons( frame_pointer, privileged_keyword_bootstrap, nil), frame_pointer,
make_cons( frame_pointer, make_cons( frame_pointer, privileged_keyword_name, n), make_cons(frame_pointer, privileged_keyword_bootstrap, nil),
make_cons( frame_pointer, make_cons( frame_pointer, privileged_keyword_documentation, d), 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); struct pso_pointer r = make_special(frame_pointer, meta, executable);
debug_print(doc, DEBUG_BOOTSTRAP, 0);
if (!exceptionp(r)) { if (!exceptionp(r)) {
result = make_cons( frame_pointer, make_cons( frame_pointer, n, r), result); debug_print(U"... bound\n", DEBUG_BOOTSTRAP, 0);
result =
make_cons(frame_pointer, make_cons(frame_pointer, n, r), result);
} else {
debug_print(U"... failed to bind\n", DEBUG_BOOTSTRAP, 0);
} }
return result; return result;
@ -90,7 +121,7 @@ bind_special(struct pso_pointer frame_pointer, wchar_t *name, wchar_t *doc,
struct function_data { struct function_data {
char32_t *name; char32_t *name;
char32_t *documentation; char32_t *documentation;
void* executable; void *executable;
}; };
/* right, the problem with all those pretty '#ifdefs' which might allow us to /* right, the problem with all those pretty '#ifdefs' which might allow us to
@ -137,16 +168,70 @@ struct function_data function_initialisers[] = {
&lisp_eval}, &lisp_eval},
#endif #endif
#ifdef __psse_ops_inspect_h #ifdef __psse_ops_inspect_h
{ {U"inspect",
U"inspect", U"(inspect expr), (inspect expr write-stream): inspect one complete "
U"(inspect expr), (inspect expr write-stream): inspect one complete " U"lisp expression and return `nil`. If `write-stream` is specified and "
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"is a write stream, then print to that stream, else to the stream " U"which is the value of `*out*` in the environment.",
U"which is the value of `*out*` in the environment.", &lisp_inspect},
&lisp_inspect
},
#endif #endif
}; #ifdef __psse_ops_keys_h
{U"keys", U"(keys store): returns a list of the keys in this `store`.",
&lisp_keys},
#endif
#ifdef __psse_ops_list_ops_h
{U"count",
U"(count sequence): returns the number of top level elements in "
U"`sequence`.",
&count},
#endif
#ifdef __psse_ops_mapcar_h
{U"mapcar",
U"(mapcar fn list): map this `fn` over this `list`, and return a list "
U"of the results.",
&lisp_mapcar},
#endif
#ifdef __psse_ops_progn_h
{U"progn",
U"(progn expressions...): Evaluate each expression in "
U"`expressions` in turn and return the value of the last.",
&lisp_progn},
#endif
#ifdef __psse_ops_repl_h
{U"repl", U"(repl show_prompt?): Start a new read, eval, print loop.",
&repl},
#endif
#ifdef __psse_ops_reverse_h
{U"reverse",
U"(reverse sequence): return a sequence like this `sequence`, but with "
U"the order of top level elements reversed.",
&reverse},
#endif
#ifdef __psse_ops_truth_h
{U"and",
U"(and expressions...): returns `t` if none of these `expressions...` "
U"evaluates to `nil`, else `nil`.",
&and},
{U"nil?",
U"(nil? expression): returns `t` if `expression` evaluates to `nil`, else "
U"`nil`.",
&nilp},
{U"not",
U"(not expression): returns `t` unless `expression` evaluates to `nil`, "
U"else "
U"`nil`.",
&not},
{U"or",
U"(or expressions...): returns `nil` if all of these `expressions...` "
U"evaluates to `nil`, else `t`.",
&or},
{U"true?",
U"(true? expression): returns `t` if `expression` evaluates to `t`, else "
U"`nil`.",
&truep},
#endif
{U"END MARKER", U"END MARKER", NULL}};
/* right, the problem with all those pretty '#ifdefs' which might allow us to /* 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 * simply switch functions on and off just by including or not including .h
@ -158,18 +243,38 @@ struct function_data function_initialisers[] = {
struct function_data special_initialisers[] = { struct function_data special_initialisers[] = {
#ifdef __psse_ops_cond_h #ifdef __psse_ops_cond_h
{U"cond", {U"cond",
U"(cond clauses...): conditional. Each `clause` is expected to be a " U"(cond clauses...): special form; conditional. Each `clause` is expected "
U"to be a "
U"list; if the first item in such a list evaluates to non-nil, the " 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"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"the last returned. If no arg `clause` has a first element which "
U"evaluates to non nil, then nil is returned", U"evaluates to non nil, then nil is returned",
&lisp_cond}, &lisp_cond},
#endif #endif
}; #ifdef __psse_ops_quote_h
{U"quote",
U"(quote expression): special form; protect `expression` from "
U"evaluation.",
&quote},
#endif
{U"END MARKER", U"END MARKER", NULL}};
struct pso_pointer struct pso_pointer
initialise_function_bindings(struct pso_pointer frame_pointer) { initialise_function_bindings(struct pso_pointer frame_pointer) {
struct pso_pointer result = fetch_env(frame_pointer); struct pso_pointer result = fetch_env(frame_pointer);
for (int i = 0; function_initialisers[i].executable != NULL; i++) {
result = bind_function(push_local(frame_pointer, make_frame_with_env(0, frame_pointer, result)),
function_initialisers[i].name,
function_initialisers[i].documentation,
function_initialisers[i].executable);
}
for (int i = 0; special_initialisers[i].executable != NULL; i++) {
result = bind_function(push_local( frame_pointer, make_frame_with_env(0, frame_pointer, result)),
special_initialisers[i].name,
special_initialisers[i].documentation,
special_initialisers[i].executable);
}
return result; return result;
} }

17
src/c/environment/function_bindings.h
View file

@ -0,0 +1,17 @@
/**
* environment/function_bindings.h
*
* Post Scarcity Software Environment: bootstrap function bindings.
*
* Bindings for functions written in C and available during bootstrap.
*
* (c) 2026 Simon Brooke <simon@journeyman.cc>
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#ifndef __psse_environment_function_bindings_h
#define __psse_environment_function_bindings_h
struct pso_pointer
initialise_function_bindings(struct pso_pointer frame_pointer);
#endif

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. * Licensed under GPL version 2.0, or, at your option, any later version.
*/ */
#ifndef psse_ops_inspect_h #ifndef __psse_ops_inspect_h
#define psse_ops_inspect_h #define __psse_ops_inspect_h
#include "memory/pointer.h" #include "memory/pointer.h"

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

@ -9,8 +9,8 @@
* Licensed under GPL version 2.0, or, at your option, any later version. * Licensed under GPL version 2.0, or, at your option, any later version.
*/ */
#ifndef psse_ops_keys #ifndef __psse_ops_keys_h
#define psse_ops_keys #define __psse_ops_keys_h
struct pso_pointer c_keys( struct pso_pointer store ); struct pso_pointer c_keys( struct pso_pointer store );

6
src/c/ops/mapcar.h
View file

@ -9,9 +9,9 @@
* Licensed under GPL version 2.0, or, at your option, any later version. * Licensed under GPL version 2.0, or, at your option, any later version.
*/ */
#ifndef psse_ops_mapcar #ifndef __psse_ops_mapcar_h
#define psse_ops_mapcar #define __psse_ops_mapcar_h
struct pso_pointer lisp_mapcar( struct pso_pointer frame_pointer );
#endif #endif

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

@ -48,7 +48,7 @@ void interrupt_handler( int dummy ) {
/** /**
* Very simple read/eval/print loop for bootstrapping. * Very simple read/eval/print loop for bootstrapping.
*/ */
void repl( struct pso_pointer frame_pointer ) { struct pso_pointer repl( struct pso_pointer frame_pointer ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso4 *frame = pointer_to_pso4( frame_pointer );
bool show_prompt = c_truep( fetch_arg( frame, 0 ) ); bool show_prompt = c_truep( fetch_arg( frame, 0 ) );
// todo: issue #21: must have stack frame passed in. // todo: issue #21: must have stack frame passed in.
@ -106,5 +106,7 @@ void repl( struct pso_pointer frame_pointer ) {
dec_ref( base_of_stack ); dec_ref( base_of_stack );
} }
debug_print( L"Leaving repl\n", DEBUG_REPL, 0 ); debug_print(L"Leaving repl\n", DEBUG_REPL, 0);
return nil;
} }

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

@ -9,11 +9,13 @@
* Licensed under GPL version 2.0, or, at your option, any later version. * Licensed under GPL version 2.0, or, at your option, any later version.
*/ */
#ifndef SRC_C_OPS_REPL_H_ #ifndef __psse_ops_repl_h
#define SRC_C_OPS_REPL_H_ #define __psse_ops_repl_h
void repl( struct pso_pointer frame_pointer ); #include "memory/pointer.h"
struct pso_pointer repl( struct pso_pointer frame_pointer );
#endif /* SRC_C_OPS_REPL_H_ */ #endif /* __psse_ops_repl_h */