diff options
| -rw-r--r-- | eval.c | 46 | ||||
| -rw-r--r-- | lisplib.c | 17 | ||||
| -rw-r--r-- | share/txr/stdlib/pmac.tl | 34 | ||||
| -rw-r--r-- | txr.1 | 211 |
4 files changed, 302 insertions, 6 deletions
@@ -68,7 +68,7 @@ struct c_var { }; val top_vb, top_fb, top_mb, top_smb, special, builtin; -val op_table; +val op_table, pm_table; val dyn_env; val eval_initing; @@ -895,17 +895,48 @@ static val expand_params_rec(val params, val menv, } } +static val expand_param_macro(val params, val body, val menv, val form) +{ + if (atom(params)) { + return cons(params, body); + } else { + val sym = car(params); + val pmac = gethash(pm_table, sym); + + if (!keywordp(sym) || sym == whole_k || sym == form_k || + 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); + + { + val prest = cdr(params); + cons_bind (prest_ex0, body_ex0, expand_param_macro(prest, body, + menv, form)); + cons_bind (prest_ex, body_ex, funcall4(pmac, prest_ex0, body_ex0, + menv, form)); + if (body_ex != body) + rlcp(body_ex, body); + return expand_param_macro(prest_ex, body_ex, menv, form); + } + } +} + static val expand_params(val params, val body, val menv, val macro_style_p, val form) { val specials = nil; - int have_rebinds = consp(body) && consp(car(body)) && caar(body) == with_dyn_rebinds_s; - val params_ex = expand_params_rec(params, menv, macro_style_p, + cons_bind (params_ex0, body_ex0, expand_param_macro(params, body, + menv, form)); + int have_rebinds = consp(body_ex0) && consp(car(body_ex0)) && caar(body_ex0) == with_dyn_rebinds_s; + val params_ex = expand_params_rec(params_ex0, menv, macro_style_p, form, &specials); val body_out = if3(!have_rebinds && specials, - rlcp(cons(cons(with_dyn_rebinds_s, cons(specials, body)), + rlcp(cons(cons(with_dyn_rebinds_s, cons(specials, body_ex0)), nil), nil), - body); + body_ex0); return cons(params_ex, body_out); } @@ -4967,7 +4998,7 @@ void eval_init(void) val me_for_f = func_n2(me_for); protect(&top_vb, &top_fb, &top_mb, &top_smb, &special, &builtin, &dyn_env, - &op_table, &last_form_evaled, &last_form_expanded, + &op_table, &pm_table, &last_form_evaled, &last_form_expanded, &call_f, &unbound_s, &origin_hash, convert(val *, 0)); top_fb = make_hash(t, nil, nil); top_vb = make_hash(t, nil, nil); @@ -4976,6 +5007,7 @@ void eval_init(void) special = make_hash(t, nil, nil); builtin = make_hash(t, nil, nil); op_table = make_hash(nil, nil, nil); + pm_table = make_hash(nil, nil, nil); eval_initing = t; @@ -5432,6 +5464,8 @@ void eval_init(void) reg_fun(intern(lit("unique"), user_package), func_n2ov(unique, 1)); reg_fun(intern(lit("uniq"), user_package), func_n1(uniq)); + reg_var(intern(lit("*param-macro*"), user_package), pm_table); + reg_fun(intern(lit("eval"), user_package), func_n2o(eval_intrinsic, 1)); reg_fun(intern(lit("lisp-parse"), user_package), func_n5o(lisp_parse, 0)); reg_fun(intern(lit("read"), user_package), func_n5o(lisp_parse, 0)); @@ -465,6 +465,22 @@ static val tagbody_instantiate(val set_fun) return nil; } +static val pmac_set_entries(val dlt, val fun) +{ + val name[] = { + lit("define-param-expander"), nil + }; + set_dlt_entries(dlt, name, fun); + return nil; +} + +static val pmac_instantiate(val set_fun) +{ + funcall1(set_fun, nil); + load(format(nil, lit("~apmac.tl"), stdlib_path, nao)); + return nil; +} + val dlt_register(val dlt, val (*instantiate)(val), val (*set_entries)(val, val)) @@ -501,6 +517,7 @@ void lisplib_init(void) dlt_register(dl_table, package_instantiate, package_set_entries); dlt_register(dl_table, getput_instantiate, getput_set_entries); dlt_register(dl_table, tagbody_instantiate, tagbody_set_entries); + dlt_register(dl_table, pmac_instantiate, pmac_set_entries); } val lisplib_try_load(val sym) diff --git a/share/txr/stdlib/pmac.tl b/share/txr/stdlib/pmac.tl new file mode 100644 index 00000000..1a93d21e --- /dev/null +++ b/share/txr/stdlib/pmac.tl @@ -0,0 +1,34 @@ +;; 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. + +(defmacro define-param-expander (keyword + (parms body : (env (gensym)) (form (gensym))) + . forms) + ^(progn + (set [*param-macro* ,keyword] + (lambda (,parms ,body ,env ,form) + ,*forms)) + ,keyword)) @@ -12393,6 +12393,10 @@ and semantics as the .code lambda operator. +Note that the above syntax synopsis describes only the canonical +parameter syntax which remains after parameter list macros are +expanded. See the section Parameter List Macros. + Unlike in .codn lambda , the @@ -12487,6 +12491,10 @@ Lisps, functions are objects in \*(TL. They can be passed to functions as arguments, returned from functions, aggregated into lists, stored in variables, et cetera. +Note that the above syntax synopsis describes only the canonical +parameter syntax which remains after parameter list macros are +expanded. See the section Parameter List Macros. + The first argument of .code lambda is the list of parameters for the function. It @@ -12623,6 +12631,11 @@ The and .code labels macros bind local, named functions in the lexical scope. + +Note that the above syntax synopsis describes only the canonical +parameter syntax which remains after parameter list macros are +expanded. See the section Parameter List Macros. + The difference between .code flet and @@ -27573,6 +27586,10 @@ macro-expander function under the name .metn name , effectively creating a new operator. +Note that the above syntax synopsis describes only the canonical +parameter syntax which remains after parameter list macros are +expanded. See the section Parameter List Macros. + Note that the parameter list is a macro parameter list, and not a function parameter list. This means that each .meta param @@ -28448,6 +28465,200 @@ shorthand: ^(,x ,y ,z)) .cble +.SS* Parameter List Macros + +Parameter list macros, also more briefly called +.I "parameter macros" +are an original feature of \*(TL. + +If the first element of a function or macro parameter list is a keyword +symbol other than +.codn :env , +.codn :whole , +.code :form +or +.code : +(the colon symbol), +it denotes a parameter macro. This keyword symbol is expected to +have a binding in the parameter macro namespace: a global namespace +which associates keyword symbols with parameter list expander +functions. + +Expansion of a parameter list macro occurs at macro-expansion +time, when a function's parameter list is traversed by the +macro expander. It takes place as follows. +First, the keyword is removed from the parameter list. +The keyword's binding in the parameter macro namespace is +retrieved. If it doesn't exist, an exception is thrown. +Otherwise, the remaining parameter list is first recursively +processed for more occurrences of parameter macros. +This expansion produces a transformed parameter list, +along with a transformed function body. These two artifacts +are then passed to the transformer function retrieved from +the keyword symbol's binding. The function returns a +further transformed version of the parameter list and +body. These are processed for more parameter macros. +The process terminates when no more expansion is +possible, because a parameter list has been produced +which does not begin with a parameter macro. This +final parameter list and its accompanying body are then +taken in place of the original parameter list and +body. + +.coNP Special variable @ *param-macro* +.desc +The variable +.code *param-macro* +holds a hash table which associates keyword symbols with +parameter list expander functions. + +The functions are expected to conform to the following +syntax: + +.cblk +.mets (lambda >> ( params < body < env << form ) << form *) +.cble + +The +.meta params +parameter receives the parameter list of the function +which is undergoing parameter expansion. All other +parameter macros have already been expanded. + +The +.meta body +parameter receives the list of body forms. +The function is expected to return a +.code cons +cell whose +.code car +contains the transformed parameter list, and whose +.code cdr +contains the transformed list of body forms. +Parameter expansion takes place at macro expansion time. + +The +.meta env +parameter receives the macro-expansion-time environment +which surrounds the function being expanded. +Note that this environment doesn't take into account the +parameters themselves; therefore, it is not the correct environment +for expanding macros among the +.meta body +forms. For that purpose, it must be extended with +shadowing entries, the manner of doing which is +undocumented. However +.meta env +may be used directly for expanding init forms +for optional parameters occurring in +.metn params . + +The +.meta form +parameter receives the overall function-defining +form that is being processes, such as a +.code defun +or +.code lambda +form. This is intended for error reporting. + +.coNP Macro @ define-param-expander +.synb +.mets (define-param-expander < name >> ( pvar < bvar : < evar << fvar ) +.mets \ \ << form *) +.syne +.desc +The +.code define-param-expander +macro provides syntax for defining parameter macros. Invocations +of this macro expand to code which constructs an anonymous +function and installs it into the +.code *param-macro* +hash table, under the key given by +.metn name . + +The +.meta name +parameter's argument should be a keyword symbol that is valid for use +as a parameter macro name. + +The +.metn pvar , +.metn bvar , +.meta evar +and +.meta fvar +arguments must be symbols suitable for variable +binding. These symbols define the parameters of the +expander function which shall, respectively, receive +the parameter list, body forms, macro environment +and function form. If +.meta evar +is omitted, a symbol generated by the +.code gensym +function is used. Likewise if +.meta fvar +is omitted. + +The +.meta form +arguments constitute the body of the expander. + +The +.code define-param-expander +form returns +.metn name . + +.TP* Example: + +The following example shows the implementation +of a parameter macro +.code :memo +which provides rudimentary memoization. +Using the macro is extremely easy. It is a matter +of simply inserting the +.code :memo +keyword at the front of a function's parameter list. +The function is then memoized. + +.cblk + (defvarl %memo% (hash :weak-keys)) + + (defun ensure-memo (sym) + (or (gethash %memo% sym) + (sethash %memo% sym (hash :equal-based)))) + + (define-param-expander :memo (param body) + (let* ((piter param) + ;; memoize over required args + (memo-parm (build + (whilet ((p (pop piter)) + (x (and p (neq p :)))) + (add p)))) + (hash (gensym)) + (key (gensym))) + ^(,param (let ((,hash (ensure-memo ',hash)) + (,key (list ,*memo-parm))) + (or (gethash ,hash ,key) + (sethash ,hash ,key (progn ,*body))))))) +.cble + +The above +.code :memo +macro may be used to define a memoized Fibonacci function +as follows: + +.cble + (defun fib (:memo n) + (if (< n 2) + (clamp 0 1 n) + (+ (fib (pred n)) (fib (ppred n))))) +.cble + +All that is required is the insertion of the +.code :memo +keyword. + .SS* Mutation of Syntactic Places .coNP Macro @ set .synb |