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

getting lookup-primitive to return primitive values

Browse Source
This commit is contained in:
Danny Yoo 2011-03-07 16:34:51 -05:00
parent 865181ddc4
commit 700c637e47
4 changed files with 42 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
il-structs.rkt
View File

@ -21,8 +21,9 @@
(define-type OpArg (U Const ;; an constant
Label ;; an label
Reg ;; an register
EnvLexicalReference
EnvWholePrefixReference))
EnvLexicalReference ;; a reference into the stack
EnvWholePrefixReference ;; a reference into a toplevel prefix in the stack.
))
(define-struct: Label ([name : Symbol])
#:transparent)

8
simulator-structs.rkt
View File

@ -31,7 +31,7 @@
)
#:transparent)
(define-struct: toplevel ([vals : (Listof Any)])
(define-struct: toplevel ([vals : (Listof PrimitiveValue)])
#:transparent)
@ -49,4 +49,8 @@
;; undefined value
(define-struct: undefined ()
#:transparent)
#:transparent)
(define-predicate PrimitiveValue? PrimitiveValue)

41
simulator.rkt
View File

@ -12,7 +12,7 @@
(for-syntax racket/base))
(require/typed "simulator-prims.rkt"
[lookup-primitive (Symbol -> Any)])
[lookup-primitive (Symbol -> PrimitiveValue)])
(provide new-machine can-step? step)
@ -41,7 +41,7 @@
[(AssignImmediateStatement? i)
(step-assign-immediate m i)]
[(AssignPrimOpStatement? i)
(error 'step)]
(step-assign-primitive-operation m i)]
[(PerformStatement? i)
(step-perform m i)]
[(GotoStatement? i)
@ -143,8 +143,7 @@
(SetToplevel!-depth op)
(toplevel-mutate (ensure-toplevel (env-ref m (SetToplevel!-depth op)))
(SetToplevel!-pos op)
(machine-val m)))]
(ensure-primitive-value (machine-val m))))]
[(CheckToplevelBound!? op)
(let: ([a-top : toplevel (ensure-toplevel (env-ref m (CheckToplevelBound!-depth op)))])
(cond
@ -166,6 +165,10 @@
[else
(error 'step-perform "Procedure register doesn't hold a procedure: ~s"
a-proc)]))])))
(: step-assign-primitive-operation (machine AssignPrimOpStatement -> machine))
(define (step-assign-primitive-operation m stmt)
m)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -176,8 +179,10 @@
(cond
[(Const? an-oparg)
(ensure-primitive-value (Const-const an-oparg))]
[(Label? an-oparg)
(Label-name an-oparg)]
[(Reg? an-oparg)
(let: ([n : AtomicRegisterSymbol (Reg-name an-oparg)])
(cond
@ -185,14 +190,27 @@
(machine-proc m)]
[(eq? n 'val)
(machine-val m)]))]
[(EnvLexicalReference? an-oparg)
(list-ref (machine-env m) (EnvLexicalReference-depth an-oparg))]
(let: ([v : SlotValue
(list-ref (machine-env m) (EnvLexicalReference-depth an-oparg))])
(cond
[(PrimitiveValue? v)
v]
[(toplevel? v)
(error 'evaluate-oparg
"Unexpected toplevel at depth ~s"
(EnvLexicalReference-depth an-oparg))]))]
[(EnvWholePrefixReference? an-oparg)
(unless (toplevel? (list-ref (machine-env m)
(EnvWholePrefixReference-depth an-oparg)))
(error 'evaluate-oparg "Internal error: not a toplevel at depth ~s"
(EnvWholePrefixReference-depth an-oparg)))
(list-ref (machine-env m) (EnvWholePrefixReference-depth an-oparg))]))
(let: ([v : SlotValue
(list-ref (machine-env m) (EnvWholePrefixReference-depth an-oparg))])
(cond
[(PrimitiveValue? v)
(error 'evaluate-oparg "Internal error: primitive value at depth ~s"
(EnvWholePrefixReference-depth an-oparg))]
[(toplevel? v)
v]))]))
(: ensure-primitive-value (Any -> PrimitiveValue))
@ -343,9 +361,8 @@
(loop (add1 i))])))
(: toplevel-mutate (toplevel Natural Any -> toplevel))
(: toplevel-mutate (toplevel Natural PrimitiveValue -> toplevel))
(define (toplevel-mutate a-top index v)
(make-toplevel (append (take (toplevel-vals a-top) index)
(list v)
(drop (toplevel-vals a-top) (add1 index)))))

5
test-simulator.rkt
View File

@ -284,4 +284,7 @@
)))])
(test (machine-env (run m))
;; Check that the environment has installed the expected closure values.
(list 1 2 3 true false)))
(list 1 2 3 true false)))