Cleaned up constant propagation, and added some arithmetic simplicications

phases/constant_propagation.ml

@@ -9,6 +9,11 @@
  * variables in general, some form of liveness analysis would be required (e.g.
  * Static Single Assignment form). Expressions can only be propagated when they
  * have no side effects, i.e. when they do not contain function calls.
+ *
+ * Constant propagation is merged with some some arithmetic simplification here,
+ * specifically targeting optimization oppertunities created bij earlier
+ * constant propagation. This is utilized, for example, in array index
+ * calculation when array dimensions are constant.
  *)
 open Types
 open Util
@@ -18,75 +23,102 @@ let is_const_name name =
 
 let is_const = function Const _ -> true | _ -> false
 
-let eval_monop = function
-    | (Not, Const (BoolVal  value, _), ann) -> Const (BoolVal  (not value), ann)
-    | (Neg, Const (IntVal   value, _), ann) -> Const (IntVal   (-value), ann)
-    | (Neg, Const (FloatVal value, _), ann) -> Const (FloatVal (-.value), ann)
-    | (op, opnd, ann) -> Monop (op, opnd, ann)
-
-let eval_binop = function
-    (* Arithmetic *)
-    | (Add, Const (IntVal left, _), Const (IntVal right, _), ann) ->
+(* Play-it-safe side effect analysis: only return true for variables and
+ * constants, since these are targeted in arithmetic simplification (in
+ * particular targeting array indices that can be simplified after array
+ * dimension reduction). *)
+let no_side_effect = function
+    | VarUse _ | Const _ | Var _ -> true
+    | _ -> false
+
+(* Constand folding *)
+let eval = function
+    (* Binop - arithmetic *)
+    | Binop (Add, Const (IntVal left, _), Const (IntVal right, _), ann) ->
         Const (IntVal (left + right), ann)
-    | (Add, Const (FloatVal left, _), Const (FloatVal right, _), ann) ->
+    | Binop (Add, Const (FloatVal left, _), Const (FloatVal right, _), ann) ->
         Const (FloatVal (left +. right), ann)
 
-    | (Sub, Const (IntVal left, _), Const (IntVal right, _), ann) ->
+    | Binop (Sub, Const (IntVal left, _), Const (IntVal right, _), ann) ->
         Const (IntVal (left - right), ann)
-    | (Sub, Const (FloatVal left, _), Const (FloatVal right, _), ann) ->
+    | Binop (Sub, Const (FloatVal left, _), Const (FloatVal right, _), ann) ->
         Const (FloatVal (left -. right), ann)
 
-    | (Mul, Const (IntVal left, _), Const (IntVal right, _), ann) ->
+    | Binop (Mul, Const (IntVal left, _), Const (IntVal right, _), ann) ->
         Const (IntVal (left * right), ann)
-    | (Mul, Const (FloatVal left, _), Const (FloatVal right, _), ann) ->
+    | Binop (Mul, Const (FloatVal left, _), Const (FloatVal right, _), ann) ->
         Const (FloatVal (left *. right), ann)
 
-    | (Div, Const (IntVal left, _), Const (IntVal right, _), ann) when right != 0 ->
+    | Binop (Div, Const (IntVal left, _), Const (IntVal right, _), ann) when right != 0 ->
         Const (IntVal (left / right), ann)
-    | (Div, Const (FloatVal left, _), Const (FloatVal right, _), ann) ->
+    | Binop (Div, Const (FloatVal left, _), Const (FloatVal right, _), ann) ->
         Const (FloatVal (left /. right), ann)
 
-    | (Mod, Const (IntVal left, _), Const (IntVal right, _), ann) ->
+    | Binop (Mod, Const (IntVal left, _), Const (IntVal right, _), ann) ->
         Const (IntVal (left mod right), ann)
 
-    (* Relational *)
-    | (Eq, Const (IntVal left, _), Const (IntVal right, _), ann) ->
+    (* Binop - relational *)
+    | Binop (Eq, Const (IntVal left, _), Const (IntVal right, _), ann) ->
         Const (BoolVal (left = right), ann)
-    | (Eq, Const (FloatVal left, _), Const (FloatVal right, _), ann) ->
+    | Binop (Eq, Const (FloatVal left, _), Const (FloatVal right, _), ann) ->
         Const (BoolVal (left = right), ann)
 
-    | (Ne, Const (IntVal left, _), Const (IntVal right, _), ann) ->
+    | Binop (Ne, Const (IntVal left, _), Const (IntVal right, _), ann) ->
         Const (BoolVal (left <> right), ann)
-    | (Ne, Const (FloatVal left, _), Const (FloatVal right, _), ann) ->
+    | Binop (Ne, Const (FloatVal left, _), Const (FloatVal right, _), ann) ->
         Const (BoolVal (left <> right), ann)
 
-    | (Gt, Const (IntVal left, _), Const (IntVal right, _), ann) ->
+    | Binop (Gt, Const (IntVal left, _), Const (IntVal right, _), ann) ->
         Const (BoolVal (left > right), ann)
