diff options
Diffstat (limited to 'match.csc')
| -rw-r--r-- | match.csc | 37 |
1 files changed, 26 insertions, 11 deletions
@@ -1,14 +1,26 @@ (define-library (csc match) - (export match matches?) + (export match) (import (scheme base)) (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 (! lit)) - (eqv? x lit)) ((matches? x '()) (null? x)) ((matches? x (pattern)) @@ -18,15 +30,16 @@ (and (pair? x) (matches? (car x) pattern1) (matches? (cdr x) pattern2))) - ((matches? x bind) #t))) + ((matches? x lit) + (symbol?? lit + #t + (equal? x lit))))) (define-syntax bind-pattern - (syntax-rules (! _) + (syntax-rules (_) ((bind-pattern x _ result1 result2 ...) (begin 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 ...) @@ -34,9 +47,11 @@ ((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 ...)))) + ((bind-pattern x lit result1 result2 ...) + (symbol?? lit + (let ((lit x)) + result1 result2 ...) + (begin result1 result2 ...))))) (define-syntax match |