starting to add skeleton code to do def-values

This commit is contained in:
Danny Yoo 2011-04-27 21:29:52 -04:00
parent 36627c798a
commit bd41d16bb2
2 changed files with 41 additions and 5 deletions

View File

@ -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))]))

View File

@ -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)