Added dataflow module

bin/dune

@@ -4,9 +4,9 @@
   (libraries exercises
              miniImp
              miniFun
-             cfg
+             analysis
              utility)
-  (package miniFun)
+  (package miniImp)
   (modes byte exe)
 )
 

bin/main.ml

@@ -12,26 +12,40 @@ def main with input a output b as
 "
   in
 
-  Printf.printf "%s\n%s\n" (colorred "Program is") program;
+  (* Printf.printf "%s\n%s\n" (colorred "Program is") program; *)
 
   let get_result x = Lexing.from_string x |> Parser.prg Lexer.lex in
 
   let p = get_result program in
 
-  Format.printf "%s\n%a\n@?" (colorred "AST is") Types.pp_p_exp p;
+  (* Format.printf "%s\n%a\n@?" (colorred "AST is") Types.pp_p_exp p; *)
 
   let convertedcfg = CfgImp.convert_io 10 p in
 
-  Printf.printf "%s\n%a" (colorred "Converted CFG is") CfgImp.SSCfg.pp convertedcfg;
+  (* Printf.printf "%s\n%a" (colorred "Converted CFG is") CfgImp.SSCfg.pp convertedcfg; *)
 
   let convertedrisccfg = CfgRISC.convert convertedcfg in
 
   Printf.printf "%s\n%a" (colorred "Converted RISC CFG is") CfgRISC.RISCCfg.pp convertedrisccfg;
 
+  (* ---------------------------------- *)
+
+  let analysiscfg = DefinedVariables.compute_defined_variables convertedrisccfg in
+
+  Printf.printf "%s\n%a" (colorred "Analysis CFG is") DefinedVariables.DVCfg.pp analysiscfg;
+
+  let convertedrisccfg = DefinedVariables.compute_cfg analysiscfg in
+
+  Printf.printf "%s\n%a" (colorred "Converted RISC after analysis CFG is") CfgRISC.RISCCfg.pp convertedrisccfg;
+
+  (* ---------------------------------- *)
+
   let risc = RISC.convert convertedrisccfg in
 
-  Printf.printf "%s\n%a" (colorred "RISC code is") RISC.RISCAssembly.pp risc;
+  (* Printf.printf "%s\n%a" (colorred "RISC code is") RISC.RISCAssembly.pp risc; *)
 
-  let computerisc = RISCSemantics.reduce risc in
+  let _computerisc = RISCSemantics.reduce risc in
 
-  Printf.printf "%s\n%d\n" (colorred "Output of RISC code is") computerisc;
+  (* Printf.printf "%s\n%d\n" (colorred "Output of RISC code is") computerisc; *)
+
+  ()

dune-project

@@ -11,12 +11,12 @@
  (depends ocaml dune))
 
 (package
- (name cfg)
+ (name analysis)
  (depends ocaml dune))
 
 (package
  (name miniImp)
- (depends ocaml dune utility))
+ (depends ocaml dune utility analysis))
 
 (package
  (name miniFun)

lib/analysis/Cfg.ml

@@ -8,15 +8,14 @@ let globalIdNode = ref 0;
 
 module Node = struct
   type t = {
-    id: int
+    id: int;
   }
   let compare a b = compare a.id b.id
 
   let create () =
     globalIdNode := !globalIdNode + 1;
-    {id = !globalIdNode}
+    {id = !globalIdNode;}
 end
-;;
 
 module NodeMap = struct
   include Map.Make(Node)
@@ -29,9 +28,7 @@ end
 
 module NodeSet = Set.Make(Node)
 
-module type C = sig
-  type elt
-  type t = {
+type 'a cfginternal = {
   empty: bool;
   nodes: NodeSet.t;
   edges: (Node.t * (Node.t option)) NodeMap.t;
@@ -40,8 +37,12 @@ module type C = sig
   inputOutputVar: (string * string) option;
   initial: Node.t option;
   terminal: Node.t option;
-    content: elt list NodeMap.t
-  }
+  content: 'a list NodeMap.t;
+}
+
+module type C = sig
+  type elt
+  type t = elt cfginternal
 
   val empty : t
   val merge : t -> t -> Node.t -> Node.t -> t
@@ -51,19 +52,9 @@ module type C = sig
   val pp : out_channel -> t -> unit
 end
 
-module Make(M: PrintableType) = struct
+module Make (M: PrintableType) = struct
   type elt = M.t
