diff options
Diffstat (limited to 'csc/match.csc')
| -rw-r--r-- | csc/match.csc | 66 |
1 files changed, 17 insertions, 49 deletions
diff --git a/csc/match.csc b/csc/match.csc index 86efab7..5b85f09 100644 --- a/csc/match.csc +++ b/csc/match.csc @@ -4,41 +4,6 @@ (begin - (define-syntax matches? - (syntax-rules (_ !) - ((matches? x _) #t) - ((matches? x '()) - (null? x)) - ((matches? x (! constant)) - (equal? x constant)) - ((matches? x (pattern)) - (and (= 1 (length x)) - (matches? (car x) pattern))) - ((matches? x (pattern1 . pattern2)) - (and (pair? x) - (matches? (car x) pattern1) - (matches? (cdr x) pattern2))) - ((matches? x identifier) #t))) - - - (define-syntax bind-pattern - (syntax-rules (_ !) - ((bind-pattern x _ result result* ...) - (begin result result* ...)) - ((bind-pattern x '() result result* ...) - (begin result result* ...)) - ((bind-pattern x (! constant) result result* ...) - (begin result result* ...)) - ((bind-pattern x (pattern) result result* ...) - (bind-pattern (car x) pattern result result* ...)) - ((bind-pattern x (pattern1 . pattern2) result result* ...) - (bind-pattern (car x) pattern1 - (bind-pattern (cdr x) pattern2 result result* ...))) - ((bind-pattern x identifier result result* ...) - (let ((identifier x)) - result result* ...)))) - - (define-record-type <no-match> (make-no-match) no-match?) @@ -62,25 +27,28 @@ (begin result result* ...) (raise (make-no-match)))) ((match-pattern x (pattern) result result* ...) - (if (= 1 (length x)) - (match-pattern (car x) pattern result result* ...) - (raise (make-no-match)))) + (let ((y x)) + (if (= 1 (length y)) + (match-pattern (car y) pattern result result* ...) + (raise (make-no-match))))) ((match-pattern x (pattern . rest) result result* ...) - (if (pair? x) - (match-pattern (car x) pattern - (match-pattern (cdr x) rest result result* ...)) - (raise (make-no-match)))) + (let ((y x)) + (if (pair? y) + (match-pattern (car y) pattern + (match-pattern (cdr y) rest result result* ...)) + (raise (make-no-match))))) ((match-pattern x identifier result result* ...) (let ((identifier x)) result result* ...)))) (define-syntax match - (syntax-rules (when) - ((match x (pattern result result* ...)) + (syntax-rules () + ((match x (arm ...)) (guard (e ((no-match? e) (if #f #f))) - (match-pattern x pattern result result* ...))) - ((match x (pattern result result* ...) clause clause* ...) - (guard (e ((no-match? e) - (match x clause clause* ...))) - (match-pattern x pattern result result* ...))))))) + (match-pattern x arm ...))) + ((match x (arm ...) clause clause* ...) + (let ((y x)) + (guard (e ((no-match? e) + (match y clause clause* ...))) + (match-pattern y arm ...)))))))) |
