diff --git a/expression-structs.rkt b/expression-structs.rkt index 6f83d7b..dfcb452 100644 --- a/expression-structs.rkt +++ b/expression-structs.rkt @@ -11,8 +11,7 @@ Branch Lam Seq App Let1 LetVoid - InstallValue - #;LetRec)) + InstallValue)) (define-struct: Top ([prefix : Prefix] [code : ExpressionCore]) #:transparent) @@ -23,7 +22,8 @@ [pos : Natural]) #:transparent) -(define-struct: LocalRef ([depth : Natural]) +(define-struct: LocalRef ([depth : Natural] + [unbox? : Boolean]) #:transparent) (define-struct: ToplevelSet ([depth : Natural] @@ -37,7 +37,7 @@ (define-struct: Lam ([num-parameters : Natural] [body : ExpressionCore] - [closure-map : (Listof EnvReference)]) #:transparent) + [closure-map : (Listof Natural)]) #:transparent) (define-struct: Seq ([actions : (Listof ExpressionCore)]) #:transparent) (define-struct: App ([operator : ExpressionCore] @@ -47,18 +47,15 @@ [body : ExpressionCore]) #:transparent) (define-struct: LetVoid ([count : Natural] - [body : ExpressionCore]) + [body : ExpressionCore] + [boxes? : Boolean]) #:transparent) (define-struct: InstallValue ([depth : Natural] - [body : ExpressionCore]) + [body : ExpressionCore] + [boxes? : Boolean]) #:transparent) -#;(define-struct: LetRec ([count : Natural] - [rhss : (Listof Lam)] - [body : ExpressionCore]) - #:transparent) - diff --git a/lexical-env.rkt b/lexical-env.rkt index 6a00407..14f13ec 100644 --- a/lexical-env.rkt +++ b/lexical-env.rkt @@ -11,7 +11,8 @@ collect-lexical-references lexical-references->compile-time-environment place-prefix-mask - adjust-env-reference-depth) + adjust-env-reference-depth + env-reference-depth) ;; Find where the variable is located in the lexical environment @@ -186,3 +187,12 @@ (EnvPrefixReference-name target))] [(EnvWholePrefixReference? target) (make-EnvWholePrefixReference (+ n (EnvWholePrefixReference-depth target)))])) + + +(: env-reference-depth (EnvReference -> Natural)) +(define (env-reference-depth a-ref) + (cond + [(EnvLexicalReference? a-ref) + (EnvLexicalReference-depth a-ref)] + [(EnvWholePrefixReference? a-ref) + (EnvWholePrefixReference-depth a-ref)])) \ No newline at end of file diff --git a/parse.rkt b/parse.rkt index 84aa38b..d699151 100644 --- a/parse.rkt +++ b/parse.rkt @@ -38,7 +38,8 @@ (let ([address (find-variable exp cenv)]) (cond [(EnvLexicalReference? address) - (make-LocalRef (EnvLexicalReference-depth address))] + (make-LocalRef (EnvLexicalReference-depth address) + (EnvLexicalReference-unbox? address))] [(EnvPrefixReference? address) (make-ToplevelRef (EnvPrefixReference-depth address) (EnvPrefixReference-pos address))]))] @@ -80,7 +81,7 @@ (if (= (length lam-body) 1) (first lam-body) (make-Seq lam-body)) - closure-references)))] + (map env-reference-depth closure-references))))] [(begin? exp) (let ([actions (map (lambda (e) @@ -289,11 +290,12 @@ (make-LetVoid (length vars) (make-Seq (append (map (lambda (rhs index) - (make-InstallValue index (parse rhs rhs-cenv))) + (make-InstallValue index (parse rhs rhs-cenv) #f)) rhss (build-list (length rhss) (lambda (i) i))) (list (parse `(begin ,@body) - (extend-lexical-environment/names cenv vars)))))))]))) + (extend-lexical-environment/names cenv vars))))) + #f))]))) (define (parse-letrec exp cenv) (let ([vars (let-variables exp)] @@ -303,14 +305,15 @@ [(= 0 (length vars)) (parse `(begin ,@body) cenv)] [else - (let ([new-cenv (extend-lexical-environment/names cenv vars)]) + (let ([new-cenv (extend-lexical-environment/boxed-names cenv vars)]) (make-LetVoid (length vars) (make-Seq (append (map (lambda (rhs index) - (make-InstallValue index (parse rhs new-cenv))) + (make-InstallValue index (parse rhs new-cenv) #t)) rhss - (build-list (length rhss (lambda (i) i)))) - (list (parse `(begin ,@body) new-cenv))))))]))) + (build-list (length rhss) (lambda (i) i))) + (list (parse `(begin ,@body) new-cenv)))) + #t))]))) (define (desugar-let* exp) diff --git a/test-parse.rkt b/test-parse.rkt index 843d26a..30304e8 100644 --- a/test-parse.rkt +++ b/test-parse.rkt @@ -88,36 +88,37 @@ (test (parse '(lambda (x y z) x)) (make-Top (make-Prefix '()) - (make-Lam 3 (make-LocalRef 0) '()))) + (make-Lam 3 (make-LocalRef 0 #f) '()))) (test (parse '(lambda (x y z) y)) (make-Top (make-Prefix '()) - (make-Lam 3 (make-LocalRef 1) '()))) + (make-Lam 3 (make-LocalRef 1 #f) '()))) (test (parse '(lambda (x y z) z)) (make-Top (make-Prefix '()) - (make-Lam 3 (make-LocalRef 2) '()))) + (make-Lam 3 (make-LocalRef 2 #f) '()))) (test (parse '(lambda (x y z) x y z)) (make-Top (make-Prefix '()) - (make-Lam 3 (make-Seq (list (make-LocalRef 0) - (make-LocalRef 1) - (make-LocalRef 2))) + (make-Lam 3 (make-Seq (list (make-LocalRef 0 #f) + (make-LocalRef 1 #f) + (make-LocalRef 2 #f))) '()))) (test (parse '(lambda (x y z) k)) (make-Top (make-Prefix '(k)) - (make-Lam 3 (make-ToplevelRef 0 0 ) - (list (make-EnvWholePrefixReference 0))))) + (make-Lam 3 + (make-ToplevelRef 0 0 ) + '(0)))) (test (parse '(lambda (x y z) k x y z)) (make-Top (make-Prefix '(k)) (make-Lam 3 (make-Seq (list (make-ToplevelRef 0 0 ) - (make-LocalRef 1) - (make-LocalRef 2) - (make-LocalRef 3))) - (list (make-EnvWholePrefixReference 0))))) + (make-LocalRef 1 #f) + (make-LocalRef 2 #f) + (make-LocalRef 3 #f))) + '(0)))) (test (parse '(lambda (x) (lambda (y) @@ -131,18 +132,16 @@ (make-Lam 1 (make-Lam 1 (make-Seq (list - (make-LocalRef 1) - (make-LocalRef 2) - (make-LocalRef 3) + (make-LocalRef 1 #f) + (make-LocalRef 2 #f) + (make-LocalRef 3 #f) (make-ToplevelRef 0 0))) - (list (make-EnvWholePrefixReference 0) ;; w - (make-EnvLexicalReference 1 #f) ;; x - (make-EnvLexicalReference 2 #f) ;; y - )) - (list (make-EnvWholePrefixReference 0) ;; w - (make-EnvLexicalReference 1 #f) ;; x - )) - (list (make-EnvWholePrefixReference 0))))) + '(0 1 2) ;; w x y + ) + + '(0 1) ;; w x + ) + '(0)))) (test (parse '(lambda (x) (lambda (y) @@ -150,8 +149,8 @@ (make-Top (make-Prefix '()) (make-Lam 1 (make-Lam 1 - (make-LocalRef 0) - (list (make-EnvLexicalReference 0 #f))) + (make-LocalRef 0 #f) + '(0)) (list)))) (test (parse '(lambda (x) @@ -160,7 +159,7 @@ (make-Top (make-Prefix '()) (make-Lam 1 (make-Lam 1 - (make-LocalRef 0) + (make-LocalRef 0 #f) (list)) (list)))) @@ -175,9 +174,9 @@ (make-Top (make-Prefix '(+)) (make-Lam 1 (make-App (make-ToplevelRef 2 0) - (list (make-LocalRef 3) - (make-LocalRef 3))) - (list (make-EnvWholePrefixReference 0))))) + (list (make-LocalRef 3 #f) + (make-LocalRef 3 #f))) + '(0)))) (test (parse '(lambda (x) (+ (* x x) x))) @@ -188,10 +187,10 @@ (list ;; stack layout: [???, ???, ???, ???, prefix, x] (make-App (make-ToplevelRef 4 0) - (list (make-LocalRef 5) - (make-LocalRef 5))) - (make-LocalRef 3))) - (list (make-EnvWholePrefixReference 0))))) + (list (make-LocalRef 5 #f) + (make-LocalRef 5 #f))) + (make-LocalRef 3 #f))) + '(0)))) (test (parse '(let () x)) @@ -202,7 +201,7 @@ x)) (make-Top (make-Prefix '()) (make-Let1 (make-Constant 3) - (make-LocalRef 0)))) + (make-LocalRef 0 #f)))) (test (parse '(let ([x 3] [y 4]) @@ -210,10 +209,11 @@ y)) (make-Top (make-Prefix '()) (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)))))))) + (make-Seq (list (make-InstallValue 0 (make-Constant 3) #f) + (make-InstallValue 1 (make-Constant 4) #f) + (make-Seq (list (make-LocalRef 0 #f) + (make-LocalRef 1 #f))))) + #f))) (test (parse '(let ([x 3] [y 4]) @@ -223,13 +223,15 @@ y))) (make-Top (make-Prefix '()) (make-LetVoid 2 - (make-Seq (list (make-InstallValue 0 (make-Constant 3)) - (make-InstallValue 1 (make-Constant 4)) + (make-Seq (list (make-InstallValue 0 (make-Constant 3) #f) + (make-InstallValue 1 (make-Constant 4) #f) (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))))))))))) + (make-Seq (list (make-InstallValue 0 (make-LocalRef 3 #f) #f) + (make-InstallValue 1 (make-LocalRef 2 #f) #f) + (make-Seq (list (make-LocalRef 0 #f) + (make-LocalRef 1 #f))))) + #f))) + #f))) @@ -251,11 +253,11 @@ (make-App ;; stack layout: [???, ???, x_0, prefix] - (make-ToplevelRef 3 0) (list (make-LocalRef 2))) + (make-ToplevelRef 3 0) (list (make-LocalRef 2 #f))) ;; stack layout [???, x_1, x_0, prefix] (make-App (make-ToplevelRef 3 0) - (list (make-LocalRef 1))))))) + (list (make-LocalRef 1 #f))))))) (test (parse '(let* () @@ -263,7 +265,45 @@ (make-Top (make-Prefix '()) (make-Constant 42))) -;#;(test (parse '(letrec ([x (lambda (x) x)] -; [y (lambda (x) x)]))) -; (make-Top (make-Prefix '()) - \ No newline at end of file +(test (parse '(letrec ([x (lambda (x) x)] + [y (lambda (x) x)]) + (x y))) + (make-Top (make-Prefix '()) + (make-LetVoid 2 + (make-Seq + (list + (make-InstallValue 0 + (make-Lam 1 (make-LocalRef 0 #f) '()) + #t) + (make-InstallValue 1 + (make-Lam 1 (make-LocalRef 0 #f) '()) + #t) + ;; stack layout: ??? x y + (make-App (make-LocalRef 1 #t) + (list (make-LocalRef 2 #t))))) + #t))) + + +(test (parse '(letrec ([x (lambda (x) (y x))] + [y (lambda (x) (x y))]) + (x y))) + (make-Top (make-Prefix '()) + (make-LetVoid 2 + (make-Seq + (list + (make-InstallValue 0 + (make-Lam 1 + (make-App (make-LocalRef 1 #t) + (list (make-LocalRef 2 #f))) + '(1)) + #t) + (make-InstallValue 1 + (make-Lam 1 + (make-App (make-LocalRef 2 #f) + (list (make-LocalRef 1 #t))) + '(1)) + #t) + ;; stack layout: ??? x y + (make-App (make-LocalRef 1 #t) + (list (make-LocalRef 2 #t))))) + #t)))