* eval.c (eval_init): Registered regex_parse as new

intrinsic function and std_null as new variable.

* parser.h (yylex_destroy): Existing function declared.

* parser.l (regex_parse): New function.
New lexical syntax added which returns SECRET_ESCAPE_R.

* parser.y (SECRET_ESCAPE_R): New token.
(spec): Added syntactic variant which lets us
smuggle a regex into the parser easily.

* stream.c:x (std_null): New global variable.
(null_stream_print): New static function.
(null_ops): New static structure.
(make_null_stream): New function.
(stream_init): Protect and initialize std_null.

* stream.h (std_null, make_null_stream): Declared.

* txr.1: New features documented: regex-parse, *stdnull*.

* txr.c (txr_main): Call yylex_destroy after parsing the program now
that I know about this function; this can free up some memory.

9 files changed, 128 insertions, 4 deletions

diff --git a/ChangeLog b/ChangeLog
index abf7667c..2b240a42 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,30 @@
+2013-12-05  Kaz Kylheku  <kaz@kylheku.com>
+
+	* eval.c (eval_init): Registered regex_parse as new
+	intrinsic function and std_null as new variable.
+
+	* parser.h (yylex_destroy): Existing function declared.
+
+	* parser.l (regex_parse): New function.
+	New lexical syntax added which returns SECRET_ESCAPE_R.
+
+	* parser.y (SECRET_ESCAPE_R): New token.
+	(spec): Added syntactic variant which lets us
+	smuggle a regex into the parser easily.
+
+	* stream.c:x (std_null): New global variable.
+	(null_stream_print): New static function.
+	(null_ops): New static structure.
+	(make_null_stream): New function.
+	(stream_init): Protect and initialize std_null.
+
+	* stream.h (std_null, make_null_stream): Declared.
+
+	* txr.1: New features documented: regex-parse, *stdnull*.
+
+	* txr.c (txr_main): Call yylex_destroy after parsing the program now
+	that I know about this function; this can free up some memory.
+
 2013-12-02  Kaz Kylheku  <kaz@kylheku.com>
 
 	* stream.c (stdio_set_prop): Fix reversed boolean.
diff --git a/eval.c b/eval.c
index f40e6b89..ea3020d2 100644
--- a/eval.c
+++ b/eval.c
@@ -2312,6 +2312,7 @@ void eval_init(void)
   reg_fun(intern(lit("search-regex"), user_package), func_n4o(search_regex, 2));
   reg_fun(intern(lit("match-regex"), user_package), func_n3o(match_regex, 2));
   reg_fun(intern(lit("regsub"), user_package), func_n3(regsub));
+  reg_fun(intern(lit("regex-parse"), user_package), func_n2o(regex_parse, 1));
 
   reg_fun(intern(lit("make-hash"), user_package), func_n3(make_hash));
   reg_fun(intern(lit("make-similar-hash"), user_package), func_n1(make_similar_hash));
@@ -2351,6 +2352,7 @@ void eval_init(void)
   reg_var(intern(lit("*stddebug*"), user_package), &std_debug);
   reg_var(intern(lit("*stdin*"), user_package), &std_input);
   reg_var(intern(lit("*stderr*"), user_package), &std_error);
+  reg_var(intern(lit("*stdnull*"), user_package), &std_null);
   reg_fun(intern(lit("format"), user_package), func_n2v(formatv));
   reg_fun(intern(lit("print"), user_package), func_n2o(obj_print, 1));
   reg_fun(intern(lit("pprint"), user_package), func_n2o(obj_pprint, 1));
diff --git a/parser.h b/parser.h
index 82ca1f0f..5c953896 100644
--- a/parser.h
+++ b/parser.h
@@ -38,6 +38,7 @@ void yybadtoken(int tok, val context);
 void end_of_regex(void);
 void end_of_char(void);
 int yylex(void);
+int yylex_destroy(void);
 void parse_init(void);
 void parse_reset(val spec_file);
 val source_loc(val form);
@@ -48,3 +49,4 @@ INLINE val rlcp(val to, val from)
 {
   return rlset(to, source_loc(from));
 }
