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

4
bin/miniImpInterpreterReg.ml
View File

@ -110,7 +110,7 @@ let () =
| None -> ()
| Some l ->
Printf.printf "Error: undefined variables: %a\n"
DefinedVariables.Variable.pplist l;
DefinedVariables.Variable.pp_list l;
exit (-1)
) else ();
@ -126,7 +126,7 @@ let () =
let return_value =
return_value |>
ReduceRegisters.reduceregisters registers |>
ReduceRegisters.reduce_registers registers |>
RISC.convert
in

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

14
lib/miniFun/Semantics.ml
View File

@ -6,7 +6,7 @@ Random.self_init ()
let (let*) = Result.bind
let rec evaluate (mem: memory) (command: t_exp) :
(permittedValues, [> error]) result =
(permitted_values, [> error]) result =
match command with
Integer n -> Ok (IntegerPermitted n)
| Boolean b -> Ok (BooleanPermitted b)
@ -31,7 +31,7 @@ let rec evaluate (mem: memory) (command: t_exp) :
)
| Application (f, x) -> (
let* evalf = evaluate mem f in
let* funcClosure = (
let* func_closure = (
match evalf with
FunctionPermitted ff -> Ok ff
| IntegerPermitted _ -> Error (`WrongType ("Function is not a function,"
@ -43,15 +43,15 @@ let rec evaluate (mem: memory) (command: t_exp) :
) in
let* param = evaluate mem x in
let mem2 =
match funcClosure.recursiveness with
match func_closure.recursiveness with
None -> {assignments = (
VariableMap.add funcClosure.input param funcClosure.assignments)}
VariableMap.add func_closure.input param func_closure.assignments)}
| Some nameF -> {assignments = (
VariableMap.add funcClosure.input param funcClosure.assignments |>
VariableMap.add nameF (FunctionPermitted funcClosure)
VariableMap.add func_closure.input param func_closure.assignments |>
VariableMap.add nameF (FunctionPermitted func_closure)
)}
in
evaluate mem2 funcClosure.body
evaluate mem2 func_closure.body
)
| Plus (a, b) ->
let* aval = (

2
lib/miniFun/Semantics.mli
View File

@ -1,3 +1,3 @@
val evaluate : Types.memory -> Types.t_exp -> (Types.permittedValues, [> Types.error]) result
val evaluate : Types.memory -> Types.t_exp -> (Types.permitted_values, [> Types.error]) result
val reduce : Types.t_exp -> int -> (int, [> Types.error]) result

8
lib/miniFun/Types.ml
View File

@ -38,20 +38,20 @@ type t_exp =
| LetFun of variable * variable * ftype * t_exp * t_exp
(* let rec x. y: t. x in x*)
type permittedValues =
type permitted_values =
IntegerPermitted of int
| BooleanPermitted of bool
| TuplePermitted of permittedValues * permittedValues
| TuplePermitted of permitted_values * permitted_values
| FunctionPermitted of closure
and closure = {
input: variable;
body: t_exp;
assignments: permittedValues VariableMap.t;
assignments: permitted_values VariableMap.t;
recursiveness: variable option
}
type memory = {
assignments: permittedValues VariableMap.t
assignments: permitted_values VariableMap.t
}

8
lib/miniFun/Types.mli
View File

@ -37,20 +37,20 @@ type t_exp =
| LetIn of variable * t_exp * t_exp (* let x = x in x *)
| LetFun of variable * variable * ftype * t_exp * t_exp (* let rec x. y: t. x in x*)
type permittedValues =
type permitted_values =
IntegerPermitted of int
| BooleanPermitted of bool
| TuplePermitted of permittedValues * permittedValues
| TuplePermitted of permitted_values * permitted_values
| FunctionPermitted of closure
and closure = {
input: variable;
body: t_exp;
assignments: permittedValues VariableMap.t;
assignments: permitted_values VariableMap.t;
recursiveness: variable option
}
type memory = {
assignments: permittedValues VariableMap.t
assignments: permitted_values VariableMap.t
}

30
lib/miniImp/CfgImp.ml
View File

@ -79,7 +79,7 @@ module SimpleStatements = struct
in
helper_c ppf c
let pplist (ppf: out_channel) (c: t list) : unit =
let pp_list (ppf: out_channel) (c: t list) : unit =
List.iter (fun x -> pp ppf x; Printf.printf "; ") c
end
@ -89,10 +89,10 @@ let rec convert_c (prevcfg: SSCfg.t) (prg: Types.c_exp) : SSCfg.t =
let open SimpleStatements in
match prg with
| Skip -> (* we preserve the skips *)
prevcfg |> SSCfg.addToLastNode SimpleSkip
prevcfg |> SSCfg.add_to_last_node SimpleSkip
| Assignment (x, a) -> (* we simply add the assignment to the terminal node *)
prevcfg |> SSCfg.addToLastNode (SimpleAssignment (x, convert_a a))
prevcfg |> SSCfg.add_to_last_node (SimpleAssignment (x, convert_a a))
| Sequence (c1, c2) -> (* we first convert the first sequence, then the second
using the previous as prevcfg *)
@ -101,7 +101,7 @@ let rec convert_c (prevcfg: SSCfg.t) (prg: Types.c_exp) : SSCfg.t =
cfg2
| If (b, c1, c2) -> (* constructs two branches with a two new nodes *)
let convertedb = convert_b b in
let converted_b = convert_b b in
let cfg1 = convert_c SSCfg.empty c1 in
let cfg2 = convert_c SSCfg.empty c2 in
let entrynode = Node.create () in
@ -110,11 +110,11 @@ let rec convert_c (prevcfg: SSCfg.t) (prg: Types.c_exp) : SSCfg.t =
let mergedcfg = SSCfg.concat prevcfg newcfg in
{ mergedcfg with
content = mergedcfg.content |>
NodeMap.add_to_list entrynode (SimpleGuard convertedb) |>
NodeMap.add_to_list entrynode (SimpleGuard converted_b) |>
NodeMap.add_to_list exitnode (SimpleSkip) }
| While (b, c) -> (* constructs a loop, needs three new nodes *)
let convertedb = convert_b b in
let converted_b = convert_b b in
let cfg = convert_c SSCfg.empty c in
let cfginitial = Option.get cfg.initial in
let cfgterminal = Option.get cfg.terminal in
@ -130,17 +130,17 @@ let rec convert_c (prevcfg: SSCfg.t) (prg: Types.c_exp) : SSCfg.t =
NodeMap.add entrynode (guardnode, None) |>
NodeMap.add guardnode (cfginitial, Some exitnode) |>
NodeMap.add cfgterminal (guardnode, None);
reverseEdges = cfg.reverseEdges |>
reverse_edges = cfg.reverse_edges |>
NodeMap.add_to_list guardnode entrynode |>
NodeMap.add_to_list cfginitial guardnode |>
NodeMap.add_to_list exitnode guardnode |>
NodeMap.add_to_list guardnode cfgterminal;
inputVal = prevcfg.inputVal;
inputOutputVar = prevcfg.inputOutputVar;
input_val = prevcfg.input_val;
input_output_var = prevcfg.input_output_var;
initial = Some entrynode;
terminal = Some exitnode;
content = cfg.content |>
NodeMap.add_to_list guardnode (SimpleGuard (convertedb)) |>
NodeMap.add_to_list guardnode (SimpleGuard (converted_b)) |>
NodeMap.add_to_list exitnode (SimpleSkip)
} |> SSCfg.concat prevcfg
@ -166,12 +166,12 @@ let rec convert_c (prevcfg: SSCfg.t) (prg: Types.c_exp) : SSCfg.t =
edges = bodyincrement.edges |>
NodeMap.add guardnode (cfginitial, Some exitnode) |>
NodeMap.add cfgterminal (guardnode, None);
reverseEdges = bodyincrement.reverseEdges |>
reverse_edges = bodyincrement.reverse_edges |>
NodeMap.add_to_list cfginitial guardnode |>
NodeMap.add_to_list exitnode guardnode |>
NodeMap.add_to_list guardnode cfgterminal;
inputVal = prevcfg.inputVal;
inputOutputVar = prevcfg.inputOutputVar;
input_val = prevcfg.input_val;
input_output_var = prevcfg.input_output_var;
initial = Some guardnode;
terminal = Some exitnode;
content = bodyincrement.content |>
@ -208,8 +208,8 @@ let convert (prg: Types.p_exp) : SSCfg.t =
let prg = ReplacePowerMod.rewrite_instructions prg in
match prg with
| Main (i, o, exp) ->
{(convert_c SSCfg.empty exp) with inputOutputVar = Some (i, o)}
{(convert_c SSCfg.empty exp) with input_output_var = Some (i, o)}
let convert_io (i: int) (prg: Types.p_exp) : SSCfg.t =
let prg = ReplacePowerMod.rewrite_instructions prg in
{(convert prg) with inputVal = Some i}
{(convert prg) with input_val = Some i}

2
lib/miniImp/CfgImp.mli
View File

@ -27,7 +27,7 @@ module SimpleStatements : sig
| SimpleRand of simpleArithmetic
val pp : out_channel -> t -> unit
val pplist : out_channel -> t list -> unit
val pp_list : out_channel -> t list -> unit
end
module SSCfg : Cfg.C with type elt = SimpleStatements.t

22
lib/miniImp/CfgRISC.ml
View File

@ -102,7 +102,7 @@ module RISCSimpleStatements = struct
in
pp_t ppf v
let pplist (ppf: out_channel) (l: t list) : unit =
let pp_list (ppf: out_channel) (l: t list) : unit =
List.iter (fun x -> pp ppf x; Printf.printf "; ") l
end
@ -915,7 +915,7 @@ let convert_ss
in
(Cfg.NodeMap.add node instructions risccode, m)
let helper
let helper_convert
(c: CfgImp.SimpleStatements.t list Cfg.NodeMap.t)
(m: RegisterMap.m)
: RISCSimpleStatements.t list Cfg.NodeMap.t =
@ -932,16 +932,16 @@ let convert (prg: CfgImp.SSCfg.t) : RISCCfg.t =
let ({ empty: bool;
nodes: Cfg.NodeSet.t;
edges: (Cfg.Node.t * (Cfg.Node.t option)) Cfg.NodeMap.t;
reverseEdges: (Cfg.Node.t list) Cfg.NodeMap.t;
inputVal: int option;
inputOutputVar: (string * string) option;
reverse_edges: (Cfg.Node.t list) Cfg.NodeMap.t;
input_val: int option;
input_output_var: (string * string) option;
initial: Cfg.Node.t option;
terminal: Cfg.Node.t option;
content: CfgImp.SimpleStatements.t list Cfg.NodeMap.t
}: CfgImp.SSCfg.t) = prg
in
let initial_bindings =
match inputOutputVar with
match input_output_var with
| Some (i, o) -> (
if i = o then
RegisterMap.empty |>
@ -957,10 +957,10 @@ let convert (prg: CfgImp.SSCfg.t) : RISCCfg.t =
{ empty = empty;
nodes = nodes;
edges = edges;
reverseEdges = reverseEdges;
inputVal = inputVal;
inputOutputVar = (
match inputOutputVar with
reverse_edges = reverse_edges;
input_val = input_val;
input_output_var = (
match input_output_var with
| Some (i, o) -> (
if i = o then
Some ("in", "in")
@ -971,5 +971,5 @@ let convert (prg: CfgImp.SSCfg.t) : RISCCfg.t =
);
initial = initial;
terminal = terminal;
content = helper content initial_bindings;
content = helper_convert content initial_bindings;
}

2
lib/miniImp/CfgRISC.mli
View File

@ -47,7 +47,7 @@ module RISCSimpleStatements : sig
| Rand
val pp : out_channel -> t -> unit
val pplist : out_channel -> t list -> unit
val pp_list : out_channel -> t list -> unit
end
module RISCCfg : Cfg.C with type elt = RISCSimpleStatements.t

69
lib/miniImp/RISC.ml
View File

@ -142,19 +142,19 @@ end
let convert_cfgrisc_risci (i: CfgRISC.RISCSimpleStatements.t list) :
(RISCAssembly.risci list) =
let rec helper (i: CfgRISC.RISCSimpleStatements.t)
let rec aux (i: CfgRISC.RISCSimpleStatements.t)
: RISCAssembly.risci =
match i with
| Nop -> Nop
| BRegOp (brop, r1, r2, r3) -> BRegOp (helper_brop brop,
| BRegOp (brop, r1, r2, r3) -> BRegOp (aux_brop brop,
{index = r1.index},
{index = r2.index},
{index = r3.index})
| BImmOp (biop, r1, imm, r3) -> BImmOp (helper_biop biop,
| BImmOp (biop, r1, imm, r3) -> BImmOp (aux_biop biop,
{index = r1.index},
imm,
{index = r3.index})
| URegOp (urop, r1, r3) -> URegOp (helper_urop urop,
| URegOp (urop, r1, r3) -> URegOp (aux_urop urop,
{index = r1.index},
{index = r3.index})
| Load (r1, r3) -> Load ({index = r1.index},
@ -163,7 +163,7 @@ let convert_cfgrisc_risci (i: CfgRISC.RISCSimpleStatements.t list) :
{index = r3.index})
| Store (r1, r3) -> Store ({index = r1.index},
{index = r3.index})
and helper_brop (brop: CfgRISC.RISCSimpleStatements.brop)
and aux_brop (brop: CfgRISC.RISCSimpleStatements.brop)
: RISCAssembly.brop =
match brop with
| Add -> Add
@ -179,7 +179,7 @@ let convert_cfgrisc_risci (i: CfgRISC.RISCSimpleStatements.t list) :
| LessEq -> LessEq
| More -> More
| MoreEq -> MoreEq
and helper_biop (biop: CfgRISC.RISCSimpleStatements.biop)
and aux_biop (biop: CfgRISC.RISCSimpleStatements.biop)
: RISCAssembly.biop =
match biop with
| AddI -> AddI
@ -195,16 +195,16 @@ let convert_cfgrisc_risci (i: CfgRISC.RISCSimpleStatements.t list) :
| LessEqI -> LessEqI
| MoreI -> MoreI
| MoreEqI -> MoreEqI
and helper_urop (urop: CfgRISC.RISCSimpleStatements.urop)
and aux_urop (urop: CfgRISC.RISCSimpleStatements.urop)
: RISCAssembly.urop =
match urop with
| Not -> Not
| Copy -> Copy
| Rand -> Rand
in
List.map helper i
List.map aux i
let nextCommonSuccessor
let next_common_successor
(prg: CfgRISC.RISCCfg.t)
(node1: Cfg.Node.t)
(node2: Cfg.Node.t)
@ -231,30 +231,35 @@ let nextCommonSuccessor
| a::_ -> Some a
let rec helper
let rec helper_convert
(prg: CfgRISC.RISCCfg.t)
(currentnode: Cfg.Node.t)
(alreadyVisited: Cfg.Node.t list)
(current_node: Cfg.Node.t)
(already_visited: Cfg.Node.t list)
: (RISCAssembly.risci list) * (Cfg.Node.t list) =
(* takes the program, the current node and a list of already visited nodes to
compute the linearized three address instructions and the list of
previoulsy visited nodes plus the newly visited nodes. Stops as soon if
node has already been visited or if no nodes are next *)
if List.mem currentnode alreadyVisited then
([], alreadyVisited)
if List.mem current_node already_visited then
([], already_visited)
else (
let nextnodes = (Cfg.NodeMap.find_opt currentnode prg.edges) in
let nextnodes = (Cfg.NodeMap.find_opt current_node prg.edges) in
let currentcode =
(match (Cfg.NodeMap.find_opt currentnode prg.content) with
(match (Cfg.NodeMap.find_opt current_node prg.content) with
| None -> []
| Some x -> convert_cfgrisc_risci x)
in
match nextnodes with
| Some (nextnode1, None) ->
let res, vis = (helper prg nextnode1 (currentnode :: alreadyVisited)) in
let res, vis =
helper_convert
prg
nextnode1
(current_node :: already_visited)
in
(currentcode @ res, vis)
| Some (nextnode1, Some nextnode2) -> (
let ncs = nextCommonSuccessor prg nextnode1 nextnode2 in
let ncs = next_common_successor prg nextnode1 nextnode2 in
match ncs with
| None -> (* should never happen since the terminal node should always be
rechable *)
@ -267,11 +272,11 @@ let rec helper
let label3 = nextLabel () in
let res1, _ =
(helper prg nextnode1
(currentnode :: nextnode2 :: alreadyVisited)) in
(helper_convert prg nextnode1
(current_node :: nextnode2 :: already_visited)) in
let res2, vis2 =
(helper prg nextnode2
(currentnode :: nextnode1 :: alreadyVisited)) in
(helper_convert prg nextnode2
(current_node :: nextnode1 :: already_visited)) in
match List.nth currentcode ((List.length currentcode) - 1) with
| BRegOp (_, _, _, r)
@ -296,9 +301,15 @@ let rec helper
let label3 = nextLabel () in
let res1, vis1 =
(helper prg nextnode1 (currentnode :: ncs :: alreadyVisited)) in
let res2, _ = (helper prg nextnode2 vis1) in
let res3, vis3 = (helper prg ncs (currentnode :: alreadyVisited)) in
helper_convert
prg
nextnode1
(current_node :: ncs :: already_visited)
in
let res2, _ = helper_convert prg nextnode2 vis1 in
let res3, vis3 =
helper_convert prg ncs (current_node :: already_visited)
in
match List.nth currentcode ((List.length currentcode) - 1) with
| BRegOp (_, _, _, r)
| BImmOp (_, _, _, r)
@ -319,15 +330,15 @@ let rec helper
| _ -> failwith "Missing instruction at branch"
)
)
| None -> (currentcode, currentnode :: alreadyVisited)
| None -> (currentcode, current_node :: already_visited)
)
let convert (prg: CfgRISC.RISCCfg.t) : RISCAssembly.t =
{code = (helper prg (Option.get prg.initial) [] |> fst |>
{code = (helper_convert prg (Option.get prg.initial) [] |> fst |>
List.append ([Label "main"] : RISCAssembly.risci list));
inputval = prg.inputVal;
inputval = prg.input_val;
inputoutputreg =
match prg.inputOutputVar with
match prg.input_output_var with
None -> None
| Some (i, o) -> Some ({index = i}, {index = o})
}

48
lib/miniImp/RISCSemantics.ml
View File

@ -22,7 +22,7 @@ let convert (prg: RISC.RISCAssembly.t)
: RISC.RISCAssembly.risci list CodeMap.t =
(* takes as input a sequence of RISC commands and computes a map to the right
labels for easier execution *)
let rec helper
let rec aux
(prg: RISC.RISCAssembly.risci list)
(current: RISC.RISCAssembly.risci list)
(current_label: string)
@ -33,27 +33,27 @@ let convert (prg: RISC.RISCAssembly.t)
(fun _ _ _ -> failwith "Two labels are the same")
(CodeMap.singleton current_label current)
map)
| Label l :: tl -> helper tl ([]) l
| Label l :: tl -> aux tl ([]) l
(CodeMap.union
(fun _ _ _ -> failwith "Two labels are the same")
(CodeMap.singleton current_label current)
map)
| instr :: tl -> helper tl (current @ [instr]) current_label map
| instr :: tl -> aux tl (current @ [instr]) current_label map
in
match prg.code with
| Label "main" :: tl -> helper tl [] "main" CodeMap.empty
| Label "main" :: tl -> aux tl [] "main" CodeMap.empty
| _ -> failwith "Program should begind with label main"
let label_order (prg: RISC.RISCAssembly.t) : string list =
let rec helper
let rec aux
(prg: RISC.RISCAssembly.risci list)
: string list =
match prg with
[] -> []
| Label l :: tl -> l :: (helper tl)
| _ :: tl -> (helper tl)
| Label l :: tl -> l :: (aux tl)
| _ :: tl -> (aux tl)
in
helper (prg.code)
aux (prg.code)
let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
let match_operator_r (brop: RISC.RISCAssembly.brop) =
@ -89,7 +89,7 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
| MoreEqI -> (Utility.int_more_eq)
in
let rec helper
let rec aux
(prg: RISCArchitecture.t)
(current: RISC.RISCAssembly.risci list)
(current_label: string)
@ -101,7 +101,7 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
None -> prg (* should never happen *)
| Some i ->
if i + 1 < (List.length lo) then
helper
aux
prg
(CodeMap.find (List.nth lo (i+1)) prg.code)
(List.nth lo (i+1))
@ -109,13 +109,13 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
prg
)
| Nop :: tl ->
helper prg tl current_label
aux prg tl current_label
| BRegOp (brop, r1, r2, r3) :: tl -> (
let n = (match_operator_r brop)
(RegisterMap.find {index = r1.index} prg.registers)
(RegisterMap.find {index = r2.index} prg.registers)
in
helper { prg with
aux { prg with
registers = RegisterMap.add {index = r3.index} n prg.registers}
tl current_label
)
@ -124,7 +124,7 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
(RegisterMap.find {index = r1.index} prg.registers)
i
in
helper { prg with
aux { prg with
registers = RegisterMap.add {index = r3.index} n prg.registers}
tl current_label
)
@ -132,7 +132,7 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
match urop with
| Copy -> (
let n = RegisterMap.find {index = r1.index} prg.registers in
helper { prg with
aux { prg with
registers =
RegisterMap.add {index = r3.index} n prg.registers }
tl current_label
@ -141,7 +141,7 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
let n = Utility.int_not
(RegisterMap.find {index = r1.index} prg.registers)
in
helper { prg with
aux { prg with
registers =
RegisterMap.add {index = r3.index} n prg.registers }
tl current_label
@ -150,7 +150,7 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
let n = Random.int
(RegisterMap.find {index = r1.index} prg.registers)
in
helper { prg with
aux { prg with
registers =
RegisterMap.add {index = r3.index} n prg.registers }
tl current_label
@ -162,40 +162,40 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
(RegisterMap.find {index = r1.index} prg.registers)
prg.memory
in
helper { prg with
aux { prg with
registers = RegisterMap.add {index = r3.index} n prg.registers}
tl current_label
)
| LoadI (i, r3) :: tl -> (
let n = i
in
helper { prg with
aux { prg with
registers = RegisterMap.add {index = r3.index} n prg.registers}
tl current_label
)
| Store (r1, r3) :: tl -> (
let n = RegisterMap.find {index = r1.index} prg.registers in
let n1 = RegisterMap.find {index = r3.index} prg.registers in
helper
aux
{ prg with memory = MemoryMap.add n1 n prg.memory }
tl
current_label
)
| Jump l :: _ -> helper prg (CodeMap.find l prg.code) l
| Jump l :: _ -> aux prg (CodeMap.find l prg.code) l
| CJump (r, l1, l2) :: _ -> (
let br = (RegisterMap.find {index = r.index} prg.registers) > 0 in
if br
then
helper prg (CodeMap.find l1 prg.code) l1
aux prg (CodeMap.find l1 prg.code) l1
else
helper prg (CodeMap.find l2 prg.code) l2
aux prg (CodeMap.find l2 prg.code) l2
)
| Label _ :: tl -> helper prg tl current_label
| Label _ :: tl -> aux prg tl current_label
in
match
RegisterMap.find_opt
prg.outputreg
(helper prg (CodeMap.find "main" prg.code) "main").registers
(aux prg (CodeMap.find "main" prg.code) "main").registers
with
Some x -> x
| None -> failwith "Output register not found"

4
lib/miniImp/Semantics.ml
View File

@ -152,8 +152,8 @@ let reduce (program: p_exp) (iin : int) : (int, [> error]) result =
Main (vin, vout, expression) -> (
let mem : memory =
{ assignments = (VariableMap.empty |> VariableMap.add vin iin) } in
let* resultmem : memory = evaluate mem expression in
match VariableMap.find_opt vout resultmem.assignments with
let* result_mem : memory = evaluate mem expression in
match VariableMap.find_opt vout result_mem.assignments with
| None ->
Error (`AbsentAssignment
("The output variable is not defined (" ^ vout ^ ")"))

52
lib/miniImp/Types.mli
View File

@ -1,35 +1,37 @@
type variable = string
type p_exp =
Main of variable * variable * c_exp (* def main with input x output y as c *)
Main of variable * variable * c_exp
(* def main with input x output y as c *)
and c_exp =
Skip
| Assignment of variable * a_exp (* x := a *)
| Sequence of c_exp * c_exp (* c; c *)
| If of b_exp * c_exp * c_exp (* if b then c else c *)
| While of b_exp * c_exp (* while b do c *)
| For of c_exp * b_exp * c_exp * c_exp (* for (c; b; c) do c *)
| Assignment of variable * a_exp (* x := a *)
| Sequence of c_exp * c_exp (* c; c *)
| If of b_exp * c_exp * c_exp (* if b then c else c *)
| While of b_exp * c_exp (* while b do c *)
| For of c_exp * b_exp * c_exp * c_exp
(* for (c; b; c) do c *)
and b_exp =
Boolean of bool (* v *)
| BAnd of b_exp * b_exp (* b && b *)
| BOr of b_exp * b_exp (* b || b *)
| BNot of b_exp (* not b *)
| BCmp of a_exp * a_exp (* a == a *)
| BCmpLess of a_exp * a_exp (* a < a *)
| BCmpLessEq of a_exp * a_exp (* a <= a *)
| BCmpGreater of a_exp * a_exp (* a > a *)
| BCmpGreaterEq of a_exp * a_exp (* a >= a *)
Boolean of bool (* v *)
| BAnd of b_exp * b_exp (* b && b *)
| BOr of b_exp * b_exp (* b || b *)
| BNot of b_exp (* not b *)
| BCmp of a_exp * a_exp (* a == a *)
| BCmpLess of a_exp * a_exp (* a < a *)
| BCmpLessEq of a_exp * a_exp (* a <= a *)
| BCmpGreater of a_exp * a_exp (* a > a *)
| BCmpGreaterEq of a_exp * a_exp (* a >= a *)
and a_exp =
Variable of variable (* x *)
| Integer of int (* n *)
| Plus of a_exp * a_exp (* a + a *)
| Minus of a_exp * a_exp (* a - a *)
| Times of a_exp * a_exp (* a * a *)
| Division of a_exp * a_exp (* a / a *)
| Modulo of a_exp * a_exp (* a % a *)
| Power of a_exp * a_exp (* a ^ a *)
| PowerMod of a_exp * a_exp * a_exp (* a ^ a % a *)
| Rand of a_exp (* rand(0, a) *)
Variable of variable (* x *)
| Integer of int (* n *)
| Plus of a_exp * a_exp (* a + a *)
| Minus of a_exp * a_exp (* a - a *)
| Times of a_exp * a_exp (* a * a *)
| Division of a_exp * a_exp (* a / a *)
| Modulo of a_exp * a_exp (* a % a *)
| Power of a_exp * a_exp (* a ^ a *)
| PowerMod of a_exp * a_exp * a_exp (* a ^ a % a *)
| Rand of a_exp (* rand(0, a) *)
val pp_p_exp : Format.formatter -> p_exp -> unit

132
lib/miniImp/definedVariables.ml
View File

@ -5,7 +5,7 @@ module Variable = struct
let pp (ppf: out_channel) (v: t) : unit =
Printf.fprintf ppf "%s" v
let pplist (ppf: out_channel) (vv: t list) : unit =
let pp_list (ppf: out_channel) (vv: t list) : unit =
List.iter (Printf.fprintf ppf "%s, ") vv
let compare a b =
@ -19,7 +19,7 @@ module DVCeltSet = Set.Make(Variable)
let variables (instr : DVCfg.elt) : DVCfg.internal list =
let helper (acc: DVCeltSet.t) (instr: DVCfg.elt) =
let aux (acc: DVCeltSet.t) (instr: DVCfg.elt) =
match instr with
| Nop ->
acc
@ -37,7 +37,7 @@ let variables (instr : DVCfg.elt) : DVCfg.internal list =
DVCeltSet.add r3.index acc
in
helper DVCeltSet.empty instr |> DVCeltSet.to_list
aux DVCeltSet.empty instr |> DVCeltSet.to_list
let variables_all (instructions : DVCfg.elt list) : DVCfg.internal list =
List.fold_left (fun (acc: DVCeltSet.t) (instr: DVCfg.elt) ->
@ -45,7 +45,7 @@ let variables_all (instructions : DVCfg.elt list) : DVCfg.internal list =
) DVCeltSet.empty instructions |> DVCeltSet.to_list
let variables_used (instr : DVCfg.elt) : DVCfg.internal list =
let helper (acc: DVCeltSet.t) (instr: DVCfg.elt) =
let aux (acc: DVCeltSet.t) (instr: DVCfg.elt) =
match instr with
| Nop
| LoadI (_, _) ->
@ -60,7 +60,7 @@ let variables_used (instr : DVCfg.elt) : DVCfg.internal list =
DVCeltSet.add r1.index acc
in
helper DVCeltSet.empty instr |> DVCeltSet.to_list
aux DVCeltSet.empty instr |> DVCeltSet.to_list
let variables_used_all (instructions : DVCfg.elt list) : DVCfg.internal list =
List.fold_left (fun (acc: DVCeltSet.t) (instr: DVCfg.elt) ->
@ -69,7 +69,7 @@ let variables_used_all (instructions : DVCfg.elt list) : DVCfg.internal list =
let variables_defined (instructions : DVCfg.elt) : DVCfg.internal list =
let helper (acc: DVCeltSet.t) (instr: DVCfg.elt) =
let aux (acc: DVCeltSet.t) (instr: DVCfg.elt) =
match instr with
| Nop
| Store (_, _) -> acc
@ -81,116 +81,118 @@ let variables_defined (instructions : DVCfg.elt) : DVCfg.internal list =
DVCeltSet.add r3.index acc
in
helper DVCeltSet.empty instructions |> DVCeltSet.to_list
aux DVCeltSet.empty instructions |> DVCeltSet.to_list
(* init function, assign the bottom to everything *)
let _init_bottom : (DVCfg.elt list -> DVCfg.internalnode) =
(fun l -> {internalin = [];
internalout = [];
internalbetween = (List.init (List.length l) (fun _ -> ([], [])))})
let _init_bottom : (DVCfg.elt list -> DVCfg.internal_node) =
(fun l -> {internal_in = [];
internal_out = [];
internal_between = (List.init (List.length l) (fun _ -> ([], [])))}
)
(* init function, assign the top to everything *)
let init_top (all_variables) : (DVCfg.elt list -> DVCfg.internalnode) =
(fun l -> {internalin = all_variables;
internalout = all_variables;
internalbetween = (List.init (List.length l)
let init_top (all_variables) : (DVCfg.elt list -> DVCfg.internal_node) =
(fun l -> {internal_in = all_variables;
internal_out = all_variables;
internal_between = (List.init (List.length l)
(fun _ -> (all_variables, all_variables)))})
let lub (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode =
let previnternalvar = Cfg.NodeMap.find node t.internalvar in
let lub (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internal_node =
let prev_internal_var = Cfg.NodeMap.find node t.internal_var in
let code = match Cfg.NodeMap.find_opt node t.t.content with
None -> []
| Some c -> c
in
let newinternalbetween = (
let new_internal_between = (
List.map
(fun (code, (i, _o)) ->
(i, Utility.unique_union i (variables_defined code)))
(List.combine code previnternalvar.internalbetween)
(List.combine code prev_internal_var.internal_between)
) in
let newinternalout =
match newinternalbetween with
let new_internal_out =
match new_internal_between with
| [] ->
previnternalvar.internalin
prev_internal_var.internal_in
| _ ->
let _, newinternalout = (Utility.last_list newinternalbetween) in
let _, newinternalout = (Utility.last_list new_internal_between) in
newinternalout
in
{ previnternalvar with
internalbetween = newinternalbetween;
internalout = newinternalout }
{ prev_internal_var with
internal_between = new_internal_between;
internal_out = new_internal_out }
let lucf (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode =
let previnternalvar = Cfg.NodeMap.find node t.internalvar in
let lucf (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internal_node =
let prev_internal_var = Cfg.NodeMap.find node t.internal_var in
if Option.equal (=) (Some node) t.t.initial then
(* if L is initial set dvin to the "in" register *)
let newinternalin = (
match t.t.inputOutputVar with
let new_internal_in = (
match t.t.input_output_var with
Some (i, _) -> [i]
| None -> []
) in
let newinternalbetween = ( (* set the dvin of each to the previous dvout *)
match previnternalvar.internalbetween with
let new_internal_between = (
(* set the dvin of each to the previous dvout *)
match prev_internal_var.internal_between with
[] -> []
| [(_i, o)] -> [(newinternalin, o)]
| [(_i, o)] -> [(new_internal_in, o)]
| (_i, o) :: btwrest ->
(newinternalin, o) :: (
(new_internal_in, o) :: (
List.map (fun ((_i, o), (_previ, prevo)) -> (prevo, o))
(Utility.combine_twice btwrest previnternalvar.internalbetween)
(Utility.combine_twice btwrest prev_internal_var.internal_between)
)
) in
{ previnternalvar with
internalin = newinternalin;
internalbetween = newinternalbetween }
{ prev_internal_var with
internal_in = new_internal_in;
internal_between = new_internal_between }
else
(* if L is not initial set dvin to the intersection of the previous node's
dvouts *)
let prevnodes = Cfg.NodeMap.find node t.t.reverseEdges in
let newinternalin = (
match prevnodes with
let prev_nodes = Cfg.NodeMap.find node t.t.reverse_edges in
let new_internal_in = (
match prev_nodes with
| [] ->
[]
| [prevnode] ->
(Cfg.NodeMap.find prevnode t.internalvar).internalout
(Cfg.NodeMap.find prevnode t.internal_var).internal_out
| [prevnode1; prevnode2] ->
Utility.unique_intersection
(Cfg.NodeMap.find prevnode1 t.internalvar).internalout
(Cfg.NodeMap.find prevnode2 t.internalvar).internalout
(Cfg.NodeMap.find prevnode1 t.internal_var).internal_out
(Cfg.NodeMap.find prevnode2 t.internal_var).internal_out
| prevnode :: restnodes ->
List.fold_left (* intersection of all previous nodes' dvout *)
(fun acc prevnode ->
Utility.unique_intersection
acc
(Cfg.NodeMap.find prevnode t.internalvar).internalout)
(Cfg.NodeMap.find prevnode t.internalvar).internalout
(Cfg.NodeMap.find prevnode t.internal_var).internal_out)
(Cfg.NodeMap.find prevnode t.internal_var).internal_out
restnodes
) in
let newinternalbetween =
match previnternalvar.internalbetween with
let new_internal_between =
match prev_internal_var.internal_between with
[] -> []
| [(_i, o)] -> [(newinternalin, o)]
| [(_i, o)] -> [(new_internal_in, o)]
| (_i, o) :: btwrest ->
(newinternalin, o) :: (
(new_internal_in, o) :: (
List.map (fun ((_i, o), (_previ, prevo)) -> (prevo, o))
(Utility.combine_twice btwrest previnternalvar.internalbetween)
(Utility.combine_twice btwrest prev_internal_var.internal_between)
)
in
{ previnternalvar with
internalin = newinternalin;
internalbetween = newinternalbetween }
{ prev_internal_var with
internal_in = new_internal_in;
internal_between = new_internal_between }
let update (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode =
let update (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internal_node =
let newt =
{t with internalvar = (Cfg.NodeMap.add node (lucf t node) t.internalvar)}
{t with internal_var = (Cfg.NodeMap.add node (lucf t node) t.internal_var)}
in
lub newt node
@ -204,7 +206,7 @@ let compute_defined_variables (cfg: RISCCfg.t) : DVCfg.t =
(Cfg.NodeMap.to_list cfg.content)
in
let all_variables =
match cfg.inputOutputVar with
match cfg.input_output_var with
| None -> all_variables
| Some (i, o) -> Utility.unique_union all_variables [i;o]
in
@ -215,18 +217,18 @@ let compute_defined_variables (cfg: RISCCfg.t) : DVCfg.t =
let check_undefined_variables (dvcfg: DVCfg.t) : Variable.t list option =
(* returns all undefined variables previously computed *)
let helper (node: Cfg.Node.t) (dvcfg: DVCfg.t) : Variable.t list option =
let aux (node: Cfg.Node.t) (dvcfg: DVCfg.t) : Variable.t list option =
let code = match Cfg.NodeMap.find_opt node dvcfg.t.content with
None -> []
| Some c -> c
in
let internalvar = Cfg.NodeMap.find node dvcfg.internalvar in
let internal_var = Cfg.NodeMap.find node dvcfg.internal_var in
let vua = variables_used_all code in
let outvar =
match (Option.equal (=) (Some node) dvcfg.t.terminal,
dvcfg.t.inputOutputVar,
internalvar.internalout) with
dvcfg.t.input_output_var,
internal_var.internal_out) with
| (true, Some (_, outvar), vout) ->
if List.mem outvar vout
then None
@ -235,18 +237,18 @@ let check_undefined_variables (dvcfg: DVCfg.t) : Variable.t list option =
None
in
if Utility.inclusion vua (internalvar.internalin) then
if Utility.inclusion vua (internal_var.internal_in) then
match outvar with None -> None
| Some outvar -> Some [outvar]
else
(* the variable might be defined inside the block, so check all vin and
return true only if all variables are properly defined *)
let vuabetween = List.map variables_used code in
let vua_between = List.map variables_used code in
let undef_vars = List.fold_left
(fun acc (codevars, (vin, _vout)) ->
(Utility.subtraction codevars vin) @ acc)
[]
(List.combine vuabetween internalvar.internalbetween)
(List.combine vua_between internal_var.internal_between)
in
match outvar, undef_vars with
None, [] -> None
@ -255,7 +257,7 @@ let check_undefined_variables (dvcfg: DVCfg.t) : Variable.t list option =
| Some outvar, undef_vars -> Some (outvar :: undef_vars)
in
Cfg.NodeSet.fold (fun node acc ->
match acc, (helper node dvcfg) with
match acc, (aux node dvcfg) with
None, None -> None
| None, Some x -> Some x
| Some acc, None -> Some acc

2
lib/miniImp/definedVariables.mli
View File

@ -3,7 +3,7 @@ open Analysis
module Variable : 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 RISCCfg = CfgRISC.RISCCfg

95
lib/miniImp/liveVariables.ml
View File

@ -5,7 +5,7 @@ module Variable = struct
let pp (ppf: out_channel) (v: t) : unit =
Printf.fprintf ppf "%s" v
let pplist (ppf: out_channel) (vv: t list) : unit =
let pp_list (ppf: out_channel) (vv: t list) : unit =
List.iter (Printf.fprintf ppf "%s, ") vv
let compare a b =
@ -21,7 +21,7 @@ module DVCeltSet = Set.Make(Variable)
let variables_used (instr : DVCfg.elt)
: DVCfg.internal list =
let helper (acc: DVCeltSet.t) (instr: DVCfg.elt) =
let aux (acc: DVCeltSet.t) (instr: DVCfg.elt) =
match instr with
| Nop
| LoadI (_, _) ->
@ -36,10 +36,10 @@ let variables_used (instr : DVCfg.elt)
DVCeltSet.add r1.index acc
in
helper DVCeltSet.empty instr |> DVCeltSet.to_list
aux DVCeltSet.empty instr |> DVCeltSet.to_list
let variables_defined (instructions : DVCfg.elt) : DVCfg.internal list =
let helper (acc: DVCeltSet.t) (instr: DVCfg.elt) =
let aux (acc: DVCeltSet.t) (instr: DVCfg.elt) =
match instr with
| Nop
| Store (_, _) -> acc
@ -51,10 +51,10 @@ let variables_defined (instructions : DVCfg.elt) : DVCfg.internal list =
DVCeltSet.add r3.index acc
in
helper DVCeltSet.empty instructions |> DVCeltSet.to_list
aux DVCeltSet.empty instructions |> DVCeltSet.to_list
let variables (instruction : DVCfg.elt) : DVCfg.internal list =
let helper (acc: DVCeltSet.t) (instr: DVCfg.elt) =
let aux (acc: DVCeltSet.t) (instr: DVCfg.elt) =
match instr with
| Nop -> acc
| Store (r1, r2) ->
@ -73,7 +73,7 @@ let variables (instruction : DVCfg.elt) : DVCfg.internal list =
DVCeltSet.add r3.index acc
in
helper DVCeltSet.empty instruction |> DVCeltSet.to_list
aux DVCeltSet.empty instruction |> DVCeltSet.to_list
let variables_all (instructions : DVCfg.elt list) : DVCfg.internal list =
List.fold_left (fun (acc: DVCeltSet.t) (instr: DVCfg.elt) ->
@ -81,43 +81,44 @@ let variables_all (instructions : DVCfg.elt list) : DVCfg.internal list =
) DVCeltSet.empty instructions |> DVCeltSet.to_list
(* init function, assign the bottom to everything *)
let init : (DVCfg.elt list -> DVCfg.internalnode) =
(fun l -> {internalin = [];
internalout = [];
internalbetween = (List.init (List.length l) (fun _ -> ([], [])))})
let init : (DVCfg.elt list -> DVCfg.internal_node) =
(fun l -> {internal_in = [];
internal_out = [];
internal_between = (List.init (List.length l) (fun _ -> ([], [])))}
)
let lub (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode =
let previnternalvar = Cfg.NodeMap.find node t.internalvar in
let lub (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internal_node =
let prev_internal_var = Cfg.NodeMap.find node t.internal_var in
let code = match Cfg.NodeMap.find_opt node t.t.content with
None -> []
| Some c -> c
in
let newinternalbetween = (
let new_internal_between = (
List.map
(fun (code, (_i, o)) ->
(Utility.unique_union
(variables_used code)
(Utility.subtraction o (variables_defined code)), o))
(Utility.combine_twice code previnternalvar.internalbetween)
(Utility.combine_twice code prev_internal_var.internal_between)
) in
let newinternalin =
match newinternalbetween with
| [] -> previnternalvar.internalout
let new_internal_in =
match new_internal_between with
| [] -> prev_internal_var.internal_out
| (i, _)::_ -> i
in
{ previnternalvar with
internalbetween = newinternalbetween;
internalin = newinternalin; }
{ prev_internal_var with
internal_between = new_internal_between;
internal_in = new_internal_in; }
let lucf (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode =
let previnternalvar = Cfg.NodeMap.find node t.internalvar in
let lucf (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internal_node =
let prev_internal_var = Cfg.NodeMap.find node t.internal_var in
let newinternalout = (
if Option.equal (=) (Some node) t.t.terminal then (
match t.t.inputOutputVar with
match t.t.input_output_var with
Some (_, o) -> [o]
| None -> []
) else (
@ -125,35 +126,35 @@ let lucf (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode =
match nextnodes with
| None -> []
| Some (node, None) ->
(Cfg.NodeMap.find node t.internalvar).internalin
(Cfg.NodeMap.find node t.internal_var).internal_in
| Some (node1, Some node2) ->
Utility.unique_union
(Cfg.NodeMap.find node1 t.internalvar).internalin
(Cfg.NodeMap.find node2 t.internalvar).internalin
(Cfg.NodeMap.find node1 t.internal_var).internal_in
(Cfg.NodeMap.find node2 t.internal_var).internal_in
)
) in
let newinternalbetween = (
match List.rev previnternalvar.internalbetween with
let new_internal_between = (
match List.rev prev_internal_var.internal_between with
| [] -> []
| (i, _o) :: btwrest ->
let btwrest = List.rev btwrest in
let newbtwrest = List.map2
(fun (i, _o) (nexti, _nexto) -> (i, nexti))
btwrest
(Utility.drop_first_element_list previnternalvar.internalbetween)
(Utility.drop_first_element_list prev_internal_var.internal_between)
in
newbtwrest @ [(i, newinternalout)]
) in
{ previnternalvar with
internalout = newinternalout;
internalbetween = newinternalbetween; }
{ prev_internal_var with
internal_out = newinternalout;
internal_between = new_internal_between; }
let update (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode =
let newt = {t with internalvar = (Cfg.NodeMap.add node
let update (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internal_node =
let newt = {t with internal_var = (Cfg.NodeMap.add node
(lucf t node)
t.internalvar)} in
t.internal_var)} in
lub newt node
@ -244,38 +245,38 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
(t: DVCfg.t)
(node: Cfg.Node.t)
: (Variable.t VariableMap.t * DVCfg.t) =
let livevars = Cfg.NodeMap.find node t.internalvar in
let livevars = Cfg.NodeMap.find node t.internal_var in
let code =
match Cfg.NodeMap.find_opt node t.t.content with
| None -> []
| Some x -> x
in
let newcode, newassignments =
let new_code, new_assignments =
(List.fold_left2
(fun (acc, assignments) btw code ->
let na, nc = replace_code btw assignments code in
(acc @ [nc], na)
)
([], assignments)
livevars.internalbetween
livevars.internal_between
code)
in
let newcontent = Cfg.NodeMap.add
node
newcode
new_code
t.t.content
in
let newt = { t with t = { t.t with content = newcontent } } in
(newassignments, newt)
(new_assignments, newt)
in
(* ------------------- *)
(* at least the input variable should be in the mapping *)
let assignments =
match t.t.inputOutputVar with
match t.t.input_output_var with
None -> VariableMap.empty
| Some (i, _o) -> (
VariableMap.get_or_set_mapping VariableMap.empty [] i |> fst
@ -296,7 +297,7 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
(* union of all in and out such that v is in the set *)
let union : 'a list =
List.fold_left
(fun (acc: 'a list) (node, (x: DVCfg.internalnode)) ->
(fun (acc: 'a list) (node, (x: DVCfg.internal_node)) ->
(* not interested in internalin or internalout since information
is mirrored into internalbetween *)
List.fold_left2
@ -315,12 +316,12 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
(Utility.unique_union i o) acc
)
acc
x.internalbetween
x.internal_between
(Cfg.NodeMap.find_opt node t.t.content |>
Option.value ~default:[])
)
[]
(Cfg.NodeMap.to_list t.internalvar)
(Cfg.NodeMap.to_list t.internal_var)
in
let assignments, _ =
VariableMap.get_or_set_mapping assignments union v in
@ -338,8 +339,8 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
{ newt with
t = { newt.t with
inputOutputVar =
match newt.t.inputOutputVar with
input_output_var =
match newt.t.input_output_var with
None -> None
| Some (i, o) -> (
match VariableMap.find_opt i mapping,

40
lib/miniImp/reduceRegisters.ml
View File

@ -21,7 +21,7 @@ let variables_frequency (instr : RISCCfg.elt) : (Variable.t * int) list =
let add_one = (fun x -> match x with None -> Some 1 | Some x -> Some (x + 1))
in
let helper (acc: int VariableMap.t) (instr: RISCCfg.elt) : int VariableMap.t =
let aux (acc: int VariableMap.t) (instr: RISCCfg.elt) : int VariableMap.t =
match instr with
| Nop ->
acc
@ -39,7 +39,7 @@ let variables_frequency (instr : RISCCfg.elt) : (Variable.t * int) list =
VariableMap.update r3.index add_one acc
in
helper VariableMap.empty instr |> VariableMap.to_list
aux VariableMap.empty instr |> VariableMap.to_list
(* computes syntactic frequency of all variables in the code *)
let variables_all_frequency (instructions : RISCCfg.elt list)
@ -52,7 +52,7 @@ let variables_all_frequency (instructions : RISCCfg.elt list)
VariableMap.empty instructions |> VariableMap.to_list
let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
let reduce_registers (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
(if n < 4 then (
failwith "ReduceRegisters: number of registers too small"
) else ());
@ -68,7 +68,7 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
(* add one to in and out variables *)
let all_variables =
match cfg.inputOutputVar with
match cfg.input_output_var with
| None -> all_variables
| Some (i, _o) -> (
match List.assoc_opt i all_variables with
@ -78,7 +78,7 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
in
let all_variables =
match cfg.inputOutputVar with
match cfg.input_output_var with
| None -> all_variables
| Some (_i, o) -> (
match List.assoc_opt o all_variables with
@ -89,7 +89,7 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
(* replace each operation with a list of operations that have the new
registers or load from memory *)
let replaceregisters
let replace_registers
(remappedregisters: Variable.t VariableMap.t)
(memorymap: int VariableMap.t)
(temporaryregisters: Variable.t list)
@ -315,7 +315,7 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
cfg with
content = Cfg.NodeMap.map
( fun x ->
replaceregisters
replace_registers
most_frequent_mapping
least_frequent_mapping
["1"; "2"]
@ -323,10 +323,10 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
) cfg.content}
in
if newcfg.inputOutputVar = None
if newcfg.input_output_var = None
then newcfg (* if no input or output variables we ignore *)
else
let i, o = Option.get newcfg.inputOutputVar in
let i, o = Option.get newcfg.input_output_var in
match (VariableMap.find_opt i most_frequent_mapping,
VariableMap.find_opt o most_frequent_mapping,
VariableMap.find_opt i least_frequent_mapping,
@ -335,15 +335,15 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
newcfg.terminal )
with (*we check if in and out are simply remapped or are put in memory*)
| Some i, Some o, _, _, _, _ ->
{ newcfg with inputOutputVar = Some (i, o) }
{ newcfg with input_output_var = Some (i, o) }
| Some i, None, _, Some _, _, None ->
(* we check for the terminal node, if not present we are very confused
and dont modify the out variable *)
{ newcfg with inputOutputVar = Some (i, o)}
{ newcfg with input_output_var = Some (i, o)}
| Some i, None, _, Some mo, _, Some n ->
(* since the output simbol is in memory we need to first retrive it
and then put the result in a temporary register *)
let terminalcontent = (
let terminal_content = (
match Cfg.NodeMap.find_opt n newcfg.content with
| None -> []
| Some x -> x
@ -351,14 +351,14 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
Load ({index = "2"}, {index = "2"})]
in
let content =
Cfg.NodeMap.add n terminalcontent newcfg.content
Cfg.NodeMap.add n terminal_content newcfg.content
in
{ newcfg with
inputOutputVar = Some (i, "2");
input_output_var = Some (i, "2");
content = content
}
| None, Some o, Some _, _, _, None ->
{ newcfg with inputOutputVar = Some (i, o) }
{ newcfg with input_output_var = Some (i, o) }
| None, Some o, Some mi, _, _, Some n -> (
(* the input simbol should be stored in memory *)
let initialcontent =
@ -371,12 +371,12 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
in
let content = Cfg.NodeMap.add n initialcontent newcfg.content in
{ newcfg with
inputOutputVar = Some ("1", o);
input_output_var = Some ("1", o);
content = content
}
)
| None, None, Some _, Some _, None, None ->
{ newcfg with inputOutputVar = Some (i, o) }
{ newcfg with input_output_var = Some (i, o) }
| None, None, Some _, Some mo, None, Some n ->
(* both simbols should be in memory *)
let terminalcontent = (
@ -390,7 +390,7 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
Cfg.NodeMap.add n terminalcontent newcfg.content
in
{ newcfg with
inputOutputVar = Some (i, "2");
input_output_var = Some (i, "2");
content = content
}
| None, None, Some mi, Some _, Some n, None ->
@ -405,7 +405,7 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
in
let content = Cfg.NodeMap.add n initialcontent newcfg.content in
{ newcfg with
inputOutputVar = Some ("1", o);
input_output_var = Some ("1", o);
content = content
}
| None, None, Some mi, Some mo, Some ni, Some no ->
@ -432,7 +432,7 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
Cfg.NodeMap.add no terminalcontent content
in
{ newcfg with
inputOutputVar = Some ("1", "2");
input_output_var = Some ("1", "2");
content = content
}
| _ -> failwith ("ReduceRegisters: fail to partition a set, some" ^

2
lib/miniImp/reduceRegisters.mli
View File

@ -1,3 +1,3 @@
module RISCCfg = CfgRISC.RISCCfg
val reduceregisters : int -> RISCCfg.t -> RISCCfg.t
val reduce_registers : int -> RISCCfg.t -> RISCCfg.t

2
test/testingAnalysis.ml
View File

@ -8,7 +8,7 @@ let compute x i =
LiveVariables.compute_live_variables |>
LiveVariables.optimize_cfg |>
LiveVariables.compute_cfg |>
ReduceRegisters.reduceregisters 4 |>
ReduceRegisters.reduce_registers 4 |>
RISC.convert |>
RISCSemantics.reduce