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

pushenv will push boxes.

Browse Source
This commit is contained in:
Danny Yoo 2011-03-13 20:15:30 -04:00
parent 44078dd40e
commit 581cbd5f9f
5 changed files with 56 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
compile.rkt
View File

@ -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)

3
il-structs.rkt
View File

@ -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)

1
simulator-structs.rkt
View File

@ -15,6 +15,7 @@
(Pairof PrimitiveValue PrimitiveValue)
)))
(define-type SlotValue (U PrimitiveValue
(Boxof PrimitiveValue)
toplevel
CapturedControl
CapturedEnvironment))

26
test-assemble.rkt
View File

@ -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)

30
test-simulator.rkt
View File

@ -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))