Source file inclusion implemented: needed for macros.

* match.c (include_s): New symbol variable.
(v_load): Function extended to handle include semantics.
(include): External wrapper function for doing inclusion
via v_load.
(syms_init): include_s initialized.

* match.h (include_s): Declared.
(include): Declared.

* parser.y (check_for_include): New static function.
(clauses_rev): Use check_for_include to replace @(include ..)
directive.

* txr.1: Documented include.

* genvim.txr: Added include symbol.

* txr.vim: Regenerated.

7 files changed, 119 insertions, 24 deletions

diff --git a/ChangeLog b/ChangeLog
index 6be88a89..72c52894 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,26 @@
+2014-10-20  Kaz Kylheku  <kaz@kylheku.com>
+
+	Source file inclusion implemented: needed for macros.
+
+	* match.c (include_s): New symbol variable.
+	(v_load): Function extended to handle include semantics.
+	(include): External wrapper function for doing inclusion
+	via v_load.
+	(syms_init): include_s initialized.
+
+	* match.h (include_s): Declared.
+	(include): Declared.
+
+	* parser.y (check_for_include): New static function.
+	(clauses_rev): Use check_for_include to replace @(include ..)
+	directive.
+
+	* txr.1: Documented include.
+
+	* genvim.txr: Added include symbol.
+
+	* txr.vim: Regenerated.
+
 2014-10-19  Kaz Kylheku  <kaz@kylheku.com>
 
 	* match.c (match_fun): Bugfix: replace incorrect plain return
