From 66a2d6b0ef675913d38ffc327b4c6bc7ba3363ea Mon Sep 17 00:00:00 2001
From: Danny Yoo <dyoo@cs.wpi.edu>
Date: Sun, 10 Apr 2011 21:25:52 -0400
Subject: [PATCH] adding pushimmediateontoenvironment

---
 assemble.rkt    | 10 +++++++++-
 compile.rkt     | 28 +++++++++++++++-------------
 il-structs.rkt  |  9 +++++++++
 optimize-il.rkt | 13 +++++++++++++
 simulator.rkt   |  8 ++++++++
 5 files changed, 54 insertions(+), 14 deletions(-)
 create mode 100644 optimize-il.rkt

diff --git a/assemble.rkt b/assemble.rkt
index 7ceeb03..2f4070f 100644
--- a/assemble.rkt
+++ b/assemble.rkt
@@ -200,6 +200,8 @@ EOF
                              empty]
                             [(PopEnvironment? stmt)
                              empty]
+                            [(PushImmediateOntoEnvironment? stmt)
+                             (collect-input (PushImmediateOntoEnvironment-value stmt))]
                             [(PushControlFrame? stmt)
                              (list (PushControlFrame-label stmt))]
                             [(PushControlFrame/Prompt? stmt)
@@ -298,7 +300,13 @@ EOF
            (format "MACHINE.env.splice(MACHINE.env.length - (~a + ~a), ~a);"
                    (assemble-oparg (PopEnvironment-skip stmt))
                    (assemble-oparg (PopEnvironment-n stmt))
-                   (assemble-oparg (PopEnvironment-n stmt)))]))])))
+                   (assemble-oparg (PopEnvironment-n stmt)))]))]
+
+     [(PushImmediateOntoEnvironment? stmt)
+      (format "MACHINE.env.push(~a)"
+              (cond [(PushImmediateOntoEnvironment-box? stmt)
+                     (format "[~a]" (assemble-oparg (PushImmediateOntoEnvironment-value stmt)))
+                     (assemble-oparg (PushImmediateOntoEnvironment-value stmt))]))])))
 
 
 (: ensure-natural (Any -> Natural))
diff --git a/compile.rkt b/compile.rkt
index 9fe451b..7b630f9 100644
--- a/compile.rkt
+++ b/compile.rkt
@@ -4,6 +4,7 @@
          "lexical-structs.rkt"
          "il-structs.rkt"
          "kernel-primitives.rkt"
+         "optimize-il.rkt"
          racket/bool
          racket/list)
 
@@ -23,19 +24,20 @@
 (define (-compile exp target linkage)
   (let ([after-lam-bodies (make-label 'afterLamBodies)]
         [before-pop-prompt (make-label 'beforePopPrompt)])
-    (statements
-     (append-instruction-sequences 
-      
-      (make-instruction-sequence 
-       `(,(make-GotoStatement (make-Label after-lam-bodies))))
-      (compile-lambda-bodies (collect-all-lams exp))
-      after-lam-bodies
-      
-      (make-instruction-sequence
-       `(,(make-PushControlFrame/Prompt default-continuation-prompt-tag
-                                        before-pop-prompt)))
-      (compile exp '() target prompt-linkage)
-      before-pop-prompt))))
+    (optimize-il
+     (statements
+      (append-instruction-sequences 
+       
+       (make-instruction-sequence 
+        `(,(make-GotoStatement (make-Label after-lam-bodies))))
+       (compile-lambda-bodies (collect-all-lams exp))
+       after-lam-bodies
+       
+       (make-instruction-sequence
+        `(,(make-PushControlFrame/Prompt default-continuation-prompt-tag
+                                         before-pop-prompt)))
+       (compile exp '() target prompt-linkage)
+       before-pop-prompt)))))
 
 (define-struct: lam+cenv ([lam : Lam]
                           [cenv : CompileTimeEnvironment]))
diff --git a/il-structs.rkt b/il-structs.rkt
index 00de8f4..72ec657 100644
--- a/il-structs.rkt
+++ b/il-structs.rkt
@@ -71,6 +71,9 @@
                                  
                                  PopEnvironment
                                  PushEnvironment
+                                 
+                                 PushImmediateOntoEnvironment
+                                 
                                  PushControlFrame
                                  PushControlFrame/Prompt
 
@@ -98,6 +101,12 @@
   #:transparent)
 
 
+;; Evaluate the value, and then push it onto the top of the environment.
+(define-struct: PushImmediateOntoEnvironment ([value : OpArg]
+                                              [box? : Boolean])
+  #:transparent)
+
+
 (define-struct: PopControlFrame () 
   #:transparent)
 (define-struct: PopControlFrame/Prompt () 
diff --git a/optimize-il.rkt b/optimize-il.rkt
new file mode 100644
index 0000000..d24633e
--- /dev/null
+++ b/optimize-il.rkt
@@ -0,0 +1,13 @@
+#lang typed/racket/base
+(require "il-structs.rkt")
+
+(provide optimize-il)
+
+;; perform optimizations on the intermediate language.
+;;
+
+
+
+(: optimize-il ((Listof Statement) -> (Listof Statement)))
+(define (optimize-il statements)
+  statements)
diff --git a/simulator.rkt b/simulator.rkt
index 3b372ae..eff83a7 100644
--- a/simulator.rkt
+++ b/simulator.rkt
@@ -103,6 +103,8 @@
                      (step-pop-environment! m i)]
                     [(PushEnvironment? i)
                      (step-push-environment! m i)]
+                    [(PushImmediateOntoEnvironment? i)
+                     (step-push-immediate-onto-environment! m i)]
                     [(PushControlFrame? i)
                      (step-push-control-frame! m i)]
                     [(PushControlFrame/Prompt? i)
@@ -156,6 +158,12 @@
             (ensure-natural (evaluate-oparg m (PopEnvironment-n stmt)))
             (ensure-natural (evaluate-oparg m (PopEnvironment-skip stmt)))))
 
+(: step-push-immediate-onto-environment! (machine PushImmediateOntoEnvironment -> 'ok))
+(define (step-push-immediate-onto-environment! m stmt)
+  (let ([t (make-EnvLexicalReference 0 (PushImmediateOntoEnvironment-box? stmt))]
+        [v (evaluate-oparg m (PushImmediateOntoEnvironment-value stmt))])
+    (step-push-environment! m (make-PushEnvironment 1 (PushImmediateOntoEnvironment-box? stmt)))
+    ((get-target-updater t) m v)))
 
 (: step-push-control-frame! (machine PushControlFrame -> 'ok))
 (define (step-push-control-frame! m stmt)