diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-04-21 06:54:50 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-04-21 06:54:50 -0700 |
| commit | 9b8fce5acc9f27866b29ececbece109bbdef01f0 (patch) | |
| tree | 42361acae0c1a91cc75746230c8b5592780a196c /share/txr/stdlib/match.tl | |
| parent | 43e0e33ced93434fd32c050ab3ca68a1e7231932 (diff) | |
| download | txr-9b8fce5acc9f27866b29ececbece109bbdef01f0.tar.gz txr-9b8fce5acc9f27866b29ececbece109bbdef01f0.tar.bz2 txr-9b8fce5acc9f27866b29ececbece109bbdef01f0.zip | |
matcher: defmatch: useful :env parameter.
* share/txr/stdlib/match.tl (compile-match): Pattern macro
expanders now have an environment parameter. We turn the list
of variables that have been bound so far into a fake
macro-time lexical environment, the parent of which is the
surrounding environment. The pattern macro can query this
using the lexical-var-p function to determine whether a given
variable already has a binding, either in the pattern, or
in the surrounding lexical environment.
(defmatch): Generate a two-argument lambda, and use the new
mac-env-param-bind to make the environment object available
to the user-defined expansion.
* tests/011/patmatch.tl: New test cases for this environment
mechanism, and also for defmatch itself.
* txr.1: Document role of :env under defmatch.
Diffstat (limited to 'share/txr/stdlib/match.tl')
| -rw-r--r-- | share/txr/stdlib/match.tl | 14 |
1 files changed, 9 insertions, 5 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) |