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

adding Primitives as a target

Browse Source
This commit is contained in:
dyoo 2011-03-15 14:35:23 -04:00
parent a17434937b
commit b14631a40f
5 changed files with 28 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
assemble.rkt
View File

@ -281,7 +281,9 @@ EOF
[(EnvLexicalReference? target)
(assemble-lexical-reference target)]
[(EnvPrefixReference? target)
(assemble-prefix-reference target)]))
(assemble-prefix-reference target)]
[(PrimitivesReference? target)
(format "Primitives[~s]" (symbol->string (PrimitivesReference-name target)))]))

4
compile.rkt
View File

@ -620,7 +620,9 @@
(EnvLexicalReference-unbox? target))]
[(EnvPrefixReference? target)
(make-EnvPrefixReference (+ n (EnvPrefixReference-depth target))
(EnvPrefixReference-pos target))]))
(EnvPrefixReference-pos target))]
[(PrimitivesReference? target)
target]))

7
il-structs.rkt
View File

@ -29,7 +29,8 @@
;; Targets: these are the allowable lhs's for an assignment.
(define-type Target (U AtomicRegisterSymbol
EnvLexicalReference
EnvPrefixReference))
EnvPrefixReference
PrimitivesReference))
@ -49,6 +50,10 @@
#:transparent)
(define-struct: PrimitivesReference ([name : Symbol])
#:transparent)
;; An environment reference is either lexical or referring to a whole prefix.
(define-type EnvReference (U EnvLexicalReference

8
simulator-primitives.rkt
View File

@ -5,7 +5,11 @@
racket/math
(for-syntax racket/base))
(provide lookup-primitive)
(provide lookup-primitive set-primitive!)
(define mutated-primitives (make-hasheq))
(define (set-primitive! n p)
(hash-set! mutated-primitives n p))
(define-syntax (make-lookup stx)
@ -29,6 +33,8 @@
...)
(lambda (n)
(cond
[(hash-has-key? mutated-primitives n)
(hash-ref mutated-primitives n)]
[(eq? n 'exported-name)
prim-name]
...

25
simulator.rkt
View File

@ -13,7 +13,8 @@
(for-syntax racket/base))
(require/typed "simulator-primitives.rkt"
[lookup-primitive (Symbol -> PrimitiveValue)])
[lookup-primitive (Symbol -> PrimitiveValue)]
[set-primitive! (Symbol PrimitiveValue -> Void)])
(require/typed "simulator-helpers.rkt"
[ensure-primitive-value-box (SlotValue -> (Boxof PrimitiveValue))]
@ -125,20 +126,7 @@
(define (step-assign-immediate! m stmt)
(let: ([t : Target (AssignImmediateStatement-target stmt)]
[v : SlotValue (evaluate-oparg m (AssignImmediateStatement-value stmt))])
(cond [(eq? t 'proc)
(proc-update! m v)]
[(eq? t 'val)
(val-update! m v)]
[(EnvLexicalReference? t)
(if (EnvLexicalReference-unbox? t)
(begin (set-box! (ensure-primitive-value-box (env-ref m (EnvLexicalReference-depth t)))
(ensure-primitive-value v))
'ok)
(env-mutate! m (EnvLexicalReference-depth t) v))]
[(EnvPrefixReference? t)
(toplevel-mutate! (ensure-toplevel (env-ref m (EnvPrefixReference-depth t)))
(EnvPrefixReference-pos t)
(ensure-primitive-value v))])))
((get-target-updater t) m v)))
(: step-push-environment! (machine PushEnvironment -> 'ok))
@ -273,7 +261,12 @@
(lambda: ([m : machine] [v : SlotValue])
(toplevel-mutate! (ensure-toplevel (env-ref m (EnvPrefixReference-depth t)))
(EnvPrefixReference-pos t)
(ensure-primitive-value v)))]))
(ensure-primitive-value v)))]
[(PrimitivesReference? t)
(lambda: ([m : machine] [v : SlotValue])
(set-primitive! (PrimitivesReference-name t)
(ensure-primitive-value v))
'ok)]))
(: step-assign-primitive-operation! (machine AssignPrimOpStatement -> 'ok))