From fcfdb43b05b0ed66ef1f35b976284a892de3c6e2 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Mon, 4 May 2026 18:23:46 +0100 Subject: [PATCH] I *think* that's all the bootstrap functions being bound in the environment. --- src/c/environment/environment.c | 34 +++--- src/c/environment/function_bindings.c | 157 +++++++++++++++++++++----- src/c/environment/function_bindings.h | 17 +++ src/c/ops/inspect.h | 4 +- src/c/ops/keys.h | 4 +- src/c/ops/mapcar.h | 6 +- src/c/ops/repl.c | 6 +- src/c/ops/repl.h | 10 +- 8 files changed, 184 insertions(+), 54 deletions(-) diff --git a/src/c/environment/environment.c b/src/c/environment/environment.c index 4c83bc7..b575fb9 100644 --- a/src/c/environment/environment.c +++ b/src/c/environment/environment.c @@ -11,6 +11,7 @@ #include "debug.h" +#include "environment/function_bindings.h" #include "memory/memory.h" #include "memory/node.h" #include "memory/pointer.h" @@ -21,11 +22,11 @@ #include "ops/bind.h" #include "ops/string_ops.h" -#include "payloads/cons.h" -#include "payloads/exception.h" #include "payloads/psse_string.h" +#include "ops/stack_ops.h" #include "ops/truth.h" +#include "payloads/stack.h" /** * @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 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 ); if ( ( n.page == 0 ) && ( n.offset == 0 ) ) { @@ -54,14 +55,14 @@ struct pso_pointer initialise_environment( uint32_t node ) { nil = n; lock_object( nil ); - debug_print( L"success\n", DEBUG_BOOTSTRAP, 0 ); + debug_print( U"success\n", DEBUG_BOOTSTRAP, 0 ); } else { result = nil; - debug_print( L"fail\n", DEBUG_BOOTSTRAP, 0 ); + debug_print( U"fail\n", DEBUG_BOOTSTRAP, 0 ); } } 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 ); // 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; lock_object( t ); - debug_print( L"success\n", DEBUG_BOOTSTRAP, 0 ); + debug_print( U"success\n", DEBUG_BOOTSTRAP, 0 ); } else { result = nil; - debug_print( L"fail\n", DEBUG_BOOTSTRAP, 0 ); + debug_print( U"fail\n", DEBUG_BOOTSTRAP, 0 ); } } if ( !exceptionp( result ) ) { result = lisp_bind( make_frame ( 3, frame_pointer, - c_string_to_lisp_symbol( frame_pointer, L"nil" ), nil, + c_string_to_lisp_symbol( frame_pointer, U"niU" ), nil, nil ) ); - debug_print( L"Environment after binding `nil`: ", DEBUG_BOOTSTRAP, + debug_print( U"Environment after binding `nil`: ", DEBUG_BOOTSTRAP, 0 ); debug_print_object( result, DEBUG_BOOTSTRAP, 0 ); result = lisp_bind( make_frame ( 3, frame_pointer, - c_string_to_lisp_symbol( frame_pointer, L"t" ), t, + c_string_to_lisp_symbol( frame_pointer, U"t" ), t, result ) ); 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( L"\nEnvironment initialised successfully.\n", + debug_print( U"\nEnvironment initialised successfully.\n", 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; } diff --git a/src/c/environment/function_bindings.c b/src/c/environment/function_bindings.c index 00d026c..07a19c7 100644 --- a/src/c/environment/function_bindings.c +++ b/src/c/environment/function_bindings.c @@ -6,15 +6,17 @@ * 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. + * have namespaces and paths working. * * (c) 2026 Simon Brooke * Licensed under GPL version 2.0, or, at your option, any later version. */ #include +#include #include +#include "debug.h" #include "environment/privileged_keywords.h" #include "memory/node.h" #include "memory/pointer.h" @@ -23,15 +25,24 @@ #include "ops/assoc.h" #include "ops/bind.h" #include "ops/cond.h" -#include "ops/eval_apply.h" #include "ops/eq.h" +#include "ops/eval_apply.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/string_ops.h" +#include "ops/truth.h" #include "payloads/cons.h" #include "payloads/function.h" #include "payloads/special.h" +#include "payloads/stack.h" /** * Bind this compiled `executable` function, as a Lisp function, to @@ -42,21 +53,31 @@ */ 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 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 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); + debug_print(doc, DEBUG_BOOTSTRAP, 0); 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; @@ -67,21 +88,31 @@ bind_function(struct pso_pointer frame_pointer, wchar_t *name, wchar_t *doc, * this `name` in the `oblist`. */ 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 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 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); + debug_print(doc, DEBUG_BOOTSTRAP, 0); 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; @@ -90,7 +121,7 @@ bind_special(struct pso_pointer frame_pointer, wchar_t *name, wchar_t *doc, struct function_data { char32_t *name; char32_t *documentation; - void* executable; + void *executable; }; /* right, the problem with all those pretty '#ifdefs' which might allow us to @@ -137,16 +168,70 @@ struct function_data function_initialisers[] = { &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 - }, + {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 -}; +#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`.", + ¬}, + {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 * 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[] = { #ifdef __psse_ops_cond_h {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"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 -}; +#ifdef __psse_ops_quote_h + {U"quote", + U"(quote expression): special form; protect `expression` from " + U"evaluation.", + "e}, +#endif + {U"END MARKER", U"END MARKER", NULL}}; struct pso_pointer initialise_function_bindings(struct pso_pointer 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; } \ No newline at end of file diff --git a/src/c/environment/function_bindings.h b/src/c/environment/function_bindings.h index e69de29..0a061f4 100644 --- a/src/c/environment/function_bindings.h +++ b/src/c/environment/function_bindings.h @@ -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 + * 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 \ No newline at end of file diff --git a/src/c/ops/inspect.h b/src/c/ops/inspect.h index 800d643..a383dfa 100644 --- a/src/c/ops/inspect.h +++ b/src/c/ops/inspect.h @@ -9,8 +9,8 @@ * Licensed under GPL version 2.0, or, at your option, any later version. */ -#ifndef psse_ops_inspect_h -#define psse_ops_inspect_h +#ifndef __psse_ops_inspect_h +#define __psse_ops_inspect_h #include "memory/pointer.h" diff --git a/src/c/ops/keys.h b/src/c/ops/keys.h index 3b48261..a912936 100644 --- a/src/c/ops/keys.h +++ b/src/c/ops/keys.h @@ -9,8 +9,8 @@ * Licensed under GPL version 2.0, or, at your option, any later version. */ -#ifndef psse_ops_keys -#define psse_ops_keys +#ifndef __psse_ops_keys_h +#define __psse_ops_keys_h struct pso_pointer c_keys( struct pso_pointer store ); diff --git a/src/c/ops/mapcar.h b/src/c/ops/mapcar.h index db0a5dd..50408a9 100644 --- a/src/c/ops/mapcar.h +++ b/src/c/ops/mapcar.h @@ -9,9 +9,9 @@ * Licensed under GPL version 2.0, or, at your option, any later version. */ -#ifndef psse_ops_mapcar -#define psse_ops_mapcar - +#ifndef __psse_ops_mapcar_h +#define __psse_ops_mapcar_h +struct pso_pointer lisp_mapcar( struct pso_pointer frame_pointer ); #endif \ No newline at end of file diff --git a/src/c/ops/repl.c b/src/c/ops/repl.c index cc150bd..a949b25 100644 --- a/src/c/ops/repl.c +++ b/src/c/ops/repl.c @@ -48,7 +48,7 @@ void interrupt_handler( int dummy ) { /** * 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 ); bool show_prompt = c_truep( fetch_arg( frame, 0 ) ); // 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 ); } - debug_print( L"Leaving repl\n", DEBUG_REPL, 0 ); + debug_print(L"Leaving repl\n", DEBUG_REPL, 0); + + return nil; } diff --git a/src/c/ops/repl.h b/src/c/ops/repl.h index b7ab6de..7603433 100644 --- a/src/c/ops/repl.h +++ b/src/c/ops/repl.h @@ -9,11 +9,13 @@ * Licensed under GPL version 2.0, or, at your option, any later version. */ -#ifndef SRC_C_OPS_REPL_H_ -#define SRC_C_OPS_REPL_H_ +#ifndef __psse_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 */