+val regex_parse(val string, val error_stream);
diff --git a/parser.l b/parser.l
index c629e481..18b4af3b 100644
--- a/parser.l
+++ b/parser.l
@@ -675,6 +675,11 @@ UONLY   {U2}{U}|{U3}{U}{U}|{U4}{U}{U}{U}
   yy_push_state(SPECIAL);
 }
 
+<INITIAL>@\x01R {
+  yy_push_state(REGEX);
+  return SECRET_ESCAPE_R;
+}
+
 <INITIAL>^@[#;].*\n {
   /* eat whole line comment */
   lineno++;
@@ -823,3 +828,23 @@ void parse_reset(val spec_file)
     yyin_stream = make_stdio_stream(in, spec_file_str);
   }
 }
+
+val regex_parse(val string, val error_stream)
+{
+  uses_or2;
+  val parse_string = cat_str(list(lit("@\x01R/"), string, lit("/"), nao), nil);
+  yyin_stream = make_string_byte_input_stream(parse_string);
+  errors = 0;
+  lineno = 1;
+  val save_stream = std_error;
+  std_error = if3(error_stream == t, std_output, or2(error_stream, std_null));
+  {
+    int gc = gc_state(0);
+    spec_file_str = string;
+    yyparse();
+    yylex_destroy();
+    gc_state(gc);
+  }
+  std_error = save_stream;
+  return errors ? nil : rest(get_spec());
+}
diff --git a/parser.y b/parser.y
index c71ddce7..321b32e0 100644
--- a/parser.y
+++ b/parser.y
@@ -73,6 +73,7 @@ static val parsed_spec;
 %token <lineno> MOD MODLAST DEFINE TRY CATCH FINALLY
 %token <lineno> ERRTOK /* deliberately not used in grammar */
 %token <lineno> HASH_BACKSLASH HASH_SLASH DOTDOT HASH_H
+%token <lineno> SECRET_ESCAPE_R
 
 %token <val> NUMBER METANUM
 
@@ -113,6 +114,7 @@ static val parsed_spec;
 
 spec : clauses                  { parsed_spec = $1; }
      | /* empty */              { parsed_spec = nil; }
+     | SECRET_ESCAPE_R regex    { parsed_spec = $2; }
      | error '\n'               { parsed_spec = nil;
                                   if (errors >= 8)
                                     YYABORT;
diff --git a/stream.c b/stream.c
index 549ad244..78c2598e 100644
--- a/stream.c
+++ b/stream.c
@@ -51,7 +51,7 @@
 #include "stream.h"
 #include "utf8.h"
 
-val std_input, std_output, std_debug, std_error;
+val std_input, std_output, std_debug, std_error, std_null;
 val output_produced;
 
 val dev_k, ino_k, mode_k, nlink_k, uid_k;
@@ -91,6 +91,35 @@ static void common_destroy(val obj)
   (void) close_stream(obj, nil);
 }
 
