Write a first draft macro expander.

Committing it because it compiles. I have to write tests and debug
it still.

1 files changed, 17 insertions, 49 deletions

diff --git a/csc/match.csc b/csc/match.csc
index 86efab7..5b85f09 100644
--- a/csc/match.csc
+++ b/csc/match.csc
@@ -4,41 +4,6 @@
   (begin
 
 
-    (define-syntax matches?
-      (syntax-rules (_ !)
-        ((matches? x _) #t)
-        ((matches? x '())
-         (null? x))
-        ((matches? x (! constant))
-         (equal? x constant))
-        ((matches? x (pattern))
-         (and (= 1 (length x))
-              (matches? (car x) pattern)))
-        ((matches? x (pattern1 . pattern2))
-         (and (pair? x)
-              (matches? (car x) pattern1)
-              (matches? (cdr x) pattern2)))
-        ((matches? x identifier) #t)))
-
-
-    (define-syntax bind-pattern
-      (syntax-rules (_ !)
-        ((bind-pattern x _ result result* ...)
-         (begin result result* ...))
-        ((bind-pattern x '() result result* ...)
-         (begin result result* ...))
-        ((bind-pattern x (! constant) result result* ...)
-         (begin result result* ...))
-        ((bind-pattern x (pattern) result result* ...)
-         (bind-pattern (car x) pattern result result* ...))
-        ((bind-pattern x (pattern1 . pattern2) result result* ...)
-         (bind-pattern (car x) pattern1
-           (bind-pattern (cdr x) pattern2 result result* ...)))
-        ((bind-pattern x identifier result result* ...)
-         (let ((identifier x))
-           result result* ...))))
-
-
     (define-record-type <no-match>
       (make-no-match)
       no-match?)
@@ -62,25 +27,28 @@
            (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))))
+         (let ((y x))
+           (if (= 1 (length y))
+             (match-pattern (car y) 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))))
+         (let ((y x))
+           (if (pair? y)
+             (match-pattern (car y) pattern
+               (match-pattern (cdr y) 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 result result* ...))
+      (syntax-rules ()
+        ((match x (arm ...))
          (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* ...)))))))
+           (match-pattern x arm ...)))
+        ((match x (arm ...) clause clause* ...)
+         (let ((y x))
+           (guard (e ((no-match? e)
+                      (match y clause clause* ...)))
+             (match-pattern y arm ...))))))))