diff options
| -rw-r--r-- | share/txr/stdlib/match.tl | 27 | ||||
| -rw-r--r-- | tests/011/patmatch.tl | 21 | ||||
| -rw-r--r-- | txr.1 | 25 |
3 files changed, 64 insertions, 9 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl index e269ecc1..f40fbd70 100644 --- a/share/txr/stdlib/match.tl +++ b/share/txr/stdlib/match.tl @@ -118,8 +118,11 @@ (defstruct var-list () vars + menv - (:method exists (me sym) (member sym me.vars)) + (:method exists (me sym) (or (member sym me.vars) + (lexical-var-p me.menv sym) + (boundp sym))) (:method record (me sym) (push sym me.vars)) (:method merge (me copy) (each ((v copy.vars)) (pushnew v me.vars)))) @@ -551,14 +554,17 @@ (compile-atom-match pat obj-var var-list))))) (t (compile-atom-match pat obj-var var-list)))) -(defmacro when-match (:form *match-form* pat obj . body) - (let ((cm (compile-match pat))) +(defun get-var-list (env) + (new var-list menv env)) + +(defmacro when-match (:form *match-form* :env e pat obj . body) + (let ((cm (compile-match pat : (get-var-list e)))) ^(alet ((,cm.obj-var ,obj)) (let ,cm.(get-vars) ,cm.(wrap-guards . body))))) -(defmacro if-match (:form *match-form* pat obj then : else) - (let ((cm (compile-match pat)) +(defmacro if-match (:form *match-form* :env e pat obj then : else) + (let ((cm (compile-match pat : (get-var-list e))) (match-p (gensym "match-p-")) (result (gensym "result-"))) ^(alet ((,cm.obj-var ,obj)) @@ -568,13 +574,16 @@ then))) (if ,match-p ,result ,else))))) -(defmacro match-case (:form *match-form* obj . clauses) +(defmacro match-case (:form *match-form* :env e obj . clauses) (unless [all clauses [andf proper-listp [chain len plusp]]] (compile-error *match-form* "bad clause syntax")) (let* ((matched-p-temp (gensym "matched-p-")) (result-temp (gensym "result-")) (objvar (gensym "obj-")) - (clause-matches [mapcar (op compile-match (car @1) objvar) clauses]) + (var-list (get-var-list e)) + (clause-matches [mapcar (op compile-match (car @1) + objvar (copy var-list)) + clauses]) (nclauses (len clauses)) (clause-code (collect-each ((cl clauses) (cm clause-matches) @@ -593,8 +602,8 @@ ,*clause-code ,result-temp)))) -(defmacro when-exprs-match (:form *match-form* pats exprs . forms) - (let ((em (compile-match ^@(exprs ,*pats) exprs))) +(defmacro when-exprs-match (:form *match-form* :env e pats exprs . forms) + (let ((em (compile-match ^@(exprs ,*pats) exprs (get-var-list e)))) ^(let* (,*em.(get-vars)) ,em.(wrap-guards . forms)))) diff --git a/tests/011/patmatch.tl b/tests/011/patmatch.tl index fe82d28c..870a3a0b 100644 --- a/tests/011/patmatch.tl +++ b/tests/011/patmatch.tl @@ -241,3 +241,24 @@ (test (ack 1 1) 3) (test (ack 2 2) 7) + +(defun x-x-y (list x) + (when-match (@x @x @y) list y)) + +(test (x-x-y '(1 1 2) 1) 2) +(test (x-x-y '(1 2 3) 1) nil) +(test (x-x-y '(1 1 2 r2) 1) nil) + +(test (let ((a 3) (x 0)) + (match-case '(3 2 1) + ((@x 2 @b) ^(1 ,b)) + ((@a 2 @b) ^(2 ,a)))) + (2 3)) + +(test + (let ((a 3) (x 0)) + (labels ((local (:match) + ((@x 2 @b) ^(1 ,b)) + ((@a 2 @b) ^(2 ,a)))) + (local 3 2 1))) + (2 3)) @@ -39818,6 +39818,31 @@ and binds a to the leftmost and fails to match a list like .codn "(1 2)" . +Pattern variables exist in the same namespace as Lisp variables, +and are fully integrated in it. Patterns not only bind variables, +but have visibility to existing variables in scope, including +lexical variables and special/global variables. When a variable +is mentioned in a pattern, if it already has a binding as a Lisp variable, then +it denotes a reference to that variable in exactly the same way that a pattern +variable back-references itself in a pattern: the Lisp variable +is require to compare +.code equal +to the corresponding object being examined by the pattern. For instance, +the following function returns the third element of a list, if the +first two elements are repetitions of the +.code x +argument, otherwise +.codn nil : + +.verb + (defun x-x-y (list x) + (when-match (@x @x @y) list y)) + + (x-x-y '(1 1 2) 1) -> 2 + (x-x-y '(1 2 3) 1) -> nil ;; no @x @x match + (x-x-y '(1 1 2 r2) 1) -> nil ;; list too long +.brev + The pattern-matching notation is documented in the following sections; sections describing the pattern matching macros follow. |