diff options
Diffstat (limited to 'match.csc')
| -rw-r--r-- | match.csc | 51 |
1 files changed, 18 insertions, 33 deletions
@@ -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 |
