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