named let evaluates the initial bindings outside the scope of the loop

(fixes 8.2 in r5rs_pitfalls.scm)
This commit is contained in:
Alex Shinn 2010-05-15 13:07:01 +09:00
parent f8a3296372
commit 14c4d0b57d

View file

@ -219,13 +219,17 @@
(if (every (lambda (x) (if (every (lambda (x)
(if (pair? x) (if (pair? (cdr x)) (null? (cddr x)) #f) #f)) (if (pair? x) (if (pair? (cdr x)) (null? (cddr x)) #f) #f))
bindings) bindings)
((lambda (vars vals)
(if (identifier? (cadr expr)) (if (identifier? (cadr expr))
`(,(rename 'letrec) ((,(cadr expr) `((,(rename 'lambda) ,vars
(,(rename 'lambda) ,(map car bindings) (,(rename 'letrec) ((,(cadr expr)
(,(rename 'lambda) ,vars
,@(cdddr expr)))) ,@(cdddr expr))))
,(cons (cadr expr) (map cadr bindings))) (,(cadr expr) ,@vars)))
`((,(rename 'lambda) ,(map car bindings) ,@(cddr expr)) ,@vals)
,@(map cadr bindings))) `((,(rename 'lambda) ,vars ,@(cddr expr)) ,@vals)))
(map car bindings)
(map cadr bindings))
(error "bad let syntax" expr))) (error "bad let syntax" expr)))
(if (identifier? (cadr expr)) (caddr expr) (cadr expr)))))) (if (identifier? (cadr expr)) (caddr expr) (cadr expr))))))