-  type t = {
-    empty: bool;
-    nodes: NodeSet.t;
-    edges: (Node.t * (Node.t option)) NodeMap.t;
-    reverseEdges: (Node.t list) NodeMap.t;
-    inputVal: int option;
-    inputOutputVar: (string * string) option;
-    initial: Node.t option;
-    terminal: Node.t option;
-    content: elt list NodeMap.t
-  }
+  type t = elt cfginternal
 
   let empty : t =
     { empty = true;

lib/analysis/Cfg.mli

@@ -6,7 +6,7 @@ end
 
 module Node : sig
   type t = {
-    id: int
+    id: int;
   }
   val compare : t -> t -> int
   val create : unit -> t
@@ -20,9 +20,8 @@ end
 
 module NodeSet : Set.S with type elt = Node.t
 
-module type C = sig
-  type elt
-  type t = {
+
+type 'a cfginternal = {
   empty: bool;
   nodes: NodeSet.t;
   edges: (Node.t * (Node.t option)) NodeMap.t;
@@ -31,8 +30,12 @@ module type C = sig
   inputOutputVar: (string * string) option;
   initial: Node.t option;
   terminal: Node.t option;
-    content: elt list NodeMap.t
-  }
+  content: 'a list NodeMap.t;
+}
+
+module type C = sig
+  type elt
+  type t = elt cfginternal
 
   val empty : t
   val merge : t -> t -> Node.t -> Node.t -> t

lib/analysis/Dataflow.ml

@@ -0,0 +1,136 @@
+module type C = sig
+  type elt
+  type internal
+
+  type internalnode = {
+    internalin: internal list;
+    internalout: internal list;
+    internalbetween: internal list list;
+  }
+
+  type cfgt = elt Cfg.cfginternal
+
+  type t = {
+    t: cfgt;
+    internalvar: internalnode Cfg.NodeMap.t;
+  }
+
+  val from_cfg : cfgt -> t
+  val to_cfg : t -> cfgt
+
+  val fixed_point : ?init:(elt list -> internalnode) -> ?update:(t -> Cfg.Node.t -> internalnode) -> t -> t
+
+  val pp : out_channel -> t -> unit
+end
+
+module Make (M: Cfg.PrintableType) (I: Cfg.PrintableType) = struct
+  type elt = M.t
+  type internal = I.t
+
+  type internalnode = {
+    internalin: internal list;
+    internalout: internal list;
+    internalbetween: internal list list;
+  }
+
+  type cfgt = elt Cfg.cfginternal
+
+  type t = {
+    t: cfgt;
+    internalvar: internalnode Cfg.NodeMap.t;
+  }
+
+  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
+    helper { t with internalvar = Cfg.NodeMap.map init t.t.content }
+
+
+  open Cfg
+  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);
+    Printf.fprintf ppf "\n";
+
+    Printf.fprintf ppf "Nodes' edges:\n";
+    List.iter (fun ((n, (a, b)) : (Node.t * (Node.t * Node.t option))) : unit ->
+        match b with None -> Printf.fprintf ppf "\t%d -> %d\n" n.id a.id
+                   | Some b -> Printf.fprintf ppf "\t%d -> %d, %d\n" n.id a.id b.id
+      ) (NodeMap.to_list c.t.edges);
+    Printf.fprintf ppf "\n";
+
+    Printf.fprintf ppf "Nodes' back edges:\n";
+    List.iter (fun ((n, xs) : (Node.t * (Node.t list))) : unit ->
+        Printf.fprintf ppf "\t%d -> " n.id;
+        List.iter (fun (x: Node.t) -> Printf.fprintf ppf "%d, " x.id) xs;
+        Printf.fprintf ppf "\n"
+      ) (NodeMap.to_list c.t.reverseEdges);
+    Printf.fprintf ppf "\n";
+
+    Printf.fprintf ppf "Input Value: ";
+    (match c.t.inputVal with
+       Some i -> Printf.fprintf ppf "%d" i;
+     | None   -> Printf.fprintf ppf "None";);
+    Printf.fprintf ppf "\n";
+
+    Printf.fprintf ppf "Input and Output Vars: ";
+    (match c.t.inputOutputVar with
+       Some (i, o) -> Printf.fprintf ppf "(in: %s, out: %s)" i o;
+     | None   -> Printf.fprintf ppf "None";);
+    Printf.fprintf ppf "\n";
+
+    Printf.fprintf ppf "Initial node's id: ";
+    (match c.t.initial with
+       Some i -> Printf.fprintf ppf "%d" (i.id);
+     | None   -> Printf.fprintf ppf "None";);
+    Printf.fprintf ppf "\n";
+
+    Printf.fprintf ppf "Terminal node's id: ";
+    (match c.t.terminal with
+       Some i -> Printf.fprintf ppf "%d" (i.id);
+     | None   -> Printf.fprintf ppf "None";);
+    Printf.fprintf ppf "\n";
+
+    Printf.fprintf ppf "Code:\n";
+    List.iter (fun ((n, stms) : Node.t * elt list) : unit ->
+        Printf.fprintf ppf "\tid %d --> %a\n%!" n.id M.pplist stms
+      ) (NodeMap.to_list c.t.content);
+    Printf.fprintf ppf "\n";
+
+    Printf.fprintf ppf "Analysis structure:\n";
+    List.iter (fun ((n, {internalin; internalout; internalbetween})
+                    : (Node.t * internalnode)) : unit ->
+                Printf.fprintf ppf "Node: %d\n" n.id;
+                Printf.fprintf ppf "Internal Input: ";
+                Printf.fprintf ppf "%a\n" I.pplist internalin;
+                Printf.fprintf ppf "Internal Output: ";
+                Printf.fprintf ppf "%a\n" I.pplist internalout;
+                Printf.fprintf ppf "Internal Between: ";
+                List.iter (Printf.fprintf ppf "%a;" I.pplist) internalbetween;
+                Printf.fprintf ppf "\n";
+      ) (NodeMap.to_list c.internalvar);
+end

