Fixing live analysis

lib/miniImp/CfgRISC.ml

@@ -755,10 +755,15 @@ let convert (prg: CfgImp.SSCfg.t) : RISCCfg.t =
   } ->
   let initial_bindings =
     match inputOutputVar with
-    | Some (i, o) ->
+    | Some (i, o) -> (
+        if i = o then
+          RegisterMap.empty |>
+          RegisterMap.set_register i {index = "in"}
+        else
           RegisterMap.empty |>
           RegisterMap.set_register i {index = "in"} |>
           RegisterMap.set_register o {index = "out"}
+      )
     | None ->
       RegisterMap.empty
   in
@@ -767,7 +772,16 @@ let convert (prg: CfgImp.SSCfg.t) : RISCCfg.t =
     edges = edges;
     reverseEdges = reverseEdges;
     inputVal = inputVal;
-    inputOutputVar = Some ("in", "out");
+    inputOutputVar = (
+      match inputOutputVar with
+      | Some (i, o) -> (
+          if i = o then
+            Some ("in", "in")
+          else
+            Some ("in", "out")
+        )
+      | None -> Some ("in", "out")
+    );
     initial = initial;
     terminal = terminal;
     content = helper content initial_bindings;

lib/miniImp/liveVariables.ml

@@ -18,7 +18,9 @@ module DVCfg = Dataflow.Make (CfgRISC.RISCSimpleStatements) (Variable)
 module DVCeltSet = Set.Make(Variable)
 
 
-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) =
     match instr with
     | Nop
@@ -51,6 +53,33 @@ let variables_defined (instructions : DVCfg.elt) : DVCfg.internal list =
 
   helper DVCeltSet.empty instructions |> DVCeltSet.to_list
 
