Ran a 'make format', because !'m close to being able to merge this feature.
This commit is contained in:
parent
5e64a33965
commit
80049f2272
52 changed files with 936 additions and 843 deletions
|
|
@ -59,34 +59,40 @@
|
|||
*/
|
||||
|
||||
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);
|
||||
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_layer, privileged_keyword_bootstrap),
|
||||
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_layer,
|
||||
privileged_keyword_bootstrap ),
|
||||
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)) {
|
||||
debug_print(L"... bound\n", DEBUG_BOOTSTRAP, 0);
|
||||
result =
|
||||
make_cons(frame_pointer, make_cons(frame_pointer, n, r), result);
|
||||
} else {
|
||||
debug_print(L"... failed to bind\n", DEBUG_BOOTSTRAP, 0);
|
||||
}
|
||||
debug_print( doc, DEBUG_BOOTSTRAP, 0 );
|
||||
if ( !exceptionp( r ) ) {
|
||||
debug_print( L"... bound\n", DEBUG_BOOTSTRAP, 0 );
|
||||
result =
|
||||
make_cons( frame_pointer, make_cons( frame_pointer, n, r ),
|
||||
result );
|
||||
} else {
|
||||
debug_print( L"... failed to bind\n", DEBUG_BOOTSTRAP, 0 );
|
||||
}
|
||||
|
||||
return result;
|
||||
return result;
|
||||
}
|
||||
|
||||
/**
|
||||
|
|
@ -94,40 +100,46 @@ 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,
|
||||
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);
|
||||
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 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);
|
||||
struct pso_pointer r = make_special( frame_pointer, meta, executable );
|
||||
|
||||
debug_print(doc, DEBUG_BOOTSTRAP, 0);
|
||||
if (!exceptionp(r)) {
|
||||
debug_print(L"... bound\n", DEBUG_BOOTSTRAP, 0);
|
||||
result =
|
||||
make_cons(frame_pointer, make_cons(frame_pointer, n, r), result);
|
||||
} else {
|
||||
debug_print(L"... failed to bind\n", DEBUG_BOOTSTRAP, 0);
|
||||
}
|
||||
debug_print( doc, DEBUG_BOOTSTRAP, 0 );
|
||||
if ( !exceptionp( r ) ) {
|
||||
debug_print( L"... bound\n", DEBUG_BOOTSTRAP, 0 );
|
||||
result =
|
||||
make_cons( frame_pointer, make_cons( frame_pointer, n, r ),
|
||||
result );
|
||||
} else {
|
||||
debug_print( L"... failed to bind\n", DEBUG_BOOTSTRAP, 0 );
|
||||
}
|
||||
|
||||
return result;
|
||||
return result;
|
||||
}
|
||||
|
||||
struct function_data {
|
||||
wchar_t *name;
|
||||
wchar_t *documentation;
|
||||
void *executable;
|
||||
wchar_t *name;
|
||||
wchar_t *documentation;
|
||||
void *executable;
|
||||
};
|
||||
|
||||
/* right, the problem with all those pretty '#ifdefs' which might allow us to
|
||||
|
|
@ -140,152 +152,151 @@ struct function_data {
|
|||
/** initialisers for functions */
|
||||
struct function_data function_initialisers[] = {
|
||||
#ifdef _psse_io_io_h
|
||||
{L"close", L"(close stream): close `stream`.", &lisp_close},
|
||||
{L"open",
|
||||
L"(open stream), (open stream write?): open `stream`; if `write?` is "
|
||||
L"present and is non-nil, open for writing, else for reading.",
|
||||
&lisp_open},
|
||||
{L"slurp",
|
||||
L"(slurp stream): read the whole contents of this `stream`, "
|
||||
L"which may "
|
||||
L"be an open stream open for reading or a URL, into a string, and return "
|
||||
L"the "
|
||||
L"string.",
|
||||
&lisp_slurp},
|
||||
{L"close", L"(close stream): close `stream`.", &lisp_close},
|
||||
{L"open",
|
||||
L"(open stream), (open stream write?): open `stream`; if `write?` is "
|
||||
L"present and is non-nil, open for writing, else for reading.",
|
||||
&lisp_open},
|
||||
{L"slurp",
|
||||
L"(slurp stream): read the whole contents of this `stream`, "
|
||||
L"which may "
|
||||
L"be an open stream open for reading or a URL, into a string, and return "
|
||||
L"the " L"string.",
|
||||
&lisp_slurp},
|
||||
#endif
|
||||
#ifdef __psse_io_peek_h
|
||||
{L"peek",
|
||||
L"(peek stream): return the next character which may be read from "
|
||||
L"`stream`, without removing it.",
|
||||
&peek},
|
||||
{L"peek",
|
||||
L"(peek stream): return the next character which may be read from "
|
||||
L"`stream`, without removing it.",
|
||||
&peek},
|
||||
#endif
|
||||
#ifdef __psse_io_print_h
|
||||
{L"print",
|
||||
L"(print object), (print object stream) print this `object` in a format "
|
||||
L"suitable to be read by `read`, q.v.; if `stream` is specified and is a "
|
||||
L"stream open for writing, to that stream.",
|
||||
&print},
|
||||
{L"princ",
|
||||
L"(princ object), (princ object stream) print this `object` in a format "
|
||||
L"more suited to human readers; if `stream` is specified and is a stream "
|
||||
L"open for writing, to that stream.",
|
||||
&print},
|
||||
{L"print",
|
||||
L"(print object), (print object stream) print this `object` in a format "
|
||||
L"suitable to be read by `read`, q.v.; if `stream` is specified and is a "
|
||||
L"stream open for writing, to that stream.",
|
||||
&print},
|
||||
{L"princ",
|
||||
L"(princ object), (princ object stream) print this `object` in a format "
|
||||
L"more suited to human readers; if `stream` is specified and is a stream "
|
||||
L"open for writing, to that stream.",
|
||||
&print},
|
||||
#endif
|
||||
#ifdef __psse_io_read_h
|
||||
{L"read",
|
||||
L"(read stream) read one complete Lisp expression from `stream`, and "
|
||||
L"return that expression unevaluated.",
|
||||
&read},
|
||||
{L"read-character",
|
||||
L"(read-character stream): read a single character from `stream` and "
|
||||
L"return it.",
|
||||
&read_character},
|
||||
{L"read-number",
|
||||
L"(read-number stream): read a number from `stream` and return it.",
|
||||
&read_number},
|
||||
{L"read-symbol",
|
||||
L"(read-symbol stream): read a symbol from `stream` and return it.",
|
||||
&read_symbol},
|
||||
{L"read",
|
||||
L"(read stream) read one complete Lisp expression from `stream`, and "
|
||||
L"return that expression unevaluated.",
|
||||
&read},
|
||||
{L"read-character",
|
||||
L"(read-character stream): read a single character from `stream` and "
|
||||
L"return it.",
|
||||
&read_character},
|
||||
{L"read-number",
|
||||
L"(read-number stream): read a number from `stream` and return it.",
|
||||
&read_number},
|
||||
{L"read-symbol",
|
||||
L"(read-symbol stream): read a symbol from `stream` and return it.",
|
||||
&read_symbol},
|
||||
#endif
|
||||
#ifdef __psse_ops_assoc_h
|
||||
{L"assoc",
|
||||
L"(assoc key store): search `store` for the value associated with "
|
||||
L"`key`.",
|
||||
&assoc},
|
||||
{L"assoc",
|
||||
L"(assoc key store): search `store` for the value associated with "
|
||||
L"`key`.",
|
||||
&assoc},
|
||||
#endif
|
||||
#ifdef __psse_ops_bind_h
|
||||
{L"bind!",
|
||||
L"(bind! key value store): bind `key` to `value` in this store, modifying "
|
||||
L"the store if it is writable to the user, otherwise returning a new "
|
||||
L"store",
|
||||
&bind},
|
||||
{L"bind!",
|
||||
L"(bind! key value store): bind `key` to `value` in this store, modifying "
|
||||
L"the store if it is writable to the user, otherwise returning a new "
|
||||
L"store",
|
||||
&bind},
|
||||
#endif
|
||||
#ifdef __psse_ops_eq_h
|
||||
{L"eq",
|
||||
L"(eq args...): shallow, cheap equality; returns `t` if all `args...` "
|
||||
L"are the same object, else `nil`.",
|
||||
&eq},
|
||||
{L"equal",
|
||||
L"(equal a b): expensive, deep equality: returns `t` if objects `a` "
|
||||
L"and `b` have recursively equal value.",
|
||||
&equal},
|
||||
{L"eq",
|
||||
L"(eq args...): shallow, cheap equality; returns `t` if all `args...` "
|
||||
L"are the same object, else `nil`.",
|
||||
&eq},
|
||||
{L"equal",
|
||||
L"(equal a b): expensive, deep equality: returns `t` if objects `a` "
|
||||
L"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.
|
||||
{L"apply",
|
||||
L"(apply fn args...): apply this `fn` to these `args...` and return "
|
||||
L"their value.",
|
||||
&lisp_apply},
|
||||
{L"eval",
|
||||
L"(eval expression): evaluate this `expression` and return its value",
|
||||
&lisp_eval},
|
||||
// TODO: there's a lot of other stuff in eval_apply.c, which ought to be in
|
||||
// other files but at present isn't.
|
||||
{L"apply",
|
||||
L"(apply fn args...): apply this `fn` to these `args...` and return "
|
||||
L"their value.",
|
||||
&lisp_apply},
|
||||
{L"eval",
|
||||
L"(eval expression): evaluate this `expression` and return its value",
|
||||
&lisp_eval},
|
||||
#endif
|
||||
#ifdef __psse_ops_inspect_h
|
||||
{L"inspect",
|
||||
L"(inspect expr), (inspect expr write-stream): inspect one complete "
|
||||
L"lisp expression and return `nil`. If `write-stream` is specified and "
|
||||
L"is a write stream, then print to that stream, else to the stream "
|
||||
L"which is the value of `*out*` in the environment.",
|
||||
&lisp_inspect},
|
||||
{L"inspect",
|
||||
L"(inspect expr), (inspect expr write-stream): inspect one complete "
|
||||
L"lisp expression and return `nil`. If `write-stream` is specified and "
|
||||
L"is a write stream, then print to that stream, else to the stream "
|
||||
L"which is the value of `*out*` in the environment.",
|
||||
&lisp_inspect},
|
||||
#endif
|
||||
#ifdef __psse_ops_keys_h
|
||||
{L"keys", L"(keys store): returns a list of the keys in this `store`.",
|
||||
&lisp_keys},
|
||||
{L"keys", L"(keys store): returns a list of the keys in this `store`.",
|
||||
&lisp_keys},
|
||||
#endif
|
||||
#ifdef __psse_ops_list_ops_h
|
||||
{L"count",
|
||||
L"(count sequence): returns the number of top level elements in "
|
||||
L"`sequence`.",
|
||||
&count},
|
||||
{L"count",
|
||||
L"(count sequence): returns the number of top level elements in "
|
||||
L"`sequence`.",
|
||||
&count},
|
||||
#endif
|
||||
#ifdef __psse_ops_mapcar_h
|
||||
{L"mapcar",
|
||||
L"(mapcar fn list): map this `fn` over this `list`, and return a list "
|
||||
L"of the results.",
|
||||
&lisp_mapcar},
|
||||
{L"mapcar",
|
||||
L"(mapcar fn list): map this `fn` over this `list`, and return a list "
|
||||
L"of the results.",
|
||||
&lisp_mapcar},
|
||||
#endif
|
||||
#ifdef __psse_ops_progn_h
|
||||
{L"progn",
|
||||
L"(progn expressions...): Evaluate each expression in "
|
||||
L"`expressions` in turn and return the value of the last.",
|
||||
&lisp_progn},
|
||||
{L"progn",
|
||||
L"(progn expressions...): Evaluate each expression in "
|
||||
L"`expressions` in turn and return the value of the last.",
|
||||
&lisp_progn},
|
||||
#endif
|
||||
#ifdef __psse_ops_repl_h
|
||||
{L"repl", L"(repl show_prompt?): Start a new read, eval, print loop.",
|
||||
&repl},
|
||||
{L"repl", L"(repl show_prompt?): Start a new read, eval, print loop.",
|
||||
&repl},
|
||||
#endif
|
||||
#ifdef __psse_ops_reverse_h
|
||||
{L"reverse",
|
||||
L"(reverse sequence): return a sequence like this `sequence`, but with "
|
||||
L"the order of top level elements reversed.",
|
||||
&reverse},
|
||||
{L"reverse",
|
||||
L"(reverse sequence): return a sequence like this `sequence`, but with "
|
||||
L"the order of top level elements reversed.",
|
||||
&reverse},
|
||||
#endif
|
||||
#ifdef __psse_ops_truth_h
|
||||
{L"and",
|
||||
L"(and expressions...): returns `t` if none of these `expressions...` "
|
||||
L"evaluates to `nil`, else `nil`.",
|
||||
&and},
|
||||
{L"nil?",
|
||||
L"(nil? expression): returns `t` if `expression` evaluates to `nil`, else "
|
||||
L"`nil`.",
|
||||
&nilp},
|
||||
{L"not",
|
||||
L"(not expression): returns `t` unless `expression` evaluates to `nil`, "
|
||||
L"else "
|
||||
L"`nil`.",
|
||||
¬},
|
||||
{L"or",
|
||||
L"(or expressions...): returns `nil` if every one of these `expressions...` "
|
||||
L"evaluates to `nil`, else `t`.",
|
||||
&or},
|
||||
{L"true?",
|
||||
L"(true? expression): returns `t` if `expression` evaluates to `t`, else "
|
||||
L"`nil`.",
|
||||
&truep},
|
||||
{L"and",
|
||||
L"(and expressions...): returns `t` if none of these `expressions...` "
|
||||
L"evaluates to `nil`, else `nil`.",
|
||||
&and},
|
||||
{L"nil?",
|
||||
L"(nil? expression): returns `t` if `expression` evaluates to `nil`, else "
|
||||
L"`nil`.",
|
||||
&nilp},
|
||||
{L"not",
|
||||
L"(not expression): returns `t` unless `expression` evaluates to `nil`, "
|
||||
L"else " L"`nil`.",
|
||||
¬},
|
||||
{L"or",
|
||||
L"(or expressions...): returns `nil` if every one of these `expressions...` "
|
||||
L"evaluates to `nil`, else `t`.",
|
||||
&or},
|
||||
{L"true?",
|
||||
L"(true? expression): returns `t` if `expression` evaluates to `t`, else "
|
||||
L"`nil`.",
|
||||
&truep},
|
||||
#endif
|
||||
|
||||
{L"END MARKER", L"END MARKER", NULL}};
|
||||
{L"END MARKER", L"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
|
||||
|
|
@ -296,41 +307,48 @@ struct function_data function_initialisers[] = {
|
|||
/** initialisers for special forms */
|
||||
struct function_data special_initialisers[] = {
|
||||
#ifdef __psse_ops_cond_h
|
||||
{L"cond",
|
||||
L"(cond clauses...): special form; conditional. Each `clause` is expected "
|
||||
L"to be a "
|
||||
L"list; if the first item in such a list evaluates to non-nil, the "
|
||||
L"remaining items in that list are evaluated in turn and the value of "
|
||||
L"the last returned. If no arg `clause` has a first element which "
|
||||
L"evaluates to non nil, then nil is returned",
|
||||
&lisp_cond},
|
||||
{L"cond",
|
||||
L"(cond clauses...): special form; conditional. Each `clause` is expected "
|
||||
L"to be a "
|
||||
L"list; if the first item in such a list evaluates to non-nil, the "
|
||||
L"remaining items in that list are evaluated in turn and the value of "
|
||||
L"the last returned. If no arg `clause` has a first element which "
|
||||
L"evaluates to non nil, then nil is returned",
|
||||
&lisp_cond},
|
||||
#endif
|
||||
#ifdef __psse_ops_quote_h
|
||||
{L"quote",
|
||||
L"(quote expression): special form; protect `expression` from "
|
||||
L"evaluation.",
|
||||
"e},
|
||||
{L"quote",
|
||||
L"(quote expression): special form; protect `expression` from "
|
||||
L"evaluation.",
|
||||
"e},
|
||||
#endif
|
||||
{L"END MARKER", L"END MARKER", NULL}};
|
||||
{L"END MARKER", L"END MARKER", NULL}
|
||||
};
|
||||
|
||||
struct pso_pointer
|
||||
initialise_function_bindings(struct pso_pointer frame_pointer) {
|
||||
struct pso_pointer result = fetch_env(frame_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++) {
|
||||
struct pso_pointer b = c_car( bind_function( frame_pointer,
|
||||
function_initialisers[i].name,
|
||||
function_initialisers[i].documentation,
|
||||
function_initialisers[i].executable));
|
||||
result = make_cons( frame_pointer, b, result);
|
||||
}
|
||||
for (int i = 0; special_initialisers[i].executable != NULL; i++) {
|
||||
struct pso_pointer b = c_car( bind_special( frame_pointer,
|
||||
special_initialisers[i].name,
|
||||
special_initialisers[i].documentation,
|
||||
special_initialisers[i].executable));
|
||||
result = make_cons( frame_pointer, b, result);
|
||||
}
|
||||
for ( int i = 0; function_initialisers[i].executable != NULL; i++ ) {
|
||||
struct pso_pointer b = c_car( bind_function( frame_pointer,
|
||||
function_initialisers[i].
|
||||
name,
|
||||
function_initialisers[i].
|
||||
documentation,
|
||||
function_initialisers[i].
|
||||
executable ) );
|
||||
result = make_cons( frame_pointer, b, result );
|
||||
}
|
||||
for ( int i = 0; special_initialisers[i].executable != NULL; i++ ) {
|
||||
struct pso_pointer b = c_car( bind_special( frame_pointer,
|
||||
special_initialisers[i].
|
||||
name,
|
||||
special_initialisers[i].
|
||||
documentation,
|
||||
special_initialisers[i].
|
||||
executable ) );
|
||||
result = make_cons( frame_pointer, b, result );
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue