From 93761a9804641c130172d5e9d55c283c053d781a Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Sun, 9 Jan 2022 13:16:56 -0800
Subject: Improve match syntax.

Now ! is required to match against a constant, and by default a name
is bound.
---
 match.csc | 38 ++++++++++++++++++++------------------
 1 file changed, 20 insertions(+), 18 deletions(-)

(limited to 'match.csc')

diff --git a/match.csc b/match.csc
index f6c9008..d128195 100644
--- a/match.csc
+++ b/match.csc
@@ -1,5 +1,5 @@
 (define-library (csc match)
-  (export match)
+  (export match matches?)
   (import (scheme base))
   (begin
 
@@ -7,34 +7,36 @@
     (define-syntax matches?
       (syntax-rules (! _)
         ((matches? x _) #t)
-        ((matches? x (! bind)) #t)
+        ((matches? x (! lit))
+         (eqv? x lit))
+        ((matches? x '())
+         (null? x))
         ((matches? x (pattern))
          (and (= 1 (length x))
-              (matches? (car x) pat)))
-        ((matches? x (pattern pattern1 pattern2 ...))
+              (matches? (car x) pattern)))
+        ((matches? x (pattern1 . pattern2))
          (and (pair? x)
-              (matches? (car x) pattern)
-              (matches? (cdr x) (pattern1 pattern2 ...))))
-        ((matches? x lit)
-         (eqv? lit x))))
+              (matches? (car x) pattern1)
+              (matches? (cdr x) pattern2)))
+        ((matches? x bind) #t)))
 
 
     (define-syntax bind-pattern
       (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 (! lit) result1 result2 ...)
+         (begin result1 result2 ...))
+        ((bind-pattern x '() result1 result2 ...)
+         (begin result1 result2 ...))
         ((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 result1 result2 ...)
-         (begin result1 result2 ...))))
+        ((bind-pattern x (pattern1 . pattern2) result1 result2 ...)
+         (bind-pattern (car x) pattern1
+           (bind-pattern (cdr x) pattern2 result1 result2 ...)))
+        ((bind-pattern x bind result1 result2 ...)
+         (let ((bind x))
+           result1 result2 ...))))
 
 
     (define-syntax match
-- 
cgit v1.3.1