|
|
@@ -2,121 +2,173 @@ open Printf
|
|
|
open Types
|
|
|
open Util
|
|
|
|
|
|
-let rec var_init = function
|
|
|
- (* Move global initialisations to __init function *)
|
|
|
- | Program (decls, ann) ->
|
|
|
- let decls = flatten_blocks (List.map var_init decls) in
|
|
|
- let rec trav assigns = function
|
|
|
- | [] -> (assigns, [])
|
|
|
- | (Assign _ as hd) :: tl
|
|
|
- | (Allocate _ as hd) :: tl -> trav (assigns @ [hd]) tl
|
|
|
- | hd :: tl ->
|
|
|
- let (assigns, decls) = trav assigns tl in
|
|
|
- (assigns, (hd :: decls))
|
|
|
- in
|
|
|
- let (assigns, decls) = trav [] decls in (
|
|
|
- match assigns with
|
|
|
- | [] -> Program (decls, ann)
|
|
|
- | assigns ->
|
|
|
- let init_func = FunDef (true, Void, "__init", [], Block assigns, []) in
|
|
|
- Program (init_func :: decls, ann)
|
|
|
- )
|
|
|
+(* 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;
|
|
|
+ * }
|
|
|
+ * *)
|
|
|
+let rec array_dims node =
|
|
|
+ let make_dims basename values make_dec =
|
|
|
+ let make_name i _ = basename ^ "$dim$$" ^ string_of_int (i + 1) in
|
|
|
+ let names = mapi make_name values in
|
|
|
|
|
|
- (* Global variable initialisation:
|
|
|
- * Add an assign statement and the Program node will remove it later on *)
|
|
|
- | GlobalDef (export, ctype, name, Some init, ann) ->
|
|
|
- Block [GlobalDef (export, ctype, name, None, ann);
|
|
|
- Assign (name, None, init, ann)]
|
|
|
+ let decs = List.map2 make_dec values names in
|
|
|
|
|
|
- (* Global array definition:
|
|
|
- * - Create a new global variable for each dimension and initialise it to
|
|
|
- * the given expression
|
|
|
- * - create __allocate statement in __init *)
|
|
|
- | GlobalDef (export, Array (ctype, dims), name, None, ann) as dec ->
|
|
|
- let rec create_dimvars i = function
|
|
|
+ let make_dim value name = Dim (name, annof value) in
|
|
|
+ let dims = List.map2 make_dim values names in
|
|
|
+
|
|
|
+ (decs, dims)
|
|
|
+ in
|
|
|
+ match node with
|
|
|
+ | VarDec (ArrayDims (ctype, values), name, init, ann) ->
|
|
|
+ let make_dec value name = VarDec (Int, name, Some value, []) in
|
|
|
+ let (decs, dims) = make_dims name values make_dec in
|
|
|
+ Block (decs @ [VarDec (ArrayDims (ctype, dims), name, init, ann)])
|
|
|
+
|
|
|
+ | GlobalDef (export, ArrayDims (ctype, values), name, None, ann) ->
|
|
|
+ let make_dec value name = GlobalDef (export, Int, name, Some value, []) in
|
|
|
+ let (decs, dims) = make_dims name values make_dec in
|
|
|
+ Block (decs @ [GlobalDef (export, ArrayDims (ctype, dims), name, None, ann)])
|
|
|
+
|
|
|
+ | GlobalDec (ArrayDims (ctype, dims), name, ann) ->
|
|
|
+ let rec make_decs = function
|
|
|
| [] -> []
|
|
|
- | hd :: tl ->
|
|
|
- let dimname = name ^ "$" ^ string_of_int i in
|
|
|
- let var = Var (dimname, None, ann) in
|
|
|
- var :: (create_dimvars (i + 1) tl)
|
|
|
- in
|
|
|
- let dimvars = create_dimvars 1 dims in
|
|
|
- let create_globaldef dim = function
|
|
|
- | Var (dimname, None, ann) ->
|
|
|
- var_init (GlobalDef (export, Int, dimname, Some dim, ann))
|
|
|
+ | Dim (name, ann) :: tl -> GlobalDec (Int, name, ann) :: (make_decs tl)
|
|
|
| _ -> raise InvalidNode
|
|
|
in
|
|
|
- let vardecs = List.map2 create_globaldef dims dimvars in
|
|
|
- let alloc = [Allocate (dec, dimvars, ann)] in
|
|
|
- Block (vardecs @
|
|
|
- [GlobalDef (export, Array (ctype, dimvars), name, None, ann)] @
|
|
|
- alloc)
|
|
|
+ let decs = make_decs dims in
|
|
|
+ Block (decs @ [GlobalDec (ArrayDims (ctype, dims), name, ann)])
|
|
|
|
|
|
- (* Split local variable initialisations in declaration and assignment *)
|
|
|
- | FunDef (export, ret_type, name, params, body, ann) ->
|
|
|
- let inits = ref [] in
|
|
|
- let rec extract_inits = function
|
|
|
- (* Translate scalar array initialisation to ArrayScalar node,
|
|
|
- * for easy replacement later on *)
|
|
|
- | VarDec (Array _ as vtype, name, Some (Const _ as v), ann) ->
|
|
|
- let init = Some (ArrayInit (ArrayScalar v, vtype)) in
|
|
|
- extract_inits (VarDec (vtype, name, init, ann))
|
|
|
-
|
|
|
- (* Wrap ArrayConst in ArrayInit to pass dimensions *)
|
|
|
- | VarDec (Array _ as vtype, name, Some (ArrayConst _ as v), ann) ->
|
|
|
- let init = Some (ArrayInit (v, vtype)) in
|
|
|
- extract_inits (VarDec (vtype, name, init, ann))
|
|
|
+ | node -> transform_children array_dims node
|
|
|
|
|
|
- | VarDec (ctype, name, init, ann) as dec ->
|
|
|
- (* array definition: create __allocate statement *)
|
|
|
- let alloc = match ctype with
|
|
|
- | Array (_, dims) ->
|
|
|
- let create_dimvar = function
|
|
|
- | Dim (name, _) -> Var (name, None, [])
|
|
|
- | _ -> raise InvalidNode
|
|
|
- in [Allocate (dec, List.map create_dimvar dims, ann)]
|
|
|
- | _ -> []
|
|
|
- in
|
|
|
- (* initialisation: create assign statement *)
|
|
|
- let add = match init with
|
|
|
- | Some value -> alloc @ [Assign (name, None, value, ann)]
|
|
|
- | None -> alloc
|
|
|
- in
|
|
|
- inits := !inits @ add;
|
|
|
- VarDec (ctype, name, None, ann)
|
|
|
+(* Split variable declaration and initialisation *)
|
|
|
+let rec split_inits = function
|
|
|
+ (* Translate scalar array initialisation to ArrayScalar node,
|
|
|
+ * for easy replacement later on *)
|
|
|
+ | VarDec (ArrayDims (_, dims) as ctype, name, Some (Const _ as v), ann) ->
|
|
|
+ let init = Some (ArrayInit (ArrayScalar v, dims)) in
|
|
|
+ split_inits (VarDec (ctype, name, init, ann))
|
|
|
|
|
|
- | DimDec (name, Some init, ann) ->
|
|
|
- (* dimension initialisation: create assign statement *)
|
|
|
- inits := !inits @ [Assign (name, None, init, ann)];
|
|
|
- DimDec (name, None, ann)
|
|
|
+ (* Wrap ArrayConst in ArrayInit to pass dimensions *)
|
|
|
+ | VarDec (ArrayDims (_, dims) as ctype, name, Some (ArrayConst _ as v), ann) ->
|
|
|
+ let init = Some (ArrayInit (v, dims)) in
|
|
|
+ split_inits (VarDec (ctype, name, init, ann))
|
|
|
|
|
|
- | LocalFuns funs -> LocalFuns (List.map var_init funs)
|
|
|
+ (* Variable initialisations are split into dec;assign *)
|
|
|
+ | VarDec (ctype, name, Some init, ann) ->
|
|
|
+ Block [
|
|
|
+ VarDec (ctype, name, None, ann);
|
|
|
+ Assign (name, None, init, ann);
|
|
|
+ ]
|
|
|
|
|
|
- | node -> transform_children extract_inits node
|
|
|
- in
|
|
|
- let rec place_inits = function
|
|
|
- (* initialisations need to be placed after local functions *)
|
|
|
- | (LocalFuns _ as hd) :: tl -> hd :: !inits @ tl
|
|
|
- | hd :: tl -> hd :: (place_inits tl)
|
|
|
- | [] -> []
|
|
|
- in
|
|
|
- let params = flatten_blocks (List.map var_init params) in
|
|
|
- let body = flatten_blocks (place_inits (block_body (extract_inits body))) in
|
|
|
- FunDef (export, ret_type, name, params, Block body, ann)
|
|
|
+ | GlobalDef (export, ctype, name, Some init, ann) ->
|
|
|
+ Block [
|
|
|
+ GlobalDef (export, ctype, name, None, ann);
|
|
|
+ Assign (name, None, init, ann);
|
|
|
+ ]
|
|
|
|
|
|
- | node -> transform_children var_init node
|
|
|
+ | node -> transform_children split_inits node
|
|
|
|
|
|
-let rec replace_var var replacement node =
|
|
|
- let trav = (replace_var var replacement) in
|
|
|
+(* Add <allocate> statements after array declarations *)
|
|
|
+let rec add_allocs node =
|
|
|
+ let create_dimvar = function
|
|
|
+ | Dim (name, _) -> Var (name, None, [])
|
|
|
+ | _ -> raise InvalidNode
|
|
|
+ in
|
|
|
match node with
|
|
|
- | Var (name, None, ann) when name = var ->
|
|
|
- Var (replacement, None, ann)
|
|
|
- | For (counter, start, stop, step, body, ann) when counter = var ->
|
|
|
- For (replacement, trav start, trav stop, trav step, trav body, ann)
|
|
|
- | node ->
|
|
|
- transform_children trav node
|
|
|
+ | VarDec (ArrayDims (_, dims), _, _, ann) ->
|
|
|
+ Block [node; Allocate (node, List.map create_dimvar dims, ann)]
|
|
|
+
|
|
|
+ | GlobalDef (_, ArrayDims (_, dims), _, _, ann) ->
|
|
|
+ Block [node; Allocate (node, List.map create_dimvar dims, ann)]
|
|
|
+
|
|
|
+ | node -> transform_children add_allocs node
|
|
|
+
|
|
|
+let extract_inits lst =
|
|
|
+ let rec trav inits = function
|
|
|
+ | [] ->
|
|
|
+ (List.rev inits, [])
|
|
|
+ | (Assign _ as hd) :: tl
|
|
|
+ | (Allocate _ as hd) :: tl ->
|
|
|
+ trav (hd :: inits) tl
|
|
|
+ | hd :: tl ->
|
|
|
+ let (inits, tl) = trav inits tl in
|
|
|
+ (inits, (hd :: tl))
|
|
|
+ in trav [] lst
|
|
|
+
|
|
|
+let rec move_inits = function
|
|
|
+ (* Move global initialisations to __init function *)
|
|
|
+ | Program (decls, ann) ->
|
|
|
+ let decls = List.map move_inits decls in
|
|
|
+ (match extract_inits decls with
|
|
|
+ | ([], _) -> Program (decls, ann)
|
|
|
+ | (inits, decls) ->
|
|
|
+ let init_func = FunDef (true, Void, "__init", [], Block inits, []) in
|
|
|
+ Program (init_func :: decls, ann)
|
|
|
+ )
|
|
|
+
|
|
|
+ (* Split local variable initialisations in declaration and assignment *)
|
|
|
+ | FunDef (export, ret_type, name, params, Block body, ann) ->
|
|
|
+ let rec place_inits inits = function
|
|
|
+ | VarDecs lst :: tl ->
|
|
|
+ let (inits, decs) = extract_inits lst in
|
|
|
+ VarDecs decs :: (place_inits inits tl)
|
|
|
+ | LocalFuns _ as hd :: tl ->
|
|
|
+ hd :: inits @ tl
|
|
|
+ | _ -> raise InvalidNode
|
|
|
+ in
|
|
|
+ let body = Block (place_inits [] body) in
|
|
|
+ FunDef (export, ret_type, name, params, body, ann)
|
|
|
+
|
|
|
+ | node -> transform_children move_inits node
|
|
|
|
|
|
let for_to_while node =
|
|
|
+ let rec replace_var var replacement node =
|
|
|
+ let trav = (replace_var var replacement) in
|
|
|
+ match node with
|
|
|
+ | Var (name, None, ann) when name = var ->
|
|
|
+ Var (replacement, None, ann)
|
|
|
+ | For (counter, start, stop, step, body, ann) when counter = var ->
|
|
|
+ For (replacement, trav start, trav stop, trav step, trav body, ann)
|
|
|
+ | node ->
|
|
|
+ transform_children trav node
|
|
|
+ in
|
|
|
let rec traverse new_vars = function
|
|
|
| FunDef (export, ret_type, name, params, body, ann) ->
|
|
|
let new_vars = ref [] in
|
|
|
@@ -166,7 +218,7 @@ let for_to_while node =
|
|
|
|
|
|
let rec array_init = function
|
|
|
(* Transform scalar assignment into nested for-loops *)
|
|
|
- | Assign (name, None, ArrayInit (ArrayScalar value, Array (_, dims)), ann) ->
|
|
|
+ | Assign (name, None, ArrayInit (ArrayScalar value, dims), ann) ->
|
|
|
let rec add_loop indices = function
|
|
|
| [] ->
|
|
|
Assign (name, Some indices, value, ann)
|
|
|
@@ -180,8 +232,8 @@ let rec array_init = function
|
|
|
(* Transform array constant inisialisation into separate assign statements
|
|
|
* for all entries in the constant array *)
|
|
|
(* TODO: only allow when array dimensions are constant? *)
|
|
|
- | Assign (name, None, ArrayInit (ArrayConst _ as value, Array (_, dims)), ann) ->
|
|
|
- let ndims = list_size dims in
|
|
|
+ | Assign (name, None, ArrayInit (ArrayConst _ as value, dims), ann) ->
|
|
|
+ let ndims = List.length dims in
|
|
|
let rec make_assigns depth i indices = function
|
|
|
| [] -> []
|
|
|
| hd :: tl ->
|
|
|
@@ -204,62 +256,8 @@ let rec array_init = function
|
|
|
|
|
|
| node -> transform_children array_init node
|
|
|
|
|
|
-(* 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;
|
|
|
- * }
|
|
|
- * *)
|
|
|
-let rec array_dims = function
|
|
|
- | VarDec (Array (ctype, values), name, init, ann) ->
|
|
|
- let make_dimname i _ = name ^ "$dim$$" ^ string_of_int (i + 1) in
|
|
|
- let dimnames = mapi make_dimname values in
|
|
|
-
|
|
|
- let make_dimvar value name = Dim (name, annof value) in
|
|
|
- let dims = List.map2 make_dimvar values dimnames in
|
|
|
-
|
|
|
- let make_dimdec name value = DimDec (name, Some value, annof value) in
|
|
|
- let dimdecs = List.map2 make_dimdec dimnames values in
|
|
|
-
|
|
|
- Block (dimdecs @ [VarDec (Array (ctype, dims), name, init, ann)])
|
|
|
-
|
|
|
- | node -> transform_children array_dims node
|
|
|
-
|
|
|
let phase = function
|
|
|
- | Ast node -> Ast (for_to_while (array_init (var_init (array_dims node))))
|
|
|
+ | Ast node ->
|
|
|
+ let node = move_inits (add_allocs (split_inits (array_dims node))) in
|
|
|
+ Ast (for_to_while (array_init (node)))
|
|
|
| _ -> raise (InvalidInput "desugar")
|
Taddeus Kroes