Revision 785b64f9
Added by Pierre-Loïc Garoche about 6 years ago
| src/backends/EMF/EMF_backend.ml | ||
|---|---|---|
| 146 | 146 |
let branch_cpt = ref 0 |
| 147 | 147 |
let get_instr_id fmt i = |
| 148 | 148 |
match Corelang.get_instr_desc i with |
| 149 |
| MLocalAssign(lhs,_) | MStateAssign (lhs, _) -> Printers.pp_var_name fmt lhs
|
|
| 149 |
| MLocalAssign(lhs,_) | MStateAssign (lhs, _) -> pp_var_name fmt lhs |
|
| 150 | 150 |
| MReset i | MNoReset i -> fprintf fmt "%s" (reset_name i) |
| 151 | 151 |
| MBranch (g, _) -> incr branch_cpt; fprintf fmt "branch_%i" !branch_cpt |
| 152 |
| MStep (outs, id, _) -> fprintf fmt "%a_%s" (fprintf_list ~sep:"_" Printers.pp_var_name) outs id |
|
| 152 |
| MStep (outs, id, _) -> |
|
| 153 |
print_protect fmt |
|
| 154 |
(fun fmt -> fprintf fmt "%a_%s" (fprintf_list ~sep:"_" pp_var_name) outs id) |
|
| 153 | 155 |
| _ -> () (* No name *) |
| 154 | 156 |
|
| 155 | 157 |
let rec branch_block_vars il = |
| ... | ... | |
| 299 | 301 |
| MStep ([var], f, _) when is_arrow_fun m i -> (* Arrow case *) ( |
| 300 | 302 |
fprintf fmt "\"kind\": \"arrow\",@ \"name\": \"%s\",@ \"lhs\": \"%a\",@ \"rhs\": \"%s\"" |
| 301 | 303 |
f |
| 302 |
Printers.pp_var_name var
|
|
| 304 |
pp_var_name var |
|
| 303 | 305 |
(reset_name f) |
| 304 | 306 |
) |
| 305 | 307 |
|
| 306 | 308 |
| MStep (outputs, f, inputs) when not (is_imported_node f m) -> ( |
| 307 | 309 |
let node_f = Machine_code.get_node_def f m in |
| 308 | 310 |
let is_stateful = List.mem_assoc f m.minstances in |
| 309 |
fprintf fmt "\"kind\": \"%s\",@ \"name\": \"%s\",@ \"id\": \"%s\",@ "
|
|
| 311 |
fprintf fmt "\"kind\": \"%s\",@ \"name\": \"%a\",@ \"id\": \"%s\",@ "
|
|
| 310 | 312 |
(if is_stateful then "statefulcall" else "statelesscall") |
| 311 |
(node_f.node_id)
|
|
| 313 |
print_protect (fun fmt -> pp_print_string fmt (node_f.node_id))
|
|
| 312 | 314 |
f; |
| 313 | 315 |
fprintf fmt "\"lhs\": [@[%a@]],@ \"args\": [@[%a@]]" |
| 314 | 316 |
(fprintf_list ~sep:",@ " (fun fmt v -> fprintf fmt "\"%a\"" Printers.pp_var_name v)) outputs |
| src/backends/EMF/EMF_common.ml | ||
|---|---|---|
| 33 | 33 |
*) |
| 34 | 34 |
|
| 35 | 35 |
(* Basic printing functions *) |
| 36 |
|
|
| 37 |
(* If string length of f is longer than 50 chars, we select the 20 first and |
|
| 38 |
last and put a hash in the middle *) |
|
| 39 |
let print_protect fmt f = |
|
| 40 |
fprintf str_formatter "%t" f; |
|
| 41 |
let s = flush_str_formatter () in |
|
| 42 |
let l = String.length s in |
|
| 43 |
if l > 50 then |
|
| 44 |
let prefix = String.sub s 0 20 and |
|
| 45 |
suffix = String.sub s (l-20) 20 in |
|
| 46 |
let hash = Hashtbl.hash s in |
|
| 47 |
fprintf fmt "%s_%i_%s" prefix hash suffix |
|
| 48 |
else |
|
| 49 |
fprintf fmt "%s" s |
|
| 36 | 50 |
|
| 37 | 51 |
let pp_var_string fmt v = fprintf fmt "\"%s\"" v |
| 38 |
(*let pp_var_name fmt v = fprintf fmt "\"%a\"" Printers.pp_var_name v*)
|
|
| 52 |
let pp_var_name fmt v = print_protect fmt (fun fmt -> Printers.pp_var_name fmt v)
|
|
| 39 | 53 |
(*let pp_node_args = fprintf_list ~sep:", " pp_var_name*) |
| 40 | 54 |
|
| 41 | 55 |
(********* Printing types ***********) |
| ... | ... | |
| 126 | 140 |
|
| 127 | 141 |
let pp_emf_var_decl fmt v = |
| 128 | 142 |
fprintf fmt "@[{\"name\": \"%a\", \"datatype\":\"%a\"}@]"
|
| 129 |
Printers.pp_var_name v
|
|
| 143 |
pp_var_name v |
|
| 130 | 144 |
pp_var_type v |
| 131 | 145 |
|
| 132 | 146 |
let pp_emf_vars_decl fmt vl = |
Also available in: Unified diff
[EMF] Protecting print of names to ensure a length < 50. Remove the middle part of the string and inject a hash of it.