diff --git a/piclib/syntax-rules.scm b/piclib/syntax-rules.scm index 226e44a1..62f646ea 100644 --- a/piclib/syntax-rules.scm +++ b/piclib/syntax-rules.scm @@ -54,11 +54,13 @@ (define _lambda (r 'lambda)) (define _set! (r 'set!)) (define _not (r 'not)) + (define _and (r 'and)) (define _car (r 'car)) (define _cdr (r 'cdr)) (define _cons (r 'cons)) (define _pair? (r 'pair?)) (define _null? (r 'null?)) + (define _symbol? (r 'symbol?)) (define _eqv? (r 'eqv?)) (define _map (r 'map)) (define _quote (r 'quote)) @@ -72,12 +74,12 @@ (define (compile-match ellipsis literals pattern) (letrec ((compile-match-base (lambda (pattern) - (cond ((eq? pattern '_) (values #f '())) + (cond ((compare pattern (r '_)) (values #f '())) ((member pattern literals) (values - `(,_if (cmp ',pattern (rename expr)) - (exit #f) - #f) + `(,_if (,_and (,_symbol? expr) (cmp expr (rename ',pattern))) + #f + (exit #f)) '())) ((eq? pattern ellipsis) (values `(,_syntax-error "invalid pattern") '())) @@ -119,7 +121,7 @@ (values `(,_begin ,@(reverse matches) (,_let ((expr (,_let loop ((a ()) - (d expr)) + (d ,accessor)) (,_if (,_pair? d) (loop (,_cons (,_car d) a) (,_cdr d)) (,_cons d a)))))