diff options
Diffstat (limited to 'csc/match.csc')
| -rw-r--r-- | csc/match.csc | 58 |
1 files changed, 31 insertions, 27 deletions
diff --git a/csc/match.csc b/csc/match.csc index 96ec4d3..4db0d07 100644 --- a/csc/match.csc +++ b/csc/match.csc @@ -29,39 +29,43 @@ (define-syntax match-pattern - (syntax-rules (_ ! when %) + (syntax-rules (% _ quote when) ((match-pattern x pattern when condition result result* ...) - (match-pattern x pattern - (if condition - (let () result result* ...) - (raise *no-match*)))) + (match-pattern x pattern + (unless condition + (raise *no-match*)) + result result* ...)) ((match-pattern x _ result result* ...) - (let () result result* ...)) - ((match-pattern x '() result result* ...) - (if (null? x) - (let () result result* ...) - (raise *no-match*))) - ((match-pattern x (! constant) result result* ...) - (if (equal? x constant) - (let () result result* ...) - (raise *no-match*))) - ((match-pattern x (pattern) result result* ...) - (let ((y x)) - (if (= 1 (length y)) - (match-pattern (car y) pattern result result* ...) - (raise *no-match*)))) + (let () result result* ...)) + ((match-pattern x (quote constant) result result* ...) + (let () + (unless (equal? x (quote constant)) + (raise *no-match*)) + result result* ...)) + ((match-pattern x (% record-matcher) result result* ...) + (let () + (record-matcher x) + result result* ...)) ((match-pattern x (% record-matcher . patterns) result result* ...) (let ((x* (record-matcher x))) - (match-pattern (map cdr (cdr (record-matcher x))) patterns result result* ...))) + (match-pattern (map cdr (cdr x*)) patterns result result* ...))) + ((match-pattern x () result* ...) + (syntax-error "Unexpected pattern (). Use '() to match nil.")) + ((match-pattern x (pattern) result result* ...) + (let ((y x)) + (unless (and (pair? y) + (null? (cdr y))) + (raise *no-match*)) + (match-pattern (car y) pattern result result* ...))) ((match-pattern x (pattern . rest) result result* ...) - (let ((y x)) - (if (pair? y) - (match-pattern (car y) pattern - (match-pattern (cdr y) rest result result* ...)) - (raise *no-match*)))) + (let ((y x)) + (unless (pair? y) + (raise *no-match*)) + (match-pattern (car y) pattern + (match-pattern (cdr y) rest result result* ...)))) ((match-pattern x identifier result result* ...) - (let ((identifier x)) - result result* ...)))) + (let ((identifier x)) + result result* ...)))) (define-syntax match |
