lci/lib/miniImp/RISCSemantics.ml

module Register = struct
  type t = {index: string}

  let compare a b = compare a.index b.index
end


module CodeMap = Map.Make(String)
module RegisterMap = Map.Make(Register)
module MemoryMap = Map.Make(Int)

module RISCArchitecture = struct
  type t = {
    code: RISC.RISCAssembly.risci list CodeMap.t;
    registers: int RegisterMap.t;
    memory: int MemoryMap.t;
    outputreg: Register.t;
  }
end

let convert (prg: RISC.RISCAssembly.t)
  : RISC.RISCAssembly.risci list CodeMap.t =
  (* takes as input a sequence of RISC commands and computes a map to the right
     labels for easier execution *)
  let rec aux
      (prg: RISC.RISCAssembly.risci list)
      (current: RISC.RISCAssembly.risci list)
      (current_label: string)
      (map: RISC.RISCAssembly.risci list CodeMap.t)
    : (RISC.RISCAssembly.risci list CodeMap.t) =
    match prg with
    | [] -> (CodeMap.union
               (fun _ _ _ -> failwith "Two labels are the same")
               (CodeMap.singleton current_label current)
               map)
    | Label l :: tl -> aux tl ([]) l
                         (CodeMap.union
                            (fun _ _ _ -> failwith "Two labels are the same")
                            (CodeMap.singleton current_label current)
                            map)
    | instr :: tl -> aux tl (current @ [instr]) current_label map
  in
  match prg.code with
  | Label "main" :: tl -> aux tl [] "main" CodeMap.empty
  | _ -> failwith "Program should begind with label main"

let label_order (prg: RISC.RISCAssembly.t) : string list =
  let rec aux
      (prg: RISC.RISCAssembly.risci list)
    : string list =
    match prg with
      [] -> []
    | Label l :: tl -> l :: (aux tl)
    | _ :: tl -> (aux tl)
  in
  aux (prg.code)

let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
  let match_operator_r (brop: RISC.RISCAssembly.brop) =
    match brop with
    | Add -> (+)
    | Sub -> (-)
    | Mult -> ( * )
    | Div -> (/)
    | Mod -> (mod)
    | Pow -> (Utility.pow)
    | And -> (Utility.int_and)
    | Or -> (Utility.int_or)
    | Eq -> (Utility.int_eq)
    | Less -> (Utility.int_less)
    | LessEq -> (Utility.int_less_eq)
    | More -> (Utility.int_more)
    | MoreEq -> (Utility.int_more_eq)
  in
  let match_operator_i (biop: RISC.RISCAssembly.biop) =
    match biop with
    | AddI -> (+)
    | SubI -> (-)
    | MultI -> ( * )
    | DivI -> (/)
    | ModI -> (mod)
    | PowI -> (Utility.pow)
    | AndI -> (Utility.int_and)
    | OrI -> (Utility.int_or)
    | EqI -> (Utility.int_eq)
    | LessI -> (Utility.int_less)
    | LessEqI -> (Utility.int_less_eq)
    | MoreI -> (Utility.int_more)
    | MoreEqI -> (Utility.int_more_eq)
  in

  let rec aux
      (prg: RISCArchitecture.t)
      (current: RISC.RISCAssembly.risci list)
      (current_label: string)
    : RISCArchitecture.t =
    match current with
    | [] -> (
        (* falls to the next label *)
        match List.find_index ((=) current_label) lo with
          None -> prg (* should never happen *)
        | Some i ->
          if i + 1 < (List.length lo) then
            aux
              prg
              (CodeMap.find (List.nth lo (i+1)) prg.code)
              (List.nth lo (i+1))
          else
            prg
      )
    | Nop :: tl ->
      aux prg tl current_label
    | BRegOp (brop, r1, r2, r3) :: tl -> (
        let n = (match_operator_r brop)
            (RegisterMap.find {index = r1.index} prg.registers)
            (RegisterMap.find {index = r2.index} prg.registers)
        in
        aux { prg with
                 registers = RegisterMap.add {index = r3.index} n prg.registers}
          tl current_label
      )
    | BImmOp (biop, r1, i, r3) :: tl -> (
        let n = (match_operator_i biop)
            (RegisterMap.find {index = r1.index} prg.registers)
            i
        in
        aux { prg with
                 registers = RegisterMap.add {index = r3.index} n prg.registers}
          tl current_label
      )
    | URegOp (urop, r1, r3) :: tl -> (
        match urop with
        | Copy -> (
            let n = RegisterMap.find {index = r1.index} prg.registers in
            aux { prg with
                     registers =
                       RegisterMap.add {index = r3.index} n prg.registers }
              tl current_label
          )
        | Not -> (
            let n = Utility.int_not
                (RegisterMap.find {index = r1.index} prg.registers)
            in
            aux { prg with
                     registers =
                       RegisterMap.add {index = r3.index} n prg.registers }
              tl current_label
          )
        | Rand -> (
            let n = Random.int
                (RegisterMap.find {index = r1.index} prg.registers)
            in
            aux { prg with
                     registers =
                       RegisterMap.add {index = r3.index} n prg.registers }
              tl current_label
          )
      )
    | Load (r1, r3) :: tl -> (
        let n =
          MemoryMap.find
            (RegisterMap.find {index = r1.index} prg.registers)
            prg.memory
        in
        aux { prg with
                 registers = RegisterMap.add {index = r3.index} n prg.registers}
          tl current_label
      )
    | LoadI (i, r3) :: tl -> (
        let n = i
        in
        aux { prg with
                 registers = RegisterMap.add {index = r3.index} n prg.registers}
          tl current_label
      )
    | Store (r1, r3) :: tl -> (
        let n = RegisterMap.find {index = r1.index} prg.registers in
        let n1 = RegisterMap.find {index = r3.index} prg.registers in
        aux
          { prg with memory = MemoryMap.add n1 n prg.memory }
          tl
          current_label
      )
    | Jump l :: _ -> aux prg (CodeMap.find l prg.code) l
    | CJump (r, l1, l2) :: _ -> (
        let br = (RegisterMap.find {index = r.index} prg.registers) > 0 in
        if br
        then
          aux prg (CodeMap.find l1 prg.code) l1
        else
          aux prg (CodeMap.find l2 prg.code) l2
      )
    | Label _ :: tl -> aux prg tl current_label
  in
  match
    RegisterMap.find_opt
      prg.outputreg
      (aux prg (CodeMap.find "main" prg.code) "main").registers
  with
    Some x -> x
  | None -> failwith "Output register not found"


let reduce (prg: RISC.RISCAssembly.t) : int =
  (* takes assembly and execute it *)
  reduce_instructions
    {code = convert prg;
     registers = (
       match prg.inputoutputreg with
       | None ->
         RegisterMap.singleton
           {index = "in"}
           (Option.value prg.inputval ~default:0)
       | 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)