Simplify macro definitions in match.

1 files changed, 9 insertions, 31 deletions

diff --git a/match.csc b/match.csc
index 4d5f031..f6c9008 100644
--- a/match.csc
+++ b/match.csc
@@ -6,27 +6,14 @@
 
     (define-syntax matches?
       (syntax-rules (! _)
-        ((matches? x '())
-         (null? x))
         ((matches? x _) #t)
-        ((matches? x (! bind))
-         #t)
-        ((matches? x (_))
-         (= 1 (length x)))
-        ((matches? x ((! bind)))
-         (= 1 (length x)))
-        ((matches? x (lit))
+        ((matches? x (! bind)) #t)
+        ((matches? x (pattern))
          (and (= 1 (length x))
-              (eqv? lit (car x))))
-        ((matches? x (_ pattern1 pattern2 ...))
+              (matches? (car x) pat)))
+        ((matches? x (pattern pattern1 pattern2 ...))
          (and (pair? x)
-              (matches? (cdr x) (pattern1 pattern2 ...))))
-        ((matches? x ((! bind) pattern1 pattern2 ...))
-         (and (pair? x)
-              (matches? (cdr x) (pattern1 pattern2 ...))))
-        ((matches? x (lit pattern1 pattern2 ...))
-         (and (pair? x)
-              (eqv? lit (car x))
+              (matches? (car x) pattern)
               (matches? (cdr x) (pattern1 pattern2 ...))))
         ((matches? x lit)
          (eqv? lit x))))
@@ -41,20 +28,11 @@
         ((bind-pattern x (! bind) result1 result2 ...)
          (let ((bind x))
            result1 result2 ...))
-        ((bind-pattern x (_) result1 result2 ...)
-         (begin result1 result2 ...))
-        ((bind-pattern x ((! bind)) result1 result2 ...)
-         (let ((bind (car x)))
-           result1 result2 ...))
-        ((bind-pattern x (lit) result1 result2 ...)
-         (begin result1 result2 ...))
-        ((bind-pattern x (_ pattern1 pattern2 ...) result1 result2 ...)
-         (bind-pattern (cdr x) (pattern1 pattern2 ...) result1 result2 ...))
-        ((bind-pattern x ((! bind) pattern1 pattern2 ...) result1 result2 ...)
-         (let ((bind (car x)))
+        ((bind-pattern x (pattern) result1 result2 ...)
+         (bind-pattern (car x) pattern result1 result2 ...))
+        ((bind-pattern x (pattern pattern1 pattern2 ...) result1 result2 ...)
+         (bind-pattern (car x) pattern
            (bind-pattern (cdr x) (pattern1 pattern2 ...) result1 result2 ...)))
-        ((bind-pattern x (lit pattern1 pattern2 ...) result1 result2 ...)
-         (bind-pattern (cdr x) (pattern1 pattern2 ...) result1 result2 ...))
         ((bind-pattern x lit result1 result2 ...)
          (begin result1 result2 ...))))