Compare commits
2 commits
c29a95b00d
...
5e64a33965
| Author | SHA1 | Date | |
|---|---|---|---|
| 5e64a33965 | |||
| 271b7da46a |
19 changed files with 203 additions and 164 deletions
|
|
@ -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
|
||||
|
||||
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 );
|
||||
|
||||
if ( ( n.page == 0 ) && ( n.offset == 0 ) ) {
|
||||
|
|
@ -56,14 +56,14 @@ struct pso_pointer initialise_environment( uint32_t node ) {
|
|||
|
||||
nil = n;
|
||||
lock_object( nil );
|
||||
debug_print( U"success\n", DEBUG_BOOTSTRAP, 0 );
|
||||
debug_print( L"success\n", DEBUG_BOOTSTRAP, 0 );
|
||||
} else {
|
||||
result = nil;
|
||||
debug_print( U"fail\n", DEBUG_BOOTSTRAP, 0 );
|
||||
debug_print( L"fail\n", DEBUG_BOOTSTRAP, 0 );
|
||||
}
|
||||
}
|
||||
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 );
|
||||
|
||||
// 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;
|
||||
lock_object( t );
|
||||
debug_print( U"success\n", DEBUG_BOOTSTRAP, 0 );
|
||||
debug_print( L"success\n", DEBUG_BOOTSTRAP, 0 );
|
||||
} else {
|
||||
result = nil;
|
||||
debug_print( U"fail\n", DEBUG_BOOTSTRAP, 0 );
|
||||
debug_print( L"fail\n", DEBUG_BOOTSTRAP, 0 );
|
||||
}
|
||||
}
|
||||
if ( !exceptionp( result ) ) {
|
||||
|
|
@ -85,22 +85,22 @@ struct pso_pointer initialise_environment( uint32_t node ) {
|
|||
result =
|
||||
lisp_bind( make_frame
|
||||
( 3, frame_pointer,
|
||||
c_string_to_lisp_symbol( frame_pointer, U"nil" ), nil,
|
||||
c_string_to_lisp_symbol( frame_pointer, L"nil" ), nil,
|
||||
nil ) );
|
||||
debug_print( U"Environment after binding `nil`: ", DEBUG_BOOTSTRAP,
|
||||
debug_print( L"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, U"t" ), t,
|
||||
c_string_to_lisp_symbol( frame_pointer, L"t" ), t,
|
||||
result ) );
|
||||
|
||||
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( U"\nEnvironment initialised successfully.\n",
|
||||
debug_print( L"\nEnvironment initialised successfully.\n",
|
||||
DEBUG_BOOTSTRAP, 0 );
|
||||
|
||||
initialise_privileged_keywords(frame_pointer);
|
||||
|
|
|
|||
|
|
@ -59,7 +59,7 @@
|
|||
*/
|
||||
|
||||
struct pso_pointer
|
||||
bind_function(struct pso_pointer frame_pointer, char32_t *name, char32_t *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);
|
||||
|
|
@ -67,7 +67,7 @@ bind_function(struct pso_pointer frame_pointer, char32_t *name, char32_t *doc,
|
|||
|
||||
struct pso_pointer meta = make_cons(
|
||||
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, privileged_keyword_name, n),
|
||||
make_cons(frame_pointer,
|
||||
|
|
@ -79,11 +79,11 @@ bind_function(struct pso_pointer frame_pointer, char32_t *name, char32_t *doc,
|
|||
|
||||
debug_print(doc, DEBUG_BOOTSTRAP, 0);
|
||||
if (!exceptionp(r)) {
|
||||
debug_print(U"... bound\n", DEBUG_BOOTSTRAP, 0);
|
||||
debug_print(L"... 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);
|
||||
debug_print(L"... failed to bind\n", DEBUG_BOOTSTRAP, 0);
|
||||
}
|
||||
|
||||
return result;
|
||||
|
|
@ -94,7 +94,7 @@ bind_function(struct pso_pointer frame_pointer, char32_t *name, char32_t *doc,
|
|||
* this `name` in the `oblist`.
|
||||
*/
|
||||
struct pso_pointer
|
||||
bind_special(struct pso_pointer frame_pointer, char32_t *name, char32_t *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);
|
||||
|
|
@ -114,19 +114,19 @@ bind_special(struct pso_pointer frame_pointer, char32_t *name, char32_t *doc,
|
|||
|
||||
debug_print(doc, DEBUG_BOOTSTRAP, 0);
|
||||
if (!exceptionp(r)) {
|
||||
debug_print(U"... bound\n", DEBUG_BOOTSTRAP, 0);
|
||||
debug_print(L"... 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);
|
||||
debug_print(L"... failed to bind\n", DEBUG_BOOTSTRAP, 0);
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
struct function_data {
|
||||
char32_t *name;
|
||||
char32_t *documentation;
|
||||
wchar_t *name;
|
||||
wchar_t *documentation;
|
||||
void *executable;
|
||||
};
|
||||
|
||||
|
|
@ -140,152 +140,152 @@ struct function_data {
|
|||
/** initialisers for functions */
|
||||
struct function_data function_initialisers[] = {
|
||||
#ifdef _psse_io_io_h
|
||||
{U"close", U"(close stream): close `stream`.", &lisp_close},
|
||||
{U"open",
|
||||
U"(open stream), (open stream write?): open `stream`; if `write?` is "
|
||||
U"present and is non-nil, open for writing, else for reading.",
|
||||
{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},
|
||||
{U"slurp",
|
||||
U"(slurp stream): read the whole contents of this `stream`, "
|
||||
U"which may "
|
||||
U"be an open stream open for reading or a URL, into a string, and return "
|
||||
U"the "
|
||||
U"string.",
|
||||
{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
|
||||
{U"peek",
|
||||
U"(peek stream): return the next character which may be read from "
|
||||
U"`stream`, without removing it.",
|
||||
{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
|
||||
{U"print",
|
||||
U"(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 "
|
||||
U"stream open for writing, to that stream.",
|
||||
{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},
|
||||
{U"princ",
|
||||
U"(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 "
|
||||
U"open for writing, to that stream.",
|
||||
{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
|
||||
{U"read",
|
||||
U"(read stream) read one complete Lisp expression from `stream`, and "
|
||||
U"return that expression unevaluated.",
|
||||
{L"read",
|
||||
L"(read stream) read one complete Lisp expression from `stream`, and "
|
||||
L"return that expression unevaluated.",
|
||||
&read},
|
||||
{U"read-character",
|
||||
U"(read-character stream): read a single character from `stream` and "
|
||||
U"return it.",
|
||||
{L"read-character",
|
||||
L"(read-character stream): read a single character from `stream` and "
|
||||
L"return it.",
|
||||
&read_character},
|
||||
{U"read-number",
|
||||
U"(read-number stream): read a number from `stream` and return it.",
|
||||
{L"read-number",
|
||||
L"(read-number stream): read a number from `stream` and return it.",
|
||||
&read_number},
|
||||
{U"read-symbol",
|
||||
U"(read-symbol stream): read a symbol from `stream` and return it.",
|
||||
{L"read-symbol",
|
||||
L"(read-symbol stream): read a symbol from `stream` and return it.",
|
||||
&read_symbol},
|
||||
#endif
|
||||
#ifdef __psse_ops_assoc_h
|
||||
{U"assoc",
|
||||
U"(assoc key store): search `store` for the value associated with "
|
||||
U"`key`.",
|
||||
{L"assoc",
|
||||
L"(assoc key store): search `store` for the value associated with "
|
||||
L"`key`.",
|
||||
&assoc},
|
||||
#endif
|
||||
#ifdef __psse_ops_bind_h
|
||||
{U"bind!",
|
||||
U"(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 "
|
||||
U"store",
|
||||
{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
|
||||
{U"eq",
|
||||
U"(eq args...): shallow, cheap equality; returns `t` if all `args...` "
|
||||
U"are the same object, else `nil`.",
|
||||
{L"eq",
|
||||
L"(eq args...): shallow, cheap equality; returns `t` if all `args...` "
|
||||
L"are the same object, else `nil`.",
|
||||
&eq},
|
||||
{U"equal",
|
||||
U"(equal a b): expensive, deep equality: returns `t` if objects `a` "
|
||||
U"and `b` have recursively equal value.",
|
||||
{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.
|
||||
{U"apply",
|
||||
U"(apply fn args...): apply this `fn` to these `args...` and return "
|
||||
U"their value.",
|
||||
{L"apply",
|
||||
L"(apply fn args...): apply this `fn` to these `args...` and return "
|
||||
L"their value.",
|
||||
&lisp_apply},
|
||||
{U"eval",
|
||||
U"(eval expression): evaluate this `expression` and return its value",
|
||||
{L"eval",
|
||||
L"(eval expression): evaluate this `expression` and return its value",
|
||||
&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.",
|
||||
{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
|
||||
{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},
|
||||
#endif
|
||||
#ifdef __psse_ops_list_ops_h
|
||||
{U"count",
|
||||
U"(count sequence): returns the number of top level elements in "
|
||||
U"`sequence`.",
|
||||
{L"count",
|
||||
L"(count sequence): returns the number of top level elements in "
|
||||
L"`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.",
|
||||
{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
|
||||
{U"progn",
|
||||
U"(progn expressions...): Evaluate each expression in "
|
||||
U"`expressions` in turn and return the value of the last.",
|
||||
{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
|
||||
{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},
|
||||
#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.",
|
||||
{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
|
||||
{U"and",
|
||||
U"(and expressions...): returns `t` if none of these `expressions...` "
|
||||
U"evaluates to `nil`, else `nil`.",
|
||||
{L"and",
|
||||
L"(and expressions...): returns `t` if none of these `expressions...` "
|
||||
L"evaluates to `nil`, else `nil`.",
|
||||
&and},
|
||||
{U"nil?",
|
||||
U"(nil? expression): returns `t` if `expression` evaluates to `nil`, else "
|
||||
U"`nil`.",
|
||||
{L"nil?",
|
||||
L"(nil? expression): returns `t` if `expression` evaluates to `nil`, else "
|
||||
L"`nil`.",
|
||||
&nilp},
|
||||
{U"not",
|
||||
U"(not expression): returns `t` unless `expression` evaluates to `nil`, "
|
||||
U"else "
|
||||
U"`nil`.",
|
||||
{L"not",
|
||||
L"(not expression): returns `t` unless `expression` evaluates to `nil`, "
|
||||
L"else "
|
||||
L"`nil`.",
|
||||
¬},
|
||||
{U"or",
|
||||
U"(or expressions...): returns `nil` if every one of these `expressions...` "
|
||||
U"evaluates to `nil`, else `t`.",
|
||||
{L"or",
|
||||
L"(or expressions...): returns `nil` if every one of these `expressions...` "
|
||||
L"evaluates to `nil`, else `t`.",
|
||||
&or},
|
||||
{U"true?",
|
||||
U"(true? expression): returns `t` if `expression` evaluates to `t`, else "
|
||||
U"`nil`.",
|
||||
{L"true?",
|
||||
L"(true? expression): returns `t` if `expression` evaluates to `t`, else "
|
||||
L"`nil`.",
|
||||
&truep},
|
||||
#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
|
||||
* 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 */
|
||||
struct function_data special_initialisers[] = {
|
||||
#ifdef __psse_ops_cond_h
|
||||
{U"cond",
|
||||
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",
|
||||
{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
|
||||
{U"quote",
|
||||
U"(quote expression): special form; protect `expression` from "
|
||||
U"evaluation.",
|
||||
{L"quote",
|
||||
L"(quote expression): special form; protect `expression` from "
|
||||
L"evaluation.",
|
||||
"e},
|
||||
#endif
|
||||
{U"END MARKER", U"END MARKER", NULL}};
|
||||
{L"END MARKER", L"END MARKER", NULL}};
|
||||
|
||||
struct pso_pointer
|
||||
initialise_function_bindings(struct pso_pointer frame_pointer) {
|
||||
|
|
|
|||
|
|
@ -28,8 +28,17 @@
|
|||
*/
|
||||
struct pso_pointer privileged_keyword_bootstrap;
|
||||
|
||||
/**
|
||||
* documentation metadate for functions and special forms (and possibly other
|
||||
* things)
|
||||
*/
|
||||
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).
|
||||
*/
|
||||
|
|
@ -40,6 +49,16 @@ struct pso_pointer privileged_keyword_location;
|
|||
*/
|
||||
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)))
|
||||
|
||||
|
|
@ -47,6 +66,9 @@ struct pso_pointer privileged_keyword_name;
|
|||
struct pso_pointer initialise_privileged_keywords(struct pso_pointer frame_pointer) {
|
||||
load_and_lock(privileged_keyword_bootstrap, PK_BOOTSTRAP);
|
||||
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_name, PK_NAME);
|
||||
load_and_lock(privileged_keyword_system, PK_SYSTEM);
|
||||
load_and_lock(privileged_keyword_user, PK_USER);
|
||||
}
|
||||
|
|
@ -13,15 +13,21 @@
|
|||
#define SRC_C_ENVIRONMENT_PRIVILEGED_KEYWORDS_H_
|
||||
#include "memory/pointer.h"
|
||||
|
||||
#define PK_BOOTSTRAP U"bootstrap"
|
||||
#define PK_DOCUMENTATION U"documentation"
|
||||
#define PK_LOCATION U"location"
|
||||
#define PK_NAME U"name"
|
||||
#define PK_BOOTSTRAP L"bootstrap"
|
||||
#define PK_DOCUMENTATION L"documentation"
|
||||
#define PK_LAYER L"layer"
|
||||
#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_documentation;
|
||||
extern struct pso_pointer privileged_keyword_layer;
|
||||
extern struct pso_pointer privileged_keyword_location;
|
||||
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);
|
||||
#endif /* SRC_C_ENVIRONMENT_PRIVILEGED_KEYWORDS_H_ */
|
||||
|
|
|
|||
|
|
@ -287,8 +287,8 @@ wint_t url_fgetwc( URL_FILE *input ) {
|
|||
break;
|
||||
case CFTYPE_CURL:{
|
||||
char *cbuff =
|
||||
calloc( sizeof( char32_t ) + 2, sizeof( char ) );
|
||||
char32_t *wbuff = calloc( 2, sizeof( char32_t ) );
|
||||
calloc( sizeof( wchar_t ) + 2, sizeof( char ) );
|
||||
wchar_t *wbuff = calloc( 2, sizeof( wchar_t ) );
|
||||
size_t count = 0;
|
||||
debug_print( L"url_fgetwc: about to call url_fgets\n",
|
||||
DEBUG_IO, 0 );
|
||||
|
|
@ -409,7 +409,7 @@ struct pso_pointer lisp_close( struct pso_pointer frame_pointer) {
|
|||
}
|
||||
|
||||
struct pso_pointer add_meta_integer( struct pso_pointer frame_pointer,
|
||||
struct pso_pointer meta, char32_t *key,
|
||||
struct pso_pointer meta, wchar_t *key,
|
||||
long int value ) {
|
||||
return make_cons( frame_pointer,
|
||||
make_cons( frame_pointer,
|
||||
|
|
@ -420,10 +420,10 @@ struct pso_pointer add_meta_integer( struct pso_pointer frame_pointer,
|
|||
}
|
||||
|
||||
struct pso_pointer add_meta_string( struct pso_pointer frame_pointer,
|
||||
struct pso_pointer meta, char32_t *key,
|
||||
struct pso_pointer meta, wchar_t *key,
|
||||
char *value ) {
|
||||
value = trim( value );
|
||||
char32_t buffer[strlen( value ) + 1];
|
||||
wchar_t buffer[strlen( value ) + 1];
|
||||
mbstowcs( buffer, value, strlen( value ) + 1 );
|
||||
return make_cons( frame_pointer,
|
||||
make_cons( frame_pointer,
|
||||
|
|
@ -434,7 +434,7 @@ struct pso_pointer add_meta_string( struct pso_pointer frame_pointer,
|
|||
}
|
||||
|
||||
struct pso_pointer add_meta_time( struct pso_pointer frame_pointer,
|
||||
struct pso_pointer meta, char32_t *key,
|
||||
struct pso_pointer meta, wchar_t *key,
|
||||
time_t *value ) {
|
||||
return make_cons( frame_pointer,
|
||||
make_cons( frame_pointer,
|
||||
|
|
@ -465,7 +465,7 @@ static size_t write_meta_callback( struct pso_pointer frame_pointer,
|
|||
s[offset] = ( char ) 0;
|
||||
char *name = trim( s );
|
||||
char *value = trim( &s[++offset] );
|
||||
char32_t wname[strlen( name )];
|
||||
wchar_t wname[strlen( name )];
|
||||
mbstowcs( wname, name, strlen( name ) + 1 );
|
||||
object->payload.stream.meta =
|
||||
add_meta_string( frame_pointer, object->payload.stream.meta,
|
||||
|
|
@ -667,7 +667,7 @@ struct pso_pointer lisp_slurp( struct pso_pointer frame_pointer) {
|
|||
debug_dump_object( result, DEBUG_IO, 0 );
|
||||
debug_println( DEBUG_IO );
|
||||
struct pso2 *cell = pointer_to_object( cursor );
|
||||
cursor = make_string( frame_pointer, ( char32_t ) c, nil );
|
||||
cursor = make_string( frame_pointer, ( wchar_t ) c, nil );
|
||||
cell->payload.string.cdr = cursor;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -58,7 +58,7 @@ struct pso_pointer in_write( struct pso_pointer p, URL_FILE * output,
|
|||
* TODO: this does not yet even nearly cope with all the possible special
|
||||
* cases.
|
||||
*/
|
||||
void write_char( char32_t wc, URL_FILE *output, bool escape ) {
|
||||
void write_char( wchar_t wc, URL_FILE *output, bool escape ) {
|
||||
if ( escape && !iswprint( wc ) ) {
|
||||
url_fwprintf( output, L"\\%04x", wc );
|
||||
// url_fputwc(L'\\', output);
|
||||
|
|
@ -83,7 +83,7 @@ struct pso_pointer print_string_like_thing( struct pso_pointer p,
|
|||
if ( keywordp( p ) || stringp( p ) || symbolp( p ) ) {
|
||||
for ( struct pso_pointer cursor = p; !c_nilp( cursor );
|
||||
cursor = pointer_to_object( cursor )->payload.string.cdr ) {
|
||||
char32_t wc =
|
||||
wchar_t wc =
|
||||
pointer_to_object( cursor )->payload.string.character;
|
||||
|
||||
write_char( wc, output, escape );
|
||||
|
|
|
|||
|
|
@ -141,7 +141,7 @@ struct pso_pointer read_number( struct pso_pointer frame_pointer ) {
|
|||
character =
|
||||
read_character( make_frame( 1, frame_pointer, stream ) );
|
||||
}
|
||||
char32_t c = c_nilp( character )
|
||||
wchar_t c = c_nilp( character )
|
||||
? 0 : pointer_to_object( character )->payload.character.character;
|
||||
|
||||
URL_FILE *input = pointer_to_object( stream )->payload.stream.stream;
|
||||
|
|
@ -173,7 +173,7 @@ struct pso_pointer read_symbol( struct pso_pointer frame_pointer ) {
|
|||
read_character( make_frame( 1, frame_pointer, stream ) );
|
||||
}
|
||||
|
||||
char32_t c = c_nilp( character )
|
||||
wchar_t c = c_nilp( character )
|
||||
? 0 : pointer_to_object( character )->payload.character.character;
|
||||
|
||||
URL_FILE *input = pointer_to_object( stream )->payload.stream.stream;
|
||||
|
|
@ -233,7 +233,7 @@ struct pso_pointer read( struct pso_pointer frame_pointer ) {
|
|||
if ( !c_nilp( readmacro ) ) {
|
||||
// invoke the read macro on the stream
|
||||
} else if ( readp( stream ) && characterp( character ) ) {
|
||||
char32_t c =
|
||||
wchar_t c =
|
||||
pointer_to_object( character )->payload.character.character;
|
||||
URL_FILE *input = pointer_to_object( stream )->payload.stream.stream;
|
||||
|
||||
|
|
|
|||
|
|
@ -39,7 +39,7 @@ struct pso_pointer get_tag_string( struct pso_pointer frame_pointer,
|
|||
for ( int i = 2 - 1; i >= 0; i-- ) {
|
||||
result =
|
||||
make_string( frame_pointer,
|
||||
( char32_t ) ( object->header.tag.bytes.mnemonic[i] ),
|
||||
( wchar_t ) ( object->header.tag.bytes.mnemonic[i] ),
|
||||
result );
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -43,7 +43,7 @@
|
|||
#define STRINGTAG "STR"
|
||||
#define SYMBOLTAG "SYM"
|
||||
#define TIMETAG "TIM"
|
||||
#define TRUETAG "TRU"
|
||||
#define TRUETAG "TRL"
|
||||
#define VECTORTAG "VEC"
|
||||
#define VECTORPOINTTAG "VSP"
|
||||
#define WRITETAG "WRT"
|
||||
|
|
|
|||
|
|
@ -35,7 +35,7 @@ struct pso_pointer eval_cond_clause( struct pso_pointer clause,
|
|||
struct pso_pointer env = fetch_env(frame_pointer);
|
||||
|
||||
#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_println( DEBUG_EVAL);
|
||||
#endif
|
||||
|
|
@ -50,19 +50,19 @@ struct pso_pointer eval_cond_clause( struct pso_pointer clause,
|
|||
c_progn( frame, frame_pointer, c_cdr( clause ), env ) );
|
||||
|
||||
#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( U" succeeded; returning: ", DEBUG_EVAL, 0 );
|
||||
debug_print( L" succeeded; returning: ", DEBUG_EVAL, 0 );
|
||||
debug_print_object( result, DEBUG_EVAL, 0 );
|
||||
debug_println( DEBUG_EVAL);
|
||||
} 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( U" failed.\n", DEBUG_EVAL, 0 );
|
||||
debug_print( L" failed.\n", DEBUG_EVAL, 0 );
|
||||
#endif
|
||||
}
|
||||
} 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
|
||||
(frame_pointer, L"Arguments to `cond` must be lists" ),
|
||||
frame_pointer );
|
||||
|
|
@ -103,7 +103,7 @@ struct pso_pointer lisp_cond(struct pso_pointer frame_pointer) {
|
|||
}
|
||||
}
|
||||
#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_println( DEBUG_EVAL);
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -46,6 +46,8 @@ bool c_equal( struct pso_pointer a, struct pso_pointer b ) {
|
|||
if ( c_eq( a, b ) ) {
|
||||
result = true;
|
||||
} 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 *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.
|
||||
*
|
||||
|
|
|
|||
|
|
@ -601,7 +601,7 @@ struct pso_pointer lisp_apply( struct pso_pointer frame_pointer) {
|
|||
special.
|
||||
executable ) )
|
||||
( next_pointer ), fn_pointer );
|
||||
debug_print( U"Special form returning: ", DEBUG_EVAL,
|
||||
debug_print( L"Special form returning: ", DEBUG_EVAL,
|
||||
0 );
|
||||
debug_print_object( result, DEBUG_EVAL, 0 );
|
||||
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 );
|
||||
free( buffer );
|
||||
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 );
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -27,7 +27,7 @@
|
|||
struct pso_pointer lisp_mapcar( struct pso_pointer frame_pointer ) {
|
||||
struct pso_pointer result = nil;
|
||||
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 );
|
||||
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, 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_println( DEBUG_EVAL);
|
||||
|
||||
|
|
@ -50,14 +50,14 @@ struct pso_pointer lisp_mapcar( struct pso_pointer frame_pointer ) {
|
|||
} else {
|
||||
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_println( DEBUG_EVAL);
|
||||
}
|
||||
|
||||
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_println( DEBUG_EVAL );
|
||||
|
||||
|
|
|
|||
|
|
@ -71,7 +71,7 @@ uint32_t calculate_hash( wint_t c, struct pso_pointer ptr ) {
|
|||
* pointer to next is nil.
|
||||
*
|
||||
* NOTE THAT: in 0.1.X, we may allocate symbols and keywords as arrays of
|
||||
* char32_t in larger pso classes, so this function may be only for strings
|
||||
* wchar_t in larger pso classes, so this function may be only for strings
|
||||
* (and thus simpler).
|
||||
*/
|
||||
struct pso_pointer make_string_like_thing( struct pso_pointer frame_pointer,
|
||||
|
|
@ -142,7 +142,7 @@ char *lisp_string_to_c_string( struct pso_pointer s ) {
|
|||
len++;
|
||||
}
|
||||
|
||||
wchar_t *buffer = calloc( len, sizeof( char32_t ) );
|
||||
wchar_t *buffer = calloc( len, sizeof( wchar_t ) );
|
||||
int i = 0;
|
||||
for ( struct pso_pointer c = s; !c_nilp( c ); c = c_cdr( c ) ) {
|
||||
buffer[i++] =
|
||||
|
|
@ -177,11 +177,11 @@ char *lisp_string_to_c_string( struct pso_pointer s ) {
|
|||
* symbols, I am accepting only lower case characters and certain punctuation.
|
||||
*/
|
||||
struct pso_pointer c_string_to_lisp_symbol( struct pso_pointer frame_pointer,
|
||||
char32_t *symbol ) {
|
||||
wchar_t *symbol ) {
|
||||
struct pso_pointer result = nil;
|
||||
|
||||
for ( int i = wcslen( symbol ) - 1; i >= 0; i-- ) {
|
||||
char32_t c = symbol[i];
|
||||
wchar_t c = symbol[i];
|
||||
|
||||
if ( symbol_char_p(c)) {
|
||||
result = make_symbol( frame_pointer, c, result );
|
||||
|
|
@ -196,11 +196,11 @@ struct pso_pointer c_string_to_lisp_symbol( struct pso_pointer frame_pointer,
|
|||
* keywords, I am accepting only lower case characters and numbers.
|
||||
*/
|
||||
struct pso_pointer c_string_to_lisp_keyword( struct pso_pointer frame_pointer,
|
||||
char32_t *symbol ) {
|
||||
wchar_t *symbol ) {
|
||||
struct pso_pointer result = nil;
|
||||
|
||||
for ( int i = wcslen( symbol ) - 1; i >= 0; i-- ) {
|
||||
char32_t c = towlower( symbol[i] );
|
||||
wchar_t c = towlower( symbol[i] );
|
||||
|
||||
if ( iswalnum( c ) || c == L'-' ) {
|
||||
result = make_keyword( frame_pointer, c, result );
|
||||
|
|
|
|||
|
|
@ -27,10 +27,10 @@ char *lisp_string_to_c_string( struct pso_pointer s );
|
|||
|
||||
|
||||
struct pso_pointer c_string_to_lisp_keyword( struct pso_pointer frame_pointer,
|
||||
char32_t * symbol );
|
||||
wchar_t * symbol );
|
||||
|
||||
struct pso_pointer c_string_to_lisp_symbol( struct pso_pointer frame_pointer,
|
||||
char32_t * symbol );
|
||||
wchar_t * symbol );
|
||||
|
||||
bool end_of_stringp(struct pso_pointer arg);
|
||||
|
||||
|
|
|
|||
|
|
@ -28,7 +28,7 @@ struct pso_pointer make_character( struct pso_pointer frame_pointer, wint_t c )
|
|||
|
||||
if ( !c_nilp( result ) ) {
|
||||
pointer_to_object( result )->payload.character.character =
|
||||
( char32_t ) c;
|
||||
( wchar_t ) c;
|
||||
}
|
||||
|
||||
return result;
|
||||
|
|
|
|||
|
|
@ -35,7 +35,7 @@
|
|||
* @brief a single character, as returned by the reader.
|
||||
*/
|
||||
struct character_payload {
|
||||
char32_t character;
|
||||
wchar_t character;
|
||||
};
|
||||
|
||||
struct pso_pointer make_character( struct pso_pointer frame_pointer,
|
||||
|
|
|
|||
|
|
@ -114,15 +114,15 @@ struct pso_pointer throw_exception_with_cause( struct pso_pointer location,
|
|||
struct pso_pointer result = nil;
|
||||
|
||||
#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( U"` at `", DEBUG_ANY, 0 );
|
||||
debug_print( L"` at `", 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 ) ) {
|
||||
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( U"`\n", DEBUG_ANY, 0 );
|
||||
debug_print( L"`\n", DEBUG_ANY, 0 );
|
||||
}
|
||||
#endif
|
||||
struct pso2 *cell = pointer_to_object( message );
|
||||
|
|
|
|||
9
src/sh/wchar_t_everywhere.sh
Normal file
9
src/sh/wchar_t_everywhere.sh
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
#!/bin/bash
|
||||
|
||||
for file in src/c/*/*.[ch]
|
||||
do
|
||||
echo $file
|
||||
cp $file $file.bak
|
||||
sed 's/char32_t/wchar_t/g' $file.bak |\
|
||||
sed 's/U"/L"/g' > $file
|
||||
done
|
||||
Loading…
Add table
Add a link
Reference in a new issue