starting to add skeleton code to do def-values
This commit is contained in:
parent
36627c798a
commit
bd41d16bb2
37
compiler.rkt
37
compiler.rkt
|
@ -124,7 +124,9 @@
|
|||
(loop (WithContMark-body exp) cenv))]
|
||||
[(ApplyValues? exp)
|
||||
(append (loop (ApplyValues-proc exp) cenv)
|
||||
(loop (ApplyValues-args-expr exp) cenv))])))
|
||||
(loop (ApplyValues-args-expr exp) cenv))]
|
||||
[(DefValues? exp)
|
||||
(append (loop (DefValues-rhs exp) cenv))])))
|
||||
|
||||
|
||||
|
||||
|
@ -183,7 +185,9 @@
|
|||
[(WithContMark? exp)
|
||||
(compile-with-cont-mark exp cenv target linkage)]
|
||||
[(ApplyValues? exp)
|
||||
(compile-apply-values exp cenv target linkage)]))
|
||||
(compile-apply-values exp cenv target linkage)]
|
||||
[(DefValues? exp)
|
||||
(compile-def-values exp cenv target linkage)]))
|
||||
|
||||
|
||||
|
||||
|
@ -1495,6 +1499,20 @@
|
|||
(compile-general-procedure-call cenv (make-Reg 'argcount) target linkage))))
|
||||
|
||||
|
||||
(: compile-def-values (DefValues CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
(define (compile-def-values exp cenv target linkage)
|
||||
(let ([ids (DefValues-ids exp)]
|
||||
[rhs (DefValues-rhs exp)])
|
||||
;; First, compile the body with expectations for
|
||||
(end-with-linkage
|
||||
linkage
|
||||
cenv
|
||||
(append-instruction-sequences
|
||||
(compile rhs cenv 'val (make-NextLinkage (length ids)))
|
||||
;; Now install each of the values in place
|
||||
))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
@ -1537,6 +1555,12 @@
|
|||
(error 'ensure-lam "Not a Lam: ~s" x)))
|
||||
|
||||
|
||||
(: ensure-toplevelref (Any -> ToplevelRef))
|
||||
(define (ensure-toplevelref x)
|
||||
(if (ToplevelRef? x)
|
||||
x
|
||||
(error 'ensure-toplevelref "Not a ToplevelRef: ~s" x)))
|
||||
|
||||
|
||||
(: adjust-target-depth (Target Natural -> Target))
|
||||
(define (adjust-target-depth target n)
|
||||
|
@ -1681,6 +1705,11 @@
|
|||
(adjust-expression-depth (WithContMark-body exp) n skip))]
|
||||
[(ApplyValues? exp)
|
||||
(make-ApplyValues (adjust-expression-depth (ApplyValues-proc exp) n skip)
|
||||
(adjust-expression-depth (ApplyValues-args-expr exp) n skip))]))
|
||||
|
||||
(adjust-expression-depth (ApplyValues-args-expr exp) n skip))]
|
||||
|
||||
[(DefValues? exp)
|
||||
(make-DefValues (map (lambda: ([id : ToplevelRef])
|
||||
(ensure-toplevelref
|
||||
(adjust-expression-depth id n skip)))
|
||||
(DefValues-ids exp))
|
||||
(adjust-expression-depth (DefValues-rhs exp) n skip))]))
|
|
@ -15,7 +15,8 @@
|
|||
InstallValue
|
||||
BoxEnv
|
||||
WithContMark
|
||||
ApplyValues))
|
||||
ApplyValues
|
||||
DefValues))
|
||||
|
||||
(define-struct: Top ([prefix : Prefix]
|
||||
[code : Expression]) #:transparent)
|
||||
|
@ -86,6 +87,12 @@
|
|||
#:transparent)
|
||||
|
||||
|
||||
;; Multiple value definition
|
||||
(define-struct: DefValues ([ids : (Listof ToplevelRef)]
|
||||
[rhs : Expression])
|
||||
#:transparent)
|
||||
|
||||
|
||||
|
||||
(: last-exp? ((Listof Expression) -> Boolean))
|
||||
(define (last-exp? seq)
|
||||
|
|
Loading…
Reference in New Issue
Block a user