diff --git a/bin/dune b/bin/dune index 02fa3b6..9f2f5b0 100644 --- a/bin/dune +++ b/bin/dune @@ -4,9 +4,9 @@ (libraries exercises miniImp miniFun - cfg + analysis utility) - (package miniFun) + (package miniImp) (modes byte exe) ) diff --git a/bin/main.ml b/bin/main.ml index c0edcd1..cdfc151 100644 --- a/bin/main.ml +++ b/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; *) + + () diff --git a/dune-project b/dune-project index bbe1b2e..a984e98 100644 --- a/dune-project +++ b/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) diff --git a/lib/cfg/Cfg.ml b/lib/analysis/Cfg.ml similarity index 89% rename from lib/cfg/Cfg.ml rename to lib/analysis/Cfg.ml index f9b6fb8..55b2a5f 100644 --- a/lib/cfg/Cfg.ml +++ b/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,19 +28,21 @@ end module NodeSet = Set.Make(Node) +type 'a cfginternal = { + 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: 'a list NodeMap.t; +} + module type C = sig type elt - 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 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; diff --git a/lib/cfg/Cfg.mli b/lib/analysis/Cfg.mli similarity index 65% rename from lib/cfg/Cfg.mli rename to lib/analysis/Cfg.mli index d331259..ae1d790 100644 --- a/lib/cfg/Cfg.mli +++ b/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,19 +20,22 @@ end module NodeSet : Set.S with type elt = Node.t + +type 'a cfginternal = { + 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: 'a list NodeMap.t; +} + module type C = sig type elt - 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 val empty : t val merge : t -> t -> Node.t -> Node.t -> t diff --git a/lib/analysis/Dataflow.ml b/lib/analysis/Dataflow.ml new file mode 100644 index 0000000..f9041da --- /dev/null +++ b/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 diff --git a/lib/analysis/Dataflow.mli b/lib/analysis/Dataflow.mli new file mode 100644 index 0000000..6b2173a --- /dev/null +++ b/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 diff --git a/lib/analysis/dune b/lib/analysis/dune new file mode 100644 index 0000000..fe21d54 --- /dev/null +++ b/lib/analysis/dune @@ -0,0 +1,6 @@ +(library + (name analysis) + (public_name analysis) + (modules Cfg Dataflow)) + +(include_subdirs qualified) diff --git a/lib/cfg/dune b/lib/cfg/dune deleted file mode 100644 index 772e4a7..0000000 --- a/lib/cfg/dune +++ /dev/null @@ -1,5 +0,0 @@ -(library - (name cfg) - (public_name cfg)) - -(include_subdirs qualified) diff --git a/lib/miniImp/CfgImp.ml b/lib/miniImp/CfgImp.ml index 295e5cd..54f58c6 100644 --- a/lib/miniImp/CfgImp.ml +++ b/lib/miniImp/CfgImp.ml @@ -1,4 +1,5 @@ -open Cfg +open Analysis +open Analysis.Cfg module SimpleStatements = struct type t = @@ -63,7 +64,7 @@ module SimpleStatements = struct List.iter (fun x -> pp ppf x; Printf.printf "; ") c end -module SSCfg = Cfg.Make(SimpleStatements) +module SSCfg = Cfg.Make(SimpleStatements) let rec convert_c (prevcfg: SSCfg.t) (prg: Types.c_exp) : SSCfg.t = let open SimpleStatements in diff --git a/lib/miniImp/CfgImp.mli b/lib/miniImp/CfgImp.mli index b980502..dfcbfc6 100644 --- a/lib/miniImp/CfgImp.mli +++ b/lib/miniImp/CfgImp.mli @@ -1,3 +1,5 @@ +open Analysis + module SimpleStatements : sig type t = | SimpleSkip diff --git a/lib/miniImp/CfgRISC.ml b/lib/miniImp/CfgRISC.ml index fe21435..ca51e35 100644 --- a/lib/miniImp/CfgRISC.ml +++ b/lib/miniImp/CfgRISC.ml @@ -1,3 +1,5 @@ +open Analysis + module RISCSimpleStatements = struct type register = { index: string diff --git a/lib/miniImp/CfgRISC.mli b/lib/miniImp/CfgRISC.mli index 95fd4fd..2d3d778 100644 --- a/lib/miniImp/CfgRISC.mli +++ b/lib/miniImp/CfgRISC.mli @@ -1,3 +1,5 @@ +open Analysis + module RISCSimpleStatements : sig type register = { index: string diff --git a/lib/miniImp/RISC.ml b/lib/miniImp/RISC.ml index bb6542a..4d59fe2 100644 --- a/lib/miniImp/RISC.ml +++ b/lib/miniImp/RISC.ml @@ -1,3 +1,5 @@ +open Analysis + let globalCounterLabel = ref 0 let nextLabel () : string = diff --git a/lib/miniImp/definedVariables.ml b/lib/miniImp/definedVariables.ml new file mode 100644 index 0000000..b998e13 --- /dev/null +++ b/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 diff --git a/lib/miniImp/definedVariables.mli b/lib/miniImp/definedVariables.mli new file mode 100644 index 0000000..67d4ee4 --- /dev/null +++ b/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 diff --git a/lib/miniImp/dune b/lib/miniImp/dune index 0f3a888..b7451ca 100644 --- a/lib/miniImp/dune +++ b/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)