diff options
| -rw-r--r-- | eval.c | 27 | ||||
| -rw-r--r-- | eval.h | 3 | ||||
| -rw-r--r-- | match.c | 4 | ||||
| -rw-r--r-- | stdlib/doc-syms.tl | 1 | ||||
| -rw-r--r-- | tests/019/load-hook.tl | 18 | ||||
| -rw-r--r-- | tests/load-hook.tl | 4 | ||||
| -rw-r--r-- | txr.1 | 81 | ||||
| -rw-r--r-- | txr.c | 3 |
8 files changed, 136 insertions, 5 deletions
@@ -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(); } @@ -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); @@ -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*) @@ -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 )}*) @@ -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); |