|
@@ -2,8 +2,8 @@ open Printf
|
|
|
open Types
|
|
open Types
|
|
|
open Util
|
|
open Util
|
|
|
|
|
|
|
|
-(* Create new constant variables for all ArrayConst values so that they are only
|
|
|
|
|
- * evaluated once *)
|
|
|
|
|
|
|
+(* Create new constant variables for all assigned array values so that they are
|
|
|
|
|
+ * only evaluated once *)
|
|
|
let rec consts_to_vars node =
|
|
let rec consts_to_vars node =
|
|
|
let rec create_vars new_vars values = function
|
|
let rec create_vars new_vars values = function
|
|
|
| [] -> (new_vars, values)
|
|
| [] -> (new_vars, values)
|
|
@@ -19,7 +19,8 @@ let rec consts_to_vars node =
|
|
|
create_vars new_vars (values @ [value]) tl
|
|
create_vars new_vars (values @ [value]) tl
|
|
|
in
|
|
in
|
|
|
match node with
|
|
match node with
|
|
|
- | VarDec (ctype, name, Some (ArrayConst (values, vann)), ann) ->
|
|
|
|
|
|
|
+ (* Add vardecs for values in arrayconst *)
|
|
|
|
|
+ | VarDec (ArrayDims _ as ctype, name, Some (ArrayConst (values, vann)), ann) ->
|
|
|
let (new_vars, values) = create_vars [] [] values in
|
|
let (new_vars, values) = create_vars [] [] values in
|
|
|
let value = ArrayConst (values, vann) in
|
|
let value = ArrayConst (values, vann) in
|
|
|
let create_vardec (name, value) =
|
|
let create_vardec (name, value) =
|
|
@@ -28,6 +29,14 @@ let rec consts_to_vars node =
|
|
|
let new_vardecs = List.map create_vardec new_vars in
|
|
let new_vardecs = List.map create_vardec new_vars in
|
|
|
Block (new_vardecs @ [VarDec (ctype, name, Some value, ann)])
|
|
Block (new_vardecs @ [VarDec (ctype, name, Some value, ann)])
|
|
|
|
|
|
|
|
|
|
+ (* Add vardec for scalar value *)
|
|
|
|
|
+ | VarDec (ArrayDims _ as ctype, name, Some value, ann) as node ->
|
|
|
|
|
+ let scalar_name = fresh_const "scalar" in
|
|
|
|
|
+ Block [
|
|
|
|
|
+ VarDec (basetypeof node, scalar_name, Some value, ann);
|
|
|
|
|
+ VarDec (ctype, name, Some (Var (scalar_name, None, annof value)), ann);
|
|
|
|
|
+ ]
|
|
|
|
|
+
|
|
|
| node -> transform_children consts_to_vars node
|
|
| node -> transform_children consts_to_vars node
|
|
|
|
|
|
|
|
(* Generate new variables for array dimensions, to avoid re-evalutation when
|
|
(* Generate new variables for array dimensions, to avoid re-evalutation when
|
|
@@ -68,8 +77,9 @@ let rec array_dims node =
|
|
|
|
|
|
|
|
(* Split variable declaration and initialisation *)
|
|
(* Split variable declaration and initialisation *)
|
|
|
let rec split_inits = function
|
|
let rec split_inits = function
|
|
|
- (* Translate scalar array initialisation to ArrayScalar node,
|
|
|
|
|
- * for easy replacement later on *)
|
|
|
|
|
|
|
+ (*
|
|
|
|
|
+ (* Translate scalar array initialisation to ArrayScalar node, for easy
|
|
|
|
|
+ * replacement later on *)
|
|
|
| VarDec (ArrayDims (_, dims) as ctype, name, Some (Const _ as v), ann) ->
|
|
| VarDec (ArrayDims (_, dims) as ctype, name, Some (Const _ as v), ann) ->
|
|
|
let init = Some (ArrayInit (ArrayScalar v, dims)) in
|
|
let init = Some (ArrayInit (ArrayScalar v, dims)) in
|
|
|
split_inits (VarDec (ctype, name, init, ann))
|
|
split_inits (VarDec (ctype, name, init, ann))
|
|
@@ -78,6 +88,14 @@ let rec split_inits = function
|
|
|
| VarDec (ArrayDims (_, dims) as ctype, name, Some (ArrayConst _ as v), ann) ->
|
|
| VarDec (ArrayDims (_, dims) as ctype, name, Some (ArrayConst _ as v), ann) ->
|
|
|
let init = Some (ArrayInit (v, dims)) in
|
|
let init = Some (ArrayInit (v, dims)) in
|
|
|
split_inits (VarDec (ctype, name, init, ann))
|
|
split_inits (VarDec (ctype, name, init, ann))
|
|
|
|
|
+ *)
|
|
|
|
|
+
|
|
|
|
|
+ (* Wrap array initialisation in ArrayInit to pass dimensions *)
|
|
|
|
|
+ | VarDec (ArrayDims (_, dims) as ctype, name, Some value, ann) ->
|
|
|
|
|
+ Block [
|
|
|
|
|
+ VarDec (ctype, name, None, ann);
|
|
|
|
|
+ Assign (name, None, ArrayInit (value, dims), ann);
|
|
|
|
|
+ ]
|
|
|
|
|
|
|
|
(* Variable initialisations are split into dec;assign *)
|
|
(* Variable initialisations are split into dec;assign *)
|
|
|
| VarDec (ctype, name, Some init, ann) ->
|
|
| VarDec (ctype, name, Some init, ann) ->
|
|
@@ -205,19 +223,13 @@ let for_to_while node =
|
|
|
in
|
|
in
|
|
|
traverse (ref []) node
|
|
traverse (ref []) node
|
|
|
|
|
|
|
|
-let rec array_init = function
|
|
|
|
|
- (* Transform scalar assignment into nested for-loops *)
|
|
|
|
|
- | Assign (name, None, ArrayInit (ArrayScalar value, dims), ann) ->
|
|
|
|
|
- let rec add_loop indices = function
|
|
|
|
|
- | [] ->
|
|
|
|
|
- Assign (name, Some indices, value, ann)
|
|
|
|
|
- | dim :: rest ->
|
|
|
|
|
- let counter = fresh_var "i" in
|
|
|
|
|
- let body = Block [add_loop (indices @ [Var (counter, None, [])]) rest] in
|
|
|
|
|
- For (counter, Const (IntVal 0, []), dim, Const (IntVal 1, []), body, [])
|
|
|
|
|
- in
|
|
|
|
|
- add_loop [] dims
|
|
|
|
|
|
|
+let rec sublist n = function
|
|
|
|
|
+ | [] when n > 0 -> raise (Invalid_argument "n")
|
|
|
|
|
+ | [] -> []
|
|
|
|
|
+ | lst when n = 0 -> lst
|
|
|
|
|
+ | _ :: tl -> sublist (n - 1) tl
|
|
|
|
|
|
|
|
|
|
+let rec array_init = function
|
|
|
(* Transform array constant inisialisation into separate assign statements
|
|
(* Transform array constant inisialisation into separate assign statements
|
|
|
* for all entries in the constant array *)
|
|
* for all entries in the constant array *)
|
|
|
(* TODO: only allow when array dimensions are constant? *)
|
|
(* TODO: only allow when array dimensions are constant? *)
|
|
@@ -234,6 +246,11 @@ let rec array_init = function
|
|
|
| value when depth = ndims ->
|
|
| value when depth = ndims ->
|
|
|
let indices = List.map (fun i -> Const (IntVal i, [])) indices in
|
|
let indices = List.map (fun i -> Const (IntVal i, [])) indices in
|
|
|
[Assign (name, Some (List.rev indices), value, ann)]
|
|
[Assign (name, Some (List.rev indices), value, ann)]
|
|
|
|
|
+ | value when depth < ndims ->
|
|
|
|
|
+ (* Use the for-loops constructed for scalar assignment *)
|
|
|
|
|
+ let value = ArrayInit (value, dims) in
|
|
|
|
|
+ let indices = List.map (fun i -> Const (IntVal i, [])) indices in
|
|
|
|
|
+ [array_init (Assign (name, Some (List.rev indices), value, ann))]
|
|
|
| node ->
|
|
| node ->
|
|
|
let msg = sprintf
|
|
let msg = sprintf
|
|
|
"dimension mismatch: expected %d nesting levels, got %d"
|
|
"dimension mismatch: expected %d nesting levels, got %d"
|
|
@@ -243,6 +260,28 @@ let rec array_init = function
|
|
|
in
|
|
in
|
|
|
Block (List.rev (traverse 0 [] value))
|
|
Block (List.rev (traverse 0 [] value))
|
|
|
|
|
|
|
|
|
|
+ (* Replace no indices with empty indices to have a list below *)
|
|
|
|
|
+ | Assign (name, None, (ArrayInit _ as value), ann) ->
|
|
|
|
|
+ array_init (Assign (name, Some [], value, ann))
|
|
|
|
|
+
|
|
|
|
|
+ | Assign (name, Some indices, ArrayInit (value, dims), ann) as node ->
|
|
|
|
|
+ let rec add_loop indices = function
|
|
|
|
|
+ | [] ->
|
|
|
|
|
+ array_init (Assign (name, Some indices, value, ann))
|
|
|
|
|
+ | dim :: rest ->
|
|
|
|
|
+ let counter = fresh_var "i" in
|
|
|
|
|
+ let start = Const (IntVal 0, []) in
|
|
|
|
|
+ let step = Const (IntVal 1, []) in
|
|
|
|
|
+ let body = Block [add_loop (indices @ [Var (counter, None, [])]) rest] in
|
|
|
|
|
+ let stop = match dim with
|
|
|
|
|
+ | Dim (name, ann) -> Var (name, None, ann)
|
|
|
|
|
+ | _ -> dim
|
|
|
|
|
+ in
|
|
|
|
|
+ For (counter, start, stop, step, body, [])
|
|
|
|
|
+ in
|
|
|
|
|
+ let dims_left = sublist (List.length indices) dims in
|
|
|
|
|
+ add_loop indices dims_left
|
|
|
|
|
+
|
|
|
| node -> transform_children array_init node
|
|
| node -> transform_children array_init node
|
|
|
|
|
|
|
|
let phase = function
|
|
let phase = function
|