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

112
lib/analysis/Cfg.ml
View File

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

10
lib/analysis/Cfg.mli
View File

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

89
lib/analysis/Dataflow.ml
View File

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

14
lib/analysis/Dataflow.mli
View File

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

14
lib/miniFun/Semantics.ml
View File

@ -6,7 +6,7 @@ Random.self_init ()
let (let*) = Result.bind let (let*) = Result.bind
let rec evaluate (mem: memory) (command: t_exp) : let rec evaluate (mem: memory) (command: t_exp) :
(permittedValues, [> error]) result = (permitted_values, [> error]) result =
match command with match command with
Integer n -> Ok (IntegerPermitted n) Integer n -> Ok (IntegerPermitted n)
| Boolean b -> Ok (BooleanPermitted b) | Boolean b -> Ok (BooleanPermitted b)
@ -31,7 +31,7 @@ let rec evaluate (mem: memory) (command: t_exp) :
) )
| Application (f, x) -> ( | Application (f, x) -> (
let* evalf = evaluate mem f in let* evalf = evaluate mem f in
let* funcClosure = ( let* func_closure = (
match evalf with match evalf with
FunctionPermitted ff -> Ok ff FunctionPermitted ff -> Ok ff
| IntegerPermitted _ -> Error (`WrongType ("Function is not a function," | IntegerPermitted _ -> Error (`WrongType ("Function is not a function,"
@ -43,15 +43,15 @@ let rec evaluate (mem: memory) (command: t_exp) :
) in ) in
let* param = evaluate mem x in let* param = evaluate mem x in
let mem2 = let mem2 =
match funcClosure.recursiveness with match func_closure.recursiveness with
None -> {assignments = ( None -> {assignments = (
VariableMap.add funcClosure.input param funcClosure.assignments)} VariableMap.add func_closure.input param func_closure.assignments)}
| Some nameF -> {assignments = ( | Some nameF -> {assignments = (
VariableMap.add funcClosure.input param funcClosure.assignments |> VariableMap.add func_closure.input param func_closure.assignments |>
VariableMap.add nameF (FunctionPermitted funcClosure) VariableMap.add nameF (FunctionPermitted func_closure)
)} )}
in in
evaluate mem2 funcClosure.body evaluate mem2 func_closure.body
) )
| Plus (a, b) -> | Plus (a, b) ->
let* aval = ( 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 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 | LetFun of variable * variable * ftype * t_exp * t_exp
(* let rec x. y: t. x in x*) (* let rec x. y: t. x in x*)
type permittedValues = type permitted_values =
IntegerPermitted of int IntegerPermitted of int
| BooleanPermitted of bool | BooleanPermitted of bool
| TuplePermitted of permittedValues * permittedValues | TuplePermitted of permitted_values * permitted_values
| FunctionPermitted of closure | FunctionPermitted of closure
and closure = { and closure = {
input: variable; input: variable;
body: t_exp; body: t_exp;
assignments: permittedValues VariableMap.t; assignments: permitted_values VariableMap.t;
recursiveness: variable option recursiveness: variable option
} }
type memory = { 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 *) | 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*) | 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 IntegerPermitted of int
| BooleanPermitted of bool | BooleanPermitted of bool
| TuplePermitted of permittedValues * permittedValues | TuplePermitted of permitted_values * permitted_values
| FunctionPermitted of closure | FunctionPermitted of closure
and closure = { and closure = {
input: variable; input: variable;
body: t_exp; body: t_exp;
assignments: permittedValues VariableMap.t; assignments: permitted_values VariableMap.t;
recursiveness: variable option recursiveness: variable option
} }
type memory = { 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 in
helper_c ppf c 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 List.iter (fun x -> pp ppf x; Printf.printf "; ") c
end end
@ -89,10 +89,10 @@ let rec convert_c (prevcfg: SSCfg.t) (prg: Types.c_exp) : SSCfg.t =
let open SimpleStatements in let open SimpleStatements in
match prg with match prg with
| Skip -> (* we preserve the skips *) | 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 *) | 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 | Sequence (c1, c2) -> (* we first convert the first sequence, then the second
using the previous as prevcfg *) using the previous as prevcfg *)
@ -101,7 +101,7 @@ let rec convert_c (prevcfg: SSCfg.t) (prg: Types.c_exp) : SSCfg.t =
cfg2 cfg2
| If (b, c1, c2) -> (* constructs two branches with a two new nodes *) | 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 cfg1 = convert_c SSCfg.empty c1 in
let cfg2 = convert_c SSCfg.empty c2 in let cfg2 = convert_c SSCfg.empty c2 in
let entrynode = Node.create () 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 let mergedcfg = SSCfg.concat prevcfg newcfg in
{ mergedcfg with { mergedcfg with
content = mergedcfg.content |> content = mergedcfg.content |>
NodeMap.add_to_list entrynode (SimpleGuard convertedb) |> NodeMap.add_to_list entrynode (SimpleGuard converted_b) |>
NodeMap.add_to_list exitnode (SimpleSkip) } NodeMap.add_to_list exitnode (SimpleSkip) }
| While (b, c) -> (* constructs a loop, needs three new nodes *) | 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 cfg = convert_c SSCfg.empty c in
let cfginitial = Option.get cfg.initial in let cfginitial = Option.get cfg.initial in
let cfgterminal = Option.get cfg.terminal 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 entrynode (guardnode, None) |>
NodeMap.add guardnode (cfginitial, Some exitnode) |> NodeMap.add guardnode (cfginitial, Some exitnode) |>
NodeMap.add cfgterminal (guardnode, None); NodeMap.add cfgterminal (guardnode, None);
reverseEdges = cfg.reverseEdges |> reverse_edges = cfg.reverse_edges |>
NodeMap.add_to_list guardnode entrynode |> NodeMap.add_to_list guardnode entrynode |>
NodeMap.add_to_list cfginitial guardnode |> NodeMap.add_to_list cfginitial guardnode |>
NodeMap.add_to_list exitnode guardnode |> NodeMap.add_to_list exitnode guardnode |>
NodeMap.add_to_list guardnode cfgterminal; NodeMap.add_to_list guardnode cfgterminal;
inputVal = prevcfg.inputVal; input_val = prevcfg.input_val;
inputOutputVar = prevcfg.inputOutputVar; input_output_var = prevcfg.input_output_var;
initial = Some entrynode; initial = Some entrynode;
terminal = Some exitnode; terminal = Some exitnode;
content = cfg.content |> content = cfg.content |>
NodeMap.add_to_list guardnode (SimpleGuard (convertedb)) |> NodeMap.add_to_list guardnode (SimpleGuard (converted_b)) |>
NodeMap.add_to_list exitnode (SimpleSkip) NodeMap.add_to_list exitnode (SimpleSkip)
} |> SSCfg.concat prevcfg } |> SSCfg.concat prevcfg
@ -166,12 +166,12 @@ let rec convert_c (prevcfg: SSCfg.t) (prg: Types.c_exp) : SSCfg.t =
edges = bodyincrement.edges |> edges = bodyincrement.edges |>
NodeMap.add guardnode (cfginitial, Some exitnode) |> NodeMap.add guardnode (cfginitial, Some exitnode) |>
NodeMap.add cfgterminal (guardnode, None); NodeMap.add cfgterminal (guardnode, None);
reverseEdges = bodyincrement.reverseEdges |> reverse_edges = bodyincrement.reverse_edges |>
NodeMap.add_to_list cfginitial guardnode |> NodeMap.add_to_list cfginitial guardnode |>
NodeMap.add_to_list exitnode guardnode |> NodeMap.add_to_list exitnode guardnode |>
NodeMap.add_to_list guardnode cfgterminal; NodeMap.add_to_list guardnode cfgterminal;
inputVal = prevcfg.inputVal; input_val = prevcfg.input_val;
inputOutputVar = prevcfg.inputOutputVar; input_output_var = prevcfg.input_output_var;
initial = Some guardnode; initial = Some guardnode;
terminal = Some exitnode; terminal = Some exitnode;
content = bodyincrement.content |> content = bodyincrement.content |>
@ -208,8 +208,8 @@ let convert (prg: Types.p_exp) : SSCfg.t =
let prg = ReplacePowerMod.rewrite_instructions prg in let prg = ReplacePowerMod.rewrite_instructions prg in
match prg with match prg with
| Main (i, o, exp) -> | 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 convert_io (i: int) (prg: Types.p_exp) : SSCfg.t =
let prg = ReplacePowerMod.rewrite_instructions prg in 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 | SimpleRand of simpleArithmetic
val pp : out_channel -> t -> unit val pp : out_channel -> t -> unit
val pplist : out_channel -> t list -> unit val pp_list : out_channel -> t list -> unit
end end
module SSCfg : Cfg.C with type elt = SimpleStatements.t module SSCfg : Cfg.C with type elt = SimpleStatements.t

