Fixes defined variables, fixes live variables, implements reduces registers, fixes risc semantic

bin/main.ml

@@ -5,15 +5,11 @@ let colorred s =
 
 let () =
   let program = "
-def main with input c output m as
+def main with input in output out as
-    a := 0;
+    out := in;
-    b := a + 1;
+    a := 1;
-    c := c + b;
+    b := 2;
-    a := b * 2;
+    c := a + a;
-    if a < 3 then
-       c := 4
-    else
-       c := 6
 "
   in
 
@@ -39,8 +35,12 @@ def main with input c output m as
 
   (* Printf.printf "%s\n%a" (colorred "Analysis CFG is") DefinedVariables.DVCfg.pp analysiscfg; *)
 
-  (* Printf.printf "%s\n" (colorred "Undefined Variables are:"); *)
+  (* Printf.printf "%s" (colorred "Undefined Variables are:"); *)
-  (* List.iter (fun v -> Printf.printf "%a, " DefinedVariables.Variable.pp v) (DefinedVariables.check_undefined_variables analysiscfg); *)
+  (* ( *)
+  (*   match DefinedVariables.check_undefined_variables analysiscfg with *)
+  (*   | None -> Printf.printf " none"; *)
+  (*   | Some l -> Printf.printf " %a" DefinedVariables.Variable.pplist l; *)
+  (* ); *)
   (* Printf.printf "\n"; *)
 
   let convertedrisccfg = DefinedVariables.compute_cfg analysiscfg in
@@ -48,20 +48,32 @@ def main with input c output m as
   (* Printf.printf "%s\n%a" (colorred "Converted RISC after analysis CFG is") CfgRISC.RISCCfg.pp convertedrisccfg; *)
 
 
-  let analysiscfg = LiveVariables.compute_live_variables convertedrisccfg in
+  (* let analysiscfg = LiveVariables.compute_live_variables convertedrisccfg in *)
 
-  Printf.printf "%s\n%a" (colorred "Analysis CFG is") LiveVariables.DVCfg.pp analysiscfg;
+  (* Printf.printf "%s\n%a" (colorred "Live Analysis CFG is") LiveVariables.DVCfg.pp analysiscfg; *)
+
+  (* let convertedrisccfg = LiveVariables.compute_cfg analysiscfg in *)
+
+  (* Printf.printf "%s\n%a" (colorred "Converted RISC with no analysis CFG is") CfgRISC.RISCCfg.pp convertedrisccfg; *)
+
+
+  (* let convertedrisccfg = LiveVariables.compute_cfg (LiveVariables.optimize_cfg analysiscfg) in *)
+
+  (* Printf.printf "%s\n%a" (colorred "Converted RISC after analysis CFG is") CfgRISC.RISCCfg.pp convertedrisccfg; *)
+
+  let convertedrisccfg = ReduceRegisters.reduceregisters 4 convertedrisccfg in
+
+  Printf.printf "%s\n%a" (colorred "Converted RISC after reducing registers CFG is") CfgRISC.RISCCfg.pp convertedrisccfg;
 
-  let convertedrisccfg = LiveVariables.optimize_cfg analysiscfg |> LiveVariables.compute_cfg in
 
   (* ---------------------------------- *)
 
-  let _risc = RISC.convert convertedrisccfg in
+  let risc = RISC.convert convertedrisccfg in
 
-  (* Printf.printf "%s\n%a" (colorred "RISC code is") RISC.RISCAssembly.pp risc; *)
+  Printf.printf "%s\n%a" (colorred "RISC code is") RISC.RISCAssembly.pp risc;
 
-  (* let computerisc = RISCSemantics.reduce risc in *)
+  let computerisc = RISCSemantics.reduce risc in
 
-  (* Printf.printf "%s\n%d\n" (colorred "Output of RISC code is") computerisc; *)
+  Printf.printf "%s\n%d\n" (colorred "Output of RISC code is") computerisc;
 
   ()

dune-project

@@ -12,7 +12,7 @@
 
 (package
  (name analysis)
- (depends ocaml dune))
+ (depends ocaml dune utility))
 
 (package
  (name miniImp)

lib/analysis/Dataflow.ml

@@ -33,6 +33,16 @@ module Make (M: Cfg.PrintableType) (I: Cfg.PrintableType) = struct
     internalbetween: (internal list * internal list) list;
   }
 
+  let compareinternalnode (a:internalnode) (b:internalnode) : bool =
+    match Utility.equality a.internalin b.internalin,
+          Utility.equality a.internalout b.internalout,
+          (List.fold_left2 (fun acc (ain, aout) (bin, bout)
+                            -> acc && (Utility.equality ain bin) && (Utility.equality aout bout)
+            ) true a.internalbetween b.internalbetween)
+    with
+    | true, true, true -> true
+    | _, _, _ -> false
+
   type cfgt = elt Cfg.cfginternal
 
   type t = {
@@ -40,49 +50,23 @@ module Make (M: Cfg.PrintableType) (I: Cfg.PrintableType) = struct
     internalvar: internalnode Cfg.NodeMap.t;
   }
 
+  let compareinternal (a: internalnode Cfg.NodeMap.t) (b: internalnode Cfg.NodeMap.t) =
+    Cfg.NodeMap.fold
+      (fun node bi acc ->
+         match Cfg.NodeMap.find_opt node a with
+           None -> false
+         | Some ai -> acc && compareinternalnode ai bi
+      ) b true
+
   let from_cfg (cfg: cfgt) : t =
     {t = cfg; internalvar = Cfg.NodeMap.empty}
 
   let to_cfg ({t; _}: t) : cfgt =
     t
 
