diff --git a/compile.rkt b/compile.rkt index 382b80e..2100748 100644 --- a/compile.rkt +++ b/compile.rkt @@ -352,7 +352,7 @@ 'val))))]) (append-instruction-sequences - (make-instruction-sequence `(,(make-PushEnvironment (length (App-operands exp))))) + (make-instruction-sequence `(,(make-PushEnvironment (length (App-operands exp)) #f))) proc-code (juggle-operands operand-codes) (compile-procedure-call cenv extended-cenv @@ -508,12 +508,13 @@ (end-with-linkage linkage extended-cenv - (append-instruction-sequences (make-instruction-sequence `(,(make-PushEnvironment 1))) - rhs-code - body-code - after-body-code - (make-instruction-sequence `(,(make-PopEnvironment 1 0))) - after-let1)))) + (append-instruction-sequences + (make-instruction-sequence `(,(make-PushEnvironment 1 #f))) + rhs-code + body-code + after-body-code + (make-instruction-sequence `(,(make-PopEnvironment 1 0))) + after-let1)))) @@ -549,12 +550,13 @@ (end-with-linkage linkage extended-cenv - (append-instruction-sequences (make-instruction-sequence `(,(make-PushEnvironment n))) - (apply append-instruction-sequences rhs-codes) - body-code - after-body-code - (make-instruction-sequence `(,(make-PopEnvironment n 0))) - after-let)))) + (append-instruction-sequences + (make-instruction-sequence `(,(make-PushEnvironment n #f))) + (apply append-instruction-sequences rhs-codes) + body-code + after-body-code + (make-instruction-sequence `(,(make-PopEnvironment n 0))) + after-let)))) (: compile-letrec (LetRec CompileTimeEnvironment Target Linkage -> InstructionSequence)) (define (compile-letrec exp cenv target linkage) @@ -563,7 +565,8 @@ (map (lambda: ([rhs : ExpressionCore] [i : Natural]) (compile rhs - (extend-lexical-environment/names cenv (LetRec-names exp)) + (extend-lexical-environment/boxed-names cenv + (LetRec-names exp)) (make-EnvLexicalReference i #t) 'next)) (LetRec-rhss exp) @@ -588,12 +591,13 @@ (end-with-linkage linkage extended-cenv - (append-instruction-sequences (make-instruction-sequence `(,(make-PushEnvironment n))) - (apply append-instruction-sequences rhs-codes) - body-code - after-body-code - (make-instruction-sequence `(,(make-PopEnvironment n 0))) - after-letrec)))) + (append-instruction-sequences + (make-instruction-sequence `(,(make-PushEnvironment n #t))) + (apply append-instruction-sequences rhs-codes) + body-code + after-body-code + (make-instruction-sequence `(,(make-PopEnvironment n 0))) + after-letrec)))) (: adjust-target-depth (Target Natural -> Target)) @@ -662,7 +666,7 @@ ,(make-AssignImmediateStatement 'proc (make-EnvLexicalReference 0 #f)) ;; Next, capture the envrionment and the current continuation closure,. - ,(make-PushEnvironment 2) + ,(make-PushEnvironment 2 #f) ,(make-AssignPrimOpStatement (make-EnvLexicalReference 0 #f) (make-CaptureControl 0)) ,(make-AssignPrimOpStatement (make-EnvLexicalReference 1 #f) diff --git a/il-structs.rkt b/il-structs.rkt index 92ac370..91d6976 100644 --- a/il-structs.rkt +++ b/il-structs.rkt @@ -86,7 +86,8 @@ (define-struct: PopEnvironment ([n : Natural] [skip : Natural]) #:transparent) -(define-struct: PushEnvironment ([n : Natural]) +(define-struct: PushEnvironment ([n : Natural] + [unbox? : Boolean]) #:transparent) diff --git a/simulator-structs.rkt b/simulator-structs.rkt index 1039f41..e1aad89 100644 --- a/simulator-structs.rkt +++ b/simulator-structs.rkt @@ -15,6 +15,7 @@ (Pairof PrimitiveValue PrimitiveValue) ))) (define-type SlotValue (U PrimitiveValue + (Boxof PrimitiveValue) toplevel CapturedControl CapturedEnvironment)) diff --git a/test-assemble.rkt b/test-assemble.rkt index 00bb78c..5a7a082 100644 --- a/test-assemble.rkt +++ b/test-assemble.rkt @@ -113,18 +113,18 @@ "Danny") -(test (E-single (make-PushEnvironment 1) +(test (E-single (make-PushEnvironment 1 #f) "MACHINE.env.length") "1") -(test (E-single (make-PushEnvironment 20) +(test (E-single (make-PushEnvironment 20 #f) "MACHINE.env.length") "20") ;; PopEnvironment -(test (E-many (list (make-PushEnvironment 2)) +(test (E-many (list (make-PushEnvironment 2 #f)) "MACHINE.env.length") "2") -(test (E-many (list (make-PushEnvironment 2) +(test (E-many (list (make-PushEnvironment 2 #f) (make-PopEnvironment 1 0)) "MACHINE.env.length") "1") @@ -132,17 +132,17 @@ ;; Assigning to the environment -(test (E-many (list (make-PushEnvironment 2) +(test (E-many (list (make-PushEnvironment 2 #f) (make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) (make-Const 12345))) "MACHINE.env[1]") "12345") -(test (E-many (list (make-PushEnvironment 2) +(test (E-many (list (make-PushEnvironment 2 #f) (make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) (make-Const 12345))) "MACHINE.env[0]") "undefined") -(test (E-many (list (make-PushEnvironment 2) +(test (E-many (list (make-PushEnvironment 2 #f) (make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) (make-Const 12345))) "MACHINE.env[0]") @@ -159,7 +159,7 @@ ;; Simple application (test (E-many (list (make-PerformStatement (make-ExtendEnvironment/Prefix! '(+))) (make-AssignImmediateStatement 'proc (make-EnvPrefixReference 0 0)) - (make-PushEnvironment 2) + (make-PushEnvironment 2 #f) (make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) (make-Const 3)) (make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) @@ -187,7 +187,7 @@ 'closureStart (make-GotoStatement (make-Label 'afterLambda)) 'afterLambda - (make-PushEnvironment 2) + (make-PushEnvironment 2 #f) (make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) (make-Const "hello")) (make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) @@ -206,7 +206,7 @@ (make-GotoStatement (make-Label 'theEnd)) 'afterLambdaBody - (make-PushEnvironment 2) + (make-PushEnvironment 2 #f) (make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) (make-Const "hello")) (make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) @@ -230,7 +230,7 @@ (make-GotoStatement (make-Label 'theEnd)) 'afterLambdaBody - (make-PushEnvironment 2) + (make-PushEnvironment 2 #f) (make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) (make-Const "hello")) (make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) @@ -252,7 +252,7 @@ (make-GotoStatement (make-Label 'theEnd)) 'afterLambdaBody - (make-PushEnvironment 2) + (make-PushEnvironment 2 #f) (make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) (make-Const "hello")) (make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) @@ -274,7 +274,7 @@ (make-GotoStatement (make-Label 'theEnd)) 'afterLambdaBody - (make-PushEnvironment 2) + (make-PushEnvironment 2 #f) (make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) (make-Const "hello")) (make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) diff --git a/test-simulator.rkt b/test-simulator.rkt index 6b1d825..fbc3063 100644 --- a/test-simulator.rkt +++ b/test-simulator.rkt @@ -65,58 +65,58 @@ ;; Assigning to a environment reference -(let* ([m (new-machine `(,(make-PushEnvironment 1) +(let* ([m (new-machine `(,(make-PushEnvironment 1 #f) ,(make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) (make-Const 42))))] [m (run m)]) (test (machine-env m) '(42))) ;; Assigning to another environment reference -(let* ([m (new-machine `(,(make-PushEnvironment 2) +(let* ([m (new-machine `(,(make-PushEnvironment 2 #f) ,(make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) (make-Const 42))))] [m (run m)]) (test (machine-env m) `(,(make-undefined) 42))) ;; Assigning to another environment reference -(let* ([m (new-machine `(,(make-PushEnvironment 2) +(let* ([m (new-machine `(,(make-PushEnvironment 2 #f) ,(make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) (make-Const 42))))] [m (run m)]) (test (machine-env m) `(42 ,(make-undefined)))) ;; PushEnv -(let ([m (new-machine `(,(make-PushEnvironment 20)))]) +(let ([m (new-machine `(,(make-PushEnvironment 20 #f)))]) (test (machine-env (run m)) (build-list 20 (lambda (i) (make-undefined))))) ;; PopEnv -(let ([m (new-machine `(,(make-PushEnvironment 20) +(let ([m (new-machine `(,(make-PushEnvironment 20 #f) ,(make-PopEnvironment 20 0)))]) (test (machine-env (run m)) '())) -(let* ([m (new-machine `(,(make-PushEnvironment 3) +(let* ([m (new-machine `(,(make-PushEnvironment 3 #f) ,(make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) (make-Const "hewie")) ,(make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) (make-Const "dewey")) ,(make-AssignImmediateStatement (make-EnvLexicalReference 2 #f) (make-Const "louie")) ,(make-PopEnvironment 1 0)))]) (test (machine-env (run m)) '("dewey" "louie"))) -(let* ([m (new-machine `(,(make-PushEnvironment 3) +(let* ([m (new-machine `(,(make-PushEnvironment 3 #f) ,(make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) (make-Const "hewie")) ,(make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) (make-Const "dewey")) ,(make-AssignImmediateStatement (make-EnvLexicalReference 2 #f) (make-Const "louie")) ,(make-PopEnvironment 1 1)))]) (test (machine-env (run m)) '("hewie" "louie"))) -(let* ([m (new-machine `(,(make-PushEnvironment 3) +(let* ([m (new-machine `(,(make-PushEnvironment 3 #f) ,(make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) (make-Const "hewie")) ,(make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) (make-Const "dewey")) ,(make-AssignImmediateStatement (make-EnvLexicalReference 2 #f) (make-Const "louie")) ,(make-PopEnvironment 1 2)))]) (test (machine-env (run m)) '("hewie" "dewey"))) -(let* ([m (new-machine `(,(make-PushEnvironment 3) +(let* ([m (new-machine `(,(make-PushEnvironment 3 #f) ,(make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) (make-Const "hewie")) ,(make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) (make-Const "dewey")) ,(make-AssignImmediateStatement (make-EnvLexicalReference 2 #f) (make-Const "louie")) @@ -253,7 +253,7 @@ (let ([m (new-machine `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(some-variable))) ,(make-AssignImmediateStatement 'val (make-Const "Danny")) - ,(make-PushEnvironment 5) + ,(make-PushEnvironment 5 #f) ,(make-AssignImmediateStatement (make-EnvPrefixReference 5 0) (make-Reg 'val))))]) (test (machine-env (run m)) (list (make-undefined) (make-undefined) (make-undefined) (make-undefined) (make-undefined) @@ -322,7 +322,7 @@ (make-closure 'procedure-entry 0 (list)))) ;; make-compiled-procedure: Capturing a few variables. -(let ([m (new-machine `(,(make-PushEnvironment 3) +(let ([m (new-machine `(,(make-PushEnvironment 3 #f) ,(make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) (make-Const 'larry)) ,(make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) (make-Const 'curly)) ,(make-AssignImmediateStatement (make-EnvLexicalReference 2 #f) (make-Const 'moe)) @@ -368,7 +368,7 @@ ,(make-AssignImmediateStatement 'val (make-Const "z")) ,(make-AssignImmediateStatement (make-EnvPrefixReference 0 2) (make-Reg 'val)) - ,(make-PushEnvironment 3) + ,(make-PushEnvironment 3 #f) ,(make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) (make-Const 'larry)) ,(make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) (make-Const 'curly)) ,(make-AssignImmediateStatement (make-EnvLexicalReference 2 #f) (make-Const 'moe)) @@ -400,7 +400,7 @@ ;; Test lexical lookup (let ([m (new-machine `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(+))) - ,(make-PushEnvironment 3) + ,(make-PushEnvironment 3 #f) ,(make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) (make-Const 'larry)) ,(make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) (make-Const 'curly)) ,(make-AssignImmediateStatement (make-EnvLexicalReference 2 #f) (make-Const 'moe)) @@ -410,7 +410,7 @@ 'larry)) ;; Another lexical lookup test (let ([m (new-machine `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(+))) - ,(make-PushEnvironment 3) + ,(make-PushEnvironment 3 #f) ,(make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) (make-Const 'larry)) ,(make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) (make-Const 'curly)) ,(make-AssignImmediateStatement (make-EnvLexicalReference 2 #f) (make-Const 'moe)) @@ -423,7 +423,7 @@ ;; Adding two numbers (let ([m (new-machine `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(+))) ,(make-AssignImmediateStatement 'proc (make-EnvPrefixReference 0 0)) - ,(make-PushEnvironment 2) + ,(make-PushEnvironment 2 #f) ,(make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) (make-Const 126389)) ,(make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) (make-Const 42)) ,(make-AssignPrimOpStatement 'val (make-ApplyPrimitiveProcedure 2 'after))