suzanne.soy/whalesong
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

found that the documentation for let-rec's behavior in 5.1.1 is off: the closures are installed in reverse order, but the first element is what's on the stack, not the last.

Browse Source
This commit is contained in:
Danny Yoo 2011-05-12 15:27:04 -04:00
parent 882b228ae8
commit d7d4abec59
3 changed files with 40 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
compiler.rkt
View File

@ -128,7 +128,7 @@
(append (build-list (length (LetRec-procs exp))
(lambda: ([i : Natural]) '?))
(drop cenv n))))
(reverse (LetRec-procs exp)))
(LetRec-procs exp))
(drop cenv n))])
(append (apply append
(map (lambda: ([lam : Lam])
@ -1678,7 +1678,7 @@
(lambda: ([i : Natural])
'?))
(drop cenv n))))
(reverse (LetRec-procs exp)))
(LetRec-procs exp))
(drop cenv n))]
[n : Natural (length (LetRec-procs exp))]
[after-body-code : Symbol (make-label 'afterBodyCode)]
@ -1700,7 +1700,7 @@
extended-cenv
(append-instruction-sequences
;; Install each of the closure shells
;; Install each of the closure shells.
(apply append-instruction-sequences
(map (lambda: ([lam : Lam]
[i : Natural])
@ -1709,7 +1709,7 @@
(make-EnvLexicalReference i #f)
next-linkage/expects-single))
(LetRec-procs exp)
(build-list n (lambda: ([i : Natural]) (ensure-natural (- n 1 i))))))
(build-list n (lambda: ([i : Natural]) i))))
;; Fix the closure maps of each
(apply append-instruction-sequences
@ -1720,7 +1720,7 @@
(make-FixClosureShellMap! i (Lam-closure-map lam))))))
(LetRec-procs exp)
(build-list n (lambda: ([i : Natural]) (ensure-natural (- n 1 i))))))
(build-list n (lambda: ([i : Natural]) i))))
;; Compile the body
(compile (LetRec-body exp) extended-cenv target letrec-linkage)

4
expression-structs.rkt
View File

@ -107,6 +107,10 @@
[body : Expression]
[boxes? : Boolean]) #:transparent)
;; During evaluation, the closures corresponding to procs are expected
;; to be laid out so that stack position 0 corresponds to procs[0],
;; stack position 1 to procs[1], and so on.
(define-struct: LetRec ([procs : (Listof Lam)]
[body : Expression]) #:transparent)

62
test-compiler.rkt
View File

@ -387,37 +387,37 @@
;; deriv
#;(test '(let ()
(define (deriv-aux a) (list '/ (deriv a) a))
(define (map f l)
(if (null? l)
l
(cons (f (car l))
(map f (cdr l)))))
(define (deriv a)
(if (not (pair? a))
(if (eq? a 'x) 1 0)
(if (eq? (car a) '+)
(cons '+ (map deriv (cdr a)))
(if (eq? (car a) '-)
(cons '- (map deriv (cdr a)))
(if (eq? (car a) '*)
(list '*
a
(cons '+ (map deriv-aux (cdr a))))
(if (eq? (car a) '/)
(list '-
(list '/
(deriv (cadr a))
(caddr a))
(list '/
(cadr a)
(list '*
(caddr a)
(caddr a)
(deriv (caddr a)))))
'error))))))
(deriv '(+ (* 3 x x) (* a x x) (* b x) 5)))
(test '(let ()
(define (deriv-aux a) (list '/ (deriv a) a))
(define (map f l)
(if (null? l)
l
(cons (f (car l))
(map f (cdr l)))))
(define (deriv a)
(if (not (pair? a))
(if (eq? a 'x) 1 0)
(if (eq? (car a) '+)
(cons '+ (map deriv (cdr a)))
(if (eq? (car a) '-)
(cons '- (map deriv (cdr a)))
(if (eq? (car a) '*)
(list '*
a
(cons '+ (map deriv-aux (cdr a))))
(if (eq? (car a) '/)
(list '-
(list '/
(deriv (cadr a))
(caddr a))
(list '/
(cadr a)
(list '*
(caddr a)
(caddr a)
(deriv (caddr a)))))
'error))))))
(deriv '(+ (* 3 x x) (* a x x) (* b x) 5)))
'(+ (* (* 3 x x) (+ (/ 0 3) (/ 1 x) (/ 1 x)))
(* (* a x x) (+ (/ 0 a) (/ 1 x) (/ 1 x)))
(* (* b x) (+ (/ 0 b) (/ 1 x)))