Support for parsing Lisp expression out of strings and streams.

New catenated streams make the Yacc hack possible.

* eval.c (eval_init): Register lisp_parse as intrinsic.

* parser.h (lisp_parse): Declared.

* parser.l: New lexical hack to produce SECRET_ESCAPE_E token.
(regex_parse): Move declaration before statements.
(lisp_parse): New function.

* parser.y (SECRET_ESCAPE_E): New token type.
(spec): New production rule for single expression.

* stream.c (cat_stream_print, cat_get_line, cat_get_char,
cat_get_byte, cat_get_prop): New static functions.
(cat_stream_ops): New static function.
(make_catenated_stream): New function.

* stream.h (make_catenated_stream): Declared.

7 files changed, 139 insertions, 2 deletions

diff --git a/ChangeLog b/ChangeLog
index 6b0dcb93..a75d44ba 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,26 @@
+2013-12-14  Kaz Kylheku  <kaz@kylheku.com>
+
+	Support for parsing Lisp expression out of strings and streams.
+	New catenated streams make the Yacc hack possible.
+
+	* eval.c (eval_init): Register lisp_parse as intrinsic.
+
+	* parser.h (lisp_parse): Declared.
+
+	* parser.l: New lexical hack to produce SECRET_ESCAPE_E token.
+	(regex_parse): Move declaration before statements.
+	(lisp_parse): New function.
+
+	* parser.y (SECRET_ESCAPE_E): New token type.
+	(spec): New production rule for single expression.
+
+	* stream.c (cat_stream_print, cat_get_line, cat_get_char,
+	cat_get_byte, cat_get_prop): New static functions.
+	(cat_stream_ops): New static function.
+	(make_catenated_stream): New function.
+
+	* stream.h (make_catenated_stream): Declared.
+
 2013-12-13  Kaz Kylheku  <kaz@kylheku.com>
 
 	New stream property: name. Some streams can report
diff --git a/eval.c b/eval.c
index b6b87657..3c4aa120 100644
--- a/eval.c
+++ b/eval.c
@@ -2384,6 +2384,7 @@ void eval_init(void)
   reg_fun(intern(lit("hash-isec"), user_package), func_n2(hash_isec));
 
   reg_fun(intern(lit("eval"), user_package), func_n2o(eval_intrinsic, 1));
+  reg_fun(intern(lit("lisp-parse"), user_package), func_n2o(lisp_parse, 1));
 
   reg_fun(intern(lit("chain"), user_package), func_n0v(chainv));
   reg_fun(intern(lit("andf"), user_package), func_n0v(andv));
diff --git a/parser.h b/parser.h
index 93061fe4..bf582fcb 100644
--- a/parser.h
+++ b/parser.h
@@ -50,3 +50,4 @@ INLINE val rlcp(val to, val from)
   return rlset(to, source_loc(from));
 }
 val regex_parse(val string, val error_stream);
+val lisp_parse(val source, val error_stream);
diff --git a/parser.l b/parser.l
index bdee6275..78e29408 100644
--- a/parser.l
+++ b/parser.l
@@ -682,6 +682,12 @@ UONLY   {U2}{U}|{U3}{U}{U}|{U4}{U}{U}{U}
   return SECRET_ESCAPE_R;
 }
 
+<INITIAL>@\x01E {
+  yy_push_state(SPECIAL);
+  yy_push_state(NESTED);
+  return SECRET_ESCAPE_E;
+}
+
 <INITIAL>^@[#;].*\n {
   /* eat whole line comment */
   lineno++;
@@ -837,10 +843,10 @@ val regex_parse(val string, val error_stream)
 {
   uses_or2;
   val parse_string = cat_str(list(lit("@\x01R"), string, nao), nil);
+  val save_stream = std_error;
   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);
@@ -854,3 +860,27 @@ val regex_parse(val string, val error_stream)
   std_error = save_stream;
   return errors ? nil : get_spec();
 }
