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) [(EnvLexicalReference? target)
(assemble-lexical-reference target)] (assemble-lexical-reference target)]
[(EnvPrefixReference? 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))] (EnvLexicalReference-unbox? target))]
[(EnvPrefixReference? target) [(EnvPrefixReference? target)
(make-EnvPrefixReference (+ n (EnvPrefixReference-depth 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. ;; Targets: these are the allowable lhs's for an assignment.
(define-type Target (U AtomicRegisterSymbol (define-type Target (U AtomicRegisterSymbol
EnvLexicalReference EnvLexicalReference
EnvPrefixReference)) EnvPrefixReference
PrimitivesReference))
@ -49,6 +50,10 @@
#:transparent) #:transparent)
(define-struct: PrimitivesReference ([name : Symbol])
#:transparent)
;; An environment reference is either lexical or referring to a whole prefix. ;; An environment reference is either lexical or referring to a whole prefix.
(define-type EnvReference (U EnvLexicalReference (define-type EnvReference (U EnvLexicalReference

8
simulator-primitives.rkt
View File

@ -5,7 +5,11 @@
racket/math racket/math
(for-syntax racket/base)) (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) (define-syntax (make-lookup stx)
@ -29,6 +33,8 @@
...) ...)
(lambda (n) (lambda (n)
(cond (cond
[(hash-has-key? mutated-primitives n)
(hash-ref mutated-primitives n)]
[(eq? n 'exported-name) [(eq? n 'exported-name)
prim-name] prim-name]
... ...

25
simulator.rkt
View File

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