adding operator to get at a single closure value

assemble-helpers.rkt

@@ -45,10 +45,12 @@
      (assemble-control-stack-label v)]
     [(ControlStackLabel/MultipleValueReturn? v)
      (assemble-control-stack-label/multiple-value-return v)]
+    [(ControlFrameTemporary? v)
+     (assemble-control-frame-temporary v)]
     [(CompiledProcedureEntry? v)
      (assemble-compiled-procedure-entry v)]
-    [(ControlFrameTemporary? v)
-     (assemble-control-frame-temporary v)]))
+    [(CompiledProcedureClosureReference? v)
+     (assemble-compiled-procedure-closure-reference v)]))
 
 
 
@@ -177,6 +179,13 @@
           (assemble-oparg (CompiledProcedureEntry-proc a-compiled-procedure-entry))))
 
 
+(: assemble-compiled-procedure-closure-reference (CompiledProcedureClosureReference -> String))
+(define (assemble-compiled-procedure-closure-reference a-ref)
+  (format "(~a).closedVals[~a]"
+          (assemble-oparg (CompiledProcedureClosureReference-proc a-ref))
+          (CompiledProcedureClosureReference-n a-ref)))
+
+
 
 (: assemble-default-continuation-prompt-tag (-> String))
 (define (assemble-default-continuation-prompt-tag)

collect-jump-targets.rkt

@@ -83,10 +83,13 @@
     empty]
    [(ControlStackLabel/MultipleValueReturn? an-input)
     empty]
+   [(ControlFrameTemporary? an-input)
+    empty]
    [(CompiledProcedureEntry? an-input)
     (collect-input (CompiledProcedureEntry-proc an-input))]
-   [(ControlFrameTemporary? an-input)
-    empty]))
+   [(CompiledProcedureClosureReference? an-input)
+    (collect-input (CompiledProcedureClosureReference-proc an-input))]))
+
 
 (: collect-location ((U Reg Label) -> (Listof Symbol)))
 (define (collect-location a-location)

il-structs.rkt

@@ -29,8 +29,9 @@
                       SubtractArg
 		      ControlStackLabel
 		      ControlStackLabel/MultipleValueReturn
+                      ControlFrameTemporary
                       CompiledProcedureEntry
-                      ControlFrameTemporary))
+                      CompiledProcedureClosureReference))
 
 
 ;; Targets: these are the allowable lhs's for an assignment.
@@ -76,6 +77,10 @@
   #:transparent)
 
 
+;; Get at the nth value in a closure's list of closed values.
+(define-struct: CompiledProcedureClosureReference ([proc : OpArg]
+                                                   [n : Natural])
+  #:transparent)
 
 
 

optimize-il.rkt

@@ -125,10 +125,14 @@
      oparg]
     [(ControlStackLabel/MultipleValueReturn? oparg)
      oparg]
+    [(ControlFrameTemporary? oparg)
+     oparg]
     [(CompiledProcedureEntry? oparg)
      (make-CompiledProcedureEntry (adjust-oparg-depth (CompiledProcedureEntry-proc oparg) n))]
-    [(ControlFrameTemporary? oparg)
-     oparg]))
+    [(CompiledProcedureClosureReference? oparg)
+     (make-CompiledProcedureClosureReference 
+      (adjust-oparg-depth (CompiledProcedureClosureReference-proc oparg) n)
+      (CompiledProcedureClosureReference-n oparg))]))
 
 
 (define-predicate natural? Natural)

simulator.rkt

@@ -752,14 +752,18 @@
 	 (let ([label (CallFrame-return frame)])
 	   (LinkedLabel-linked-to label))]))]
 
-    [(CompiledProcedureEntry? an-oparg)
-     (let ([proc (ensure-closure (evaluate-oparg m (CompiledProcedureEntry-proc an-oparg)))])
-       (closure-label proc))]
-
     [(ControlFrameTemporary? an-oparg)
      (let ([ht (frame-temps (control-top m))])
        (hash-ref ht
-                 (ControlFrameTemporary-name an-oparg)))]))
+                 (ControlFrameTemporary-name an-oparg)))]
+    
+    [(CompiledProcedureEntry? an-oparg)
+     (let ([proc (ensure-closure (evaluate-oparg m (CompiledProcedureEntry-proc an-oparg)))])
+       (closure-label proc))]
+    
+    [(CompiledProcedureClosureReference? an-oparg)
+     (let ([proc (ensure-closure (evaluate-oparg m (CompiledProcedureClosureReference-proc an-oparg)))])
+       (list-ref (closure-vals proc) (CompiledProcedureClosureReference-n an-oparg)))]))