Revision d7b73fed src/backends/C/c_backend_src.ml
src/backends/C/c_backend_src.ml | ||
---|---|---|
147 | 147 |
| loop_var :: q, Array vl -> |
148 | 148 |
let var_type = Types.array_element_type var_type in |
149 | 149 |
Format.fprintf fmt "(%a[]){%a }%a" (pp_c_type "") var_type (Utils.fprintf_list ~sep:", " (pp_value_suffix self var_type q pp_value)) vl pp_suffix [loop_var] |
150 |
| [] , Array vl -> |
|
151 |
let var_type = Types.array_element_type var_type in |
|
152 |
Format.fprintf fmt "(%a[]){%a }" (pp_c_type "") var_type (Utils.fprintf_list ~sep:", " (pp_value_suffix self var_type [] pp_value)) vl |
|
150 | 153 |
| _ :: q, Power (v, n) -> |
151 | 154 |
pp_value_suffix self var_type q pp_value fmt v |
152 | 155 |
| _ , Fun (n, vl) -> |
... | ... | |
164 | 167 |
| _ , Cst cst -> pp_c_const_suffix var_type fmt cst |
165 | 168 |
| _ , _ -> (Format.eprintf "internal error: C_backend_src.pp_value_suffix %a %a %a@." Types.print_ty var_type Machine_code.pp_val value pp_suffix loop_vars; assert false) |
166 | 169 |
|
170 |
(* Subsumes C_backend_common.pp_c_val to cope with aggressive substitution |
|
171 |
which may yield constant arrays in expressions. |
|
172 |
Type is needed to correctly print constant arrays. |
|
173 |
*) |
|
174 |
let pp_c_val self pp_var fmt (t, v) = |
|
175 |
pp_value_suffix self t [] pp_var fmt v |
|
176 |
|
|
167 | 177 |
(* type_directed assignment: array vs. statically sized type |
168 | 178 |
- [var_type]: type of variable to be assigned |
169 | 179 |
- [var_name]: name of variable to be assigned |
... | ... | |
213 | 223 |
aux fmt reordered_loop_vars |
214 | 224 |
end |
215 | 225 |
|
216 |
let pp_instance_call m self fmt i (inputs: value_t list) (outputs: var_decl list) = |
|
217 |
try (* stateful node instance *) |
|
218 |
let (n,_) = List.assoc i m.minstances in |
|
219 |
fprintf fmt "%a (%a%t%a%t%s->%s);" |
|
220 |
pp_machine_step_name (node_name n) |
|
221 |
(Utils.fprintf_list ~sep:", " (pp_c_val self (pp_c_var_read m))) inputs |
|
222 |
(Utils.pp_final_char_if_non_empty ", " inputs) |
|
223 |
(Utils.fprintf_list ~sep:", " (pp_c_var_write m)) outputs |
|
224 |
(Utils.pp_final_char_if_non_empty ", " outputs) |
|
225 |
self |
|
226 |
i |
|
227 |
with Not_found -> (* stateless node instance *) |
|
228 |
let (n,_) = List.assoc i m.mcalls in |
|
229 |
fprintf fmt "%a (%a%t%a);" |
|
230 |
pp_machine_step_name (node_name n) |
|
231 |
(Utils.fprintf_list ~sep:", " (pp_c_val self (pp_c_var_read m))) inputs |
|
232 |
(Utils.pp_final_char_if_non_empty ", " inputs) |
|
233 |
(Utils.fprintf_list ~sep:", " (pp_c_var_write m)) outputs |
|
234 |
|
|
235 |
let pp_machine_reset (m: machine_t) self fmt inst = |
|
236 |
let (node, static) = |
|
237 |
try |
|
238 |
List.assoc inst m.minstances |
|
239 |
with Not_found -> (Format.eprintf "pp_machine_reset %s %s %s: internal error@," m.mname.node_id self inst; raise Not_found) in |
|
240 |
fprintf fmt "%a(%a%t%s->%s);" |
|
241 |
pp_machine_reset_name (node_name node) |
|
242 |
(Utils.fprintf_list ~sep:", " Dimension.pp_dimension) static |
|
243 |
(Utils.pp_final_char_if_non_empty ", " static) |
|
244 |
self inst |
|
245 |
|
|
246 | 226 |
let has_c_prototype funname dependencies = |
247 | 227 |
let imported_node_opt = (* We select the last imported node with the name funname. |
248 | 228 |
The order of evaluation of dependencies should be |
... | ... | |
268 | 248 |
| None -> false |
269 | 249 |
| Some nd -> (match nd.nodei_prototype with Some "C" -> true | _ -> false) |
270 | 250 |
|
251 |
let pp_instance_call dependencies m self fmt i (inputs: value_t list) (outputs: var_decl list) = |
|
252 |
try (* stateful node instance *) |
|
253 |
let (n,_) = List.assoc i m.minstances in |
|
254 |
let (input_types, _) = Typing.get_type_of_call n in |
|
255 |
let inputs = List.combine input_types inputs in |
|
256 |
fprintf fmt "%a (%a%t%a%t%s->%s);" |
|
257 |
pp_machine_step_name (node_name n) |
|
258 |
(Utils.fprintf_list ~sep:", " (pp_c_val self (pp_c_var_read m))) inputs |
|
259 |
(Utils.pp_final_char_if_non_empty ", " inputs) |
|
260 |
(Utils.fprintf_list ~sep:", " (pp_c_var_write m)) outputs |
|
261 |
(Utils.pp_final_char_if_non_empty ", " outputs) |
|
262 |
self |
|
263 |
i |
|
264 |
with Not_found -> (* stateless node instance *) |
|
265 |
let (n,_) = List.assoc i m.mcalls in |
|
266 |
let (input_types, output_types) = Typing.get_type_of_call n in |
|
267 |
let inputs = List.combine input_types inputs in |
|
268 |
if has_c_prototype i dependencies |
|
269 |
then (* external C function *) |
|
270 |
let outputs = List.map2 (fun t v -> t, LocalVar v) output_types outputs in |
|
271 |
fprintf fmt "%a = %s(%a);" |
|
272 |
(Utils.fprintf_list ~sep:", " (pp_c_val self (pp_c_var_read m))) outputs |
|
273 |
i |
|
274 |
(Utils.fprintf_list ~sep:", " (pp_c_val self (pp_c_var_read m))) inputs |
|
275 |
else |
|
276 |
fprintf fmt "%a (%a%t%a);" |
|
277 |
pp_machine_step_name (node_name n) |
|
278 |
(Utils.fprintf_list ~sep:", " (pp_c_val self (pp_c_var_read m))) inputs |
|
279 |
(Utils.pp_final_char_if_non_empty ", " inputs) |
|
280 |
(Utils.fprintf_list ~sep:", " (pp_c_var_write m)) outputs |
|
281 |
|
|
282 |
let pp_machine_reset (m: machine_t) self fmt inst = |
|
283 |
let (node, static) = |
|
284 |
try |
|
285 |
List.assoc inst m.minstances |
|
286 |
with Not_found -> (Format.eprintf "pp_machine_reset %s %s %s: internal error@," m.mname.node_id self inst; raise Not_found) in |
|
287 |
fprintf fmt "%a(%a%t%s->%s);" |
|
288 |
pp_machine_reset_name (node_name node) |
|
289 |
(Utils.fprintf_list ~sep:", " Dimension.pp_dimension) static |
|
290 |
(Utils.pp_final_char_if_non_empty ", " static) |
|
291 |
self inst |
|
292 |
|
|
271 | 293 |
let rec pp_conditional dependencies (m: machine_t) self fmt c tl el = |
272 | 294 |
fprintf fmt "@[<v 2>if (%a) {%t%a@]@,@[<v 2>} else {%t%a@]@,}" |
273 |
(pp_c_val self (pp_c_var_read m)) c
|
|
295 |
(pp_c_val self (pp_c_var_read m)) (Type_predef.type_bool, c)
|
|
274 | 296 |
(Utils.pp_newline_if_non_empty tl) |
275 | 297 |
(Utils.fprintf_list ~sep:"@," (pp_machine_instr dependencies m self)) tl |
276 | 298 |
(Utils.pp_newline_if_non_empty el) |
... | ... | |
290 | 312 |
i.var_type (StateVar i) v |
291 | 313 |
| MStep ([i0], i, vl) when Basic_library.is_internal_fun i -> |
292 | 314 |
pp_machine_instr dependencies m self fmt (MLocalAssign (i0, Fun (i, vl))) |
293 |
| MStep ([i0], i, vl) when has_c_prototype i dependencies -> |
|
294 |
fprintf fmt "%a = %s(%a);" |
|
295 |
(pp_c_val self (pp_c_var_read m)) (LocalVar i0) |
|
296 |
i |
|
297 |
(Utils.fprintf_list ~sep:", " (pp_c_val self (pp_c_var_read m))) vl |
|
298 | 315 |
| MStep (il, i, vl) -> |
299 |
pp_instance_call m self fmt i vl il |
|
300 |
| MBranch (g,hl) -> |
|
301 |
if hl <> [] && let t = fst (List.hd hl) in t = tag_true || t = tag_false |
|
316 |
pp_instance_call dependencies m self fmt i vl il |
|
317 |
| MBranch (_, []) -> (Format.eprintf "internal error: C_backend_src.pp_machine_instr %a@." pp_instr instr; assert false) |
|
318 |
| MBranch (g, hl) -> |
|
319 |
if let t = fst (List.hd hl) in t = tag_true || t = tag_false |
|
302 | 320 |
then (* boolean case, needs special treatment in C because truth value is not unique *) |
303 | 321 |
(* may disappear if we optimize code by replacing last branch test with default *) |
304 | 322 |
let tl = try List.assoc tag_true hl with Not_found -> [] in |
305 | 323 |
let el = try List.assoc tag_false hl with Not_found -> [] in |
306 | 324 |
pp_conditional dependencies m self fmt g tl el |
307 | 325 |
else (* enum type case *) |
326 |
let g_typ = Typing.type_const Location.dummy_loc (Const_tag (fst (List.hd hl))) in |
|
308 | 327 |
fprintf fmt "@[<v 2>switch(%a) {@,%a@,}@]" |
309 |
(pp_c_val self (pp_c_var_read m)) g
|
|
328 |
(pp_c_val self (pp_c_var_read m)) (g_typ, g)
|
|
310 | 329 |
(Utils.fprintf_list ~sep:"@," (pp_machine_branch dependencies m self)) hl |
311 | 330 |
|
312 | 331 |
and pp_machine_branch dependencies m self fmt (t, h) = |
Also available in: Unified diff