diff options
| -rw-r--r-- | autoload.c | 1 | ||||
| -rw-r--r-- | eval.c | 1 | ||||
| -rw-r--r-- | parser.c | 48 | ||||
| -rw-r--r-- | parser.h | 2 | ||||
| -rw-r--r-- | stdlib/getput.tl | 17 | ||||
| -rw-r--r-- | tests/018/getput.tl | 33 | ||||
| -rw-r--r-- | txr.1 | 75 |
7 files changed, 169 insertions, 8 deletions
@@ -464,6 +464,7 @@ static val getput_set_entries(val fun) val name[] = { lit("get-jsons"), lit("put-jsons"), lit("file-get"), lit("file-put"), lit("file-append"), + lit("file-get-objects"), lit("file-put-objects"), lit("file-append-objects"), lit("file-get-string"), lit("file-put-string"), lit("file-append-string"), lit("file-get-lines"), lit("file-put-lines"), lit("file-append-lines"), lit("file-get-buf"), lit("file-put-buf"), @@ -7436,6 +7436,7 @@ void eval_init(void) reg_fun(intern(lit("lisp-parse"), user_package), func_n5o(nread, 0)); reg_fun(intern(lit("read"), user_package), func_n5o(nread, 0)); reg_fun(intern(lit("iread"), user_package), func_n5o(iread, 0)); + reg_fun(intern(lit("read-objects"), user_package), func_n5o(read_objects, 0)); reg_fun(intern(lit("get-json"), user_package), func_n5o(get_json, 0)); reg_fun(intern(lit("txr-parse"), user_package), func_n4o(txr_parse, 0)); reg_fun(intern(lit("load"), user_package), func_n1v(loadv)); @@ -891,21 +891,31 @@ val read_compiled_file(val self, val stream, val error_stream) return read_file_common(self, stream, error_stream, t); } -val read_objects_from_string(val string, val error_stream, - val error_return_val, val name_in) +static val read_objects_common(val stream, val error_stream_in, + val error_return_val, val name, + val lineno, val self) { - val self = lit("read-objects-from-string"); - val stream = make_string_byte_input_stream(string); - val name = default_arg(name_in, lit("string")); + val error_stream = if3(error_stream_in == t, + std_output, + default_arg_strict(error_stream_in, std_null)); val parser = ensure_parser(stream, name); + parser_t *pi = parser_get_impl(self, parser); list_collect_decl (out, ptail); + if (lineno && !missingp(lineno)) + pi->lineno = c_num(lineno, self); + for (;;) { val form = lisp_parse_impl(self, prime_lisp, t, stream, error_stream, unique_s, name, colon_k); if (form == unique_s) { - if (parser_errors(parser) != zero) + if (pi->syntax_tree == nao) + break; + if (pi->errors) + if (missingp(error_return_val)) + uw_throwf(syntax_error_s, lit("read: ~a: errors encountered"), + name, nao); return error_return_val; break; } @@ -916,6 +926,32 @@ val read_objects_from_string(val string, val error_stream, return out; } +val read_objects_from_string(val string, val error_stream, + val error_return_val, val name_in) +{ + val self = lit("read-objects-from-string"); + val stream = make_string_byte_input_stream(string); + val name = default_arg(name_in, lit("string")); + + return read_objects_common(stream, error_stream, error_return_val, + name, one, self); +} + +val read_objects(val source_in, val error_stream, val error_return_val, + val name_in, val lineno_in) +{ + val self = lit("read-objects"); + val source = default_arg_strict(source_in, std_input); + val str = stringp(source); + val input_stream = if3(str, make_string_byte_input_stream(source), source); + val name = default_arg_strict(name_in, + if3(str, + lit("string"), + stream_get_prop(input_stream, name_k))); + return read_objects_common(input_stream, error_stream, error_return_val, + name, lineno_in, self); +} + val txr_parse(val source_in, val error_stream, val error_return_val, val name_in) { @@ -139,6 +139,8 @@ val read_eval_stream(val self, val stream, val error_stream); val read_compiled_file(val self, val stream, val error_stream); val read_objects_from_string(val string, val error_stream, val error_return_val, val name_in); +val read_objects(val source_in, val error_stream, val error_return_val, + val name_in, val lineno_in); val txr_parse(val source, val error_stream, val error_return_val, val name_in); val repl(val bindings, val in_stream, val out_stream, val env); diff --git a/stdlib/getput.tl b/stdlib/getput.tl index fd62f911..8bc30598 100644 --- a/stdlib/getput.tl +++ b/stdlib/getput.tl @@ -62,6 +62,11 @@ (put-jsonl obj s flat-p)) t) +(defun put-objects (list : (s *stdout*)) + (each ((obj list)) + (prinl obj s) + t)) + (defun file-get (name : mopt) (with-stream (s (open-file name `r@mopt`)) (read s))) @@ -74,6 +79,18 @@ (with-stream (s (open-file name `a@mopt`)) (prinl obj s))) +(defun file-get-objects (name : mopt (err-stream :)) + (with-stream (s (open-file name `r@mopt`)) + (read-objects s err-stream))) + +(defun file-put-objects (name seq : mopt) + (with-stream (s (open-file name `w@mopt`)) + (put-objects seq s))) + +(defun file-append-objects (name seq : mopt) + (with-stream (s (open-file name `a@mopt`)) + (put-objects seq s))) + (defun file-get-string (name : mopt) (with-stream (s (open-file name `r@mopt`)) (get-string s))) diff --git a/tests/018/getput.tl b/tests/018/getput.tl new file mode 100644 index 00000000..7e8e2be1 --- /dev/null +++ b/tests/018/getput.tl @@ -0,0 +1,33 @@ +(load "../common") + +(defvarl file "getput.data") + +(push-after-load (remove-path file)) + +(file-put-objects file '(1 2.3 (a . b) "foo")) + +(test + (file-get-lines file) ("1" "2.3" "(a . b)" "\"foo\"")) + +(file-append-objects file '(#(nil))) + +(mtest + (file-get-lines file) ("1" "2.3" "(a . b)" "\"foo\"" "#(nil)") + (file-get-objects file) (1 2.3 (a . b) "foo" #(nil))) + +(mtest + (read-objects "(a . b) #\\c") ((a . b) #\c) + (read-objects "(a") :error) + +(file-put-string file "(a") + +(mtest + (file-get file) :error + (file-get-objects file) :error) + +(let ((errors (with-out-string-stream (err) + (ignerr (file-get-objects file : err))))) + (mtest + (true (contains "syntax error" errors)) t + (true (contains "unterminated" errors)) t + (true (contains ":1" errors)) t)) @@ -64828,6 +64828,28 @@ it may be useful to set true in order to obtain better diagnostics. However, source location recording incurs a performance and storage penalty. +.coNP Function @ read-objects +.synb +.mets (read-objects >> [ source +.mets \ \ \ \ \ \ \ \ \ \ \ \ \ \ >> [ err-stream +.mets \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ >> [ err-retval >> [ name <> [ lineno ]]]]]) +.syne +.desc +The +.code read-objects +function has the same argument syntax and semantics as the +.code read +function, except that rather than reading one object, it reads all +the Lisp objects from the source, and returns a list of these objects. + +If the stream is empty, then +.code read-objects +returns the empty list +.codn nil , +whereas the +.code read +function treats the situation as an error. + .coNP Function @ parse-errors .synb .mets (parse-errors << stream ) @@ -65760,14 +65782,63 @@ and then close the stream. These functions are close counterparts of, respectively, .codn file-get , -.code file-append-string +.code file-get-string and -.codn file-append-lines . +.codn file-get-lines . These functions behave differently when the indicated file already exists. Rather than being truncated and overwritten, the file is extended by appending the new data to its end. +.coNP Function @ file-get-objects +.synb +.mets (file-get-objects < name < [ mode-opts <> [ error-stream ]]) +.syne +.desc +The +.code file-get-objects +function opens an input text stream over the file indicated by the +.meta name +argument, which is a string. + +All Lisp objects are read from the stream. Parse errors are +reported to +.meta error-stream +which defaults to +.code *stdnull* +(error output is discarded). + +If there is a parse error, the function throws an exception, +otherwise the list of parsed objects is returned. + +.coNP Functions @ file-put-objects and @ file-append-objects +.synb +.mets (file-put-objects < name < seq <> [ mode-opts ]) +.syne +.desc +The functions +.code file-put-objects +and +.code file-append-objects +open a text stream over the file indicated by the string argument +.metn name , +and write each of the objects contained in sequence +.meta seq +into the stream as if using the +.code prinl +function on each individual element of +.metn seq . + +The +.code file-put-objects +function opens the file using the +.str w +mode, which overwrites the file if it exists, whereas +.code file-append-objects +uses +.strn a , +which appends to the file. + .coNP Functions @, command-get @ command-get-string and @ command-get-lines .synb .mets (command-get < cmd <> [ mode-opts ]) |