Project

General

Profile

Revision 1bff14ac src/backends/EMF/EMF_backend.ml

View differences:

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