From 7f6ed34b957b6080c4c1ba9c8cf4dbc6d692c3fe Mon Sep 17 00:00:00 2001
From: Danny Yoo <dyoo@cs.wpi.edu>
Date: Sun, 24 Apr 2011 18:51:10 -0400
Subject: [PATCH] trying to simplify structures some more.

---
 bootstrapped-primitives.rkt |  2 +-
 compiler.rkt                | 29 +++++++++++++++++++++--------
 il-structs.rkt              | 13 ++++++++++++-
 package.rkt                 |  2 +-
 test-compiler.rkt           |  2 +-
 5 files changed, 36 insertions(+), 12 deletions(-)

diff --git a/bootstrapped-primitives.rkt b/bootstrapped-primitives.rkt
index 72d47f6..de0ea02 100644
--- a/bootstrapped-primitives.rkt
+++ b/bootstrapped-primitives.rkt
@@ -69,7 +69,7 @@
 (define (make-bootstrapped-primitive-code name src)
   (parameterize ([current-defined-name name])
     (append
-     (compile (parse src) (make-PrimitivesReference name) next-linkage))))
+     (compile (parse src) (make-PrimitivesReference name) next-linkage/drop-multiple))))
 
 
 
diff --git a/compiler.rkt b/compiler.rkt
index e65ba81..1deec1a 100644
--- a/compiler.rkt
+++ b/compiler.rkt
@@ -189,7 +189,10 @@
           (append-instruction-sequences
            (make-instruction-sequence 
             `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! names))))
-           (compile (Top-code top) (cons (Top-prefix top) cenv) target next-linkage)
+           (compile (Top-code top) 
+		    (cons (Top-prefix top) cenv)
+		    target
+		    next-linkage/drop-multiple)
            (make-instruction-sequence
             `(,(make-PopEnvironment (make-Const 1) 
                                     (make-Const 0))))))))
@@ -373,8 +376,9 @@
   ;; All but the last will use next-linkage linkage.
   (if (last-exp? seq)
       (compile (first-exp seq) cenv target linkage)
-      (append-instruction-sequences (compile (first-exp seq) cenv target next-linkage)
-                                    (compile-sequence (rest-exps seq) cenv target linkage))))
+      (append-instruction-sequences 
+       (compile (first-exp seq) cenv target next-linkage/drop-multiple)
+       (compile-sequence (rest-exps seq) cenv target linkage))))
 
 
 (: compile-splice ((Listof Expression) CompileTimeEnvironment Target Linkage -> InstructionSequence))
@@ -573,7 +577,10 @@
                              next-linkage-expects-single)]
          [operand-codes (map (lambda: ([operand : Expression]
                                        [target : Target])
-                                      (compile operand extended-cenv target next-linkage-expects-single))
+                                      (compile operand
+					       extended-cenv
+					       target
+					       next-linkage-expects-single))
                              (App-operands exp)
                              (build-list (length (App-operands exp))
                                          (lambda: ([i : Natural])
@@ -724,7 +731,10 @@
                     (apply append-instruction-sequences
                            (map (lambda: ([operand : Expression]
                                           [target : Target])
-                                         (compile operand extended-cenv target next-linkage-expects-single))
+                                         (compile operand 
+						  extended-cenv 
+						  target 
+						  next-linkage-expects-single))
                                 rest-operands
                                 rest-operand-poss))])
        
@@ -875,7 +885,10 @@
 			       next-linkage-expects-single)]
 	   [operand-codes (map (lambda: ([operand : Expression]
 					 [target : Target])
-					(compile operand extended-cenv target next-linkage-expects-single))
+					(compile operand 
+						 extended-cenv 
+						 target 
+						 next-linkage-expects-single))
 			       (App-operands exp)
 			       (build-list (length (App-operands exp))
 					   (lambda: ([i : Natural])
@@ -1502,9 +1515,9 @@
 		       -> InstructionSequence))
   (define (in-other-context linkage)
     (let ([body-next-linkage (cond [(NextLinkage? linkage)
-				    next-linkage]
+				    next-linkage/drop-multiple]
 				   [(LabelLinkage? linkage)
-				    next-linkage]
+				    next-linkage/drop-multiple]
 				   [(NextLinkage/Expects? linkage)
 				    linkage]
 				   [(LabelLinkage/Expects? linkage)
diff --git a/il-structs.rkt b/il-structs.rkt
index b832238..eec9eaa 100644
--- a/il-structs.rkt
+++ b/il-structs.rkt
@@ -402,11 +402,22 @@
 
 
 
+;; A ValuesContext describes if a context either
+;;    * accepts any number multiple values by dropping them from the stack.
+;;    * accepts any number of multiple values by maintaining them on the stack.
+;;    * accepts exactly n values, erroring out
+(define-type ValuesContext (U 'drop-multiple 
+			      'keep-multiple
+			      Natural))
 
 
 ;; Linkage
 (define-struct: NextLinkage ())
-(define next-linkage (make-NextLinkage))
+(define next-linkage/drop-multiple (make-NextLinkage))
+
+
+
+
 
 ;; NextLinkage/Expects works like NextLinkage, but should check that
 ;; it is returning 'expects' values back.
diff --git a/package.rkt b/package.rkt
index e6e315f..19e1c54 100644
--- a/package.rkt
+++ b/package.rkt
@@ -19,7 +19,7 @@
   (assemble/write-invoke (append (get-bootstrapping-code)
 				 (compile (parse source-code)
 					  'val
-					  next-linkage))
+					  next-linkage/drop-multiple))
                          op)
   (fprintf op ";\n"))
 
diff --git a/test-compiler.rkt b/test-compiler.rkt
index b77a1e3..012cf27 100644
--- a/test-compiler.rkt
+++ b/test-compiler.rkt
@@ -9,7 +9,7 @@
 
 
 (define (run-compiler code)
-  (compile (parse code) 'val next-linkage))
+  (compile (parse code) 'val next-linkage/drop-multiple))
   
 
 ;; Test out the compiler, using the simulator.