load: new *load-hooks* feature.

*load-hooks* lets a .txr, .tl or .tlo file specify actions to be taken
when the loading of that file completes, whether normally or via
an exception. They are also honored by process exit.

For instance, with this, we can have a Lisp file that behaves like
a script which cleans up after itself (e.g. removing temporary files)
even if it is not run as a stand-alone program, but invoked
via (load ...). Because it's not a stand-alone program, it cannot
simply use the at-exit-call mechanism. The unwind-protect operator could
be used, but it's inconvenient because it protects a single form.
The *load-hooks* feature in effect protects all the top level forms of a
load, similarly to unwind-protect. Also, unwind-protect does not
guard against a process exit. (However, *load-hooks* does not guard
against an abnormal exit, only normal termination).

* eval.c (load_hooks_s): New symbol variable.
(run_load_hooks): New function.
(run_load_hooks_atexit): New static function.
(load): bind *load-hooks* to nil around load. Implement
the hooks processing via run_load_hooks, taking care to pass the
load-time dynamic environment that has already been undone.
(eval_init): Initialize load_hooks_s and register the *load-hooks*
variable. Register run_load_hooks_atexit with atexit, so the
current value of *load-hooks* is processed on process exit.

* eval.h (load_hooks_s, run_load_hooks): Declared.

* match.c (v_load): Similar changes as in load.

* txr.c (txr_main): Run the load hooks with run_load_hooks immediately
after processing the .txr or .tl file, before entering the listener.

* tests/019/load-hook.tl: New directory and file

* tests/load-hook.tl: New file.

* txr.1: Documented.

* stdlib/doc-syms.tl: Updated.

8 files changed, 136 insertions, 5 deletions

diff --git a/eval.c b/eval.c
index 497644b0..8a9fada6 100644
--- a/eval.c
+++ b/eval.c
@@ -102,7 +102,7 @@ val vector_lit_s, vec_list_s, tree_lit_s, tree_construct_s;
 val macro_time_s, macrolet_s;
 val defsymacro_s, symacrolet_s, prof_s, switch_s, struct_s;
 val fbind_s, lbind_s, flet_s, labels_s;
-val load_path_s, load_recursive_s;
+val load_path_s, load_hooks_s, load_recursive_s;
 val load_time_s, load_time_lit_s;
 val eval_only_s, compile_only_s;
 val const_foldable_s;
@@ -4579,6 +4579,23 @@ static val me_load_for(val form, val menv)
   return cons(rt_load_for_s, out);
 }
 
