elvis/lci
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Style more consistent, replace capitalization with camel case

Browse Source
This commit is contained in:
elvis
2025-01-27 16:28:23 +01:00
parent 4ab0b40cca
commit 2fbbf4e4d1
23 changed files with 390 additions and 373 deletions
Download Patch File Download Diff File Expand all files Collapse all files

112
lib/analysis/Cfg.ml
View File

@ -1,7 +1,7 @@
module type PrintableType = sig
type t
val pp : out_channel -> t -> unit
val pplist : out_channel -> t list -> unit
val pp_list : out_channel -> t list -> unit
end
let globalIdNode = ref 0;
@ -33,9 +33,9 @@ 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;
reverse_edges: (Node.t list) NodeMap.t;
input_val: int option;
input_output_var: (string * string) option;
initial: Node.t option;
terminal: Node.t option;
content: 'a list NodeMap.t;
@ -48,7 +48,7 @@ module type C = sig
val empty : t
val merge : t -> t -> Node.t -> Node.t -> t
val concat : t -> t -> t
val addToLastNode : elt -> t -> t
val add_to_last_node : elt -> t -> t
val pp : out_channel -> t -> unit
end
@ -61,43 +61,43 @@ module Make (M: PrintableType) = struct
{ empty = true;
nodes = NodeSet.empty;
edges = NodeMap.empty;
reverseEdges = NodeMap.empty;
inputVal = None;
inputOutputVar = None;
reverse_edges = NodeMap.empty;
input_val = None;
input_output_var = None;
initial = None;
terminal = None;
content = NodeMap.empty }
let merge (cfg1: t) (cfg2: t) (entryNode: Node.t) (exitNode: Node.t) : t =
let merge (cfg1: t) (cfg2: t) (entry_node: Node.t) (exit_node: Node.t) : t =
match (cfg1.empty, cfg2.empty) with
true, _ -> cfg2
| _, true -> cfg1
| false, false ->
let cfg1initial = Option.get cfg1.initial in
let cfg2initial = Option.get cfg2.initial in
let cfg1terminal = Option.get cfg1.terminal in
let cfg2terminal = Option.get cfg2.terminal in
let cfg1_initial = Option.get cfg1.initial in
let cfg2_initial = Option.get cfg2.initial in
let cfg1_terminal = Option.get cfg1.terminal in
let cfg2_terminal = Option.get cfg2.terminal in
{ empty = false;
nodes = NodeSet.union cfg1.nodes cfg2.nodes |>
NodeSet.add entryNode |>
NodeSet.add exitNode;
NodeSet.add entry_node |>
NodeSet.add exit_node;
edges = NodeMap.union
(fun _ -> failwith "Failed merging edges of cfg.")
cfg1.edges cfg2.edges |>
NodeMap.add entryNode (cfg1initial, Some cfg2initial) |>
NodeMap.add cfg1terminal (exitNode, None) |>
NodeMap.add cfg2terminal (exitNode, None);
reverseEdges = NodeMap.union
NodeMap.add entry_node (cfg1_initial, Some cfg2_initial) |>
NodeMap.add cfg1_terminal (exit_node, None) |>
NodeMap.add cfg2_terminal (exit_node, None);
reverse_edges = NodeMap.union
(fun _ -> failwith "Failed merging edges of cfg.")
cfg1.reverseEdges cfg2.reverseEdges |>
NodeMap.add_to_list cfg1initial entryNode |>
NodeMap.add_to_list cfg2initial entryNode |>
NodeMap.add_to_list exitNode cfg1terminal |>
NodeMap.add_to_list exitNode cfg2terminal;
inputVal = cfg1.inputVal;
inputOutputVar = cfg1.inputOutputVar;
initial = Some entryNode;
terminal = Some exitNode;
cfg1.reverse_edges cfg2.reverse_edges |>
NodeMap.add_to_list cfg1_initial entry_node |>
NodeMap.add_to_list cfg2_initial entry_node |>
NodeMap.add_to_list exit_node cfg1_terminal |>
NodeMap.add_to_list exit_node cfg2_terminal;
input_val = cfg1.input_val;
input_output_var = cfg1.input_output_var;
initial = Some entry_node;
terminal = Some exit_node;
content = NodeMap.union
(fun _ -> failwith "Failed merging code of cfg.")
cfg1.content cfg2.content
@ -108,48 +108,48 @@ module Make (M: PrintableType) = struct
true, _ -> cfg2
| _, true -> cfg1
| false, false ->
let cfg1initial = Option.get cfg1.initial in
let cfg2initial = Option.get cfg2.initial in
let cfg1terminal = Option.get cfg1.terminal in
let cfg2terminal = Option.get cfg2.terminal in
let cfg1_initial = Option.get cfg1.initial in
let cfg2_initial = Option.get cfg2.initial in
let cfg1_terminal = Option.get cfg1.terminal in
let cfg2_terminal = Option.get cfg2.terminal in
{ empty = false;
nodes = NodeSet.union cfg1.nodes cfg2.nodes;
edges = NodeMap.union
(fun _ -> failwith "Failed merging edges of cfg.")
cfg1.edges cfg2.edges |>
NodeMap.add cfg1terminal (cfg2initial, None);
reverseEdges = NodeMap.union
NodeMap.add cfg1_terminal (cfg2_initial, None);
reverse_edges = NodeMap.union
(fun _ -> failwith "Failed merging edges of cfg.")
cfg1.reverseEdges cfg2.reverseEdges |>
NodeMap.add_to_list cfg2initial cfg1terminal;
inputVal = cfg1.inputVal;
inputOutputVar = cfg1.inputOutputVar;
initial = Some cfg1initial;
terminal = Some cfg2terminal;
cfg1.reverse_edges cfg2.reverse_edges |>
NodeMap.add_to_list cfg2_initial cfg1_terminal;
input_val = cfg1.input_val;
input_output_var = cfg1.input_output_var;
initial = Some cfg1_initial;
terminal = Some cfg2_terminal;
content = NodeMap.union
(fun _ -> failwith "Failed merging code of cfg.")
cfg1.content cfg2.content
}
let addToLastNode (newcontent: elt) (cfg: t) : t =
let add_to_last_node (new_content: elt) (cfg: t) : t =
if cfg.empty then
let newnode = Node.create () in
let new_node = Node.create () in
{ empty = false;
nodes = NodeSet.singleton newnode;
nodes = NodeSet.singleton new_node;
edges = NodeMap.empty;
reverseEdges = NodeMap.empty;
inputVal = None;
inputOutputVar = None;
initial = Some newnode;
terminal = Some newnode;
content = NodeMap.singleton newnode [newcontent]
reverse_edges = NodeMap.empty;
input_val = None;
input_output_var = None;
initial = Some new_node;
terminal = Some new_node;
content = NodeMap.singleton new_node [new_content]
}
else
let prevcfgterminal = Option.get cfg.terminal in
let prevcfg_terminal = Option.get cfg.terminal in
{ cfg with
content = (NodeMap.add_to_list_last
prevcfgterminal
newcontent
prevcfg_terminal
new_content
cfg.content) }
let pp (ppf) (c: t) : unit =
@ -173,17 +173,17 @@ module Make (M: PrintableType) = struct
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.reverseEdges);
) (NodeMap.to_list c.reverse_edges);
Printf.fprintf ppf "\n";
Printf.fprintf ppf "Input Value: ";
(match c.inputVal with
(match c.input_val 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.inputOutputVar with
(match c.input_output_var with
Some (i, o) -> Printf.fprintf ppf "(in: %s, out: %s)" i o;
| None -> Printf.fprintf ppf "None";);
Printf.fprintf ppf "\n";
@ -202,7 +202,7 @@ module Make (M: PrintableType) = struct
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
Printf.fprintf ppf "\tid %d --> %a\n%!" n.id M.pp_list stms
) (NodeMap.to_list c.content);
Printf.fprintf ppf "\n";
end

10
lib/analysis/Cfg.mli
View File

@ -1,7 +1,7 @@
module type PrintableType = sig
type t
val pp : out_channel -> t -> unit
val pplist : out_channel -> t list -> unit
val pp_list : out_channel -> t list -> unit
end
module Node : sig
@ -25,9 +25,9 @@ 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;
reverse_edges: (Node.t list) NodeMap.t;
input_val: int option;
input_output_var: (string * string) option;
initial: Node.t option;
terminal: Node.t option;
content: 'a list NodeMap.t;
@ -40,7 +40,7 @@ module type C = sig
val empty : t
val merge : t -> t -> Node.t -> Node.t -> t
val concat : t -> t -> t
val addToLastNode : elt -> t -> t
val add_to_last_node : elt -> t -> t
val pp : out_channel -> t -> unit
end

89
lib/analysis/Dataflow.ml
View File

@ -2,25 +2,25 @@ module type C = sig
type elt
type internal
type internalnode = {
internalin: internal list;
internalout: internal list;
internalbetween: (internal list * internal list) list;
type internal_node = {
internal_in: internal list;
internal_out: internal list;
internal_between: (internal list * internal list) list;
}
type cfgt = elt Cfg.cfginternal
type t = {
t: cfgt;
internalvar: internalnode Cfg.NodeMap.t;
internal_var: internal_node 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) ->
?init : (elt list -> internal_node) ->
?update : (t -> Cfg.Node.t -> internal_node) ->
t ->
t
@ -31,20 +31,20 @@ 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 internal_node = {
internal_in: internal list;
internal_out: internal list;
internal_between: (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,
let compare_internal_node (a:internal_node) (b:internal_node) : bool =
match Utility.equality a.internal_in b.internal_in,
Utility.equality a.internal_out b.internal_out,
(List.fold_left2 (fun acc (ain, aout) (bin, bout)
-> acc &&
(Utility.equality ain bin) &&
(Utility.equality aout bout)
) true a.internalbetween b.internalbetween)
) true a.internal_between b.internal_between)
with
| true, true, true -> true
| _, _, _ -> false
@ -53,19 +53,19 @@ module Make (M: Cfg.PrintableType) (I: Cfg.PrintableType) = struct
type t = {
t: cfgt;
internalvar: internalnode Cfg.NodeMap.t;
internal_var: internal_node Cfg.NodeMap.t;
}
let compareinternal a b =
let compare_internal a b =
Cfg.NodeMap.fold
(fun node bi acc ->
match Cfg.NodeMap.find_opt node a with
None -> false
| Some ai -> acc && compareinternalnode ai bi
| Some ai -> acc && compare_internal_node ai bi
) b true
let from_cfg (cfg: cfgt) : t =
{t = cfg; internalvar = Cfg.NodeMap.empty}
{t = cfg; internal_var = Cfg.NodeMap.empty}
let to_cfg ({t; _}: t) : cfgt =
t
@ -92,17 +92,17 @@ module Make (M: Cfg.PrintableType) (I: Cfg.PrintableType) = struct
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);
) (NodeMap.to_list c.t.reverse_edges);
Printf.fprintf ppf "\n";
Printf.fprintf ppf "Input Value: ";
(match c.t.inputVal with
(match c.t.input_val 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
(match c.t.input_output_var with
Some (i, o) -> Printf.fprintf ppf "(in: %s, out: %s)" i o;
| None -> Printf.fprintf ppf "None";);
Printf.fprintf ppf "\n";
@ -121,35 +121,36 @@ module Make (M: Cfg.PrintableType) (I: Cfg.PrintableType) = struct
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
Printf.fprintf ppf "\tid %d --> %a\n%!" n.id M.pp_list 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 ->
List.iter (fun ((n, {internal_in; internal_out; internal_between})
: (Node.t * internal_node)) : 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 "%a\n" I.pp_list internal_in;
Printf.fprintf ppf "Internal Output: ";
Printf.fprintf ppf "%a\n" I.pplist internalout;
Printf.fprintf ppf "%a\n" I.pp_list internal_out;
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 "IN: %a;" I.pp_list i;
Printf.fprintf ppf "OUT: %a;" I.pp_list o;)
internal_between;
Printf.fprintf ppf "\n";
) (NodeMap.to_list c.internalvar);
) (NodeMap.to_list c.internal_var);
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))
?(init : (elt list -> internal_node) =
(fun _ -> {internal_in = [];
internal_out = [];
internal_between = []}))
?(update : (t -> Cfg.Node.t -> internal_node) =
(fun t n -> Cfg.NodeMap.find n t.internal_var))
(t: t)
: t =
(* init function is applied only once to each node content,
@ -158,21 +159,21 @@ module Make (M: Cfg.PrintableType) (I: Cfg.PrintableType) = struct
update function is applied to the resulting structure until no change is
observed with compareinternal function
*)
let rec helper t =
let rec aux t =
let newt =
{t with
internalvar = Cfg.NodeMap.mapi (fun n _ -> update t n) t.internalvar}
internal_var = Cfg.NodeMap.mapi (fun n _ -> update t n) t.internal_var}
in
if compareinternal newt.internalvar t.internalvar
if compare_internal newt.internal_var t.internal_var
then newt
else helper newt
else aux newt
in
let content =
List.fold_left
(fun cfg node -> Cfg.NodeMap.add node {internalin = [];
internalout = [];
internalbetween = []} cfg)
(fun cfg node -> Cfg.NodeMap.add node {internal_in = [];
internal_out = [];
internal_between = []} cfg)
Cfg.NodeMap.empty
(Cfg.NodeSet.to_list t.t.nodes)
in
@ -190,6 +191,6 @@ module Make (M: Cfg.PrintableType) (I: Cfg.PrintableType) = struct
content
(Cfg.NodeMap.map init code)
in
helper { t with internalvar = content }
aux { t with internal_var = content }
end

14
lib/analysis/Dataflow.mli
View File

@ -2,25 +2,25 @@ module type C = sig
type elt
type internal
type internalnode = {
internalin: internal list;
internalout: internal list;
internalbetween: (internal list * internal list) list;
type internal_node = {
internal_in: internal list;
internal_out: internal list;
internal_between: (internal list * internal list) list;
}
type cfgt = elt Cfg.cfginternal
type t = {
t: cfgt;
internalvar: internalnode Cfg.NodeMap.t;
internal_var: internal_node 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
?init : (elt list -> internal_node) ->
?update : (t -> Cfg.Node.t -> internal_node) -> t -> t
val pp : out_channel -> t -> unit
end