diff --git a/compile.rkt b/compile.rkt index 8ef8c50..8aeaa29 100644 --- a/compile.rkt +++ b/compile.rkt @@ -410,16 +410,7 @@ ;; Optimization: we put the result directly in the registers, or in ;; the appropriate spot on the stack. This takes into account the popenviroment ;; that happens right afterwards. - (cond [(eq? target 'val) - '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))]) + (adjust-target-depth target n) (make-ApplyPrimitiveProcedure n after-call)) ,(make-PopEnvironment n 0)))) @@ -496,8 +487,9 @@ 'return] [(symbol? linkage) after-body-code])] + [body-target : Target (adjust-target-depth target 1)] [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 linkage extended-cenv @@ -508,6 +500,18 @@ (make-instruction-sequence `(,(make-PopEnvironment 1 0))) 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))])) diff --git a/test-compiler.rkt b/test-compiler.rkt index bf47b8d..1de2f7e 100644 --- a/test-compiler.rkt +++ b/test-compiler.rkt @@ -491,6 +491,15 @@ 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] [y (+ x 1)] [z (+ x y)]) @@ -500,8 +509,7 @@ [z (+ x y)]) (list x y z))) (list (list 3 4 7) - (list 17 18 35)) - #:debug? #t) + (list 17 18 35)))