lci/lib/miniImp/CfgRISC.ml

open Analysis

module RISCSimpleStatements = struct
  type register = {
    index: string
  }

  type t =
    | Nop
    | BRegOp of brop * register * register * register
    | BImmOp of biop * register * int * register
    | URegOp of urop * register * register
    | Load of register * register
    | LoadI of int * register
    | Store of register * register
  and brop =
    | Add
    | Sub
    | Mult
    | Div
    | Mod
    | Pow
    | And
    | Or
    | Eq
    | Less
    | LessEq
    | More
    | MoreEq
  and biop =
    | AddI
    | SubI
    | MultI
    | DivI
    | ModI
    | PowI
    | AndI
    | OrI
    | EqI
    | LessI
    | LessEqI
    | MoreI
    | MoreEqI
  and urop =
    | Not
    | Copy
    | Rand

  let pp (ppf: out_channel) (v: t) : unit =
    let rec pp_t (ppf: out_channel) (v: t) : unit =
      match v with
        Nop ->
        Printf.fprintf ppf "Nop"
      | BRegOp (b, r1, r2, r3) ->
        Printf.fprintf ppf "%a r%s r%s => r%s"
          pp_brop b r1.index r2.index r3.index
      | BImmOp (b, r1, i, r3)  ->
        Printf.fprintf ppf "%a r%s %d => r%s" pp_biop b r1.index i r3.index
      | URegOp (u, r1, r2) ->
        Printf.fprintf ppf "%a r%s => r%s" pp_urop u r1.index r2.index
      | Load (r1, r2) ->
        Printf.fprintf ppf "Load r%s => r%s" r1.index r2.index
      | LoadI (i, r2) ->
        Printf.fprintf ppf "LoadI %d => r%s" i r2.index
      | Store (r1, r2) ->
        Printf.fprintf ppf "Store r%s => r%s" r1.index r2.index
    and pp_brop (ppf: out_channel) (v: brop) : unit =
      match v with
        Add    -> Printf.fprintf ppf "Add"
      | Sub    -> Printf.fprintf ppf "Sub"
      | Mult   -> Printf.fprintf ppf "Mult"
      | Div    -> Printf.fprintf ppf "Div"
      | Mod    -> Printf.fprintf ppf "Mod"
      | Pow    -> Printf.fprintf ppf "Pow"
      | And    -> Printf.fprintf ppf "And"
      | Or     -> Printf.fprintf ppf "Or"
      | Eq     -> Printf.fprintf ppf "Eq"
      | Less   -> Printf.fprintf ppf "Less"
      | LessEq -> Printf.fprintf ppf "LessEq"
      | More   -> Printf.fprintf ppf "More"
      | MoreEq -> Printf.fprintf ppf "MoreEq"
    and pp_biop (ppf: out_channel) (v: biop) : unit =
      match v with
        AddI    -> Printf.fprintf ppf "AddI"
      | SubI    -> Printf.fprintf ppf "SubI"
      | MultI   -> Printf.fprintf ppf "MultI"
      | DivI    -> Printf.fprintf ppf "DivI"
      | ModI    -> Printf.fprintf ppf "ModI"
      | PowI    -> Printf.fprintf ppf "PowI"
      | AndI    -> Printf.fprintf ppf "AndI"
      | OrI     -> Printf.fprintf ppf "OrI"
      | EqI     -> Printf.fprintf ppf "EqI"
      | LessI   -> Printf.fprintf ppf "LessI"
      | LessEqI -> Printf.fprintf ppf "LessEqI"
      | MoreI   -> Printf.fprintf ppf "MoreI"
      | MoreEqI -> Printf.fprintf ppf "MoreEqI"
    and pp_urop (ppf: out_channel) (v: urop) : unit =
      match v with
        Not     -> Printf.fprintf ppf "Nop"
      | Copy    -> Printf.fprintf ppf "Copy"
      | Rand    -> Printf.fprintf ppf "Rand"
    in
    pp_t ppf v

  let pplist (ppf: out_channel) (l: t list) : unit =
    List.iter (fun x -> pp ppf x; Printf.printf "; ") l
