diff options
| -rw-r--r-- | checkman.txr | 2 | ||||
| -rw-r--r-- | eval.c | 10 | ||||
| -rw-r--r-- | lisplib.c | 18 | ||||
| -rw-r--r-- | share/txr/stdlib/keyparams.tl | 96 | ||||
| -rw-r--r-- | txr.1 | 155 |
5 files changed, 277 insertions, 4 deletions
diff --git a/checkman.txr b/checkman.txr index 7797f070..c6b11686 100644 --- a/checkman.txr +++ b/checkman.txr @@ -61,7 +61,7 @@ @ (assert bad ln `no .synb after @{type}s heading`) @ (check-synb) @ (or) -.coNP @{type /Function|Operator|Macro|Accessor|Method|Structure/}@(assert bad ln `bad @type heading`) @@ @{x /\S+/}@junk +.coNP @{type /Function|Operator|Macro|Accessor|Method|Structure|Parameter list macro/}@(assert bad ln `bad @type heading`) @@ @{x /\S+/}@junk @ (assert bad ln `extra elements in singular @type heading`) @ (bind junk "") @ (assert bad ln `no .synb after @type heading`) @@ -941,9 +941,13 @@ static val expand_param_macro(val params, val body, val menv, val form) sym == env_k ||sym == colon_k) return cons(params, body); - if (!pmac) - eval_error(form, lit("~s: keyword ~s has no param macro binding"), - car(form), sym, nao); + if (!pmac) { + lisplib_try_load(sym); + pmac = gethash(pm_table, sym); + if (!pmac) + eval_error(form, lit("~s: keyword ~s has no param macro binding"), + car(form), sym, nao); + } { val prest = cdr(params); @@ -498,6 +498,23 @@ static val error_instantiate(val set_fun) return nil; } +static val keyparams_set_entries(val dlt, val fun) +{ + val key_k = intern(lit("key"), keyword_package); + if (fun) + sethash(dlt, key_k, fun); + else + remhash(dlt, key_k); + return nil; +} + +static val keyparams_instantiate(val set_fun) +{ + funcall1(set_fun, nil); + load(format(nil, lit("~akeyparams.tl"), stdlib_path, nao)); + return nil; +} + val dlt_register(val dlt, val (*instantiate)(val), val (*set_entries)(val, val)) @@ -536,6 +553,7 @@ void lisplib_init(void) dlt_register(dl_table, tagbody_instantiate, tagbody_set_entries); dlt_register(dl_table, pmac_instantiate, pmac_set_entries); dlt_register(dl_table, error_instantiate, error_set_entries); + dlt_register(dl_table, keyparams_instantiate, keyparams_set_entries); } val lisplib_try_load(val sym) diff --git a/share/txr/stdlib/keyparams.tl b/share/txr/stdlib/keyparams.tl new file mode 100644 index 00000000..b3474c4e --- /dev/null +++ b/share/txr/stdlib/keyparams.tl @@ -0,0 +1,96 @@ +;; Copyright 2017 +;; 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 sys:extract-keys (keys args) + (build + (each ((k keys)) + (iflet ((f (memq (car k) args))) + (add (cadr f)) + (add (cdr k)))))) + +(defun sys:extract-keys-p (keys args) + (build + (each ((k keys)) + (add (if (memq k args) t))))) + +(defun sys:build-key-list (key-params) + (let ((constant (group-by [chain second constantp] key-params))) + (let ((var-keys (mapcar (ret ^(cons ',(intern (symbol-name (first @1)) + 'keyword) + ,(second @1))) + [constant nil])) + (const-keys (mapcar (op cons + (intern (symbol-name (first @1)) 'keyword) + (second @1)) + [constant t]))) + (cond + ((empty const-keys) + ^(list ,*var-keys)) + ((empty var-keys) + ^',const-keys) + (t ^(list* ,*var-keys ',const-keys)))))) + +(define-param-expander :key (param body menv form) + (let* ((excluding-rest (butlastn 0 param)) + (key-start (memq '-- excluding-rest)) + (rest-param (or (nthlast 0 param) (gensym))) + (before-key (ldiff excluding-rest key-start)) + (key-params-raw (butlastn 0 (cdr key-start))) + (key-params [mapcar [iffi atom (op list @1)] key-params-raw]) + (eff-param (append before-key rest-param))) + (each ((key-spec key-params)) + (tree-case key-spec + ((var init var-p . junk) + (when (consp junk) + (compile-error form "superfluous forms in ~s" key-spec)) + (when junk + (compile-error form "invalid dotted form ~s" key-spec)) + (unless (bindable var-p) + (compile-error form "~s isn't a bindable symbol" var-p)) + :) + ((var init . more) + (unless (listp more) + (compile-error form "invalid dotted form ~s" key-spec)) + :) + ((var . more) + (unless (listp more) + (compile-error form "invalid dotted form ~s" key-spec)) + (unless (bindable var) + (compile-error form "~s isn't a bindable symbol" var))))) + (let* ((key-params-p [keep-if third key-params]) + (key-vars [mapcar first key-params]) + (key-vars-p [mapcar third key-params-p]) + (keys (sys:build-key-list key-params)) + (keys-p (mapcar (op intern (symbol-name (first @1)) 'keyword) + key-params-p))) + (list eff-param + ^(tree-bind ,key-vars + (sys:extract-keys ,keys ,rest-param) + ,*(if keys-p + ^((tree-bind ,key-vars-p + (sys:extract-keys-p ',keys-p ,rest-param) + ,*body)) + body)))))) @@ -28544,6 +28544,14 @@ final parameter list and its accompanying body are then taken in place of the original parameter list and body. +\*(TL provides a built-in parameter list macro bound to the symbol +.code :key +which endows a function keyword parameters. The implementation is +written entirely using this parameter list macro mechanism, by means +of the +.code define-parameter-macro +macro. + .coNP Special variable @ *param-macro* .desc The variable @@ -28693,6 +28701,153 @@ All that is required is the insertion of the .code :memo keyword. +.coNP Parameter list macro @ :key +.synb +.mets (:key << param * +.mets \ \ [ -- >> { sym | >> ( sym >> [ init-form <> [ p-sym ]])}* ] +.mets \ \ [ . rest-param ]) +.syne +.desc +Parameter list macro +.code :key +injects keyword parameter support into functions and macros. + +When +.code :key +appears as the first item in a function parameter list, a special syntax is +recognized in the parameter list. After any required and optional parameters, +the symbol +.code -- +(two dashes) may appear. Parameters after this symbol are interpreted +as keyword parameters. After the keyword parameters, a rest parameter +may appear in the usual way as a symbol in the dotted position. + +Keyword parameters use the same syntax as optional parameters, except +that if used in a macro parameter list, they do not support +destructuring whereas optional parameters do. That is to say, regardless +whether +.code :key +is used in a function or macro, keyword parameters are symbols. + +A keyword parameter takes three possible forms: + +.RS +.meIP < sym +A keyword parameter may be specified as a simple symbol +.metn sym . +If the argument for such a keyword parameter is missing, +it takes on the value +.codn nil . +.meIP >> ( sym << init-form ) +If the keyword parameter symbol +.meta sym +is enclosed in a list, then the second element of that list +specifies a default value, similarly to the default value for +an optional argument. If the function is called in such a way +that the argument for the parameter is missing, the +.meta init-form +is evaluated and the resulting value is bound to the keyword parameter. +The evaluation takes place in a lexical scope in which the +required and optional parameters are are already visible, +and their values are bound. If there is a +.meta rest-param +it is also visible in this scope, even though in the parameter +list it appears to the left. +.meIP >> ( sym < init-form << p-sym ) +The three-element form of the keyword parameter specifies +an additional symbol +.metn p-sym , +which names an argument that implicitly receives a Boolean +argument indicating the presence of the keyword argument. +If an argument is not passed for the keyword parameter +.metn sym , +then parameter +.meta sym-p +takes on the value +.codn nil . +If an argument is given for +.metn sym , +then the +.meta sym-p +argument takes on the value +.codn t . +This mechanism also closely resembles the analogous +one supported in optional arguments. See the previous +paragraph regarding the evaluation scope of +.metn init-form . +.RE + +.IP +Arguments to keyword appear as a property list which begins +after the last required or optional argument. A property list +consists of interleaved indicators and values. The indicators +for keyword parameters are keyword symbols whose names match +the parameter names. For instance, the indicator-value pair +.code ":xyz 42" +passes the value +.code 42 +to a keyword parameter that may be named +.code xyz +in any package: it may be +.code usr:xyz +or +.code mypackage:xyz +and so forth. + +If the function has a +.meta rest-param +then that param receives the keyword parameter list. That is to say, the +.code :key +mechanism generates a regular variadic function which receives the keyword +parameters as the trailing arguments. The function is endowed with code which +parses these extra arguments out of the trailing list, and binds them to +the keyword parameter symbols. If a +.meta rest-param +argument present, then it specifies a symbol to be used as the name of +the rest parameter, making the entire keyword argument list available +under that name. If there is no +.meta rest-param +then a machine-generated rest parameter is substituted; the keyword argument +parsing logic refers to that instead. + +.TP* Example: + +Define a function +.code fun +with two required arguments +.codn "a b" , +one optional argument +.codn c , +two keyword arguments +.code foo +and +.codn bar , +and a rest parameter +.codn klist : + +.cblk + (defun fun (:key a b : c -- foo bar . klist) + (list a b c foo bar klist)) + + (fun 1 2 3 :bar 4) -> (1 2 3 nil 4 (:bar 4)) +.cble + +Define a function with only keyword arguments, with default expressions and +Boolean indicator params: + +.cblk + (defun keyfun (:key -- (a 10 a-p) (b 20 b-p)) + (list a a-p b b-p)) + + (keyfun :a 3) -> (3 t 20 nil) + + (keyfun :b 4) -> (10 nil 4 t) + + (keyfun :c 4) -> (10 nil 20 nil) + + (keyfun) -> (10 nil 20 nil) +.cble + .SS* Mutation of Syntactic Places .coNP Macro @ set .synb |