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

let* is doing something

Browse Source
This commit is contained in:
Danny Yoo 2011-03-11 14:59:00 -05:00
parent 5de82cdecf
commit e3ff7ce382
2 changed files with 25 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
compile.rkt
View File

@ -410,16 +410,7 @@
;; Optimization: we put the result directly in the registers, or in ;; Optimization: we put the result directly in the registers, or in
;; the appropriate spot on the stack. This takes into account the popenviroment ;; the appropriate spot on the stack. This takes into account the popenviroment
;; that happens right afterwards. ;; that happens right afterwards.
(cond [(eq? target 'val) (adjust-target-depth target n)
'val]
[(eq? target 'proc)
'proc]
[(EnvLexicalReference? target)
;; The optimization is right here.
(make-EnvLexicalReference (+ (EnvLexicalReference-depth target) n))]
[(EnvPrefixReference? target)
;; The optimization is right here.
(make-EnvPrefixReference (+ (EnvPrefixReference-depth target) n) (EnvPrefixReference-pos target))])
(make-ApplyPrimitiveProcedure n after-call)) (make-ApplyPrimitiveProcedure n after-call))
,(make-PopEnvironment n 0)))) ,(make-PopEnvironment n 0))))
@ -496,8 +487,9 @@
'return] 'return]
[(symbol? linkage) [(symbol? linkage)
after-body-code])] after-body-code])]
[body-target : Target (adjust-target-depth target 1)]
[body-code : InstructionSequence [body-code : InstructionSequence
(compile (Let1-body exp) extended-cenv target let-linkage)]) (compile (Let1-body exp) extended-cenv body-target let-linkage)])
(end-with-linkage (end-with-linkage
linkage linkage
extended-cenv extended-cenv
@ -508,6 +500,18 @@
(make-instruction-sequence `(,(make-PopEnvironment 1 0))) (make-instruction-sequence `(,(make-PopEnvironment 1 0)))
after-let1)))) after-let1))))
(: adjust-target-depth (Target Natural -> Target))
(define (adjust-target-depth target n)
(cond
[(eq? target 'val)
target]
[(eq? target 'proc)
target]
[(EnvLexicalReference? target)
(make-EnvLexicalReference (+ n (EnvLexicalReference-depth target)))]
[(EnvPrefixReference? target)
(make-EnvPrefixReference (+ n (EnvPrefixReference-depth target))
(EnvPrefixReference-pos target))]))

12
test-compiler.rkt
View File

@ -491,6 +491,15 @@
24) 24)
(test (list (let* ([x 3]
[y (+ x 1)]
[z (+ x y)])
(list x y z))
4)
(list (list 3 4 7)
4))
(test (list (let* ([x 3] (test (list (let* ([x 3]
[y (+ x 1)] [y (+ x 1)]
[z (+ x y)]) [z (+ x y)])
@ -500,8 +509,7 @@
[z (+ x y)]) [z (+ x y)])
(list x y z))) (list x y z)))
(list (list 3 4 7) (list (list 3 4 7)
(list 17 18 35)) (list 17 18 35)))
#:debug? #t)