Revision 1bff14ac src/backends/EMF/EMF_backend.ml
src/backends/EMF/EMF_backend.ml | ||
---|---|---|
174 | 174 |
| _ -> fprintf fmt "%s (%a)" id (Utils.fprintf_list ~sep:", " (pp_val vars)) vl |
175 | 175 |
|
176 | 176 |
|
177 |
|
|
178 |
|
|
179 |
let rec pp_instr m vars fmt i = |
|
177 |
(* detect whether the instruction i represents a STEP, ie an arrow with true -> false *) |
|
178 |
let is_step_fun m i = |
|
180 | 179 |
match Corelang.get_instr_desc i with |
181 |
| MLocalAssign (var,v) |
|
182 |
| MStateAssign (var,v) -> fprintf fmt "y = %a" (pp_val vars) v |
|
183 | 180 |
| MStep ([var], i, vl) -> ( |
184 | 181 |
let name = (Machine_code.get_node_def i m).node_id in |
185 | 182 |
match name, vl with |
186 |
"_arrow", [v1; v2] -> (
|
|
183 |
| "_arrow", [v1; v2] -> (
|
|
187 | 184 |
match v1.value_desc, v2.value_desc with |
188 |
| Cst c1, Cst c2 -> if c1 = Corelang.const_of_bool true && c2 = Corelang.const_of_bool false then fprintf fmt "STEP" else assert false (* only handle true -> false *) |
|
185 |
| Cst c1, Cst c2 -> |
|
186 |
if c1 = Corelang.const_of_bool true && c2 = Corelang.const_of_bool false then |
|
187 |
true |
|
188 |
else |
|
189 |
assert false (* only handle true -> false *) |
|
189 | 190 |
| _ -> assert false |
190 |
)
|
|
191 |
| _ -> raise (Unhandled ("call to node " ^ name))
|
|
191 |
) |
|
192 |
| _ -> false
|
|
192 | 193 |
) |
194 |
| _ -> false |
|
195 |
|
|
196 |
|
|
197 |
let rec pp_instr m vars fmt i = |
|
198 |
match Corelang.get_instr_desc i with |
|
199 |
| MLocalAssign (var,v) |
|
200 |
| MStateAssign (var,v) -> fprintf fmt "y = %a" (pp_val vars) v |
|
201 |
| MStep _ when is_step_fun m i -> fprintf fmt "STEP" |
|
193 | 202 |
| MBranch (g,[(tag1,case1);(tag2,case2)]) -> |
194 | 203 |
let then_case, else_case = |
195 | 204 |
if tag1 = Corelang.tag_true then |
... | ... | |
201 | 210 |
(pp_val vars) g |
202 | 211 |
(pp_instrs m vars) then_case |
203 | 212 |
(pp_instrs m vars) else_case |
204 |
| MStep _ (* only single output for function call *)
|
|
213 |
| MStep _ (* no function calls handled yet *)
|
|
205 | 214 |
| MBranch _ (* EMF backend only accept true/false ite *) |
206 | 215 |
| MReset _ |
207 | 216 |
| MNoReset _ |
... | ... | |
258 | 267 |
List.fold_left (fun res i -> Utils.ISet.union res (get_instr_vars i)) |
259 | 268 |
Utils.ISet.empty |
260 | 269 |
il |
270 |
|
|
271 |
|
|
272 |
let pp_original_lustre_expression m fmt i = |
|
273 |
match Corelang.get_instr_desc i with |
|
274 |
| MLocalAssign _ | MStateAssign _ |
|
275 |
| MBranch _ |
|
276 |
-> ( match i.lustre_eq with None -> () | Some e -> Printers.pp_node_eq fmt e) |
|
277 |
| MStep _ when is_step_fun m i -> () (* we print nothing, this is a STEP *) |
|
278 |
| MStep _ -> (match i.lustre_eq with None -> () | Some eq -> Printers.pp_node_eq fmt eq) |
|
279 |
| _ -> () |
|
261 | 280 |
|
262 | 281 |
let pp_instr_main m fmt i = |
263 | 282 |
(* first, we extract the expression and associated variables *) |
264 | 283 |
let var = get_instr_var i in |
265 | 284 |
let vars = Utils.ISet.elements (get_instr_vars i) in |
266 |
fprintf fmt "\"%s\": @[<v 2>{ \"expr\": \"%a\",@ \"vars\": [%a] @ \"original_lustre_expr\": [%t]@]}"
|
|
285 |
fprintf fmt "\"%s\": @[<v 2>{ \"expr\": \"%a\",@ \"vars\": [%a] @ \"original_lustre_expr\": [%a]@]}"
|
|
267 | 286 |
var.var_id |
268 | 287 |
(pp_instr m vars) i |
269 | 288 |
(fprintf_list ~sep:", " pp_var_string) vars |
270 |
(fun fmt -> () |
|
271 |
(*xxxx |
|
272 |
if is expr than print associated lustre eq else empty string |
|
273 |
xxx todo |
|
274 |
*) |
|
275 |
) |
|
289 |
(pp_original_lustre_expression m) i |
|
290 |
|
|
291 |
|
|
276 | 292 |
|
277 | 293 |
let pp_machine fmt m = |
278 | 294 |
try |
Also available in: Unified diff