continuing to clean up the emitted code.

compiler/il-structs.rkt

@@ -97,11 +97,22 @@
 (define (new-SubtractArg lhs rhs)
   ;; FIXME: do some limited constant folding here
   (cond
-   [(and (Const? lhs) (number? lhs)
+   [(and (Const? lhs)(Const? rhs))
-         (Const? rhs) (number? rhs))
+    (let ([lhs-val (Const-const lhs)]
-    (make-Const (- lhs rhs))]
+          [rhs-val (Const-const rhs)])
-   [(and (Const? rhs) (number? rhs) (= rhs 0))
+      (cond [(and (number? lhs-val)
-    lhs]
+                  (number? rhs-val))
+             (make-Const (- lhs-val rhs-val))]
+            [else
+             (make-SubtractArg lhs rhs)]))]
+   [(Const? rhs)
+    (let ([rhs-val (Const-const rhs)])
+      (cond
+       [(and (number? rhs-val)
+             (= rhs-val 0))
+        lhs]
+       [else
+        (make-SubtractArg lhs rhs)]))]
    [else
     (make-SubtractArg lhs rhs)]))
 

compiler/optimize-il.rkt

@@ -18,7 +18,7 @@
   ;; For now, replace pairs of PushEnvironment / AssignImmediate(0, ...)
   ;; We should do some more optimizations here, like peephole...
   (let* ([statements (filter not-no-op? statements)]
-         [statements (eliminate-no-ops statements)]
+         [statements (pairwise-reductions statements)]
          [statements (flatten-adjacent-labels statements)])
     statements))
 
@@ -302,8 +302,8 @@
     
 
 
-(: eliminate-no-ops ((Listof Statement) -> (Listof Statement)))
+(: pairwise-reductions ((Listof Statement) -> (Listof Statement)))
-(define (eliminate-no-ops statements)
+(define (pairwise-reductions statements)
   (let loop ([statements statements])
       (cond
        [(empty? statements)
@@ -319,6 +319,9 @@
            [else
             (let ([second-stmt (second statements)])
               (cond
+               
+               ;; A PushEnvironment followed by a direct AssignImmediate can be reduced to a single
+               ;; instruction.
                [(and (PushEnvironment? first-stmt)
                      (equal? first-stmt (make-PushEnvironment 1 #f))
                      (AssignImmediateStatement? second-stmt))
@@ -332,6 +335,32 @@
                           (loop (rest (rest statements))))]
                    [else
                     (default)]))]
+
+               ;; Adjacent PopEnvironments with constants can be reduced to single ones
+               [(and (PopEnvironment? first-stmt)
+                     (PopEnvironment? second-stmt))
+                (let ([first-n (PopEnvironment-n first-stmt)]
+                      [second-n (PopEnvironment-n second-stmt)]
+                      [first-skip (PopEnvironment-skip first-stmt)]
+                      [second-skip (PopEnvironment-skip first-stmt)])
+                  (cond [(and (Const? first-n) (Const? second-n) (Const? first-skip) (Const? second-skip))
+                         (let ([first-n-val (Const-const first-n)]
+                               [second-n-val (Const-const second-n)]
+                               [first-skip-val (Const-const first-skip)]
+                               [second-skip-val (Const-const second-skip)])
+                           (cond
+                            [(and (number? first-n-val)
+                                  (number? second-n-val)
+                                  (number? first-skip-val) (= first-skip-val 0)
+                                  (number? second-skip-val) (= second-skip-val 0))
+                             (loop (cons (make-PopEnvironment (make-Const (+ first-n-val second-n-val))
+                                                              (make-Const 0))
+                                         (rest (rest statements))))]
+                            [else
+                             (default)]))]
+                         [else
+                          (default)]))]
+
                [else
                 (default)]))]))])))