cfg_nop_elim.ml 4.14 KB
Newer Older
1
2
3
4
5
open BatList
open Batteries
open Prog
open Utils
open Cfg
Wilke Pierre's avatar
Wilke Pierre committed
6
7
8
open Report
open Cfg_print
open Options
9

10
(* Élimination des NOPs. *)
11

12
13
14
(* [nop_transitions cfg] donne la liste des transitions NOP dans un CFG.

   Si le nœud [n] contient [Cnop s], alors [(n,s)] devrait être dans le résultat.
15
16
*)
let nop_transitions (cfgfunbody: (int, cfg_node) Hashtbl.t) : (int * int) list =
Armillon Damien's avatar
Armillon Damien committed
17
18
19
20
21
   List.filter_map (fun (n, node) -> 
      match node with
      | Cnop(i) -> Some(n,i)
      | _ -> None
      ) (Hashtbl.to_list cfgfunbody)
22
23


24
25
26
27
28
(* [follow n l visited] donne le premier successeur à partir de [n] qui ne soit
   pas un NOP. Pour connaître le successeur d'un nœud NOP, on utilisara la liste
   [l] telle que produite précédemment. Pour rappel [(x,y)] dans [l] signifie
   qu'il y a un transition depuis un nœud [x] qui contient une instruction [Cnop
   y].
29

30
31
   L'ensemble [visited] est utilisé pour éviter les boucles.
   *)
32
let rec follow (n: int) (l: (int * int) list) (visited: int Set.t) : int =
Armillon Damien's avatar
Armillon Damien committed
33
34
35
36
37
   if Set.mem n visited then n else
   let next_nop = List.find_opt (fun (nop,s) -> nop = n) l in
   match next_nop with
   | None -> n
   | Some(_,s) -> follow s l (Set.add n visited)
38

39
40
41
42
(* [nop_transitions_closed] contient la liste [(n,s)] telle que l'instruction au
   nœud [n] est le début d'une chaîne de NOPs qui termine au nœud [s]. Les
   enseignants du cours de compiilation sont heureux de vous offrir cette
   fonction. *)
43
44
45
46
let nop_transitions_closed cfgfunbody =
  List.map (fun (node_id, node) ->
      (node_id, follow node_id (nop_transitions cfgfunbody) Set.empty))
    (nop_transitions cfgfunbody)
Armillon Damien's avatar
Armillon Damien committed
47
   
48

49
50
51
52
(* Nous allons maintenant réécrire notre programme pour remplacer les
   successeurs [s] de chaque nœud du CFG de la manière suivante : si [s] est le
   début d'une chaîne de NOPs, on remplace [s] par la fin de cette chaîne, en
   éliminant ainsi les nœuds NOPs. *)
53

54
55
(* [replace_succ nop_succs s] donne le nouveau nom du nœud [s], en utilisant la
   liste [nop_succs] (telle que renvoyée par [nop_transitions_closed]). *)
56
let replace_succ nop_succs s =
Armillon Damien's avatar
Armillon Damien committed
57
58
59
60
   let potential_succ = List.find_opt (fun (n,s') -> n=s) nop_succs in
   match potential_succ with
   | None -> s
   | Some (n,s') -> s'
61

62
63
(* [replace_succs nop_succs n] remplace le nœud [n] par un nœud équivalent où on
   a remplacé les successeurs, en utilisant la liste [nop_succs]. *)
64
let replace_succs nop_succs (n: cfg_node) =
Armillon Damien's avatar
Armillon Damien committed
65
66
67
68
69
70
   match n with
   | Cassign(str,e,s) -> Cassign(str,e, replace_succ nop_succs s)
   | Cprint(e,s) -> Cprint(e, replace_succ nop_succs s)
   | Ccmp(i,e,s) -> Ccmp(i,e, replace_succ nop_succs s)
   | Cnop(s) -> Cnop(replace_succ nop_succs s)
   | _ -> n
71

72
(* [nop_elim_fun f] applique la fonction [replace_succs] à chaque nœud du CFG. *)
73
74
let nop_elim_fun ({ cfgfunargs; cfgfunbody; cfgentry } as f: cfg_fun) =
  let nop_transf = nop_transitions_closed cfgfunbody in
75
76
77
78
79
80
81
82
  (* On utilise la fonction [Hashtbl.filter_map f h] qui permet d'appliquer une
     fonction à chaque nœud de [h] et d'éliminer ceux pour lesquels [f] renvoie
     [None].

     On souhaite éliminer les nœuds qui n'ont pas de prédécesseurs
     (inaccessibles), et appliquer la fonction [replace_succs] aux nœuds qui
     resteront.
  *)
Armillon Damien's avatar
Armillon Damien committed
83
84
  let cfgfunbody = Hashtbl.map (fun n node ->
         replace_succs nop_transf node
85
    ) cfgfunbody in
Armillon Damien's avatar
Armillon Damien committed
86
  let cfgfunbody = Hashtbl.filter_map (fun n node ->
Armillon Damien's avatar
Armillon Damien committed
87
88
89
90
91
92
93
94
      if (Set.is_empty (preds cfgfunbody n)) then
         if n=cfgentry then
            match node with
            | Cnop(n) -> Some node
            | _ -> Some node
         else Some node
      else Some node
   ) cfgfunbody in
95
96
  (* La fonction renvoyée est composée du nouveau [cfgfunbody] que l'on vient de
     calculer, et le point d'entrée est transformé en conséquence. *)
97
98
99
100
101
102
103
  {f with cfgfunbody; cfgentry = replace_succ nop_transf cfgentry }

let nop_elim_gdef gd =
  match gd with
    Gfun f -> Gfun (nop_elim_fun f)

let nop_elimination cp =
104
105
106
  if !Options.no_cfg_ne
  then cp
  else assoc_map nop_elim_gdef cp
Wilke Pierre's avatar
Wilke Pierre committed
107
108
109
110
111
112
113

let pass_nop_elimination cfg =
  let cfg = nop_elimination cfg in
  record_compile_result "NopElim";
  dump (!cfg_dump >*> fun s -> s ^ "3") dump_cfg_prog cfg
    (call_dot "cfg-after-nop" "CFG after NOP elim");
  OK cfg