end

module RISCCfg = Cfg.Make(RISCSimpleStatements)

let globalcounter = ref 0
module RegisterMap = struct
  type m = {
    assignments: RISCSimpleStatements.register Types.VariableMap.t
  }

  let set_register (x: Types.variable) (v: RISCSimpleStatements.register) (m: m)
    : m =
    {assignments = Types.VariableMap.add x v m.assignments}

  let get_or_set_register (x: Types.variable) (m: m)
    : RISCSimpleStatements.register * m =
    match Types.VariableMap.find_opt x m.assignments with
      None -> (
        globalcounter := !globalcounter + 1;
        ({index = string_of_int !globalcounter},
         {assignments =
            Types.VariableMap.add x
              ({index = (string_of_int !globalcounter)}
               : RISCSimpleStatements.register)
              m.assignments}))
    | Some i -> (i, m)

  let get_fresh_register (m: m)
    : RISCSimpleStatements.register * m * Types.variable =
    globalcounter := !globalcounter + 1;
    let freshvariable = string_of_int !globalcounter in
    ({index = string_of_int !globalcounter},
     {assignments =
        Types.VariableMap.add freshvariable
          ({index = string_of_int !globalcounter}
           : RISCSimpleStatements.register)
          m.assignments},
     freshvariable)

  let empty : m =
    {assignments = Types.VariableMap.empty}
end

(* converts a simple statement into RISC simple statements *)
let rec c_ss_t
    (ss: CfgImp.SimpleStatements.t)
    (m: RegisterMap.m)
    (convertedcode: RISCSimpleStatements.t list)
  : RISCSimpleStatements.t list * RegisterMap.m =
  match ss with
    SimpleSkip -> (convertedcode @ [Nop], m)
  | SimpleAssignment (v, sa) -> (
      let r1, m = RegisterMap.get_or_set_register v m in
      c_ss_sa sa m convertedcode r1
    )
  | SimpleGuard (b) -> (
      let returnreg, m, _returnregvar = RegisterMap.get_fresh_register m in
      c_ss_sb b m convertedcode returnreg
    )

(* converts a boolean simple statement into RISC simple statements, requires
   the register where the result sould be put into, does a lookahead to optimize
   with operations where an integer is one side of the operation *)
