Project

General

Profile

Revision dd71e482

View differences:

src/backends/EMF/EMF_backend.ml
424 424
       Printers.pp_var_name v
425 425
  | _ -> assert false (* Invalid argument *)
426 426

  
427
     
427
let rec get_expr_vars v =
428
  match v.value_desc with
429
  | Cst c -> VSet.empty
430
  | LocalVar v | StateVar v -> VSet.singleton v
431
  | Fun (_, args) -> List.fold_left (fun accu v -> VSet.union accu (get_expr_vars v)) VSet.empty args
432
  | _ -> assert false (* Invalid argument *)
433

  
428 434
let branch_cpt = ref 0
429 435
let get_instr_id fmt i =
430 436
  match Corelang.get_instr_desc i with
......
434 440
  | MStep (_, id, _) -> fprintf fmt "%s" id
435 441
  | _ -> () (* No name *)
436 442

  
437
let rec branch_block_defined_vars il =
443
let rec branch_block_vars il =
438 444
  List.fold_left
439
    (fun accu i -> ISet.union accu (branch_instr_defined_vars i)) ISet.empty il
440
and branch_instr_defined_vars i =
445
    (fun (accu_def, accu_read) i ->
446
      let defined_vars, read_vars = branch_instr_vars i in
447
      ISet.union accu_def defined_vars, VSet.union accu_read read_vars)
448
    (ISet.empty, VSet.empty) il
449
and branch_instr_vars i =
441 450
  match Corelang.get_instr_desc i with
442
  | MLocalAssign (var,_) 
443
  | MStateAssign (var,_) -> ISet.singleton var.var_id
444
  | MStep (vars, _, _)  ->  ISet.of_list (List.map (fun v -> v.var_id) vars)
445
  | MBranch (_,(_,hd_il)::tl)     -> (* We focus on variables defined in all branches *)
446
     List.fold_left
447
       (fun res (_, il) -> ISet.inter res (branch_block_defined_vars il))
448
       (branch_block_defined_vars hd_il)
449
       tl
451
  | MLocalAssign (var,expr) 
452
  | MStateAssign (var,expr) -> ISet.singleton var.var_id, get_expr_vars expr
453
  | MStep (vars, _, args)  ->
454
     ISet.of_list (List.map (fun v -> v.var_id) vars),
455
    List.fold_left (fun accu v -> VSet.union accu (get_expr_vars v)) VSet.empty args
456
  | MBranch (g,(_,hd_il)::tl)     -> (* We focus on variables defined in all branches *)
457
     let read_guard = get_expr_vars g in
458
     let def_vars_hd, read_vars_hd = branch_block_vars hd_il in
459
     let def_vars, read_vars =
460
       List.fold_left
461
	 (fun (def_vars, read_vars) (_, il) ->
462
	 (* We accumulate reads but intersect writes *)
463
	   let writes_il, reads_il = branch_block_vars il in
464
	   ISet.inter def_vars writes_il,
465
	 VSet.union read_vars reads_il
466
	 )
467
	 (def_vars_hd, read_vars_hd)
468
	 tl
469
     in
470
     def_vars, VSet.union read_guard read_vars
450 471
  | MBranch _ -> assert false (* branch instruction should admit at least one case *)
451 472
  | MReset ni           
452
  | MNoReset ni -> ISet.singleton (reset_name ni)
473
  | MNoReset ni -> ISet.singleton (reset_name ni), VSet.empty
453 474
  | MComment _ -> assert false (* not  available for EMF output *)
454 475
     
455 476
  
......
501 522
    )
502 523
    
