aboutsummaryrefslogtreecommitdiffstats
path: root/match.csc
diff options
context:
space:
mode:
authorRose Hogenson <rhogenson@posteo.net>2022-01-09 22:55:59 -0800
committerRose Hogenson <rhogenson@posteo.net>2022-01-09 22:55:59 -0800
commit77583a881b03ce38c8065c40641489fe88b61eb2 (patch)
treed4f65cfd698fee8e63168b4a5b64ab4123177fc3 /match.csc
parentRemove str- prefixes from the strings library. (diff)
downloadchromatopelma-77583a881b03ce38c8065c40641489fe88b61eb2.tar.zst
Write the linker.
Diffstat (limited to 'match.csc')
-rw-r--r--match.csc51
1 files changed, 18 insertions, 33 deletions
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