and c_ss_sb
    (ss: CfgImp.SimpleStatements.simpleBoolean)
    (m: RegisterMap.m)
    (convertedcode: RISCSimpleStatements.t list)
    (register: RISCSimpleStatements.register)
  : RISCSimpleStatements.t list * RegisterMap.m =
  match ss with
    SimpleBoolean (b) -> (
      let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
      if b then
        (convertedcode @ [LoadI (1, partialresreg)], m)
      else
        (convertedcode @ [LoadI (0, partialresreg)], m)
    )
  | SimpleBAnd (b1, b2) -> (
      match (b1, b2) with
      | (SimpleBoolean (true), b)
      | (b, SimpleBoolean (true)) -> (
          c_ss_sb b m convertedcode register
        )
      | (SimpleBoolean (false), _)
      | (_, SimpleBoolean (false)) -> (
          (convertedcode @ [LoadI (0, register)], m)
        )
      | (_, _) -> (
          let partialresreg1, m, _partialresvar1 =
            RegisterMap.get_fresh_register m
          in
          let partialresreg2, m, _partialresvar2 =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sb b1 m convertedcode partialresreg1 in
          let convertedcode, m = c_ss_sb b2 m convertedcode partialresreg2 in
          (convertedcode @
           [BRegOp (And, partialresreg1, partialresreg2, register)], m)
        )
    )
  | SimpleBOr (b1, b2) -> (
      match (b1, b2) with
      | (SimpleBoolean (false), b)
      | (b, SimpleBoolean (false)) -> (
          c_ss_sb b m convertedcode register
        )
      | (SimpleBoolean (true), _)
      | (_, SimpleBoolean (true)) -> (
          (LoadI (1, register) :: convertedcode, m)
        )
      | (_, _) -> (
          let partialresreg1, m, _partialresvar1 =
            RegisterMap.get_fresh_register m
          in
          let partialresreg2, m, _partialresvar2 =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sb b1 m convertedcode partialresreg1 in
          let convertedcode, m = c_ss_sb b2 m convertedcode partialresreg2 in
          (convertedcode @
           [BRegOp (Or, partialresreg1, partialresreg2, register)], m)
        )
    )
  | SimpleBNot (b) -> (
      match (b) with
      | SimpleBoolean (b) -> (
        if b then
          (LoadI (0, register) :: convertedcode, m)
        else
          (LoadI (1, register) :: convertedcode, m)
      )
      | _ -> (
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sb b m convertedcode partialresreg in
          (convertedcode @ [URegOp (Not, partialresreg, register)], m)
        )
    )
  | SimpleBCmp (a1, a2) -> (
      match (a1, a2) with
      | (SimpleInteger (i), SimpleVariable (x))
      | (SimpleVariable (x), SimpleInteger (i)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          (convertedcode @ [BImmOp (EqI, xreg, i, register)], m)
        )
      | (SimpleInteger (i), a)
      | (a, SimpleInteger (i)) -> (
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BImmOp (EqI, partialresreg, i, register)], m)
        )
      | (SimpleVariable (x), SimpleVariable (y)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let yreg, m = RegisterMap.get_or_set_register y m in
          (convertedcode @ [BRegOp (Eq, xreg, yreg, register)], m)
        )
      | (SimpleVariable (x), a)
      | (a, SimpleVariable (x)) -> (
          let xreg, m =
            RegisterMap.get_or_set_register x m
          in
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BRegOp (Eq, partialresreg, xreg, register)], m)
        )
      | (_, _) -> (
          let partialresreg1, m, _partialresvar1 =
            RegisterMap.get_fresh_register m
          in
          let partialresreg2, m, _partialresvar2 =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a1 m convertedcode partialresreg1 in
          let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in
          (convertedcode @
           [BRegOp (Eq, partialresreg1, partialresreg2, register)], m)
        )
    )
  | SimpleBCmpLess (a1, a2) -> (
      match (a1, a2) with
      | (SimpleInteger (i), SimpleVariable (x)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          (convertedcode @ [BImmOp (MoreI, xreg, i, register)], m)
        )
      | (SimpleVariable (x), SimpleInteger (i)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          (convertedcode @ [BImmOp (LessI, xreg, i, register)], m)
        )
      | (SimpleInteger (i), a) -> (
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BImmOp (MoreI, partialresreg, i, register)], m)
        )
      | (a, SimpleInteger (i)) -> (
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BImmOp (LessI, partialresreg, i, register)], m)
        )
      | (SimpleVariable (x), SimpleVariable (y)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let yreg, m = RegisterMap.get_or_set_register y m in
          (convertedcode @ [BRegOp (Less, xreg, yreg, register)], m)
        )
      | (SimpleVariable (x), a) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BRegOp (Less, xreg, partialresreg, register)], m)
        )
      | (a, SimpleVariable (x)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BRegOp (Less, partialresreg, xreg, register)], m)
        )
      | (_, _) -> (
          let partialresreg1, m, _partialresvar1 =
            RegisterMap.get_fresh_register m
          in
          let partialresreg2, m, _partialresvar2 =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a1 m convertedcode partialresreg1 in
          let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in
          (convertedcode @
           [BRegOp (Less, partialresreg1, partialresreg2, register)], m)
        )
    )
  | SimpleBCmpLessEq (a1, a2) -> (
      match (a1, a2) with
      | (SimpleInteger (i), SimpleVariable (x)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          (convertedcode @ [BImmOp (MoreEqI, xreg, i, register)], m)
        )
      | (SimpleVariable (x), SimpleInteger (i)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          (convertedcode @ [BImmOp (LessEqI, xreg, i, register)], m)
        )
      | (SimpleInteger (i), a) -> (
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BImmOp (MoreEqI, partialresreg, i, register)], m)
        )
      | (a, SimpleInteger (i)) -> (
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BImmOp (LessEqI, partialresreg, i, register)], m)
        )
      | (SimpleVariable (x), SimpleVariable (y)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let yreg, m = RegisterMap.get_or_set_register y m in
          (convertedcode @ [BRegOp (LessEq, xreg, yreg, register)], m)
        )
      | (SimpleVariable (x), a) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BRegOp (LessEq, xreg, partialresreg, register)], m)
        )
      | (a, SimpleVariable (x)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BRegOp (LessEq, partialresreg, xreg, register)], m)
        )
      | (_, _) -> (
          let partialresreg1, m, _partialresvar1 =
            RegisterMap.get_fresh_register m
          in
          let partialresreg2, m, _partialresvar2 =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a1 m convertedcode partialresreg1 in
          let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in
          (convertedcode @
           [BRegOp (LessEq, partialresreg1, partialresreg2, register)], m)
        )
    )
  | SimpleBCmpGreater (a1, a2) -> (
      match (a1, a2) with
      | (SimpleInteger (i), SimpleVariable (x)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          (convertedcode @ [BImmOp (LessI, xreg, i, register)], m)
        )
      | (SimpleVariable (x), SimpleInteger (i)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          (convertedcode @ [BImmOp (MoreI, xreg, i, register)], m)
        )
      | (SimpleInteger (i), a) -> (
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BImmOp (LessI, partialresreg, i, register)], m)
        )
      | (a, SimpleInteger (i)) -> (
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BImmOp (MoreI, partialresreg, i, register)], m)
        )
      | (SimpleVariable (x), SimpleVariable (y)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let yreg, m = RegisterMap.get_or_set_register y m in
          (convertedcode @ [BRegOp (More, xreg, yreg, register)], m)
        )
      | (SimpleVariable (x), a) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BRegOp (More, xreg, partialresreg, register)], m)
        )
      | (a, SimpleVariable (x)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BRegOp (More, partialresreg, xreg, register)], m)
        )
      | (_, _) -> (
          let partialresreg1, m, _partialresvar1 =
            RegisterMap.get_fresh_register m
          in
          let partialresreg2, m, _partialresvar2 =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a1 m convertedcode partialresreg1 in
          let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in
          (convertedcode @
           [BRegOp (More, partialresreg1, partialresreg2, register)], m)
        )
    )
  | SimpleBCmpGreaterEq (a1, a2) -> (
      match (a1, a2) with
      | (SimpleInteger (i), SimpleVariable (x)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          (convertedcode @ [BImmOp (LessEqI, xreg, i, register)], m)
        )
      | (SimpleVariable (x), SimpleInteger (i)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          (convertedcode @ [BImmOp (MoreEqI, xreg, i, register)], m)
        )
      | (SimpleInteger (i), a) -> (
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BImmOp (LessEqI, partialresreg, i, register)], m)
        )
      | (a, SimpleInteger (i)) -> (
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BImmOp (MoreEqI, partialresreg, i, register)], m)
        )
      | (SimpleVariable (x), SimpleVariable (y)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let yreg, m = RegisterMap.get_or_set_register y m in
          (convertedcode @ [BRegOp (MoreEq, xreg, yreg, register)], m)
        )
      | (SimpleVariable (x), a) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BRegOp (MoreEq, xreg, partialresreg, register)], m)
        )
      | (a, SimpleVariable (x)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BRegOp (MoreEq, partialresreg, xreg, register)], m)
        )
      | (_, _) -> (
          let partialresreg1, m, _partialresvar1 =
            RegisterMap.get_fresh_register m
          in
          let partialresreg2, m, _partialresvar2 =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a1 m convertedcode partialresreg1 in
          let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in
          (convertedcode @
           [BRegOp (MoreEq, partialresreg1, partialresreg2, register)], m)
        )
    )

