* 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.

9 files changed, 44 insertions, 13 deletions

diff --git a/ChangeLog b/ChangeLog
index a8dad0df..c572feaf 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,26 @@
 2014-09-02  Kaz Kylheku  <kaz@kylheku.com>
 
+	* 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  <kaz@kylheku.com>
+
 	* arith.c (arith_init): Register some variables: *flo-dig*,
 	*flo-min*, *flo-max*, *flo-epsilon*, *pi* and *e*.
 
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 [ <source> [<error-stream>] ])
-   (lisp-parse <source> [<error-stream>]) ;; obsolescent synonym for read
+   (read [<source> [<error-stream> [<error-return-value>]]])
 
 .TP
 Description:
@@ -13591,8 +13590,10 @@ to convert it to a string stream.
 The optional <error-stream> 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 <error-return-value> parameter is
+present, its value is returned. If the <error-return-value> 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);
 }