diff --git a/assemble.rkt b/assemble.rkt index cf30f60..7767f50 100644 --- a/assemble.rkt +++ b/assemble.rkt @@ -260,7 +260,9 @@ EOF [(eq? target 'val) "MACHINE.val"] [(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]" (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)) (define (assemble-whole-prefix-reference a-prefix-ref) (format "MACHINE.env[MACHINE.env.length - 1 - ~a]" (EnvWholePrefixReference-depth a-prefix-ref))) + (: assemble-env-reference (EnvReference -> String)) (define (assemble-env-reference ref) (cond diff --git a/compile.rkt b/compile.rkt index 47fd175..52e9a0b 100644 --- a/compile.rkt +++ b/compile.rkt @@ -418,7 +418,10 @@ 'proc] [(EnvLexicalReference? target) ;; 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-PopEnvironment n 0)))) diff --git a/il-structs.rkt b/il-structs.rkt index 4cb246c..bd618d1 100644 --- a/il-structs.rkt +++ b/il-structs.rkt @@ -26,7 +26,9 @@ ;; 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) (define-struct: EnvLexicalReference ([depth : Natural]) #:transparent) +(define-struct: EnvPrefixReference ([depth : Natural] + [pos : Natural]) + #:transparent) (define-struct: EnvWholePrefixReference ([depth : Natural]) #:transparent) + ;; An environment reference is either lexical or referring to a whole prefix. (define-type EnvReference (U EnvLexicalReference EnvWholePrefixReference)) diff --git a/simulator.rkt b/simulator.rkt index 182abbc..3082b73 100644 --- a/simulator.rkt +++ b/simulator.rkt @@ -91,7 +91,12 @@ [(eq? t 'val) (val-update m v)] [(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)) @@ -206,7 +211,13 @@ val-update] [(EnvLexicalReference? t) (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))