diff options
| -rw-r--r-- | share/txr/stdlib/match.tl | 14 | ||||
| -rw-r--r-- | tests/011/patmatch.tl | 15 | ||||
| -rw-r--r-- | txr.1 | 54 |
3 files changed, 72 insertions, 11 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl index 3026ab0a..08357932 100644 --- a/share/txr/stdlib/match.tl +++ b/share/txr/stdlib/match.tl @@ -580,7 +580,11 @@ (usr:scan (compile-scan-match exp obj-var var-list)) (exprs (compile-exprs-match exp obj-var var-list)) (t (iflet ((xfun [*match-macro* op])) - (let ((xexp [xfun exp])) + (let* ((var-env (make-env (mapcar (lop cons + 'sys:special) + var-list.vars) + nil var-list.menv)) + (xexp [xfun exp var-env])) (if (neq xexp exp) (compile-match xexp obj-var var-list) (compile-predicate-match exp obj-var var-list))) @@ -750,10 +754,10 @@ (with-gensyms (name-dummy args) ^(progn (sethash *match-macro* ',name - (lambda (,args) - (mac-param-bind *match-form* - (,name-dummy ,*destructuring-args) - ,args ,*body))) + (lambda (,args vars-env) + (mac-env-param-bind *match-form* vars-env + (,name-dummy ,*destructuring-args) + ,args ,*body))) ',name))) (defun check (f op pat) diff --git a/tests/011/patmatch.tl b/tests/011/patmatch.tl index 346b21b6..87545c82 100644 --- a/tests/011/patmatch.tl +++ b/tests/011/patmatch.tl @@ -321,3 +321,18 @@ (test (when-match @(as z @(end (2 @x) y)) '(1 2 3) (list x y z)) (3 (2 3) (1 2 3))) + +(defmatch env (var :env e) + ^@(with ,var ',e)) + +(test (when-match @(and @a @(env e) @b) 42 + (list a (env-vbindings e) (lexical-var-p e 'a) (lexical-var-p e 'b) b)) + (42 ((a . sys:special)) t nil 42)) + +(defmatch var= (sym :env e) + (if (lexical-var-p e sym) + (with-gensyms (obj) + ^@(require (sys:var ,obj) (= ,sym ,obj))) + ^(sys:var ,sym))) + +(test (when-match (@(var= a) @(var= a)) '(1 1.0) a) 1) @@ -42169,19 +42169,35 @@ The pattern macro bindings are stored in a hash table held by the variable whose keys are symbols, and whose values are expander functions. There are no lexically scoped pattern macros. -If a +Pattern macros defined with .code defmatch -macro uses the +may specify the special macro parameters +.code :form +and +.code :env +in their parameter lists. The values of these parameters are determined +in a manner particular to +.codn defmatch . + +The .code :form -parameter to gain access to the form, what the parameter retrieves -is the pattern matching form, or a constituent thereof, in which the -the macro is being invoked. For instance, if the operator is being used -inside a pattern given to a +parameter captures the pattern matching form, or a constituent thereof, in +which the the macro is being invoked. For instance, if the operator is being +used inside a pattern given to a .code when-match macro invocation, then the form will be that entire .code when-match form. +The +.code :env +parameter captures a specially constructed macro-time environment object in +which all of the variables to the left of the pattern appear as lexical +variables. The parent of this environment is the surrounding macro environment. +If the pattern macro needs to treat a variable which already has a binding +differently from an unbound variable, it can look up the variable in this +environment. + .TP* Example: .verb @@ -42202,6 +42218,24 @@ form. "~s: bindable symbol expected, not ~s" 'foo sym)) ...) + + ;; Pattern macro which uses = equality to backreference + ;; an existing lexical binding, or else binds the variable + ;; if it has no existing lexical binding. + (defmatch var= (sym :env e) + (if (lexical-var-p e sym) + (with-gensyms (obj) + ^@(require (sys:var ,obj) + (= ,sym ,obj))) + ^(sys:var ,sym))) + + ;; example use: + (when-match (@(var= a) @(var= a)) '(1 1.0) a) + -> 1 + + ;; no match: (equal 1 1.0) is false + (when-match (@a @a) '(1 1.0) a) + -> nil .brev .coNP Special variable @ *match-macro* @@ -42222,6 +42256,14 @@ then there is no such binding: pattern operator forms based on .code sym do not undergo place macro expansion. +The macro expanders in +.code *match-macro* +are two-parameter functions. The first argument passes the operator +syntax to be expanded. The second argument is used for passing the +environment object which the expander can capture using +.code :env +in its macro parameter list. + .SS* Quasiquote Operator Syntax .coNP Macro @ qquote .synb |