+static void null_stream_print(val stream, val out)
+{
+  format(out, lit("#<~s null>"), stream->co.cls, nao);
+}
+
+static struct strm_ops null_ops = {
+  { cobj_equal_op,
+    null_stream_print,
+    cobj_destroy_stub_op,
+    cobj_mark_op,
+    cobj_hash_op },
+  0, /* put_string */
+  0, /*_put_char */
+  0, /* put_byte, */
+  0, /* get_line, */
+  0, /* get_char, */
+  0, /* get_byte, */
+  0, /* close, */
+  0, /* flush, */
+  0, /* seek, */
+  0, /* get_prop, */
+  0, /* set_prop */
+};
+
+val make_null_stream(void)
+{
+  return cobj((mem_t *) 0, stream_s, &null_ops.cobj_ops);
+}
+
 struct stdio_handle {
   FILE *f;
   val descr;
@@ -1951,11 +1980,12 @@ val open_process(val name, val mode_str, val args)
 
 void stream_init(void)
 {
-  protect(&std_input, &std_output, &std_debug, &std_error, (val *) 0);
+  protect(&std_input, &std_output, &std_debug, &std_error, &std_null, (val *) 0);
   std_input = make_stdio_stream(stdin, string(L"stdin"));
   std_output = make_stdio_stream(stdout, string(L"stdout"));
   std_debug = make_stdio_stream(stdout, string(L"debug"));
   std_error = make_stdio_stream(stderr, string(L"stderr"));
+  std_null = make_null_stream();
   detect_format_string();
 
   dev_k = intern(lit("dev"), keyword_package);
diff --git a/stream.h b/stream.h
index 6bf7c5e6..604a5e78 100644
--- a/stream.h
+++ b/stream.h
@@ -24,7 +24,7 @@
  * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  */
 
-extern val std_input, std_output, std_debug, std_error;
+extern val std_input, std_output, std_debug, std_error, std_null;
 extern val output_produced;
 
 extern val dev_k, ino_k, mode_k, nlink_k, uid_k;
@@ -38,6 +38,7 @@ extern val s_ifchr, s_ififo, s_isuid, s_isgid, s_isvtx, s_irwxu;
 extern val s_irusr, s_iwusr, s_ixusr, s_irwxg, s_irgrp, s_iwgrp;
 extern val s_ixgrp, s_irwxo, s_iroth, s_iwoth, s_ixoth;
 
+val make_null_stream(void);
 val make_stdio_stream(FILE *, val descr);
 val make_tail_stream(FILE *, val descr);
 val make_pipe_stream(FILE *, val descr);
diff --git a/txr.1 b/txr.1
index c38de95c..2906a0ab 100644
--- a/txr.1
+++ b/txr.1
@@ -9357,6 +9357,8 @@ The regex compile function takes the source code of a regular expression,
 expressed as a Lisp data structure, and compiles it to a regular expression
 object.
 
+Suitable source code is produced by regex-parse.
+
 .TP
 Examples:
 
@@ -9370,6 +9372,34 @@ Examples:
   ;; #/a|b|c/
   (regex-compile '(or (or #\ea #\eb) #\ec))
 
+.SS Function regex-parse
+
+.TP
+Syntax:
+
+  (regex-parse <string> : <stream>)
+
+.TP
+Description:
+
+The regex string parses a character string which contains a regular expression
+(without any surrounding / characters) and turns it into a Lisp data structure
+(the abstract syntax tree representation of the regular expression).
+
+The regular expression syntax #/RE/ produces the same structure, but as a
+literal which is processed at the time TXR source code is read; the regex-parse
+function performs this parsing at run-time.
+
+If there are parse errors, the function returns nil.
+
+The optional <stream> argument specifies a stream to which error messages
+are sent from the parser. By default, diagnostic output goes to the *stdnull*
+stream, which discards it. If <stream> is specified as t, then the diagnostic
+output goes to the *stdout* stream.
+
+If regex-parse returns a non-nil value, that structure is then something
+which is suitable as input to regex-compile.
+
 .SH HASHING LIBRARY
 
 .SS Functions make-hash, hash
@@ -9880,7 +9910,7 @@ In general, I/O errors are usually turned into exceptions. When the description
 of error reporting is omitted from the description of a function, it can be
 assumed that it throws an error.
 
-.SS Variables *stdout*, *stddebug*, *stdin* and *stderr*
+.SS Variables *stdout*, *stddebug*, *stdin*, *stderr* and *stdnull*
 
 These variables hold predefined stream objects. The *stdin*, *stdout* and
 *stderr* streams closely correspond to the underlying operating system streams.
@@ -9890,6 +9920,10 @@ The *stddebug* stream goes to the same destination as *stdout*, but is
 a separate object which can be redirected independently, allowing debugging
 output to be separated from normal output.
 
+The *stdnull* stream is a special kind of stream called a null stream.
+This stream is not connected to any device or file.  It is similar to
+the /dev/null device on Unix, but does not involve the operating system.
+
 .SS Function format
 
 .TP
diff --git a/txr.c b/txr.c
index 5f423b03..5ff5e2e0 100644
--- a/txr.c
+++ b/txr.c
@@ -417,6 +417,7 @@ int txr_main(int argc, char **argv)
   {
     int gc = gc_state(0);
     yyparse();
+    yylex_destroy();
     gc_state(gc);
 
     if (errors)