From 80049f2272564e26eef122c37858911fe9ad8e42 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 6 May 2026 16:45:56 +0100 Subject: [PATCH] Ran a 'make format', because !'m close to being able to merge this feature. --- src/c/environment/environment.c | 15 +- src/c/environment/function_bindings.c | 410 +++++++++++++----------- src/c/environment/function_bindings.h | 4 +- src/c/environment/privileged_keywords.c | 19 +- src/c/environment/privileged_keywords.h | 2 +- src/c/io/alphabets.h | 2 +- src/c/io/io.c | 14 +- src/c/io/io.h | 27 +- src/c/io/peek.c | 23 +- src/c/io/print.c | 55 ++-- src/c/io/print.h | 7 +- src/c/io/read.c | 23 +- src/c/memory/dump.c | 327 ++++++++++--------- src/c/memory/pso.c | 24 +- src/c/memory/pso2.h | 4 +- src/c/ops/assoc.c | 23 +- src/c/ops/assoc.h | 2 +- src/c/ops/bind.c | 1 - src/c/ops/cond.c | 42 +-- src/c/ops/eq.c | 4 +- src/c/ops/eval_apply.c | 375 ++++++++++++---------- src/c/ops/inspect.c | 6 +- src/c/ops/inspect.h | 6 +- src/c/ops/keys.c | 19 +- src/c/ops/keys.h | 4 +- src/c/ops/list_ops.c | 1 - src/c/ops/mapcar.c | 33 +- src/c/ops/mapcar.h | 2 +- src/c/ops/progn.c | 44 +-- src/c/ops/progn.h | 11 +- src/c/ops/quote.c | 6 +- src/c/ops/quote.h | 4 +- src/c/ops/repl.c | 4 +- src/c/ops/reverse.c | 22 +- src/c/ops/string_ops.c | 6 +- src/c/ops/string_ops.h | 6 +- src/c/payloads/exception.c | 33 +- src/c/payloads/float.h | 4 +- src/c/payloads/function.c | 19 +- src/c/payloads/function.h | 8 +- src/c/payloads/keyword.c | 8 +- src/c/payloads/keyword.h | 6 +- src/c/payloads/lambda.c | 15 +- src/c/payloads/lambda.h | 11 +- src/c/payloads/psse_string.h | 2 +- src/c/payloads/special.c | 19 +- src/c/payloads/special.h | 8 +- src/c/payloads/stack.c | 52 +-- src/c/payloads/stack.h | 3 +- src/c/payloads/stack_payload.h | 2 +- src/c/payloads/symbol.c | 6 +- src/c/payloads/symbol.h | 6 +- 52 files changed, 936 insertions(+), 843 deletions(-) diff --git a/src/c/environment/environment.c b/src/c/environment/environment.c index dbc5f84..c167eb1 100644 --- a/src/c/environment/environment.c +++ b/src/c/environment/environment.c @@ -81,7 +81,7 @@ struct pso_pointer initialise_environment( uint32_t node ) { } } if ( !exceptionp( result ) ) { - frame_pointer = inc_ref( make_frame(0, nil)); + frame_pointer = inc_ref( make_frame( 0, nil ) ); result = lisp_bind( make_frame ( 3, frame_pointer, @@ -103,13 +103,16 @@ struct pso_pointer initialise_environment( uint32_t node ) { debug_print( L"\nEnvironment initialised successfully.\n", DEBUG_BOOTSTRAP, 0 ); - initialise_privileged_keywords(frame_pointer); + initialise_privileged_keywords( frame_pointer ); - result = inc_ref( initialise_function_bindings(push_local( - frame_pointer, make_frame_with_env(0, frame_pointer, result)))); + result = + inc_ref( initialise_function_bindings + ( push_local + ( frame_pointer, + make_frame_with_env( 0, frame_pointer, result ) ) ) ); - dec_ref(frame_pointer); + dec_ref( frame_pointer ); } - return result; + return result; } diff --git a/src/c/environment/function_bindings.c b/src/c/environment/function_bindings.c index 80b6a5d..b393c3c 100644 --- a/src/c/environment/function_bindings.c +++ b/src/c/environment/function_bindings.c @@ -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; -} \ No newline at end of file + return result; +} diff --git a/src/c/environment/function_bindings.h b/src/c/environment/function_bindings.h index 0a061f4..48a83c7 100644 --- a/src/c/environment/function_bindings.h +++ b/src/c/environment/function_bindings.h @@ -13,5 +13,5 @@ #define __psse_environment_function_bindings_h struct pso_pointer -initialise_function_bindings(struct pso_pointer frame_pointer); -#endif \ No newline at end of file +initialise_function_bindings( struct pso_pointer frame_pointer ); +#endif diff --git a/src/c/environment/privileged_keywords.c b/src/c/environment/privileged_keywords.c index 1a807bb..26f785e 100644 --- a/src/c/environment/privileged_keywords.c +++ b/src/c/environment/privileged_keywords.c @@ -63,12 +63,13 @@ struct pso_pointer privileged_keyword_user; #define load_and_lock(var,val)(var = lock_object(c_string_to_lisp_keyword(frame_pointer, val))) -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); -} \ No newline at end of file +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 ); +} diff --git a/src/c/environment/privileged_keywords.h b/src/c/environment/privileged_keywords.h index 0bee337..fe08e4c 100644 --- a/src/c/environment/privileged_keywords.h +++ b/src/c/environment/privileged_keywords.h @@ -29,5 +29,5 @@ 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_ */ diff --git a/src/c/io/alphabets.h b/src/c/io/alphabets.h index 60e5ff3..8970fc0 100644 --- a/src/c/io/alphabets.h +++ b/src/c/io/alphabets.h @@ -16,4 +16,4 @@ #define GREEK L"ΑαΒβΓγΔδΕεΖζΗηΘθΙιΚκΛλΜμΝνΞξΟοΠπΡρΣσςΤτΥυΦφΧχΨψΩω" #define ELDERFUTHARK L"ᚠᚢᚦᚨᚱᚲᚷᚹᚺᚾᛁᛃᛈᛇᛉᛊᛏᛒᛖᛗᛚᛜᛞᛟ" -#endif \ No newline at end of file +#endif diff --git a/src/c/io/io.c b/src/c/io/io.c index 31f64c4..38ff1d3 100644 --- a/src/c/io/io.c +++ b/src/c/io/io.c @@ -371,8 +371,8 @@ struct pso_pointer push_back_character( struct pso_pointer c, struct pso_pointer result = nil; if ( characterp( c ) && readp( r ) ) { if ( url_ungetwc( ( wint_t ) - ( pointer_to_object( c )->payload.character. - character ), + ( pointer_to_object( c )->payload. + character.character ), pointer_to_object( r )->payload.stream.stream ) >= 0 ) { result = t; @@ -393,13 +393,13 @@ struct pso_pointer push_back_character( struct pso_pointer c, * @param env my environment. * @return T if the stream was successfully closed, else nil. */ -struct pso_pointer lisp_close( struct pso_pointer frame_pointer) { +struct pso_pointer lisp_close( struct pso_pointer frame_pointer ) { struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso_pointer result = nil; if ( readp( fetch_arg( frame, 0 ) ) || writep( fetch_arg( frame, 0 ) ) ) { if ( url_fclose - ( pointer_to_object( fetch_arg( frame, 0 ) )->payload.stream. - stream ) + ( pointer_to_object( fetch_arg( frame, 0 ) )->payload. + stream.stream ) == 0 ) { result = t; } @@ -593,7 +593,7 @@ URL_FILE *stream_get_url_file( struct pso_pointer s ) { * @param frame_pointer a pointer to my stack frame. * @return a stream open on the URL indicated by the first argument. */ -struct pso_pointer lisp_open( struct pso_pointer frame_pointer) { +struct pso_pointer lisp_open( struct pso_pointer frame_pointer ) { struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso_pointer result = nil; if ( stringp( fetch_arg( frame, 0 ) ) ) { @@ -651,7 +651,7 @@ struct pso_pointer lisp_open( struct pso_pointer frame_pointer) { * @return return a string representing all characters from the stream * indicated by arg 0 */ -struct pso_pointer lisp_slurp( struct pso_pointer frame_pointer) { +struct pso_pointer lisp_slurp( struct pso_pointer frame_pointer ) { struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso_pointer result = nil; if ( readp( fetch_arg( frame, 0 ) ) ) { diff --git a/src/c/io/io.h b/src/c/io/io.h index cd37d5d..d6acd86 100644 --- a/src/c/io/io.h +++ b/src/c/io/io.h @@ -24,9 +24,10 @@ extern CURLSH *io_share; -int initialise_io(); -struct pso_pointer initialise_default_streams(struct pso_pointer frame_pointer, - struct pso_pointer env); +int initialise_io( ); +struct pso_pointer initialise_default_streams( struct pso_pointer + frame_pointer, + struct pso_pointer env ); #define C_IO_IN L"*in*" #define C_IO_OUT L"*out*" @@ -49,19 +50,19 @@ extern struct pso_pointer lisp_stderr; extern struct pso_pointer lisp_io_prompt; -URL_FILE *file_to_url_file(FILE *f); -wint_t url_fgetwc(URL_FILE *input); -wint_t url_ungetwc(wint_t wc, URL_FILE *input); +URL_FILE *file_to_url_file( FILE * f ); +wint_t url_fgetwc( URL_FILE * input ); +wint_t url_ungetwc( wint_t wc, URL_FILE * input ); -struct pso_pointer push_back_character(struct pso_pointer c, - struct pso_pointer r); +struct pso_pointer push_back_character( struct pso_pointer c, + struct pso_pointer r ); -struct pso_pointer get_default_stream(bool inputp, struct pso_pointer env); +struct pso_pointer get_default_stream( bool inputp, struct pso_pointer env ); -URL_FILE *stream_get_url_file(struct pso_pointer s); +URL_FILE *stream_get_url_file( struct pso_pointer s ); -struct pso_pointer lisp_close(struct pso_pointer frame_pointer); -struct pso_pointer lisp_open(struct pso_pointer frame_pointer); -struct pso_pointer lisp_slurp(struct pso_pointer frame_pointer); +struct pso_pointer lisp_close( struct pso_pointer frame_pointer ); +struct pso_pointer lisp_open( struct pso_pointer frame_pointer ); +struct pso_pointer lisp_slurp( struct pso_pointer frame_pointer ); #endif diff --git a/src/c/io/peek.c b/src/c/io/peek.c index b926456..ad64c47 100644 --- a/src/c/io/peek.c +++ b/src/c/io/peek.c @@ -25,18 +25,17 @@ * * (peek stream) */ -struct pso_pointer peek(struct pso_pointer frame_pointer) { - struct pso_pointer result = nil; - struct pso_pointer input = - pointer_to_pso4(frame_pointer)->payload.stack_frame.arg[0]; +struct pso_pointer peek( struct pso_pointer frame_pointer ) { + struct pso_pointer result = nil; + struct pso_pointer input = + pointer_to_pso4( frame_pointer )->payload.stack_frame.arg[0]; - if (readp(input)) { - URL_FILE *stream = pointer_to_object(input)->payload.stream.stream; - wint_t c = url_fgetwc(stream); - url_ungetwc(c, stream); + if ( readp( input ) ) { + URL_FILE *stream = pointer_to_object( input )->payload.stream.stream; + wint_t c = url_fgetwc( stream ); + url_ungetwc( c, stream ); - result = make_character(frame_pointer, c); - } - return result; + result = make_character( frame_pointer, c ); + } + return result; } - diff --git a/src/c/io/print.c b/src/c/io/print.c index c9b0f7d..e780b20 100644 --- a/src/c/io/print.c +++ b/src/c/io/print.c @@ -83,8 +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 ) { - wchar_t wc = - pointer_to_object( cursor )->payload.string.character; + wchar_t wc = pointer_to_object( cursor )->payload.string.character; write_char( wc, output, escape ); } @@ -189,14 +188,15 @@ struct pso_pointer in_write( struct pso_pointer p, URL_FILE *output, } else { url_fputws( L"", output ); } - } break; - case FUNCTIONTV: { - struct pso2 *function = pointer_to_object(p); - url_fputws(L"payload.function.meta, output, escape, - indent); - write_char( L'>', output, escape ); - } break; + } + break; + case FUNCTIONTV:{ + struct pso2 *function = pointer_to_object( p ); + url_fputws( L"payload.function.meta, output, escape, + indent ); + write_char( L'>', output, escape ); + } break; case INTEGERTV: url_fwprintf( output, L"%d", ( int64_t ) ( object->payload.integer.value ) ); @@ -217,13 +217,13 @@ struct pso_pointer in_write( struct pso_pointer p, URL_FILE *output, indent ); write_char( L'>', output, escape ); break; - case SPECIALTV: { - struct pso2 *function = pointer_to_object(p); - url_fputws(L"payload.function.meta, output, escape, - indent); - write_char( L'>', output, escape ); - } break; + case SPECIALTV:{ + struct pso2 *function = pointer_to_object( p ); + url_fputws( L"payload.function.meta, output, escape, + indent ); + write_char( L'>', output, escape ); + } break; case TRUETV: write_char( L't', output, escape ); break; @@ -281,15 +281,19 @@ struct pso_pointer write( struct pso_pointer frame_pointer ) { return result; } -struct pso_pointer c_write(struct pso_pointer frame_pointer, - struct pso_pointer object, struct pso_pointer stream, - bool escape, bool nl_before, bool nl_after) { - struct pso_pointer next_pointer = - push_local(frame_pointer, make_frame(5, frame_pointer, object, stream, escape ? t : nil, - nl_before ? t : nil, nl_after ? t : nil)); - struct pso_pointer result = push_local(frame_pointer, write(next_pointer)); +struct pso_pointer c_write( struct pso_pointer frame_pointer, + struct pso_pointer object, + struct pso_pointer stream, bool escape, + bool nl_before, bool nl_after ) { + struct pso_pointer next_pointer = + push_local( frame_pointer, + make_frame( 5, frame_pointer, object, stream, + escape ? t : nil, + nl_before ? t : nil, nl_after ? t : nil ) ); + struct pso_pointer result = + push_local( frame_pointer, write( next_pointer ) ); - return result; + return result; } /** @@ -333,4 +337,3 @@ struct pso_pointer princ( struct pso_pointer frame_pointer ) { return result; } - diff --git a/src/c/io/print.h b/src/c/io/print.h index 44f2bfa..233e87d 100644 --- a/src/c/io/print.h +++ b/src/c/io/print.h @@ -26,9 +26,10 @@ struct pso_pointer princ( struct pso_pointer frame_pointer ); struct pso_pointer in_write( struct pso_pointer p, URL_FILE * output, bool escape, int indent ); -struct pso_pointer c_write(struct pso_pointer frame_pointer, - struct pso_pointer object, struct pso_pointer stream, - bool escape, bool nl_before, bool nl_after); +struct pso_pointer c_write( struct pso_pointer frame_pointer, + struct pso_pointer object, + struct pso_pointer stream, bool escape, + bool nl_before, bool nl_after ); #define c_print(f,o,s)(c_write(f,o,s,true,true,false)) #define c_princ(f,o,s)(c_write(f,o,s,false,true,false)) diff --git a/src/c/io/read.c b/src/c/io/read.c index 4813c70..65c2a08 100644 --- a/src/c/io/read.c +++ b/src/c/io/read.c @@ -146,15 +146,17 @@ struct pso_pointer read_number( struct pso_pointer frame_pointer ) { URL_FILE *input = pointer_to_object( stream )->payload.stream.stream; for ( ; iswdigit( c ) || c == L','; c = url_fgetwc( input ) ) { - if ( iswdigit( c ) ){value = ( value * base ) + ( ( int ) c - ( int ) L'0' );} + if ( iswdigit( c ) ) { + value = ( value * base ) + ( ( int ) c - ( int ) L'0' ); + } } url_ungetwc( c, input ); result = make_integer( frame_pointer, value ); } // else exception? #ifdef DEBUG - debug_printf( DEBUG_IO, 0, L"\nRead number %ld\n", value ); - debug_dump_object(result, DEBUG_IO, 1); + debug_printf( DEBUG_IO, 0, L"\nRead number %ld\n", value ); + debug_dump_object( result, DEBUG_IO, 1 ); #endif return result; @@ -185,13 +187,12 @@ struct pso_pointer read_symbol( struct pso_pointer frame_pointer ) { url_ungetwc( c, input ); result = c_reverse( frame_pointer, result ); } - #ifdef DEBUG - debug_print( L"\nRead symbol `", DEBUG_IO, 0 ); - debug_print_object( result, DEBUG_IO, 0); - debug_print( L"`\n\t", DEBUG_IO, 0); - debug_dump_object(result, DEBUG_IO, 1); - #endif + debug_print( L"\nRead symbol `", DEBUG_IO, 0 ); + debug_print_object( result, DEBUG_IO, 0 ); + debug_print( L"`\n\t", DEBUG_IO, 0 ); + debug_dump_object( result, DEBUG_IO, 1 ); +#endif return result; } @@ -283,8 +284,8 @@ struct pso_pointer read( struct pso_pointer frame_pointer ) { #ifdef DEBUG debug_print( L"Read expression: `", DEBUG_IO, 0 ); debug_print_object( result, DEBUG_IO, 0 ); - debug_print( L"`\n", DEBUG_IO, 0 ); - debug_dump_object(result, DEBUG_IO, 1); + debug_print( L"`\n", DEBUG_IO, 0 ); + debug_dump_object( result, DEBUG_IO, 1 ); #endif return result; diff --git a/src/c/memory/dump.c b/src/c/memory/dump.c index 36a9755..b4c1fd6 100644 --- a/src/c/memory/dump.c +++ b/src/c/memory/dump.c @@ -45,13 +45,14 @@ void dump_string_cell( URL_FILE *output, wchar_t *prefix, struct pso_pointer pointer ) { - struct pso2* object = pointer_to_object( pointer ); + struct pso2 *object = pointer_to_object( pointer ); if ( object->payload.string.character == 0 ) { url_fwprintf( output, L"\t\t%ls cell: termination; next at page %d offset %d, count %u\n", prefix, object->payload.string.cdr.page, - object->payload.string.cdr.offset, object->header.count ); + object->payload.string.cdr.offset, + object->header.count ); } else { url_fwprintf( output, L"\t\t%ls cell: character '%lc' (%d) with hash %d; next at page %d offset %d, count %u\n", @@ -60,17 +61,21 @@ void dump_string_cell( URL_FILE *output, wchar_t *prefix, object->payload.string.character, object->payload.string.hash, object->payload.string.cdr.page, - object->payload.string.cdr.offset, object->header.count ); + object->payload.string.cdr.offset, + object->header.count ); url_fwprintf( output, L"\t\t value: " ); - in_write( pointer, output, false, 0); - if (stringlikep(pointer)) { - url_fwprintf( output, L"\n\t\t structure: " ); - for ( struct pso_pointer cursor = pointer; !c_nilp(cursor); cursor = c_cdr(cursor)) { - wint_t c = pointer_to_object(cursor)->payload.string.character; - char* tag = (pointer_to_object(cursor)->header.tag.bytes.mnemonic); - url_fwprintf( output, L"[%3.3s %lc (%d)]", tag, c, c); - } - } + in_write( pointer, output, false, 0 ); + if ( stringlikep( pointer ) ) { + url_fwprintf( output, L"\n\t\t structure: " ); + for ( struct pso_pointer cursor = pointer; !c_nilp( cursor ); + cursor = c_cdr( cursor ) ) { + wint_t c = + pointer_to_object( cursor )->payload.string.character; + char *tag = + ( pointer_to_object( cursor )->header.tag.bytes.mnemonic ); + url_fwprintf( output, L"[%3.3s %lc (%d)]", tag, c, c ); + } + } url_fwprintf( output, L"\n" ); } @@ -79,9 +84,9 @@ void dump_string_cell( URL_FILE *output, wchar_t *prefix, void dump_frame_context_fragment( URL_FILE *output, struct pso_pointer frame_pointer, - uint arg) { - if ( stackp(frame_pointer )) { - struct pso4 *frame = pointer_to_pso4( frame_pointer ); + uint arg ) { + if ( stackp( frame_pointer ) ) { + struct pso4 *frame = pointer_to_pso4( frame_pointer ); url_fwprintf( output, L" <= " ); in_write( frame->payload.stack_frame.arg[arg], output, false, 0 ); @@ -90,7 +95,7 @@ void dump_frame_context_fragment( URL_FILE *output, void dump_frame_context( URL_FILE *output, struct pso_pointer frame_pointer, int depth ) { - if ( stackp(frame_pointer) ) { + if ( stackp( frame_pointer ) ) { struct pso4 *frame = pointer_to_pso4( frame_pointer ); url_fwprintf( output, L"\tContext: " ); @@ -98,7 +103,8 @@ void dump_frame_context( URL_FILE *output, struct pso_pointer frame_pointer, int i = 0; for ( struct pso_pointer cursor = frame_pointer; i++ < depth && !c_nilp( cursor ); - cursor = pointer_to_pso4(cursor)->payload.stack_frame.previous ) { + cursor = + pointer_to_pso4( cursor )->payload.stack_frame.previous ) { dump_frame_context_fragment( output, cursor, 0 ); } @@ -112,18 +118,20 @@ void dump_frame_context( URL_FILE *output, struct pso_pointer frame_pointer, * @param frame_pointer the pointer to the frame */ void dump_frame( URL_FILE *output, struct pso_pointer frame_pointer ) { - if ( stackp(frame_pointer) ) { + if ( stackp( frame_pointer ) ) { struct pso4 *frame = pointer_to_pso4( frame_pointer ); url_fwprintf( output, L"Stack frame %d with %d arguments:\n", - frame->payload.stack_frame.depth, frame->payload.stack_frame.args ); + frame->payload.stack_frame.depth, + frame->payload.stack_frame.args ); dump_frame_context( output, frame_pointer, 4 ); for ( int arg = 0; arg < frame->payload.stack_frame.args; arg++ ) { - struct pso2* object = pointer_to_object( fetch_arg(frame, arg)); + struct pso2 *object = pointer_to_object( fetch_arg( frame, arg ) ); url_fwprintf( output, L"\tArg %d:\t%3.3s\tcount: %10u\tvalue: ", - arg, object->header.tag.bytes.mnemonic[0], object->header.count ); + arg, object->header.tag.bytes.mnemonic[0], + object->header.count ); in_write( frame->payload.stack_frame.arg[arg], output, false, 0 ); url_fputws( L"\n", output ); @@ -139,13 +147,12 @@ void dump_frame( URL_FILE *output, struct pso_pointer frame_pointer ) { void dump_stack_trace( URL_FILE *output, struct pso_pointer pointer ) { if ( exceptionp( pointer ) ) { - struct pso3* exep = pointer_to_pso3( pointer); + struct pso3 *exep = pointer_to_pso3( pointer ); in_write( exep->payload.exception.message, output, false, 0 ); url_fputws( L"\n", output ); - dump_stack_trace( output, - exep->payload.exception.stack ); + dump_stack_trace( output, exep->payload.exception.stack ); } else { - while ( stackp( pointer) ) { + while ( stackp( pointer ) ) { dump_frame( output, pointer ); pointer = pointer_to_pso4( pointer )->payload.stack_frame.previous; } @@ -168,142 +175,142 @@ void dump_stack_trace( URL_FILE *output, struct pso_pointer pointer ) { * to be dumped. */ struct pso_pointer dump_object( struct pso_pointer frame_pointer ) { - struct pso_pointer result = nil; - struct pso_pointer stream = nil; - struct pso_pointer pointer = nil; - - if (stackp(frame_pointer)) { - struct pso4* frame = pointer_to_pso4( frame_pointer); + struct pso_pointer result = nil; + struct pso_pointer stream = nil; + struct pso_pointer pointer = nil; - pointer = fetch_arg( frame, 0); - stream = fetch_arg( frame, 1); - } else { - pointer = frame_pointer; - } + if ( stackp( frame_pointer ) ) { + struct pso4 *frame = pointer_to_pso4( frame_pointer ); - if (!writep(stream)) { - stream = lisp_stderr; - } - -// URL_FILE* output = file_to_url_file(stderr); -// url_fputws( L"\ndump_object printing to output stream; metadata: ", output ); -// in_write( pointer_to_object(stream)->payload.stream.meta, output, false, 0 ); -// url_fputws( L"\n", output ); -// fflush(stderr); - - URL_FILE* output = pointer_to_object(stream)->payload.stream.stream; + pointer = fetch_arg( frame, 0 ); + stream = fetch_arg( frame, 1 ); + } else { + pointer = frame_pointer; + } - if (c_nilp(pointer)) { - // the object at (node, 0, 0) ought to have been initialised, but may not - // have been... - url_fputws(L"nil of size class 2 at page 0, offset 0, count xxxx\n", output ); - } else { - struct pso2* object = pointer_to_object( pointer ); - url_fwprintf( output, L"\t%3.3s (%d) of size class %d at page %d, offset %d count %u\n", - object->header.tag.bytes.mnemonic, - get_tag_value(pointer), - object->header.tag.bytes.size_class, - pointer.page, pointer.offset, - object->header.count ); - - switch ( get_tag_value( pointer) ) { - case CONSTV: - url_fwprintf( output, - L"\t\tCons object: car at page %d offset %d, cdr at page %d " - L"offset %d :", - object->payload.cons.car.page, - object->payload.cons.car.offset, - object->payload.cons.cdr.page, - object->payload.cons.cdr.offset); - in_write( pointer, output, false, 0 ); - url_fputws( L"\n", output ); - break; - case EXCEPTIONTV: - url_fwprintf( output, L"\t\tException object: " ); - dump_stack_trace( output, pointer ); - break; - case FREETV: - url_fwprintf( output, - L"\t\tFree object: next at page %d offset %d\n", - object->payload.free.next.page, - object->payload.free.next.offset); - break; - case INTEGERTV: - url_fwprintf( output, L"\t\tInteger object: value %ld\n", - object->payload.integer.value ); - break; - case KEYTV: - dump_string_cell( output, L"Keyword", pointer ); - break; - // case LAMBDATV: - // url_fwprintf( output, L"\t\t\u03bb object;\n\t\t args: " ); - // in_write( output, object->payload.lambda.args ); - // url_fwprintf( output, L";\n\t\t\tbody: " ); - // in_write( output, object->payload.lambda.body ); - // url_fputws( L"\n", output ); - // break; - // case NILTV: - // break; - // case NLAMBDATV: - // url_fwprintf( output, L"\t\tn\u03bb object; \n\t\targs: " ); - // in_write( output, object->payload.lambda.args ); - // url_fwprintf( output, L";\n\t\t\tbody: " ); - // in_write( output, object->payload.lambda.body ); - // url_fputws( L"\n", output ); - // break; - // case RATIOTV: - // url_fwprintf( output, - // L"\t\tRational object: value %ld/%ld, count %u\n", - // pointer_to_object( object->payload.ratio.dividend ). - // payload.integer.value, - // pointer_to_object( object->payload.ratio.divisor ). - // payload.integer.value, object->count ); - // break; - case READTV: - url_fputws( L"\t\tInput stream; metadata: ", output ); - in_write( object->payload.stream.meta, output, false, 0 ); - url_fputws( L"\n", output ); - break; - // case REALTV: - // url_fwprintf( output, L"\t\tReal object: value %Lf, count %u\n", - // object->payload.real.value, object->count ); - // break; - case STRINGTV: - dump_string_cell( output, L"String", pointer ); - break; - case SYMBOLTV: - dump_string_cell( output, L"Symbol", pointer ); - break; - // case TRUETV: - // break; - // case VECTORPOINTTV:{ - // url_fwprintf( output, - // L"\t\tPointer to vector-space object at %p\n", - // object->payload.vectorp.address ); - // struct vector_space_object *vso = object->payload.vectorp.address; - // url_fwprintf( output, - // L"\t\tVector space object of type %4.4s (%d), payload size " - // L"%d bytes\n", - // &vso->header.tag.bytes, vso->header.tag.value, - // vso->header.size ); - // - // switch ( vso->header.tag.value ) { - // case STACKFRAMETV: - // dump_frame( output, pointer ); - // break; - // case HASHTV: - // dump_map( output, pointer ); - // break; - // } - // } - // break; - case WRITETV: - url_fputws( L"\t\tOutput stream; metadata: ", output ); - in_write( object->payload.stream.meta, output, false, 0 ); - url_fputws( L"\n", output ); - break; - } - } - - return result; + if ( !writep( stream ) ) { + stream = lisp_stderr; + } +// URL_FILE* output = file_to_url_file(stderr); +// url_fputws( L"\ndump_object printing to output stream; metadata: ", output ); +// in_write( pointer_to_object(stream)->payload.stream.meta, output, false, 0 ); +// url_fputws( L"\n", output ); +// fflush(stderr); + + URL_FILE *output = pointer_to_object( stream )->payload.stream.stream; + + if ( c_nilp( pointer ) ) { + // the object at (node, 0, 0) ought to have been initialised, but may not + // have been... + url_fputws( L"nil of size class 2 at page 0, offset 0, count xxxx\n", + output ); + } else { + struct pso2 *object = pointer_to_object( pointer ); + url_fwprintf( output, + L"\t%3.3s (%d) of size class %d at page %d, offset %d count %u\n", + object->header.tag.bytes.mnemonic, + get_tag_value( pointer ), + object->header.tag.bytes.size_class, pointer.page, + pointer.offset, object->header.count ); + + switch ( get_tag_value( pointer ) ) { + case CONSTV: + url_fwprintf( output, + L"\t\tCons object: car at page %d offset %d, cdr at page %d " + L"offset %d :", + object->payload.cons.car.page, + object->payload.cons.car.offset, + object->payload.cons.cdr.page, + object->payload.cons.cdr.offset ); + in_write( pointer, output, false, 0 ); + url_fputws( L"\n", output ); + break; + case EXCEPTIONTV: + url_fwprintf( output, L"\t\tException object: " ); + dump_stack_trace( output, pointer ); + break; + case FREETV: + url_fwprintf( output, + L"\t\tFree object: next at page %d offset %d\n", + object->payload.free.next.page, + object->payload.free.next.offset ); + break; + case INTEGERTV: + url_fwprintf( output, L"\t\tInteger object: value %ld\n", + object->payload.integer.value ); + break; + case KEYTV: + dump_string_cell( output, L"Keyword", pointer ); + break; + // case LAMBDATV: + // url_fwprintf( output, L"\t\t\u03bb object;\n\t\t args: " ); + // in_write( output, object->payload.lambda.args ); + // url_fwprintf( output, L";\n\t\t\tbody: " ); + // in_write( output, object->payload.lambda.body ); + // url_fputws( L"\n", output ); + // break; + // case NILTV: + // break; + // case NLAMBDATV: + // url_fwprintf( output, L"\t\tn\u03bb object; \n\t\targs: " ); + // in_write( output, object->payload.lambda.args ); + // url_fwprintf( output, L";\n\t\t\tbody: " ); + // in_write( output, object->payload.lambda.body ); + // url_fputws( L"\n", output ); + // break; + // case RATIOTV: + // url_fwprintf( output, + // L"\t\tRational object: value %ld/%ld, count %u\n", + // pointer_to_object( object->payload.ratio.dividend ). + // payload.integer.value, + // pointer_to_object( object->payload.ratio.divisor ). + // payload.integer.value, object->count ); + // break; + case READTV: + url_fputws( L"\t\tInput stream; metadata: ", output ); + in_write( object->payload.stream.meta, output, false, 0 ); + url_fputws( L"\n", output ); + break; + // case REALTV: + // url_fwprintf( output, L"\t\tReal object: value %Lf, count %u\n", + // object->payload.real.value, object->count ); + // break; + case STRINGTV: + dump_string_cell( output, L"String", pointer ); + break; + case SYMBOLTV: + dump_string_cell( output, L"Symbol", pointer ); + break; + // case TRUETV: + // break; + // case VECTORPOINTTV:{ + // url_fwprintf( output, + // L"\t\tPointer to vector-space object at %p\n", + // object->payload.vectorp.address ); + // struct vector_space_object *vso = object->payload.vectorp.address; + // url_fwprintf( output, + // L"\t\tVector space object of type %4.4s (%d), payload size " + // L"%d bytes\n", + // &vso->header.tag.bytes, vso->header.tag.value, + // vso->header.size ); + // + // switch ( vso->header.tag.value ) { + // case STACKFRAMETV: + // dump_frame( output, pointer ); + // break; + // case HASHTV: + // dump_map( output, pointer ); + // break; + // } + // } + // break; + case WRITETV: + url_fputws( L"\t\tOutput stream; metadata: ", output ); + in_write( object->payload.stream.meta, output, false, 0 ); + url_fputws( L"\n", output ); + break; + } + } + + return result; } diff --git a/src/c/memory/pso.c b/src/c/memory/pso.c index e16fafb..b5e97d4 100644 --- a/src/c/memory/pso.c +++ b/src/c/memory/pso.c @@ -60,8 +60,8 @@ void print_allocation_table( ) { } #endif -struct pso_pointer cheaty_allocate(struct pso_pointer frame_pointer, char *tag, - uint8_t size_class); +struct pso_pointer cheaty_allocate( struct pso_pointer frame_pointer, + char *tag, uint8_t size_class ); /** * @brief a means of creating a cons cell without using a stack frame, to @@ -88,20 +88,20 @@ struct pso_pointer cheaty_make_cons( struct pso_pointer car, * get excessive spurius missing stack frame warnings. Not to be called * outside this file! */ -struct pso_pointer cheaty_allocate(struct pso_pointer frame_pointer, char *tag, - uint8_t size_class) { +struct pso_pointer cheaty_allocate( struct pso_pointer frame_pointer, + char *tag, uint8_t size_class ) { struct pso_pointer result = pop_freelist( size_class ); #ifdef DEBUG debug_printf( DEBUG_ALLOC, 0, - L"\nAllocating object of size class %d with tag `%s`... ", - size_class, tag ); + L"\nAllocating object of size class %d with tag `%s`... ", + size_class, tag ); #endif struct pso2 *obj = pointer_to_object( result ); strncpy( ( char * ) ( obj->header.tag.bytes.mnemonic ), tag, TAGLENGTH ); debug_printf( DEBUG_ALLOC, 0, L"at page %d, offset %d... ", result.page, - result.offset ); + result.offset ); if ( stackp( frame_pointer ) ) { struct pso4 *frame = pointer_to_pso4( frame_pointer ); // You can't make a stack frame in the middle of making a stack @@ -116,7 +116,7 @@ struct pso_pointer cheaty_allocate(struct pso_pointer frame_pointer, char *tag, #ifdef DEBUG debug_print( exceptionp( result ) ? L"fail\n" : L"success\n", DEBUG_ALLOC, - 0 ); + 0 ); #endif return result; @@ -147,7 +147,7 @@ struct pso_pointer allocate( struct pso_pointer frame_pointer, char *tag, fputws( L"\nWARNING: No stack frame passed to `allocate`.\n", stderr ); } - return cheaty_allocate(frame_pointer, tag, size_class); + return cheaty_allocate( frame_pointer, tag, size_class ); } @@ -189,8 +189,10 @@ struct pso_pointer inc_ref( struct pso_pointer pointer ) { L"\nIncremented object of type %3.3s, size class %d, " L"at page %u, offset %u to count %u", ( ( char * ) & - ( object->header.tag. - bytes.mnemonic + ( object-> + header. + tag.bytes. + mnemonic [0] ) ), ( int ) object->header.tag.bytes.size_class, pointer.page, pointer.offset, object->header.count ); diff --git a/src/c/memory/pso2.h b/src/c/memory/pso2.h index 5c459de..76217d6 100644 --- a/src/c/memory/pso2.h +++ b/src/c/memory/pso2.h @@ -51,8 +51,8 @@ struct pso2 { struct free_payload free; struct function_payload function; struct integer_payload integer; - struct lambda_payload lambda; - struct float_payload real; + struct lambda_payload lambda; + struct float_payload real; struct function_payload special; struct stream_payload stream; struct string_payload string; diff --git a/src/c/ops/assoc.c b/src/c/ops/assoc.c index 5dfdd63..e5ba28a 100644 --- a/src/c/ops/assoc.c +++ b/src/c/ops/assoc.c @@ -45,7 +45,7 @@ struct pso_pointer search( struct pso_pointer key, debug_print( L"In search; key is: `", DEBUG_BIND, 0 ); debug_print_object( key, DEBUG_BIND, 0 ); debug_print( L"`\n", DEBUG_BIND, 0 ); - debug_dump_object(key, DEBUG_BIND, 1); + debug_dump_object( key, DEBUG_BIND, 1 ); #endif if ( consp( store ) ) { @@ -54,9 +54,9 @@ struct pso_pointer search( struct pso_pointer key, struct pso_pointer pair = c_car( cursor ); #ifdef DEBUG debug_print( L"Checking `", DEBUG_BIND, 1 ); - debug_print_object( c_car( pair), DEBUG_BIND, 0 ); - debug_print(L"`\n", DEBUG_BIND, 2); - debug_dump_object(c_car(pair), DEBUG_BIND, 2); + debug_print_object( c_car( pair ), DEBUG_BIND, 0 ); + debug_print( L"`\n", DEBUG_BIND, 2 ); + debug_dump_object( c_car( pair ), DEBUG_BIND, 2 ); #endif if ( consp( pair ) && c_equal( c_car( pair ), key ) ) { @@ -117,14 +117,13 @@ bool c_internedp( struct pso_pointer key, struct pso_pointer store ) { * * @return a pointer to the value of the key in the store, or nil if not found */ -struct pso_pointer assoc( - struct pso_pointer frame_pointer ) { +struct pso_pointer assoc( struct pso_pointer frame_pointer ) { struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso_pointer key = fetch_arg( frame, 0 ); struct pso_pointer store = or( make_frame( 2, frame_pointer, fetch_arg( frame, 1 ), - frame->payload. - stack_frame.env ) ); + frame->payload.stack_frame. + env ) ); return c_assoc( key, store ); } @@ -145,8 +144,8 @@ struct pso_pointer interned( struct pso_pointer key = fetch_arg( frame, 0 ); struct pso_pointer store = or( make_frame( 2, frame_pointer, fetch_arg( frame, 1 ), - frame->payload. - stack_frame.env ) ); + frame->payload.stack_frame. + env ) ); return c_interned( key, store ); } @@ -167,8 +166,8 @@ struct pso_pointer internedp( struct pso_pointer key = fetch_arg( frame, 0 ); struct pso_pointer store = or( make_frame( 2, frame_pointer, fetch_arg( frame, 1 ), - frame->payload. - stack_frame.env ) ); + frame->payload.stack_frame. + env ) ); return c_internedp( key, store ) ? t : nil; } diff --git a/src/c/ops/assoc.h b/src/c/ops/assoc.h index 1fcf981..7cf073d 100644 --- a/src/c/ops/assoc.h +++ b/src/c/ops/assoc.h @@ -16,7 +16,7 @@ #include "memory/pointer.h" -struct pso_pointer assoc(struct pso_pointer frame_pointer); +struct pso_pointer assoc( struct pso_pointer frame_pointer ); struct pso_pointer search( struct pso_pointer key, struct pso_pointer store, bool return_key ); diff --git a/src/c/ops/bind.c b/src/c/ops/bind.c index fbcbfe5..82c1fd9 100644 --- a/src/c/ops/bind.c +++ b/src/c/ops/bind.c @@ -35,4 +35,3 @@ struct pso_pointer lisp_bind( struct pso_pointer frame_pointer ) { return cons( make_frame( 2, frame_pointer, binding, store ) ); } - diff --git a/src/c/ops/cond.c b/src/c/ops/cond.c index c78e0e7..d0e5744 100644 --- a/src/c/ops/cond.c +++ b/src/c/ops/cond.c @@ -30,31 +30,34 @@ */ struct pso_pointer eval_cond_clause( struct pso_pointer clause, struct pso4 *frame, - struct pso_pointer frame_pointer) { - struct pso_pointer result = nil; - struct pso_pointer env = fetch_env(frame_pointer); + struct pso_pointer frame_pointer ) { + struct pso_pointer result = nil; + struct pso_pointer env = fetch_env( frame_pointer ); #ifdef DEBUG debug_print( L"\n\tCond clause: ", DEBUG_EVAL, 0 ); debug_print_object( clause, DEBUG_EVAL, 0 ); - debug_println( DEBUG_EVAL); + debug_println( DEBUG_EVAL ); #endif if ( consp( clause ) ) { - struct pso_pointer test_frame = push_local( frame_pointer, make_frame(1, frame_pointer, c_car(clause))); - struct pso_pointer val = lisp_eval(test_frame); + struct pso_pointer test_frame = + push_local( frame_pointer, + make_frame( 1, frame_pointer, c_car( clause ) ) ); + struct pso_pointer val = lisp_eval( test_frame ); if ( !c_nilp( val ) ) { result = make_cons( frame_pointer, t, - c_progn( frame, frame_pointer, c_cdr( clause ), env ) ); + c_progn( frame, frame_pointer, c_cdr( clause ), + env ) ); #ifdef DEBUG debug_print( L"\n\t\tCond clause ", DEBUG_EVAL, 0 ); debug_print_object( clause, DEBUG_EVAL, 0 ); debug_print( L" succeeded; returning: ", DEBUG_EVAL, 0 ); debug_print_object( result, DEBUG_EVAL, 0 ); - debug_println( DEBUG_EVAL); + debug_println( DEBUG_EVAL ); } else { debug_print( L"\n\t\tCond clause ", DEBUG_EVAL, 0 ); debug_print_object( clause, DEBUG_EVAL, 0 ); @@ -62,10 +65,11 @@ struct pso_pointer eval_cond_clause( struct pso_pointer clause, #endif } } else { - 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 ); + 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 ); } return result; @@ -81,18 +85,18 @@ struct pso_pointer eval_cond_clause( struct pso_pointer clause, * * @return the value of the last expression of the first successful `clause`. */ -struct pso_pointer lisp_cond(struct pso_pointer frame_pointer) { - struct pso4 *frame = pointer_to_pso4(frame_pointer); +struct pso_pointer lisp_cond( struct pso_pointer frame_pointer ) { + struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso_pointer result = nil; bool done = false; for ( int i = 0; ( i < frame->payload.stack_frame.args ) && !done; i++ ) { struct pso_pointer clause_pointer = fetch_arg( frame, i ); - // TODO: WHOOPS! This isn't right. If the test of a cond clause - // evaluates to non-nil, but the last form of the clause evaluates - // to nil, the form still succeeded and we should still exit `cond`. - // + // TODO: WHOOPS! This isn't right. If the test of a cond clause + // evaluates to non-nil, but the last form of the clause evaluates + // to nil, the form still succeeded and we should still exit `cond`. + // result = eval_cond_clause( clause_pointer, frame, frame_pointer ); @@ -105,7 +109,7 @@ struct pso_pointer lisp_cond(struct pso_pointer frame_pointer) { #ifdef DEBUG debug_print( L"\tCond returning: ", DEBUG_EVAL, 0 ); debug_print_object( result, DEBUG_EVAL, 0 ); - debug_println( DEBUG_EVAL); + debug_println( DEBUG_EVAL ); #endif return result; diff --git a/src/c/ops/eq.c b/src/c/ops/eq.c index f2ef638..c395b6e 100644 --- a/src/c/ops/eq.c +++ b/src/c/ops/eq.c @@ -46,8 +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; + /* assume true and try to falsify */ + result = true; struct pso2 *oa = pointer_to_object( a ); struct pso2 *ob = pointer_to_object( b ); diff --git a/src/c/ops/eval_apply.c b/src/c/ops/eval_apply.c index b35e947..5dc79f4 100644 --- a/src/c/ops/eval_apply.c +++ b/src/c/ops/eval_apply.c @@ -110,7 +110,7 @@ struct pso_pointer eval_form( struct pso_pointer frame_pointer ) { debug_print( L" returning: ", DEBUG_EVAL, 0 ); debug_print_object( result, DEBUG_EVAL, 0 ); debug_println( DEBUG_EVAL ); - debug_dump_object(result, DEBUG_EVAL, 1); + debug_dump_object( result, DEBUG_EVAL, 1 ); return result; } @@ -155,11 +155,12 @@ struct pso_pointer eval_forms( struct pso_pointer frame_pointer ) { * * This is experimental. It almost certainly WILL change. */ -struct pso_pointer lisp_try( struct pso_pointer frame_pointer) { +struct pso_pointer lisp_try( struct pso_pointer frame_pointer ) { struct pso_pointer result = nil; struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso_pointer body_frame = - push_local( frame_pointer, make_frame( 1, frame_pointer, fetch_arg( frame, 0 ) ) ); + push_local( frame_pointer, + make_frame( 1, frame_pointer, fetch_arg( frame, 0 ) ) ); result = push_local( frame_pointer, lisp_progn( body_frame ) ); @@ -167,16 +168,19 @@ struct pso_pointer lisp_try( struct pso_pointer frame_pointer) { // TODO: need to put the exception into the environment! struct pso_pointer catch_frame = push_local( frame_pointer, make_frame_with_env( 1, frame_pointer, - make_cons( frame_pointer, - make_cons( frame_pointer, + make_cons + ( frame_pointer, + make_cons + ( frame_pointer, c_string_to_lisp_symbol ( frame_pointer, L"*exception*" ), result ), - fetch_env - ( frame_pointer ) ), - frame->payload.stack_frame. - arg[1] ) ); + fetch_env + ( frame_pointer ) ), + frame->payload. + stack_frame.arg + [1] ) ); result = push_local( frame_pointer, lisp_progn( catch_frame ) ); } @@ -195,7 +199,7 @@ struct pso_pointer lisp_try( struct pso_pointer frame_pointer) { * @return the root namespace. */ struct pso_pointer -lisp_oblist( struct pso4 *frame, struct pso_pointer frame_pointer) { +lisp_oblist( struct pso4 *frame, struct pso_pointer frame_pointer ) { return oblist; } @@ -235,10 +239,10 @@ struct pso_pointer compose_body( struct pso_pointer frame_pointer ) { * @param env the environment in which it is to be intepreted. * @return an interpretable function with these `args` and this `body`. */ -struct pso_pointer -lisp_lambda( struct pso_pointer frame_pointer ) { - struct pso4* frame = pointer_to_pso4(frame_pointer); - return make_lambda( frame_pointer, fetch_arg(frame, 0), compose_body( frame_pointer ) ); +struct pso_pointer lisp_lambda( struct pso_pointer frame_pointer ) { + struct pso4 *frame = pointer_to_pso4( frame_pointer ); + return make_lambda( frame_pointer, fetch_arg( frame, 0 ), + compose_body( frame_pointer ) ); } /** @@ -253,22 +257,21 @@ lisp_lambda( struct pso_pointer frame_pointer ) { * @return an interpretable special form with these `args` and this `body`. */ struct pso_pointer -lisp_nlambda( struct pso_pointer frame_pointer, - struct pso_pointer env ) { - struct pso4* frame = pointer_to_pso4(frame_pointer); - return make_nlambda( frame_pointer, fetch_arg(frame, 0), compose_body( frame_pointer ) ); +lisp_nlambda( struct pso_pointer frame_pointer, struct pso_pointer env ) { + struct pso4 *frame = pointer_to_pso4( frame_pointer ); + return make_nlambda( frame_pointer, fetch_arg( frame, 0 ), + compose_body( frame_pointer ) ); } /** * Evaluate a lambda or nlambda expression. */ -struct pso_pointer -eval_lambda( struct pso_pointer frame_pointer ) { - struct pso_pointer result = nil; - struct pso4 *frame = pointer_to_pso4(frame_pointer); - struct pso2 *lambda = pointer_to_object(fetch_arg(frame, 0)); - struct pso_pointer args = fetch_arg( frame, 1); +struct pso_pointer eval_lambda( struct pso_pointer frame_pointer ) { + struct pso_pointer result = nil; + struct pso4 *frame = pointer_to_pso4( frame_pointer ); + struct pso2 *lambda = pointer_to_object( fetch_arg( frame, 0 ) ); + struct pso_pointer args = fetch_arg( frame, 1 ); struct pso_pointer new_env = fetch_env( frame_pointer ); struct pso_pointer names = lambda->payload.lambda.args; @@ -299,12 +302,12 @@ eval_lambda( struct pso_pointer frame_pointer ) { /* if `names` is a symbol, rather than a list of symbols, * then bind a list of the values of args to that symbol. */ /* \todo eval all the things in frame->payload.stack_frame.more */ - struct pso_pointer more_frame = inc_ref( - make_frame(1, frame_pointer, - frame->payload.stack_frame.more)); + struct pso_pointer more_frame = inc_ref( make_frame( 1, frame_pointer, + frame->payload. + stack_frame. + more ) ); - struct pso_pointer vals = - eval_forms( more_frame ); + struct pso_pointer vals = eval_forms( more_frame ); for ( int i = args_in_frame - 1; i >= 0; i-- ) { struct pso_pointer next = @@ -407,43 +410,46 @@ struct pso_pointer maybe_fixup_exception_location( struct pso_pointer r, * * @return a pointer to the new frame. */ -struct pso_pointer make_fn_frame(struct pso_pointer previous, - struct pso_pointer fn_pointer, - struct pso_pointer arg_list) { +struct pso_pointer make_fn_frame( struct pso_pointer previous, + struct pso_pointer fn_pointer, + struct pso_pointer arg_list ) { - struct pso_pointer new_pointer = make_frame( 0, previous ); + struct pso_pointer new_pointer = make_frame( 0, previous ); struct pso4 *new_frame = pointer_to_pso4( new_pointer ); - struct pso_pointer next_pointer = - push_local(previous, make_frame(1, previous, nil)); - struct pso4 *next_frame = pointer_to_pso4(next_pointer); + struct pso_pointer next_pointer = + push_local( previous, make_frame( 1, previous, nil ) ); + struct pso4 *next_frame = pointer_to_pso4( next_pointer ); new_frame->payload.stack_frame.function = fn_pointer; - int args = 0; - struct pso_pointer cursor; - for ( cursor = arg_list; consp(cursor) && args < args_in_frame; cursor = c_cdr(cursor)) { - // Reusing a frame like this is a bit of an abuse but will save allocation churn. - next_frame->payload.stack_frame.arg[0] = c_car(cursor); - new_frame->payload.stack_frame.arg[args++] = inc_ref( lisp_eval( next_pointer) ); - } - if (consp(cursor)) { - struct pso_pointer more = nil; + int args = 0; + struct pso_pointer cursor; + for ( cursor = arg_list; consp( cursor ) && args < args_in_frame; + cursor = c_cdr( cursor ) ) { + // Reusing a frame like this is a bit of an abuse but will save allocation churn. + next_frame->payload.stack_frame.arg[0] = c_car( cursor ); + new_frame->payload.stack_frame.arg[args++] = + inc_ref( lisp_eval( next_pointer ) ); + } + if ( consp( cursor ) ) { + struct pso_pointer more = nil; - for (; consp(cursor); cursor = c_cdr(cursor)) { - // Reusing a frame like this is a bit of an abuse but will save - // allocation churn. - next_frame->payload.stack_frame.arg[0] = c_car(cursor); - more = make_cons(previous, lisp_eval(next_pointer), more); + for ( ; consp( cursor ); cursor = c_cdr( cursor ) ) { + // Reusing a frame like this is a bit of an abuse but will save + // allocation churn. + next_frame->payload.stack_frame.arg[0] = c_car( cursor ); + more = make_cons( previous, lisp_eval( next_pointer ), more ); args++; - } + } - new_frame->payload.stack_frame.more = push_local( previous, c_reverse( previous, more)); - } + new_frame->payload.stack_frame.more = + push_local( previous, c_reverse( previous, more ) ); + } - new_frame->payload.stack_frame.args = args; + new_frame->payload.stack_frame.args = args; - return new_pointer; + return new_pointer; } /** @@ -457,29 +463,31 @@ struct pso_pointer make_fn_frame(struct pso_pointer previous, * * @return a pointer to the new frame. */ -struct pso_pointer make_special_frame(struct pso_pointer previous, - struct pso_pointer fn_pointer, - struct pso_pointer arg_list) { +struct pso_pointer make_special_frame( struct pso_pointer previous, + struct pso_pointer fn_pointer, + struct pso_pointer arg_list ) { - struct pso_pointer new_pointer = make_frame( 0, previous ); + struct pso_pointer new_pointer = make_frame( 0, previous ); struct pso4 *new_frame = pointer_to_pso4( new_pointer ); new_frame->payload.stack_frame.function = fn_pointer; - int args = 0; - struct pso_pointer cursor; - for ( cursor = arg_list; consp(cursor) && args < args_in_frame; cursor = c_cdr(cursor)) { - // Reusing a frame like this is a bit of an abuse but will save allocation churn. - new_frame->payload.stack_frame.arg[args++] = inc_ref( c_car(cursor) ); - } - if (consp(cursor)) { + int args = 0; + struct pso_pointer cursor; + for ( cursor = arg_list; consp( cursor ) && args < args_in_frame; + cursor = c_cdr( cursor ) ) { + // Reusing a frame like this is a bit of an abuse but will save allocation churn. + new_frame->payload.stack_frame.arg[args++] = + inc_ref( c_car( cursor ) ); + } + if ( consp( cursor ) ) { - new_frame->payload.stack_frame.more = inc_ref( cursor); - } + new_frame->payload.stack_frame.more = inc_ref( cursor ); + } - new_frame->payload.stack_frame.args = args; + new_frame->payload.stack_frame.args = args; - return new_pointer; + return new_pointer; } /** @@ -489,15 +497,18 @@ struct pso_pointer make_special_frame(struct pso_pointer previous, * @param env The evaluation environment. * @return the result of evaluating the function with its arguments. */ -struct pso_pointer lisp_apply( struct pso_pointer frame_pointer) { +struct pso_pointer lisp_apply( struct pso_pointer frame_pointer ) { debug_print( L"Entering apply\n", DEBUG_EVAL, 0 ); struct pso_pointer result = nil; - struct pso4* frame = pointer_to_pso4(frame_pointer); - struct pso_pointer fn_frame = inc_ref( make_frame(1, frame_pointer, c_car( frame->payload.stack_frame.arg[0] ))); + struct pso4 *frame = pointer_to_pso4( frame_pointer ); + struct pso_pointer fn_frame = + inc_ref( make_frame + ( 1, frame_pointer, + c_car( frame->payload.stack_frame.arg[0] ) ) ); struct pso_pointer fn_pointer = - push_local(frame_pointer, eval_form( fn_frame)); - dec_ref( fn_frame); + push_local( frame_pointer, eval_form( fn_frame ) ); + dec_ref( fn_frame ); if ( exceptionp( fn_pointer ) ) { result = fn_pointer; @@ -514,35 +525,33 @@ struct pso_pointer lisp_apply( struct pso_pointer frame_pointer) { case FUNCTIONTV: { struct pso_pointer next_pointer = - inc_ref( make_fn_frame( frame_pointer, fn_pointer, args )); + inc_ref( make_fn_frame + ( frame_pointer, fn_pointer, args ) ); if ( exceptionp( next_pointer ) ) { result = next_pointer; } else { - result = push_local( frame_pointer, - maybe_fixup_exception_location( ( * - ( fn_cell-> - payload. - function. - executable ) ) - (next_pointer ), - fn_pointer )); + result = push_local( frame_pointer, + maybe_fixup_exception_location( ( *( fn_cell->payload.function.executable ) ) + ( next_pointer ), fn_pointer ) ); dec_ref( next_pointer ); } } break; - case KEYTV: { - struct pso_pointer map_frame = - inc_ref(make_frame(1, frame_pointer, c_car(args))); - result = push_local( - frame_pointer, - c_assoc(fn_pointer, - maybe_fixup_exception_location( - eval_form(map_frame), fn_pointer))); - } break; + case KEYTV:{ + struct pso_pointer map_frame = + inc_ref( make_frame + ( 1, frame_pointer, c_car( args ) ) ); + result = + push_local( frame_pointer, + c_assoc( fn_pointer, + maybe_fixup_exception_location + ( eval_form( map_frame ), + fn_pointer ) ) ); + } break; - case LAMBDATV: + case LAMBDATV: { struct pso_pointer next_pointer = make_fn_frame( frame_pointer, fn_pointer, args ); @@ -551,8 +560,7 @@ struct pso_pointer lisp_apply( struct pso_pointer frame_pointer) { result = next_pointer; } else { struct pso4 *next = pointer_to_pso4( next_pointer ); - result = - eval_lambda( next_pointer ); + result = eval_lambda( next_pointer ); if ( !exceptionp( result ) ) { dec_ref( next_pointer ); } @@ -561,7 +569,7 @@ struct pso_pointer lisp_apply( struct pso_pointer frame_pointer) { break; case HASHTV: - /* \todo: if arg[0] is a CONS, treat it as a path */ + /* \todo: if arg[0] is a CONS, treat it as a path */ // result = c_assoc( eval_form( frame, // frame_pointer, @@ -580,8 +588,7 @@ struct pso_pointer lisp_apply( struct pso_pointer frame_pointer) { result = next_pointer; } else { struct pso4 *next = pointer_to_pso4( next_pointer ); - result = - eval_lambda( next_pointer ); + result = eval_lambda( next_pointer ); dec_ref( next_pointer ); } } @@ -596,15 +603,12 @@ struct pso_pointer lisp_apply( struct pso_pointer frame_pointer) { result = next_pointer; } else { result = maybe_fixup_exception_location( ( * - ( fn_cell-> - payload. - special. - executable ) ) + ( fn_cell->payload.special.executable ) ) ( next_pointer ), fn_pointer ); debug_print( L"Special form returning: ", DEBUG_EVAL, 0 ); debug_print_object( result, DEBUG_EVAL, 0 ); - debug_println( DEBUG_EVAL); + debug_println( DEBUG_EVAL ); dec_ref( next_pointer ); } } @@ -617,14 +621,15 @@ struct pso_pointer lisp_apply( struct pso_pointer frame_pointer) { memset( buffer, '\0', bs ); swprintf( buffer, bs, L"Unexpected cell with tag %u (%3.3s) in function position", - get_tag_value(fn_pointer), + get_tag_value( fn_pointer ), &( fn_cell->header.tag.bytes.mnemonic[0] ) ); struct pso_pointer message = c_string_to_lisp_string( frame_pointer, buffer ); free( buffer ); result = - throw_exception( c_string_to_lisp_symbol( frame_pointer, L"apply" ), - message, frame_pointer ); + throw_exception( c_string_to_lisp_symbol + ( frame_pointer, L"apply" ), message, + frame_pointer ); } } @@ -633,7 +638,7 @@ struct pso_pointer lisp_apply( struct pso_pointer frame_pointer) { debug_print( L"apply: returning: ", DEBUG_EVAL, 0 ); debug_print_object( result, DEBUG_EVAL, 0 ); debug_println( DEBUG_EVAL ); - debug_dump_object( result, DEBUG_EVAL, 0 ); + debug_dump_object( result, DEBUG_EVAL, 0 ); return result; } @@ -655,42 +660,46 @@ struct pso_pointer lisp_apply( struct pso_pointer frame_pointer) { * * If a special form, passes the cdr of expression to the special form as argument. * @exception if `expression` is a symbol which is not bound in `env`. */ -struct pso_pointer -lisp_eval( struct pso_pointer frame_pointer ) { +struct pso_pointer lisp_eval( struct pso_pointer frame_pointer ) { debug_print( L"Eval: ", DEBUG_EVAL, 0 ); debug_dump_object( frame_pointer, DEBUG_EVAL, 0 ); - struct pso4* frame = pointer_to_pso4(frame_pointer); + struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso_pointer result = frame->payload.stack_frame.arg[0]; - struct pso2 *cell = pointer_to_object(frame->payload.stack_frame.arg[0]); - struct pso_pointer env = fetch_env(frame_pointer); + struct pso2 *cell = pointer_to_object( frame->payload.stack_frame.arg[0] ); + struct pso_pointer env = fetch_env( frame_pointer ); - switch (get_tag_value(result)) { - case CONSTV: { - struct pso_pointer next_pointer = - push_local(frame_pointer, make_frame(2, frame_pointer, - c_car(result), c_cdr(result))); - result = push_local(frame_pointer, lisp_apply(next_pointer)); - } break; + switch ( get_tag_value( result ) ) { + case CONSTV:{ + struct pso_pointer next_pointer = + push_local( frame_pointer, make_frame( 2, frame_pointer, + c_car( result ), + c_cdr( result ) ) ); + result = + push_local( frame_pointer, lisp_apply( next_pointer ) ); + } break; - case SYMBOLTV: + case SYMBOLTV: { #ifdef DEBUG - debug_print( L"\nEvaluating symbol `", DEBUG_EVAL, 0); - debug_print_object( fetch_arg( frame, 0), DEBUG_EVAL, 0); - debug_print( L"`\n\tEnvironment is: ", DEBUG_EVAL, 0); - debug_dump_object( fetch_env(frame_pointer), DEBUG_EVAL, 0); + debug_print( L"\nEvaluating symbol `", DEBUG_EVAL, 0 ); + debug_print_object( fetch_arg( frame, 0 ), DEBUG_EVAL, 0 ); + debug_print( L"`\n\tEnvironment is: ", DEBUG_EVAL, 0 ); + debug_dump_object( fetch_env( frame_pointer ), DEBUG_EVAL, 0 ); #endif struct pso_pointer canonical = - c_interned( frame->payload.stack_frame.arg[0], fetch_env(frame_pointer) ); + c_interned( frame->payload.stack_frame.arg[0], + fetch_env( frame_pointer ) ); if ( c_nilp( canonical ) ) { struct pso_pointer message = make_cons( frame_pointer, c_string_to_lisp_string - ( frame_pointer, L"Attempt to take value of unbound symbol." ), - frame->payload.stack_frame.arg[0] ); + ( frame_pointer, + L"Attempt to take value of unbound symbol." ), + frame->payload.stack_frame.arg[0] ); result = - throw_exception( c_string_to_lisp_symbol( frame_pointer, L"eval" ), - message, frame_pointer ); + throw_exception( c_string_to_lisp_symbol + ( frame_pointer, L"eval" ), message, + frame_pointer ); } else { result = c_assoc( canonical, env ); // inc_ref( result ); @@ -706,9 +715,9 @@ lisp_eval( struct pso_pointer frame_pointer ) { default: // we've already done this... break; - } + } - debug_print( L"Eval returning ", DEBUG_EVAL, 0 ); + debug_print( L"Eval returning ", DEBUG_EVAL, 0 ); debug_dump_object( result, DEBUG_EVAL, 0 ); return result; @@ -737,17 +746,22 @@ lisp_quote( struct pso4 *frame, struct pso_pointer frame_pointer, * @param pointer a pointer to the object whose type is requested. * @return As a Lisp string, the tag of the object which is at that pointer. */ -struct pso_pointer c_type( struct pso_pointer frame_pointer, struct pso_pointer pointer ) { +struct pso_pointer c_type( struct pso_pointer frame_pointer, + struct pso_pointer pointer ) { /* Strings read by `read` have the null character termination. This means * that for the same printable string, the hashcode is different from * strings made with NIL termination. The question is which should be * fixed, and actually that's probably strings read by `read`. However, * for now, it was easier to add a null character here. */ - struct pso_pointer result = make_symbol( frame_pointer, ( wchar_t ) 0, nil ); + struct pso_pointer result = + make_symbol( frame_pointer, ( wchar_t ) 0, nil ); struct pso2 *cell = pointer_to_object( pointer ); for ( int i = TAGLENGTH - 1; i >= 0; i-- ) { - result = make_symbol( frame_pointer, ( wchar_t ) cell->header.tag.bytes.mnemonic[i], result ); + result = + make_symbol( frame_pointer, + ( wchar_t ) cell->header.tag.bytes.mnemonic[i], + result ); } return result; @@ -761,9 +775,9 @@ struct pso_pointer c_type( struct pso_pointer frame_pointer, struct pso_pointer * * @return As a Lisp symbol, the tag of `expression`. */ -struct pso_pointer -lisp_type( struct pso_pointer frame_pointer ) { - return c_type( frame_pointer, fetch_arg( pointer_to_pso4( frame_pointer), 0) ); +struct pso_pointer lisp_type( struct pso_pointer frame_pointer ) { + return c_type( frame_pointer, + fetch_arg( pointer_to_pso4( frame_pointer ), 0 ) ); } @@ -779,13 +793,13 @@ lisp_type( struct pso_pointer frame_pointer ) { * @return the source of the `object` indicated, if it is a function, a lambda, * an nlambda, or a spcial form; else `nil`. */ -struct pso_pointer lisp_source( struct pso_pointer frame_pointer) { +struct pso_pointer lisp_source( struct pso_pointer frame_pointer ) { struct pso_pointer result = nil; - struct pso4* frame = pointer_to_pso4(frame_pointer); - struct pso2 *cell = - pointer_to_object( fetch_arg( frame, 0) ); - struct pso_pointer source_key = c_string_to_lisp_keyword( frame_pointer, L"source" ); - switch ( get_tag_value(fetch_arg( frame, 0)) ) { + struct pso4 *frame = pointer_to_pso4( frame_pointer ); + struct pso2 *cell = pointer_to_object( fetch_arg( frame, 0 ) ); + struct pso_pointer source_key = + c_string_to_lisp_keyword( frame_pointer, L"source" ); + switch ( get_tag_value( fetch_arg( frame, 0 ) ) ) { case FUNCTIONTV: result = c_assoc( source_key, cell->payload.function.meta ); break; @@ -794,17 +808,19 @@ struct pso_pointer lisp_source( struct pso_pointer frame_pointer) { break; case LAMBDATV: result = make_cons( frame_pointer, - c_string_to_lisp_symbol( frame_pointer, L"λ" ), - make_cons( frame_pointer, - cell->payload.lambda.args, - cell->payload.lambda.body ) ); + c_string_to_lisp_symbol( frame_pointer, + L"λ" ), + make_cons( frame_pointer, + cell->payload.lambda.args, + cell->payload.lambda.body ) ); break; case NLAMBDATV: result = make_cons( frame_pointer, - c_string_to_lisp_symbol( frame_pointer, L"nλ" ), - make_cons( frame_pointer, - cell->payload.lambda.args, - cell->payload.lambda.body ) ); + c_string_to_lisp_symbol( frame_pointer, + L"nλ" ), + make_cons( frame_pointer, + cell->payload.lambda.args, + cell->payload.lambda.body ) ); break; } push_local( frame_pointer, result ); @@ -820,7 +836,7 @@ struct pso_pointer lisp_source( struct pso_pointer frame_pointer) { * @return struct pso_pointer a pointer to the result */ struct pso_pointer lisp_list( struct pso_pointer frame_pointer ) { - struct pso4* frame = pointer_to_pso4( frame_pointer); + struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso_pointer result = frame->payload.stack_frame.more; for ( int a = @@ -840,51 +856,60 @@ struct pso_pointer lisp_list( struct pso_pointer frame_pointer ) { * This is `let*` in Common Lisp parlance; `let` in Clojure parlance. */ struct pso_pointer lisp_let( struct pso_pointer frame_pointer ) { - struct pso4* frame = pointer_to_pso4( frame_pointer); - struct pso_pointer bindings = fetch_env(frame_pointer); + struct pso4 *frame = pointer_to_pso4( frame_pointer ); + struct pso_pointer bindings = fetch_env( frame_pointer ); struct pso_pointer result = nil; - for ( struct pso_pointer cursor = fetch_arg( frame, 0); + for ( struct pso_pointer cursor = fetch_arg( frame, 0 ); c_truep( cursor ); cursor = c_cdr( cursor ) ) { struct pso_pointer pair = c_car( cursor ); struct pso_pointer symbol = c_car( pair ); - struct pso_pointer next_pointer = push_local( frame_pointer, make_frame_with_env( 0, frame_pointer, bindings)); + struct pso_pointer next_pointer = + push_local( frame_pointer, + make_frame_with_env( 0, frame_pointer, bindings ) ); if ( symbolp( symbol ) ) { - add_arg(next_pointer, c_cdr(pair)); - struct pso_pointer val = - eval_form( next_pointer ); + add_arg( next_pointer, c_cdr( pair ) ); + struct pso_pointer val = eval_form( next_pointer ); // debug_print_binding( symbol, val, false, DEBUG_BIND ); - bindings = make_cons( frame_pointer, make_cons( frame_pointer, symbol, val ), bindings ); + bindings = + make_cons( frame_pointer, + make_cons( frame_pointer, symbol, val ), bindings ); } else { result = - throw_exception( c_string_to_lisp_symbol( frame_pointer, L"let" ), - c_string_to_lisp_string( frame_pointer, L"Let: cannot bind, not a symbol" ), + throw_exception( c_string_to_lisp_symbol + ( frame_pointer, L"let" ), + c_string_to_lisp_string( frame_pointer, + L"Let: cannot bind, not a symbol" ), frame_pointer ); break; } } - if (!exceptionp(result)) { + if ( !exceptionp( result ) ) { debug_print( L"\nlet: bindings complete.\n", DEBUG_BIND, 0 ); - struct pso_pointer progn_pointer = make_frame_with_env( 0, frame_pointer, bindings); - struct pso4* progn_frame = pointer_to_pso4(progn_pointer); + struct pso_pointer progn_pointer = + make_frame_with_env( 0, frame_pointer, bindings ); + struct pso4 *progn_frame = pointer_to_pso4( progn_pointer ); int a = 1; - for (; a < frame->payload.stack_frame.args && a < args_in_frame; a++) { - progn_frame->payload.stack_frame.arg[a-1] = fetch_arg( frame, a); - progn_frame->payload.stack_frame.args ++; + for ( ; a < frame->payload.stack_frame.args && a < args_in_frame; a++ ) { + progn_frame->payload.stack_frame.arg[a - 1] = + fetch_arg( frame, a ); + progn_frame->payload.stack_frame.args++; } - if ( a < frame->payload.stack_frame.args) { - progn_frame->payload.stack_frame.arg[a-1] = fetch_arg( frame, a); - progn_frame->payload.stack_frame.more = c_cdr( frame->payload.stack_frame.more); + if ( a < frame->payload.stack_frame.args ) { + progn_frame->payload.stack_frame.arg[a - 1] = + fetch_arg( frame, a ); + progn_frame->payload.stack_frame.more = + c_cdr( frame->payload.stack_frame.more ); } - result = lisp_progn(progn_pointer); + result = lisp_progn( progn_pointer ); } return result; @@ -904,8 +929,8 @@ struct pso_pointer lisp_and( struct pso4 *frame, bool accumulator = true; struct pso_pointer result = frame->payload.stack_frame.more; - for ( int a = 0; accumulator == true && a < frame->payload.stack_frame.args; - a++ ) { + for ( int a = 0; + accumulator == true && a < frame->payload.stack_frame.args; a++ ) { accumulator = truthy( fetch_arg( frame, a ) ); } # diff --git a/src/c/ops/inspect.c b/src/c/ops/inspect.c index 67c883d..bb920e5 100644 --- a/src/c/ops/inspect.c +++ b/src/c/ops/inspect.c @@ -35,8 +35,8 @@ * @param env my environment (from which the stream may be extracted). * @return nil. */ -struct pso_pointer lisp_inspect(struct pso_pointer frame_pointer) { - debug_print( L"Entering lisp_inspect\n", DEBUG_IO, 0 ); +struct pso_pointer lisp_inspect( struct pso_pointer frame_pointer ) { + debug_print( L"Entering lisp_inspect\n", DEBUG_IO, 0 ); struct pso_pointer result = nil; struct pso4 *frame = pointer_to_pso4( frame_pointer ); @@ -46,7 +46,7 @@ struct pso_pointer lisp_inspect(struct pso_pointer frame_pointer) { : get_default_stream( false, fetch_env( frame_pointer ) ); URL_FILE *output; - dump_object( frame_pointer, fetch_arg(frame,1), fetch_arg(frame, 0) ); + dump_object( frame_pointer, fetch_arg( frame, 1 ), fetch_arg( frame, 0 ) ); debug_print( L"Leaving lisp_inspect", DEBUG_IO, 0 ); diff --git a/src/c/ops/inspect.h b/src/c/ops/inspect.h index a383dfa..2f9bdae 100644 --- a/src/c/ops/inspect.h +++ b/src/c/ops/inspect.h @@ -17,9 +17,9 @@ /** * Legacy technical debt to be entirely rewritten */ -void dump_object(struct pso_pointer frame_pointer, - struct pso_pointer output, struct pso_pointer pointer ); +void dump_object( struct pso_pointer frame_pointer, + struct pso_pointer output, struct pso_pointer pointer ); struct pso_pointer lisp_inspect( struct pso_pointer frame_pointer ); -#endif \ No newline at end of file +#endif diff --git a/src/c/ops/keys.c b/src/c/ops/keys.c index 5eaffdd..0099917 100644 --- a/src/c/ops/keys.c +++ b/src/c/ops/keys.c @@ -20,8 +20,8 @@ * @brief an implementation of `keys` convenient for calling from C * * @param */ -struct pso_pointer c_keys(struct pso_pointer frame_pointer, - struct pso_pointer store ) { +struct pso_pointer c_keys( struct pso_pointer frame_pointer, + struct pso_pointer store ) { struct pso_pointer result = nil; if ( consp( store ) ) { @@ -29,14 +29,14 @@ struct pso_pointer c_keys(struct pso_pointer frame_pointer, pair = c_car( store ) ) { if ( consp( pair ) ) { result = make_cons( frame_pointer, c_car( pair ), result ); - // } else if ( hashtabp( pair ) ) { - // result = c_append( hashmap_keys( pair ), result ); + // } else if ( hashtabp( pair ) ) { + // result = c_append( hashmap_keys( pair ), result ); } store = c_cdr( store ); } - // } else if ( hashtabp( store ) ) { - // result = hashmap_keys( store ); + // } else if ( hashtabp( store ) ) { + // result = hashmap_keys( store ); } return result; @@ -44,7 +44,8 @@ struct pso_pointer c_keys(struct pso_pointer frame_pointer, -struct pso_pointer lisp_keys( struct pso_pointer frame_pointer) { - return c_keys( frame_pointer, pointer_to_pso4(frame_pointer)->payload.stack_frame.arg[0] ); +struct pso_pointer lisp_keys( struct pso_pointer frame_pointer ) { + return c_keys( frame_pointer, + pointer_to_pso4( frame_pointer )->payload.stack_frame. + arg[0] ); } - diff --git a/src/c/ops/keys.h b/src/c/ops/keys.h index a912936..fa6e03e 100644 --- a/src/c/ops/keys.h +++ b/src/c/ops/keys.h @@ -14,6 +14,6 @@ struct pso_pointer c_keys( struct pso_pointer store ); -struct pso_pointer lisp_keys(struct pso_pointer frame_pointer); +struct pso_pointer lisp_keys( struct pso_pointer frame_pointer ); -#endif \ No newline at end of file +#endif diff --git a/src/c/ops/list_ops.c b/src/c/ops/list_ops.c index 5cb3151..93d7c55 100644 --- a/src/c/ops/list_ops.c +++ b/src/c/ops/list_ops.c @@ -33,4 +33,3 @@ struct pso_pointer count( struct pso_pointer frame_pointer ) { return acquire_integer( frame_pointer, c ); } - diff --git a/src/c/ops/mapcar.c b/src/c/ops/mapcar.c index 44921b1..d6315b4 100644 --- a/src/c/ops/mapcar.c +++ b/src/c/ops/mapcar.c @@ -25,34 +25,43 @@ #include "payloads/cons.h" struct pso_pointer lisp_mapcar( struct pso_pointer frame_pointer ) { - struct pso_pointer result = nil; - struct pso4* frame = pointer_to_pso4(frame_pointer); + struct pso_pointer result = nil; + struct pso4 *frame = pointer_to_pso4( frame_pointer ); debug_print( L"Mapcar: ", DEBUG_EVAL, 0 ); debug_dump_object( frame_pointer, DEBUG_EVAL, 0 ); int i = 0; - for ( struct pso_pointer c = frame->payload.stack_frame.arg[1]; c_truep( c ); - c = c_cdr( c ) ) { - struct pso_pointer expr = - push_local( frame_pointer, - make_cons( frame_pointer, frame->payload.stack_frame.arg[0], - make_cons( frame_pointer, c_car( c ), nil ) ) ); + for ( struct pso_pointer c = frame->payload.stack_frame.arg[1]; + c_truep( c ); c = c_cdr( c ) ) { + struct pso_pointer expr = push_local( 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, L"Mapcar %d, evaluating ", i ); debug_print_object( expr, DEBUG_EVAL, 0 ); - debug_println( DEBUG_EVAL); + debug_println( DEBUG_EVAL ); - struct pso_pointer r = lisp_eval( push_local( frame_pointer, make_frame(1, frame_pointer, expr))); + struct pso_pointer r = + lisp_eval( push_local + ( frame_pointer, + make_frame( 1, frame_pointer, expr ) ) ); if ( exceptionp( r ) ) { result = r; break; } 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, L"Mapcar %d, result is ", i++ ); debug_print_object( result, DEBUG_EVAL, 0 ); - debug_println( DEBUG_EVAL); + debug_println( DEBUG_EVAL ); } result = consp( result ) ? c_reverse( frame_pointer, result ) : result; diff --git a/src/c/ops/mapcar.h b/src/c/ops/mapcar.h index 50408a9..bb1c24a 100644 --- a/src/c/ops/mapcar.h +++ b/src/c/ops/mapcar.h @@ -14,4 +14,4 @@ struct pso_pointer lisp_mapcar( struct pso_pointer frame_pointer ); -#endif \ No newline at end of file +#endif diff --git a/src/c/ops/progn.c b/src/c/ops/progn.c index 3fdef99..a6a21bb 100644 --- a/src/c/ops/progn.c +++ b/src/c/ops/progn.c @@ -31,14 +31,14 @@ struct pso_pointer c_progn( struct pso4 *frame, struct pso_pointer frame_pointer, struct pso_pointer expressions, struct pso_pointer env ) { struct pso_pointer result = nil; - struct pso_pointer next_pointer = - push_local(frame_pointer, make_frame(1, frame_pointer, nil)); - struct pso4 *next_frame = pointer_to_pso4(next_pointer); + struct pso_pointer next_pointer = + push_local( frame_pointer, make_frame( 1, frame_pointer, nil ) ); + struct pso4 *next_frame = pointer_to_pso4( next_pointer ); while ( consp( expressions ) ) { - next_frame->payload.stack_frame.arg[0] = c_car(expressions); + next_frame->payload.stack_frame.arg[0] = c_car( expressions ); - result = lisp_eval( next_pointer); + result = lisp_eval( next_pointer ); expressions = exceptionp( result ) ? nil : c_cdr( expressions ); } @@ -60,25 +60,25 @@ c_progn( struct pso4 *frame, struct pso_pointer frame_pointer, * @return the value of the last `expression` of the sequence which is my single * argument. */ -struct pso_pointer -lisp_progn( struct pso_pointer frame_pointer) { - struct pso_pointer result = nil; - struct pso4 *frame = pointer_to_pso4(frame_pointer); - struct pso_pointer next_pointer = - push_local(frame_pointer, make_frame(1, frame_pointer, nil)); - struct pso4 *next_frame = pointer_to_pso4(next_pointer); +struct pso_pointer lisp_progn( struct pso_pointer frame_pointer ) { + struct pso_pointer result = nil; + struct pso4 *frame = pointer_to_pso4( frame_pointer ); + struct pso_pointer next_pointer = + push_local( frame_pointer, make_frame( 1, frame_pointer, nil ) ); + struct pso4 *next_frame = pointer_to_pso4( next_pointer ); - for (int i = 0; i < args_in_frame; i++) { - next_frame->payload.stack_frame.arg[0] = - frame->payload.stack_frame.arg[i]; + for ( int i = 0; i < args_in_frame; i++ ) { + next_frame->payload.stack_frame.arg[0] = + frame->payload.stack_frame.arg[i]; - result = push_local(frame_pointer, lisp_eval(next_pointer)); - } + result = push_local( frame_pointer, lisp_eval( next_pointer ) ); + } - if (consp(frame->payload.stack_frame.more)) { - result = c_progn(frame, frame_pointer, frame->payload.stack_frame.more, - fetch_env(frame_pointer)); - } + if ( consp( frame->payload.stack_frame.more ) ) { + result = + c_progn( frame, frame_pointer, frame->payload.stack_frame.more, + fetch_env( frame_pointer ) ); + } - return result; + return result; } diff --git a/src/c/ops/progn.h b/src/c/ops/progn.h index 4651485..37e42c3 100644 --- a/src/c/ops/progn.h +++ b/src/c/ops/progn.h @@ -15,9 +15,10 @@ #include "memory/pointer.h" #include "memory/pso4.h" -struct pso_pointer c_progn(struct pso4 *frame, struct pso_pointer frame_pointer, - struct pso_pointer expressions, - struct pso_pointer env); +struct pso_pointer c_progn( struct pso4 *frame, + struct pso_pointer frame_pointer, + struct pso_pointer expressions, + struct pso_pointer env ); -struct pso_pointer lisp_progn(struct pso_pointer frame_pointer); -#endif \ No newline at end of file +struct pso_pointer lisp_progn( struct pso_pointer frame_pointer ); +#endif diff --git a/src/c/ops/quote.c b/src/c/ops/quote.c index f1d3595..15a3c28 100644 --- a/src/c/ops/quote.c +++ b/src/c/ops/quote.c @@ -21,6 +21,6 @@ * * @return the expression. */ -struct pso_pointer quote(struct pso_pointer frame_pointer){ - return fetch_arg(pointer_to_pso4(frame_pointer), 0); -} \ No newline at end of file +struct pso_pointer quote( struct pso_pointer frame_pointer ) { + return fetch_arg( pointer_to_pso4( frame_pointer ), 0 ); +} diff --git a/src/c/ops/quote.h b/src/c/ops/quote.h index 6c6af0b..b203554 100644 --- a/src/c/ops/quote.h +++ b/src/c/ops/quote.h @@ -14,5 +14,5 @@ #include "memory/pointer.h" -struct pso_pointer quote(struct pso_pointer frame_pointer); -#endif \ No newline at end of file +struct pso_pointer quote( struct pso_pointer frame_pointer ); +#endif diff --git a/src/c/ops/repl.c b/src/c/ops/repl.c index 8d04f09..009cbf9 100644 --- a/src/c/ops/repl.c +++ b/src/c/ops/repl.c @@ -106,7 +106,7 @@ struct pso_pointer repl( struct pso_pointer frame_pointer ) { dec_ref( base_of_stack ); } - debug_print(L"Leaving repl\n", DEBUG_REPL, 0); + debug_print( L"Leaving repl\n", DEBUG_REPL, 0 ); - return nil; + return nil; } diff --git a/src/c/ops/reverse.c b/src/c/ops/reverse.c index a9be24f..1fb76e5 100644 --- a/src/c/ops/reverse.c +++ b/src/c/ops/reverse.c @@ -49,25 +49,25 @@ struct pso_pointer reverse( struct pso_pointer frame_pointer ) { case KEYTV: result = push_local( frame_pointer, make_string_like_thing( frame_pointer, - object->payload. - string.character, - result, + object-> + payload.string. + character, result, KEYTAG ) ); break; case STRINGTV: result = push_local( frame_pointer, make_string_like_thing( frame_pointer, - object->payload. - string.character, - result, + object-> + payload.string. + character, result, STRINGTAG ) ); break; case SYMBOLTV: result = push_local( frame_pointer, make_string_like_thing( frame_pointer, - object->payload. - string.character, - result, + object-> + payload.string. + character, result, SYMBOLTAG ) ); break; default: @@ -105,8 +105,8 @@ struct pso_pointer c_reverse( struct pso_pointer frame_pointer, struct pso_pointer result = nil; if ( stackp( frame_pointer ) ) { - result = reverse( make_frame(1, frame_pointer, sequence) ); + result = reverse( make_frame( 1, frame_pointer, sequence ) ); } - + return result; } diff --git a/src/c/ops/string_ops.c b/src/c/ops/string_ops.c index 7111762..7674434 100644 --- a/src/c/ops/string_ops.c +++ b/src/c/ops/string_ops.c @@ -146,8 +146,8 @@ char *lisp_string_to_c_string( struct pso_pointer s ) { int i = 0; for ( struct pso_pointer c = s; !c_nilp( c ); c = c_cdr( c ) ) { buffer[i++] = - ( wchar_t ) ( pointer_to_object( c )->payload. - string.character ); + ( wchar_t ) ( pointer_to_object( c )->payload.string. + character ); } mbstate_t ps; @@ -183,7 +183,7 @@ struct pso_pointer c_string_to_lisp_symbol( struct pso_pointer frame_pointer, for ( int i = wcslen( symbol ) - 1; i >= 0; i-- ) { wchar_t c = symbol[i]; - if ( symbol_char_p(c)) { + if ( symbol_char_p( c ) ) { result = make_symbol( frame_pointer, c, result ); } } diff --git a/src/c/ops/string_ops.h b/src/c/ops/string_ops.h index b265dc7..af21a2b 100644 --- a/src/c/ops/string_ops.h +++ b/src/c/ops/string_ops.h @@ -27,11 +27,11 @@ char *lisp_string_to_c_string( struct pso_pointer s ); struct pso_pointer c_string_to_lisp_keyword( struct pso_pointer frame_pointer, - wchar_t * symbol ); + wchar_t *symbol ); struct pso_pointer c_string_to_lisp_symbol( struct pso_pointer frame_pointer, - wchar_t * symbol ); + wchar_t *symbol ); -bool end_of_stringp(struct pso_pointer arg); +bool end_of_stringp( struct pso_pointer arg ); #endif diff --git a/src/c/payloads/exception.c b/src/c/payloads/exception.c index 1bdd236..e2d3b58 100644 --- a/src/c/payloads/exception.c +++ b/src/c/payloads/exception.c @@ -121,29 +121,29 @@ struct pso_pointer throw_exception_with_cause( struct pso_pointer location, debug_print( L"`\n", DEBUG_ANY, 0 ); if ( !c_nilp( cause ) ) { debug_print( L"\tCaused by: ", DEBUG_ANY, 0 ); - debug_print_object( cause, DEBUG_ANY, 0); + debug_print_object( cause, DEBUG_ANY, 0 ); debug_print( L"`\n", DEBUG_ANY, 0 ); } #endif struct pso2 *cell = pointer_to_object( message ); - if (get_tag_value( message)) { - result = message; - } else { - struct pso_pointer x_frame = inc_ref(make_frame( - 2, frame_pointer, message, - (c_nilp(location) - ? nil - : make_cons(frame_pointer, - make_cons(frame_pointer, - privileged_keyword_location, location), - nil)), - cause)); + if ( get_tag_value( message ) ) { + result = message; + } else { + struct pso_pointer x_frame = + inc_ref( make_frame( 2, frame_pointer, message, + ( c_nilp( location ) + ? nil : make_cons( frame_pointer, + make_cons( frame_pointer, + privileged_keyword_location, + location ), + nil ) ), + cause ) ); - result = push_local(frame_pointer, make_exception(x_frame)); - } + result = push_local( frame_pointer, make_exception( x_frame ) ); + } - return result; + return result; } /** @@ -162,4 +162,3 @@ throw_exception( struct pso_pointer location, struct pso_pointer frame_pointer ) { return throw_exception_with_cause( location, payload, nil, frame_pointer ); } - diff --git a/src/c/payloads/float.h b/src/c/payloads/float.h index 9cfc018..15c4f2c 100644 --- a/src/c/payloads/float.h +++ b/src/c/payloads/float.h @@ -16,7 +16,7 @@ * we could/should use the full 128 bits. */ struct float_payload { - long double value; + long double value; }; -#endif \ No newline at end of file +#endif diff --git a/src/c/payloads/function.c b/src/c/payloads/function.c index 14015ab..a0c6d0d 100644 --- a/src/c/payloads/function.c +++ b/src/c/payloads/function.c @@ -12,14 +12,17 @@ #include "memory/pso2.h" #include "memory/tags.h" -struct pso_pointer make_function( - struct pso_pointer frame_pointer, struct pso_pointer meta, - struct pso_pointer (*executable)(struct pso_pointer frame_pointer)) { - struct pso_pointer result = allocate(frame_pointer, FUNCTIONTAG, 2); - struct pso2 *object = pointer_to_object(result); +struct pso_pointer make_function( struct pso_pointer frame_pointer, + struct pso_pointer meta, + struct pso_pointer ( *executable ) ( struct + pso_pointer + frame_pointer ) ) +{ + struct pso_pointer result = allocate( frame_pointer, FUNCTIONTAG, 2 ); + struct pso2 *object = pointer_to_object( result ); - object->payload.function.meta = meta; - object->payload.function.executable = executable; + object->payload.function.meta = meta; + object->payload.function.executable = executable; - return result; + return result; } diff --git a/src/c/payloads/function.h b/src/c/payloads/function.h index 8c7da98..54e7d69 100644 --- a/src/c/payloads/function.h +++ b/src/c/payloads/function.h @@ -39,8 +39,10 @@ struct function_payload { struct pso_pointer ( *executable ) ( struct pso_pointer frame_pointer ); }; -struct pso_pointer make_function( - struct pso_pointer frame_pointer, struct pso_pointer meta, - struct pso_pointer (*executable)(struct pso_pointer frame_pointer)); +struct pso_pointer make_function( struct pso_pointer frame_pointer, + struct pso_pointer meta, + struct pso_pointer ( *executable ) ( struct + pso_pointer + frame_pointer ) ); #endif diff --git a/src/c/payloads/keyword.c b/src/c/payloads/keyword.c index 325f4e3..16e11e0 100644 --- a/src/c/payloads/keyword.c +++ b/src/c/payloads/keyword.c @@ -21,7 +21,7 @@ * @param c the character to add (prepend); * @param tail the keyword which is being built. */ - struct pso_pointer make_keyword( struct pso_pointer frame_pointer, wint_t c, - struct pso_pointer tail ) { - return make_string_like_thing( frame_pointer, c, tail, KEYTAG ); - } +struct pso_pointer make_keyword( struct pso_pointer frame_pointer, wint_t c, + struct pso_pointer tail ) { + return make_string_like_thing( frame_pointer, c, tail, KEYTAG ); +} diff --git a/src/c/payloads/keyword.h b/src/c/payloads/keyword.h index 35bbbe7..56fe481 100644 --- a/src/c/payloads/keyword.h +++ b/src/c/payloads/keyword.h @@ -16,8 +16,8 @@ /* TODO: for now, Keyword shares a payload with String, but this may change. * Strings are of indefinite length, but keywords are really not, and might * fit into any size class. */ - - struct pso_pointer make_keyword( struct pso_pointer frame_pointer, wint_t c, - struct pso_pointer tail ); + +struct pso_pointer make_keyword( struct pso_pointer frame_pointer, wint_t c, + struct pso_pointer tail ); #endif diff --git a/src/c/payloads/lambda.c b/src/c/payloads/lambda.c index b38ad9d..17ee164 100644 --- a/src/c/payloads/lambda.c +++ b/src/c/payloads/lambda.c @@ -13,12 +13,13 @@ #include "memory/pso.h" #include "memory/pso2.h" -struct pso_pointer make_lambda_like_thing(struct pso_pointer frame_pointer, - struct pso_pointer args, - struct pso_pointer body, char *tag) { +struct pso_pointer make_lambda_like_thing( struct pso_pointer frame_pointer, + struct pso_pointer args, + struct pso_pointer body, + char *tag ) { - struct pso_pointer result = allocate(frame_pointer, tag, 2); - struct pso2 *object = pointer_to_object(result); - object->payload.lambda.args = args; - object->payload.lambda.body = body; + struct pso_pointer result = allocate( frame_pointer, tag, 2 ); + struct pso2 *object = pointer_to_object( result ); + object->payload.lambda.args = args; + object->payload.lambda.body = body; } diff --git a/src/c/payloads/lambda.h b/src/c/payloads/lambda.h index 0873719..59131d6 100644 --- a/src/c/payloads/lambda.h +++ b/src/c/payloads/lambda.h @@ -30,9 +30,10 @@ struct lambda_payload { struct pso_pointer body; }; -struct pso_pointer make_lambda_like_thing(struct pso_pointer frame_pointer, - struct pso_pointer args, - struct pso_pointer body, char *tag); - -#define make_lambda(f,a,b) (make_lambda_like_thing( f, a, b, LAMBDATAG)) +struct pso_pointer make_lambda_like_thing( struct pso_pointer frame_pointer, + struct pso_pointer args, + struct pso_pointer body, + char *tag ); + +#define make_lambda(f,a,b) (make_lambda_like_thing( f, a, b, LAMBDATAG)) #endif diff --git a/src/c/payloads/psse_string.h b/src/c/payloads/psse_string.h index 7e1c75e..2fbab18 100644 --- a/src/c/payloads/psse_string.h +++ b/src/c/payloads/psse_string.h @@ -35,7 +35,7 @@ struct string_payload { struct pso_pointer make_string( struct pso_pointer frame_pointer, wint_t c, struct pso_pointer tail ); - + struct pso_pointer destroy_string( struct pso_pointer fp ); #endif diff --git a/src/c/payloads/special.c b/src/c/payloads/special.c index abf8d97..4eaf622 100644 --- a/src/c/payloads/special.c +++ b/src/c/payloads/special.c @@ -12,14 +12,17 @@ #include "memory/pso2.h" #include "memory/tags.h" -struct pso_pointer make_special( - struct pso_pointer frame_pointer, struct pso_pointer meta, - struct pso_pointer (*executable)(struct pso_pointer frame_pointer)) { - struct pso_pointer result = allocate(frame_pointer, SPECIALTAG, 2); - struct pso2 *object = pointer_to_object(result); +struct pso_pointer make_special( struct pso_pointer frame_pointer, + struct pso_pointer meta, + struct pso_pointer ( *executable ) ( struct + pso_pointer + frame_pointer ) ) +{ + struct pso_pointer result = allocate( frame_pointer, SPECIALTAG, 2 ); + struct pso2 *object = pointer_to_object( result ); - object->payload.special.meta = meta; - object->payload.special.executable = executable; + object->payload.special.meta = meta; + object->payload.special.executable = executable; - return result; + return result; } diff --git a/src/c/payloads/special.h b/src/c/payloads/special.h index ef913e9..c43f35c 100644 --- a/src/c/payloads/special.h +++ b/src/c/payloads/special.h @@ -22,8 +22,10 @@ * \see NLAMBDATAG. */ -struct pso_pointer make_special( - struct pso_pointer frame_pointer, struct pso_pointer meta, - struct pso_pointer (*executable)(struct pso_pointer frame_pointer)); +struct pso_pointer make_special( struct pso_pointer frame_pointer, + struct pso_pointer meta, + struct pso_pointer ( *executable ) ( struct + pso_pointer + frame_pointer ) ); #endif diff --git a/src/c/payloads/stack.c b/src/c/payloads/stack.c index 2e299a4..adf6d11 100644 --- a/src/c/payloads/stack.c +++ b/src/c/payloads/stack.c @@ -100,22 +100,28 @@ struct pso_pointer push_local( struct pso_pointer frame_pointer, * * @return `nil` on success; potentially an exception on failure. */ -struct pso_pointer add_arg( struct pso_pointer frame_pointer, struct pso_pointer arg_pointer) { - struct pso4* frame = pointer_to_pso4( frame_pointer); +struct pso_pointer add_arg( struct pso_pointer frame_pointer, + struct pso_pointer arg_pointer ) { + struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso_pointer result = nil; - if (frame->payload.stack_frame.args < args_in_frame) { - frame->payload.stack_frame.arg[frame->payload.stack_frame.args++] = push_local(frame_pointer, arg_pointer); + if ( frame->payload.stack_frame.args < args_in_frame ) { + frame->payload.stack_frame.arg[frame->payload.stack_frame.args++] = + push_local( frame_pointer, arg_pointer ); } else { struct pso_pointer new_more = c_reverse( frame_pointer, - make_cons( frame_pointer, - arg_pointer, - c_reverse( frame_pointer, frame->payload.stack_frame.more))); - if (exceptionp(new_more)) { + make_cons( frame_pointer, + arg_pointer, + c_reverse + ( frame_pointer, + frame->payload. + stack_frame. + more ) ) ); + if ( exceptionp( new_more ) ) { result = new_more; } else { frame->payload.stack_frame.more = - push_local( frame_pointer, new_more); + push_local( frame_pointer, new_more ); } } @@ -127,7 +133,7 @@ struct pso_pointer add_arg( struct pso_pointer frame_pointer, struct pso_pointer * `env` pointer of the new frame -- callers are responsible for doing so. */ struct pso_pointer in_make_frame( int arg_count, struct pso_pointer previous, - va_list args ) { + va_list args ) { /* NOTE! It is really important not to `push_local` the new_pointer here, * since that would stop stack frames and all the temporary objects they * curate ever being garbage collected! */ @@ -205,13 +211,14 @@ struct pso_pointer make_frame( int arg_count, struct pso_pointer previous, va_list args; va_start( args, previous ); - struct pso_pointer new_pointer = in_make_frame( arg_count, previous, args); - struct pso4* new_frame = pointer_to_pso4(new_pointer); + struct pso_pointer new_pointer = + in_make_frame( arg_count, previous, args ); + struct pso4 *new_frame = pointer_to_pso4( new_pointer ); - new_frame->payload.stack_frame.env = stackp(previous) ? - inc_ref(pointer_to_pso4(previous)->payload.stack_frame.env) : nil; + new_frame->payload.stack_frame.env = stackp( previous ) ? + inc_ref( pointer_to_pso4( previous )->payload.stack_frame.env ) : nil; - va_end(args); + va_end( args ); return new_pointer; } @@ -238,10 +245,11 @@ struct pso_pointer make_frame_with_env( int arg_count, va_list args; va_start( args, env ); - struct pso_pointer new_pointer = in_make_frame( arg_count, previous, args); - pointer_to_pso4(new_pointer)->payload.stack_frame.env = inc_ref( env); + struct pso_pointer new_pointer = + in_make_frame( arg_count, previous, args ); + pointer_to_pso4( new_pointer )->payload.stack_frame.env = inc_ref( env ); - va_end(args); + va_end( args ); return new_pointer; } @@ -270,8 +278,8 @@ struct pso_pointer make_frame_with_arglist_and_env( struct pso_pointer struct pso_pointer arg_length = count( push_local( previous, make_frame( 1, previous, argvalues ) ) ); int arg_count = - integerp( arg_length ) ? pointer_to_object( arg_length )-> - payload.integer.value : 0; + integerp( arg_length ) ? pointer_to_object( arg_length )->payload. + integer.value : 0; #ifdef DEBUG debug_printf( DEBUG_ALLOC, 0, L"\nAllocating stack frame with %d arguments at page %d, " @@ -330,8 +338,8 @@ struct pso_pointer make_frame_with_arglist( struct pso_pointer previous, struct pso_pointer argvalues ) { return make_frame_with_arglist_and_env( previous, argvalues, pointer_to_pso4 - ( previous )->payload.stack_frame. - env ); + ( previous )->payload. + stack_frame.env ); } diff --git a/src/c/payloads/stack.h b/src/c/payloads/stack.h index 7c20409..40e9f54 100644 --- a/src/c/payloads/stack.h +++ b/src/c/payloads/stack.h @@ -54,6 +54,7 @@ struct pso_pointer make_frame_with_arglist( struct pso_pointer previous, struct pso_pointer destroy_stack_frame( struct pso_pointer fp, struct pso_pointer env ); -struct pso_pointer add_arg( struct pso_pointer frame_pointer, struct pso_pointer arg_pointer); +struct pso_pointer add_arg( struct pso_pointer frame_pointer, + struct pso_pointer arg_pointer ); #endif diff --git a/src/c/payloads/stack_payload.h b/src/c/payloads/stack_payload.h index 95a9c2a..117a86a 100644 --- a/src/c/payloads/stack_payload.h +++ b/src/c/payloads/stack_payload.h @@ -42,4 +42,4 @@ struct stack_frame_payload { uint32_t depth; }; -#endif \ No newline at end of file +#endif diff --git a/src/c/payloads/symbol.c b/src/c/payloads/symbol.c index 4030831..2594011 100644 --- a/src/c/payloads/symbol.c +++ b/src/c/payloads/symbol.c @@ -24,6 +24,6 @@ * @param tail the symbol which is being built. */ struct pso_pointer make_symbol( struct pso_pointer frame_pointer, wint_t c, - struct pso_pointer tail ) { - return make_string_like_thing( frame_pointer, c, tail, SYMBOLTAG ); - } + struct pso_pointer tail ) { + return make_string_like_thing( frame_pointer, c, tail, SYMBOLTAG ); +} diff --git a/src/c/payloads/symbol.h b/src/c/payloads/symbol.h index 2b0dd48..35a7375 100644 --- a/src/c/payloads/symbol.h +++ b/src/c/payloads/symbol.h @@ -27,8 +27,8 @@ /* TODO: for now, Symbol shares a payload with String, but this may change. * Strings are of indefinite length, but symbols are really not, and might * fit into any size class. */ - - struct pso_pointer make_symbol( struct pso_pointer frame_pointer, wint_t c, - struct pso_pointer tail ); + +struct pso_pointer make_symbol( struct pso_pointer frame_pointer, wint_t c, + struct pso_pointer tail ); #endif