First cut at @(load) directive. Incomplete: debug location info

needs to record file name, not only line number; absolute paths
not handled, etc.

* match.c (load_s): New symbol variable.
(v_load): New static function.
(syms_init): load_s initialized.
(dir_tables_init): Load directive registered.

* match.h (load_s): Declared.

* parser.h (parse_reset): New function declared.

* parser.l (spec_file_str): Global variable moved from txr.c.
(parse_reset): New function.

* parser.y (clause): Special handling for @(load ...) directive.
parent file path inserted into the syntax at parse time,
so when the load directive executes, it can load the file from
the same directory as the parent file.

* txr.c (spec_file_str): Global variable moved to parser.l.

7 files changed, 79 insertions, 4 deletions

diff --git a/ChangeLog b/ChangeLog
index 41a1237e..1404dfbd 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,28 @@
+2012-02-24  Kaz Kylheku  <kaz@kylheku.com>
+
+	First cut at @(load) directive. Incomplete: debug location info
+	needs to record file name, not only line number; absolute paths
+	not handled, etc.
+
+	* match.c (load_s): New symbol variable.
+	(v_load): New static function.
+	(syms_init): load_s initialized.
+	(dir_tables_init): Load directive registered.
+
+	* match.h (load_s): Declared.
+
+	* parser.h (parse_reset): New function declared.
+
+	* parser.l (spec_file_str): Global variable moved from txr.c.
+	(parse_reset): New function.
+
+	* parser.y (clause): Special handling for @(load ...) directive.
+	parent file path inserted into the syntax at parse time,
+	so when the load directive executes, it can load the file from
+	the same directory as the parent file.
+
+	* txr.c (spec_file_str): Global variable moved to parser.l.
+
 2012-02-22  Kaz Kylheku  <kaz@kylheku.com>
 
 	* tests/010/seq.txr: New file.
diff --git a/match.c b/match.c
index 9028cd81..cf674eaf 100644
--- a/match.c
+++ b/match.c
@@ -54,7 +54,7 @@ int opt_arraydims = 1;
 val decline_k, next_spec_k, repeat_spec_k;
 val mingap_k, maxgap_k, gap_k, mintimes_k, maxtimes_k, times_k;
 val lines_k, chars_k;
-val text_s, choose_s, gather_s, do_s, mod_s, modlast_s, fuzz_s;
+val text_s, choose_s, gather_s, do_s, mod_s, modlast_s, fuzz_s, load_s;
 val longest_k, shortest_k, greedy_k;
 val vars_k, resolve_k;
 val append_k, into_k, var_k, list_k, string_k, env_k, counter_k;
@@ -3373,6 +3373,31 @@ static val v_do(match_files_ctx *c)
   return next_spec_k;
 }
 
