Improve the match syntax for constants.

I guess you can pattern match using quote as a literal.
That's pretty cool.

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