Add wildcard to pattern syntax.

2 files changed, 25 insertions, 7 deletions

diff --git a/match-test.csc b/match-test.csc
index 3fed862..2728e44 100644
--- a/match-test.csc
+++ b/match-test.csc
@@ -18,7 +18,7 @@
                      (1 1)
                      (2 2)
                      (3 3)
-                     (else 4))
+                     (_ 4))
                    3)
                  (test-case
                    "match-list"
@@ -27,12 +27,20 @@
                      ((1 2) 1)
                      ((1 2 3) 2)
                      ((1 2 3 4) 3)
-                     (else 4))
+                     (_ 4))
                    2)
                  (test-case
                    "binding"
                    (match '(1 2 3)
                      ((1 (! x) 3) x))
+                   2)
+                 (test-case
+                   "ignore"
+                   (match '(1 2 3)
+                     ((_ _ _ _) 0)
+                     ((2 _ _) 1)
+                     ((1 _ _) 2)
+                     (_ 3))
                    2))))
     (for-each
       (lambda (tc)
diff --git a/match.csc b/match.csc
index 95b2b32..4d5f031 100644
--- a/match.csc
+++ b/match.csc
@@ -5,16 +5,22 @@
 
 
     (define-syntax matches?
-      (syntax-rules (!)
+      (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))
          (and (= 1 (length x))
               (eqv? lit (car x))))
+        ((matches? x (_ pattern1 pattern2 ...))
+         (and (pair? x)
+              (matches? (cdr x) (pattern1 pattern2 ...))))
         ((matches? x ((! bind) pattern1 pattern2 ...))
          (and (pair? x)
               (matches? (cdr x) (pattern1 pattern2 ...))))
@@ -27,17 +33,23 @@
 
 
     (define-syntax bind-pattern
-      (syntax-rules (!)
+      (syntax-rules (! _)
         ((bind-pattern x '() result1 result2 ...)
          (begin result1 result2 ...))
+        ((bind-pattern x _ result1 result2 ...)
+         (begin result1 result2 ...))
         ((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 (cdr x) (pattern1 pattern2 ...) result1 result2 ...)))
@@ -48,9 +60,7 @@
 
 
     (define-syntax match
-      (syntax-rules (else)
-        ((match x (else result1 result2 ...))
-         (begin result1 result2 ...))
+      (syntax-rules ()
         ((match x (pattern result1 result2 ...))
          (if (matches? x pattern)
            (bind-pattern x pattern result1 result2 ...)))