adding operator to get at a single closure value

This commit is contained in:
Danny Yoo 2011-05-04 15:21:20 -04:00
parent b388d01ff8
commit 484d3dae6d
5 changed files with 37 additions and 12 deletions

View File

@ -45,10 +45,12 @@
(assemble-control-stack-label v)] (assemble-control-stack-label v)]
[(ControlStackLabel/MultipleValueReturn? v) [(ControlStackLabel/MultipleValueReturn? v)
(assemble-control-stack-label/multiple-value-return v)] (assemble-control-stack-label/multiple-value-return v)]
[(ControlFrameTemporary? v)
(assemble-control-frame-temporary v)]
[(CompiledProcedureEntry? v) [(CompiledProcedureEntry? v)
(assemble-compiled-procedure-entry v)] (assemble-compiled-procedure-entry v)]
[(ControlFrameTemporary? v) [(CompiledProcedureClosureReference? v)
(assemble-control-frame-temporary v)])) (assemble-compiled-procedure-closure-reference v)]))
@ -177,6 +179,13 @@
(assemble-oparg (CompiledProcedureEntry-proc a-compiled-procedure-entry)))) (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)) (: assemble-default-continuation-prompt-tag (-> String))
(define (assemble-default-continuation-prompt-tag) (define (assemble-default-continuation-prompt-tag)

View File

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

View File

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

View File

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

View File

@ -752,14 +752,18 @@
(let ([label (CallFrame-return frame)]) (let ([label (CallFrame-return frame)])
(LinkedLabel-linked-to label))]))] (LinkedLabel-linked-to label))]))]
[(CompiledProcedureEntry? an-oparg)
(let ([proc (ensure-closure (evaluate-oparg m (CompiledProcedureEntry-proc an-oparg)))])
(closure-label proc))]
[(ControlFrameTemporary? an-oparg) [(ControlFrameTemporary? an-oparg)
(let ([ht (frame-temps (control-top m))]) (let ([ht (frame-temps (control-top m))])
(hash-ref ht (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)))]))