-  let fixed_point
-      ?(init : (elt list -> internalnode) =
-               (fun _ -> {internalin = []; internalout = []; internalbetween = []}))
-      ?(update : (t -> Cfg.Node.t -> internalnode) =
-                 (fun t n -> Cfg.NodeMap.find n t.internalvar))
-      (t: t)
-    : t =
-    (* init function is applied only once to each node content,
-       the update function takes the node and the whole structure and is
-       expected to return the updated structure for the appropriate node,
-       update function is applied to the resulting structure until no change is
-       observed
-    *)
-    let rec helper t =
-      let newt =
-        {t with
-         internalvar = Cfg.NodeMap.mapi (fun n _ -> update t n) t.internalvar}
-      in
-      if newt = t then newt else helper newt
-    in
-    let content = List.fold_left
-        (fun cfg node -> Cfg.NodeMap.add node {internalin = [];
-                                               internalout = [];
-                                               internalbetween = []} cfg)
-        Cfg.NodeMap.empty
-        (Cfg.NodeSet.to_list t.t.nodes)
-    in
-    let content = Cfg.NodeMap.union
-        (fun _ket _empty code -> Some code)
-        content
-        (Cfg.NodeMap.map init t.t.content)
-    in
-    helper { t with internalvar = content }
-
 
   open Cfg
-  let pp (ppf: out_channel) (c: t) : unit =
+  let pp (ppf: out_channel) (c: t) : unit = (
     Printf.fprintf ppf "Cfg:\n";
     Printf.fprintf ppf "Nodes' ids: ";
     List.iter (fun (x : Node.t) -> Printf.fprintf ppf "%d " x.id) (NodeSet.to_list c.t.nodes);
@@ -148,4 +132,54 @@ module Make (M: Cfg.PrintableType) (I: Cfg.PrintableType) = struct
                 Printf.fprintf ppf "\n";
               ) (NodeMap.to_list c.internalvar);
     Printf.fprintf ppf "\n";
+  )
+
+
+  let fixed_point
+      ?(init : (elt list -> internalnode) =
+               (fun _ -> {internalin = []; internalout = []; internalbetween = []}))
+      ?(update : (t -> Cfg.Node.t -> internalnode) =
+                 (fun t n -> Cfg.NodeMap.find n t.internalvar))
+      (t: t)
+    : t =
+    (* init function is applied only once to each node content,
+       the update function takes the node and the whole structure and is
+       expected to return the updated structure for the appropriate node,
+       update function is applied to the resulting structure until no change is
+       observed
+    *)
+    let rec helper t =
+      let newt =
+        {t with
+         internalvar = Cfg.NodeMap.mapi (fun n _ -> update t n) t.internalvar}
+      in
+      if compareinternal newt.internalvar t.internalvar
+      then newt
+      else helper newt
+    in
+
+    let content =
+      List.fold_left
+        (fun cfg node -> Cfg.NodeMap.add node {internalin = [];
+                                               internalout = [];
+                                               internalbetween = []} cfg)
+        Cfg.NodeMap.empty
+        (Cfg.NodeSet.to_list t.t.nodes)
+    in
+
+    let code = (* we add back in the nodes with no code (there is no binding
+                  in the t.t.content map) *)
+      Cfg.NodeMap.union (fun _n c _empty -> Some c)
+        t.t.content
+        (Cfg.NodeMap.of_list
+           (Cfg.NodeSet.to_list t.t.nodes |> List.map (fun c -> (c, []))))
+    in
+
+    let content = Cfg.NodeMap.union
+        (fun _key _empty code -> Some code)
+        content
+        (Cfg.NodeMap.map init code)
+    in
+    helper { t with internalvar = content }
+
 end

lib/analysis/dune

@@ -1,6 +1,7 @@
 (library
  (name analysis)
  (public_name analysis)
- (modules Cfg Dataflow))
+ (modules Cfg Dataflow)
+ (libraries utility))
 
 (include_subdirs qualified)

lib/miniImp/RISC.ml

@@ -59,7 +59,8 @@ module RISCAssembly = struct
 
   type t = {
     code : risci list;
-    inputval: int option
+    inputval: int option;
+    inputoutputreg: (register * register) option;
   }
 
   let pp_risci (ppf: out_channel) (v: risci) : unit =
@@ -285,4 +286,9 @@ let rec helper
 let convert (prg: CfgRISC.RISCCfg.t) : RISCAssembly.t =
   {code = (helper prg (Option.get prg.initial) [] |> fst |>
            List.append ([Label "main"] : RISCAssembly.risci list));
-   inputval = prg.inputVal}
+   inputval = prg.inputVal;
+   inputoutputreg =
+     match prg.inputOutputVar with
+       None -> None
+     | Some (i, o) -> Some ({index = i}, {index = o})
+  }

lib/miniImp/RISC.mli

@@ -50,7 +50,8 @@ module RISCAssembly : sig
 
   type t = {
     code : risci list;
-    inputval: int option
+    inputval: int option;
+    inputoutputreg: (register * register) option;
   }
 
   val pp_risci : out_channel -> risci -> unit

lib/miniImp/RISCSemantics.ml

@@ -13,7 +13,8 @@ module RISCArchitecture = struct
   type t = {
     code: RISC.RISCAssembly.risci list CodeMap.t;
     registers: int RegisterMap.t;
-    memory: int MemoryMap.t
+    memory: int MemoryMap.t;
+    outputreg: Register.t;
   }
 end
 
@@ -101,7 +102,8 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
           else
             prg
       )
