diff --git a/compile.rkt b/compile.rkt index e480661..943a575 100644 --- a/compile.rkt +++ b/compile.rkt @@ -602,22 +602,7 @@ after-letrec)))) -(: 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)) - (EnvLexicalReference-unbox? target))] - [(EnvPrefixReference? target) - (make-EnvPrefixReference (+ n (EnvPrefixReference-depth target)) - (EnvPrefixReference-pos target) - (EnvPrefixReference-name target))] - [(PrimitivesReference? target) - target])) + @@ -644,3 +629,21 @@ (error 'ensure-natural "Not a natural: ~s\n" n))) + + +(: 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)) + (EnvLexicalReference-unbox? target))] + [(EnvPrefixReference? target) + (make-EnvPrefixReference (+ n (EnvPrefixReference-depth target)) + (EnvPrefixReference-pos target) + (EnvPrefixReference-name target))] + [(PrimitivesReference? target) + target])) diff --git a/expression-structs.rkt b/expression-structs.rkt index 28d8002..6f83d7b 100644 --- a/expression-structs.rkt +++ b/expression-structs.rkt @@ -9,7 +9,10 @@ ToplevelRef LocalRef ToplevelSet Branch Lam Seq App - Let1 Let LetRec)) + Let1 + LetVoid + InstallValue + #;LetRec)) (define-struct: Top ([prefix : Prefix] [code : ExpressionCore]) #:transparent) @@ -43,16 +46,19 @@ (define-struct: Let1 ([rhs : ExpressionCore] [body : ExpressionCore]) #:transparent) -(define-struct: Let ([count : Natural] - [rhss : (Listof ExpressionCore)] - [body : ExpressionCore]) +(define-struct: LetVoid ([count : Natural] + [body : ExpressionCore]) #:transparent) -(define-struct: LetRec ([count : Natural] - [rhss : (Listof Lam)] - [body : ExpressionCore]) +(define-struct: InstallValue ([depth : Natural] + [body : ExpressionCore]) #:transparent) +#;(define-struct: LetRec ([count : Natural] + [rhss : (Listof Lam)] + [body : ExpressionCore]) + #:transparent) + diff --git a/lexical-env.rkt b/lexical-env.rkt index a04a8d8..6a00407 100644 --- a/lexical-env.rkt +++ b/lexical-env.rkt @@ -10,7 +10,8 @@ extend-lexical-environment/placeholders collect-lexical-references lexical-references->compile-time-environment - place-prefix-mask) + place-prefix-mask + adjust-env-reference-depth) ;; Find where the variable is located in the lexical environment @@ -169,4 +170,19 @@ n #f)] [else n])) - (Prefix-names a-prefix)))) \ No newline at end of file + (Prefix-names a-prefix)))) + + + +(: adjust-env-reference-depth (EnvReference Natural -> EnvReference)) +(define (adjust-env-reference-depth target n) + (cond + [(EnvLexicalReference? target) + (make-EnvLexicalReference (+ n (EnvLexicalReference-depth target)) + (EnvLexicalReference-unbox? target))] + [(EnvPrefixReference? target) + (make-EnvPrefixReference (+ n (EnvPrefixReference-depth target)) + (EnvPrefixReference-pos target) + (EnvPrefixReference-name target))] + [(EnvWholePrefixReference? target) + (make-EnvWholePrefixReference (+ n (EnvWholePrefixReference-depth target)))])) diff --git a/parse.rkt b/parse.rkt index 083d93f..84aa38b 100644 --- a/parse.rkt +++ b/parse.rkt @@ -286,10 +286,14 @@ (extend-lexical-environment/names cenv (list (first vars)))))] [else (let ([rhs-cenv (extend-lexical-environment/placeholders cenv (length vars))]) - (make-Let (length vars) - (map (lambda (rhs) (parse rhs rhs-cenv)) rhss) - (parse `(begin ,@body) - (extend-lexical-environment/names cenv vars))))]))) + (make-LetVoid (length vars) + (make-Seq (append + (map (lambda (rhs index) + (make-InstallValue index (parse rhs rhs-cenv))) + rhss + (build-list (length rhss) (lambda (i) i))) + (list (parse `(begin ,@body) + (extend-lexical-environment/names cenv vars)))))))]))) (define (parse-letrec exp cenv) (let ([vars (let-variables exp)] @@ -300,9 +304,13 @@ (parse `(begin ,@body) cenv)] [else (let ([new-cenv (extend-lexical-environment/names cenv vars)]) - (make-LetRec (length vars) - (map (lambda (rhs) (parse rhs new-cenv)) rhss) - (parse `(begin ,@body) new-cenv)))]))) + (make-LetVoid (length vars) + (make-Seq (append + (map (lambda (rhs index) + (make-InstallValue index (parse rhs new-cenv))) + rhss + (build-list (length rhss (lambda (i) i)))) + (list (parse `(begin ,@body) new-cenv))))))]))) (define (desugar-let* exp) diff --git a/test-parse.rkt b/test-parse.rkt index 09474fc..843d26a 100644 --- a/test-parse.rkt +++ b/test-parse.rkt @@ -209,11 +209,11 @@ x y)) (make-Top (make-Prefix '()) - (make-Let 2 - (list (make-Constant 3) - (make-Constant 4)) - (make-Seq (list (make-LocalRef 0) - (make-LocalRef 1)))))) + (make-LetVoid 2 + (make-Seq (list (make-InstallValue 0 (make-Constant 3)) + (make-InstallValue 1 (make-Constant 4)) + (make-Seq (list (make-LocalRef 0) + (make-LocalRef 1)))))))) (test (parse '(let ([x 3] [y 4]) @@ -222,13 +222,14 @@ x y))) (make-Top (make-Prefix '()) - (make-Let 2 - (list (make-Constant 3) (make-Constant 4)) - (make-Let 2 - (list (make-LocalRef 3) - (make-LocalRef 2)) - (make-Seq (list (make-LocalRef 0) - (make-LocalRef 1))))))) + (make-LetVoid 2 + (make-Seq (list (make-InstallValue 0 (make-Constant 3)) + (make-InstallValue 1 (make-Constant 4)) + (make-LetVoid 2 + (make-Seq (list (make-InstallValue 0 (make-LocalRef 3)) + (make-InstallValue 1 (make-LocalRef 2)) + (make-Seq (list (make-LocalRef 0) + (make-LocalRef 1))))))))))) @@ -262,7 +263,7 @@ (make-Top (make-Prefix '()) (make-Constant 42))) -(test (parse '(letrec ([x (lambda (x) x)] - [y (lambda (x) x)]))) - (make-Top (make-Prefix '()) +;#;(test (parse '(letrec ([x (lambda (x) x)] +; [y (lambda (x) x)]))) +; (make-Top (make-Prefix '()) \ No newline at end of file