Project

General

Profile

« Previous | Next » 

Revision a91680fc

Added by LĂ©lio Brun 8 months ago

Bug fix with constant inlining variable removal in machine code

View differences:

src/optimize_machine.ml
623 623
(* Additional function to modify the prog according to removed variables map *)
624 624

  
625 625
let elim_prog_variables prog removed_table =
626
  List.map (
627
      fun t ->
628
      match t.top_decl_desc with
629
        Node nd ->
630
         if IMap.mem nd.node_id removed_table then
631
           let nd_elim_map = IMap.find nd.node_id removed_table in
632
           (* Iterating through the elim map to compute
633
              - the list of variables to remove
634
              - the associated list of lustre definitions x = expr to
635
                be used when removing these variables *)
636
           let vars_to_replace, defs = (* Recovering vid from node locals *)
637
             IMap.fold (fun v (_,eq) (accu_locals, accu_defs) ->
638
                 let locals =
639
                   try
640
                     (List.find (fun v' -> v'.var_id = v) nd.node_locals)::accu_locals
641
                   with Not_found -> accu_locals (* Variable v shall
642
                                                    be a global
643
                                                    constant, we do no
644
                                                    need to eliminate
645
                                                    it from the locals
646
                                                    *)
647
                 in
648
                 (* xxx let new_eq = { eq_lhs = [v]; eq_rhs = e; eq_loc = e.expr_loc } in *)
649
                 let defs = eq::accu_defs in
650
                 locals, defs
651
               ) nd_elim_map ([], [])
652
           in
653
            
654
           let new_locals, new_stmts =
655
             List.fold_right (fun stmt (locals, res_stmts) ->
656
                 match stmt with
657
                   Aut _ -> assert false (* should be processed by now *)
658
                 | Eq eq -> (
659
                   match eq.eq_lhs with
660
                   | [] -> assert false (* shall not happen *)
661
                   | _::_::_ ->
662
                      (* When more than one lhs we just keep the
663
                         equation and do not delete it *)
664
                      let eq_rhs' = substitute_expr vars_to_replace defs eq.eq_rhs in
665
                      locals, (Eq { eq with eq_rhs = eq_rhs' })::res_stmts
666
                   | [lhs] -> 
667
                      if List.exists (fun v -> v.var_id = lhs) vars_to_replace then 
668
                        (* We remove the def *)
669
                        List.filter (fun l -> l.var_id != lhs) locals,
670
                        res_stmts
671
                      else (* We keep it but modify any use of an eliminatend var *)
672
                        let eq_rhs' = substitute_expr vars_to_replace defs eq.eq_rhs in 
673
                        locals,
674
                        (Eq { eq with eq_rhs = eq_rhs' })::res_stmts
675
                        
676
                 )
677
               ) nd.node_stmts (nd.node_locals,[])
678
           in
679
           let nd' = { nd with
680
                       node_locals = new_locals;
681
                       node_stmts = new_stmts;
682
                     }
683
           in
684
           { t with top_decl_desc = Node nd' }
685
         else
686
           t
626
  List.map (fun t -> match t.top_decl_desc with
627
      | Node nd ->
628
        begin match IMap.find_opt nd.node_id removed_table with
629
          | Some nd_elim_map ->
630
            (* Iterating through the elim map to compute
631
               - the list of variables to remove
632
               - the associated list of lustre definitions x = expr to
633
                 be used when removing these variables *)
634
            let vars_to_replace, defs = (* Recovering vid from node locals *)
635
              IMap.fold (fun v (_,eq) (accu_locals, accu_defs) ->
636
                  let locals =
637
                    try
638
                      List.find (fun v' -> v'.var_id = v) nd.node_locals
639
                      :: accu_locals
640
                    with Not_found -> accu_locals (* Variable v shall
641
                                                     be a global
642
                                                     constant, we do no
643
                                                     need to eliminate
644
                                                     it from the locals
645
                                                  *)
646
                  in
647
                  (* xxx let new_eq = { eq_lhs = [v]; eq_rhs = e; eq_loc = e.expr_loc } in *)
648
                  let defs = eq::accu_defs in
649
                  locals, defs
650
                ) nd_elim_map ([], [])
651
            in
652

  
653
            let node_locals, node_stmts =
654
              List.fold_right (fun stmt (locals, res_stmts) ->
655
                  match stmt with
656
                  | Aut _ -> assert false (* should be processed by now *)
657
                  | Eq eq ->
658
                    begin match eq.eq_lhs with
659
                      | [] -> assert false (* shall not happen *)
660
                      | _::_::_ ->
661
                        (* When more than one lhs we just keep the
662
                           equation and do not delete it *)
663
                        let eq_rhs' = substitute_expr vars_to_replace defs eq.eq_rhs in
664
                        locals, (Eq { eq with eq_rhs = eq_rhs' })::res_stmts
665
                      | [lhs] ->
666
                        if List.exists (fun v -> v.var_id = lhs) vars_to_replace then
667
                          (* We remove the def *)
668
                          List.filter (fun v -> v.var_id <> lhs) locals,
669
                          res_stmts
670
                        else (* We keep it but modify any use of an eliminatend var *)
671
                          let eq_rhs' = substitute_expr vars_to_replace defs eq.eq_rhs in
672
                          locals,
673
                          (Eq { eq with eq_rhs = eq_rhs' })::res_stmts
674
                    end
675
                ) nd.node_stmts (nd.node_locals, [])
676
            in
677
            let nd' = { nd with node_locals; node_stmts } in
678
            { t with top_decl_desc = Node nd' }
679
          | None -> t
680
        end
687 681
      | _ -> t
688
    ) prog
682
  ) prog
689 683

  
690 684
(*** Main function ***)
691 685

  

Also available in: Unified diff