diff options
| -rw-r--r-- | match.csc | 40 |
1 files changed, 9 insertions, 31 deletions
@@ -6,27 +6,14 @@ (define-syntax matches? (syntax-rules (! _) - ((matches? x '()) - (null? x)) ((matches? x _) #t) - ((matches? x (! bind)) - #t) - ((matches? x (_)) - (= 1 (length x))) - ((matches? x ((! bind))) - (= 1 (length x))) - ((matches? x (lit)) + ((matches? x (! bind)) #t) + ((matches? x (pattern)) (and (= 1 (length x)) - (eqv? lit (car x)))) - ((matches? x (_ pattern1 pattern2 ...)) + (matches? (car x) pat))) + ((matches? x (pattern pattern1 pattern2 ...)) (and (pair? x) - (matches? (cdr x) (pattern1 pattern2 ...)))) - ((matches? x ((! bind) pattern1 pattern2 ...)) - (and (pair? x) - (matches? (cdr x) (pattern1 pattern2 ...)))) - ((matches? x (lit pattern1 pattern2 ...)) - (and (pair? x) - (eqv? lit (car x)) + (matches? (car x) pattern) (matches? (cdr x) (pattern1 pattern2 ...)))) ((matches? x lit) (eqv? lit x)))) @@ -41,20 +28,11 @@ ((bind-pattern x (! bind) result1 result2 ...) (let ((bind x)) result1 result2 ...)) - ((bind-pattern x (_) result1 result2 ...) - (begin result1 result2 ...)) - ((bind-pattern x ((! bind)) result1 result2 ...) - (let ((bind (car x))) - result1 result2 ...)) - ((bind-pattern x (lit) result1 result2 ...) - (begin result1 result2 ...)) - ((bind-pattern x (_ pattern1 pattern2 ...) result1 result2 ...) - (bind-pattern (cdr x) (pattern1 pattern2 ...) result1 result2 ...)) - ((bind-pattern x ((! bind) pattern1 pattern2 ...) result1 result2 ...) - (let ((bind (car x))) + ((bind-pattern x (pattern) result1 result2 ...) + (bind-pattern (car x) pattern result1 result2 ...)) + ((bind-pattern x (pattern pattern1 pattern2 ...) result1 result2 ...) + (bind-pattern (car x) pattern (bind-pattern (cdr x) (pattern1 pattern2 ...) result1 result2 ...))) - ((bind-pattern x (lit pattern1 pattern2 ...) result1 result2 ...) - (bind-pattern (cdr x) (pattern1 pattern2 ...) result1 result2 ...)) ((bind-pattern x lit result1 result2 ...) (begin result1 result2 ...)))) |