diff options
Diffstat (limited to 'share')
| -rw-r--r-- | share/txr/stdlib/match.tl | 36 |
1 files changed, 20 insertions, 16 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl index 38d0b821..e269ecc1 100644 --- a/share/txr/stdlib/match.tl +++ b/share/txr/stdlib/match.tl @@ -331,22 +331,26 @@ pat-match.guard-chain))))) (defun compile-with-match (exp obj-var var-list) - (mac-param-bind *match-form* (op side-pat-var side-expr main-pat) exp - (let* ((side-var (gensym)) - (side-pat (if (or (null side-pat-var) (bindable side-pat-var)) - ^(sys:var ,side-pat-var) - side-pat-var)) - (side-match (compile-match side-pat side-var var-list)) - (main-match (compile-match main-pat obj-var var-list)) - (guard (new match-guard - pure-temps (list side-var) - pure-temp-exprs (list side-expr)))) - (new compiled-match - pattern exp - obj-var obj-var - guard-chain (append (list guard) - side-match.guard-chain - main-match.guard-chain))))) + (tree-case exp + ((op main-pat side-pat-var side-expr) + (let* ((side-var (gensym)) + (side-pat (if (or (null side-pat-var) (bindable side-pat-var)) + ^(sys:var ,side-pat-var) + side-pat-var)) + (main-match (compile-match main-pat obj-var var-list)) + (side-match (compile-match side-pat side-var var-list)) + (guard (new match-guard + pure-temps (list side-var) + pure-temp-exprs (list side-expr)))) + (new compiled-match + pattern exp + obj-var obj-var + guard-chain (append main-match.guard-chain + (list guard) + side-match.guard-chain)))) + ((op side-pat-var side-expr) + (compile-with-match ^(,op @nil ,side-pat-var ,side-expr) obj-var var-list)) + (x (compile-error *match-form* "bad syntax: ~s" exp)))) (defun compile-loop-match (exp obj-var var-list) (mac-param-bind *match-form* (op match) exp |