From bd41d16bb2da87e7d83907217d532e736c107201 Mon Sep 17 00:00:00 2001
From: Danny Yoo <dyoo@cs.wpi.edu>
Date: Wed, 27 Apr 2011 21:29:52 -0400
Subject: [PATCH] starting to add skeleton code to do def-values

---
 compiler.rkt           | 37 +++++++++++++++++++++++++++++++++----
 expression-structs.rkt |  9 ++++++++-
 2 files changed, 41 insertions(+), 5 deletions(-)

diff --git a/compiler.rkt b/compiler.rkt
index f86e70d..c9b63dc 100644
--- a/compiler.rkt
+++ b/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))]))
\ No newline at end of file
diff --git a/expression-structs.rkt b/expression-structs.rkt
index 03b1843..d622277 100644
--- a/expression-structs.rkt
+++ b/expression-structs.rkt
@@ -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)