+static val v_load(match_files_ctx *c)
+{
+  spec_bind (specline, first_spec, c->spec);
+  val args = rest(first_spec);
+  val parent = first(args);
+  val target = txeval(specline, second(args), c->bindings);
+
+  if (rest(specline))
+    sem_error(specline, lit("unexpected material after load"), nao);
+
+  {
+    val path = cat_str(nappend2(sub_list(split_str(parent, lit("/")),
+                                         zero, negone),
+                                cons(target, nil)), lit("/"));
+    int gc = gc_state(0);
+    parse_reset(path);
+    yyparse();
+    gc_state(gc);
+    { 
+      val spec = get_spec();
+      return match_files(mf_spec(*c, spec));
+    }
+  }
+}
+
 static val h_do(match_line_ctx *c)
 {
   val elem = first(c->specline);
@@ -3588,6 +3613,7 @@ static void syms_init(void)
   choose_s = intern(lit("choose"), user_package);
   gather_s = intern(lit("gather"), user_package);
   do_s = intern(lit("do"), user_package);
+  load_s = intern(lit("load"), user_package);
   longest_k = intern(lit("longest"), keyword_package);
   shortest_k = intern(lit("shortest"), keyword_package);
   greedy_k = intern(lit("greedy"), keyword_package);
@@ -3648,6 +3674,7 @@ static void dir_tables_init(void)
   sethash(v_directive_table, filter_s, cptr((mem_t *) v_filter));
   sethash(v_directive_table, eof_s, cptr((mem_t *) v_eof));
   sethash(v_directive_table, do_s, cptr((mem_t *) v_do));
+  sethash(v_directive_table, load_s, cptr((mem_t *) v_load));
 
   sethash(h_directive_table, text_s, cptr((mem_t *) h_text));
   sethash(h_directive_table, var_s, cptr((mem_t *) h_var));
diff --git a/match.h b/match.h
index 719fc13b..fe7c4d93 100644
--- a/match.h
+++ b/match.h
@@ -24,7 +24,8 @@
  * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  */
 
-extern val text_s, choose_s, gather_s, do_s, mod_s, modlast_s, counter_k;
+extern val text_s, choose_s, gather_s, do_s;
+extern val load_s, mod_s, modlast_s, counter_k;
 val format_field(val string_or_list, val modifier, val filter, val eval_fun);
 val match_filter(val name, val arg, val other_args);
 val match_fun(val name, val args, val input, val files);
diff --git a/parser.h b/parser.h
index 81e43c31..519da719 100644
--- a/parser.h
+++ b/parser.h
@@ -39,6 +39,7 @@ void end_of_regex(void);
 void end_of_char(void);
 int yylex(void);
 void parse_init(void);
+void parse_reset(val spec_file);
 val source_loc(val form);
 val rl(val form, val lineno);
 INLINE val rlcp(val to, val from)
diff --git a/parser.l b/parser.l
index d2745c99..4925b113 100644
--- a/parser.l
+++ b/parser.l
@@ -66,6 +66,7 @@ cnum lineno = 1;
 int opt_loglevel = 1;   /* 0 - quiet; 1 - normal; 2 - verbose */
 
 int errors;
+val spec_file_str;
 
 val form_to_ln_hash;
 
@@ -693,3 +694,16 @@ void parse_init(void)
 
   form_to_ln_hash = make_hash(t, nil, nil);
 }
+
+void parse_reset(val spec_file)
+{
+  errors = 0;
+  lineno = 1;
+  spec_file_str = spec_file;
+  {
+    FILE *in = w_fopen(c_str(spec_file_str), L"r");
+    if (in == 0)
+      uw_throwf(file_error_s, lit("unable to open ~a"), spec_file_str, nao);
+    yyin_stream = make_stdio_stream(in, spec_file_str, t, nil);
+  }
+}
diff --git a/parser.y b/parser.y
index ebcf63b3..bf58d9ff 100644
--- a/parser.y
+++ b/parser.y
@@ -141,7 +141,15 @@ clause : all_clause             { $$ = list($1, nao); rlcp($$, $1); }
                                   rlcp($$, $1); }
        | try_clause             { $$ = list($1, nao); rlcp($$, $1); }
        | output_clause          { $$ = list($1, nao); rlcp($$, $1); }
-       | line                   { $$ = $1; }
+       | line                   { val elem = car($1);
+                            
+                                  if (consp(elem) && car(elem) == load_s)
+                                  { elem = rlcp(cons(load_s,
+                                                     cons(spec_file_str, 
+                                                          cdr(elem))), elem);
+                                    $$ = rlcp(cons(elem, cdr($1)), $1); }
+                                  else
+                                  { $$ = $1; } }
        | repeat_clause          { $$ = nil;
                                   yyerror("repeat outside of output"); }
        ;
diff --git a/txr.c b/txr.c
index 084d20a3..2c7080f6 100644
--- a/txr.c
+++ b/txr.c
@@ -46,7 +46,6 @@
 const wchli_t *version = wli("57");
 const wchar_t *progname = L"txr";
 const wchar_t *spec_file = L"stdin";
-val spec_file_str;
 
 /*
  * Can implement an emergency allocator here from a fixed storage