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