Live Variables

bin/main.ml

@@ -5,12 +5,15 @@ let colorred s =
 
 let () =
   let program = "
-def main with input n output out as
+def main with input c output m as
-    for (x := 2, x < 0, x := 2) do (
+    a := 0;
-      y := x + 3;
+    b := a + 1;
-      x := y;
+    c := c + b;
-    );
+    a := b * 2;
-    out := 1 - y;
+    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:"); *)
-  Printf.printf "%s\n" (colorred "Undefined Variables are:");
+  (* List.iter (fun v -> Printf.printf "%a, " DefinedVariables.Variable.pp v) (DefinedVariables.check_undefined_variables analysiscfg); *)
-  List.iter (fun v -> Printf.printf "%a, " DefinedVariables.Variable.pp v)  (DefinedVariables.undefined_variables analysiscfg);
+  (* Printf.printf "\n"; *)
-  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
 
   (* ---------------------------------- *)
 

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 check_undefined_variables (dvcfg: DVCfg.t) : Variable.t list option =
-  let helper node (dvcfg: DVCfg.t) =
+  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
-    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 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 =

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 check_undefined_variables : DVCfg.t -> Variable.t list option
-
-val undefined_variables : DVCfg.t -> Variable.t list

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))
 

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

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

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

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