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

Major step forward: equal is now working, and consequently so is assoc.

Browse source
This commit is contained in:
Simon Brooke 2026-05-06 16:42:18 +01:00
parent 271b7da46a
commit 5e64a33965
11 changed files with 168 additions and 137 deletions
Download patch file Download diff file Expand all files Collapse all files

22
src/c/environment/environment.c
View file

@ -46,7 +46,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( U"Initialising `nil`... ", DEBUG_BOOTSTRAP, 0 ); debug_print( L"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 ) ) {
@ -56,14 +56,14 @@ struct pso_pointer initialise_environment( uint32_t node ) {
nil = n; nil = n;
lock_object( nil ); lock_object( nil );
debug_print( U"success\n", DEBUG_BOOTSTRAP, 0 ); debug_print( L"success\n", DEBUG_BOOTSTRAP, 0 );
} else { } else {
result = nil; result = nil;
debug_print( U"fail\n", DEBUG_BOOTSTRAP, 0 ); debug_print( L"fail\n", DEBUG_BOOTSTRAP, 0 );
} }
} }
if ( !c_nilp( result ) ) { if ( !c_nilp( result ) ) {
debug_print( U"Initialising `t`... ", DEBUG_BOOTSTRAP, 0 ); debug_print( L"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
@ -74,10 +74,10 @@ struct pso_pointer initialise_environment( uint32_t node ) {
t = n; t = n;
lock_object( t ); lock_object( t );
debug_print( U"success\n", DEBUG_BOOTSTRAP, 0 ); debug_print( L"success\n", DEBUG_BOOTSTRAP, 0 );
} else { } else {
result = nil; result = nil;
debug_print( U"fail\n", DEBUG_BOOTSTRAP, 0 ); debug_print( L"fail\n", DEBUG_BOOTSTRAP, 0 );
} }
} }
if ( !exceptionp( result ) ) { if ( !exceptionp( result ) ) {
@ -85,22 +85,22 @@ struct pso_pointer initialise_environment( uint32_t node ) {
result = result =
lisp_bind( make_frame lisp_bind( make_frame
( 3, frame_pointer, ( 3, frame_pointer,
c_string_to_lisp_symbol( frame_pointer, U"nil" ), nil, c_string_to_lisp_symbol( frame_pointer, L"nil" ), nil,
nil ) ); nil ) );
debug_print( U"Environment after binding `nil`: ", DEBUG_BOOTSTRAP, debug_print( L"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, U"t" ), t, c_string_to_lisp_symbol( frame_pointer, L"t" ), t,
result ) ); result ) );
environment_initialised = true; environment_initialised = true;
debug_print( U"Environment after binding `t`: ", DEBUG_BOOTSTRAP, 0 ); debug_print( L"Environment after binding `t`: ", DEBUG_BOOTSTRAP, 0 );
debug_print_object( result, DEBUG_BOOTSTRAP, 0 ); debug_print_object( result, DEBUG_BOOTSTRAP, 0 );
debug_print( U"\nEnvironment initialised successfully.\n", debug_print( L"\nEnvironment initialised successfully.\n",
DEBUG_BOOTSTRAP, 0 ); DEBUG_BOOTSTRAP, 0 );
initialise_privileged_keywords(frame_pointer); initialise_privileged_keywords(frame_pointer);

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

@ -67,7 +67,7 @@ bind_function(struct pso_pointer frame_pointer, wchar_t *name, wchar_t *doc,
struct pso_pointer meta = make_cons( struct pso_pointer meta = make_cons(
frame_pointer, frame_pointer,
make_cons(frame_pointer, privileged_keyword_bootstrap, nil), make_cons(frame_pointer, privileged_keyword_layer, privileged_keyword_bootstrap),
make_cons(frame_pointer, make_cons(frame_pointer,
make_cons(frame_pointer, privileged_keyword_name, n), make_cons(frame_pointer, privileged_keyword_name, n),
make_cons(frame_pointer, make_cons(frame_pointer,
@ -79,11 +79,11 @@ bind_function(struct pso_pointer frame_pointer, wchar_t *name, wchar_t *doc,
debug_print(doc, DEBUG_BOOTSTRAP, 0); debug_print(doc, DEBUG_BOOTSTRAP, 0);
if (!exceptionp(r)) { if (!exceptionp(r)) {
debug_print(U"... bound\n", DEBUG_BOOTSTRAP, 0); debug_print(L"... bound\n", DEBUG_BOOTSTRAP, 0);
result = result =
make_cons(frame_pointer, make_cons(frame_pointer, n, r), result); make_cons(frame_pointer, make_cons(frame_pointer, n, r), result);
} else { } else {
debug_print(U"... failed to bind\n", DEBUG_BOOTSTRAP, 0); debug_print(L"... failed to bind\n", DEBUG_BOOTSTRAP, 0);
} }
return result; return result;
@ -114,11 +114,11 @@ bind_special(struct pso_pointer frame_pointer, wchar_t *name, wchar_t *doc,
debug_print(doc, DEBUG_BOOTSTRAP, 0); debug_print(doc, DEBUG_BOOTSTRAP, 0);
if (!exceptionp(r)) { if (!exceptionp(r)) {
debug_print(U"... bound\n", DEBUG_BOOTSTRAP, 0); debug_print(L"... bound\n", DEBUG_BOOTSTRAP, 0);
result = result =
make_cons(frame_pointer, make_cons(frame_pointer, n, r), result); make_cons(frame_pointer, make_cons(frame_pointer, n, r), result);
} else { } else {
debug_print(U"... failed to bind\n", DEBUG_BOOTSTRAP, 0); debug_print(L"... failed to bind\n", DEBUG_BOOTSTRAP, 0);
} }
return result; return result;
@ -140,152 +140,152 @@ struct function_data {
/** initialisers for functions */ /** initialisers for functions */
struct function_data function_initialisers[] = { struct function_data function_initialisers[] = {
#ifdef _psse_io_io_h #ifdef _psse_io_io_h
{U"close", U"(close stream): close `stream`.", &lisp_close}, {L"close", L"(close stream): close `stream`.", &lisp_close},
{U"open", {L"open",
U"(open stream), (open stream write?): open `stream`; if `write?` is " L"(open stream), (open stream write?): open `stream`; if `write?` is "
U"present and is non-nil, open for writing, else for reading.", L"present and is non-nil, open for writing, else for reading.",
&lisp_open}, &lisp_open},
{U"slurp", {L"slurp",
U"(slurp stream): read the whole contents of this `stream`, " L"(slurp stream): read the whole contents of this `stream`, "
U"which may " L"which may "
U"be an open stream open for reading or a URL, into a string, and return " L"be an open stream open for reading or a URL, into a string, and return "
U"the " L"the "
U"string.", L"string.",
&lisp_slurp}, &lisp_slurp},
#endif #endif
#ifdef __psse_io_peek_h #ifdef __psse_io_peek_h
{U"peek", {L"peek",
U"(peek stream): return the next character which may be read from " L"(peek stream): return the next character which may be read from "
U"`stream`, without removing it.", L"`stream`, without removing it.",
&peek}, &peek},
#endif #endif
#ifdef __psse_io_print_h #ifdef __psse_io_print_h
{U"print", {L"print",
U"(print object), (print object stream) print this `object` in a format " L"(print object), (print object stream) print this `object` in a format "
U"suitable to be read by `read`, q.v.; if `stream` is specified and is a " L"suitable to be read by `read`, q.v.; if `stream` is specified and is a "
U"stream open for writing, to that stream.", L"stream open for writing, to that stream.",
&print}, &print},
{U"princ", {L"princ",
U"(princ object), (princ object stream) print this `object` in a format " L"(princ object), (princ object stream) print this `object` in a format "
U"more suited to human readers; if `stream` is specified and is a stream " L"more suited to human readers; if `stream` is specified and is a stream "
U"open for writing, to that stream.", L"open for writing, to that stream.",
&print}, &print},
#endif #endif
#ifdef __psse_io_read_h #ifdef __psse_io_read_h
{U"read", {L"read",
U"(read stream) read one complete Lisp expression from `stream`, and " L"(read stream) read one complete Lisp expression from `stream`, and "
U"return that expression unevaluated.", L"return that expression unevaluated.",
&read}, &read},
{U"read-character", {L"read-character",
U"(read-character stream): read a single character from `stream` and " L"(read-character stream): read a single character from `stream` and "
U"return it.", L"return it.",
&read_character}, &read_character},
{U"read-number", {L"read-number",
U"(read-number stream): read a number from `stream` and return it.", L"(read-number stream): read a number from `stream` and return it.",
&read_number}, &read_number},
{U"read-symbol", {L"read-symbol",
U"(read-symbol stream): read a symbol from `stream` and return it.", L"(read-symbol stream): read a symbol from `stream` and return it.",
&read_symbol}, &read_symbol},
#endif #endif
#ifdef __psse_ops_assoc_h #ifdef __psse_ops_assoc_h
{U"assoc", {L"assoc",
U"(assoc key store): search `store` for the value associated with " L"(assoc key store): search `store` for the value associated with "
U"`key`.", L"`key`.",
&assoc}, &assoc},
#endif #endif
#ifdef __psse_ops_bind_h #ifdef __psse_ops_bind_h
{U"bind!", {L"bind!",
U"(bind! key value store): bind `key` to `value` in this store, modifying " L"(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 " L"the store if it is writable to the user, otherwise returning a new "
U"store", L"store",
&bind}, &bind},
#endif #endif
#ifdef __psse_ops_eq_h #ifdef __psse_ops_eq_h
{U"eq", {L"eq",
U"(eq args...): shallow, cheap equality; returns `t` if all `args...` " L"(eq args...): shallow, cheap equality; returns `t` if all `args...` "
U"are the same object, else `nil`.", L"are the same object, else `nil`.",
&eq}, &eq},
{U"equal", {L"equal",
U"(equal a b): expensive, deep equality: returns `t` if objects `a` " L"(equal a b): expensive, deep equality: returns `t` if objects `a` "
U"and `b` have recursively equal value.", L"and `b` have recursively equal value.",
&equal}, &equal},
#endif #endif
#ifdef __psse_ops_eval_apply_h #ifdef __psse_ops_eval_apply_h
// TODO: there's a lot of other stuff in eval_apply.c, which ought to be in // TODO: there's a lot of other stuff in eval_apply.c, which ought to be in
// other files but at present isn't. // other files but at present isn't.
{U"apply", {L"apply",
U"(apply fn args...): apply this `fn` to these `args...` and return " L"(apply fn args...): apply this `fn` to these `args...` and return "
U"their value.", L"their value.",
&lisp_apply}, &lisp_apply},
{U"eval", {L"eval",
U"(eval expression): evaluate this `expression` and return its value", L"(eval expression): evaluate this `expression` and return its value",
&lisp_eval}, &lisp_eval},
#endif #endif
#ifdef __psse_ops_inspect_h #ifdef __psse_ops_inspect_h
{U"inspect", {L"inspect",
U"(inspect expr), (inspect expr write-stream): inspect one complete " L"(inspect expr), (inspect expr write-stream): inspect one complete "
U"lisp expression and return `nil`. If `write-stream` is specified and " L"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 " L"is a write stream, then print to that stream, else to the stream "
U"which is the value of `*out*` in the environment.", L"which is the value of `*out*` in the environment.",
&lisp_inspect}, &lisp_inspect},
#endif #endif
#ifdef __psse_ops_keys_h #ifdef __psse_ops_keys_h
{U"keys", U"(keys store): returns a list of the keys in this `store`.", {L"keys", L"(keys store): returns a list of the keys in this `store`.",
&lisp_keys}, &lisp_keys},
#endif #endif
#ifdef __psse_ops_list_ops_h #ifdef __psse_ops_list_ops_h
{U"count", {L"count",
U"(count sequence): returns the number of top level elements in " L"(count sequence): returns the number of top level elements in "
U"`sequence`.", L"`sequence`.",
&count}, &count},
#endif #endif
#ifdef __psse_ops_mapcar_h #ifdef __psse_ops_mapcar_h
{U"mapcar", {L"mapcar",
U"(mapcar fn list): map this `fn` over this `list`, and return a list " L"(mapcar fn list): map this `fn` over this `list`, and return a list "
U"of the results.", L"of the results.",
&lisp_mapcar}, &lisp_mapcar},
#endif #endif
#ifdef __psse_ops_progn_h #ifdef __psse_ops_progn_h
{U"progn", {L"progn",
U"(progn expressions...): Evaluate each expression in " L"(progn expressions...): Evaluate each expression in "
U"`expressions` in turn and return the value of the last.", L"`expressions` in turn and return the value of the last.",
&lisp_progn}, &lisp_progn},
#endif #endif
#ifdef __psse_ops_repl_h #ifdef __psse_ops_repl_h
{U"repl", U"(repl show_prompt?): Start a new read, eval, print loop.", {L"repl", L"(repl show_prompt?): Start a new read, eval, print loop.",
&repl}, &repl},
#endif #endif
#ifdef __psse_ops_reverse_h #ifdef __psse_ops_reverse_h
{U"reverse", {L"reverse",
U"(reverse sequence): return a sequence like this `sequence`, but with " L"(reverse sequence): return a sequence like this `sequence`, but with "
U"the order of top level elements reversed.", L"the order of top level elements reversed.",
&reverse}, &reverse},
#endif #endif
#ifdef __psse_ops_truth_h #ifdef __psse_ops_truth_h
{U"and", {L"and",
U"(and expressions...): returns `t` if none of these `expressions...` " L"(and expressions...): returns `t` if none of these `expressions...` "
U"evaluates to `nil`, else `nil`.", L"evaluates to `nil`, else `nil`.",
&and}, &and},
{U"nil?", {L"nil?",
U"(nil? expression): returns `t` if `expression` evaluates to `nil`, else " L"(nil? expression): returns `t` if `expression` evaluates to `nil`, else "
U"`nil`.", L"`nil`.",
&nilp}, &nilp},
{U"not", {L"not",
U"(not expression): returns `t` unless `expression` evaluates to `nil`, " L"(not expression): returns `t` unless `expression` evaluates to `nil`, "
U"else " L"else "
U"`nil`.", L"`nil`.",
&not}, &not},
{U"or", {L"or",
U"(or expressions...): returns `nil` if every one of these `expressions...` " L"(or expressions...): returns `nil` if every one of these `expressions...` "
U"evaluates to `nil`, else `t`.", L"evaluates to `nil`, else `t`.",
&or}, &or},
{U"true?", {L"true?",
U"(true? expression): returns `t` if `expression` evaluates to `t`, else " L"(true? expression): returns `t` if `expression` evaluates to `t`, else "
U"`nil`.", L"`nil`.",
&truep}, &truep},
#endif #endif
{U"END MARKER", U"END MARKER", NULL}}; {L"END MARKER", L"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
@ -296,22 +296,22 @@ struct function_data function_initialisers[] = {
/** initialisers for special forms */ /** initialisers for special forms */
struct function_data special_initialisers[] = { struct function_data special_initialisers[] = {
#ifdef __psse_ops_cond_h #ifdef __psse_ops_cond_h
{U"cond", {L"cond",
U"(cond clauses...): special form; conditional. Each `clause` is expected " L"(cond clauses...): special form; conditional. Each `clause` is expected "
U"to be a " L"to be a "
U"list; if the first item in such a list evaluates to non-nil, the " L"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 " L"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 " L"the last returned. If no arg `clause` has a first element which "
U"evaluates to non nil, then nil is returned", L"evaluates to non nil, then nil is returned",
&lisp_cond}, &lisp_cond},
#endif #endif
#ifdef __psse_ops_quote_h #ifdef __psse_ops_quote_h
{U"quote", {L"quote",
U"(quote expression): special form; protect `expression` from " L"(quote expression): special form; protect `expression` from "
U"evaluation.", L"evaluation.",
&quote}, &quote},
#endif #endif
{U"END MARKER", U"END MARKER", NULL}}; {L"END MARKER", L"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) {

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

@ -28,8 +28,17 @@
*/ */
struct pso_pointer privileged_keyword_bootstrap; struct pso_pointer privileged_keyword_bootstrap;
/**
* documentation metadate for functions and special forms (and possibly other
* things)
*/
struct pso_pointer privileged_keyword_documentation; struct pso_pointer privileged_keyword_documentation;
/**
* key for layer metadata for functions and special forms
*/
struct pso_pointer privileged_keyword_layer;
/** /**
* location metadata for exceptions (and possibly location in other contexts). * location metadata for exceptions (and possibly location in other contexts).
*/ */
@ -40,6 +49,16 @@ struct pso_pointer privileged_keyword_location;
*/ */
struct pso_pointer privileged_keyword_name; struct pso_pointer privileged_keyword_name;
/**
* layer metadata for functions that users shouldn't be able to override.
*/
struct pso_pointer privileged_keyword_system;
/**
* layer metadata for functions written by users.
*/
struct pso_pointer privileged_keyword_user;
#define load_and_lock(var,val)(var = lock_object(c_string_to_lisp_keyword(frame_pointer, val))) #define load_and_lock(var,val)(var = lock_object(c_string_to_lisp_keyword(frame_pointer, val)))
@ -47,6 +66,9 @@ struct pso_pointer privileged_keyword_name;
struct pso_pointer initialise_privileged_keywords(struct pso_pointer frame_pointer) { struct pso_pointer initialise_privileged_keywords(struct pso_pointer frame_pointer) {
load_and_lock(privileged_keyword_bootstrap, PK_BOOTSTRAP); load_and_lock(privileged_keyword_bootstrap, PK_BOOTSTRAP);
load_and_lock(privileged_keyword_documentation, PK_DOCUMENTATION); load_and_lock(privileged_keyword_documentation, PK_DOCUMENTATION);
load_and_lock(privileged_keyword_layer, PK_LAYER);
load_and_lock(privileged_keyword_location, PK_LOCATION); load_and_lock(privileged_keyword_location, PK_LOCATION);
load_and_lock( privileged_keyword_name, PK_NAME); load_and_lock( privileged_keyword_name, PK_NAME);
load_and_lock(privileged_keyword_system, PK_SYSTEM);
load_and_lock(privileged_keyword_user, PK_USER);
} }

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

@ -13,15 +13,21 @@
#define SRC_C_ENVIRONMENT_PRIVILEGED_KEYWORDS_H_ #define SRC_C_ENVIRONMENT_PRIVILEGED_KEYWORDS_H_
#include "memory/pointer.h" #include "memory/pointer.h"
#define PK_BOOTSTRAP U"bootstrap" #define PK_BOOTSTRAP L"bootstrap"
#define PK_DOCUMENTATION U"documentation" #define PK_DOCUMENTATION L"documentation"
#define PK_LOCATION U"location" #define PK_LAYER L"layer"
#define PK_NAME U"name" #define PK_LOCATION L"location"
#define PK_NAME L"name"
#define PK_SYSTEM L"system"
#define PK_USER L"user"
extern struct pso_pointer privileged_keyword_bootstrap; extern struct pso_pointer privileged_keyword_bootstrap;
extern struct pso_pointer privileged_keyword_documentation; extern struct pso_pointer privileged_keyword_documentation;
extern struct pso_pointer privileged_keyword_layer;
extern struct pso_pointer privileged_keyword_location; extern struct pso_pointer privileged_keyword_location;
extern struct pso_pointer privileged_keyword_name; extern struct pso_pointer privileged_keyword_name;
extern struct pso_pointer privileged_keyword_system;
extern struct pso_pointer privileged_keyword_user;
struct pso_pointer initialise_privileged_keywords( struct pso_pointer env); struct pso_pointer initialise_privileged_keywords( struct pso_pointer env);
#endif /* SRC_C_ENVIRONMENT_PRIVILEGED_KEYWORDS_H_ */ #endif /* SRC_C_ENVIRONMENT_PRIVILEGED_KEYWORDS_H_ */

2
src/c/memory/tags.h
View file

@ -43,7 +43,7 @@
#define STRINGTAG "STR" #define STRINGTAG "STR"
#define SYMBOLTAG "SYM" #define SYMBOLTAG "SYM"
#define TIMETAG "TIM" #define TIMETAG "TIM"
#define TRUETAG "TRU" #define TRUETAG "TRL"
#define VECTORTAG "VEC" #define VECTORTAG "VEC"
#define VECTORPOINTTAG "VSP" #define VECTORPOINTTAG "VSP"
#define WRITETAG "WRT" #define WRITETAG "WRT"

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

@ -35,7 +35,7 @@ struct pso_pointer eval_cond_clause( struct pso_pointer clause,
struct pso_pointer env = fetch_env(frame_pointer); struct pso_pointer env = fetch_env(frame_pointer);
#ifdef DEBUG #ifdef DEBUG
debug_print( U"\n\tCond clause: ", DEBUG_EVAL, 0 ); debug_print( L"\n\tCond clause: ", DEBUG_EVAL, 0 );
debug_print_object( clause, DEBUG_EVAL, 0 ); debug_print_object( clause, DEBUG_EVAL, 0 );
debug_println( DEBUG_EVAL); debug_println( DEBUG_EVAL);
#endif #endif
@ -50,19 +50,19 @@ struct pso_pointer eval_cond_clause( struct pso_pointer clause,
c_progn( frame, frame_pointer, c_cdr( clause ), env ) ); c_progn( frame, frame_pointer, c_cdr( clause ), env ) );
#ifdef DEBUG #ifdef DEBUG
debug_print( U"\n\t\tCond clause ", DEBUG_EVAL, 0 ); debug_print( L"\n\t\tCond clause ", DEBUG_EVAL, 0 );
debug_print_object( clause, DEBUG_EVAL, 0 ); debug_print_object( clause, DEBUG_EVAL, 0 );
debug_print( U" succeeded; returning: ", DEBUG_EVAL, 0 ); debug_print( L" succeeded; returning: ", DEBUG_EVAL, 0 );
debug_print_object( result, DEBUG_EVAL, 0 ); debug_print_object( result, DEBUG_EVAL, 0 );
debug_println( DEBUG_EVAL); debug_println( DEBUG_EVAL);
} else { } else {
debug_print( U"\n\t\tCond clause ", DEBUG_EVAL, 0 ); debug_print( L"\n\t\tCond clause ", DEBUG_EVAL, 0 );
debug_print_object( clause, DEBUG_EVAL, 0 ); debug_print_object( clause, DEBUG_EVAL, 0 );
debug_print( U" failed.\n", DEBUG_EVAL, 0 ); debug_print( L" failed.\n", DEBUG_EVAL, 0 );
#endif #endif
} }
} else { } else {
result = throw_exception( c_string_to_lisp_symbol( frame_pointer, U"cond" ), result = throw_exception( c_string_to_lisp_symbol( frame_pointer, L"cond" ),
c_string_to_lisp_string c_string_to_lisp_string
(frame_pointer, L"Arguments to `cond` must be lists" ), (frame_pointer, L"Arguments to `cond` must be lists" ),
frame_pointer ); frame_pointer );
@ -103,7 +103,7 @@ struct pso_pointer lisp_cond(struct pso_pointer frame_pointer) {
} }
} }
#ifdef DEBUG #ifdef DEBUG
debug_print( U"\tCond returning: ", DEBUG_EVAL, 0 ); debug_print( L"\tCond returning: ", DEBUG_EVAL, 0 );
debug_print_object( result, DEBUG_EVAL, 0 ); debug_print_object( result, DEBUG_EVAL, 0 );
debug_println( DEBUG_EVAL); debug_println( DEBUG_EVAL);
#endif #endif

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

@ -46,6 +46,8 @@ bool c_equal( struct pso_pointer a, struct pso_pointer b ) {
if ( c_eq( a, b ) ) { if ( c_eq( a, b ) ) {
result = true; result = true;
} else if ( get_tag_value( a ) == get_tag_value( b ) ) { } else if ( get_tag_value( a ) == get_tag_value( b ) ) {
/* assume true and try to falsify */
result = true;
struct pso2 *oa = pointer_to_object( a ); struct pso2 *oa = pointer_to_object( a );
struct pso2 *ob = pointer_to_object( b ); struct pso2 *ob = pointer_to_object( b );
@ -88,7 +90,7 @@ bool c_equal( struct pso_pointer a, struct pso_pointer b ) {
/** /**
* Function; do all arguments to this finction point to the same object? * Function; do all arguments to this function point to the same object?
* *
* Shallow, cheap equality. * Shallow, cheap equality.
* *

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

@ -601,7 +601,7 @@ struct pso_pointer lisp_apply( struct pso_pointer frame_pointer) {
special. special.
executable ) ) executable ) )
( next_pointer ), fn_pointer ); ( next_pointer ), fn_pointer );
debug_print( U"Special form returning: ", DEBUG_EVAL, debug_print( L"Special form returning: ", DEBUG_EVAL,
0 ); 0 );
debug_print_object( result, DEBUG_EVAL, 0 ); debug_print_object( result, DEBUG_EVAL, 0 );
debug_println( DEBUG_EVAL); debug_println( DEBUG_EVAL);
@ -623,7 +623,7 @@ struct pso_pointer lisp_apply( struct pso_pointer frame_pointer) {
c_string_to_lisp_string( frame_pointer, buffer ); c_string_to_lisp_string( frame_pointer, buffer );
free( buffer ); free( buffer );
result = result =
throw_exception( c_string_to_lisp_symbol( frame_pointer, U"apply" ), throw_exception( c_string_to_lisp_symbol( frame_pointer, L"apply" ),
message, frame_pointer ); message, frame_pointer );
} }
} }

8
src/c/ops/mapcar.c
View file

@ -27,7 +27,7 @@
struct pso_pointer lisp_mapcar( struct pso_pointer frame_pointer ) { struct pso_pointer lisp_mapcar( struct pso_pointer frame_pointer ) {
struct pso_pointer result = nil; struct pso_pointer result = nil;
struct pso4* frame = pointer_to_pso4(frame_pointer); struct pso4* frame = pointer_to_pso4(frame_pointer);
debug_print( U"Mapcar: ", DEBUG_EVAL, 0 ); debug_print( L"Mapcar: ", DEBUG_EVAL, 0 );
debug_dump_object( frame_pointer, DEBUG_EVAL, 0 ); debug_dump_object( frame_pointer, DEBUG_EVAL, 0 );
int i = 0; int i = 0;
@ -38,7 +38,7 @@ struct pso_pointer lisp_mapcar( struct pso_pointer frame_pointer ) {
make_cons( frame_pointer, frame->payload.stack_frame.arg[0], make_cons( frame_pointer, frame->payload.stack_frame.arg[0],
make_cons( frame_pointer, c_car( c ), nil ) ) ); make_cons( frame_pointer, c_car( c ), nil ) ) );
debug_printf( DEBUG_EVAL, 0, U"Mapcar %d, evaluating ", i ); debug_printf( DEBUG_EVAL, 0, L"Mapcar %d, evaluating ", i );
debug_print_object( expr, DEBUG_EVAL, 0 ); debug_print_object( expr, DEBUG_EVAL, 0 );
debug_println( DEBUG_EVAL); debug_println( DEBUG_EVAL);
@ -50,14 +50,14 @@ struct pso_pointer lisp_mapcar( struct pso_pointer frame_pointer ) {
} else { } else {
result = push_local( frame_pointer, make_cons( frame_pointer, r, result )); result = push_local( frame_pointer, make_cons( frame_pointer, r, result ));
} }
debug_printf( DEBUG_EVAL, 0, U"Mapcar %d, result is ", i++ ); debug_printf( DEBUG_EVAL, 0, L"Mapcar %d, result is ", i++ );
debug_print_object( result, DEBUG_EVAL, 0 ); debug_print_object( result, DEBUG_EVAL, 0 );
debug_println( DEBUG_EVAL); debug_println( DEBUG_EVAL);
} }
result = consp( result ) ? c_reverse( frame_pointer, result ) : result; result = consp( result ) ? c_reverse( frame_pointer, result ) : result;
debug_print( U"Mapcar returning: ", DEBUG_EVAL, 0 ); debug_print( L"Mapcar returning: ", DEBUG_EVAL, 0 );
debug_print_object( result, DEBUG_EVAL, 0 ); debug_print_object( result, DEBUG_EVAL, 0 );
debug_println( DEBUG_EVAL ); debug_println( DEBUG_EVAL );

10
src/c/payloads/exception.c
View file

@ -114,15 +114,15 @@ struct pso_pointer throw_exception_with_cause( struct pso_pointer location,
struct pso_pointer result = nil; struct pso_pointer result = nil;
#ifdef DEBUG #ifdef DEBUG
debug_print( U"\nERROR: `", DEBUG_ANY, 0 ); debug_print( L"\nERROR: `", DEBUG_ANY, 0 );
debug_print_object( message, DEBUG_ANY, 0 ); debug_print_object( message, DEBUG_ANY, 0 );
debug_print( U"` at `", DEBUG_ANY, 0 ); debug_print( L"` at `", DEBUG_ANY, 0 );
debug_print_object( location, DEBUG_ANY, 0 ); debug_print_object( location, DEBUG_ANY, 0 );
debug_print( U"`\n", DEBUG_ANY, 0 ); debug_print( L"`\n", DEBUG_ANY, 0 );
if ( !c_nilp( cause ) ) { if ( !c_nilp( cause ) ) {
debug_print( U"\tCaused by: ", DEBUG_ANY, 0 ); debug_print( L"\tCaused by: ", DEBUG_ANY, 0 );
debug_print_object( cause, DEBUG_ANY, 0); debug_print_object( cause, DEBUG_ANY, 0);
debug_print( U"`\n", DEBUG_ANY, 0 ); debug_print( L"`\n", DEBUG_ANY, 0 );
} }
#endif #endif
struct pso2 *cell = pointer_to_object( message ); struct pso2 *cell = pointer_to_object( message );

3
src/sh/wchar_t_everywhere.sh
View file

@ -4,5 +4,6 @@ for file in src/c/*/*.[ch]
do do
echo $file echo $file
cp $file $file.bak cp $file $file.bak
sed 's/char32_t/wchar_t/g' $file.bak > $file sed 's/char32_t/wchar_t/g' $file.bak |\
sed 's/U"/L"/g' > $file
done done