From 1aa3e77a571edd00bceabb14fd8718b1de1f3766 Mon Sep 17 00:00:00 2001
From: Danny Yoo <dyoo@cs.wpi.edu>
Date: Sun, 10 Apr 2011 22:08:21 -0400
Subject: [PATCH] optimizing some stack usage

---
 NOTES           | 20 +++++++++++++--
 assemble.rkt    | 13 ++++++----
 optimize-il.rkt | 66 +++++++++++++++++++++++++++++++++++++++++++++++--
 3 files changed, 90 insertions(+), 9 deletions(-)

diff --git a/NOTES b/NOTES
index 13c7fbd..94ea350 100644
--- a/NOTES
+++ b/NOTES
@@ -171,7 +171,7 @@ prefix, and we can reduce some allocation.
 
 
 
-I can eliminate an instruction in the pair:
+I can eliminate the first instruction in the pair:
 
 
     #(struct:AssignPrimOpStatement val #(struct:GetCompiledProcedureEntry))
@@ -182,4 +182,20 @@ since the val isn't even being used here...  This is the case when we
 statically know the lambda target.
 
 
-   - ok, done.
\ No newline at end of file
+    - this is done now.
+
+
+
+I can coalese
+
+     (PushEnvironment 1 #f)
+     (AssignPrimOpStatement (EnvLexicalReference 0 #f) (MakeCompiledProcedure 'lamEntry265 1 '(2 1) 'diff)
+
+into a single statement.
+
+
+
+
+
+If lambdas don't escape, then we can make their closures empty by
+simply explicitly passing in the free arguments.
\ No newline at end of file
diff --git a/assemble.rkt b/assemble.rkt
index 2f4070f..e9f66ae 100644
--- a/assemble.rkt
+++ b/assemble.rkt
@@ -301,12 +301,15 @@ EOF
                    (assemble-oparg (PopEnvironment-skip 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))]))])))
+      (format "MACHINE.env.push(~a);"
+              (let: ([val-string : String
+                                 (cond [(PushImmediateOntoEnvironment-box? stmt)
+                                        (format "[~a]" (assemble-oparg (PushImmediateOntoEnvironment-value stmt)))]
+                                       [else
+                                        (assemble-oparg (PushImmediateOntoEnvironment-value stmt))])])
+                    val-string))])))
 
 
 (: ensure-natural (Any -> Natural))
diff --git a/optimize-il.rkt b/optimize-il.rkt
index d24633e..464b046 100644
--- a/optimize-il.rkt
+++ b/optimize-il.rkt
@@ -1,5 +1,7 @@
 #lang typed/racket/base
-(require "il-structs.rkt")
+(require "il-structs.rkt"
+         "lexical-structs.rkt"
+         racket/list)
 
 (provide optimize-il)
 
@@ -10,4 +12,64 @@
 
 (: optimize-il ((Listof Statement) -> (Listof Statement)))
 (define (optimize-il statements)
-  statements)
+  ;; For now, replace pairs of PushEnvironment / AssignImmediate(0, ...)
+  ;; We should do some more optimizations here, like peephole...
+  (let loop ([statements statements])
+    (cond
+      [(empty? statements)
+       empty]
+      [else
+       (let ([first-stmt (first statements)])
+         (: default (-> (Listof Statement)))
+         (define (default)
+           (cons first-stmt
+                 (loop (rest statements))))
+         (cond
+           [(empty? (rest statements))
+            (default)]
+           [else
+            (let ([second-stmt (second statements)])
+              (cond
+                [(and (PushEnvironment? first-stmt)
+                      (equal? first-stmt (make-PushEnvironment 1 #f))
+                      (AssignImmediateStatement? second-stmt))
+                 (let ([target (AssignImmediateStatement-target second-stmt)])
+                   (cond
+                     [(equal? target (make-EnvLexicalReference 0 #f))
+                      (cons (make-PushImmediateOntoEnvironment 
+                             (adjust-oparg-depth 
+                              (AssignImmediateStatement-value second-stmt) -1)
+                             #f)
+                            (loop (rest (rest statements))))]
+                     [else
+                      (default)]))]
+                [else
+                 (default)]))]))])))
+       
+
+
+
+(: adjust-oparg-depth (OpArg Integer -> OpArg))
+(define (adjust-oparg-depth oparg n)
+  (cond
+    [(Const? oparg) oparg]
+    [(Label? oparg) oparg]
+    [(Reg? oparg) oparg]
+    [(EnvLexicalReference? oparg)
+     (make-EnvLexicalReference (ensure-natural (+ n (EnvLexicalReference-depth oparg)))
+                               (EnvLexicalReference-unbox? oparg))]
+    [(EnvPrefixReference? oparg)
+     (make-EnvPrefixReference (ensure-natural (+ n (EnvPrefixReference-depth oparg)))
+                              (EnvPrefixReference-pos oparg))]
+    [(EnvWholePrefixReference? oparg)
+     (make-EnvWholePrefixReference (ensure-natural (+ n (EnvWholePrefixReference-depth oparg))))]
+    [(SubtractArg? oparg)
+     (make-SubtractArg (adjust-oparg-depth (SubtractArg-lhs oparg) n)
+                       (adjust-oparg-depth (SubtractArg-rhs oparg) n))]))
+
+
+(define-predicate natural? Natural)
+(define (ensure-natural x)
+  (if (natural? x)
+      x
+      (error 'ensure-natural)))
\ No newline at end of file