partial fix for issue #816

This commit is contained in:
Alex Shinn 2022-03-15 23:45:59 +09:00
parent 452b9a528d
commit 9fe1e69c23
2 changed files with 9 additions and 5 deletions

View file

@ -8,12 +8,12 @@
(import (rename (chibi) (import (rename (chibi)
(define-syntax %define-syntax) (define-syntax %define-syntax)
(let-syntax %let-syntax) (let-syntax %let-syntax)
(letrec-syntax %letrec-syntax) (letrec-syntax %letrec-syntax))
make-variable-transformer)
(only (chibi ast) (only (chibi ast)
env-cell macro? macro-aux macro-aux-set! env-cell macro? macro-aux macro-aux-set!
procedure-arity procedure-variadic? procedure-arity procedure-variadic?
procedure-variable-transformer?) procedure-variable-transformer?
make-variable-transformer)
(only (meta) environment) (only (meta) environment)
(srfi 1) (srfi 1)
(srfi 11) (srfi 11)

View file

@ -873,8 +873,12 @@
(set! count (+ count 1)) (set! count (+ count 1))
(rename (string->symbol (string-append s (%number->string count))))) (rename (string->symbol (string-append s (%number->string count)))))
(define (expand-pattern pat tmpl) (define (expand-pattern pat tmpl)
(let lp ((p (if (pair? pat) (cdr pat) pat)) (define full-match?
(x (if (pair? pat) (list _cdr _expr) _expr)) (or (not (pair? pat))
(and (compare (car pat) (rename 'set!))
(any (lambda (x) (compare x (rename 'set!))) lits))))
(let lp ((p (if full-match? pat (cdr pat)))
(x (if full-match? _expr (list _cdr _expr)))
(dim 0) (dim 0)
(vars '()) (vars '())
(k (lambda (vars) (k (lambda (vars)