From 230a40cd3f6ed654010becd793a33e4259cae0ca Mon Sep 17 00:00:00 2001
From: Youssef <youssef.sellami@student-cs.fr>
Date: Sun, 9 Mar 2025 16:01:56 +0100
Subject: [PATCH] cfg
---
src/cfg_dead_assign.ml | 25 ++++++++++++++-----------
src/cfg_liveness.ml | 41 ++++++++++++++++++++++++++++++++++-------
src/cfg_nop_elim.ml | 24 ++++++++++++++++++------
src/elang.ml | 2 +-
4 files changed, 67 insertions(+), 25 deletions(-)
diff --git a/src/cfg_dead_assign.ml b/src/cfg_dead_assign.ml
index e35fc47..00c2b5b 100644
--- a/src/cfg_dead_assign.ml
+++ b/src/cfg_dead_assign.ml
@@ -14,22 +14,25 @@ open Options
nouvelle fonction, et [c] est un booléen qui indique si du progrès a été
fait. *)
let dead_assign_elimination_fun ({ cfgfunbody; _ } as f: cfg_fun) =
- let changed = ref false in
- let cfgfunbody =
- Hashtbl.map (fun (n: int) (m: cfg_node) ->
- match m with
- (* TODO *)
- | _ -> m
- ) cfgfunbody in
- ({ f with cfgfunbody }, !changed )
+ let changed = ref false
+ in let lives_in = live_cfg_fun f
+ in let lives_out n = live_after_node cfgfunbody n lives_in
+ in let cfgfunbody =
+ Hashtbl.map (fun (n: int) (m: cfg_node) ->
+ match m with
+ (* TODO *)
+ | Cassign (s, e, i) -> if (Set.mem s (lives_out n)) then m else (changed := true; Cnop i)
+ | _ -> m
+ ) cfgfunbody
+ in ({ f with cfgfunbody }, !changed )
(* Applique l'élimination de code mort autant de fois que nécessaire. Testez
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
-
+ (* TODO *)
+ 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)
diff --git a/src/cfg_liveness.ml b/src/cfg_liveness.ml
index 194a291..609e3ad 100644
--- a/src/cfg_liveness.ml
+++ b/src/cfg_liveness.ml
@@ -1,12 +1,17 @@
open Batteries
open Cfg
+open Utils
(* Analyse de vivacité *)
(* [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
+ | Eint i -> Set.empty
+ | Evar s -> Set.singleton s
+ | Ebinop (b, e1, e2) -> Set.union (vars_in_expr e1) (vars_in_expr e2)
+ | Eunop (u, e) -> vars_in_expr e
(* [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,
@@ -14,14 +19,26 @@ let rec vars_in_expr (e: expr) =
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
-
+ let in_succs_opt = Set.map (fun s -> Hashtbl.find_opt lives s) (succs cfg n)
+ in let in_succs = Set.filter_map (fun s -> s) in_succs_opt
+ in set_concat (Set.to_list in_succs)
(* [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
+ let use node =
+ match node with
+ | Cassign (s, e, i) -> vars_in_expr e
+ | Creturn e -> vars_in_expr e
+ | Cprint (e, i) -> vars_in_expr e
+ | Ccmp (e, i1, i2) -> vars_in_expr e
+ | Cnop (i) -> Set.empty
+ in let def node =
+ match node with
+ | Cassign (s, e, i) -> Set.singleton s
+ | _ -> Set.empty
+ in Set.union (use node) (Set.diff live_after (def node))
(* [live_cfg_nodes cfg lives] effectue une itération du calcul de point fixe.
@@ -31,12 +48,22 @@ let live_cfg_node (node: cfg_node) (live_after: string Set.t) =
nœud a changé). *)
let live_cfg_nodes cfg (lives : (int, string Set.t) Hashtbl.t) =
(* TODO *)
- false
+ let changed = ref false in
+ Hashtbl.iter (fun n node ->
+ let new_alive_vars = live_cfg_node node (live_after_node cfg n lives)
+ in match Hashtbl.find_opt lives n with
+ | None -> changed := true; Hashtbl.replace lives n new_alive_vars
+ | Some alive_vars -> if not (Set.equal alive_vars new_alive_vars) then changed := true; Hashtbl.replace lives n new_alive_vars) cfg; !changed
+
(* [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
+ let lives = Hashtbl.create 17 in
(* TODO *)
- lives
+ let cfg = f.cfgfunbody
+ in while live_cfg_nodes cfg lives do
+ ()
+ done;
+ lives
diff --git a/src/cfg_nop_elim.ml b/src/cfg_nop_elim.ml
index da45a5a..5d8f3c6 100644
--- a/src/cfg_nop_elim.ml
+++ b/src/cfg_nop_elim.ml
@@ -15,7 +15,9 @@ open Options
*)
let nop_transitions (cfgfunbody: (int, cfg_node) Hashtbl.t) : (int * int) list =
(* TODO *)
- []
+ Hashtbl.fold (fun n node acc -> match node with
+ | Cnop i -> (n, i)::acc
+ | _ -> acc) cfgfunbody []
(* [follow n l visited] donne le premier successeur à partir de [n] qui ne soit
@@ -26,9 +28,13 @@ 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 =
+let rec follow (nop: int) (l: (int * int) list) (visited: int Set.t) : int =
(* TODO *)
- n
+ if Set.mem nop visited
+ then nop
+ else match List.assoc_opt nop l with
+ | None -> nop
+ | Some m -> follow m l (Set.add nop 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
@@ -48,13 +54,19 @@ let nop_transitions_closed cfgfunbody =
liste [nop_succs] (telle que renvoyée par [nop_transitions_closed]). *)
let replace_succ nop_succs s =
(* TODO *)
- s
+ match List.assoc_opt s nop_succs with
+ | None -> s
+ | Some x -> x
(* [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 (s, e, i) -> Cassign (s, e, replace_succ nop_succs i)
+ | Cprint (e, i) -> Cprint (e, replace_succ nop_succs i)
+ | Ccmp (e, i1, i2) -> Ccmp (e, replace_succ nop_succs i1, replace_succ nop_succs i2)
+ | _ -> 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) =
@@ -69,7 +81,7 @@ let nop_elim_fun ({ cfgfunargs; cfgfunbody; cfgentry } as f: cfg_fun) =
*)
let cfgfunbody = Hashtbl.filter_map (fun n node ->
(* TODO *)
- Some node
+ if Set.is_empty (preds cfgfunbody n) && n!=cfgentry then None else Some (replace_succs nop_transf 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. *)
diff --git a/src/elang.ml b/src/elang.ml
index 3e6fcf0..7dc3280 100644
--- a/src/elang.ml
+++ b/src/elang.ml
@@ -6,7 +6,7 @@ type unop = Eneg
type expr =
Ebinop of binop * expr * expr
- | Eunop of unop * expr (*unused*)
+ | Eunop of unop * expr (*unused in grammar*)
| Eint of int
| Evar of string
--
GitLab