Fixes defined variables, fixes live variables, implements reduces registers, fixes risc semantic

lib/analysis/Dataflow.ml

@@ -33,6 +33,16 @@ module Make (M: Cfg.PrintableType) (I: Cfg.PrintableType) = struct
     internalbetween: (internal list * internal list) list;
   }
 
+  let compareinternalnode (a:internalnode) (b:internalnode) : bool =
+    match Utility.equality a.internalin b.internalin,
+          Utility.equality a.internalout b.internalout,
+          (List.fold_left2 (fun acc (ain, aout) (bin, bout)
+                            -> acc && (Utility.equality ain bin) && (Utility.equality aout bout)
+            ) true a.internalbetween b.internalbetween)
+    with
+    | true, true, true -> true
+    | _, _, _ -> false
+
   type cfgt = elt Cfg.cfginternal
 
   type t = {
@@ -40,49 +50,23 @@ module Make (M: Cfg.PrintableType) (I: Cfg.PrintableType) = struct
     internalvar: internalnode Cfg.NodeMap.t;
   }
 
+  let compareinternal (a: internalnode Cfg.NodeMap.t) (b: internalnode Cfg.NodeMap.t) =
+    Cfg.NodeMap.fold
+      (fun node bi acc ->
+         match Cfg.NodeMap.find_opt node a with
+           None -> false
+         | Some ai -> acc && compareinternalnode ai bi
+      ) b true
+
   let from_cfg (cfg: cfgt) : t =
     {t = cfg; internalvar = Cfg.NodeMap.empty}
 
   let to_cfg ({t; _}: t) : cfgt =
     t
 
-  let fixed_point
-      ?(init : (elt list -> internalnode) =
-               (fun _ -> {internalin = []; internalout = []; internalbetween = []}))
-      ?(update : (t -> Cfg.Node.t -> internalnode) =
-                 (fun t n -> Cfg.NodeMap.find n t.internalvar))
-      (t: t)
-    : t =
-    (* init function is applied only once to each node content,
-       the update function takes the node and the whole structure and is
-       expected to return the updated structure for the appropriate node,
-       update function is applied to the resulting structure until no change is
-       observed
-    *)
-    let rec helper t =
-      let newt =
-        {t with
-         internalvar = Cfg.NodeMap.mapi (fun n _ -> update t n) t.internalvar}
-      in
-      if newt = t then newt else helper newt
-    in
-    let content = List.fold_left
-        (fun cfg node -> Cfg.NodeMap.add node {internalin = [];
-                                               internalout = [];
-                                               internalbetween = []} cfg)
-        Cfg.NodeMap.empty
-        (Cfg.NodeSet.to_list t.t.nodes)
-    in
-    let content = Cfg.NodeMap.union
-        (fun _ket _empty code -> Some code)
-        content
-        (Cfg.NodeMap.map init t.t.content)
-    in
-    helper { t with internalvar = content }
-
 
   open Cfg
-  let pp (ppf: out_channel) (c: t) : unit =
+  let pp (ppf: out_channel) (c: t) : unit = (
     Printf.fprintf ppf "Cfg:\n";
     Printf.fprintf ppf "Nodes' ids: ";
     List.iter (fun (x : Node.t) -> Printf.fprintf ppf "%d " x.id) (NodeSet.to_list c.t.nodes);
@@ -148,4 +132,54 @@ module Make (M: Cfg.PrintableType) (I: Cfg.PrintableType) = struct
                 Printf.fprintf ppf "\n";
               ) (NodeMap.to_list c.internalvar);
     Printf.fprintf ppf "\n";
+  )
+
+
+  let fixed_point
+      ?(init : (elt list -> internalnode) =
+               (fun _ -> {internalin = []; internalout = []; internalbetween = []}))
+      ?(update : (t -> Cfg.Node.t -> internalnode) =
+                 (fun t n -> Cfg.NodeMap.find n t.internalvar))
+      (t: t)
+    : t =
+    (* init function is applied only once to each node content,
+       the update function takes the node and the whole structure and is
+       expected to return the updated structure for the appropriate node,
+       update function is applied to the resulting structure until no change is
+       observed
+    *)
+    let rec helper t =
+      let newt =
+        {t with
+         internalvar = Cfg.NodeMap.mapi (fun n _ -> update t n) t.internalvar}
+      in
+      if compareinternal newt.internalvar t.internalvar
+      then newt
+      else helper newt
+    in
+
+    let content =
+      List.fold_left
+        (fun cfg node -> Cfg.NodeMap.add node {internalin = [];
+                                               internalout = [];
+                                               internalbetween = []} cfg)
+        Cfg.NodeMap.empty
+        (Cfg.NodeSet.to_list t.t.nodes)
+    in
+
+    let code = (* we add back in the nodes with no code (there is no binding
+                  in the t.t.content map) *)
+      Cfg.NodeMap.union (fun _n c _empty -> Some c)
+        t.t.content
+        (Cfg.NodeMap.of_list
+           (Cfg.NodeSet.to_list t.t.nodes |> List.map (fun c -> (c, []))))
+    in
+
+    let content = Cfg.NodeMap.union
+        (fun _key _empty code -> Some code)
+        content
+        (Cfg.NodeMap.map init code)
+    in
+    helper { t with internalvar = content }
+
 end