Revision 080a6d0b src/backends/C/c_backend_src.ml
| src/backends/C/c_backend_src.ml | ||
|---|---|---|
| 44 | 44 |
| Access (v, i) -> max 0 (expansion_depth v - 1) |
| 45 | 45 |
| Power (v, n) -> 0 (*1 + expansion_depth v*) |
| 46 | 46 |
|
| 47 |
type loop_index = LVar of ident | LInt of int ref |
|
| 48 |
|
|
| 47 |
let rec merge_static_loop_profiles lp1 lp2 = |
|
| 48 |
match lp1, lp2 with |
|
| 49 |
| [] , _ -> lp2 |
|
| 50 |
| _ , [] -> lp1 |
|
| 51 |
| p1 :: q1, p2 :: q2 -> (p1 || p2) :: merge_static_loop_profiles q1 q2 |
|
| 52 |
|
|
| 53 |
(* Returns a list of bool values, indicating whether the indices must be static or not *) |
|
| 54 |
let rec static_loop_profile v = |
|
| 55 |
match v with |
|
| 56 |
| Cst (Const_array cl) -> |
|
| 57 |
List.fold_right (fun c lp -> merge_static_loop_profiles lp (static_loop_profile (Cst c))) cl [] |
|
| 58 |
| Cst _ |
|
| 59 |
| LocalVar _ |
|
| 60 |
| StateVar _ -> [] |
|
| 61 |
| Fun (_, vl) -> List.fold_right (fun v lp -> merge_static_loop_profiles lp (static_loop_profile v)) vl [] |
|
| 62 |
| Array vl -> true :: List.fold_right (fun v lp -> merge_static_loop_profiles lp (static_loop_profile v)) vl [] |
|
| 63 |
| Access (v, i) -> (match (static_loop_profile v) with [] -> [] | _ :: q -> q) |
|
| 64 |
| Power (v, n) -> false :: static_loop_profile v |
|
| 65 |
|
|
| 66 |
let rec is_const_index v = |
|
| 67 |
match v with |
|
| 68 |
| Cst (Const_int _) -> true |
|
| 69 |
| Fun (_, vl) -> List.for_all is_const_index vl |
|
| 70 |
| _ -> false |
|
| 71 |
|
|
| 72 |
type loop_index = LVar of ident | LInt of int ref | LAcc of value_t |
|
| 73 |
(* |
|
| 74 |
let rec value_offsets v offsets = |
|
| 75 |
match v, offsets with |
|
| 76 |
| _ , [] -> v |
|
| 77 |
| Power (v, n) , _ :: q -> value_offsets v q |
|
| 78 |
| Array vl , LInt r :: q -> value_offsets (List.nth vl !r) q |
|
| 79 |
| Cst (Const_array cl) , LInt r :: q -> value_offsets (Cst (List.nth cl !r)) q |
|
| 80 |
| Fun (f, vl) , _ -> Fun (f, List.map (fun v -> value_offsets v offsets) vl) |
|
| 81 |
| _ , LInt r :: q -> value_offsets (Access (v, Cst (Const_int !r))) q |
|
| 82 |
| _ , LVar i :: q -> value_offsets (Access (v, LocalVar i)) q |
|
| 83 |
*) |
|
| 49 | 84 |
(* Computes the list of nested loop variables together with their dimension bounds. |
| 50 | 85 |
- LInt r stands for loop expansion (no loop variable, but int loop index) |
| 51 | 86 |
- LVar v stands for loop variable v |
| ... | ... | |
| 72 | 107 |
match snd lv with |
| 73 | 108 |
| LVar v -> fprintf fmt "[%s]" v |
| 74 | 109 |
| LInt r -> fprintf fmt "[%d]" !r |
| 110 |
| LAcc i -> fprintf fmt "[%a]" pp_val i |
|
| 75 | 111 |
|
| 76 | 112 |
(* Prints a suffix of loop variables for arrays *) |
| 77 | 113 |
let pp_suffix fmt loop_vars = |
| ... | ... | |
| 80 | 116 |
(* Prints a [value] indexed by the suffix list [loop_vars] *) |
| 81 | 117 |
let rec pp_value_suffix self loop_vars pp_value fmt value = |
| 82 | 118 |
match loop_vars, value with |
| 83 |
| (_, LInt r) :: q, Array vl -> |
|
| 119 |
| (_, LInt r) :: q, Array vl ->
|
|
| 84 | 120 |
pp_value_suffix self q pp_value fmt (List.nth vl !r) |
| 85 |
| _ :: q, Power (v, n) -> |
|
| 86 |
pp_value_suffix self loop_vars pp_value fmt v
|
|
| 87 |
| _ , Fun (n, vl) -> |
|
| 121 |
| _ :: q, Power (v, n) ->
|
|
| 122 |
pp_value_suffix self q pp_value fmt v
|
|
| 123 |
| _ , Fun (n, vl) ->
|
|
| 88 | 124 |
Basic_library.pp_c n (pp_value_suffix self loop_vars pp_value) fmt vl |
| 89 |
| _ , _ -> |
|
| 125 |
| _ , Access (v, i) -> |
|
| 126 |
pp_value_suffix self ((Dimension.mkdim_var (), LAcc i) :: loop_vars) pp_value fmt v |
|
| 127 |
| _ , _ -> |
|
| 90 | 128 |
let pp_var_suffix fmt v = fprintf fmt "%a%a" pp_value v pp_suffix loop_vars in |
| 91 | 129 |
pp_c_val self pp_var_suffix fmt value |
| 92 | 130 |
|
| ... | ... | |
| 96 | 134 |
- [value]: assigned value |
| 97 | 135 |
- [pp_var]: printer for variables |
| 98 | 136 |
*) |
| 137 |
(* |
|
| 138 |
let pp_assign_rec pp_var var_type var_name value = |
|
| 139 |
match (Types.repr var_type).Types.tdesc, value with |
|
| 140 |
| Types.Tarray (d, ty'), Array vl -> |
|
| 141 |
let szl = Utils.enumerate (Dimension.size_const_dimension d) in |
|
| 142 |
fprintf fmt "@[<v 2>{@,%a@]@,}"
|
|
| 143 |
(Utils.fprintf_list ~sep:"@," (fun fmt i -> r := i; aux fmt q)) szl |
|
| 144 |
| Types.Tarray (d, ty'), Power (v, _) -> |
|
| 145 |
| Types.Tarray (d, ty'), _ -> |
|
| 146 |
| _ , _ -> |
|
| 147 |
fprintf fmt "%a = %a;" |
|
| 148 |
pp_var var_name |
|
| 149 |
(pp_value_suffix self loop_vars pp_var) value |
|
| 150 |
*) |
|
| 99 | 151 |
let pp_assign m self pp_var fmt var_type var_name value = |
| 100 | 152 |
let depth = expansion_depth value in |
| 101 | 153 |
(*eprintf "pp_assign %a %a %d@." Types.print_ty var_type pp_val value depth;*) |
| ... | ... | |
| 117 | 169 |
let szl = Utils.enumerate (Dimension.size_const_dimension d) in |
| 118 | 170 |
fprintf fmt "@[<v 2>{@,%a@]@,}"
|
| 119 | 171 |
(Utils.fprintf_list ~sep:"@," (fun fmt i -> r := i; aux fmt q)) szl |
| 172 |
| _ -> assert false |
|
| 120 | 173 |
in |
| 121 | 174 |
begin |
| 122 | 175 |
reset_loop_counter (); |
Also available in: Unified diff