elements of the prefix can be lhs targets now

This commit is contained in:
Danny Yoo 2011-03-10 13:05:16 -05:00
parent 5b406543bc
commit c4bf7c60b5
4 changed files with 34 additions and 5 deletions

View File

@ -260,7 +260,9 @@ EOF
[(eq? target 'val) [(eq? target 'val)
"MACHINE.val"] "MACHINE.val"]
[(EnvLexicalReference? target) [(EnvLexicalReference? target)
(assemble-lexical-reference target)])) (assemble-lexical-reference target)]
[(EnvPrefixReference? target)
(assemble-prefix-reference target)]))
@ -288,11 +290,18 @@ EOF
(format "MACHINE.env[MACHINE.env.length - 1 - ~a]" (format "MACHINE.env[MACHINE.env.length - 1 - ~a]"
(EnvLexicalReference-depth a-lex-ref))) (EnvLexicalReference-depth a-lex-ref)))
(: assemble-prefix-reference (EnvPrefixReference -> String))
(define (assemble-prefix-reference a-ref)
(format "MACHINE.env[MACHINE.env.length - 1 - ~a][~a]"
(EnvPrefixReference-depth a-ref)
(EnvPrefixReference-pos a-ref)))
(: assemble-whole-prefix-reference (EnvWholePrefixReference -> String)) (: assemble-whole-prefix-reference (EnvWholePrefixReference -> String))
(define (assemble-whole-prefix-reference a-prefix-ref) (define (assemble-whole-prefix-reference a-prefix-ref)
(format "MACHINE.env[MACHINE.env.length - 1 - ~a]" (format "MACHINE.env[MACHINE.env.length - 1 - ~a]"
(EnvWholePrefixReference-depth a-prefix-ref))) (EnvWholePrefixReference-depth a-prefix-ref)))
(: assemble-env-reference (EnvReference -> String)) (: assemble-env-reference (EnvReference -> String))
(define (assemble-env-reference ref) (define (assemble-env-reference ref)
(cond (cond

View File

@ -418,7 +418,10 @@
'proc] 'proc]
[(EnvLexicalReference? target) [(EnvLexicalReference? target)
;; The optimization is right here. ;; The optimization is right here.
(make-EnvLexicalReference (+ (EnvLexicalReference-depth target) n))]) (make-EnvLexicalReference (+ (EnvLexicalReference-depth target) n))]
[(EnvPrefixReference? target)
;; The optimization is right here.
(make-EnvPrefixReference (+ (EnvPrefixReference-depth target) n) (EnvPrefixReference-pos target))])
(make-ApplyPrimitiveProcedure n after-call)) (make-ApplyPrimitiveProcedure n after-call))
,(make-PopEnvironment n 0)))) ,(make-PopEnvironment n 0))))

View File

@ -26,7 +26,9 @@
;; 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 EnvLexicalReference)) (define-type Target (U AtomicRegisterSymbol
EnvLexicalReference
EnvPrefixReference))
@ -38,10 +40,14 @@
#:transparent) #:transparent)
(define-struct: EnvLexicalReference ([depth : Natural]) (define-struct: EnvLexicalReference ([depth : Natural])
#:transparent) #:transparent)
(define-struct: EnvPrefixReference ([depth : Natural]
[pos : Natural])
#:transparent)
(define-struct: EnvWholePrefixReference ([depth : Natural]) (define-struct: EnvWholePrefixReference ([depth : Natural])
#:transparent) #: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
EnvWholePrefixReference)) EnvWholePrefixReference))

View File

@ -91,7 +91,12 @@
[(eq? t 'val) [(eq? t 'val)
(val-update m v)] (val-update m v)]
[(EnvLexicalReference? t) [(EnvLexicalReference? t)
(env-mutate m (EnvLexicalReference-depth t) v)]))) (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))
m])))
(: step-push-environment (machine PushEnvironment -> machine)) (: step-push-environment (machine PushEnvironment -> machine))
@ -206,7 +211,13 @@
val-update] val-update]
[(EnvLexicalReference? t) [(EnvLexicalReference? t)
(lambda: ([m : machine] [v : SlotValue]) (lambda: ([m : machine] [v : SlotValue])
(env-mutate m (EnvLexicalReference-depth t) v))])) (env-mutate m (EnvLexicalReference-depth t) v))]
[(EnvPrefixReference? t)
(lambda: ([m : machine] [v : SlotValue])
(toplevel-mutate! (ensure-toplevel (env-ref m (EnvPrefixReference-depth t)))
(EnvPrefixReference-pos t)
(ensure-primitive-value v))
m)]))
(: step-assign-primitive-operation (machine AssignPrimOpStatement -> machine)) (: step-assign-primitive-operation (machine AssignPrimOpStatement -> machine))