Project

General

Profile

Revision 8f0e9f74 src/backends/EMF/EMF_backend.ml

View differences:

src/backends/EMF/EMF_backend.ml
216 216
  let pp_content fmt i =
217 217
    match Corelang.get_instr_desc i with
218 218
    | MLocalAssign(lhs, expr)
219
    -> (
220
      (match expr.value_desc with
221
      | Fun (fun_id, vl) -> (
222
	(* Thanks to normalization, vl shall only contain constant or
223
	   local/state vars but not calls to other functions *)
224
	fprintf fmt "\"kind\": \"operator\",@ ";
225
	fprintf fmt "\"lhs\": \"%a\",@ " pp_var_name lhs;
226
	fprintf fmt "\"name\": \"%s\",@ \"args\": [@[%a@]]"
227
	  fun_id
228
	  pp_emf_cst_or_var_list vl
229
      )	 
230
      | Array _ | Access _ | Power _ -> assert false (* No array expression allowed yet *)
231
      | Cst _ 
232
      | LocalVar _
233
      | StateVar _ -> (
234
	fprintf fmt "\"kind\": \"local_assign\",@ \"lhs\": \"%a\",@ \"rhs\": %a"
219
      -> (
220
	(match expr.value_desc with
221
	| Fun (fun_id, vl) -> (
222
	  (* Thanks to normalization, vl shall only contain constant or
223
	     local/state vars but not calls to other functions *)
224
	  fprintf fmt "\"kind\": \"operator\",@ ";
225
	  fprintf fmt "\"lhs\": \"%a\",@ " pp_var_name lhs;
226
	  fprintf fmt "\"name\": \"%s\",@ \"args\": [@[%a@]]"
227
	    fun_id
228
	    pp_emf_cst_or_var_list vl
229
	)	 
230
	| Array _ | Access _ | Power _ -> assert false (* No array expression allowed yet *)
231
	| Cst _ 
232
	| LocalVar _
233
	| StateVar _ -> (
234
	  fprintf fmt "\"kind\": \"local_assign\",@ \"lhs\": \"%a\",@ \"rhs\": %a"
235
	    pp_var_name lhs
236
	    pp_emf_cst_or_var expr
237
	))    )
238

  
239
    | MStateAssign(lhs, expr) (* a Pre construct Shall only be defined by a
240
				 variable or a constant, no function anymore! *)
241
      -> (
242
	fprintf fmt "\"kind\": \"pre\",@ \"lhs\": \"%a\",@ \"rhs\": %a"
235 243
	  pp_var_name lhs
236 244
	  pp_emf_cst_or_var expr
237
      ))    )
238

  
239
  | MStateAssign(lhs, expr) (* a Pre construct Shall only be defined by a
240
			       variable or a constant, no function anymore! *)
241
    -> (
242
      fprintf fmt "\"kind\": \"pre\",@ \"lhs\": \"%a\",@ \"rhs\": %a"
243
	pp_var_name lhs
244
	pp_emf_cst_or_var expr
245
    )
246
     
247
  | MReset id           
248
    -> (
249
      fprintf fmt "\"kind\": \"reset\",@ \"lhs\": \"%s\",@ \"rhs\": \"true\""
250
	(reset_name id)
251
    )
252
  | MNoReset id           
253
    -> (
254
      fprintf fmt "\"kind\": \"reset\",@ \"lhs\": \"%s\",@ \"rhs\": \"false\""
255
	(reset_name id)
256
    )
257
    
258
  | MBranch (g, hl) -> (
259
    let all_outputs, outputs, inputs = branch_instr_vars i in
260
    Format.eprintf "Mbranch %a@.vars: all_out: %a, out:%a, in:%a@.@."
261
      Machine_code.pp_instr i
262
      (fprintf_list ~sep:", " pp_var_string) (ISet.elements all_outputs)
263
      (fprintf_list ~sep:", " pp_var_string) (ISet.elements outputs)
264
      pp_emf_vars_decl
265
      (VSet.elements inputs)
245
      )
246
       
247
    | MReset id           
248
      -> (
249
	fprintf fmt "\"kind\": \"reset\",@ \"lhs\": \"%s\",@ \"rhs\": \"true\""
250
	  (reset_name id)
251
      )
252
    | MNoReset id           
253
      -> (
254
	fprintf fmt "\"kind\": \"reset\",@ \"lhs\": \"%s\",@ \"rhs\": \"false\""
255
	  (reset_name id)
256
      )
257
       
258
    | MBranch (g, hl) -> (
259
      let all_outputs, outputs, inputs = branch_instr_vars i in
260
      Format.eprintf "Mbranch %a@.vars: all_out: %a, out:%a, in:%a@.@."
261
	Machine_code.pp_instr i
262
	(fprintf_list ~sep:", " pp_var_string) (ISet.elements all_outputs)
263
	(fprintf_list ~sep:", " pp_var_string) (ISet.elements outputs)
264
	pp_emf_vars_decl
265
	(VSet.elements inputs)
266 266

  
267
    ;
268
    let inputs = VSet.filter (fun v -> not (ISet.mem v.var_id all_outputs)) inputs in
269
    Format.eprintf "Filtering in: %a@.@."
270
      pp_emf_vars_decl
271
      (VSet.elements inputs)
267
      ;
268
      let inputs = VSet.filter (fun v -> not (ISet.mem v.var_id all_outputs)) inputs in
269
      Format.eprintf "Filtering in: %a@.@."
270
	pp_emf_vars_decl
271
	(VSet.elements inputs)
272 272

  
273 273
      ;
274
    fprintf fmt "\"kind\": \"branch\",@ ";
275
    fprintf fmt "\"guard\": %a,@ " pp_emf_cst_or_var g; (* it has to be a variable or a constant *)
276
    fprintf fmt "\"outputs\": [%a],@ " (fprintf_list ~sep:", " pp_var_string) (ISet.elements outputs);
277
    fprintf fmt "\"inputs\": [%a],@ " pp_emf_vars_decl
278
      (* (let guard_inputs = get_expr_vars g in
279
	  VSet.elements (VSet.diff inputs guard_inputs)) -- previous version to
280
	 remove guard's variable from inputs *)
281
      (VSet.elements inputs)
282
    ;
283
    fprintf fmt "@[<v 2>\"branches\": {@ @[<v 0>%a@]@]@ }"
284
      (fprintf_list ~sep:",@ "
285
	 (fun fmt (tag, instrs_tag) ->
286
	   let branch_all_lhs, _, branch_inputs = branch_block_vars instrs_tag in
287
	   let branch_inputs = VSet.filter (fun v -> not (ISet.mem v.var_id branch_all_lhs)) branch_inputs in
288
	   fprintf fmt "@[<v 2>\"%s\": {@ " tag;
289
	   fprintf fmt "\"guard_value\": \"%a\",@ " pp_tag_id tag; 
290
	   fprintf fmt "\"inputs\": [%a],@ " pp_emf_vars_decl (VSet.elements branch_inputs); 
291
	   fprintf fmt "@[<v 2>\"instrs\": {@ ";
292
	   (pp_emf_instrs m) fmt instrs_tag;
293
	   fprintf fmt "@]@ }";
294
	   fprintf fmt "@]@ }"
295
	 )
296
      )
297
      hl
298
   )
299

  
300
  | MStep ([var], f, _) when is_arrow_fun m i -> (* Arrow case *) (
301
    fprintf fmt "\"kind\": \"arrow\",@ \"name\": \"%s\",@ \"lhs\": \"%a\",@ \"rhs\": \"%s\""
302
      f
303
      pp_var_name var
304
      (reset_name f)
305
  )
274
      fprintf fmt "\"kind\": \"branch\",@ ";
275
      fprintf fmt "\"guard\": %a,@ " pp_emf_cst_or_var g; (* it has to be a variable or a constant *)
276
      fprintf fmt "\"outputs\": [%a],@ " (fprintf_list ~sep:", " pp_var_string) (ISet.elements outputs);
277
      fprintf fmt "\"inputs\": [%a],@ " pp_emf_vars_decl
278
	(* (let guard_inputs = get_expr_vars g in
279
	   VSet.elements (VSet.diff inputs guard_inputs)) -- previous version to
280
	   remove guard's variable from inputs *)
281
	(VSet.elements inputs)
282
      ;
283
      fprintf fmt "@[<v 2>\"branches\": {@ @[<v 0>%a@]@]@ }"
284
	(fprintf_list ~sep:",@ "
285
	   (fun fmt (tag, instrs_tag) ->
286
	     let branch_all_lhs, _, branch_inputs = branch_block_vars instrs_tag in
287
	     let branch_inputs = VSet.filter (fun v -> not (ISet.mem v.var_id branch_all_lhs)) branch_inputs in
288
	     fprintf fmt "@[<v 2>\"%s\": {@ " tag;
289
	     fprintf fmt "\"guard_value\": \"%a\",@ " pp_tag_id tag; 
290
	     fprintf fmt "\"inputs\": [%a],@ " pp_emf_vars_decl (VSet.elements branch_inputs); 
291
	     fprintf fmt "@[<v 2>\"instrs\": {@ ";
292
	     (pp_emf_instrs m) fmt instrs_tag;
293
	     fprintf fmt "@]@ }";
294
	     fprintf fmt "@]@ }"
295
	   )
296
	)
297
	hl
298
    )
306 299

  
307
  | MStep (outputs, f, inputs) when not (is_imported_node f m) -> (
308
    let node_f = Machine_code.get_node_def f m in
309
    let is_stateful = List.mem_assoc f m.minstances in 
310
    fprintf fmt "\"kind\": \"%s\",@ \"name\": \"%a\",@ \"id\": \"%s\",@ "
311
      (if is_stateful then "statefulcall" else "statelesscall")
312
      print_protect (fun fmt -> pp_print_string fmt (node_f.node_id)) 
313
      f;
314
    fprintf fmt "\"lhs\": [@[%a@]],@ \"args\": [@[%a@]]"
315
      (fprintf_list ~sep:",@ " (fun fmt v -> fprintf fmt "\"%a\"" pp_var_name v)) outputs
316
      pp_emf_cst_or_var_list inputs;
317
    if is_stateful then fprintf fmt ",@ \"reset\": \"%s\"" (reset_name f) else fprintf fmt "@ "
318
  )
300
    | MStep ([var], f, _) when is_arrow_fun m i -> (* Arrow case *) (
301
      fprintf fmt "\"kind\": \"arrow\",@ \"name\": \"%s\",@ \"lhs\": \"%a\",@ \"rhs\": \"%s\""
302
	f
303
	pp_var_name var
304
	(reset_name f)
305
    )
319 306

  
320
  | MStep(outputs, f, inputs ) -> (* This is an imported node *)
321
        EMF_library_calls.pp_call fmt m f outputs inputs
322
	  
323
  | MComment _ 
324
    -> Format.eprintf "unhandled comment in EMF@.@?"; assert false
307
    | MStep (outputs, f, inputs) when not (is_imported_node f m) -> (
308
      let node_f = Machine_code.get_node_def f m in
309
      let is_stateful = List.mem_assoc f m.minstances in 
310
      fprintf fmt "\"kind\": \"%s\",@ \"name\": \"%a\",@ \"id\": \"%s\",@ "
311
	(if is_stateful then "statefulcall" else "statelesscall")
312
	print_protect (fun fmt -> pp_print_string fmt (node_f.node_id)) 
313
	f;
314
      fprintf fmt "\"lhs\": [@[%a@]],@ \"args\": [@[%a@]]"
315
	(fprintf_list ~sep:",@ " (fun fmt v -> fprintf fmt "\"%a\"" pp_var_name v)) outputs
316
	pp_emf_cst_or_var_list inputs;
317
      if is_stateful then
318
	fprintf fmt ",@ \"reset\": { \"name\": \"%s\", \"resetable\": \"%b\"}"
319
	  (reset_name f)
320
	  ( (* We extract the clock if it exist from the original lustre equation *)
321
	    match i.lustre_eq with
322
	    | Some eq -> (
323
	      match eq.eq_rhs.expr_desc with
324
	      | Expr_appl(_,_,reset) -> (
325
		match reset with None -> false | Some _ -> true
326
	      )
327
	      | _ ->  assert false
328
	    )
329
	    | None -> assert false (* should have been assigned to an original lustre equation *)
330
	  )
331
      else fprintf fmt "@ "
332
    )
333

  
334
    | MStep(outputs, f, inputs ) -> (* This is an imported node *)
335
       EMF_library_calls.pp_call fmt m f outputs inputs
336
	 
337
    | MComment _ 
338
      -> Format.eprintf "unhandled comment in EMF@.@?"; assert false
325 339
  (* not  available for EMF output *)
326 340

  
327 341
  in

Also available in: Unified diff