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 /tests | |
| 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 'tests')
| -rw-r--r-- | tests/011/patmatch.tl | 15 |
1 files changed, 15 insertions, 0 deletions
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) |