+let variables (instruction : DVCfg.elt) : DVCfg.internal list =
+  let helper (acc: DVCeltSet.t) (instr: DVCfg.elt) =
+    match instr with
+    | Nop -> acc
+    | Store (r1, r2) ->
+      DVCeltSet.add r1.index acc |>
+      DVCeltSet.add r2.index
+    | BRegOp (_, r1, r2, r3) ->
+      DVCeltSet.add r1.index acc |>
+      DVCeltSet.add r2.index |>
+      DVCeltSet.add r3.index
+    | BImmOp (_, r1, _, r3)
+    | URegOp (_, r1, r3)
+    | Load (r1, r3) ->
+      DVCeltSet.add r1.index acc |>
+      DVCeltSet.add r3.index
+    | LoadI (_, r3) ->
+      DVCeltSet.add r3.index acc
+  in
+
+  helper DVCeltSet.empty instruction |> DVCeltSet.to_list
+
+let variables_all (instructions : DVCfg.elt list) : DVCfg.internal list =
+  List.fold_left (fun (acc: DVCeltSet.t) (instr: DVCfg.elt) ->
+      DVCeltSet.union acc (variables 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 = [];
@@ -157,7 +186,7 @@ module VariableMap = struct
     let start = "1" in
     first_empty next start m l
 
-  let get_mapping m l r =
+  let get_or_set_mapping m l r =
     match find_opt r m with
     | None -> (
         let newr = first_empty_Variable m l in
@@ -179,33 +208,33 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
         (a, Nop)
       )
     | BRegOp (brop, r1, r2, r3) -> (
-        let (newa, newr1) = VariableMap.get_mapping a vin r1.index in
+        let (newa, newr1) = VariableMap.get_or_set_mapping a vin r1.index in
-        let (newa, newr2) = VariableMap.get_mapping newa vin r2.index in
+        let (newa, newr2) = VariableMap.get_or_set_mapping newa vin r2.index in
-        let (newa, newr3) = VariableMap.get_mapping newa vout r3.index in
+        let (newa, newr3) = VariableMap.get_or_set_mapping newa vout r3.index in
         (newa, BRegOp (brop, {index = newr1}, {index = newr2}, {index = newr3}))
       )
     | BImmOp (biop, r1, i, r3) -> (
-        let (newa, newr1) = VariableMap.get_mapping a vin r1.index in
+        let (newa, newr1) = VariableMap.get_or_set_mapping a vin r1.index in
-        let (newa, newr3) = VariableMap.get_mapping newa vout r3.index in
+        let (newa, newr3) = VariableMap.get_or_set_mapping newa vout r3.index in
         (newa, BImmOp (biop, {index = newr1}, i, {index = newr3}))
       )
     | URegOp (urop, r1, r3) -> (
-        let (newa, newr1) = VariableMap.get_mapping a vin r1.index in
+        let (newa, newr1) = VariableMap.get_or_set_mapping a vin r1.index in
-        let (newa, newr3) = VariableMap.get_mapping newa vout r3.index in
+        let (newa, newr3) = VariableMap.get_or_set_mapping newa vout r3.index in
         (newa, URegOp (urop, {index = newr1}, {index = newr3}))
       )
     | Load (r1, r3) -> (
-        let (newa, newr1) = VariableMap.get_mapping a vin r1.index in
+        let (newa, newr1) = VariableMap.get_or_set_mapping a vin r1.index in
-        let (newa, newr3) = VariableMap.get_mapping newa vout r3.index in
+        let (newa, newr3) = VariableMap.get_or_set_mapping newa vout r3.index in
         (newa, Load ({index = newr1}, {index = newr3}))
       )
     | LoadI (i, r3) -> (
-        let (newa, newr3) = VariableMap.get_mapping a vout r3.index in
+        let (newa, newr3) = VariableMap.get_or_set_mapping a vout r3.index in
         (newa, LoadI (i, {index = newr3}))
       )
     | Store (r1, r3) -> (
-        let (newa, newr1) = VariableMap.get_mapping a vin r1.index in
+        let (newa, newr1) = VariableMap.get_or_set_mapping a vin r1.index in
-        let (newa, newr3) = VariableMap.get_mapping newa vout r3.index in
+        let (newa, newr3) = VariableMap.get_or_set_mapping newa vout r3.index in
         (newa, Store ({index = newr1}, {index = newr3}))
       )
   in
@@ -228,6 +257,7 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
          livevars.internalbetween
          code)
     in
+
     let newcontent = Cfg.NodeMap.add
         node
         newcode
@@ -240,14 +270,65 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
 
   (* ------------------- *)
 
-  let assignments = VariableMap.empty in
+  (* at least the input variable should be in the mapping *)
+  let assignments =
+    match t.t.inputOutputVar with
+      None -> VariableMap.empty
+    | Some (i, _o) -> (
+        VariableMap.get_or_set_mapping VariableMap.empty [] i |> fst
+      )
+  in
 
-  let a, newt =
+  let all_variables = List.fold_left
+      (fun acc (_, code) ->
+         Utility.unique_union acc (variables_all code))
+      []
+      (Cfg.NodeMap.to_list t.t.content)
+  in
+
+  let mapping =
+    (* for each variable we get the union of all in and out that contains it
+       then we find a register such that it's not in conflict *)
+    List.fold_left (fun assignments v -> (
+          (* union of all in and out such that v is in the set *)
+          let union : 'a list =
+            List.fold_left
+              (fun (acc: 'a list) (node, (x: DVCfg.internalnode)) ->
+                (* not interested in internalin or internalout since information
+                   is mirrored into internalbetween *)
+                 List.fold_left2
+                   (fun acc (i, o) code ->
+                      (* we also consider the out set if we "use" v as a guard *)
+                      match List.mem v i,
+                            List.mem v o,
+                            List.mem v (variables_defined code) with
+                      | false, false, false -> acc
+                      | true, false, false -> Utility.unique_union i acc
+                      | false, false, true
+                      | false, true, _ -> Utility.unique_union o acc
+                      | true, false, true
+                      | true, true, _ -> Utility.unique_union
+                                           (Utility.unique_union i o) acc
+                  )
+                  acc
+                  x.internalbetween
+                  (Cfg.NodeMap.find_opt node t.t.content |>
+                   Option.value ~default:[])
+              )
+              []
+              (Cfg.NodeMap.to_list t.internalvar)
+          in
+          let assignments, _ = VariableMap.get_or_set_mapping assignments union v in
+          assignments
+        )) assignments all_variables
+  in
+
+  let mapping, newt =
     Cfg.NodeSet.fold (* for each node we replace all the variables with the
                         optimized ones *)
       (fun node (assign, t) -> aux assign t node)
       t.t.nodes
-      (assignments, t)
+      (mapping, t)
   in
 
   { newt with
@@ -256,7 +337,8 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
             match newt.t.inputOutputVar with
               None -> None
             | Some (i, o) -> (
-                match VariableMap.find_opt i a, VariableMap.find_opt o a with
+                match VariableMap.find_opt i mapping,
+                      VariableMap.find_opt o mapping with
                 | None, None -> Some (i, o)
                 | Some i, None -> Some (i, o)
                 | None, Some o -> Some (i, o)

report/document.tex

@@ -68,7 +68,7 @@
 \usepackage{pgfornament} %% ornaments
 
 %% load last
-\usepackage[hidelinks]{hyperref} %% links for table of contents, load last
+\usepackage{hyperref} %% links for table of contents, load last
 \usepackage{bookmark} %% for better table of contents
 
 

report/report.tex

@@ -23,8 +23,8 @@
       \alt{} <a> `\%' <a> | <a> `^' <a> | `powmod' `(' <a> `,' <a> `,' <a> `)' | `rand' `(' <a> `)'
     \end{grammar}
 
-    Where \texttt{\%} is the modulo operator and \texttt{a  a \% a} is the powermod operator;
+    Where \texttt{\%} is the modulo operator and the powmod operator is equivalent to \texttt{a \^{} a \% a};
-    the variables are all integers, \texttt{n} is an integer and \texttt{v} is a boolean litteral.
+    the variables are all integers, \texttt{n} is an integer and \texttt{v} is a boolean literal.
 
     The additional arithmetic expressions' semantics are implemented in a similar manner as with the other.
 
@@ -47,7 +47,8 @@
     A program \texttt{t} is defined as follows:
     \begin{grammar}
       <t> \(\defeq\) <n> | <v> | <x> | `(' <t> `,' <t> `)'
-      \alt{} `fun' <x> `:' <type> `=>' <t> | <t> <t> | <op\textsubscript{1}> <t> | <t> <op\textsubscript{2}> <t> % chktex 38
+      \alt{} `fun' <x> `:' <type> `=>' <t> | <t> <t> % chktex 38
+      \alt{} <op\(_1\)> <t> | <t> <op\(_2\)> <t>
       \alt{} `powmod' `(' <t> `,' <t> `,' <t> `)'
       \alt{} `rand' `(' <t> `)' |
       \alt{} `if' <t> `then' <t> `else' <t>

test/dune

@@ -10,6 +10,10 @@
  (name testingRISC)
  (libraries miniImp))
 
+(test
+ (name testingAnalysis)
+ (libraries miniImp))
+
 (test
  (name testingFun)
  (libraries miniFun))

test/testingAnalysis.expected

@@ -0,0 +1,8 @@
+Identity program: 1
+Factorial program: 3628800
+Hailstone sequence's lenght program: 351
+Sum multiples of 3 and 5 program: 35565945
+Rand program: true
+Fibonacci program: 4807526976
+Miller-Rabin primality test program 1: 0
+Miller-Rabin primality test program 2: 1

test/testingAnalysis.ml

@@ -0,0 +1,132 @@
+open MiniImp
+
+let compute x i =
+  Lexing.from_string x |>
+  Parser.prg Lexer.lex |>
+  CfgImp.convert_io i |>
+  CfgRISC.convert |>
+  LiveVariables.compute_live_variables |>
+  LiveVariables.optimize_cfg |>
+  LiveVariables.compute_cfg |>
+  ReduceRegisters.reduceregisters 4 |>
+  RISC.convert |>
+  RISCSemantics.reduce
+
+(* -------------------------------------------------------------------------- *)
+(* Identity program *)
+let program =
+  "def main with input a output b as b := a"
+;;
+
+Printf.printf "Identity program: ";
+Printf.printf "%d\n" (compute program 1)
+;;
+
+(* -------------------------------------------------------------------------- *)
+(* Factorial program *)
+let program =
+"def main with input a output b as
+  b := 1;
+  for (i := 1, i <= a, i := i + 1) do
+    b := b * i;
+"
+;;
+
+Printf.printf "Factorial program: ";
+Printf.printf "%d\n" (compute program 10)
+
+(* -------------------------------------------------------------------------- *)
+(* Hailstone sequence's lenght program *)
+let program =
+"def main with input a output b as
+  b := 1;
+  while not a == 1 do (
+    b :=  b + 1;
+    if ((a % 2) == 1) then a := 3 * a + 1 else a := a / 2
+  )
+"
+;;
+
+Printf.printf "Hailstone sequence's lenght program: ";
+Printf.printf "%d\n" (compute program 77031)
+
+(* -------------------------------------------------------------------------- *)
+(* Sum multiples of 3 and 5 program *)
+let program =
+"def main with input a output b as
+  b := 0;
+  for (i := 0, i <= a, i := i+1) do
+    if (i % 3 == 0 || i % 5 == 0) then b := b + i;
+                                   else skip;
+"
+;;
+
+Printf.printf "Sum multiples of 3 and 5 program: ";
+Printf.printf "%d\n" (compute program 12345)
+
+(* -------------------------------------------------------------------------- *)
+(* Rand program *)
+let program =
+  "def main with input a output b as b := rand(a)"
+;;
+
+Printf.printf "Rand program: ";
+Printf.printf "%b\n" ((compute program 10) < 10)
+
+(* -------------------------------------------------------------------------- *)
+(* Fibonacci program *)
+let program =
+"def main with input n output fnext as
+  fnow := 0;
+  fnext := 1;
+  while (n > 1) do (
+    tmp := fnow + fnext;
+    fnow := fnext;
+    fnext := tmp;
+    n := n - 1;
+  )
+"
+;;
+
+Printf.printf "Fibonacci program: ";
+Printf.printf "%d\n" (compute program 48)
+
+(* -------------------------------------------------------------------------- *)
+(* Miller-Rabin primality test program *)
+let program =
+"def main with input n output result as
+  if (n % 2) == 0 then result := 1
+  else (
+
+    result := 0;
+    s := 0;
+    while (0 == ((n - 1) / (2 ^ s)) % 2) do (
+      s := s + 1
+    );
+    d := ((n - 1) / 2 ^ s);
+    for (i := 20, i > 0, i := i - 1) do (
+      a := rand(n - 4) + 2;
+      x := powmod(a, d, n);
+      y := 0;
+      for (j := 0, j < s, j := j+1) do (
+        y := powmod(x, 2, n);
+        if (y == 1 && (not x == 1) && (not x == n - 1)) then
+          result := 1;
+        else
+          skip;
+        x := y;
+      );
+      if not y == 1 then result := 1;
+                    else skip;
+    )
+  )
+"
+;;
+
+(* should return 0 because prime *)
+Printf.printf "Miller-Rabin primality test program 1: ";
+Printf.printf "%d\n" (compute program 179424673);
+
+(* should return 1 because not prime *)
+Printf.printf "Miller-Rabin primality test program 2: ";
+Printf.printf "%d\n" (compute program 179424675);

test/testingImpParser.ml

@@ -134,6 +134,7 @@ let program =
     for (i := 20, i > 0, i := i - 1) do (
       a := rand(n - 4) + 2;
       x := powmod(a, d, n);
+      y := 0;
       for (j := 0, j < s, j := j+1) do (
         y := powmod(x, 2, n);
         if (y == 1 && (not x == 1) && (not x == n - 1)) then