diff --git a/lib/chibi/syntax-case.scm b/lib/chibi/syntax-case.scm index db66689c..f0b80d21 100644 --- a/lib/chibi/syntax-case.scm +++ b/lib/chibi/syntax-case.scm @@ -61,6 +61,10 @@ ((letrec-syntax ((keyword transformer) ...) . body) (%letrec-syntax ((keyword (make-transformer transformer)) ...) . body)))) +(define-record-type Pattern-Cell + (make-pattern-cell val) pattern-cell? + (val pattern-cell-value)) + (define-syntax define-pattern-variable (er-macro-transformer (lambda (expr rename compare) @@ -68,7 +72,7 @@ (binding (cddr expr))) (let ((cell (env-cell (current-usage-environment) id))) (if cell - (macro-aux-set! (cdr cell) binding))) + (macro-aux-set! (cdr cell) (make-pattern-cell binding)))) (rename '(begin)))))) (define (make-pattern-variable pvar) @@ -76,8 +80,13 @@ (error "reference to pattern variable outside syntax" pvar))) (define (pattern-variable x) - (let ((cell (env-cell (current-usage-environment) x))) - (and cell (macro? (cdr cell)) (macro-aux (cdr cell))))) + (and-let* + ((cell (env-cell (current-usage-environment) x)) + (cell-ref (cdr cell)) + ((macro? cell-ref)) + (aux (macro-aux cell-ref)) + ((pattern-cell? aux))) + (pattern-cell-value aux))) (define (rename id) ((current-renamer) id)) diff --git a/lib/chibi/syntax-case.sld b/lib/chibi/syntax-case.sld index 65aac46f..a12a7316 100644 --- a/lib/chibi/syntax-case.sld +++ b/lib/chibi/syntax-case.sld @@ -16,6 +16,8 @@ make-variable-transformer) (only (meta) environment) (srfi 1) + (srfi 2) + (srfi 9) (srfi 11) (srfi 39)) (include "syntax-case.scm"))