(* converts a arithmetic simple statement into RISC simple statements, requires
   the register where the result sould be put into, does a lookahead to optimize
   with operations where an integer is one side of the operation *)
and c_ss_sa
    (ss: CfgImp.SimpleStatements.simpleArithmetic)
    (m: RegisterMap.m)
    (convertedcode: RISCSimpleStatements.t list)
    (register: RISCSimpleStatements.register)
  : RISCSimpleStatements.t list * RegisterMap.m =
  match ss with
    SimpleVariable (x) -> (
      let r1, m = RegisterMap.get_or_set_register x m in
      (convertedcode @ [URegOp (Copy, r1, register)], m)
    )
  | SimpleInteger (i) -> (
      (convertedcode @ [LoadI (i, register)], m)
    )
  | SimplePlus (a1, a2) -> (
      match (a1, a2) with
      | (SimpleInteger (i), SimpleVariable (x))
      | (SimpleVariable (x), SimpleInteger (i)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          (convertedcode @ [BImmOp (AddI, xreg, i, register)], m)
        )
      | (SimpleInteger (i), a)
      | (a, SimpleInteger (i)) -> (
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BImmOp (AddI, partialresreg, i, register)], m)
        )
      | (SimpleVariable (x), SimpleVariable (y)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let yreg, m = RegisterMap.get_or_set_register y m in
          (convertedcode @ [BRegOp (Add, xreg, yreg, register)], m)
        )
      | (SimpleVariable (x), a)
      | (a, SimpleVariable (x)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BRegOp (Add, partialresreg, xreg, register)], m)
        )
      | (_, _) -> (
          let partialresreg1, m, _partialresvar1 =
            RegisterMap.get_fresh_register m
          in
          let partialresreg2, m, _partialresvar2 =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a1 m convertedcode partialresreg1 in
          let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in
          (convertedcode @
           [BRegOp (Add, partialresreg1, partialresreg2, register)], m)
        )
    )
  | SimpleMinus (a1, a2) -> (
      match (a1, a2) with
      | (SimpleInteger (i), SimpleVariable (x)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          (convertedcode @
           [LoadI (i, partialresreg);
            BRegOp (Sub, partialresreg, xreg, register)], m)
        )
      | (SimpleVariable (x), SimpleInteger (i)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          (convertedcode @ [BImmOp (SubI, xreg, i, register)], m)
        )
      | (SimpleInteger (i), a) -> (
          let partialresregi, m, _partialresvari =
            RegisterMap.get_fresh_register m
          in
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @
           [LoadI (i, partialresregi);
            BRegOp (Sub, partialresregi, partialresreg, register)], m)
        )
      | (a, SimpleInteger (i)) -> (
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BImmOp (SubI, partialresreg, i, register)], m)
        )
      | (SimpleVariable (x), SimpleVariable (y)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let yreg, m = RegisterMap.get_or_set_register y m in
          (convertedcode @ [BRegOp (Sub, xreg, yreg, register)], m)
        )
      | (SimpleVariable (x), a) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BRegOp (Sub, xreg, partialresreg, register)], m)
        )
      | (a, SimpleVariable (x)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BRegOp (Sub, partialresreg, xreg, register)], m)
        )
      | (_, _) -> (
          let partialresreg1, m, _partialresvar1 =
            RegisterMap.get_fresh_register m
          in
          let partialresreg2, m, _partialresvar2 =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a1 m convertedcode partialresreg1 in
          let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in
          (convertedcode @
           [BRegOp (Sub, partialresreg1, partialresreg2, register)], m)
        )
    )
  | SimpleTimes (a1, a2) -> (
      match (a1, a2) with
      | (SimpleInteger (i), SimpleVariable (x))
      | (SimpleVariable (x), SimpleInteger (i)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          (convertedcode @ [BImmOp (MultI, xreg, i, register)], m)
        )
      | (SimpleInteger (i), a)
      | (a, SimpleInteger (i)) -> (
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BImmOp (MultI, partialresreg, i, register)], m)
        )
      | (SimpleVariable (x), SimpleVariable (y)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let yreg, m = RegisterMap.get_or_set_register y m in
          (convertedcode @ [BRegOp (Mult, xreg, yreg, register)], m)
        )
      | (SimpleVariable (x), a)
      | (a, SimpleVariable (x)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BRegOp (Mult, partialresreg, xreg, register)], m)
        )
      | (_, _) -> (
          let partialresreg1, m, _partialresvar1 =
            RegisterMap.get_fresh_register m
          in
          let partialresreg2, m, _partialresvar2 =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a1 m convertedcode partialresreg1 in
          let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in
          (convertedcode @
           [BRegOp (Mult, partialresreg1, partialresreg2, register)], m)
        )
    )
  | SimpleDivision (a1, a2) -> (
      match (a1, a2) with
      | (SimpleInteger (i), SimpleVariable (x)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          (convertedcode @
           [LoadI (i, partialresreg);
            BRegOp (Div, partialresreg, xreg, register)], m)
        )
      | (SimpleVariable (x), SimpleInteger (i)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          (convertedcode @ [BImmOp (DivI, xreg, i, register)], m)
        )
      | (SimpleInteger (i), a) -> (
          let partialresregi, m, _partialresvari =
            RegisterMap.get_fresh_register m
          in
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @
           [LoadI (i, partialresregi);
            BRegOp (Div, partialresregi, partialresreg, register)], m)
        )
      | (a, SimpleInteger (i)) -> (
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BImmOp (DivI, partialresreg, i, register)], m)
        )
      | (SimpleVariable (x), SimpleVariable (y)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let yreg, m = RegisterMap.get_or_set_register y m in
          (convertedcode @ [BRegOp (Div, xreg, yreg, register)], m)
        )
      | (SimpleVariable (x), a) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BRegOp (Div, xreg, partialresreg, register)], m)
        )
      | (a, SimpleVariable (x)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BRegOp (Div, partialresreg, xreg, register)], m)
        )
      | (_, _) -> (
          let partialresreg1, m, _partialresvar1 =
            RegisterMap.get_fresh_register m
          in
          let partialresreg2, m, _partialresvar2 =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a1 m convertedcode partialresreg1 in
          let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in
          (convertedcode @
           [BRegOp (Div, partialresreg1, partialresreg2, register)], m)
        )
    )
  | SimpleModulo (a1, a2) -> (
      match (a1, a2) with
      | (SimpleInteger (i), SimpleVariable (x)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          (convertedcode @
           [LoadI (i, partialresreg);
            BRegOp (Mod, partialresreg, xreg, register)], m)
        )
      | (SimpleVariable (x), SimpleInteger (i)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          (convertedcode @ [BImmOp (ModI, xreg, i, register)], m)
        )
      | (SimpleInteger (i), a) -> (
          let partialresregi, m, _partialresvari =
            RegisterMap.get_fresh_register m
          in
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @
           [LoadI (i, partialresregi);
            BRegOp (Mod, partialresregi, partialresreg, register)], m)
        )
      | (a, SimpleInteger (i)) -> (
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BImmOp (ModI, partialresreg, i, register)], m)
        )
      | (SimpleVariable (x), SimpleVariable (y)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let yreg, m = RegisterMap.get_or_set_register y m in
          (convertedcode @ [BRegOp (Mod, xreg, yreg, register)], m)
        )
      | (SimpleVariable (x), a) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BRegOp (Mod, xreg, partialresreg, register)], m)
        )
      | (a, SimpleVariable (x)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BRegOp (Mod, partialresreg, xreg, register)], m)
        )
      | (_, _) -> (
          let partialresreg1, m, _partialresvar1 =
            RegisterMap.get_fresh_register m
          in
          let partialresreg2, m, _partialresvar2 =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a1 m convertedcode partialresreg1 in
          let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in
          (convertedcode @
           [BRegOp (Mod, partialresreg1, partialresreg2, register)], m)
        )
    )
  | SimplePower (a1, a2) -> (
      match (a1, a2) with
      | (SimpleInteger (i), SimpleVariable (x)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          (convertedcode @
           [LoadI (i, partialresreg);
            BRegOp (Pow, partialresreg, xreg, register)], m)
        )
      | (SimpleVariable (x), SimpleInteger (i)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          (convertedcode @ [BImmOp (PowI, xreg, i, register)], m)
        )
      | (SimpleInteger (i), a) -> (
          let partialresregi, m, _partialresvari =
            RegisterMap.get_fresh_register m
          in
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @
           [LoadI (i, partialresregi);
            BRegOp (Pow, partialresregi, partialresreg, register)], m)
        )
      | (a, SimpleInteger (i)) -> (
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BImmOp (PowI, partialresreg, i, register)], m)
        )
      | (SimpleVariable (x), SimpleVariable (y)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let yreg, m = RegisterMap.get_or_set_register y m in
          (convertedcode @ [BRegOp (Pow, xreg, yreg, register)], m)
        )
      | (SimpleVariable (x), a) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BRegOp (Pow, xreg, partialresreg, register)], m)
        )
      | (a, SimpleVariable (x)) -> (
          let xreg, m = RegisterMap.get_or_set_register x m in
          let partialresreg, m, _partialresvar =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
          (convertedcode @ [BRegOp (Pow, partialresreg, xreg, register)], m)
        )
      | (_, _) -> (
          let partialresreg1, m, _partialresvar1 =
            RegisterMap.get_fresh_register m
          in
          let partialresreg2, m, _partialresvar2 =
            RegisterMap.get_fresh_register m
          in
          let convertedcode, m = c_ss_sa a1 m convertedcode partialresreg1 in
          let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in
          (convertedcode @
           [BRegOp (Pow, partialresreg1, partialresreg2, register)], m)
        )
    )
  | SimpleRand (a) -> (
      let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
      let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
      (convertedcode @ [URegOp (Rand, partialresreg, register)], m)
    )

