diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2021-02-03 06:16:24 -0800 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2021-02-03 06:16:24 -0800 |
commit | 06f994c1fd99290535a918e4b0954b6350684966 (patch) | |
tree | 9f013660ebd227f6976395faba5669df316ebcff | |
parent | fe917350c75980d68cd435554fbdca149aeaf323 (diff) | |
download | txr-06f994c1fd99290535a918e4b0954b6350684966.tar.gz txr-06f994c1fd99290535a918e4b0954b6350684966.tar.bz2 txr-06f994c1fd99290535a918e4b0954b6350684966.zip |
matcher: bugfix: bad hygiene in match-case.
* share/txr/stdlib/match.tl (match-case): Use a gensym for
evaluating the obj expression, rather than passing that
expression itself into the sub-compile jobs, where it is
subject to multiple evaluation.
-rw-r--r-- | share/txr/stdlib/match.tl | 10 |
1 files changed, 6 insertions, 4 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl index d5063c40..adb85ea9 100644 --- a/share/txr/stdlib/match.tl +++ b/share/txr/stdlib/match.tl @@ -555,7 +555,8 @@ (compile-error *match-form* "bad clause syntax")) (let* ((flag (gensym "flag-")) (result (gensym "result-")) - (clause-matches [mapcar (op compile-match (car @1) obj) clauses]) + (objvar (gensym "obj-")) + (clause-matches [mapcar (op compile-match (car @1) objvar) clauses]) (clause-code (collect-each ((cl clauses) (cm clause-matches) (i 0)) @@ -565,9 +566,10 @@ (set ,result ,cm.(wrap-guards ^(set ,flag t) . forms)))))))) - ^(let (,flag ,result) - ,*clause-code - ,result))) + ^(alet ((,objvar ,obj)) + (let (,flag ,result) + ,*clause-code + ,result)))) (defmacro lambda-match (. clauses) (with-gensyms (args) |