503 524
  | MBranch (g, hl) -> (
504
    let outputs = ISet.elements (branch_instr_defined_vars i) in
525
    let outputs, inputs = branch_instr_vars i in
505 526
    fprintf fmt "\"kind\": \"branch\",@ ";
506 527
    fprintf fmt "\"guard\": %a,@ " pp_emf_cst_or_var g; (* it has to be a variable or a constant *)
507
    fprintf fmt "\"outputs\": [%a],@ " (fprintf_list ~sep:", " pp_var_string) outputs;
508
    fprintf fmt "\"branches\": {@[<v 0>%a@]}@ "
528
    fprintf fmt "\"outputs\": [%a],@ " (fprintf_list ~sep:", " pp_var_string) (ISet.elements outputs);
529
    fprintf fmt "\"inputs\": [%a],@ " pp_emf_vars_decl
530
      (* (let guard_inputs = get_expr_vars g in
531
	  VSet.elements (VSet.diff inputs guard_inputs)) -- previous version to
532
	 removed guard's variable from inputs *)
533
      (VSet.elements inputs)
534
    ;
535
    fprintf fmt "@[<v 2>\"branches\": {@ %a@]}@ "
509 536
      (fprintf_list ~sep:",@ "
510 537
	 (fun fmt (tag, instrs_tag) ->
511
	   fprintf fmt "\"%s\": {@[<v 0>" tag;
538
	   let (*branch_outputs*) _, branch_inputs = branch_block_vars instrs_tag in
539
    	   
540
	   fprintf fmt "@[<v 2>\"%s\": {@ " tag;
541
	   fprintf fmt "\"inputs\": [%a],@ " pp_emf_vars_decl (VSet.elements branch_inputs); 
542
	   fprintf fmt "@[<v 2>\"instrs\": {@ ";
512 543
	   fprintf_list ~sep:",@ " (pp_emf_instr2 m) fmt instrs_tag;
513
	       (* TODO xx ajouter les outputs dans le Mbranch et les inputs de chaque
514
	    action bloc dans chaque branch 
515
	    (fprintf_list ~sep:", " pp_var_string) arguments_vars *)
516
	       
517
	       fprintf fmt "@]}"
544
	   fprintf fmt "@]}@ ";
545
	   fprintf fmt "@]}"
518 546

  
519 547
	 )
520 548
      )
521 549
      hl
522
  )
550
   )
523 551

  
524 552
  | MStep ([var], f, _) when is_arrow_fun m i -> (* Arrow case *) (
525 553
    fprintf fmt "\"kind\": \"arrow\",@ \"name\": \"%s\",@ \"lhs\": \"%a\",@ \"rhs\": \"%s\""
......
535 563
      (if is_stateful then "statefulcall" else "statelesscall")
536 564
      (node_f.node_id) 
537 565
      f;
538
    fprintf fmt "\"lhs\": [%a],@ \"args\": [@[%a@]]@ "
566
    fprintf fmt "\"lhs\": [@[%a@]],@ \"args\": [@[%a@]]"
539 567
      (fprintf_list ~sep:",@ " (fun fmt v -> fprintf fmt "\"%a\"" Printers.pp_var_name v)) outputs
540 568
      pp_emf_cst_or_var_list inputs;
541
    if is_stateful then fprintf fmt ",@ \"reset\": \"%s\"" (reset_name f)   
569
    if is_stateful then fprintf fmt ",@ \"reset\": \"%s\"" (reset_name f) else fprintf fmt "@ "
542 570
  )
543 571

  
544 572
  | MComment _ 
......
546 574
  (* not  available for EMF output *)
547 575

  
548 576
  in
549
  fprintf fmt "@[ \"%a\": { " get_instr_id i;
550
  fprintf fmt "@[<v 0>%a,@ " pp_content i;
551
  fprintf fmt "\"original_lustre_expr\": [@[<v 0>\"%a\"@]]@]" (pp_original_lustre_expression m) i; 
577
  fprintf fmt "@[ @[<v 2>\"%a\": {@ " get_instr_id i;
578
  fprintf fmt "%a@ " pp_content i;
579
  (* fprintf fmt "@[<v 2>\"original_lustre_expr\": [@ \"%a\"@]]@]" (pp_original_lustre_expression m) i;  *)
552 580
  fprintf fmt "}@]"
553 581

  
554 582
       
src/printers.ml
45 45
  | Tydec_array (d, cty') -> fprintf fmt "%a^%a" print_dec_ty cty' Dimension.pp_dimension d
46 46

  
47 47
let pp_var_name fmt id = fprintf fmt "%s" id.var_id
48
let pp_var_type fmt id = Types.print_ty fmt id.var_type
48
let pp_var_type fmt id = Types.print_node_ty fmt id.var_type
49 49
  
50 50
let pp_eq_lhs = fprintf_list ~sep:", " pp_print_string
51 51

  

Also available in: Unified diff