1 files changed, 43 insertions, 17 deletions
diff --git a/csc/match.csc b/csc/match.csc
index 3e02937..86efab7 100644
--- a/csc/match.csc
+++ b/csc/match.csc
@@ -39,22 +39,48 @@
            result result* ...))))
 
 
+    (define-record-type <no-match>
+      (make-no-match)
+      no-match?)
+
+
+    (define-syntax match-pattern
+      (syntax-rules (_ ! when)
+        ((match-pattern x pattern (when condition) result result* ...)
+         (match-pattern x pattern
+           (if condition
+             (begin result result* ...)
+             (raise (make-no-match)))))
+        ((match-pattern x _ result result* ...)
+         (begin result result* ...))
+        ((match-pattern x '() result result* ...)
+         (if (null? x)
+           (begin result result* ...)
+           (raise (make-no-match))))
+        ((match-pattern x (! constant) result result* ...)
+         (if (equal? x constant)
+           (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))))
+        ((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))))
+        ((match-pattern x identifier result result* ...)
+         (let ((identifier x))
+           result result* ...))))
+
+
     (define-syntax match
       (syntax-rules (when)
-        ((match x (pattern (when condition) result result* ...))
-         (if (matches? x pattern)
-           (bind-pattern x pattern
-             (if condition
-               (begin result result* ...)))))
-        ((match x (pattern result1 result2 ...))
-         (if (matches? x pattern)
-           (bind-pattern x pattern result1 result2 ...)))
-        ((match x (pattern (when condition) result result* ...) clause clause* ...)
-         (if (and (matches? x pattern)
-                  (bind-pattern x pattern condition))
-           (bind-pattern x pattern result result* ...)
-           (match x clause clause* ...)))
-        ((match x (pattern result1 result2 ...) clause1 clause2 ...)
-         (if (matches? x pattern)
-           (bind-pattern x pattern result1 result2 ...)
-           (match x clause1 clause2 ...)))))))
+        ((match x (pattern result result* ...))
+         (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* ...)))))))