diff --git a/genvim.txr b/genvim.txr
index ac9dc5d0..e49f8416 100644
--- a/genvim.txr
+++ b/genvim.txr
@@ -37,7 +37,8 @@ static void dir_tables_init(void)
 @(do (set [txr-sym 0..0] '("rep" "end" "and" "or"
                            "catch" "finally"
                            "until" "last"
-                           "if" "else" "elif")))
+                           "if" "else" "elif"
+                           "include")))
 @(do (set [txl-sym 0..0] '("macro-time" "macrolet" "symacrolet")))
 @(set (txr-sym txl-sym) (@(sort (uniq txr-sym)) @(sort (uniq txl-sym))))
 @(output)
diff --git a/match.c b/match.c
index 4e136967..65f3687d 100644
--- a/match.c
+++ b/match.c
@@ -57,7 +57,7 @@ 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, line_s, fuzz_s, load_s;
-val close_s, require_s;
+val include_s, close_s, require_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;
@@ -3703,18 +3703,19 @@ static val v_load(match_files_ctx *c)
 {
   uses_or2;
   spec_bind (specline, first_spec, c->spec);
+  val sym = first(first_spec);
   val args = rest(first_spec);
   val parent = or2(cdr(source_loc(specline)), null_string);
   val target = txeval(specline, first(args), c->bindings);
 
   if (rest(specline))
-    sem_error(specline, lit("unexpected material after load"), nao);
+    sem_error(specline, lit("unexpected material after ~s"), sym, nao);
 
   if (!stringp(target))
-    sem_error(specline, lit("load: path ~s is not a string"), target, nao);
+    sem_error(specline, lit("~s: path ~s is not a string"), sym, target, nao);
 
   if (equal(target, null_string))
-    sem_error(specline, lit("load: null string path given"), nao);
+    sem_error(specline, lit("~s: null string path given"), sym, nao);
 
   {
     val path = if3(abs_path_p(target),
@@ -3731,9 +3732,11 @@ static val v_load(match_files_ctx *c)
     gc_state(gc);
 
     if (parser.errors)
-      sem_error(specline, lit("load: errors encountered in ~s"), path, nao);
+      sem_error(specline, lit("~s: errors encountered in ~s"), sym, path, nao);
 
-    { 
+    if (sym == include_s) {
+      return parser.syntax_tree;
+    } else {
       val spec = parser.syntax_tree;
       val result = match_files(mf_spec(*c, spec));
 
@@ -4029,6 +4032,13 @@ val match_fun(val name, val args, val input, val files)
   debug_leave;
 }
 
+val include(val specline)
+{
+  val spec = cons(specline, nil);
+  match_files_ctx c = mf_all(spec, nil, nil, nil, nil);
+  return v_load(&c);
+}
+
 int extract(val spec, val files, val predefined_bindings)
 {
   cons_bind (bindings, success, match_files(mf_all(spec, files,
@@ -4066,6 +4076,7 @@ static void syms_init(void)
   gather_s = intern(lit("gather"), user_package);
   do_s = intern(lit("do"), user_package);
   load_s = intern(lit("load"), user_package);
+  include_s = intern(lit("include"), user_package);
   close_s = intern(lit("close"), user_package);
   require_s = intern(lit("require"), user_package);
   longest_k = intern(lit("longest"), keyword_package);
diff --git a/match.h b/match.h
index 176edcc7..705290f2 100644
--- a/match.h
+++ b/match.h
@@ -25,9 +25,11 @@
  */
 
 extern val text_s, choose_s, gather_s, do_s, require_s;
-extern val close_s, load_s, mod_s, modlast_s, line_s, counter_k, env_k;
+extern val close_s, load_s, include_s, mod_s, modlast_s, line_s;
+extern val counter_k, env_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);
+val include(val specline);
 int extract(val spec, val filenames, val bindings);
 void match_init(void);
diff --git a/parser.y b/parser.y
index e8e6069e..7f9ee3d4 100644
--- a/parser.y
+++ b/parser.y
@@ -57,6 +57,7 @@ static val expand_meta(val form, val menv);
 static val rlrec(parser_t *, val form, val line);
 static wchar_t char_from_name(const wchar_t *name);
 static val make_expr(parser_t *, val sym, val rest, val lineno);
+static val check_for_include(val spec_rev);
 
 #if YYBISON
 union YYSTYPE;
@@ -146,8 +147,8 @@ spec : clauses                  { parser->syntax_tree = $1; }
 
 clauses : clauses_rev           { $$ = nreverse($1); }
 
-clauses_rev : clause                    { $$ = cons($1, nil); }
-            | clauses_rev clause        { $$ = cons($2, $1);  }
+clauses_rev : clause                    { $$ = check_for_include(cons($1, nil)); }
+            | clauses_rev clause        { $$ = check_for_include(cons($2, $1));  }
             ;
 
 clauses_opt : clauses_rev       { $$ = nreverse($1); }
@@ -1305,6 +1306,20 @@ static val make_expr(parser_t *parser, val sym, val rest, val lineno)
   return ret;
 }
 
+static val check_for_include(val spec_rev)
+{
+  val line = first(spec_rev);
+
+  if (consp(line)) {
+    val elem = first(line);
+    if (consp(elem)) {
+      if (car(elem) == include_s)
+        return nappend2(nreverse(include(line)), rest(spec_rev));
+    }
+  }
+  return spec_rev;
+}
+
 #ifndef YYEOF
 #define YYEOF 0
 #endif
diff --git a/txr.1 b/txr.1
index 006d3b0a..066b30a7 100644
--- a/txr.1
+++ b/txr.1
@@ -2858,8 +2858,9 @@ as a filter. See Function Filters below.
 The filter directive passes one or more variables through a given
 filter or chain or filters, updating them with the filtered values.
 
-.coIP @(load)
-The load directive loads another \*(TX file and interprets its contents.
+.coSS @ @(load) and @ @(include)
+These directives allow \*(TX programs to be modularized. They bring in
+code from a file, in two different ways.
 
 .coIP @(do)
 The do directive is used to evaluate \*(TL expressions, discarding their
@@ -6662,14 +6663,17 @@ call goes to the toplevel definition.
 
 .SH* MODULARIZATION
 
-.dir load
+.dirs load include
 
 The syntax of the
 .code load
-directive is:
+and
+.code include
+directives is:
 
 .cblk
 .mets @(load << expr )
+.mets @(include << expr )
 .cble
 
 Where
@@ -6689,13 +6693,38 @@ attempt is made. Thus load expressions need not refer to the suffix.
 In the future, additional suffixes may be searched (compiled versions
 of a file).
 
-Loading is performed at evaluation time; it is not a source file inclusion
-mechanism.  A \*(TX script is read from beginning to end and parsed prior to
-being evaluated.
+The two directives differ as follows. The action of
+.code load
+is not performed immediately but at evaluation time. Evaluation time
+occurs after a \*(TX program is read from beginning to end and parsed.
+The action of
+.code include
+is performed immediately, as the code is being scanned and parsed.
+That is to say, as the \*(TX parser encounters
+.code @(include)
+it processes it immediately. The included material is read and parsed, and its
+syntax tree is substituted in place of the
+.code include
+directive. The parser then
+continues processing the original file after the
+.code include
+directive.
+
+Note: the
+.code include
+directive is useful for loading \*(TX files which contain Lisp macros
+which are needed by the parent program. The parent program cannot use
+.code load
+to bring in macros because macros are required during expansion, which
+takes place prior to evaluation time, whereas
+.code load
+doesn't execute until evaluation time.
 
 See also: the
 .code *self-path*
-variable in \*(TL.
+and
+.code stdlib
+variables in \*(TL.
 
 .SH* OUTPUT
 
@@ -25213,6 +25242,20 @@ special builds of \*(TX for small systems.
 .desc
 This variable holds the invocation path name of the \*(TX program.
 
+.coNP Special variable @ stdlib
+The
+.code stdlib
+variable expands to the directory where the \*(TX standard library
+is installed. It can be referenced in
+.code @(load)
+and
+.code @(include)
+directives via quasiliteral substitution, as in, for example:
+
+.cblk
+  @(include `@stdlib/extract`)
+.cble
+
 .SS* Debugger
 \*(TX has a simple, crude, built-in debugger. The debugger is invoked by adding
 the
diff --git a/txr.vim b/txr.vim
index d330d812..e25a12b1 100644
--- a/txr.vim
+++ b/txr.vim
@@ -27,12 +27,12 @@ syn keyword txr_keyword contained define do elif else
 syn keyword txr_keyword contained end eof eol fail
 syn keyword txr_keyword contained filter finally flatten forget
 syn keyword txr_keyword contained freeform fuzz gather if
-syn keyword txr_keyword contained last line load local
-syn keyword txr_keyword contained maybe merge next none
-syn keyword txr_keyword contained or output rebind rep
-syn keyword txr_keyword contained repeat require set skip
-syn keyword txr_keyword contained some text throw trailer
-syn keyword txr_keyword contained try until var
+syn keyword txr_keyword contained include last line load
+syn keyword txr_keyword contained local maybe merge next
+syn keyword txr_keyword contained none or output rebind
+syn keyword txr_keyword contained rep repeat require set
+syn keyword txr_keyword contained skip some text throw
+syn keyword txr_keyword contained trailer try until var
 
 syn keyword txl_keyword contained * *args* *e* *flo-dig*
 syn keyword txl_keyword contained *flo-epsilon* *flo-max* *flo-min* *full-args*