diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-02-05 07:15:23 -0800 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-02-05 07:15:23 -0800 |
| commit | 00a793530e0386cfbe29670a8224f5e82897b283 (patch) | |
| tree | 4f59dea5bd251ab00455d73c816a6518cbcc208a | |
| parent | 4cddc02c7c2993ef7f942c200a6ec5408947cddb (diff) | |
| download | txr-00a793530e0386cfbe29670a8224f5e82897b283.tar.gz txr-00a793530e0386cfbe29670a8224f5e82897b283.tar.bz2 txr-00a793530e0386cfbe29670a8224f5e82897b283.zip | |
matcher: don't set flag in last case.
The last case in a match-case or lambda-match does not need to
set the matched flag, since nothing tests it.
* share/txr/stdlib/match.tl (match-case): Rename some local
variables for consistency with lambda-match. Change the
counter from 1, so we can then compare the index of the last
case to the length and avoid emitting the set.
(expand-lambda-match): Same optimization.
| -rw-r--r-- | share/txr/stdlib/match.tl | 30 |
1 files changed, 18 insertions, 12 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl index 70f19665..38d0b821 100644 --- a/share/txr/stdlib/match.tl +++ b/share/txr/stdlib/match.tl @@ -567,23 +567,27 @@ (defmacro match-case (:form *match-form* obj . clauses) (unless [all clauses [andf proper-listp [chain len plusp]]] (compile-error *match-form* "bad clause syntax")) - (let* ((flag (gensym "flag-")) - (result (gensym "result-")) + (let* ((matched-p-temp (gensym "matched-p-")) + (result-temp (gensym "result-")) (objvar (gensym "obj-")) (clause-matches [mapcar (op compile-match (car @1) objvar) clauses]) + (nclauses (len clauses)) (clause-code (collect-each ((cl clauses) (cm clause-matches) - (i 0)) + (i 1)) (mac-param-bind *match-form* (match . forms) cl - ^(unless ,(unless (zerop i) flag) + ^(unless ,(unless (eql i 1) matched-p-temp) (let (,*cm.(get-vars)) - (set ,result ,cm.(wrap-guards - ^(set ,flag t) - . forms)))))))) + (set ,result-temp + ,(if (eql i nclauses) + cm.(wrap-guards . forms) + cm.(wrap-guards + ^(set ,matched-p-temp t) + . forms))))))))) ^(alet ((,objvar ,obj)) - (let (,flag ,result) + (let (,matched-p-temp ,result-temp) ,*clause-code - ,result)))) + ,result-temp)))) (defmacro when-exprs-match (:form *match-form* pats exprs . forms) (let ((em (compile-match ^@(exprs ,*pats) exprs))) @@ -638,8 +642,9 @@ 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 0)) + (counter 1)) (let* ((vp pc.variadic-pattern) (exp ^(when-exprs-match (,*pc.fixed-patterns @@ -648,7 +653,8 @@ ,*(if vp ^((list* ,*[arg-temps pc.nfixed..:] ,rest-temp)))) - (set ,matched-p-temp t) + ,*(unless (eql counter nclauses) + ^((set ,matched-p-temp t))) (set ,result-temp (progn ,*pc.forms))))) (sys:set-macro-ancestor exp pc.orig-syntax) (when (> pc.nfixed min-args) @@ -660,7 +666,7 @@ (when (and variadic (not vp) (= pc.nfixed max-args)) (set exp ^(unless ,rest-temp ,exp))) - (unless (zerop counter) + (unless (eql 1 counter) (set exp ^(unless ,matched-p-temp ,exp))) exp)))) ^(lambda (,*fix-arg-temps |