22
lib/miniImp/CfgRISC.ml
View File

@ -102,7 +102,7 @@ module RISCSimpleStatements = struct
in in
pp_t ppf v 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 List.iter (fun x -> pp ppf x; Printf.printf "; ") l
end end
@ -915,7 +915,7 @@ let convert_ss
in in
(Cfg.NodeMap.add node instructions risccode, m) (Cfg.NodeMap.add node instructions risccode, m)
let helper let helper_convert
(c: CfgImp.SimpleStatements.t list Cfg.NodeMap.t) (c: CfgImp.SimpleStatements.t list Cfg.NodeMap.t)
(m: RegisterMap.m) (m: RegisterMap.m)
: RISCSimpleStatements.t list Cfg.NodeMap.t = : RISCSimpleStatements.t list Cfg.NodeMap.t =
@ -932,16 +932,16 @@ let convert (prg: CfgImp.SSCfg.t) : RISCCfg.t =
let ({ empty: bool; let ({ empty: bool;
nodes: Cfg.NodeSet.t; nodes: Cfg.NodeSet.t;
edges: (Cfg.Node.t * (Cfg.Node.t option)) Cfg.NodeMap.t; edges: (Cfg.Node.t * (Cfg.Node.t option)) Cfg.NodeMap.t;
reverseEdges: (Cfg.Node.t list) Cfg.NodeMap.t; reverse_edges: (Cfg.Node.t list) Cfg.NodeMap.t;
inputVal: int option; input_val: int option;
inputOutputVar: (string * string) option; input_output_var: (string * string) option;
initial: Cfg.Node.t option; initial: Cfg.Node.t option;
terminal: Cfg.Node.t option; terminal: Cfg.Node.t option;
content: CfgImp.SimpleStatements.t list Cfg.NodeMap.t content: CfgImp.SimpleStatements.t list Cfg.NodeMap.t
}: CfgImp.SSCfg.t) = prg }: CfgImp.SSCfg.t) = prg
in in
let initial_bindings = let initial_bindings =
match inputOutputVar with match input_output_var with
| Some (i, o) -> ( | Some (i, o) -> (
if i = o then if i = o then
RegisterMap.empty |> RegisterMap.empty |>
@ -957,10 +957,10 @@ let convert (prg: CfgImp.SSCfg.t) : RISCCfg.t =
{ empty = empty; { empty = empty;
nodes = nodes; nodes = nodes;
edges = edges; edges = edges;
reverseEdges = reverseEdges; reverse_edges = reverse_edges;
inputVal = inputVal; input_val = input_val;
inputOutputVar = ( input_output_var = (
match inputOutputVar with match input_output_var with
| Some (i, o) -> ( | Some (i, o) -> (
if i = o then if i = o then
Some ("in", "in") Some ("in", "in")
@ -971,5 +971,5 @@ let convert (prg: CfgImp.SSCfg.t) : RISCCfg.t =
); );
initial = initial; initial = initial;
terminal = terminal; 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 | Rand
val pp : out_channel -> t -> unit val pp : out_channel -> t -> unit
val pplist : out_channel -> t list -> unit val pp_list : out_channel -> t list -> unit
end end
module RISCCfg : Cfg.C with type elt = RISCSimpleStatements.t 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) : let convert_cfgrisc_risci (i: CfgRISC.RISCSimpleStatements.t list) :
(RISCAssembly.risci list) = (RISCAssembly.risci list) =
let rec helper (i: CfgRISC.RISCSimpleStatements.t) let rec aux (i: CfgRISC.RISCSimpleStatements.t)
: RISCAssembly.risci = : RISCAssembly.risci =
match i with match i with
| Nop -> Nop | Nop -> Nop
| BRegOp (brop, r1, r2, r3) -> BRegOp (helper_brop brop, | BRegOp (brop, r1, r2, r3) -> BRegOp (aux_brop brop,
{index = r1.index}, {index = r1.index},
{index = r2.index}, {index = r2.index},
{index = r3.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}, {index = r1.index},
imm, imm,
{index = r3.index}) {index = r3.index})
| URegOp (urop, r1, r3) -> URegOp (helper_urop urop, | URegOp (urop, r1, r3) -> URegOp (aux_urop urop,
{index = r1.index}, {index = r1.index},
{index = r3.index}) {index = r3.index})
| Load (r1, r3) -> Load ({index = r1.index}, | Load (r1, r3) -> Load ({index = r1.index},
@ -163,7 +163,7 @@ let convert_cfgrisc_risci (i: CfgRISC.RISCSimpleStatements.t list) :
{index = r3.index}) {index = r3.index})
| Store (r1, r3) -> Store ({index = r1.index}, | Store (r1, r3) -> Store ({index = r1.index},
{index = r3.index}) {index = r3.index})
and helper_brop (brop: CfgRISC.RISCSimpleStatements.brop) and aux_brop (brop: CfgRISC.RISCSimpleStatements.brop)
: RISCAssembly.brop = : RISCAssembly.brop =
match brop with match brop with
| Add -> Add | Add -> Add
@ -179,7 +179,7 @@ let convert_cfgrisc_risci (i: CfgRISC.RISCSimpleStatements.t list) :
| LessEq -> LessEq | LessEq -> LessEq
| More -> More | More -> More
| MoreEq -> MoreEq | MoreEq -> MoreEq
and helper_biop (biop: CfgRISC.RISCSimpleStatements.biop) and aux_biop (biop: CfgRISC.RISCSimpleStatements.biop)
: RISCAssembly.biop = : RISCAssembly.biop =
match biop with match biop with
| AddI -> AddI | AddI -> AddI
@ -195,16 +195,16 @@ let convert_cfgrisc_risci (i: CfgRISC.RISCSimpleStatements.t list) :
| LessEqI -> LessEqI | LessEqI -> LessEqI
| MoreI -> MoreI | MoreI -> MoreI
| MoreEqI -> MoreEqI | MoreEqI -> MoreEqI
and helper_urop (urop: CfgRISC.RISCSimpleStatements.urop) and aux_urop (urop: CfgRISC.RISCSimpleStatements.urop)
: RISCAssembly.urop = : RISCAssembly.urop =
match urop with match urop with
| Not -> Not | Not -> Not
| Copy -> Copy | Copy -> Copy
| Rand -> Rand | Rand -> Rand
in in
List.map helper i List.map aux i
let nextCommonSuccessor let next_common_successor
(prg: CfgRISC.RISCCfg.t) (prg: CfgRISC.RISCCfg.t)
(node1: Cfg.Node.t) (node1: Cfg.Node.t)
(node2: Cfg.Node.t) (node2: Cfg.Node.t)
@ -231,30 +231,35 @@ let nextCommonSuccessor
| a::_ -> Some a | a::_ -> Some a
let rec helper let rec helper_convert
(prg: CfgRISC.RISCCfg.t) (prg: CfgRISC.RISCCfg.t)
(currentnode: Cfg.Node.t) (current_node: Cfg.Node.t)
(alreadyVisited: Cfg.Node.t list) (already_visited: Cfg.Node.t list)
: (RISCAssembly.risci list) * (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 (* takes the program, the current node and a list of already visited nodes to
compute the linearized three address instructions and the list of compute the linearized three address instructions and the list of
previoulsy visited nodes plus the newly visited nodes. Stops as soon if previoulsy visited nodes plus the newly visited nodes. Stops as soon if
node has already been visited or if no nodes are next *) node has already been visited or if no nodes are next *)
if List.mem currentnode alreadyVisited then if List.mem current_node already_visited then
([], alreadyVisited) ([], already_visited)
else ( else (
let nextnodes = (Cfg.NodeMap.find_opt currentnode prg.edges) in let nextnodes = (Cfg.NodeMap.find_opt current_node prg.edges) in
let currentcode = let currentcode =
(match (Cfg.NodeMap.find_opt currentnode prg.content) with (match (Cfg.NodeMap.find_opt current_node prg.content) with
| None -> [] | None -> []
| Some x -> convert_cfgrisc_risci x) | Some x -> convert_cfgrisc_risci x)
in in
match nextnodes with match nextnodes with
| Some (nextnode1, None) -> | 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) (currentcode @ res, vis)
| Some (nextnode1, Some nextnode2) -> ( | Some (nextnode1, Some nextnode2) -> (
let ncs = nextCommonSuccessor prg nextnode1 nextnode2 in let ncs = next_common_successor prg nextnode1 nextnode2 in
match ncs with match ncs with
| None -> (* should never happen since the terminal node should always be | None -> (* should never happen since the terminal node should always be
rechable *) rechable *)
@ -267,11 +272,11 @@ let rec helper
let label3 = nextLabel () in let label3 = nextLabel () in
let res1, _ = let res1, _ =
(helper prg nextnode1 (helper_convert prg nextnode1
(currentnode :: nextnode2 :: alreadyVisited)) in (current_node :: nextnode2 :: already_visited)) in
let res2, vis2 = let res2, vis2 =
(helper prg nextnode2 (helper_convert prg nextnode2
(currentnode :: nextnode1 :: alreadyVisited)) in (current_node :: nextnode1 :: already_visited)) in
match List.nth currentcode ((List.length currentcode) - 1) with match List.nth currentcode ((List.length currentcode) - 1) with
| BRegOp (_, _, _, r) | BRegOp (_, _, _, r)
@ -296,9 +301,15 @@ let rec helper
let label3 = nextLabel () in let label3 = nextLabel () in
let res1, vis1 = let res1, vis1 =
(helper prg nextnode1 (currentnode :: ncs :: alreadyVisited)) in helper_convert
let res2, _ = (helper prg nextnode2 vis1) in prg
let res3, vis3 = (helper prg ncs (currentnode :: alreadyVisited)) in 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 match List.nth currentcode ((List.length currentcode) - 1) with
| BRegOp (_, _, _, r) | BRegOp (_, _, _, r)
| BImmOp (_, _, _, r) | BImmOp (_, _, _, r)
@ -319,15 +330,15 @@ let rec helper
| _ -> failwith "Missing instruction at branch" | _ -> failwith "Missing instruction at branch"
) )
) )
| None -> (currentcode, currentnode :: alreadyVisited) | None -> (currentcode, current_node :: already_visited)
) )
let convert (prg: CfgRISC.RISCCfg.t) : RISCAssembly.t = 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)); List.append ([Label "main"] : RISCAssembly.risci list));
inputval = prg.inputVal; inputval = prg.input_val;
inputoutputreg = inputoutputreg =
match prg.inputOutputVar with match prg.input_output_var with
None -> None None -> None
| Some (i, o) -> Some ({index = i}, {index = o}) | 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 = : RISC.RISCAssembly.risci list CodeMap.t =
(* takes as input a sequence of RISC commands and computes a map to the right (* takes as input a sequence of RISC commands and computes a map to the right
labels for easier execution *) labels for easier execution *)
let rec helper let rec aux
(prg: RISC.RISCAssembly.risci list) (prg: RISC.RISCAssembly.risci list)
(current: RISC.RISCAssembly.risci list) (current: RISC.RISCAssembly.risci list)
(current_label: string) (current_label: string)
@ -33,27 +33,27 @@ let convert (prg: RISC.RISCAssembly.t)
(fun _ _ _ -> failwith "Two labels are the same") (fun _ _ _ -> failwith "Two labels are the same")
(CodeMap.singleton current_label current) (CodeMap.singleton current_label current)
map) map)
| Label l :: tl -> helper tl ([]) l | Label l :: tl -> aux tl ([]) l
(CodeMap.union (CodeMap.union
(fun _ _ _ -> failwith "Two labels are the same") (fun _ _ _ -> failwith "Two labels are the same")
(CodeMap.singleton current_label current) (CodeMap.singleton current_label current)
map) map)
| instr :: tl -> helper tl (current @ [instr]) current_label map | instr :: tl -> aux tl (current @ [instr]) current_label map
in in
match prg.code with 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" | _ -> failwith "Program should begind with label main"
let label_order (prg: RISC.RISCAssembly.t) : string list = let label_order (prg: RISC.RISCAssembly.t) : string list =
let rec helper let rec aux
(prg: RISC.RISCAssembly.risci list) (prg: RISC.RISCAssembly.risci list)
: string list = : string list =
match prg with match prg with
[] -> [] [] -> []
| Label l :: tl -> l :: (helper tl) | Label l :: tl -> l :: (aux tl)
| _ :: tl -> (helper tl) | _ :: tl -> (aux tl)
in in
helper (prg.code) aux (prg.code)
let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int = let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
let match_operator_r (brop: RISC.RISCAssembly.brop) = 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) | MoreEqI -> (Utility.int_more_eq)
in in
let rec helper let rec aux
(prg: RISCArchitecture.t) (prg: RISCArchitecture.t)
(current: RISC.RISCAssembly.risci list) (current: RISC.RISCAssembly.risci list)
(current_label: string) (current_label: string)
@ -101,7 +101,7 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
None -> prg (* should never happen *) None -> prg (* should never happen *)
| Some i -> | Some i ->
if i + 1 < (List.length lo) then if i + 1 < (List.length lo) then
helper aux
prg prg
(CodeMap.find (List.nth lo (i+1)) prg.code) (CodeMap.find (List.nth lo (i+1)) prg.code)
(List.nth lo (i+1)) (List.nth lo (i+1))
@ -109,13 +109,13 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
prg prg
) )
| Nop :: tl -> | Nop :: tl ->
helper prg tl current_label aux prg tl current_label
| BRegOp (brop, r1, r2, r3) :: tl -> ( | BRegOp (brop, r1, r2, r3) :: tl -> (
let n = (match_operator_r brop) let n = (match_operator_r brop)
(RegisterMap.find {index = r1.index} prg.registers) (RegisterMap.find {index = r1.index} prg.registers)
(RegisterMap.find {index = r2.index} prg.registers) (RegisterMap.find {index = r2.index} prg.registers)
in in
helper { prg with aux { prg with
registers = RegisterMap.add {index = r3.index} n prg.registers} registers = RegisterMap.add {index = r3.index} n prg.registers}
tl current_label tl current_label
) )
@ -124,7 +124,7 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
(RegisterMap.find {index = r1.index} prg.registers) (RegisterMap.find {index = r1.index} prg.registers)
i i
in in
helper { prg with aux { prg with
registers = RegisterMap.add {index = r3.index} n prg.registers} registers = RegisterMap.add {index = r3.index} n prg.registers}
tl current_label tl current_label
) )
@ -132,7 +132,7 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
match urop with match urop with
| Copy -> ( | Copy -> (
let n = RegisterMap.find {index = r1.index} prg.registers in let n = RegisterMap.find {index = r1.index} prg.registers in
helper { prg with aux { prg with
registers = registers =
RegisterMap.add {index = r3.index} n prg.registers } RegisterMap.add {index = r3.index} n prg.registers }
tl current_label tl current_label
@ -141,7 +141,7 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
let n = Utility.int_not let n = Utility.int_not
(RegisterMap.find {index = r1.index} prg.registers) (RegisterMap.find {index = r1.index} prg.registers)
in in
helper { prg with aux { prg with
registers = registers =
RegisterMap.add {index = r3.index} n prg.registers } RegisterMap.add {index = r3.index} n prg.registers }
tl current_label tl current_label
@ -150,7 +150,7 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
let n = Random.int let n = Random.int
(RegisterMap.find {index = r1.index} prg.registers) (RegisterMap.find {index = r1.index} prg.registers)
in in
helper { prg with aux { prg with
registers = registers =
RegisterMap.add {index = r3.index} n prg.registers } RegisterMap.add {index = r3.index} n prg.registers }
tl current_label tl current_label
@ -162,40 +162,40 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
(RegisterMap.find {index = r1.index} prg.registers) (RegisterMap.find {index = r1.index} prg.registers)
prg.memory prg.memory
in in
helper { prg with aux { prg with
registers = RegisterMap.add {index = r3.index} n prg.registers} registers = RegisterMap.add {index = r3.index} n prg.registers}
tl current_label tl current_label
) )
| LoadI (i, r3) :: tl -> ( | LoadI (i, r3) :: tl -> (
let n = i let n = i
in in
helper { prg with aux { prg with
registers = RegisterMap.add {index = r3.index} n prg.registers} registers = RegisterMap.add {index = r3.index} n prg.registers}
tl current_label tl current_label
) )
| Store (r1, r3) :: tl -> ( | Store (r1, r3) :: tl -> (
let n = RegisterMap.find {index = r1.index} prg.registers in let n = RegisterMap.find {index = r1.index} prg.registers in
let n1 = RegisterMap.find {index = r3.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 } { prg with memory = MemoryMap.add n1 n prg.memory }
tl tl
current_label 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) :: _ -> ( | CJump (r, l1, l2) :: _ -> (
let br = (RegisterMap.find {index = r.index} prg.registers) > 0 in let br = (RegisterMap.find {index = r.index} prg.registers) > 0 in
if br if br
then then
helper prg (CodeMap.find l1 prg.code) l1 aux prg (CodeMap.find l1 prg.code) l1
else 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 in
match match
RegisterMap.find_opt RegisterMap.find_opt
prg.outputreg prg.outputreg
(helper prg (CodeMap.find "main" prg.code) "main").registers (aux prg (CodeMap.find "main" prg.code) "main").registers
with with
Some x -> x Some x -> x
| None -> failwith "Output register not found" | 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) -> ( Main (vin, vout, expression) -> (
let mem : memory = let mem : memory =
{ assignments = (VariableMap.empty |> VariableMap.add vin iin) } in { assignments = (VariableMap.empty |> VariableMap.add vin iin) } in
let* resultmem : memory = evaluate mem expression in let* result_mem : memory = evaluate mem expression in
match VariableMap.find_opt vout resultmem.assignments with match VariableMap.find_opt vout result_mem.assignments with
| None -> | None ->
Error (`AbsentAssignment Error (`AbsentAssignment
("The output variable is not defined (" ^ vout ^ ")")) ("The output variable is not defined (" ^ vout ^ ")"))

52
lib/miniImp/Types.mli
View File

@ -1,35 +1,37 @@
type variable = string type variable = string
type p_exp = 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 = and c_exp =
Skip Skip
| Assignment of variable * a_exp (* x := a *) | Assignment of variable * a_exp (* x := a *)
| Sequence of c_exp * c_exp (* c; c *) | Sequence of c_exp * c_exp (* c; c *)
| If of b_exp * c_exp * c_exp (* if b then c else 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 *) | 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 *) | For of c_exp * b_exp * c_exp * c_exp
(* for (c; b; c) do c *)
and b_exp = and b_exp =
Boolean of bool (* v *) Boolean of bool (* v *)
| BAnd of b_exp * b_exp (* b && b *) | BAnd of b_exp * b_exp (* b && b *)
| BOr of b_exp * b_exp (* b || b *) | BOr of b_exp * b_exp (* b || b *)
| BNot of b_exp (* not b *) | BNot of b_exp (* not b *)
| BCmp of a_exp * a_exp (* a == a *) | BCmp of a_exp * a_exp (* a == a *)
| BCmpLess of a_exp * a_exp (* a < a *) | BCmpLess of a_exp * a_exp (* a < a *)
| BCmpLessEq of a_exp * a_exp (* a <= a *) | BCmpLessEq of a_exp * a_exp (* a <= a *)
| BCmpGreater of a_exp * a_exp (* a > a *) | BCmpGreater of a_exp * a_exp (* a > a *)
| BCmpGreaterEq of a_exp * a_exp (* a >= a *) | BCmpGreaterEq of a_exp * a_exp (* a >= a *)
and a_exp = and a_exp =
Variable of variable (* x *) Variable of variable (* x *)
| Integer of int (* n *) | Integer of int (* n *)
| Plus of a_exp * a_exp (* a + a *) | Plus of a_exp * a_exp (* a + a *)
| Minus of a_exp * a_exp (* a - a *) | Minus of a_exp * a_exp (* a - a *)
| Times of a_exp * a_exp (* a * a *) | Times of a_exp * a_exp (* a * a *)
| Division of a_exp * a_exp (* a / a *) | Division of a_exp * a_exp (* a / a *)
| Modulo of a_exp * a_exp (* a % a *) | Modulo of a_exp * a_exp (* a % a *)
| Power 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 *) | PowerMod of a_exp * a_exp * a_exp (* a ^ a % a *)
| Rand of a_exp (* rand(0, a) *) | Rand of a_exp (* rand(0, a) *)
val pp_p_exp : Format.formatter -> p_exp -> unit 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 = let pp (ppf: out_channel) (v: t) : unit =
Printf.fprintf ppf "%s" v 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 List.iter (Printf.fprintf ppf "%s, ") vv
let compare a b = let compare a b =
@ -19,7 +19,7 @@ module DVCeltSet = Set.Make(Variable)
let variables (instr : DVCfg.elt) : DVCfg.internal list = 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 match instr with
| Nop -> | Nop ->
acc acc
@ -37,7 +37,7 @@ let variables (instr : DVCfg.elt) : DVCfg.internal list =
DVCeltSet.add r3.index acc DVCeltSet.add r3.index acc
in 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 = let variables_all (instructions : DVCfg.elt list) : DVCfg.internal list =
List.fold_left (fun (acc: DVCeltSet.t) (instr: DVCfg.elt) -> 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 ) DVCeltSet.empty instructions |> DVCeltSet.to_list
let variables_used (instr : DVCfg.elt) : DVCfg.internal 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 match instr with
| Nop | Nop
| LoadI (_, _) -> | LoadI (_, _) ->
@ -60,7 +60,7 @@ let variables_used (instr : DVCfg.elt) : DVCfg.internal list =
DVCeltSet.add r1.index acc DVCeltSet.add r1.index acc
in 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 = let variables_used_all (instructions : DVCfg.elt list) : DVCfg.internal list =
List.fold_left (fun (acc: DVCeltSet.t) (instr: DVCfg.elt) -> 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 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 match instr with
| Nop | Nop
| Store (_, _) -> acc | Store (_, _) -> acc
@ -81,116 +81,118 @@ let variables_defined (instructions : DVCfg.elt) : DVCfg.internal list =
DVCeltSet.add r3.index acc DVCeltSet.add r3.index acc
in in
helper DVCeltSet.empty instructions |> DVCeltSet.to_list aux DVCeltSet.empty instructions |> DVCeltSet.to_list
(* init function, assign the bottom to everything *) (* init function, assign the bottom to everything *)
let _init_bottom : (DVCfg.elt list -> DVCfg.internalnode) = let _init_bottom : (DVCfg.elt list -> DVCfg.internal_node) =
(fun l -> {internalin = []; (fun l -> {internal_in = [];
internalout = []; internal_out = [];
internalbetween = (List.init (List.length l) (fun _ -> ([], [])))}) internal_between = (List.init (List.length l) (fun _ -> ([], [])))}
)
(* init function, assign the top to everything *) (* init function, assign the top to everything *)
let init_top (all_variables) : (DVCfg.elt list -> DVCfg.internalnode) = let init_top (all_variables) : (DVCfg.elt list -> DVCfg.internal_node) =
(fun l -> {internalin = all_variables; (fun l -> {internal_in = all_variables;
internalout = all_variables; internal_out = all_variables;
internalbetween = (List.init (List.length l) internal_between = (List.init (List.length l)
(fun _ -> (all_variables, all_variables)))}) (fun _ -> (all_variables, all_variables)))})
let lub (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode = let lub (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internal_node =
let previnternalvar = Cfg.NodeMap.find node t.internalvar in let prev_internal_var = Cfg.NodeMap.find node t.internal_var in
let code = match Cfg.NodeMap.find_opt node t.t.content with let code = match Cfg.NodeMap.find_opt node t.t.content with
None -> [] None -> []
| Some c -> c | Some c -> c
in in
let newinternalbetween = ( let new_internal_between = (
List.map List.map
(fun (code, (i, _o)) -> (fun (code, (i, _o)) ->
(i, Utility.unique_union i (variables_defined code))) (i, Utility.unique_union i (variables_defined code)))
(List.combine code previnternalvar.internalbetween) (List.combine code prev_internal_var.internal_between)
) in ) in
let newinternalout = let new_internal_out =
match newinternalbetween with 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 newinternalout
in in
{ previnternalvar with { prev_internal_var with
internalbetween = newinternalbetween; internal_between = new_internal_between;
internalout = newinternalout } internal_out = new_internal_out }
let lucf (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode = let lucf (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internal_node =
let previnternalvar = Cfg.NodeMap.find node t.internalvar in let prev_internal_var = Cfg.NodeMap.find node t.internal_var in
if Option.equal (=) (Some node) t.t.initial then if Option.equal (=) (Some node) t.t.initial then
(* if L is initial set dvin to the "in" register *) (* if L is initial set dvin to the "in" register *)
let newinternalin = ( let new_internal_in = (
match t.t.inputOutputVar with match t.t.input_output_var with
Some (i, _) -> [i] Some (i, _) -> [i]
| None -> [] | None -> []
) in ) in
let newinternalbetween = ( (* set the dvin of each to the previous dvout *) let new_internal_between = (
match previnternalvar.internalbetween with (* 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 -> | (_i, o) :: btwrest ->
(newinternalin, o) :: ( (new_internal_in, o) :: (
List.map (fun ((_i, o), (_previ, prevo)) -> (prevo, 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 ) in
{ previnternalvar with { prev_internal_var with
internalin = newinternalin; internal_in = new_internal_in;
internalbetween = newinternalbetween } internal_between = new_internal_between }
else else
(* if L is not initial set dvin to the intersection of the previous node's (* if L is not initial set dvin to the intersection of the previous node's
dvouts *) dvouts *)
let prevnodes = Cfg.NodeMap.find node t.t.reverseEdges in let prev_nodes = Cfg.NodeMap.find node t.t.reverse_edges in
let newinternalin = ( let new_internal_in = (
match prevnodes with match prev_nodes with
| [] -> | [] ->
[] []
| [prevnode] -> | [prevnode] ->
(Cfg.NodeMap.find prevnode t.internalvar).internalout (Cfg.NodeMap.find prevnode t.internal_var).internal_out
| [prevnode1; prevnode2] -> | [prevnode1; prevnode2] ->
Utility.unique_intersection Utility.unique_intersection
(Cfg.NodeMap.find prevnode1 t.internalvar).internalout (Cfg.NodeMap.find prevnode1 t.internal_var).internal_out
(Cfg.NodeMap.find prevnode2 t.internalvar).internalout (Cfg.NodeMap.find prevnode2 t.internal_var).internal_out
| prevnode :: restnodes -> | prevnode :: restnodes ->
List.fold_left (* intersection of all previous nodes' dvout *) List.fold_left (* intersection of all previous nodes' dvout *)
(fun acc prevnode -> (fun acc prevnode ->
Utility.unique_intersection Utility.unique_intersection
acc acc
(Cfg.NodeMap.find prevnode t.internalvar).internalout) (Cfg.NodeMap.find prevnode t.internal_var).internal_out)
(Cfg.NodeMap.find prevnode t.internalvar).internalout (Cfg.NodeMap.find prevnode t.internal_var).internal_out
restnodes restnodes
) in ) in
let newinternalbetween = let new_internal_between =
match previnternalvar.internalbetween with match prev_internal_var.internal_between with
[] -> [] [] -> []
| [(_i, o)] -> [(newinternalin, o)] | [(_i, o)] -> [(new_internal_in, o)]
| (_i, o) :: btwrest -> | (_i, o) :: btwrest ->
(newinternalin, o) :: ( (new_internal_in, o) :: (
List.map (fun ((_i, o), (_previ, prevo)) -> (prevo, 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 in
{ previnternalvar with { prev_internal_var with
internalin = newinternalin; internal_in = new_internal_in;
internalbetween = newinternalbetween } 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 = 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 in
lub newt node lub newt node
@ -204,7 +206,7 @@ let compute_defined_variables (cfg: RISCCfg.t) : DVCfg.t =
(Cfg.NodeMap.to_list cfg.content) (Cfg.NodeMap.to_list cfg.content)
in in
let all_variables = let all_variables =
match cfg.inputOutputVar with match cfg.input_output_var with
| None -> all_variables | None -> all_variables
| Some (i, o) -> Utility.unique_union all_variables [i;o] | Some (i, o) -> Utility.unique_union all_variables [i;o]
in 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 = let check_undefined_variables (dvcfg: DVCfg.t) : Variable.t list option =
(* returns all undefined variables previously computed *) (* 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 let code = match Cfg.NodeMap.find_opt node dvcfg.t.content with
None -> [] None -> []
| Some c -> c | Some c -> c
in 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 vua = variables_used_all code in
let outvar = let outvar =
match (Option.equal (=) (Some node) dvcfg.t.terminal, match (Option.equal (=) (Some node) dvcfg.t.terminal,
dvcfg.t.inputOutputVar, dvcfg.t.input_output_var,
internalvar.internalout) with internal_var.internal_out) with
| (true, Some (_, outvar), vout) -> | (true, Some (_, outvar), vout) ->
if List.mem outvar vout if List.mem outvar vout
then None then None
@ -235,18 +237,18 @@ let check_undefined_variables (dvcfg: DVCfg.t) : Variable.t list option =
None None
in in
if Utility.inclusion vua (internalvar.internalin) then if Utility.inclusion vua (internal_var.internal_in) then
match outvar with None -> None match outvar with None -> None
| Some outvar -> Some [outvar] | Some outvar -> Some [outvar]
else else
(* the variable might be defined inside the block, so check all vin and (* the variable might be defined inside the block, so check all vin and
return true only if all variables are properly defined *) 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 let undef_vars = List.fold_left
(fun acc (codevars, (vin, _vout)) -> (fun acc (codevars, (vin, _vout)) ->
(Utility.subtraction codevars vin) @ acc) (Utility.subtraction codevars vin) @ acc)
[] []
(List.combine vuabetween internalvar.internalbetween) (List.combine vua_between internal_var.internal_between)
in in
match outvar, undef_vars with match outvar, undef_vars with
None, [] -> None 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) | Some outvar, undef_vars -> Some (outvar :: undef_vars)
in in
Cfg.NodeSet.fold (fun node acc -> Cfg.NodeSet.fold (fun node acc ->
match acc, (helper node dvcfg) with match acc, (aux node dvcfg) with
None, None -> None None, None -> None
| None, Some x -> Some x | None, Some x -> Some x
| Some acc, None -> Some acc | Some acc, None -> Some acc

2
lib/miniImp/definedVariables.mli
View File

@ -3,7 +3,7 @@ open Analysis
module Variable : sig module Variable : sig
type t type t
val pp : out_channel -> t -> unit val pp : out_channel -> t -> unit
val pplist : out_channel -> t list -> unit val pp_list : out_channel -> t list -> unit
end end
module RISCCfg = CfgRISC.RISCCfg 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 = let pp (ppf: out_channel) (v: t) : unit =
Printf.fprintf ppf "%s" v 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 List.iter (Printf.fprintf ppf "%s, ") vv
let compare a b = let compare a b =
@ -21,7 +21,7 @@ module DVCeltSet = Set.Make(Variable)
let variables_used (instr : DVCfg.elt) let variables_used (instr : DVCfg.elt)
: DVCfg.internal list = : DVCfg.internal list =
let helper (acc: DVCeltSet.t) (instr: DVCfg.elt) = let aux (acc: DVCeltSet.t) (instr: DVCfg.elt) =
match instr with match instr with
| Nop | Nop
| LoadI (_, _) -> | LoadI (_, _) ->
@ -36,10 +36,10 @@ let variables_used (instr : DVCfg.elt)
DVCeltSet.add r1.index acc DVCeltSet.add r1.index acc
in 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 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 match instr with
| Nop | Nop
| Store (_, _) -> acc | Store (_, _) -> acc
@ -51,10 +51,10 @@ let variables_defined (instructions : DVCfg.elt) : DVCfg.internal list =
DVCeltSet.add r3.index acc DVCeltSet.add r3.index acc
in in
helper DVCeltSet.empty instructions |> DVCeltSet.to_list aux DVCeltSet.empty instructions |> DVCeltSet.to_list
let variables (instruction : DVCfg.elt) : DVCfg.internal 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 match instr with
| Nop -> acc | Nop -> acc
| Store (r1, r2) -> | Store (r1, r2) ->
@ -73,7 +73,7 @@ let variables (instruction : DVCfg.elt) : DVCfg.internal list =
DVCeltSet.add r3.index acc DVCeltSet.add r3.index acc
in 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 = let variables_all (instructions : DVCfg.elt list) : DVCfg.internal list =
List.fold_left (fun (acc: DVCeltSet.t) (instr: DVCfg.elt) -> 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 ) DVCeltSet.empty instructions |> DVCeltSet.to_list
(* init function, assign the bottom to everything *) (* init function, assign the bottom to everything *)
let init : (DVCfg.elt list -> DVCfg.internalnode) = let init : (DVCfg.elt list -> DVCfg.internal_node) =
(fun l -> {internalin = []; (fun l -> {internal_in = [];
internalout = []; internal_out = [];
internalbetween = (List.init (List.length l) (fun _ -> ([], [])))}) internal_between = (List.init (List.length l) (fun _ -> ([], [])))}
)
let lub (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode = let lub (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internal_node =
let previnternalvar = Cfg.NodeMap.find node t.internalvar in let prev_internal_var = Cfg.NodeMap.find node t.internal_var in
let code = match Cfg.NodeMap.find_opt node t.t.content with let code = match Cfg.NodeMap.find_opt node t.t.content with
None -> [] None -> []
| Some c -> c | Some c -> c
in in
let newinternalbetween = ( let new_internal_between = (
List.map List.map
(fun (code, (_i, o)) -> (fun (code, (_i, o)) ->
(Utility.unique_union (Utility.unique_union
(variables_used code) (variables_used code)
(Utility.subtraction o (variables_defined code)), o)) (Utility.subtraction o (variables_defined code)), o))
(Utility.combine_twice code previnternalvar.internalbetween) (Utility.combine_twice code prev_internal_var.internal_between)
) in ) in
let newinternalin = let new_internal_in =
match newinternalbetween with match new_internal_between with
| [] -> previnternalvar.internalout | [] -> prev_internal_var.internal_out
| (i, _)::_ -> i | (i, _)::_ -> i
in in
{ previnternalvar with { prev_internal_var with
internalbetween = newinternalbetween; internal_between = new_internal_between;
internalin = newinternalin; } internal_in = new_internal_in; }
let lucf (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode = let lucf (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internal_node =
let previnternalvar = Cfg.NodeMap.find node t.internalvar in let prev_internal_var = Cfg.NodeMap.find node t.internal_var in
let newinternalout = ( let newinternalout = (
if Option.equal (=) (Some node) t.t.terminal then ( if Option.equal (=) (Some node) t.t.terminal then (
match t.t.inputOutputVar with match t.t.input_output_var with
Some (_, o) -> [o] Some (_, o) -> [o]
| None -> [] | None -> []
) else ( ) else (
@ -125,35 +126,35 @@ let lucf (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode =
match nextnodes with match nextnodes with
| None -> [] | None -> []
| Some (node, None) -> | Some (node, None) ->
(Cfg.NodeMap.find node t.internalvar).internalin (Cfg.NodeMap.find node t.internal_var).internal_in
| Some (node1, Some node2) -> | Some (node1, Some node2) ->
Utility.unique_union Utility.unique_union
(Cfg.NodeMap.find node1 t.internalvar).internalin (Cfg.NodeMap.find node1 t.internal_var).internal_in
(Cfg.NodeMap.find node2 t.internalvar).internalin (Cfg.NodeMap.find node2 t.internal_var).internal_in
) )
) in ) in
let newinternalbetween = ( let new_internal_between = (
match List.rev previnternalvar.internalbetween with match List.rev prev_internal_var.internal_between with
| [] -> [] | [] -> []
| (i, _o) :: btwrest -> | (i, _o) :: btwrest ->
let btwrest = List.rev btwrest in let btwrest = List.rev btwrest in
let newbtwrest = List.map2 let newbtwrest = List.map2
(fun (i, _o) (nexti, _nexto) -> (i, nexti)) (fun (i, _o) (nexti, _nexto) -> (i, nexti))
btwrest btwrest
(Utility.drop_first_element_list previnternalvar.internalbetween) (Utility.drop_first_element_list prev_internal_var.internal_between)
in in
newbtwrest @ [(i, newinternalout)] newbtwrest @ [(i, newinternalout)]
) in ) in
{ previnternalvar with { prev_internal_var with
internalout = newinternalout; internal_out = newinternalout;
internalbetween = newinternalbetween; } 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 let newt = {t with internal_var = (Cfg.NodeMap.add node
(lucf t node) (lucf t node)
t.internalvar)} in t.internal_var)} in
lub newt node lub newt node
@ -244,38 +245,38 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
(t: DVCfg.t) (t: DVCfg.t)
(node: Cfg.Node.t) (node: Cfg.Node.t)
: (Variable.t VariableMap.t * DVCfg.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 = let code =
match Cfg.NodeMap.find_opt node t.t.content with match Cfg.NodeMap.find_opt node t.t.content with
| None -> [] | None -> []
| Some x -> x | Some x -> x
in in
let newcode, newassignments = let new_code, new_assignments =
(List.fold_left2 (List.fold_left2
(fun (acc, assignments) btw code -> (fun (acc, assignments) btw code ->
let na, nc = replace_code btw assignments code in let na, nc = replace_code btw assignments code in
(acc @ [nc], na) (acc @ [nc], na)
) )
([], assignments) ([], assignments)
livevars.internalbetween livevars.internal_between
code) code)
in in
let newcontent = Cfg.NodeMap.add let newcontent = Cfg.NodeMap.add
node node
newcode new_code
t.t.content t.t.content
in in
let newt = { t with t = { t.t with content = newcontent } } in let newt = { t with t = { t.t with content = newcontent } } in
(newassignments, newt) (new_assignments, newt)
in in
(* ------------------- *) (* ------------------- *)
(* at least the input variable should be in the mapping *) (* at least the input variable should be in the mapping *)
let assignments = let assignments =
match t.t.inputOutputVar with match t.t.input_output_var with
None -> VariableMap.empty None -> VariableMap.empty
| Some (i, _o) -> ( | Some (i, _o) -> (
VariableMap.get_or_set_mapping VariableMap.empty [] i |> fst 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 *) (* union of all in and out such that v is in the set *)
let union : 'a list = let union : 'a list =
List.fold_left 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 (* not interested in internalin or internalout since information
is mirrored into internalbetween *) is mirrored into internalbetween *)
List.fold_left2 List.fold_left2
@ -315,12 +316,12 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
(Utility.unique_union i o) acc (Utility.unique_union i o) acc
) )
acc acc
x.internalbetween x.internal_between
(Cfg.NodeMap.find_opt node t.t.content |> (Cfg.NodeMap.find_opt node t.t.content |>
Option.value ~default:[]) Option.value ~default:[])
) )
[] []
(Cfg.NodeMap.to_list t.internalvar) (Cfg.NodeMap.to_list t.internal_var)
in in
let assignments, _ = let assignments, _ =
VariableMap.get_or_set_mapping assignments union v in VariableMap.get_or_set_mapping assignments union v in
@ -338,8 +339,8 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
{ newt with { newt with
t = { newt.t with t = { newt.t with
inputOutputVar = input_output_var =
match newt.t.inputOutputVar with match newt.t.input_output_var with
None -> None None -> None
| Some (i, o) -> ( | Some (i, o) -> (
match VariableMap.find_opt i mapping, 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)) let add_one = (fun x -> match x with None -> Some 1 | Some x -> Some (x + 1))
in 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 match instr with
| Nop -> | Nop ->
acc acc
@ -39,7 +39,7 @@ let variables_frequency (instr : RISCCfg.elt) : (Variable.t * int) list =
VariableMap.update r3.index add_one acc VariableMap.update r3.index add_one acc
in in
helper VariableMap.empty instr |> VariableMap.to_list aux VariableMap.empty instr |> VariableMap.to_list
(* computes syntactic frequency of all variables in the code *) (* computes syntactic frequency of all variables in the code *)
let variables_all_frequency (instructions : RISCCfg.elt list) 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 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 ( (if n < 4 then (
failwith "ReduceRegisters: number of registers too small" failwith "ReduceRegisters: number of registers too small"
) else ()); ) else ());
@ -68,7 +68,7 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
(* add one to in and out variables *) (* add one to in and out variables *)
let all_variables = let all_variables =
match cfg.inputOutputVar with match cfg.input_output_var with
| None -> all_variables | None -> all_variables
| Some (i, _o) -> ( | Some (i, _o) -> (
match List.assoc_opt i all_variables with match List.assoc_opt i all_variables with
@ -78,7 +78,7 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
in in
let all_variables = let all_variables =
match cfg.inputOutputVar with match cfg.input_output_var with
| None -> all_variables | None -> all_variables
| Some (_i, o) -> ( | Some (_i, o) -> (
match List.assoc_opt o all_variables with 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 (* replace each operation with a list of operations that have the new
registers or load from memory *) registers or load from memory *)
let replaceregisters let replace_registers
(remappedregisters: Variable.t VariableMap.t) (remappedregisters: Variable.t VariableMap.t)
(memorymap: int VariableMap.t) (memorymap: int VariableMap.t)
(temporaryregisters: Variable.t list) (temporaryregisters: Variable.t list)
@ -315,7 +315,7 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
cfg with cfg with
content = Cfg.NodeMap.map content = Cfg.NodeMap.map
( fun x -> ( fun x ->
replaceregisters replace_registers
most_frequent_mapping most_frequent_mapping
least_frequent_mapping least_frequent_mapping
["1"; "2"] ["1"; "2"]
@ -323,10 +323,10 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
) cfg.content} ) cfg.content}
in in
if newcfg.inputOutputVar = None if newcfg.input_output_var = None
then newcfg (* if no input or output variables we ignore *) then newcfg (* if no input or output variables we ignore *)
else 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, match (VariableMap.find_opt i most_frequent_mapping,
VariableMap.find_opt o most_frequent_mapping, VariableMap.find_opt o most_frequent_mapping,
VariableMap.find_opt i least_frequent_mapping, VariableMap.find_opt i least_frequent_mapping,
@ -335,15 +335,15 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
newcfg.terminal ) newcfg.terminal )
with (*we check if in and out are simply remapped or are put in memory*) with (*we check if in and out are simply remapped or are put in memory*)
| Some i, Some o, _, _, _, _ -> | Some i, Some o, _, _, _, _ ->
{ newcfg with inputOutputVar = Some (i, o) } { newcfg with input_output_var = Some (i, o) }
| Some i, None, _, Some _, _, None -> | Some i, None, _, Some _, _, None ->
(* we check for the terminal node, if not present we are very confused (* we check for the terminal node, if not present we are very confused
and dont modify the out variable *) 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 -> | Some i, None, _, Some mo, _, Some n ->
(* since the output simbol is in memory we need to first retrive it (* since the output simbol is in memory we need to first retrive it
and then put the result in a temporary register *) and then put the result in a temporary register *)
let terminalcontent = ( let terminal_content = (
match Cfg.NodeMap.find_opt n newcfg.content with match Cfg.NodeMap.find_opt n newcfg.content with
| None -> [] | None -> []
| Some x -> x | Some x -> x
@ -351,14 +351,14 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
Load ({index = "2"}, {index = "2"})] Load ({index = "2"}, {index = "2"})]
in in
let content = let content =
Cfg.NodeMap.add n terminalcontent newcfg.content Cfg.NodeMap.add n terminal_content newcfg.content
in in
{ newcfg with { newcfg with
inputOutputVar = Some (i, "2"); input_output_var = Some (i, "2");
content = content content = content
} }
| None, Some o, Some _, _, _, None -> | 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 -> ( | None, Some o, Some mi, _, _, Some n -> (
(* the input simbol should be stored in memory *) (* the input simbol should be stored in memory *)
let initialcontent = let initialcontent =
@ -371,12 +371,12 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
in in
let content = Cfg.NodeMap.add n initialcontent newcfg.content in let content = Cfg.NodeMap.add n initialcontent newcfg.content in
{ newcfg with { newcfg with
inputOutputVar = Some ("1", o); input_output_var = Some ("1", o);
content = content content = content
} }
) )
| None, None, Some _, Some _, None, None -> | 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 -> | None, None, Some _, Some mo, None, Some n ->
(* both simbols should be in memory *) (* both simbols should be in memory *)
let terminalcontent = ( let terminalcontent = (
@ -390,7 +390,7 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
Cfg.NodeMap.add n terminalcontent newcfg.content Cfg.NodeMap.add n terminalcontent newcfg.content
in in
{ newcfg with { newcfg with
inputOutputVar = Some (i, "2"); input_output_var = Some (i, "2");
content = content content = content
} }
| None, None, Some mi, Some _, Some n, None -> | None, None, Some mi, Some _, Some n, None ->
@ -405,7 +405,7 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
in in
let content = Cfg.NodeMap.add n initialcontent newcfg.content in let content = Cfg.NodeMap.add n initialcontent newcfg.content in
{ newcfg with { newcfg with
inputOutputVar = Some ("1", o); input_output_var = Some ("1", o);
content = content content = content
} }
| None, None, Some mi, Some mo, Some ni, Some no -> | 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 Cfg.NodeMap.add no terminalcontent content
in in
{ newcfg with { newcfg with
inputOutputVar = Some ("1", "2"); input_output_var = Some ("1", "2");
content = content content = content
} }
| _ -> failwith ("ReduceRegisters: fail to partition a set, some" ^ | _ -> failwith ("ReduceRegisters: fail to partition a set, some" ^

2
lib/miniImp/reduceRegisters.mli
View File

@ -1,3 +1,3 @@
module RISCCfg = CfgRISC.RISCCfg 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.compute_live_variables |>
LiveVariables.optimize_cfg |> LiveVariables.optimize_cfg |>
LiveVariables.compute_cfg |> LiveVariables.compute_cfg |>
ReduceRegisters.reduceregisters 4 |> ReduceRegisters.reduce_registers 4 |>
RISC.convert |> RISC.convert |>
RISCSemantics.reduce RISCSemantics.reduce