Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-08 13:37:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

fixing naming conflicts arising from nested syntax-rules ellpisis

Browse source
This commit is contained in:
Alex Shinn 2011-02-22 22:32:55 +09:00
parent 700e92cb88
commit d7c6275b07
1 changed files with 13 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
lib/init.scm
View file

@ -620,18 +620,17 @@
(_quote (rename 'syntax-quote)) (_apply (rename 'apply)) (_quote (rename 'syntax-quote)) (_apply (rename 'apply))
(_append (rename 'append)) (_map (rename 'map)) (_append (rename 'append)) (_map (rename 'map))
(_vector? (rename 'vector?)) (_list? (rename 'list?)) (_vector? (rename 'vector?)) (_list? (rename 'list?))
(_lp (rename 'lp)) (_reverse (rename 'reverse))
(_len (rename'len)) (_length (rename 'length)) (_len (rename'len)) (_length (rename 'length))
(_- (rename '-)) (_>= (rename '>=)) (_error (rename 'error)) (_- (rename '-)) (_>= (rename '>=)) (_error (rename 'error))
(_ls (rename 'ls)) (_res (rename 'res)) (_i (rename 'i)) (_ls (rename 'ls)) (_res (rename 'res)) (_i (rename 'i))
(_vector->list (rename 'vector->list)) (_reverse (rename 'reverse)) (_vector->list (rename 'vector->list))
(_list->vector (rename 'list->vector))) (_list->vector (rename 'list->vector)))
(define ellipse (rename (if ellipse-specified? (cadr expr) '...))) (define ellipse (rename (if ellipse-specified? (cadr expr) '...)))
(define lits (if ellipse-specified? (caddr expr) (cadr expr))) (define lits (if ellipse-specified? (caddr expr) (cadr expr)))
(define forms (if ellipse-specified? (cdddr expr) (cddr expr))) (define forms (if ellipse-specified? (cdddr expr) (cddr expr)))
(define (next-v) (define (next-symbol s)
(set! count (+ count 1)) (set! count (+ count 1))
(rename (string->symbol (string-append "v." (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 (cdr pat)) (let lp ((p (cdr pat))
(x (list _cdr _expr)) (x (list _cdr _expr))
@ -640,7 +639,7 @@
(k (lambda (vars) (k (lambda (vars)
(or (expand-template tmpl vars) (or (expand-template tmpl vars)
(list _begin #f))))) (list _begin #f)))))
(let ((v (next-v))) (let ((v (next-symbol "v.")))
(list (list
_let (list (list v x)) _let (list (list v x))
(cond (cond
@ -658,7 +657,8 @@
(cddr p)) (cddr p))
(error "multiple ellipses" p)) (error "multiple ellipses" p))
(else (else
(let ((len (length (cdr (cdr p))))) (let ((len (length (cdr (cdr p))))
(_lp (next-symbol "lp.")))
`(,_let ((,_len (,_length ,v))) `(,_let ((,_len (,_length ,v)))
(,_and (,_>= ,_len ,len) (,_and (,_>= ,_len ,len)
(,_let ,_lp ((,_ls ,v) (,_let ,_lp ((,_ls ,v)
@ -678,15 +678,15 @@
(list _let (list (list (car p) v)) (list _let (list (list (car p) v))
(k (cons (cons (car p) (+ 1 dim)) vars))))) (k (cons (cons (car p) (+ 1 dim)) vars)))))
(else (else
(let* ((w (next-v)) (let* ((w (next-symbol "w."))
(_lp (next-symbol "lp."))
(new-vars (all-vars (car p) (+ dim 1))) (new-vars (all-vars (car p) (+ dim 1)))
(ls-vars (map (lambda (x) (ls-vars (map (lambda (x)
(rename (next-symbol
(string->symbol
(string-append (string-append
(symbol->string (symbol->string
(identifier->symbol (car x))) (identifier->symbol (car x)))
"-ls")))) "-ls")))
new-vars)) new-vars))
(once (once
(lp (car p) (list _car w) (+ dim 1) '() (lp (car p) (list _car w) (+ dim 1) '()