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

4
expression-structs.rkt
View File

@ -107,6 +107,10 @@
[body : Expression] [body : Expression]
[boxes? : Boolean]) #:transparent) [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)] (define-struct: LetRec ([procs : (Listof Lam)]
[body : Expression]) #:transparent) [body : Expression]) #:transparent)

62
test-compiler.rkt
View File

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