+
+val lisp_parse(val source, val error_stream)
+{
+  uses_or2;
+  val input_stream = if3(stringp(source), make_string_byte_input_stream(source), source);
+  val secret_token_stream = make_string_byte_input_stream(lit("@\x01" "E"));
+  val name = if3(stringp(source),
+                 format(nil, lit("expr: ~s"), source, nao),
+                 stream_get_prop(source, name_k));
+  val save_stream = std_error;
+  yyin_stream = make_catenated_stream(list(secret_token_stream, input_stream, nao));
+  errors = 0;
+  lineno = 1;
+  std_error = if3(error_stream == t, std_output, or2(error_stream, std_null));
+  {
+    int gc = gc_state(0);
+    spec_file_str = if3(std_error != std_null, name, lit(""));
+    yyparse();
+    yylex_destroy();
+    gc_state(gc);
+  }
+  std_error = save_stream;
+  return errors ? nil : get_spec();
+}
diff --git a/parser.y b/parser.y
index c82ede7c..8ff5f3cb 100644
--- a/parser.y
+++ b/parser.y
@@ -75,7 +75,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 <lineno> SECRET_ESCAPE_R SECRET_ESCAPE_E
 
 %token <val> NUMBER METANUM
 
@@ -117,6 +117,7 @@ static val parsed_spec;
 spec : clauses                  { parsed_spec = $1; }
      | /* empty */              { parsed_spec = nil; }
      | SECRET_ESCAPE_R regexpr  { parsed_spec = $2; end_of_regex(); }
+     | SECRET_ESCAPE_E expr     { parsed_spec = $2; }
      | error '\n'               { parsed_spec = nil;
                                   if (errors >= 8)
                                     YYABORT;
diff --git a/stream.c b/stream.c
index 67765e8a..c20b3ca5 100644
--- a/stream.c
+++ b/stream.c
@@ -2030,6 +2030,86 @@ val open_process(val name, val mode_str, val args)
 }
 #endif
 
+static void cat_stream_print(val stream, val out)
+{
+  val streams = (val) stream->co.handle;
+  format(out, lit("#<~s catenated ~s>"), stream->co.cls, streams, nao);
+}
+
+static val cat_get_line(val stream)
+{
+  val streams = (val) stream->co.handle;
+
+  while (streams) {
+    val line = get_line(first(streams));
+    if (line)
+      return line;
+    stream->co.handle = (mem_t *) (streams = rest(streams));
+  }
+
+  return nil;
+}
+
+static val cat_get_char(val stream)
+{
+  val streams = (val) stream->co.handle;
+
+  while (streams) {
+    val ch = get_char(first(streams));
+    if (ch)
+      return ch;
+    stream->co.handle = (mem_t *) (streams = rest(streams));
+  }
+
+  return nil;
+}
+
+static val cat_get_byte(val stream)
+{
+  val streams = (val) stream->co.handle;
+
+  while (streams) {
+    val byte = get_byte(first(streams));
+    if (byte)
+      return byte;
+    stream->co.handle = (mem_t *) (streams = rest(streams));
+  }
+
+  return nil;
+}
+
+static val cat_get_prop(val stream, val ind)
+{
+  val streams = (val) stream->co.handle;
+  if (streams)
+    return stream_get_prop(first(streams), ind);
+  return nil;
+}
+
+static struct strm_ops cat_stream_ops = {
+  { cobj_equal_op,
+    cat_stream_print,
+    cobj_destroy_stub_op,
+    cobj_mark_op,
+    cobj_hash_op },
+  0, /* put_string */
+  0, /*_put_char */
+  0, /* put_byte, */
+  cat_get_line,
+  cat_get_char,
+  cat_get_byte,
+  0, /* close, */
+  0, /* flush, */
+  0, /* seek, */
+  cat_get_prop,
+  0, /* set_prop */
+};
+
+val make_catenated_stream(val stream_list)
+{
+  return cobj((mem_t *) stream_list, stream_s, &cat_stream_ops.cobj_ops);
+}
+
 void stream_init(void)
 {
   protect(&std_input, &std_output, &std_debug, &std_error, &std_null, (val *) 0);
diff --git a/stream.h b/stream.h
index 36236622..e2ea714d 100644
--- a/stream.h
+++ b/stream.h
@@ -94,5 +94,6 @@ val open_file(val path, val mode_str);
 val open_tail(val path, val mode_str, val seek_end_p);
 val open_command(val path, val mode_str);
 val open_process(val path, val mode_str, val args);
+val make_catenated_stream(val stream_list);
 
 void stream_init(void);