let convert_ss
    (m: RegisterMap.m)
    (value: CfgImp.SimpleStatements.t list)
    (node: Cfg.Node.t)
    (risccode: RISCSimpleStatements.t list Cfg.NodeMap.t)
  : RISCSimpleStatements.t list Cfg.NodeMap.t * RegisterMap.m =
  (* we iterate over the list of simple statements and convert each operation to
     the equivalent three address operations, we need to propagate the
     association between variables and registers so we choose a fold instead of
     a mapreduce *)
  let instructions, m = List.fold_left
      (fun (convertedcode, m) code -> c_ss_t code m convertedcode)
      ([], m) value
  in
  (Cfg.NodeMap.add node instructions risccode, m)

let helper
    (c: CfgImp.SimpleStatements.t list Cfg.NodeMap.t)
    (m: RegisterMap.m)
  : RISCSimpleStatements.t list Cfg.NodeMap.t =
  (*  *)
  (* we use NodeMap.fold since order is not important, we assume that every
     has an associated register and we ignore use before assignment errors *)
  let risccode, _ = Cfg.NodeMap.fold
      (fun node value (risccode, m) -> convert_ss m value node risccode)
      c (Cfg.NodeMap.empty, m)
  in
  risccode

let convert (prg: CfgImp.SSCfg.t) : RISCCfg.t =
  let ({ empty: bool;
         nodes: Cfg.NodeSet.t;
         edges: (Cfg.Node.t * (Cfg.Node.t option)) Cfg.NodeMap.t;
         reverseEdges: (Cfg.Node.t list) Cfg.NodeMap.t;
         inputVal: int option;
         inputOutputVar: (string * string) option;
         initial: Cfg.Node.t option;
         terminal: Cfg.Node.t option;
         content: CfgImp.SimpleStatements.t list Cfg.NodeMap.t
       }: CfgImp.SSCfg.t) = prg
  in
  let initial_bindings =
    match inputOutputVar with
    | 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
  { empty = empty;
    nodes = nodes;
    edges = edges;
    reverseEdges = reverseEdges;
    inputVal = inputVal;
    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;
  }