From 1572c93478c55ff14738a4b6f1b38dc41878a816 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Tue, 2 Sep 2014 19:46:18 -0700 Subject: * eval.c (eval_init): Update registration of lisp-parse and read to account for new parameter. * lib.c (syntax_error_s): New symbol_variable. (obj_init): New symbol variable initialized. * lib.h (syntax_error_s): Declared. * parser.h (lisp_parse): Declaration updated. * parser.l (lisp_parse): Takes third parameter. * txr.1: Third parameter of read described. * txr.c (txr_main): Pass colon_k to third parameter of lisp_parse to obtain exception throwing behavior. * unwind.c (uw_init): Register syntax-error as subtype of error. --- ChangeLog | 21 +++++++++++++++++++++ eval.c | 4 ++-- lib.c | 3 ++- lib.h | 2 +- parser.h | 2 +- parser.l | 10 ++++++++-- txr.1 | 9 +++++---- txr.c | 5 +++-- unwind.c | 1 + 9 files changed, 44 insertions(+), 13 deletions(-) diff --git a/ChangeLog b/ChangeLog index a8dad0df..c572feaf 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,24 @@ +2014-09-02 Kaz Kylheku + + * eval.c (eval_init): Update registration of lisp-parse and read + to account for new parameter. + + * lib.c (syntax_error_s): New symbol_variable. + (obj_init): New symbol variable initialized. + + * lib.h (syntax_error_s): Declared. + + * parser.h (lisp_parse): Declaration updated. + + * parser.l (lisp_parse): Takes third parameter. + + * txr.1: Third parameter of read described. + + * txr.c (txr_main): Pass colon_k to third parameter of lisp_parse + to obtain exception throwing behavior. + + * unwind.c (uw_init): Register syntax-error as subtype of error. + 2014-09-02 Kaz Kylheku * arith.c (arith_init): Register some variables: *flo-dig*, diff --git a/eval.c b/eval.c index 56eb844e..a3272d6a 100644 --- a/eval.c +++ b/eval.c @@ -3787,8 +3787,8 @@ void eval_init(void) func_n4o(hash_update_1, 3)); reg_fun(intern(lit("eval"), user_package), func_n2o(eval_intrinsic, 1)); - reg_fun(intern(lit("lisp-parse"), user_package), func_n2o(lisp_parse, 0)); - reg_fun(intern(lit("read"), user_package), func_n2o(lisp_parse, 0)); + reg_fun(intern(lit("lisp-parse"), user_package), func_n3o(lisp_parse, 0)); + reg_fun(intern(lit("read"), user_package), func_n3o(lisp_parse, 0)); reg_fun(intern(lit("expand"), system_package), func_n2o(expand, 1)); reg_fun(intern(lit("macro-form-p"), user_package), func_n2o(macro_form_p, 1)); reg_fun(intern(lit("macroexpand-1"), user_package), diff --git a/lib.c b/lib.c index 7bfccdaa..7baa35d2 100644 --- a/lib.c +++ b/lib.c @@ -87,7 +87,7 @@ val try_s, catch_s, finally_s, throw_s, defex_s, deffilter_s; val eof_s, eol_s, assert_s; val error_s, type_error_s, internal_error_s; val numeric_error_s, range_error_s; -val query_error_s, file_error_s, process_error_s; +val query_error_s, file_error_s, process_error_s, syntax_error_s; val gensym_counter_s; val nothrow_k, args_k, colon_k, auto_k; @@ -6047,6 +6047,7 @@ static void obj_init(void) query_error_s = intern(lit("query_error"), user_package); file_error_s = intern(lit("file_error"), user_package); process_error_s = intern(lit("process_error"), user_package); + syntax_error_s = intern(lit("syntax-error"), user_package); assert_s = intern(lit("assert"), user_package); args_k = intern(lit("args"), keyword_package); diff --git a/lib.h b/lib.h index 63d3fbd5..8ec7ddb9 100644 --- a/lib.h +++ b/lib.h @@ -367,7 +367,7 @@ extern val try_s, catch_s, finally_s, throw_s, defex_s, deffilter_s; extern val eof_s, eol_s, assert_s; extern val error_s, type_error_s, internal_error_s; extern val numeric_error_s, range_error_s; -extern val query_error_s, file_error_s, process_error_s; +extern val query_error_s, file_error_s, process_error_s, syntax_error_s; extern val gensym_counter_s; #define gensym_counter (deref(lookup_var_l(nil, gensym_counter_s))) diff --git a/parser.h b/parser.h index 11801e5e..305b8d7b 100644 --- a/parser.h +++ b/parser.h @@ -59,4 +59,4 @@ INLINE val rlcp(val to, val from) } val rlcp_tree(val to, val from); val regex_parse(val string, val error_stream); -val lisp_parse(val source, val error_stream); +val lisp_parse(val source, val error_stream, val error_return_val); diff --git a/parser.l b/parser.l index 0a19110a..66ccb4bd 100644 --- a/parser.l +++ b/parser.l @@ -989,7 +989,7 @@ val regex_parse(val string, val error_stream) return parser.errors ? nil : parser.syntax_tree; } -val lisp_parse(val source_in, val error_stream) +val lisp_parse(val source_in, val error_stream, val error_return_val) { uses_or2; val source = default_bool_arg(source_in); @@ -1013,5 +1013,11 @@ val lisp_parse(val source_in, val error_stream) gc_state(gc); } std_error = save_stream; - return parser.errors ? nil : parser.syntax_tree; + + if (parser.errors) { + if (missingp(error_return_val)) + uw_throwf(syntax_error_s, lit("read: syntax error"), nao); + return error_return_val; + } + return parser.syntax_tree; } diff --git a/txr.1 b/txr.1 index 23de5cbc..736dc5d8 100644 --- a/txr.1 +++ b/txr.1 @@ -13572,8 +13572,7 @@ Examples of strings which are not absolute paths. .TP Syntax: - (read [ [] ]) - (lisp-parse []) ;; obsolescent synonym for read + (read [ [ []]]) .TP Description: @@ -13591,8 +13590,10 @@ to convert it to a string stream. The optional argument can be used to specify a stream to which parse errors diagnostics are sent. If absent, the diagnostics are suppressed. -If there are parse errors, the function returns nil; otherwise, it returns the -parsed data structure. +If there are no parse errors, the function returns the parsed data +structure. If there are parse errors, and the parameter is +present, its value is returned. If the parameter +is not present, then an exception of type syntax-error is thrown. .SH FILESYSTEM ACCESS diff --git a/txr.c b/txr.c index d637ddbb..9963fd30 100644 --- a/txr.c +++ b/txr.c @@ -404,11 +404,12 @@ int txr_main(int argc, char **argv) spec_file = arg; break; case 'e': - eval_intrinsic(lisp_parse(arg, std_error), make_env(bindings, nil, nil)); + eval_intrinsic(lisp_parse(arg, std_error, colon_k), + make_env(bindings, nil, nil)); evaled = t; break; case 'p': - obj_print(eval_intrinsic(lisp_parse(arg, std_error), + obj_print(eval_intrinsic(lisp_parse(arg, std_error, colon_k), make_env(bindings, nil, nil)), std_output); put_char(chr('\n'), std_output); evaled = t; diff --git a/unwind.c b/unwind.c index 99c71ea3..2c3b5a63 100644 --- a/unwind.c +++ b/unwind.c @@ -438,4 +438,5 @@ void uw_init(void) uw_register_subtype(file_error_s, error_s); uw_register_subtype(process_error_s, error_s); uw_register_subtype(assert_s, error_s); + uw_register_subtype(syntax_error_s, error_s); } -- cgit v1.2.3