|
@@ -2,47 +2,36 @@ open Printf
|
|
|
open Types
|
|
open Types
|
|
|
open Util
|
|
open Util
|
|
|
|
|
|
|
|
-(* Generate new variables for array dimensions in function bodies, to avoid
|
|
|
|
|
- * re-evalutation after array dimension reduction. For example:
|
|
|
|
|
- *
|
|
|
|
|
- * int dims = 0;
|
|
|
|
|
- *
|
|
|
|
|
- * int dim() {
|
|
|
|
|
- * dims = dims 1; // Side effect => dims() should be called once
|
|
|
|
|
- * return 10;
|
|
|
|
|
- * }
|
|
|
|
|
- *
|
|
|
|
|
- * void foo() {
|
|
|
|
|
- * int[10, dim()] arr;
|
|
|
|
|
- * arr[0, 1] = 1;
|
|
|
|
|
- * }
|
|
|
|
|
- *
|
|
|
|
|
- * After dimension reduction, this would become:
|
|
|
|
|
- * void foo() {
|
|
|
|
|
- * int[] arr;
|
|
|
|
|
- * arr = allocate(10, dim());
|
|
|
|
|
- * arr[1 * dim() + 0] = 1;
|
|
|
|
|
- * }
|
|
|
|
|
- *
|
|
|
|
|
- * This behaviour is of course incorrect. To avoid dim() from being evaluated
|
|
|
|
|
- * twice, the snippet above is transformed into the following code: (note the $$
|
|
|
|
|
- * which will help later during constant propagation)
|
|
|
|
|
- * void foo() {
|
|
|
|
|
- * int[a$dim$$1, a$dim$$2] arr;
|
|
|
|
|
- * a$dim$$1 = 10;
|
|
|
|
|
- * a$dim$$2 = dim();
|
|
|
|
|
- * arr[1, 2] = 1;
|
|
|
|
|
- * }
|
|
|
|
|
- *
|
|
|
|
|
- * ... which later becomes:
|
|
|
|
|
- * void foo() {
|
|
|
|
|
- * int[a$dim$$1, a$dim$$2] arr;
|
|
|
|
|
- * a$dim$$1 = 10;
|
|
|
|
|
- * a$dim$$2 = dim();
|
|
|
|
|
- * arr = __allocate(a$dim$$1 * a$dim$$2);
|
|
|
|
|
- * arr[1 * a$dim$2 * 0] = 1;
|
|
|
|
|
- * }
|
|
|
|
|
- * *)
|
|
|
|
|
|
|
+(* Create new constant variables for all ArrayConst values so that they are only
|
|
|
|
|
+ * evaluated once *)
|
|
|
|
|
+let rec consts_to_vars node =
|
|
|
|
|
+ let rec create_vars new_vars values = function
|
|
|
|
|
+ | [] -> (new_vars, values)
|
|
|
|
|
+ | hd :: tl ->
|
|
|
|
|
+ let (new_vars, value) = match hd with
|
|
|
|
|
+ | ArrayConst (values, ann) ->
|
|
|
|
|
+ let (new_vars, values) = create_vars new_vars [] values in
|
|
|
|
|
+ (new_vars, ArrayConst (values, ann))
|
|
|
|
|
+ | value ->
|
|
|
|
|
+ let index = fresh_const "const" in
|
|
|
|
|
+ (new_vars @ [(index, value)], Var (index, None, annof value))
|
|
|
|
|
+ in
|
|
|
|
|
+ create_vars new_vars (values @ [value]) tl
|
|
|
|
|
+ in
|
|
|
|
|
+ match node with
|
|
|
|
|
+ | VarDec (ctype, name, Some (ArrayConst (values, vann)), ann) ->
|
|
|
|
|
+ let (new_vars, values) = create_vars [] [] values in
|
|
|
|
|
+ let value = ArrayConst (values, vann) in
|
|
|
|
|
+ let create_vardec (name, value) =
|
|
|
|
|
+ VarDec (basetypeof node, name, Some value, annof value)
|
|
|
|
|
+ in
|
|
|
|
|
+ let new_vardecs = List.map create_vardec new_vars in
|
|
|
|
|
+ Block (new_vardecs @ [VarDec (ctype, name, Some value, ann)])
|
|
|
|
|
+
|
|
|
|
|
+ | node -> transform_children consts_to_vars node
|
|
|
|
|
+
|
|
|
|
|
+(* Generate new variables for array dimensions, to avoid re-evalutation when
|
|
|
|
|
+ * array dimensions are used (e.g., after array dimension reduction). *)
|
|
|
let rec array_dims node =
|
|
let rec array_dims node =
|
|
|
let make_dims basename values make_dec =
|
|
let make_dims basename values make_dec =
|
|
|
let make_name i _ = basename ^ "$dim$$" ^ string_of_int (i + 1) in
|
|
let make_name i _ = basename ^ "$dim$$" ^ string_of_int (i + 1) in
|
|
@@ -258,6 +247,15 @@ let rec array_init = function
|
|
|
|
|
|
|
|
let phase = function
|
|
let phase = function
|
|
|
| Ast node ->
|
|
| Ast node ->
|
|
|
- let node = move_inits (add_allocs (split_inits (array_dims node))) in
|
|
|
|
|
|
|
+ (* Generate variable declarations for expressions that must be evaluated
|
|
|
|
|
+ * once and used multiple times *)
|
|
|
|
|
+ let node = consts_to_vars (array_dims node) in
|
|
|
|
|
+
|
|
|
|
|
+ (* Split variable initialisations into declarations and assignments, and
|
|
|
|
|
+ * move the assignments to the function body *)
|
|
|
|
|
+ let node = move_inits (add_allocs (split_inits node)) in
|
|
|
|
|
+
|
|
|
|
|
+ (* Transform ArrayConst assignment to assignments in for-loops, and
|
|
|
|
|
+ * transform all for-loops to while-loops afterwards *)
|
|
|
Ast (for_to_while (array_init (node)))
|
|
Ast (for_to_while (array_init (node)))
|
|
|
| _ -> raise (InvalidInput "desugar")
|
|
| _ -> raise (InvalidInput "desugar")
|