diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2021-01-21 01:09:55 -0800 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2021-01-21 01:09:55 -0800 |
commit | f540686f66e09d9f8d7e9cd188ce6d8bb5e5d237 (patch) | |
tree | 909345a642e151f0b93b7d7f0f74da41b6892535 | |
parent | 8f3aa77c1ab0352d608b6b5b5303f0d1627350ae (diff) | |
download | txr-f540686f66e09d9f8d7e9cd188ce6d8bb5e5d237.tar.gz txr-f540686f66e09d9f8d7e9cd188ce6d8bb5e5d237.tar.bz2 txr-f540686f66e09d9f8d7e9cd188ce6d8bb5e5d237.zip |
matcher: cleaner @(let) implementation.
* share/txr/stdlib/match.tl (compile-let-match): Reimplement
cleanly in terms of compiling a variable match and a pattern
match against the same object and integrating the two.
Also, do not reject nil as a variable name; the documentation
clearly says it is allowed.
-rw-r--r-- | share/txr/stdlib/match.tl | 23 |
1 files changed, 11 insertions, 12 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl index 964e82ff..63fa75e1 100644 --- a/share/txr/stdlib/match.tl +++ b/share/txr/stdlib/match.tl @@ -203,18 +203,17 @@ match))) (defun compile-let-match (exp obj-var var-list) - (mac-param-bind *match-form* (op sym match) exp - (unless (bindable sym) - (compile-error *match-form* "~s is not a bindable symbol" sym)) - (let ((match (compile-match match obj-var var-list))) - (cond - (var-list.(exists sym) - (set match.test-expr - ^(and ,match.test-expr (equal ,sym ,match.obj-var)))) - (t (push sym match.vars) - (push obj-var match.var-exprs) - var-list.(record sym))) - match))) + (mac-param-bind *match-form* (op sym pat) exp + (let ((var-match (compile-var-match sym obj-var var-list)) + (pat-match (compile-match pat obj-var var-list))) + (new compiled-match + pattern exp + obj-var obj-var + guard-chain (append var-match.guard-chain + pat-match.guard-chain) + test-expr ^(and ,var-match.test-expr ,pat-match.test-expr) + vars (append var-match.vars pat-match.vars) + var-exprs (append var-match.var-exprs pat-match.var-exprs))))) (defun compile-loop-match (exp obj-var var-list) (mac-param-bind *match-form* (op match) exp |