-    | Nop :: tl -> helper prg tl current_label
+    | Nop :: tl ->
+      helper prg tl current_label
     | BRegOp (brop, r1, r2, r3) :: tl -> (
         let n = (match_operator_r brop)
             (RegisterMap.find {index = r1.index} prg.registers)
@@ -136,7 +138,8 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
           )
       )
     | Load (r1, r3) :: tl -> (
-        let n = MemoryMap.find
+        let n =
+          MemoryMap.find
             (RegisterMap.find {index = r1.index} prg.registers)
             prg.memory
         in
@@ -164,14 +167,29 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
     | Label _ :: tl -> helper prg tl current_label
   in
   RegisterMap.find
-    {index = "out"}
+    prg.outputreg
     (helper prg (CodeMap.find "main" prg.code) "main").registers
 
 
 let reduce (prg: RISC.RISCAssembly.t) : int =
-  reduce_instructions {code = convert prg;
+  reduce_instructions
-   registers =
+    {code = convert prg;
+     registers = (
+       match prg.inputoutputreg with
+       | None ->
          RegisterMap.singleton
            {index = "in"}
-       (Option.value prg.inputval ~default:0);
+           (Option.value prg.inputval ~default:0)
-   memory = MemoryMap.empty} (label_order prg)
+       | Some (i, _) ->
+         RegisterMap.singleton
+           {index = i.index}
+           (Option.value prg.inputval ~default:0)
+     );
+     memory = MemoryMap.empty;
+     outputreg = (
+       match prg.inputoutputreg with
+       | None -> {index = "out"}
+       | Some (_, o) -> {index = o.index}
+     )
+    }
+    (label_order prg)

lib/miniImp/definedVariables.ml

@@ -50,13 +50,13 @@ let variables_used (instr : DVCfg.elt) : DVCfg.internal list =
     | Nop
     | LoadI (_, _) ->
       acc
+    | Store (r1, r2)
     | BRegOp (_, r1, r2, _) ->
       DVCeltSet.add r1.index acc |>
       DVCeltSet.add r2.index
     | BImmOp (_, r1, _, _)
     | URegOp (_, r1, _)
-    | Load (r1, _)
+    | Load (r1, _) ->
-    | Store (r1, _) ->
       DVCeltSet.add r1.index acc
   in
 
@@ -71,24 +71,18 @@ let variables_used_all (instructions : DVCfg.elt list) : DVCfg.internal list =
 let variables_defined (instructions : DVCfg.elt) : DVCfg.internal list =
   let helper (acc: DVCeltSet.t) (instr: DVCfg.elt) =
     match instr with
-    | Nop -> acc
+    | Nop
+    | Store (_, _) -> acc
     | BRegOp (_, _, _, r3)
     | BImmOp (_, _, _, r3)
     | URegOp (_, _, r3)
     | Load (_, r3)
-    | LoadI (_, 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_bottom : (DVCfg.elt list -> DVCfg.internalnode) =
@@ -104,91 +98,91 @@ let init_top (all_variables) : (DVCfg.elt list -> DVCfg.internalnode) =
                                   (fun _ -> (all_variables, all_variables)))})
 
 