+void run_load_hooks(val load_dyn_env)
+{
+  val hooks_binding = lookup_var(load_dyn_env, load_hooks_s);
+  val hooks = cdr(hooks_binding);
+
+  if (hooks) {
+    for (; hooks; hooks = cdr(hooks))
+      funcall(car(hooks));
+    rplacd(hooks_binding, nil);
+  }
+}
+
+static void run_load_hooks_atexit(void)
+{
+  run_load_hooks(dyn_env);
+}
+
 val load(val target)
 {
   val self = lit("load");
@@ -4592,6 +4609,7 @@ val load(val target)
   val name, stream;
   val txr_lisp_p = t;
   val saved_dyn_env = dyn_env;
+  val load_dyn_env = make_env(nil, nil, dyn_env);
   val rec = cdr(lookup_var(saved_dyn_env, load_recursive_s));
 
   open_txr_file(path, &txr_lisp_p, &name, &stream, self);
@@ -4603,11 +4621,12 @@ val load(val target)
 
   uw_simple_catch_begin;
 
-  dyn_env = make_env(nil, nil, dyn_env);
+  dyn_env = load_dyn_env;
   env_vbind(dyn_env, load_path_s, if3(opt_compat && opt_compat <= 215,
                                       path,
                                       stream_get_prop(stream, name_k)));
   env_vbind(dyn_env, load_recursive_s, t);
+  env_vbind(dyn_env, load_hooks_s, nil);
   env_vbind(dyn_env, package_s, cur_package);
 
   if (txr_lisp_p == t) {
@@ -4653,6 +4672,7 @@ val load(val target)
 
   uw_unwind {
     close_stream(stream, nil);
+    run_load_hooks(load_dyn_env);
     if (!rec)
       uw_dump_deferred_warnings(std_null);
   }
@@ -6667,6 +6687,7 @@ void eval_init(void)
   switch_s = intern(lit("switch"), system_package);
   struct_s = intern(lit("struct"), user_package);
   load_path_s = intern(lit("*load-path*"), user_package);
+  load_hooks_s = intern(lit("*load-hooks*"), user_package);
   load_recursive_s = intern(lit("*load-recursive*"), system_package);
   load_time_s = intern(lit("load-time"), user_package);
   load_time_lit_s  = intern(lit("load-time-lit"), system_package);
@@ -6983,6 +7004,7 @@ void eval_init(void)
   reg_var(load_path_s, nil);
   reg_symacro(intern(lit("self-load-path"), user_package), load_path_s);
   reg_var(load_recursive_s, nil);
+  reg_var(load_hooks_s, nil);
   reg_fun(intern(lit("expand"), user_package), func_n2o(no_warn_expand, 1));
   reg_fun(intern(lit("expand*"), user_package), func_n2o(expand, 1));
   reg_fun(intern(lit("expand-with-free-refs"), user_package),
@@ -7373,6 +7395,7 @@ void eval_init(void)
   uw_register_subtype(eval_error_s, error_s);
   uw_register_subtype(case_error_s, error_s);
 
+  atexit(run_load_hooks_atexit);
   lisplib_init();
 }
 
diff --git a/eval.h b/eval.h
index 3c8fa3bc..14cd6578 100644
--- a/eval.h
+++ b/eval.h
@@ -34,7 +34,7 @@ extern val eval_error_s, if_s, call_s, identity_s;
 extern val eq_s, eql_s, equal_s, less_s;
 extern val car_s, cdr_s;
 extern val last_form_evaled;
-extern val load_path_s, load_recursive_s;
+extern val load_path_s, load_hooks_s, load_recursive_s;
 extern val special_s, struct_s;
 
 extern val dyn_env;
@@ -82,6 +82,7 @@ void trace_check(val name);
 val format_field(val string_or_list, val modifier, val filter, val eval_fun);
 val subst_vars(val forms, val env, val filter);
 val expand_quasi(val quasi_forms, val menv);
+void run_load_hooks(val load_dyn_env);
 val load(val target);
 val expand(val form, val menv);
 val expand_forms(val forms, val menv);
diff --git a/match.c b/match.c
index 5f177adb..d5b76fb2 100644
--- a/match.c
+++ b/match.c
@@ -4376,13 +4376,14 @@ static val v_load(match_files_ctx *c)
     val txr_lisp_p = nil;
     val ret = nil;
     val saved_dyn_env = dyn_env;
+    val load_dyn_env = make_env(nil, nil, dyn_env);
     val rec = cdr(lookup_var(saved_dyn_env, load_recursive_s));
 
     open_txr_file(path, &txr_lisp_p, &name, &stream, self);
 
     uw_simple_catch_begin;
 
-    dyn_env = make_env(nil, nil, dyn_env);
+    dyn_env = load_dyn_env;
     env_vbind(dyn_env, load_path_s, name);
     env_vbind(dyn_env, load_recursive_s, t);
     env_vbind(dyn_env, package_s, cur_package);
@@ -4453,6 +4454,7 @@ static val v_load(match_files_ctx *c)
 
     uw_unwind {
       close_stream(stream, nil);
+      run_load_hooks(saved_dyn_env);
       if (!rec)
         uw_dump_deferred_warnings(std_null);
     }
diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl
index 3e2f7cc3..0bb8b82b 100644
--- a/stdlib/doc-syms.tl
+++ b/stdlib/doc-syms.tl
@@ -23,6 +23,7 @@
       ("*listener-multi-line-p*" "N-02C5CACF")
       ("*listener-pprint-p*" "N-01E7ACFE")
       ("*listener-sel-inclusive-p*" "N-02E4924F")
+      ("*load-hooks*" "N-02D09712")
       ("*load-path*" "N-01D1DB58")
       ("*match-macro*" "N-012A473F")
       ("*n" "N-02E7AE5A")
diff --git a/tests/019/load-hook.tl b/tests/019/load-hook.tl
new file mode 100644
index 00000000..0f33d081
--- /dev/null
+++ b/tests/019/load-hook.tl
@@ -0,0 +1,18 @@
+(load "../common")
+
+(defvarl %dir% (dir-name *load-path*))
+
+(compile-file "../load-hook")
+(test counter 0)
+
+(push (lambda ()
+        (remove-path (path-cat %dir% "../load-hook.tlo")))
+  *load-hooks*)
+
+(set counter nil)
+(load "../load-hook.tl")
+(test counter 1)
+
+(set counter nil)
+(load "../load-hook.tlo")
+(test counter 1)
diff --git a/tests/load-hook.tl b/tests/load-hook.tl
new file mode 100644
index 00000000..508e50ad
--- /dev/null
+++ b/tests/load-hook.tl
@@ -0,0 +1,4 @@
+(defparml counter 0)
+(push (lambda () (inc counter)) *load-hooks*)
+(push (lambda () (dec counter)) *load-hooks*)
+(pop *load-hooks*)
diff --git a/txr.1 b/txr.1
index bace281a..bc9f01ff 100644
--- a/txr.1
+++ b/txr.1
@@ -9051,6 +9051,11 @@ variable is also given a new dynamic binding, whose value is the
 same as the existing binding. These bindings are removed when the
 load operation completes, restoring the prior values of these
 variables.
+The
+.code *load-hooks*
+variable is given a new dynamic binding, with a
+.code nil
+value.
 
 If the file opened for processing is \*(TL source, or
 a compiled \*(TL file, then it is processed in the manner
@@ -74488,6 +74493,82 @@ 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 Special variable @ *load-hooks*
+.desc
+The
+.code *load-hooks*
+variable is at the centre of a mechanism which associates the deferred
+execution of actions, associated with a loaded module or program termination.
+
+The application may push values onto this list which are expected to be
+functions, or objects that may be called as functions. These objects must
+be capable of being called with no arguments.
+
+In the situations specified below, the list of functions is processed as follows.
+First
+.code *load-hooks*
+is examined, the list which it holds is remembered. Then the variable
+is reset to
+.codn nil ,
+following which the remembered list is traversed in order. Each of the
+functions in the list is invoked, with no arguments.
+
+The
+.code *load-hooks*
+list is processed, as described above, whenever the
+.code load
+function terminates, whether normally or by throwing an exception. In this
+situation, the
+.code *load-hooks*
+variable which is accessed is that binding which was established by that
+invocation of
+.codn load .
+However, the functions are invoked in a dynamic environment in which that
+binding of the variable has already been removed. When the processing of
+.code *load-hooks*
+takes place due to the termination of
+.codn load ,
+all of the dynamic bindings established by that invocation of
+.code load
+have already been removed. Therefore, the
+.code *load-hooks*
+binding which is visible to these functions is whichever binding had been
+shadowed by the
+.code load
+function.
+
+The
+.code *load-hooks*
+list is also processed after processing a \*(TX or \*(TL file that
+is specified on the command line. If the interactive listener is
+also being entered, this processing of
+.code *load-hooks*
+occurs prior to entering the listener. In this situation, the top-level
+binding of
+.code *load-hooks*
+is used, and therefore that same binding is visible to the invoked
+functions.
+
+Lastly,
+.code *load-hooks*
+is also processed if the \*(TX process terminates normally, regardless
+of its exit status. In this situation, the current dynamic value of the
+.code *load-hooks*
+variable is used, from the dynamic environment as it exists at the
+time of exit, and that same environment is in effect over the execution
+of the functions. It is unspecified whether, at exit time, the
+.code *load-hooks*
+functions are executed first, or whether the functions registered by
+.code at-exit-call
+are executed first. However, their executions do not interleave.
+
+Note that
+.code *load-hooks*
+is not processed after the listener reads the
+.code .txr_profile
+file. Hooks installed by the profile file will activate when the process
+exits.
+
 .coNP Macro @ load-for
 .synb
 .mets (load-for >> {( kind < sym << target )}*)
diff --git a/txr.c b/txr.c
index be675149..3157b879 100644
--- a/txr.c
+++ b/txr.c
@@ -1125,7 +1125,7 @@ int txr_main(int argc, char **argv)
     gc_state(gc);
 
     close_stream(parse_stream, nil);
-
+    run_load_hooks(dyn_env);
     uw_release_deferred_warnings();
 
     spec = parser->syntax_tree;
@@ -1172,6 +1172,7 @@ int txr_main(int argc, char **argv)
   } else if (enter_repl) {
     read_eval_stream_noerr(self, parse_stream, spec_file_str, std_error);
     close_stream(parse_stream, nil);
+    run_load_hooks(dyn_env);
     uw_release_deferred_warnings();
   } else {
     val result = read_eval_stream(self, parse_stream, std_error);