aboutsummaryrefslogtreecommitdiffstats
path: root/match.csc
diff options
context:
space:
mode:
authorRose Hogenson <rhogenson@posteo.net>2022-01-11 22:01:23 -0800
committerRose Hogenson <rhogenson@posteo.net>2022-01-11 22:01:23 -0800
commit68986fe0410584c6934c835bb0ee784655f5f8c5 (patch)
treed51bc2f3e09df35ef81b7a0c462ff555b4344701 /match.csc
parentAdd a first implementation of a macro expander. (diff)
downloadchromatopelma-68986fe0410584c6934c835bb0ee784655f5f8c5.tar.zst
Move scheme compiler into a separate directory.
Diffstat (limited to 'match.csc')
-rw-r--r--match.csc60
1 files changed, 0 insertions, 60 deletions
diff --git a/match.csc b/match.csc
deleted file mode 100644
index 3e02937..0000000
--- a/match.csc
+++ /dev/null
@@ -1,60 +0,0 @@
-(define-library (csc match)
- (export match)
- (import (scheme base))
- (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-syntax match
- (syntax-rules (when)
- ((match x (pattern (when condition) result result* ...))
- (if (matches? x pattern)
- (bind-pattern x pattern
- (if condition
- (begin result result* ...)))))
- ((match x (pattern result1 result2 ...))
- (if (matches? x pattern)
- (bind-pattern x pattern result1 result2 ...)))
- ((match x (pattern (when condition) result result* ...) clause clause* ...)
- (if (and (matches? x pattern)
- (bind-pattern x pattern condition))
- (bind-pattern x pattern result result* ...)
- (match x clause clause* ...)))
- ((match x (pattern result1 result2 ...) clause1 clause2 ...)
- (if (matches? x pattern)
- (bind-pattern x pattern result1 result2 ...)
- (match x clause1 clause2 ...)))))))