diff options
| -rw-r--r-- | autoload.c | 17 | ||||
| -rw-r--r-- | stdlib/doc-syms.tl | 2 | ||||
| -rw-r--r-- | stdlib/load-args.tl | 49 | ||||
| -rw-r--r-- | tests/019/load-args.tl | 72 | ||||
| -rw-r--r-- | txr.1 | 212 |
5 files changed, 352 insertions, 0 deletions
@@ -939,6 +939,22 @@ static val expander_let_instantiate(void) return nil; } +static val load_args_set_entries(val fun) +{ + val name[] = { + lit("load-args-recurse"), lit("load-args-process"), + nil + }; + autoload_set(al_fun, name, fun); + return nil; +} + +static val load_args_instantiate(void) +{ + load(scat2(stdlib_path, lit("load-args"))); + return nil; +} + val autoload_reg(val (*instantiate)(void), val (*set_entries)(val)) { @@ -1007,6 +1023,7 @@ void autoload_init(void) autoload_reg(pic_instantiate, pic_set_entries); autoload_reg(constfun_instantiate, constfun_set_entries); autoload_reg(expander_let_instantiate, expander_let_set_entries); + autoload_reg(load_args_instantiate, load_args_set_entries); reg_fun(intern(lit("autoload-try-fun"), system_package), func_n1(autoload_try_fun)); } diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl index 49e7cb9f..94896888 100644 --- a/stdlib/doc-syms.tl +++ b/stdlib/doc-syms.tl @@ -1144,6 +1144,8 @@ ("lnew" "N-0230059D") ("lnew*" "N-021E6FDC") ("load" "D-0083") + ("load-args-process" "N-03D9382A") + ("load-args-recurse" "N-03067356") ("load-for" "N-0020A085") ("load-time" "D-0048") ("loff-t" "N-01153D9E") diff --git a/stdlib/load-args.tl b/stdlib/load-args.tl new file mode 100644 index 00000000..7877f24f --- /dev/null +++ b/stdlib/load-args.tl @@ -0,0 +1,49 @@ +;; Copyright 2023 +;; Kaz Kylheku <kaz@kylheku.com> +;; Vancouver, Canada +;; All rights reserved. +;; +;; Redistribution and use in source and binary forms, with or without +;; modification, are permitted provided that the following conditions are met: +;; +;; 1. Redistributions of source code must retain the above copyright notice, +;; this list of conditions and the following disclaimer. +;; +;; 2. Redistributions in binary form must reproduce the above copyright notice, +;; this list of conditions and the following disclaimer in the documentation +;; and/or other materials provided with the distribution. +;; +;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +;; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +;; POSSIBILITY OF SUCH DAMAGE. + +(defun load-args-recurse (. files) + (if-match (@(listp @list)) files + (set files list)) + (each ((file files)) + (load file . *load-args*))) + +(defun load-args-process (. files) + (if-match (@(listp @list)) files + (set files list)) + (match-case *load-args* + ((:compile) + (let* ((lp (base-name *load-path*)) + (self (if-match @(or `@name.tlo` + `@name.tlo.gz`) lp + name lp))) + (compile-update-file self)) + [mapdo compile-update-file files]) + ((:clean) + (clean-file (base-name *load-path*)) + [mapdo clean-file files]) + (@else + [mapdo (op load @1 . else) files]))) diff --git a/tests/019/load-args.tl b/tests/019/load-args.tl new file mode 100644 index 00000000..bd0037f1 --- /dev/null +++ b/tests/019/load-args.tl @@ -0,0 +1,72 @@ +(load "../common") + +(defvar *trace*) + +(defmacro deftrace (fun) + ^(defun ,fun (. args) + (push ^(,%fun% ,*args) *trace*))) + +(handle + (eval '(progn + (deftrace load) + (deftrace compile-update-file) + (deftrace clean-file))) + (warning (x . rest) + (throw 'continue))) + +(defmacro tr (form) + ^(let ((*trace* nil)) + ,form + (reverse *trace*))) + +(mtest + (tr (load-args-recurse '("abc"))) ((load "abc")) + (tr (load-args-recurse "abc")) ((load "abc")) + (tr (load-args-recurse "abc" "def")) ((load "abc") (load "def")) + (tr (load-args-recurse '("abc") "def")) ((load ("abc")) (load "def"))) + +(let ((*load-args* '(1 2))) + (mtest + (tr (load-args-recurse '("abc"))) ((load "abc" 1 2)) + (tr (load-args-recurse "abc")) ((load "abc" 1 2)) + (tr (load-args-recurse "abc" "def")) ((load "abc" 1 2) (load "def" 1 2)) + (tr (load-args-recurse '("abc") "def")) ((load ("abc") 1 2) (load "def" 1 2)))) + +(mtest + (tr (load-args-process '("abc"))) ((load "abc")) + (tr (load-args-process "abc")) ((load "abc")) + (tr (load-args-process "abc" "def")) ((load "abc") (load "def")) + (tr (load-args-process '("abc") "def")) ((load ("abc")) (load "def"))) + +(let ((*load-args* '(1 2))) + (mtest + (tr (load-args-process '("abc"))) ((load "abc" 1 2)) + (tr (load-args-process "abc")) ((load "abc" 1 2)) + (tr (load-args-process "abc" "def")) ((load "abc" 1 2) (load "def" 1 2)) + (tr (load-args-process '("abc") "def")) ((load ("abc") 1 2) (load "def" 1 2)))) + +(let ((*load-args* '(:compile))) + (mtest + (tr (load-args-process '("abc"))) ((compile-update-file "load-args.tl") + (compile-update-file "abc")) + (tr (load-args-process "abc")) ((compile-update-file "load-args.tl") + (compile-update-file "abc")) + (tr (load-args-process "abc" "def")) ((compile-update-file "load-args.tl") + (compile-update-file "abc") + (compile-update-file "def")) + (tr (load-args-process '("abc") "def")) ((compile-update-file "load-args.tl") + (compile-update-file ("abc")) + (compile-update-file "def")))) + +(let ((*load-args* '(:clean))) + (mtest + (tr (load-args-process '("abc"))) ((clean-file "load-args.tl") + (clean-file "abc")) + (tr (load-args-process "abc")) ((clean-file "load-args.tl") + (clean-file "abc")) + (tr (load-args-process "abc" "def")) ((clean-file "load-args.tl") + (clean-file "abc") + (clean-file "def")) + (tr (load-args-process '("abc") "def")) ((clean-file "load-args.tl") + (clean-file ("abc")) + (clean-file "def")))) @@ -80157,6 +80157,218 @@ is not processed after the listener reads the file. Hooks installed by the profile file will activate when the process exits. + +.coNP Function @ load-args-recurse +.synb +.mets (load-args-recurse << file-list ) +.mets (load-args-recurse << file *) +.syne +.desc +The +.code load-args-recurse +function loads multiple files, passing down the current +.code *load-args* +to each one. + +It may be invoked with a single argument which is a list of files, or else it +may be given multiple arguments which are files. + +Each +.meta file +is passed to the +.code load +function, along with extra arguments coming from the current +.code *load-args* +value. + +Note: the purpose of +.code load-args-recurse +is to support a module organization of system whereby modules +have local top-level files that respond to various actions specified via +.codn *load-args* , +actions such as compiling, loading or cleaning. +The +.code load-args-recurse +function allows such modules to not only perform the actions requested in +.code *load-args* +locally, but also pass it down to submodules which then do the same. + +.coNP Function @ load-args-process +.synb +.mets (load-args-process << file-list ) +.mets (load-args-process << file *) +.syne +.desc +The +.code load-args-process +function performs one of several actions over the specified files, +those actions being distinguished by the value in +.codn *load-args* . + +In addition, some of the actions are also performed for the file +indicated in the current value of +.codn *load-path* . + +It may be invoked with a single argument which is a list of files, or else it +may be given multiple arguments which are files. + +If there is exactly one argument in +.codn *load-args* , +the function responds to the following values of that argument: +.RS +.coIP :compile +The current file in +.code *load-path* +as well as the files passed as arguments, are compiled with +.codn compile-update-file . +.coIP :clean +The current file in +.code *load-path* +as well as the files passed as arguments, are processed with +.codn clean-file . +.RE +.IP +Any other value of +.code *load-args* +causes the function to +.code load +the files passed in the argument, as if by +.codn load-args-recurse . + +Note: +The +.code load-args-process +function supports a protocol for organizing a program into library modules. + +.TP* Example: + +Suppose a module located in the +.str path/to/application +path consists of the files +.strn command +.strn data +.str reports +and +.str main . +Further, suppose that there are two submodules in the +.str utils +directory relative to this directory: +.str database +and +.strn date . + +Then the application might have a file called +.str "path/to/application/app.tl" +with this content: + +.verb + (compile-only + (load-args-recurse + "utils/database/db" + "utils/date/date") + + (load-args-process + "command" + "data" + "reports" + "main")) +.brev + +Furthermore, the +.str database +module similarly provides a +.str "path/to/application/utils/database/db.tl" +file with this content: + +.verb + (compile-only + (load-args-process + "postgres" + "mariadb" + "sqlite")) +.brev + +Lastly, the +.str date +module provides a file +.str "path/to/application/utils/date/date.tl" +with this content: + +.verb + (compile-only + (load-args-process + "src/date.tl")) +.brev + +Then, to load the application and the submodules, all that is needed is +.codn "(load \(dqpath/to/application/app\(dq)" . + +Furthermore, the modules may be compiled using +.codn "(load \(dqpath/to/application/app\(dq :compile)" . +Now the +.code *load-args* +being passed is +.code "(:compile)" +which tells every +.code load-args-process +invocation to compile the file in which it occurs as well as its arguments. + +First, the +.code app +module's +.code load-args-recurse +call is executed, causing the +.str database +and +.str date +modules to compile. + +First, the +.str database +module's +.str db.tl +top file is compiled, if necessary, and then likewise the +.strn postgres.tl , +.str mariadb.tl +and +.str sqlite.tl +files. + +Then the +.str date +module is similarly processed, due to its own invocation of +.codn load-args-process . + +Finally the +.code load-args-process +call in the +.str app +module compiles +.strn app.tl , +.strn command.tl , +.str data.tl +.str reports.tl +and +.strn main.tl + +If the +.code :clean +keyword is passed via +.code *load-args* +instead of +.codn :compile , +then compiled files are recursively removed. The next time the +application is loaded, source files will be loaded rather +than compiled files. + +Note that the +.code load-args-recurse +and +.code load-args-process +forms are placed into a +.code compile-only +form so that the file compiler refrains from executing them. + .coNP Macros @ push-after-load and @ pop-after-load .synb .mets (push-after-load << form *) |