I *think* that's all the bootstrap functions being bound in the environment.
This commit is contained in:
parent
efa6a3246d
commit
fcfdb43b05
8 changed files with 184 additions and 54 deletions
|
|
@ -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 <simon@journeyman.cc>
|
||||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
|
||||
#include <stdbool.h>
|
||||
#include <stdlib.h>
|
||||
#include <wchar.h>
|
||||
|
||||
#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;
|
||||
}
|
||||
Loading…
Add table
Add a link
Reference in a new issue