-(* piece of code that computes vout for the whole block, not used,
-   use lub below *)
-let _dumb_lub (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode =
-  let previnternalvar = Cfg.NodeMap.find node t.internalvar in
-  let code = Cfg.NodeMap.find node t.t.content in
-  { previnternalvar with
-    internalout =
-      Utility.unique_union (variables_defined_all code) (previnternalvar.internalin)
-  }
-
-
-(* We consider only the propagation in the middle elements during the lub.
-   This incurs in a performance penality, but it is simpler to implement.
-   Each node is connected to one previus node.
-*)
 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 =
+  let newinternalbetween = (
-      List.mapi (* we don't NEED the index but i = 0 is easier to write than
+    List.map
-                   to check if vinout is None *)
+      (fun (code, (i, _o)) ->
-        (fun i (ithcode, vinout, ithcodeprev) ->
+         (i, Utility.unique_union i (variables_defined code)))
-           if i = 0 then
+      (List.combine code previnternalvar.internalbetween)
-             let dvin = previnternalvar.internalin in
+  ) in
-             (dvin, Utility.unique_union dvin (variables_defined ithcode))
+
-           else (
+  let newinternalout =
-             let ithcodeprev = match ithcodeprev with
+    match newinternalbetween with
-                 None -> ([], [])
+    | [] -> previnternalvar.internalin
-               | Some x -> x
+    | _ -> (snd (Utility.last_list newinternalbetween))
   in
-             match vinout with
+
-               None ->
+  { previnternalvar with
-               ([], variables_defined ithcode)
+    internalbetween = newinternalbetween;
-             | Some prevdvbtw ->
+    internalout = newinternalout }
-               (snd prevdvbtw,
-                Utility.unique_union
-                  (variables_defined ithcode)
-                  (ithcodeprev |> fst)
-               ))
-        )
-        (* ugly code that zips the three lists that we need to compute each vin
-           and vout for the middle of the code *)
-        (Utility.combine_thrice
-           code
-           (Utility.pad_opt
-              (Utility.prev previnternalvar.internalbetween None) None (List.length code))
-           (Utility.pad previnternalvar.internalbetween None (List.length code))
-        );
-    internalout =
-      match previnternalvar.internalbetween with
-        [] -> previnternalvar.internalin
-      | _ -> (snd (Utility.last_list 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.initial then
-    { previnternalvar with
+    (* if L is initial set dvin to the "in" register *)
-      internalin =
+    let newinternalin = (
       match t.t.inputOutputVar with
         Some (i, _) -> [i]
       | None -> []
-    }
+    ) in
-  else
+
-    let prevnodes = Cfg.NodeMap.find node t.t.reverseEdges in
+    let newinternalbetween = ( (* set the dvin of each to the previous dvout *)
-    { previnternalvar with
+      match previnternalvar.internalbetween with
-      internalin =
-        match prevnodes with
         [] -> []
-        | [prevnode] -> (Cfg.NodeMap.find prevnode t.internalvar).internalout
+      | [(_i, o)] -> [(newinternalin, o)]
+      | (_i, o) :: btwrest ->
+        (newinternalin, o) :: (
+          List.map (fun ((_i, o), (_previ, prevo)) -> (prevo, o))
+            (Utility.combine_twice btwrest previnternalvar.internalbetween)
+        )
+    ) in
+    { previnternalvar with
+      internalin = newinternalin;
+      internalbetween = newinternalbetween }
+  else
+    (* if L is not initial set dvin to the intersection of the previous node's
+       dvouts *)
+    let prevnodes = Cfg.NodeMap.find node t.t.reverseEdges in
+    let newinternalin = (
+      match prevnodes with
+      | [] ->
+        []
+      | [prevnode] ->
+        (Cfg.NodeMap.find prevnode t.internalvar).internalout
       | [prevnode1; prevnode2] ->
         Utility.unique_intersection
           (Cfg.NodeMap.find prevnode1 t.internalvar).internalout
           (Cfg.NodeMap.find prevnode2 t.internalvar).internalout
-        | _ ->
+      | prevnode :: restnodes ->
         List.fold_left (* intersection of all previous nodes' dvout *)
           (fun acc prevnode ->
-               Utility.unique_intersection acc (Cfg.NodeMap.find prevnode t.internalvar).internalout)
+             Utility.unique_intersection
-            []
+               acc
-            prevnodes
+               (Cfg.NodeMap.find prevnode t.internalvar).internalout)
-    }
+          (Cfg.NodeMap.find prevnode t.internalvar).internalout
+          restnodes
+    ) in
+
+    let newinternalbetween =
+      match previnternalvar.internalbetween with
+        [] -> []
+      | [(_i, o)] -> [(newinternalin, o)]
+      | (_i, o) :: btwrest ->
+        (newinternalin, o) :: (
+          List.map (fun ((_i, o), (_previ, prevo)) -> (prevo, o))
+            (Utility.combine_twice btwrest previnternalvar.internalbetween)
+        )
+    in
+    { previnternalvar with
+      internalin = newinternalin;
+      internalbetween = newinternalbetween }
 
 
 let update (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode =
@@ -198,10 +192,16 @@ let update (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode =
 
 let compute_defined_variables (cfg: RISCCfg.t) : DVCfg.t =
   let all_variables = List.fold_left
-      (fun acc (_, code) -> Utility.unique_union acc (variables_all code))
+      (fun acc (_, code) ->
+         Utility.unique_union acc (variables_all code))
       []
       (Cfg.NodeMap.to_list cfg.content)
   in
+  let all_variables =
+    match cfg.inputOutputVar with
+    | None -> all_variables
+    | Some (i, o) -> Utility.unique_union all_variables [i;o]
+  in
   DVCfg.from_cfg cfg
   |> DVCfg.fixed_point ~init:(init_top all_variables) ~update:update
 

lib/miniImp/definedVariables.mli

@@ -3,6 +3,7 @@ open Analysis
 module Variable : sig
   type t
   val pp : out_channel -> t -> unit
+  val pplist : out_channel -> t list -> unit
 end
 
 module RISCCfg = CfgRISC.RISCCfg

lib/miniImp/dune

@@ -13,6 +13,7 @@
  (modules Lexer Parser Types Semantics
           CfgImp ReplacePowerMod
           CfgRISC DefinedVariables LiveVariables
+          ReduceRegisters
           RISC RISCSemantics)
  (libraries analysis utility menhirLib))
 

lib/miniImp/liveVariables.ml

@@ -24,45 +24,33 @@ let variables_used (instr : DVCfg.elt) : DVCfg.internal list =
     | Nop
     | LoadI (_, _) ->
       acc
-    | BRegOp (_, r1, r2, _) ->
+    | BRegOp (_, r1, r2, _)
+    | Store (r1, r2) ->
       DVCeltSet.add r1.index acc |>
       DVCeltSet.add r2.index
     | BImmOp (_, r1, _, _)
     | URegOp (_, r1, _)
-    | Load (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
+    | Nop
+    | Store (_, _) -> acc
     | BRegOp (_, _, _, r3)
     | BImmOp (_, _, _, r3)
     | URegOp (_, _, r3)
     | Load (_, r3)
-    | LoadI (_, 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 = [];
@@ -75,58 +63,68 @@ let lub (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode =
       None -> []
     | Some c -> c
   in
-  { previnternalvar with
+
-    internalbetween =
+  let newinternalbetween = (
-      List.map (fun (prevbtw, code, nextprevbtw) ->
+    List.map
-          let newin = Utility.unique_union (variables_used code)
+      (fun (code, (_i, o)) ->
-              (Utility.subtraction (snd prevbtw) (variables_defined code))
+         (Utility.unique_union
+            (variables_used code)
+            (Utility.subtraction o (variables_defined code)), o))
+      (Utility.combine_twice code previnternalvar.internalbetween)
+  ) in
+
+  let newinternalin =
+    match newinternalbetween with
+    | [] -> previnternalvar.internalout
+    | (i, _)::_ -> i
   in
-          match nextprevbtw with
+
-            None -> (newin, snd prevbtw)
+  { previnternalvar with
-          | Some (newout, _) -> (newin, newout)
+    internalbetween = newinternalbetween;
-        )
+    internalin = newinternalin; }
-        (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
+  let newinternalout = (
+    if Option.equal (=) (Some node) t.t.terminal then (
+      match t.t.inputOutputVar with
         Some (_, o) -> [o]
       | None -> []
-    in
+    ) else (
-    { 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
+      match nextnodes with
-        None -> []
+      | None -> []
-      | Some (node, None) -> (Cfg.NodeMap.find node t.internalvar).internalin
+      | 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
+
+  let newinternalbetween = (
+    match List.rev previnternalvar.internalbetween with
+    | [] -> []
+    | (i, _o) :: btwrest ->
+      let btwrest = List.rev btwrest in
+      let newbtwrest = List.map2
+          (fun (i, _o) (nexti, _nexto) -> (i, nexti))
+          btwrest
+          (Utility.drop_first_element_list previnternalvar.internalbetween)
       in
+      newbtwrest @ [(i, newinternalout)]
+  ) in
+
   { previnternalvar with
     internalout = newinternalout;
-      internalbetween = (
+    internalbetween = newinternalbetween; }
-        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
+  let newt = {t with internalvar = (Cfg.NodeMap.add node
+                                      (lucf t node)
+                                      t.internalvar)} in
   lub newt node
 
 
@@ -135,10 +133,136 @@ let compute_live_variables (cfg: RISCCfg.t) : DVCfg.t =
   |> DVCfg.fixed_point ~init:init ~update:update
 
 
+
+module VariableMap = struct
+  include Map.Make(Variable)
+
+  let first_empty next start m l =
+    let bindings =
+      List.fold_left (
+        fun acc x ->
+          match find_opt x m with
+          | None -> acc
+          | Some x -> x :: acc) [] l |> List.sort Variable.compare in
+
+    let rec aux x =
+      if List.mem x bindings
+      then aux (next x)
+      else x
+    in
+    aux start
+
+  let first_empty_Variable m l =
+    let next = fun x -> x |> int_of_string |> (+) 1 |> string_of_int in
+    let start = "1" in
+    first_empty next start m l
+
+  let get_mapping m l r =
+    match find_opt r m with
+    | None -> (
+        let newr = first_empty_Variable m l in
+        let newm = add r newr m in
+        (newm, newr)
+      )
+    | Some r -> (m, r)
+end
+
+
 (* just rename the registers that dont share live status *)
 let optimize_cfg (t: DVCfg.t) : DVCfg.t =
-  t
+  let replace_code ((vin, vout): Variable.t list * Variable.t list)
+      (a: Variable.t VariableMap.t)
+      (code: DVCfg.elt)
+    : (Variable.t VariableMap.t * DVCfg.elt) =
+    match code with
+    | Nop -> (
+        (a, Nop)
+      )
+    | BRegOp (brop, r1, r2, r3) -> (
+        let (newa, newr1) = VariableMap.get_mapping a vin r1.index in
+        let (newa, newr2) = VariableMap.get_mapping newa vin r2.index in
+        let (newa, newr3) = VariableMap.get_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, newr3) = VariableMap.get_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, newr3) = VariableMap.get_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, newr3) = VariableMap.get_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
+        (newa, LoadI (i, {index = newr3}))
+      )
+    | Store (r1, r3) -> (
+        let (newa, newr1) = VariableMap.get_mapping a vin r1.index in
+        let (newa, newr3) = VariableMap.get_mapping newa vout r3.index in
+        (newa, Store ({index = newr1}, {index = newr3}))
+      )
+  in
 
+  let aux (assignments: Variable.t VariableMap.t) (t: DVCfg.t) (node: Cfg.Node.t)
+    : (Variable.t VariableMap.t * DVCfg.t) =
+    let livevars = Cfg.NodeMap.find node t.internalvar in
+    let code =
+      match Cfg.NodeMap.find_opt node t.t.content with
+      | None -> []
+      | Some x -> x
+    in
+    let newcode, newassignments =
+      (List.fold_left2
+         (fun (acc, assignments) btw code ->
+            let na, nc = replace_code btw assignments code in
+            (acc @ [nc], na)
+         )
+         ([], assignments)
+         livevars.internalbetween
+         code)
+    in
+    let newcontent = Cfg.NodeMap.add
+        node
+        newcode
+        t.t.content
+    in
+
+    let newt = { t with t = { t.t with content = newcontent } } in
+    (newassignments, newt)
+  in
+
+  (* --------- *)
+
+  let assignments = VariableMap.empty in
+
+  let a, newt =
+    Cfg.NodeSet.fold (* for each node we replace all the variables with the
+                        optimized ones *)
+      (fun node (ass, t) -> aux ass t node)
+      t.t.nodes
+      (assignments, t)
+  in
+
+  { newt with
+    t = { newt.t with
+          inputOutputVar =
+            match newt.t.inputOutputVar with
+              None -> None
+            | Some (i, o) -> (
+                match VariableMap.find_opt i a, VariableMap.find_opt o a with
+                | None, None -> Some (i, o)
+                | Some i, None -> Some (i, o)
+                | None, Some o -> Some (i, o)
+                | Some i, Some o -> Some (i, o)
+              )
+        }}
 
 
 let compute_cfg (dvcfg: DVCfg.t) : RISCCfg.t =

lib/miniImp/reduceRegisters.ml

@@ -0,0 +1,416 @@
+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 VariableMap = Map.Make(Variable)
+
+let variables_frequency (instr : RISCCfg.elt) : (Variable.t * int) list =
+  let add_one = (fun x -> match x with None -> Some 1 | Some x -> Some (x + 1)) in
+
+  let helper (acc: int VariableMap.t) (instr: RISCCfg.elt) =
+    match instr with
+    | Nop ->
+      acc
+    | BRegOp (_, r1, r2, r3) ->
+      VariableMap.update r1.index add_one acc |>
+      VariableMap.update r2.index add_one |>
+      VariableMap.update r3.index add_one
+    | BImmOp (_, r1, _, r3)
+    | URegOp (_, r1, r3)
+    | Load (r1, r3)
+    | Store (r1, r3) ->
+      VariableMap.update r1.index add_one acc |>
+      VariableMap.update r3.index add_one
+    | LoadI (_, r3) ->
+      VariableMap.update r3.index add_one acc
+  in
+
+  helper VariableMap.empty instr |> VariableMap.to_list
+
+let variables_all_frequency (instructions : RISCCfg.elt list) : (Variable.t * int) list =
+  List.fold_left (fun (acc: int VariableMap.t) (instr: RISCCfg.elt) ->
+      VariableMap.union (fun _v x y -> Some (x + y)) acc (variables_frequency instr |> VariableMap.of_list)
+    ) VariableMap.empty instructions |> VariableMap.to_list
+
+
+let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
+  (if n < 4 then (failwith "ReduceRegisters: number of registers too small") else ());
+
+  (* we get all the variables with associated frequency (only syntactic use) *)
+  let all_variables = List.fold_left
+      (fun acc (_, code) ->
+         Utility.unique_union acc (variables_all_frequency code))
+      []
+      (Cfg.NodeMap.to_list cfg.content)
+  in
+  let all_variables =
+    match cfg.inputOutputVar with
+    | None -> all_variables
+    | Some (i, _o) -> (
+      match List.assoc_opt i all_variables with
+      | None -> (i, 1) :: all_variables
+      | Some f -> (i, f+1) :: (List.remove_assoc i all_variables)
+    )
+  in
+  let all_variables =
+    match cfg.inputOutputVar with
+    | None -> all_variables
+    | Some (_i, o) -> (
+      match List.assoc_opt o all_variables with
+      | None -> (o, 1) :: all_variables
+      | Some f -> (o, f+1) :: (List.remove_assoc o all_variables)
+    )
+  in
+
+  let replaceregisters
+      (remappedregisters: Variable.t VariableMap.t)
+      (memorymap: int VariableMap.t)
+      (temporaryregisters: Variable.t list)
+      (code: RISCCfg.elt list)
+    : RISCCfg.elt list =
+
+    let tmpreg1: CfgRISC.RISCSimpleStatements.register =
+      {index = List.nth temporaryregisters 0} in
+    let tmpreg2: CfgRISC.RISCSimpleStatements.register =
+      {index = List.nth temporaryregisters 1} in
+
+    let aux (instruction: RISCCfg.elt) : RISCCfg.elt list =
+      match instruction with
+      | Nop -> [Nop]
+      | BRegOp (brop, r1, r2, r3) -> (
+          match ( VariableMap.find_opt r1.index remappedregisters,
+                  VariableMap.find_opt r2.index remappedregisters,
+                  VariableMap.find_opt r3.index remappedregisters,
+                  VariableMap.find_opt r1.index memorymap,
+                  VariableMap.find_opt r1.index memorymap,
+                  VariableMap.find_opt r3.index memorymap )
+          with
+          | Some r1, Some r2, Some r3, _, _, _ ->
+            [BRegOp (brop, {index = r1}, {index = r2}, {index = r3})]
+          | Some r1, Some r2, None, _, _, Some m3 ->
+            [BRegOp (brop, {index = r1}, {index = r2}, tmpreg2);
+             LoadI (m3, tmpreg1);
+             Store (tmpreg2, tmpreg1)]
+          | Some r1, None, Some r3, _, Some m2, _ ->
+            [LoadI (m2, tmpreg2);
+             Load (tmpreg2, tmpreg2);
+             BRegOp (brop, {index = r1}, tmpreg2, {index = r3})]
+          | None, Some r2, Some r3, Some m1, _, _ ->
+            [LoadI (m1, tmpreg1);
+             Load (tmpreg1, tmpreg1);
+             BRegOp (brop, tmpreg1, {index = r2}, {index = r3})]
+          | None, None, Some r3, Some m1, Some m2, _ ->
+            [LoadI (m1, tmpreg1);
+             Load (tmpreg1, tmpreg1);
+             LoadI (m2, tmpreg2);
+             Load (tmpreg2, tmpreg2);
+             BRegOp (brop, tmpreg1, tmpreg2, {index = r3})]
+          | None, None, None, Some m1, Some m2, Some m3 ->
+            [LoadI (m1, tmpreg1);
+             Load (tmpreg1, tmpreg1);
+             LoadI (m2, tmpreg2);
+             Load (tmpreg2, tmpreg2);
+             BRegOp (brop, tmpreg1, tmpreg2, tmpreg2);
+             LoadI (m3, tmpreg1);
+             Store (tmpreg2, tmpreg1)]
+          | _ -> [BRegOp (brop, {index = r1.index}, {index = r2.index}, {index = r3.index})]
+        )
+      | BImmOp (biop, r1, i, r3) -> (
+          match ( VariableMap.find_opt r1.index remappedregisters,
+                  VariableMap.find_opt r3.index remappedregisters,
+                  VariableMap.find_opt r1.index memorymap,
+                  VariableMap.find_opt r3.index memorymap )
+          with
+          | Some r1, Some r3, _, _ ->
+            [BImmOp (biop, {index = r1}, i, {index = r3})]
+          | Some r1, None, _, Some m3 ->
+            [BImmOp (biop, {index = r1}, i, tmpreg2);
+             LoadI (m3, tmpreg1);
+             Store (tmpreg2, tmpreg1)]
+          | None, Some r3, Some m1, _ ->
+            [LoadI (m1, tmpreg1);
+             Load (tmpreg1, tmpreg1);
+             BImmOp (biop, tmpreg1, i, {index = r3})]
+          | None, None, Some m1, Some m3 ->
+            [LoadI (m1, tmpreg1);
+             Load (tmpreg1, tmpreg1);
+             BImmOp (biop, tmpreg1, i, tmpreg2);
+             LoadI (m3, tmpreg1);
+             Store (tmpreg2, tmpreg1)]
+          | _ -> failwith ("ReduceRegisters: fail to partition a set, some" ^
+                           " registers have no binding.")
+      )
+      | URegOp (urop, r1, r3) ->(
+          match ( VariableMap.find_opt r1.index remappedregisters,
+                  VariableMap.find_opt r3.index remappedregisters,
+                  VariableMap.find_opt r1.index memorymap,
+                  VariableMap.find_opt r3.index memorymap )
+          with
+          | Some r1, Some r3, _, _ ->
+            [URegOp (urop, {index = r1}, {index = r3})]
+          | Some r1, None, _, Some m3 ->
+            [URegOp (urop, {index = r1}, tmpreg2);
+             LoadI (m3, tmpreg1);
+             Store (tmpreg2, tmpreg1)]
+          | None, Some r3, Some m1, _ ->
+            [LoadI (m1, tmpreg1);
+             Load (tmpreg1, tmpreg1);
+             URegOp (urop, tmpreg1, {index = r3})]
+          | None, None, Some m1, Some m3 ->
+            [LoadI (m1, tmpreg1);
+             Load (tmpreg1, tmpreg1);
+             URegOp (urop, tmpreg1, tmpreg2);
+             LoadI (m3, tmpreg1);
+             Store (tmpreg2, tmpreg1)]
+          | _ -> failwith ("ReduceRegisters: fail to partition a set, some" ^
+                           " registers have no binding.")
+        )
+      | Load (r1, r3) -> (
+          match ( VariableMap.find_opt r1.index remappedregisters,
+                  VariableMap.find_opt r3.index remappedregisters,
+                  VariableMap.find_opt r1.index memorymap,
+                  VariableMap.find_opt r3.index memorymap )
+          with
+          | Some r1, Some r3, _, _ ->
+            [Load ({index = r1}, {index = r3})]
+          | Some r1, None, _, Some m3 ->
+            [Load ({index = r1}, tmpreg2);
+             LoadI (m3, tmpreg1);
+             Store (tmpreg2, tmpreg1)]
+          | None, Some r3, Some m1, _ ->
+            [LoadI (m1, tmpreg1);
+             Load (tmpreg1, tmpreg1);
+             Load (tmpreg1, {index = r3})]
+          | None, None, Some m1, Some m3 ->
+            [LoadI (m1, tmpreg1);
+             Load (tmpreg1, tmpreg1);
+             Load (tmpreg1, tmpreg2);
+             LoadI (m3, tmpreg1);
+             Store (tmpreg2, tmpreg1)]
+          | _ -> failwith ("ReduceRegisters: fail to partition a set, some" ^
+                           " registers have no binding.")
+        )
+      | LoadI (i, r3) -> (
+          (* we want to store an integer in memory immediately (strange, but
+             unless better heuristic to choose the variables to replace we are
+             stuck) *)
+          match ( VariableMap.find_opt r3.index remappedregisters,
+                  VariableMap.find_opt r3.index memorymap )
+          with
+          | Some r3, _ ->
+            [LoadI (i, {index = r3})]
+          | None, Some m3 ->
+            [LoadI (i, tmpreg2);
+             LoadI (m3, tmpreg1);
+             Store (tmpreg2, tmpreg1)]
+          | _ -> failwith ("ReduceRegisters: fail to partition a set, some" ^
+                           " registers have no binding.")
+        )
+      | Store (r1, r3) -> (
+          (* we want to maybe store an address in memory (very confusing, don't
+             think can happen) *)
+          match ( VariableMap.find_opt r1.index remappedregisters,
+                  VariableMap.find_opt r3.index remappedregisters,
+                  VariableMap.find_opt r1.index memorymap,
+                  VariableMap.find_opt r3.index memorymap )
+          with
+          | Some r1, Some r3, _, _ ->
+            [Store ({index = r1}, {index = r3})]
+          | Some r1, None, _, Some m3 ->
+            [Store ({index = r1}, tmpreg2);
+             LoadI (m3, tmpreg1);
+             Store (tmpreg2, tmpreg1)]
+          | None, Some r3, Some m1, _ ->
+            [LoadI (m1, tmpreg1);
+             Load (tmpreg1, tmpreg1);
+             Store (tmpreg1, {index = r3})]
+          | None, None, Some m1, Some m3 ->
+            [LoadI (m1, tmpreg1);
+             Load (tmpreg1, tmpreg1);
+             Store (tmpreg1, tmpreg2);
+             LoadI (m3, tmpreg1);
+             Store (tmpreg2, tmpreg1)]
+          | _ -> failwith ("ReduceRegisters: fail to partition a set, some" ^
+                           " registers have no binding.")
+      )
+    in
+
+    List.map (fun x ->
+        Printf.printf "Converting: %a\n" CfgRISC.RISCSimpleStatements.pp x;
+        let tmp = aux x in
+        Printf.printf "Into: %a\n\n" CfgRISC.RISCSimpleStatements.pplist tmp;
+        tmp
+      ) code |> List.concat
+  in
+
+
+  let aux (cfg: RISCCfg.t) all_variables =
+    (* we keep the first two variables free for immediate use *)
+    let most_frequent, least_frequent =
+      List.sort (fun (_a, fa) (_b, fb) -> Int.compare fb fa) all_variables
+      |> Utility.take (n-2)
+    in
+    let most_frequent = fst (List.split most_frequent) in
+    let least_frequent = fst (List.split least_frequent) in
+
+    (* we map the most frequent to new registers, so that the first two are
+       always free *)
+    let most_frequent_mapping = (* +3 because starts at 0, but we want to start
+                                   at 1*)
+      List.mapi (fun n v -> (v, (string_of_int (n+3): Variable.t))) most_frequent
+      |> VariableMap.of_list
+    in
+    (* we map the least to memory *)
+    let least_frequent_mapping =
+      List.mapi (fun n v -> (v, (n: int))) least_frequent
+      |> VariableMap.of_list
+    in
+
+    Printf.printf "Most freq mapping:\n";
+    List.iter (fun (a, b) -> Printf.printf "%s -> %s\n" a b) (VariableMap.to_list most_frequent_mapping);
+    Printf.printf "Least freq mapping:\n";
+    List.iter (fun (a, b) -> Printf.printf "%s -> mem %d\n" a b) (VariableMap.to_list least_frequent_mapping);
+
+    (* we need to replace both at the same time, because we might have mapped
+       some registers to already used registers, so a double pass might not
+       differentiate the two *)
+    (* special care must be taken for the in and out registers *)
+    let newcfg = {
+      cfg with
+      content = Cfg.NodeMap.map
+          (fun x -> replaceregisters most_frequent_mapping least_frequent_mapping ["1"; "2"] x)
+          cfg.content}
+    in
+
+    match newcfg.inputOutputVar with
+    | None -> newcfg (* if no input or output variables we ignore *)
+    | Some (i, o) -> (
+        match (VariableMap.find_opt i most_frequent_mapping,
+               VariableMap.find_opt o most_frequent_mapping,
+               VariableMap.find_opt i least_frequent_mapping,
+               VariableMap.find_opt o least_frequent_mapping )
+        with (*we check if in and out are simply remapped or are put in memory*)
+        | Some i, Some o, _, _ ->
+          { newcfg with inputOutputVar = Some (i, o) }
+        | Some i, None, _, Some mo -> ( (* since the output simbol is in memory
+                                           we need to first retrive it and then
+                                           put the result in a temporary
+                                           register *)
+            match newcfg.terminal with (* we check for the terminal node, if not
+                                          present we are very confused and dont
+                                          modify the out variable *)
+            | None -> { newcfg with inputOutputVar = Some (i, o)}
+            | Some n -> (
+                let terminalcontent = (
+                  match Cfg.NodeMap.find_opt n newcfg.content with
+                  | None -> []
+                  | Some x -> x
+                ) @ [LoadI (mo, {index = "2"});
+                     Load ({index = "2"}, {index = "2"})]
+                in
+                let content = Cfg.NodeMap.add n terminalcontent newcfg.content in
+                { newcfg with
+                  inputOutputVar = Some (i, "2");
+                  content = content
+                }
+              )
+          )
+        | None, Some o, Some mi, _ -> ( (* the input simbol should be stored in
+                                           memory *)
+            match newcfg.initial with
+            | None -> { newcfg with inputOutputVar = Some (i, o) }
+            | Some n -> (
+                let initialcontent =
+                  [(LoadI (mi, {index = "2"}) : RISCCfg.elt);
+                   Store ({index = "1"}, {index = "2"})] @ (
+                    match Cfg.NodeMap.find_opt n newcfg.content with
+                    | None -> []
+                    | Some x -> x
+                  )
+                in
+                let content = Cfg.NodeMap.add n initialcontent newcfg.content in
+                { newcfg with
+                  inputOutputVar = Some ("1", o);
+                  content = content
+                }
+              )
+          )
+        | None, None, Some mi, Some mo -> ( (* both simbols should be in
+                                               memory *)
+            match newcfg.initial, newcfg.terminal with
+            | None, None -> { newcfg with inputOutputVar = Some (i, o) }
+            | None, Some n -> (
+                let terminalcontent = (
+                  match Cfg.NodeMap.find_opt n newcfg.content with
+                  | None -> []
+                  | Some x -> x
+                ) @ [LoadI (mo, {index = "2"});
+                     Load ({index = "2"}, {index = "2"})]
+                in
+                let content = Cfg.NodeMap.add n terminalcontent newcfg.content in
+                { newcfg with
+                  inputOutputVar = Some (i, "2");
+                  content = content
+                }
+              )
+            | Some n, None -> (
+                let initialcontent =
+                  [(LoadI (mi, {index = "2"}) : RISCCfg.elt);
+                   Store ({index = "1"}, {index = "2"})] @ (
+                    match Cfg.NodeMap.find_opt n newcfg.content with
+                    | None -> []
+                    | Some x -> x
+                  )
+                in
+                let content = Cfg.NodeMap.add n initialcontent newcfg.content in
+                { newcfg with
+                  inputOutputVar = Some ("1", o);
+                  content = content
+                }
+              )
+            | Some ni, Some no -> (
+                let initialcontent =
+                  [(LoadI (mi, {index = "2"}) : RISCCfg.elt);
+                   Store ({index = "1"}, {index = "2"})] @ (
+                    match Cfg.NodeMap.find_opt ni newcfg.content with
+                    | None -> []
+                    | Some x -> x
+                  )
+                in
+                let terminalcontent = (
+                  match Cfg.NodeMap.find_opt no newcfg.content with
+                  | None -> []
+                  | Some x -> x
+                ) @ [LoadI (mo, {index = "2"});
+                     Load ({index = "2"}, {index = "2"})]
+                in
+                let content = Cfg.NodeMap.add ni initialcontent newcfg.content in
+                let content = Cfg.NodeMap.add no terminalcontent content in
+                { newcfg with
+                  inputOutputVar = Some ("1", "2");
+                  content = content
+                }
+              )
+          )
+        | _ -> failwith ("ReduceRegisters: fail to partition a set, some" ^
+                           " registers have no binding.")
+      )
+  in
+
+
+  ( if List.length all_variables < n
+    then cfg
+    else aux cfg all_variables )

lib/miniImp/reduceRegisters.mli

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

lib/utility/utility.ml

@@ -52,6 +52,7 @@ let rec fromIntToString (alphabet: string) (x: int) : string =
                                                  |> String.make 1)
 
 
+(* true if every element of la is in lb *)
 let inclusion la lb =
   let rec aux la =
     function
@@ -63,6 +64,11 @@ let inclusion la lb =
   in
   aux lb la
 
+(* true if lb includes la and la includes lb *)
+let equality la lb =
+  inclusion la lb && inclusion lb la
+
+(* computes the result of la \setminus lb *)
 let subtraction la lb =
   let rec aux la =
     function
@@ -89,23 +95,40 @@ let unique l =
 let unique_union la lb =
   unique (la @ lb)
 
+(* returns all elements both in la and in lb *)
 let unique_intersection la lb =
-  let rec aux la lb acc =
+  let rec aux la acc =
     match la with
       [] -> acc
     | a::la ->
       if List.mem a lb
-      then aux la lb (a::acc)
+      then aux la (a::acc)
-      else aux la lb acc
+      else aux la acc
   in
-  aux la lb [] |> unique
+  aux la [] |> unique
 
+(* returns a list with at most n items and the rest in the second *)
+let rec take (n: int) (l: 'a list) : ('a list * 'a list) =
+  match n with
+  | 0 -> ([], l)
+  | n ->
+    match l with
+    | [] -> ([], [])
+    | i::ls ->
+      let (t1, t2) = (take (n - 1) ls) in
+      ((i :: t1), (t2))
 
+(* returns the list without the last element *)
 let drop_last_element_list =
   function
   | [] -> []
   | l -> l |> List.rev |> List.tl |> List.rev
 
+let drop_first_element_list =
+  function
+  | [] -> []
+  | _::l -> l
+
 (* Complicated way to drop the last element and add a new option element to the
    beginning *)
 let prev l a =
@@ -152,6 +175,13 @@ let add_to_last_list (la: 'a list list) (a: 'a) : 'a list list =
   in
   aux la a
 
+let rec combine_twice la lb =
+  match (la, lb) with
+  | [], [] -> []
+  | [a], [b] -> [a, b]
+  | a::la, b::lb -> (a, b) :: (combine_twice la lb)
+  | _ -> []
+
 let rec combine_thrice la lb lc =
   match (la, lb, lc) with
   | [], [], [] -> []

lib/utility/utility.mli

@@ -13,13 +13,17 @@ val int_not :     int -> int
 val fromIntToString : string -> int -> string
 
 val inclusion :           'a list -> 'a list -> bool
+val equality :            'a list -> 'a list -> bool
 val subtraction :         'a list -> 'a list -> 'a list
 
 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 take : int -> 'a list -> ('a list * 'a list)
+
 val drop_last_element_list  : 'a list -> 'a list
+val drop_first_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
@@ -29,4 +33,5 @@ val combine :   'a        list -> 'b option list   -> ('a * 'b) option list
 val last_list : 'a        list -> 'a
 val add_to_last_list : 'a list list -> 'a -> 'a list list
 
+val combine_twice : 'a list -> 'b list -> ('a * 'b) list
 val combine_thrice : 'a list -> 'b list -> 'c list  -> ('a * 'b * 'c) list