module type C = sig type elt type internal type internalnode = { internalin: internal list; internalout: internal list; internalbetween: (internal list * 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 * 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 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 = 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 (fun (i, o) -> Printf.fprintf ppf "IN: %a;" I.pplist i; Printf.fprintf ppf "OUT: %a;" I.pplist o;) internalbetween; Printf.fprintf ppf "\n"; ) (NodeMap.to_list c.internalvar); Printf.fprintf ppf "\n"; end