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