-    | (Gt, Const (FloatVal left, _), Const (FloatVal right, _), ann) ->
+    | Binop (Gt, Const (FloatVal left, _), Const (FloatVal right, _), ann) ->
         Const (BoolVal (left > right), ann)
 
-    | (Lt, Const (IntVal left, _), Const (IntVal right, _), ann) ->
+    | Binop (Lt, Const (IntVal left, _), Const (IntVal right, _), ann) ->
         Const (BoolVal (left < right), ann)
-    | (Lt, Const (FloatVal left, _), Const (FloatVal right, _), ann) ->
+    | Binop (Lt, Const (FloatVal left, _), Const (FloatVal right, _), ann) ->
         Const (BoolVal (left < right), ann)
 
-    | (Ge, Const (IntVal left, _), Const (IntVal right, _), ann) ->
+    | Binop (Ge, Const (IntVal left, _), Const (IntVal right, _), ann) ->
         Const (BoolVal (left >= right), ann)
-    | (Ge, Const (FloatVal left, _), Const (FloatVal right, _), ann) ->
+    | Binop (Ge, Const (FloatVal left, _), Const (FloatVal right, _), ann) ->
         Const (BoolVal (left >= right), ann)
 
-    | (Le, Const (IntVal left, _), Const (IntVal right, _), ann) ->
+    | Binop (Le, Const (IntVal left, _), Const (IntVal right, _), ann) ->
         Const (BoolVal (left <= right), ann)
-    | (Le, Const (FloatVal left, _), Const (FloatVal right, _), ann) ->
+    | Binop (Le, Const (FloatVal left, _), Const (FloatVal right, _), ann) ->
         Const (BoolVal (left <= right), ann)
 
-    (* Logical *)
-    | (And, Const (BoolVal left, _), Const (BoolVal right, _), ann) ->
+    (* Binop - logical *)
+    | Binop (And, Const (BoolVal left, _), Const (BoolVal right, _), ann) ->
         Const (BoolVal (left && right), ann)
-    | (Or, Const (BoolVal left, _), Const (BoolVal right, _), ann) ->
+    | Binop (Or, Const (BoolVal left, _), Const (BoolVal right, _), ann) ->
         Const (BoolVal (left || right), ann)
 
-    | (op, left, right, ann) -> Binop (op, left, right, ann)
+    (* Monary operations *)
+    | Monop (Not, Const (BoolVal  value, _), ann) -> Const (BoolVal  (not value), ann)
+    | Monop (Neg, Const (IntVal   value, _), ann) -> Const (IntVal   (-value), ann)
+    | Monop (Neg, Const (FloatVal value, _), ann) -> Const (FloatVal (-.value), ann)
+
+    (* 0 * a --> 0 *)
+    | Binop (Mul, Const (IntVal 0, _), other, ann)
+    | Binop (Mul, other, Const (IntVal 0, _), ann) when no_side_effect other ->
+        Const (IntVal 0, ann)
+
+    (* 0 + a --> a *)
+    | Binop (Add, Const (IntVal 0, _), other, _)
+    | Binop (Add, other, Const (IntVal 0, _), _) ->
+        other
+
+    (* 1 * a --> a *)
+    | Binop (Mul, Const (IntVal 1, _), other, _)
+    | Binop (Mul, other, Const (IntVal 1, _), _) ->
+        other
+
+    (* true|false ? texp : fexp --> texp|fexp*)
+    | Cond (Const (BoolVal value, _), texp, fexp, _) ->
+        if value then texp else fexp
+
+    | node -> node
 
 let rec propagate consts node =
     let propagate = propagate consts in
@@ -120,26 +152,13 @@ let rec propagate consts node =
 
     (* Apply arithmetic simplification to constant operands *)
     | Monop (op, opnd, ann) ->
-        let opnd = propagate opnd in
-        if is_const opnd
-            then eval_monop (op, opnd, ann)
-            else Monop (op, opnd, ann)
+        eval (Monop (op, propagate opnd, ann))
 
     | Binop (op, left, right, ann) ->
-        let left = propagate left in
-        let right = propagate right in
-        if is_const left && is_const right
-            then eval_binop (op, left, right, ann)
-            else Binop (op, left, right, ann)
+        eval (Binop (op, propagate left, propagate right, ann))
 
     | Cond (cond, texp, fexp, ann) ->
-        let cond = propagate cond in
-        let texp = propagate texp in
-        let fexp = propagate fexp in
-        (match cond with
-        | Const (BoolVal value, _) -> if value then texp else fexp
-        | _ -> Cond (cond, texp, fexp, ann)
-        )
+        eval (Cond (propagate cond, propagate texp, propagate fexp, ann))
 
     | TypeCast (ctype, value, ann) ->
         let value = propagate value in

test/old/constant_propagation.cvc

@@ -1,9 +1,16 @@
 extern void printInt(int val);
 
+int foo() {
+    return 3;
+}
+
 export int main() {
-    for (int i = 0, 10) {
-        printInt(i);
-    }
+    int[2, foo()] a = [1, 2];
+    int i = 1;
+
+    printInt(a[0, 2]);  // a[2]
+    printInt(a[1, 1]);  // a[a$dim$$X + 1]
+    printInt(i);        // 1
 
     return 0;
 }