From 77583a881b03ce38c8065c40641489fe88b61eb2 Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Sun, 9 Jan 2022 22:55:59 -0800
Subject: Write the linker.

---
 match.csc | 51 ++++++++++++++++++---------------------------------
 1 file changed, 18 insertions(+), 33 deletions(-)

(limited to 'match.csc')

diff --git a/match.csc b/match.csc
index e5ee6ec..07ca98c 100644
--- a/match.csc
+++ b/match.csc
@@ -4,25 +4,13 @@
   (begin
 
 
-    ; From https://cookbook.scheme.org/check-for-symbol-in-syntax-rules/
-    (define-syntax symbol??
-      (syntax-rules ()
-        ((symbol?? (_ . _) _ kf) kf)  ; It's a pair, not a symbol.
-        ((symbol?? #(_ ...) _ kf) kf)  ; It's a vector, not a symbol.
-        ((symbol?? maybe-symbol kt kf)
-         (let-syntax
-           ((test
-              (syntax-rules ()
-                ((test maybe-symbol t _) t)
-                ((test _ _ f) f))))
-           (test abracadabra kt kf)))))
-
-
     (define-syntax matches?
-      (syntax-rules (_)
+      (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)))
@@ -30,28 +18,25 @@
          (and (pair? x)
               (matches? (car x) pattern1)
               (matches? (cdr x) pattern2)))
-        ((matches? x lit)
-         (symbol?? lit
-           #t
-           (equal? x lit)))))
+        ((matches? x identifier) #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 (pattern) result1 result2 ...)
-         (bind-pattern (car x) pattern result1 result2 ...))
-        ((bind-pattern x (pattern1 . pattern2) result1 result2 ...)
+      (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 result1 result2 ...)))
-        ((bind-pattern x lit result1 result2 ...)
-         (symbol?? lit
-           (let ((lit x))
-             result1 result2 ...)
-           (begin result1 result2 ...)))))
+           (bind-pattern (cdr x) pattern2 result result* ...)))
+        ((bind-pattern x identifier result result* ...)
+         (let ((identifier x))
+           result result* ...))))
 
 
     (define-syntax match
-- 
cgit v1.3.1