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

lexical address lookup

Browse Source
This commit is contained in:
Danny Yoo 2011-03-07 17:40:02 -05:00
parent 31e1b0a5d8
commit c08c6ed667
2 changed files with 44 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
simulator.rkt
View File

@ -208,10 +208,24 @@
[(ApplyPrimitiveProcedure? op) [(ApplyPrimitiveProcedure? op)
m] m]
[(LookupLexicalAddress? op) [(LookupLexicalAddress? op)
m] (let: ([a-val : SlotValue (env-ref m (LookupLexicalAddress-depth op))])
(cond
[(toplevel? a-val)
(error 'lookup-lexical-address)]
[else
(target-updater m a-val)]))]
[(LookupToplevelAddress? op) [(LookupToplevelAddress? op)
m] (let: ([a-top : SlotValue (env-ref m (LookupToplevelAddress-depth op))])
(cond
[(toplevel? a-top)
(target-updater m (list-ref (toplevel-vals a-top)
(LookupToplevelAddress-pos op)))]
[else
(error 'lookup-toplevel "not a toplevel: ~s" a-top)]))]
[(GetControlStackLabel? op) [(GetControlStackLabel? op)
m]))) m])))

30
test-simulator.rkt
View File

@ -373,9 +373,35 @@
'moe)))) 'moe))))
;; Test toplevel lookup
(let ([m (new-machine `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(+)))
,(make-AssignPrimOpStatement 'val (make-LookupToplevelAddress 0 0 '+))))])
(test (machine-val (run m))
(lookup-primitive '+)))
;; Test lexical lookup
(let ([m (new-machine `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(+)))
,(make-PushEnvironment 3)
,(make-AssignImmediateStatement (make-EnvLexicalReference 0) (make-Const 'larry))
,(make-AssignImmediateStatement (make-EnvLexicalReference 1) (make-Const 'curly))
,(make-AssignImmediateStatement (make-EnvLexicalReference 2) (make-Const 'moe))
,(make-AssignPrimOpStatement 'val (make-LookupLexicalAddress 0))))])
(test (machine-val (run m))
'larry))
;; Another lexical lookup test
(let ([m (new-machine `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(+)))
,(make-PushEnvironment 3)
,(make-AssignImmediateStatement (make-EnvLexicalReference 0) (make-Const 'larry))
,(make-AssignImmediateStatement (make-EnvLexicalReference 1) (make-Const 'curly))
,(make-AssignImmediateStatement (make-EnvLexicalReference 2) (make-Const 'moe))
,(make-AssignPrimOpStatement 'val (make-LookupLexicalAddress 1))))])
(test (machine-val (run m))
'curly))
#;(let ([m (new-machine `(,(make-AssignPrimOpStatement (make-ApplyPrimitiveProcedure))))])
(test ...))
#;(let ([m (new-machine `(,(make-AssignPrimOpStatement (make-LookupLexicalAddress))))]) #;(let ([m (new-machine `(,(make-AssignPrimOpStatement (make-LookupLexicalAddress))))])
(test ...)) (test ...))
#;(let ([m (new-machine `(,(make-AssignPrimOpStatement (make-LookupToplevelAddress))))]) #;(let ([m (new-machine `(,(make-AssignPrimOpStatement (make-LookupToplevelAddress))))])