diff --git a/bin/main.ml b/bin/main.ml index 21c2600..03a8a0f 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -5,12 +5,15 @@ let colorred s = let () = let program = " -def main with input n output out as - for (x := 2, x < 0, x := 2) do ( - y := x + 3; - x := y; - ); - out := 1 - y; +def main with input c output m as + a := 0; + b := a + 1; + c := c + b; + a := b * 2; + if a < 3 then + c := 4 + else + c := 6 " in @@ -34,16 +37,22 @@ def main with input n output out as let analysiscfg = DefinedVariables.compute_defined_variables convertedrisccfg in - Printf.printf "%s\n%a" (colorred "Analysis CFG is") DefinedVariables.DVCfg.pp analysiscfg; + (* Printf.printf "%s\n%a" (colorred "Analysis CFG is") DefinedVariables.DVCfg.pp analysiscfg; *) - Printf.printf "%s%b\n" (colorred "Analysis CFG defined variables: ") (DefinedVariables.check_defined_variables analysiscfg); - Printf.printf "%s\n" (colorred "Undefined Variables are:"); - List.iter (fun v -> Printf.printf "%a, " DefinedVariables.Variable.pp v) (DefinedVariables.undefined_variables analysiscfg); - Printf.printf "\n"; + (* Printf.printf "%s\n" (colorred "Undefined Variables are:"); *) + (* List.iter (fun v -> Printf.printf "%a, " DefinedVariables.Variable.pp v) (DefinedVariables.check_undefined_variables analysiscfg); *) + (* Printf.printf "\n"; *) let convertedrisccfg = DefinedVariables.compute_cfg analysiscfg in - Printf.printf "%s\n%a" (colorred "Converted RISC after analysis CFG is") CfgRISC.RISCCfg.pp convertedrisccfg; + (* Printf.printf "%s\n%a" (colorred "Converted RISC after analysis CFG is") CfgRISC.RISCCfg.pp convertedrisccfg; *) + + + let analysiscfg = LiveVariables.compute_live_variables convertedrisccfg in + + Printf.printf "%s\n%a" (colorred "Analysis CFG is") LiveVariables.DVCfg.pp analysiscfg; + + let convertedrisccfg = LiveVariables.optimize_cfg analysiscfg |> LiveVariables.compute_cfg in (* ---------------------------------- *) diff --git a/lib/miniImp/definedVariables.ml b/lib/miniImp/definedVariables.ml index 0c2a86b..1b39ac5 100644 --- a/lib/miniImp/definedVariables.ml +++ b/lib/miniImp/definedVariables.ml @@ -207,46 +207,8 @@ let compute_defined_variables (cfg: RISCCfg.t) : DVCfg.t = -let check_defined_variables (dvcfg: DVCfg.t) : bool = - let helper node (dvcfg: DVCfg.t) = - 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 vua = variables_used_all code in - - let outvar = (* is true if we are in the last node and the out variable is - not in vout, so its true if the out variable is not - defined *) - match (Option.equal (=) (Some node) dvcfg.t.terminal, - dvcfg.t.inputOutputVar, - internalvar.internalout) with - | (true, Some (_, outvar), vout) -> - not (List.mem outvar vout) - | (_, _, _) -> - false - in - - if Utility.inclusion vua (internalvar.internalin) then - not 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 check = List.fold_left - (fun acc (codevars, (vin, _vout)) -> - acc && (Utility.inclusion codevars vin)) - true - (List.combine vuabetween internalvar.internalbetween) - in - check && (not outvar) - in - Cfg.NodeSet.fold (fun node acc -> acc && (helper node dvcfg)) dvcfg.t.nodes true - - -let undefined_variables (dvcfg: DVCfg.t) : Variable.t list = - let helper (node: Cfg.Node.t) (dvcfg: DVCfg.t) = +let check_undefined_variables (dvcfg: DVCfg.t) : Variable.t list option = + let helper (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 @@ -267,7 +229,8 @@ let undefined_variables (dvcfg: DVCfg.t) : Variable.t list = in if Utility.inclusion vua (internalvar.internalin) then - match outvar with None -> [] | Some outvar -> [outvar] + 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 *) @@ -278,9 +241,19 @@ let undefined_variables (dvcfg: DVCfg.t) : Variable.t list = [] (List.combine vuabetween internalvar.internalbetween) in - match outvar with None -> undef_vars | Some outvar -> outvar :: undef_vars + match outvar, undef_vars with + None, [] -> None + | None, undef_vars -> Some undef_vars + | Some outvar, [] -> Some [outvar] + | Some outvar, undef_vars -> Some (outvar :: undef_vars) in - Cfg.NodeSet.fold (fun node acc -> acc @ (helper node dvcfg)) dvcfg.t.nodes [] + Cfg.NodeSet.fold (fun node acc -> + match acc, (helper node dvcfg) with + None, None -> None + | None, Some x -> Some x + | Some acc, None -> Some acc + | Some acc, Some x -> Some (acc @ x) + ) dvcfg.t.nodes None let compute_cfg (dvcfg: DVCfg.t) : RISCCfg.t = diff --git a/lib/miniImp/definedVariables.mli b/lib/miniImp/definedVariables.mli index bbb1e7c..cc8e4ea 100644 --- a/lib/miniImp/definedVariables.mli +++ b/lib/miniImp/definedVariables.mli @@ -14,6 +14,4 @@ val compute_defined_variables : RISCCfg.t -> DVCfg.t val compute_cfg : DVCfg.t -> RISCCfg.t -val check_defined_variables : DVCfg.t -> bool - -val undefined_variables : DVCfg.t -> Variable.t list +val check_undefined_variables : DVCfg.t -> Variable.t list option diff --git a/lib/miniImp/dune b/lib/miniImp/dune index b7451ca..b3f830a 100644 --- a/lib/miniImp/dune +++ b/lib/miniImp/dune @@ -12,7 +12,7 @@ (public_name miniImp) (modules Lexer Parser Types Semantics CfgImp ReplacePowerMod - CfgRISC DefinedVariables + CfgRISC DefinedVariables LiveVariables RISC RISCSemantics) (libraries analysis utility menhirLib)) diff --git a/lib/miniImp/liveVariables.ml b/lib/miniImp/liveVariables.ml new file mode 100644 index 0000000..cc2b385 --- /dev/null +++ b/lib/miniImp/liveVariables.ml @@ -0,0 +1,145 @@ +open Analysis + +module Variable = struct + type t = string + let pp (ppf: out_channel) (v: t) : unit = + Printf.fprintf ppf "%s" v + + let pplist (ppf: out_channel) (vv: t list) : unit = + List.iter (Printf.fprintf ppf "%s, ") vv + + let compare a b = + String.compare a b +end + +module RISCCfg = CfgRISC.RISCCfg + +module DVCfg = Dataflow.Make (CfgRISC.RISCSimpleStatements) (Variable) +module DVCeltSet = Set.Make(Variable) + + +let variables_used (instr : DVCfg.elt) : DVCfg.internal list = + let helper (acc: DVCeltSet.t) (instr: DVCfg.elt) = + match instr with + | Nop + | LoadI (_, _) -> + acc + | BRegOp (_, r1, r2, _) -> + DVCeltSet.add r1.index acc |> + DVCeltSet.add r2.index + | BImmOp (_, r1, _, _) + | URegOp (_, r1, _) + | Load (r1, _) + | Store (r1, _) -> + DVCeltSet.add r1.index acc + in + + helper 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) -> + DVCeltSet.union acc (variables_used instr |> DVCeltSet.of_list) + ) DVCeltSet.empty instructions |> DVCeltSet.to_list + + +let variables_defined (instructions : DVCfg.elt) : DVCfg.internal list = + let helper (acc: DVCeltSet.t) (instr: DVCfg.elt) = + match instr with + | Nop -> acc + | BRegOp (_, _, _, r3) + | BImmOp (_, _, _, r3) + | URegOp (_, _, r3) + | Load (_, r3) + | LoadI (_, r3) + | Store (_, r3) -> + DVCeltSet.add r3.index acc + in + + helper DVCeltSet.empty instructions |> DVCeltSet.to_list + +let _variables_defined_all (instructions : DVCfg.elt list) : DVCfg.internal list = + List.fold_left (fun (acc: DVCeltSet.t) (instr: DVCfg.elt) -> + DVCeltSet.union acc (variables_defined instr |> DVCeltSet.of_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 lub (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode = + let previnternalvar = Cfg.NodeMap.find node t.internalvar in + let code = match Cfg.NodeMap.find_opt node t.t.content with + None -> [] + | Some c -> c + in + { previnternalvar with + internalbetween = + List.map (fun (prevbtw, code, nextprevbtw) -> + let newin = Utility.unique_union (variables_used code) + (Utility.subtraction (snd prevbtw) (variables_defined code)) + in + match nextprevbtw with + None -> (newin, snd prevbtw) + | Some (newout, _) -> (newin, newout) + ) + (Utility.combine_thrice previnternalvar.internalbetween code + (Utility.pad (List.tl previnternalvar.internalbetween) None (List.length previnternalvar.internalbetween))) + ; + internalin = fst (List.hd previnternalvar.internalbetween); + } + +let lucf (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode = + let previnternalvar = Cfg.NodeMap.find node t.internalvar in + if Option.equal (=) (Some node) t.t.terminal then + let outputvarlist = match t.t.inputOutputVar with + Some (_, o) -> [o] + | None -> [] + in + { previnternalvar with + internalout = outputvarlist; + internalbetween = ( + let last_elem = Utility.last_list previnternalvar.internalbetween in + (Utility.drop_last_element_list previnternalvar.internalbetween) @ + [(fst last_elem, outputvarlist)] + ) + } + else + let nextnodes = Cfg.NodeMap.find_opt node t.t.edges in + let newinternalout = match nextnodes with + None -> [] + | Some (node, None) -> (Cfg.NodeMap.find node t.internalvar).internalin + | Some (node1, Some node2) -> + Utility.unique_union + (Cfg.NodeMap.find node1 t.internalvar).internalin + (Cfg.NodeMap.find node2 t.internalvar).internalin + in + { previnternalvar with + internalout = newinternalout; + internalbetween = ( + let last_elem = Utility.last_list previnternalvar.internalbetween in + (Utility.drop_last_element_list previnternalvar.internalbetween) @ + [(fst last_elem, newinternalout)] + ) + } + +let update (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode = + let newt = {t with internalvar = (Cfg.NodeMap.add node (lucf t node) t.internalvar)} in + lub newt node + + +let compute_live_variables (cfg: RISCCfg.t) : DVCfg.t = + DVCfg.from_cfg cfg + |> DVCfg.fixed_point ~init:init ~update:update + + +(* just rename the registers that dont share live status *) +let optimize_cfg (t: DVCfg.t) : DVCfg.t = + t + + + +let compute_cfg (dvcfg: DVCfg.t) : RISCCfg.t = + DVCfg.to_cfg dvcfg diff --git a/lib/miniImp/liveVariables.mli b/lib/miniImp/liveVariables.mli new file mode 100644 index 0000000..86fb8f4 --- /dev/null +++ b/lib/miniImp/liveVariables.mli @@ -0,0 +1,18 @@ +open Analysis + +module Variable : sig + type t + val pp : out_channel -> t -> unit +end + +module RISCCfg = CfgRISC.RISCCfg + +module DVCfg : Dataflow.C with type elt = CfgRISC.RISCSimpleStatements.t + and type internal = Variable.t + + +val compute_live_variables : RISCCfg.t -> DVCfg.t + +val optimize_cfg : DVCfg.t -> DVCfg.t + +val compute_cfg : DVCfg.t -> RISCCfg.t diff --git a/lib/utility/utility.ml b/lib/utility/utility.ml index 758ba17..52cad39 100644 --- a/lib/utility/utility.ml +++ b/lib/utility/utility.ml @@ -101,6 +101,11 @@ let unique_intersection la lb = aux la lb [] |> unique +let drop_last_element_list = + function + | [] -> [] + | l -> l |> List.rev |> List.tl |> List.rev + (* Complicated way to drop the last element and add a new option element to the beginning *) let prev l a = @@ -108,7 +113,7 @@ let prev l a = | [] -> [a] | _ -> - a :: (List.map (fun x -> Some x) (l |> List.rev |> List.tl |> List.rev)) + a :: (List.map (fun x -> Some x) (drop_last_element_list l)) let pad l a n = let l = List.map (fun i -> Some i) l in diff --git a/lib/utility/utility.mli b/lib/utility/utility.mli index fe02ef8..9d77eee 100644 --- a/lib/utility/utility.mli +++ b/lib/utility/utility.mli @@ -19,6 +19,7 @@ val unique : 'a list -> 'a list val unique_union : 'a list -> 'a list -> 'a list val unique_intersection : 'a list -> 'a list -> 'a list +val drop_last_element_list : 'a list -> 'a list val prev : 'a list -> 'a option -> 'a option list val pad : 'a list -> 'a option -> int -> 'a option list