New macro: load-for.

* eval.c (me_load_for): New function.
(rt_load_for): New static function.
(eval_init): Register load-for macro and sys:rt-load-for
intrinsic function.

* txr.1: Documented.

2 files changed, 184 insertions, 0 deletions

diff --git a/eval.c b/eval.c
index 0a35378b..1ba84688 100644
--- a/eval.c
+++ b/eval.c
@@ -4275,6 +4275,45 @@ static val me_load_time(val form, val menv)
   return list(load_time_lit_s, nil, expr, nao);
 }
 
+static val me_load_for(val form, val menv)
+{
+  val sym = car(form);
+  val args = cdr(form);
+  val rt_load_for_s = intern(lit("rt-load-for"), system_package);
+  list_collect_decl (out, ptail);
+  val iter;
+
+  for (iter = args; iter; iter = cdr(iter)) {
+    val arg = car(iter);
+
+    if (consp(arg)) {
+      val kind = car(arg);
+      if (kind != usr_var_s && kind != fun_s && kind != macro_s
+          && kind != struct_s && kind != pkg_s)
+        eval_error(form, lit("~s: unrecognized clause symbol ~s"),
+                   sym, kind, nao);
+      if (!bindable(cadr(arg)))
+        eval_error(form, lit("~s: first argument in ~s must be bindable symbol"),
+                   sym, arg, nao);
+      if (length(arg) != three)
+        eval_error(form, lit("~s: clause ~s expected to have two arguments"),
+                   sym, arg, nao);
+      ptail = list_collect(ptail, list(list_s,
+                                       list(quote_s, car(arg), nao),
+                                       list(quote_s, cadr(arg), nao),
+                                       caddr(arg),
+                                       nao));
+    } else {
+      eval_error(form, lit("~s: invalid clause ~s"), sym, arg, nao);
+    }
+  }
+
+  if (!out)
+    return nil;
+
+  return cons(rt_load_for_s, out);
+}
+
 val load(val target)
 {
   val self = lit("load");
@@ -4352,6 +4391,43 @@ val load(val target)
   return nil;
 }
 
+static val rt_load_for(struct args *args)
+{
+  val self = lit("sys:rt-load-for");
+  cnum index = 0;
+
+  while (args_more(args, index)) {
+    val clause = args_get(args, &index);
+    val kind = pop(&clause);
+    val sym = pop(&clause);
+    val file = car(clause);
+    val (*testfun)(val);
+
+    if (kind == usr_var_s)
+      testfun = boundp;
+    else if (kind == fun_s)
+      testfun = fboundp;
+    else if (kind == macro_s)
+      testfun = mboundp;
+    else if (kind == struct_s)
+      testfun = find_struct_type;
+    else if (kind == pkg_s)
+      testfun = find_package;
+    else
+      uw_throwf(error_s, lit("~a: unrecognized kind ~s"),
+                self, kind, nao);
+
+    if (!testfun(sym)) {
+      load(file);
+      if (!testfun(sym))
+        uw_throwf(error_s, lit("~a: file ~s didn't define ~a ~s"),
+                  self, file, kind, sym, nao);
+    }
+  }
+
+  return nil;
+}
+
 static val expand_catch_clause(val form, val menv)
 {
   val sym = first(form);
@@ -6258,6 +6334,7 @@ void eval_init(void)
   reg_mac(intern(lit("lcons"), user_package), func_n2(me_lcons));
   reg_mac(intern(lit("mlet"), user_package), func_n2(me_mlet));
   reg_mac(load_time_s, func_n2(me_load_time));
+  reg_mac(intern(lit("load-for"), user_package), func_n2(me_load_for));
 
   reg_fun(cons_s, func_n2(cons));
   reg_fun(intern(lit("make-lazy-cons"), user_package), func_n1(make_lazy_cons));
@@ -6873,6 +6950,7 @@ void eval_init(void)
   reg_fun(intern(lit("rt-defmacro"), system_package), func_n3(rt_defmacro));
   reg_fun(intern(lit("rt-defsymacro"), system_package), func_n2(rt_defsymacro));
   reg_fun(intern(lit("rt-pprof"), system_package), func_n1(rt_pprof));
+  reg_fun(intern(lit("rt-load-for"), system_package), func_n0v(rt_load_for));
 
   eval_error_s = intern(lit("eval-error"), user_package);
   uw_register_subtype(eval_error_s, error_s);
diff --git a/txr.1 b/txr.1
index b2ed2768..4305af6d 100644
--- a/txr.1
+++ b/txr.1
@@ -57077,6 +57077,112 @@ parsing and processing of a loaded \*(TX source file.
 Also, during the processing of the profile file (see Interactive Profile File),
 the variable is bound to the name of that file.
 
+.coNP Macro @ load-for
+.synb
+.mets (load-for >> {( kind < sym << target )}*)
+.syne
+.desc
+The
+.code load-for
+macro takes multiple arguments, each of which is a three-element
+clause. Each clause specifies that a given
+.meta target
+file is to be conditionally loaded based on whether a symbol
+.meta sym
+has a certain kind of binding.
+
+Each argument clause has the syntax
+.cblk
+.meti >> ( kind < sym << target )
+.cble
+where
+.meta kind
+is one of the five symbols
+.codn var ,
+.codn fun ,
+.codn macro ,
+.code struct
+or
+.codn pkg .
+The
+.meta sym
+element is a symbol suitable for use as a variable, function
+or structure name, and
+.meta target
+is an expression which is evaluated to produce a value that is suitable
+as an argument to the
+.code load
+function.
+
+First, all
+.code target
+expressions in all clauses are unconditionally evaluated in left to right
+order. Then the clauses are processed in that order. If the
+.meta kind
+symbol of a clause is
+.codn var ,
+then
+.code load-for
+tests whether
+.meta sym
+has a binding in the variable namespace using the
+.code boundp
+function. If a binding does not exist, then the value of the
+.meta target
+expression is passed to the
+.code load
+function. Otherwise,
+.code load
+is not called.
+Similarly, if
+.meta kind
+is the symbol
+.codn fun ,
+then
+.meta sym
+is instead tested using
+.codn fboundp ,
+if
+.meta kind
+is
+.codn macro ,
+then
+.meta sym
+is tested using
+.codn mboundp ,
+if
+.meta kind
+is
+.codn struct ,
+then
+.meta sym
+is tested using
+.codn find-struct-type ,
+and if
+.meta kind
+is
+.codn pkg ,
+then
+.meta sym
+is tested using
+.codn find-package .
+
+When
+.code load-for
+invokes the
+.code load
+function, it confirms whether loading file has had the expected effect of
+providing a definition of
+.meta sym
+of the right
+.metn kind .
+If this isn't the case, an error is thrown.
+
+The
+.code load-for
+function returns
+.codn nil .
+
 .coNP Variable @ txr-exe-path
 .desc
 This variable holds the absolute path name of the executable file