lib/analysis/Dataflow.mli

@@ -0,0 +1,29 @@
+module type C = sig
+  type elt
+  type internal
+
+  type internalnode = {
+    internalin: internal list;
+    internalout: internal list;
+    internalbetween: internal list list;
+  }
+
+  type cfgt = elt Cfg.cfginternal
+
+  type t = {
+    t: cfgt;
+    internalvar: internalnode Cfg.NodeMap.t;
+  }
+
+  val from_cfg : cfgt -> t
+  val to_cfg : t -> cfgt
+
+  val fixed_point : ?init:(elt list -> internalnode) -> ?update:(t -> Cfg.Node.t -> internalnode) -> t -> t
+
+  val pp : out_channel -> t -> unit
+end
+
+module Make
+    (M: Cfg.PrintableType)
+    (I: Cfg.PrintableType)
+  : C with type elt = M.t and type internal = I.t

lib/analysis/dune

@@ -0,0 +1,6 @@
+(library
+ (name analysis)
+ (public_name analysis)
+ (modules Cfg Dataflow))
+
+(include_subdirs qualified)

lib/cfg/dune

@@ -1,5 +0,0 @@
-(library
- (name cfg)
- (public_name cfg))
-
-(include_subdirs qualified)

lib/miniImp/CfgImp.ml

@@ -1,4 +1,5 @@
-open Cfg
+open Analysis
+open Analysis.Cfg
 
 module SimpleStatements = struct
   type t =

lib/miniImp/CfgImp.mli

@@ -1,3 +1,5 @@
+open Analysis
+
 module SimpleStatements : sig
   type t =
     | SimpleSkip

lib/miniImp/CfgRISC.ml

@@ -1,3 +1,5 @@
+open Analysis
+
 module RISCSimpleStatements = struct
   type register = {
     index: string

lib/miniImp/CfgRISC.mli

@@ -1,3 +1,5 @@
+open Analysis
+
 module RISCSimpleStatements : sig
   type register = {
     index: string

lib/miniImp/RISC.ml

@@ -1,3 +1,5 @@
+open Analysis
+
 let globalCounterLabel = ref 0
 
 let nextLabel () : string =

lib/miniImp/definedVariables.ml

@@ -0,0 +1,20 @@
+open Analysis
+
+module Variable = struct
+  type t = string
+  let pp (ppf: out_channel) (v: t) : unit =
+    Printf.fprintf ppf "%s" v
+
+  let pplist (ppf: out_channel) (vv: t list) : unit =
+    List.iter (Printf.fprintf ppf "%s, ") vv
+end
+
+module RISCCfg = CfgRISC.RISCCfg
+
+module DVCfg = Dataflow.Make (CfgRISC.RISCSimpleStatements) (Variable)
+
+let compute_defined_variables (cfg: RISCCfg.t) : DVCfg.t =
+  DVCfg.from_cfg cfg
+
+let compute_cfg (dvcfg : DVCfg.t) : RISCCfg.t =
+  DVCfg.to_cfg dvcfg

lib/miniImp/definedVariables.mli

@@ -0,0 +1,15 @@
+open Analysis
+
+module Variable : sig
+  type t
+  val pp : out_channel -> t -> unit
+end
+
+module RISCCfg = CfgRISC.RISCCfg
+
+module DVCfg : Dataflow.C with type elt = CfgRISC.RISCSimpleStatements.t
+                           and type internal = Variable.t
+
+val compute_defined_variables : RISCCfg.t -> DVCfg.t
+
+val compute_cfg : DVCfg.t -> RISCCfg.t

lib/miniImp/dune

@@ -12,8 +12,8 @@
  (public_name miniImp)
  (modules Lexer Parser Types Semantics
           CfgImp ReplacePowerMod
-          CfgRISC
+          CfgRISC DefinedVariables
           RISC RISCSemantics)
- (libraries cfg utility menhirLib))
+ (libraries analysis utility menhirLib))
 
 (include_subdirs qualified)