Commit 0c2ae178 authored by Armillon Damien's avatar Armillon Damien
Browse files

CFG optimisation

parent 99868eaf
open Batteries
open Cfg
open Elang_run
open Cfg_run
open Prog
open Utils
open Report
......@@ -10,13 +11,20 @@ open Options
(* [simple_eval_eexpr e] evaluates an expression [e] with no variables. Raises
an exception if the expression contains variables. *)
let rec simple_eval_eexpr (e: expr) : int =
0
let st = init_state 0 in
match eval_cfgexpr st e with
| OK result -> Printf.printf "%d\n" result;result
| Error s -> failwith "There was a var"
(* If an expression contains variables, we cannot simply evaluate it. *)
(* [has_vars e] indicates whether [e] contains variables. *)
let rec has_vars (e: expr) =
true
match e with
| Eint(n) -> false
| Evar(str) -> true
| Eunop(_,e') -> has_vars e'
| Ebinop(_,e',e'') -> has_vars e' || has_vars e''
let const_prop_binop b e1 e2 =
let e = Ebinop (b, e1, e2) in
......@@ -32,10 +40,17 @@ let const_prop_unop u e =
let rec const_prop_expr (e: expr) =
e
if has_vars e
then e
else Eint (simple_eval_eexpr e)
let constant_propagation_instr (i: cfg_node) : cfg_node =
i
match i with
| Cassign(str,e,n) -> Cassign(str, const_prop_expr e, n)
| Creturn(e) -> Creturn(const_prop_expr e)
| Cprint(e, n) -> Cprint(const_prop_expr e, n)
| Ccmp(e,n,n') -> Ccmp(const_prop_expr e, n, n')
| Cnop(n) -> Cnop(n)
let constant_propagation_fun ({ cfgfunargs; cfgfunbody; cfgentry } as f: cfg_fun) =
let ht = Hashtbl.map (fun n m ->
......
......@@ -15,10 +15,12 @@ open Options
fait. *)
let dead_assign_elimination_fun ({ cfgfunargs; cfgfunbody; cfgentry } as f: cfg_fun) =
let changed = ref false in
let lives = live_cfg_fun f in
let cfgfunbody =
Hashtbl.map (fun (n: int) (m: cfg_node) ->
match m with
(* TODO *)
| Cassign(a,e,n) -> let alive = Hashtbl.find lives n in
if (Set.mem a alive) then m else (changed := true; Cnop(n))
| _ -> m
) cfgfunbody in
({ f with cfgfunbody }, !changed )
......@@ -27,8 +29,7 @@ let dead_assign_elimination_fun ({ cfgfunargs; cfgfunbody; cfgentry } as f: cfg_
notamment sur le fichier de test [basic/useless_assigns.e]. *)
let rec iter_dead_assign_elimination_fun f =
let f, c = dead_assign_elimination_fun f in
(* TODO *)
f
if c then iter_dead_assign_elimination_fun f else f
let dead_assign_elimination_gdef = function
Gfun f -> Gfun (iter_dead_assign_elimination_fun f)
......
......@@ -7,23 +7,34 @@ open Utils
(* [vars_in_expr e] renvoie l'ensemble des variables qui apparaissent dans [e]. *)
let rec vars_in_expr (e: expr) =
(* TODO *)
Set.empty
match e with
| Evar(str) -> Set.singleton(str)
| Eint(i) -> Set.empty
| Eunop(_,e1) -> vars_in_expr e1
| Ebinop(_,e1,e2) -> Set.union (vars_in_expr e1) (vars_in_expr e2)
(* [live_cfg_node node live_after] renvoie l'ensemble des variables vivantes
avant un nœud [node], étant donné l'ensemble [live_after] des variables
vivantes après ce nœud. *)
let live_cfg_node (node: cfg_node) (live_after: string Set.t) =
(* TODO *)
live_after
match node with
| Cnop(n) -> live_after
| Cassign(str, e,n) -> Set.union (vars_in_expr e) (Set.diff live_after (Set.singleton str))
| Creturn(e) -> Set.union (vars_in_expr e) live_after
| Cprint(e,n) -> Set.union (vars_in_expr e) live_after
| Ccmp(e,n,n') -> Set.union (vars_in_expr e) live_after
(* [live_after_node cfg n] renvoie l'ensemble des variables vivantes après le
nœud [n] dans un CFG [cfg]. [lives] est l'état courant de l'analyse,
c'est-à-dire une table dont les clés sont des identifiants de nœuds du CFG et
les valeurs sont les ensembles de variables vivantes avant chaque nœud. *)
let live_after_node cfg n (lives: (int, string Set.t) Hashtbl.t) : string Set.t =
(* TODO *)
Set.empty
Set.fold (fun succ acc->
match Hashtbl.find_option lives succ with
| None -> acc
| Some(set) -> Set.union acc set
) (succs cfg n) Set.empty
(* [live_cfg_nodes cfg lives] effectue une itération du calcul de point fixe.
......@@ -32,13 +43,23 @@ let live_after_node cfg n (lives: (int, string Set.t) Hashtbl.t) : string Set.t
au moins un nœud n pour lequel l'ensemble des variables vivantes avant ce
nœud a changé). *)
let live_cfg_nodes cfg (lives : (int, string Set.t) Hashtbl.t) =
(* TODO *)
false
let reverse_order_nodes = List.sort (fun n1 n2 -> compare (fst n2) (fst n2) )(Hashtbl.to_list cfg) in
List.fold_left (fun has_changed (n, node) ->
let live_in_node = live_cfg_node node (live_after_node cfg n lives) in
let old_live = Hashtbl.find_option lives n in
Hashtbl.replace lives n live_in_node;
match old_live with
| None -> true
| Some(old_live) ->
if not (has_changed ||Set.equal live_in_node (old_live)) then true else has_changed
) false reverse_order_nodes
let rec live_cfg_nodes_rec cfg lives =
if not (live_cfg_nodes cfg lives) then lives else live_cfg_nodes_rec cfg lives
(* [live_cfg_fun f] calcule l'ensemble des variables vivantes avant chaque nœud
du CFG en itérant [live_cfg_nodes] jusqu'à ce qu'un point fixe soit atteint.
*)
let live_cfg_fun (f: cfg_fun) : (int, string Set.t) Hashtbl.t =
let lives = Hashtbl.create 17 in
(* TODO *)
lives
let cfg = f.cfgfunbody in
live_cfg_nodes_rec cfg lives
......@@ -14,8 +14,11 @@ open Options
Si le nœud [n] contient [Cnop s], alors [(n,s)] devrait être dans le résultat.
*)
let nop_transitions (cfgfunbody: (int, cfg_node) Hashtbl.t) : (int * int) list =
(* TODO *)
[]
List.filter_map (fun (n, node) ->
match node with
| Cnop(i) -> Some(n,i)
| _ -> None
) (Hashtbl.to_list cfgfunbody)
(* [follow n l visited] donne le premier successeur à partir de [n] qui ne soit
......@@ -27,8 +30,11 @@ let nop_transitions (cfgfunbody: (int, cfg_node) Hashtbl.t) : (int * int) list =
L'ensemble [visited] est utilisé pour éviter les boucles.
*)
let rec follow (n: int) (l: (int * int) list) (visited: int Set.t) : int =
(* TODO *)
n
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)
(* [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
......@@ -38,6 +44,7 @@ let nop_transitions_closed cfgfunbody =
List.map (fun (node_id, node) ->
(node_id, follow node_id (nop_transitions cfgfunbody) Set.empty))
(nop_transitions cfgfunbody)
(* 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
......@@ -47,13 +54,20 @@ let nop_transitions_closed cfgfunbody =
(* [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]). *)
let replace_succ nop_succs s =
s
let potential_succ = List.find_opt (fun (n,s') -> n=s) nop_succs in
match potential_succ with
| None -> s
| Some (n,s') -> s'
(* [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]. *)
let replace_succs nop_succs (n: cfg_node) =
(* TODO *)
n
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
(* [nop_elim_fun f] applique la fonction [replace_succs] à chaque nœud du CFG. *)
let nop_elim_fun ({ cfgfunargs; cfgfunbody; cfgentry } as f: cfg_fun) =
......@@ -66,10 +80,12 @@ let nop_elim_fun ({ cfgfunargs; cfgfunbody; cfgentry } as f: cfg_fun) =
(inaccessibles), et appliquer la fonction [replace_succs] aux nœuds qui
resteront.
*)
let cfgfunbody = Hashtbl.filter_map (fun n node ->
(* TODO *)
Some node
let cfgfunbody = Hashtbl.map (fun n node ->
replace_succs nop_transf node
) cfgfunbody in
let cfgfunbody = Hashtbl.filter_map (fun n node ->
if (Set.is_empty (preds cfgfunbody n)) then None else Some node
) cfgfunbody in
(* 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. *)
{f with cfgfunbody; cfgentry = replace_succ nop_transf cfgentry }
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment