diff options
| -rw-r--r-- | eval.c | 38 | ||||
| -rw-r--r-- | eval.h | 1 | ||||
| -rw-r--r-- | tests/019/load-ret.tl | 13 | ||||
| -rw-r--r-- | tests/019/load-ret/module.tl | 1 | ||||
| -rw-r--r-- | tests/019/load-ret/module2.tl | 2 | ||||
| -rw-r--r-- | txr.1 | 50 |
6 files changed, 82 insertions, 23 deletions
@@ -103,7 +103,7 @@ 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_hooks_s, load_recursive_s, load_search_dirs_s; -val load_time_s, load_time_lit_s; +val load_args_s, load_time_s, load_time_lit_s; val eval_only_s, compile_only_s, compiler_let_s; val const_foldable_s; val pct_fun_s; @@ -4684,14 +4684,16 @@ static val me_load_for(val form, val menv) if (!bindable(cadr(arg))) expand_error(form, lit("~s: first argument in ~s must be bindable symbol"), sym, arg, nao); - if (length(arg) != three) - expand_error(form, lit("~s: clause ~s expected to have two arguments"), + if (lt(length(arg), three)) + expand_error(form, lit("~s: clause ~s needs at least 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)); + ptail = list_collect(ptail, + apply_frob_args(list(list_s, + list(quote_s, car(arg), nao), + list(quote_s, cadr(arg), nao), + caddr(arg), + cdddr(arg), + nao))); } else { expand_error(form, lit("~s: invalid clause ~s"), sym, arg, nao); } @@ -4742,7 +4744,7 @@ static void run_load_hooks_atexit(void) run_load_hooks(dyn_env); } -val load(val target) +val loadv(val target, struct args *load_args) { val self = lit("load"); uses_or2; @@ -4773,6 +4775,7 @@ val load(val target) env_vbind(dyn_env, load_recursive_s, t); env_vbind(dyn_env, load_hooks_s, nil); env_vbind(dyn_env, package_s, cur_package); + env_vbind(dyn_env, load_args_s, args_get_list(load_args)); if (txr_lisp_p == t) { if (!read_eval_stream(self, stream, std_error)) { @@ -4828,16 +4831,24 @@ val load(val target) return ret; } +val load(val target) +{ + args_decl_list(load_args, ARGS_MIN, nil); + return loadv(target, load_args); +} + static val rt_load_for(struct args *args) { val self = lit("sys:rt-load-for"); cnum index = 0; + val ret = nil; while (args_more(args, index)) { val clause = args_get(args, &index); val kind = pop(&clause); val sym = pop(&clause); val file = car(clause); + val load_args_list = cdr(clause); val (*testfun)(val); if (kind == usr_var_s) @@ -4855,14 +4866,15 @@ static val rt_load_for(struct args *args) self, kind, nao); if (!testfun(sym)) { - load(file); + args_decl_list(load_args, ARGS_MIN, load_args_list); + ret = loadv(file, load_args); if (!testfun(sym)) uw_throwf(error_s, lit("~a: file ~s didn't define ~a ~s"), self, file, kind, sym, nao); } } - return nil; + return ret; } static val fun_macro_env(val menv, val name) @@ -7048,6 +7060,7 @@ void eval_init(void) load_hooks_s = intern(lit("*load-hooks*"), user_package); load_recursive_s = intern(lit("*load-recursive*"), system_package); load_search_dirs_s = intern(lit("*load-search-dirs*"), user_package); + load_args_s = intern(lit("*load-args*"), user_package); load_time_s = intern(lit("load-time"), user_package); load_time_lit_s = intern(lit("load-time-lit"), system_package); eval_only_s = intern(lit("eval-only"), user_package); @@ -7379,11 +7392,12 @@ void eval_init(void) reg_fun(intern(lit("iread"), user_package), func_n5o(iread, 0)); reg_fun(intern(lit("get-json"), user_package), func_n5o(get_json, 0)); reg_fun(intern(lit("txr-parse"), user_package), func_n4o(txr_parse, 0)); - reg_fun(intern(lit("load"), user_package), func_n1(load)); + reg_fun(intern(lit("load"), user_package), func_n1v(loadv)); 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_search_dirs_s, nil); + reg_var(load_args_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)); @@ -86,6 +86,7 @@ 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 loadv(val target, struct args *); val load(val target); val expand(val form, val menv); val expand_forms(val forms, val menv); diff --git a/tests/019/load-ret.tl b/tests/019/load-ret.tl new file mode 100644 index 00000000..a79f7da9 --- /dev/null +++ b/tests/019/load-ret.tl @@ -0,0 +1,13 @@ +(load "../common") + +(mtest + (load "load-ret/module") 0 + (load "load-ret/module" 1) 1 + (load "load-ret/module" 1 2 3) 6) + +(mtest + (load-for (var abc "load-ret/module2" 'abc)) 0 + (load-for (var def "load-ret/module2" 'def 1 2 3)) 6 + (load-for (var abc "load-ret/module2" 'abc)) nil + (load-for (var abc "load-ret/module2" 'abc) + (var ghi "load-ret/module2" 'ghi 2 3 4)) 9) diff --git a/tests/019/load-ret/module.tl b/tests/019/load-ret/module.tl new file mode 100644 index 00000000..05d69035 --- /dev/null +++ b/tests/019/load-ret/module.tl @@ -0,0 +1 @@ +(return-from load [apply + *load-args*]) diff --git a/tests/019/load-ret/module2.tl b/tests/019/load-ret/module2.tl new file mode 100644 index 00000000..e651c3f5 --- /dev/null +++ b/tests/019/load-ret/module2.tl @@ -0,0 +1,2 @@ +(eval ^(defvar ,(pop *load-args*))) +(return-from load [apply + *load-args*]) @@ -79739,7 +79739,7 @@ can immediately use to expand the given form that is being traversed. .coNP Function @ load .synb -.mets (load << target ) +.mets (load < target << load-arg *) .syne .desc The @@ -79884,18 +79884,33 @@ stream. Over the evaluation of either a \*(TL, compiled file, or \*(TX file, .code load establishes a new dynamic binding for several special -variables. The variable -.code *load-path* -is given a new binding containing the actual pathname. -The -.code *package* -variable is also given a new dynamic binding, whose value is the -same as the existing binding. Thus if the processing of the +variables: + +.RS +.coIP *load-path* +This variable is bound to the actual pathname being loaded. + +.coIP *load-args* +The values of the +.meta load-arg +arguments which follow +.meta target +are combined into a list which is bound to +.codn *load-args* . +By this mechanism, +.code load +can pass arguments to the loaded file. + +.coIP *package* +is given a new dynamic binding, whose value is the same as its +existing binding. Thus if the processing of the loaded file has the effect of altering the value of .codn *package* , that effect will be undone when the binding is removed after the load completes. +.RE +.IP Over the evaluation of either a \*(TL, compiled file, or \*(TX file, .code load establishes a block named @@ -80180,7 +80195,7 @@ The following equivalences hold: .coNP Macro @ load-for .synb -.mets (load-for >> {( kind < sym << target )}*) +.mets (load-for >> {( kind < sym < target << load-arg*)}*) .syne .desc The @@ -80194,7 +80209,7 @@ has a certain kind of binding. Each argument clause has the syntax .mono -.meti >> ( kind < sym << target ) +.meti >> ( kind < sym < target << load-arg *) .onom where .meta kind @@ -80280,8 +80295,21 @@ of the right If this isn't the case, an error is thrown. The +.code load +function is invoked with any +.meta load-arg +arguments specified in the clause. +The +.meta load-arg +expressions of all clauses are unconditionally evaluated in order before +.code load-arg +performs any other action. + +The .code load-for -function returns +function returns the value returned by the rightmost +.code load +that was actually performed. If no loads are performed, it returns .codn nil . .coNP Variable @ txr-exe-path |