summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--share/txr/stdlib/match.tl45
1 files changed, 18 insertions, 27 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl
index a0339fab..2ed436d7 100644
--- a/share/txr/stdlib/match.tl
+++ b/share/txr/stdlib/match.tl
@@ -581,11 +581,12 @@
(match-p (gensym "match-p-"))
(result (gensym "result-")))
^(alet ((,cm.obj-var ,obj))
- (let* (,match-p ,*cm.(get-vars)
- (,result ,cm.(wrap-guards
- ^(set ,match-p t)
- then)))
- (if ,match-p ,result ,else)))))
+ (let* (,result ,*cm.(get-vars))
+ (if ,cm.(wrap-guards
+ ^(set ,result ,then)
+ t)
+ ,result
+ ,else)))))
(defmacro match-case (:form *match-form* :env e obj . clauses)
(unless [all clauses [andf proper-listp [chain len plusp]]]
@@ -599,20 +600,15 @@
clauses])
(nclauses (len clauses))
(clause-code (collect-each ((cl clauses)
- (cm clause-matches)
- (i 1))
+ (cm clause-matches))
(mac-param-bind *match-form* (match . forms) cl
- ^(unless ,(unless (eql i 1) matched-p-temp)
- (let (,*cm.(get-vars))
- (set ,result-temp
- ,(if (eql i nclauses)
- cm.(wrap-guards . forms)
- cm.(wrap-guards
- ^(set ,matched-p-temp t)
- . forms)))))))))
+ ^(let (,*cm.(get-vars))
+ ,cm.(wrap-guards ^(set ,result-temp
+ (progn ,*forms))
+ t))))))
^(alet ((,objvar ,obj))
- (let (,matched-p-temp ,result-temp)
- ,*clause-code
+ (let (,result-temp)
+ (or ,*clause-code)
,result-temp))))
(defmacro when-exprs-match (:form *match-form* :env e pats exprs . forms)
@@ -666,11 +662,9 @@
(arg-temps (append fix-arg-temps opt-arg-temps))
(present-vec (vec-list (append (repeat '(t) min-args)
present-p-temps)))
- (matched-p-temp (gensym "matched-p"))
(result-temp (gensym "result"))
(nclauses (len parsed-clauses))
- (ex-clauses (collect-each ((pc parsed-clauses)
- (counter 1))
+ (ex-clauses (collect-each ((pc parsed-clauses))
(let* ((vp pc.variadic-pattern)
(exp ^(when-exprs-match
(,*pc.fixed-patterns
@@ -679,9 +673,8 @@
,*(if vp
^((list* ,*[arg-temps pc.nfixed..:]
,rest-temp))))
- ,*(unless (eql counter nclauses)
- ^((set ,matched-p-temp t)))
- (set ,result-temp (progn ,*pc.forms)))))
+ (set ,result-temp (progn ,*pc.forms))
+ t)))
(sys:set-macro-ancestor exp pc.orig-syntax)
(when (> pc.nfixed min-args)
(set exp ^(when ,[present-vec (pred pc.nfixed)]
@@ -692,16 +685,14 @@
(when (and variadic (not vp) (= pc.nfixed max-args))
(set exp ^(unless ,rest-temp
,exp)))
- (unless (eql 1 counter)
- (set exp ^(unless ,matched-p-temp ,exp)))
exp))))
^(lambda (,*fix-arg-temps
,*(if opt-arg-temps
(cons : (mapcar (ret ^(,@1 nil ,@2))
opt-arg-temps present-p-temps)))
. ,rest-temp)
- (let (,matched-p-temp ,result-temp)
- ,*ex-clauses
+ (let (,result-temp)
+ (or ,*ex-clauses)
,result-temp))))
(defmacro lambda-match (:form *match-form* . clauses)