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

removing separate settoplevel statement; unnecessary

Browse Source
This commit is contained in:
Danny Yoo 2011-03-10 13:23:23 -05:00
parent c4bf7c60b5
commit 8699874a95
6 changed files with 24 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
assemble.rkt
View File

@ -125,8 +125,6 @@ EOF
(: collect-primitive-command (PrimitiveCommand -> (Listof Symbol)))
(define (collect-primitive-command op)
(cond
[(SetToplevel!? op)
empty]
[(CheckToplevelBound!? op)
empty]
[(CheckClosureArity!? op)
@ -347,10 +345,6 @@ EOF
(: assemble-op-statement (PrimitiveCommand -> String))
(define (assemble-op-statement op)
(cond
[(SetToplevel!? op)
(format "MACHINE.env[MACHINE.env.length - 1 - ~a][~a] = MACHINE.val;"
(SetToplevel!-depth op)
(SetToplevel!-pos op))]
[(CheckToplevelBound!? op)
(format "if (MACHINE.env[MACHINE.env.length - 1 - ~a][~a] === undefined) { throw new Error(\"Not bound: \" + ~s); }"

25
compile.rkt
View File

@ -164,23 +164,22 @@
(: compile-definition (Def CompileTimeEnvironment Target Linkage -> InstructionSequence))
(define (compile-definition exp cenv target linkage)
(let* ([var (Def-variable exp)]
[lexical-pos (find-variable var cenv)]
[get-value-code
(compile (Def-value exp) cenv 'val 'next)])
[lexical-pos (find-variable var cenv)])
(cond
[(LocalAddress? lexical-pos)
(error 'compile-definition "Defintion not at toplevel")]
[(PrefixAddress? lexical-pos)
(end-with-linkage
linkage
cenv
(append-instruction-sequences
get-value-code
(make-instruction-sequence `(,(make-PerformStatement (make-SetToplevel!
(PrefixAddress-depth lexical-pos)
(PrefixAddress-pos lexical-pos)
var))
,(make-AssignImmediateStatement target (make-Const 'ok))))))])))
(let ([get-value-code
(compile (Def-value exp) cenv (make-EnvPrefixReference
(PrefixAddress-depth lexical-pos)
(PrefixAddress-pos lexical-pos))
'next)])
(end-with-linkage
linkage
cenv
(append-instruction-sequences
get-value-code
(make-instruction-sequence `(,(make-AssignImmediateStatement target (make-Const 'ok)))))))])))
(: compile-branch (Branch CompileTimeEnvironment Target Linkage -> InstructionSequence))

7
il-structs.rkt
View File

@ -167,12 +167,6 @@
;; Assign the value in the val register into the prefix installed at (depth, pos).
(define-struct: SetToplevel! ([depth : Natural]
[pos : Natural]
[name : Symbol])
#:transparent)
;; Check that the value in the prefix has been defined.
;; If not, raise an error and stop evaluation.
(define-struct: CheckToplevelBound! ([depth : Natural]
@ -195,7 +189,6 @@
#:transparent)
(define-type PrimitiveCommand (U
SetToplevel!
CheckToplevelBound!
CheckClosureArity!
ExtendEnvironment/Prefix!

5
simulator.rkt
View File

@ -161,11 +161,6 @@
(define (step-perform m stmt)
(let: ([op : PrimitiveCommand (PerformStatement-op stmt)])
(cond
[(SetToplevel!? op)
(toplevel-mutate! (ensure-toplevel (env-ref m (SetToplevel!-depth op)))
(SetToplevel!-pos op)
(ensure-primitive-value (machine-val m)))
m]
[(CheckToplevelBound!? op)
(let: ([a-top : toplevel (ensure-toplevel (env-ref m (CheckToplevelBound!-depth op)))])

4
test-assemble.rkt
View File

@ -340,7 +340,7 @@
;; Set-toplevel
(test (E-many `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(advisor)))
,(make-AssignImmediateStatement 'val (make-Const "Kathi"))
,(make-PerformStatement (make-SetToplevel! 0 0 'some-variable)))
,(make-AssignImmediateStatement (make-EnvPrefixReference 0 0) (make-Reg 'val)))
"MACHINE.env[0][0]")
"Kathi")
@ -356,7 +356,7 @@
;; check-toplevel-bound shouldn't fail here.
(test (E-many `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(another-advisor)))
,(make-AssignImmediateStatement 'val (make-Const "Shriram"))
,(make-PerformStatement (make-SetToplevel! 0 0 'some-variable))
,(make-AssignImmediateStatement (make-EnvPrefixReference 0 0) (make-Reg 'val))
,(make-PerformStatement (make-CheckToplevelBound! 0 0 'another-advisor)))
"MACHINE.env[0][0]")
"Shriram")

20
test-simulator.rkt
View File

@ -234,20 +234,20 @@
(let ([m (new-machine `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(some-variable)))
,(make-AssignImmediateStatement 'val (make-Const "Danny"))
,(make-PerformStatement (make-SetToplevel! 0 0 'some-variable))))])
,(make-AssignImmediateStatement (make-EnvPrefixReference 0 0) (make-Reg 'val))))])
(test (machine-env (run m))
(list (make-toplevel (list "Danny")))))
(let ([m (new-machine `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(some-variable another)))
,(make-AssignImmediateStatement 'val (make-Const "Danny"))
,(make-PerformStatement (make-SetToplevel! 0 1 'another))))])
,(make-AssignImmediateStatement (make-EnvPrefixReference 0 1) (make-Reg 'val))))])
(test (machine-env (run m))
(list (make-toplevel (list (make-undefined) "Danny")))))
(let ([m (new-machine `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(some-variable)))
,(make-AssignImmediateStatement 'val (make-Const "Danny"))
,(make-PushEnvironment 5)
,(make-PerformStatement (make-SetToplevel! 5 0 'some-variable))))])
,(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)
(make-toplevel (list "Danny")))))
@ -268,7 +268,7 @@
;; check-toplevel-bound shouldn't fail here.
(let ([m (new-machine `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(some-variable)))
,(make-AssignImmediateStatement 'val (make-Const "Danny"))
,(make-PerformStatement (make-SetToplevel! 0 0 'some-variable))
,(make-AssignImmediateStatement (make-EnvPrefixReference 0 0) (make-Reg 'val))
,(make-PerformStatement (make-CheckToplevelBound! 0 0 'some-variable))))])
(void (run m)))
@ -335,11 +335,11 @@
;; make-compiled-procedure: Capturing a toplevel.
(let ([m (new-machine `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(x y z)))
,(make-AssignImmediateStatement 'val (make-Const "x"))
,(make-PerformStatement (make-SetToplevel! 0 0 'x))
,(make-AssignImmediateStatement (make-EnvPrefixReference 0 0) (make-Reg 'val))
,(make-AssignImmediateStatement 'val (make-Const "y"))
,(make-PerformStatement (make-SetToplevel! 0 1 'y))
,(make-AssignImmediateStatement (make-EnvPrefixReference 0 1) (make-Reg 'val))
,(make-AssignImmediateStatement 'val (make-Const "z"))
,(make-PerformStatement (make-SetToplevel! 0 2 'z))
,(make-AssignImmediateStatement (make-EnvPrefixReference 0 2) (make-Reg 'val))
,(make-AssignPrimOpStatement
'val
(make-MakeCompiledProcedure 'procedure-entry
@ -355,11 +355,11 @@
;; make-compiled-procedure: Capturing both a toplevel and some lexical values
(let ([m (new-machine `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(x y z)))
,(make-AssignImmediateStatement 'val (make-Const "x"))
,(make-PerformStatement (make-SetToplevel! 0 0 'x))
,(make-AssignImmediateStatement (make-EnvPrefixReference 0 0) (make-Reg 'val))
,(make-AssignImmediateStatement 'val (make-Const "y"))
,(make-PerformStatement (make-SetToplevel! 0 1 'y))
,(make-AssignImmediateStatement (make-EnvPrefixReference 0 1) (make-Reg 'val))
,(make-AssignImmediateStatement 'val (make-Const "z"))
,(make-PerformStatement (make-SetToplevel! 0 2 'z))
,(make-AssignImmediateStatement (make-EnvPrefixReference 0 2) (make-Reg 'val))
,(make-PushEnvironment 3)
,(make-AssignImmediateStatement (make-EnvLexicalReference 0) (make-Const 'larry))