diff --git a/bin/main.ml b/bin/main.ml index 832d583..4b5bd64 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -1,5 +1,4 @@ open MiniImp -open MiniImp.CfgImp let () = let program = "def main with input x output y as @@ -10,11 +9,14 @@ let () = ) else x := 1 - y;" in - let get_result x = Lexing.from_string x |> Parser.prg Lexer.lex in let p = get_result program in - let converted = convert p in + let convertedcfg = CfgImp.convert_io p 3 in - Printf.printf "%a" SSCfg.pp converted + Printf.printf "%a" CfgImp.SSCfg.pp convertedcfg; + + let convertedrisccfg = CfgRISC.convert convertedcfg in + + Printf.printf "%a" CfgRISC.RISCCfg.pp convertedrisccfg diff --git a/lib/cfg/Cfg.ml b/lib/cfg/Cfg.ml index b0b61e2..70e26a9 100644 --- a/lib/cfg/Cfg.ml +++ b/lib/cfg/Cfg.ml @@ -28,14 +28,14 @@ module type C = sig nodes: NodeSet.t; edges: (Node.t * (Node.t option)) NodeMap.t; reverseEdges: (Node.t list) NodeMap.t; - inputVal: elt option; - outputVal: elt option; + inputVal: int option; + inputOutputVar: (string * string) option; initial: Node.t option; terminal: Node.t option; content: elt list NodeMap.t } - val create : unit -> t + val empty : t val merge : t -> t -> Node.t -> Node.t -> t val concat : t -> t -> t val addToLastNode : elt -> t -> t @@ -50,20 +50,20 @@ module Make(M: PrintableType) = struct nodes: NodeSet.t; edges: (Node.t * (Node.t option)) NodeMap.t; reverseEdges: (Node.t list) NodeMap.t; - inputVal: elt option; - outputVal: elt option; + inputVal: int option; + inputOutputVar: (string * string) option; initial: Node.t option; terminal: Node.t option; content: elt list NodeMap.t } - let create () : t = + let empty : t = { empty = true; nodes = NodeSet.empty; edges = NodeMap.empty; reverseEdges = NodeMap.empty; inputVal = None; - outputVal = None; + inputOutputVar = None; initial = None; terminal = None; content = NodeMap.empty } @@ -93,7 +93,7 @@ module Make(M: PrintableType) = struct NodeMap.add_to_list exitNode cfg1terminal |> NodeMap.add_to_list exitNode cfg2terminal; inputVal = cfg1.inputVal; - outputVal = cfg1.outputVal; + inputOutputVar = cfg1.inputOutputVar; initial = Some entryNode; terminal = Some exitNode; content = NodeMap.union (fun _ -> failwith "Failed merging code of cfg.") @@ -118,7 +118,7 @@ module Make(M: PrintableType) = struct cfg1.reverseEdges cfg2.reverseEdges |> NodeMap.add_to_list cfg2initial cfg1terminal; inputVal = cfg1.inputVal; - outputVal = cfg1.outputVal; + inputOutputVar = cfg1.inputOutputVar; initial = Some cfg1initial; terminal = Some cfg2terminal; content = NodeMap.union (fun _ -> failwith "Failed merging code of cfg.") @@ -133,7 +133,7 @@ module Make(M: PrintableType) = struct edges = NodeMap.empty; reverseEdges = NodeMap.empty; inputVal = None; - outputVal = None; + inputOutputVar = None; initial = Some newnode; terminal = Some newnode; content = NodeMap.singleton newnode [newcontent] @@ -168,13 +168,13 @@ module Make(M: PrintableType) = struct Printf.fprintf ppf "Input Value: "; (match c.inputVal with - Some i -> Printf.fprintf ppf "%a" M.pp (i); + Some i -> Printf.fprintf ppf "%d" i; | None -> Printf.fprintf ppf "None";); Printf.fprintf ppf "\n"; - Printf.fprintf ppf "Output Value: "; - (match c.outputVal with - Some i -> Printf.fprintf ppf "%a" M.pp (i); + Printf.fprintf ppf "Input and Output Vars: "; + (match c.inputOutputVar with + Some (i, o) -> Printf.fprintf ppf "(in: %s, out: %s)" i o; | None -> Printf.fprintf ppf "None";); Printf.fprintf ppf "\n"; diff --git a/lib/cfg/Cfg.mli b/lib/cfg/Cfg.mli index 6a61e03..1c23d2d 100644 --- a/lib/cfg/Cfg.mli +++ b/lib/cfg/Cfg.mli @@ -5,7 +5,9 @@ module type PrintableType = sig end module Node : sig - type t + type t = { + id: int + } val compare : t -> t -> int val create : unit -> t end @@ -20,14 +22,14 @@ module type C = sig nodes: NodeSet.t; edges: (Node.t * (Node.t option)) NodeMap.t; reverseEdges: (Node.t list) NodeMap.t; - inputVal: elt option; - outputVal: elt option; + inputVal: int option; + inputOutputVar: (string * string) option; initial: Node.t option; terminal: Node.t option; content: elt list NodeMap.t } - val create : unit -> t + val empty : t val merge : t -> t -> Node.t -> Node.t -> t val concat : t -> t -> t val addToLastNode : elt -> t -> t diff --git a/lib/miniImp/CfgImp.ml b/lib/miniImp/CfgImp.ml index be8db0e..6655d30 100644 --- a/lib/miniImp/CfgImp.ml +++ b/lib/miniImp/CfgImp.ml @@ -76,8 +76,8 @@ let rec convert_c (prevcfg: SSCfg.t) (prg: Types.c_exp) : SSCfg.t = cfg2 | If (b, c1, c2) -> let convertedb = convert_b b in - let cfg1 = convert_c (SSCfg.create ()) c1 in - let cfg2 = convert_c (SSCfg.create ()) c2 in + let cfg1 = convert_c SSCfg.empty c1 in + let cfg2 = convert_c SSCfg.empty c2 in let entrynode = Node.create () in let exitnode = Node.create () in let newcfg = SSCfg.merge cfg1 cfg2 entrynode exitnode in @@ -88,7 +88,7 @@ let rec convert_c (prevcfg: SSCfg.t) (prg: Types.c_exp) : SSCfg.t = NodeMap.add_to_list exitnode (SimpleSkip) } | While (b, c) -> let convertedb = convert_b b in - let cfg = convert_c (SSCfg.create ()) c in + let cfg = convert_c SSCfg.empty c in let cfginitial = Option.get cfg.initial in let cfgterminal = Option.get cfg.terminal in let entrynode = Node.create () in @@ -109,17 +109,17 @@ let rec convert_c (prevcfg: SSCfg.t) (prg: Types.c_exp) : SSCfg.t = NodeMap.add_to_list exitnode guardnode |> NodeMap.add_to_list guardnode cfgterminal; inputVal = prevcfg.inputVal; - outputVal = prevcfg.outputVal; + inputOutputVar = prevcfg.inputOutputVar; initial = Some entrynode; terminal = Some exitnode; content = NodeMap.add_to_list guardnode (SimpleGuard (convertedb)) cfg.content |> NodeMap.add_to_list exitnode (SimpleSkip) } |> SSCfg.concat prevcfg | For (assignment, guard, increment, body) -> - let cfgassignment = convert_c (SSCfg.create ()) assignment in + let cfgassignment = convert_c SSCfg.empty assignment in let convertedguard = convert_b guard in - let cfgincrement = convert_c (SSCfg.create ()) increment in - let cfgbody = convert_c (SSCfg.create ()) body in + let cfgincrement = convert_c SSCfg.empty increment in + let cfgbody = convert_c SSCfg.empty body in let prevassignment = SSCfg.concat prevcfg cfgassignment in let bodyincrement = SSCfg.concat cfgbody cfgincrement in @@ -141,7 +141,7 @@ let rec convert_c (prevcfg: SSCfg.t) (prg: Types.c_exp) : SSCfg.t = NodeMap.add_to_list exitnode guardnode |> NodeMap.add_to_list guardnode cfgterminal; inputVal = prevcfg.inputVal; - outputVal = prevcfg.outputVal; + inputOutputVar = prevcfg.inputOutputVar; initial = Some guardnode; terminal = Some exitnode; content = NodeMap.add_to_list guardnode (SimpleGuard (convertedguard)) bodyincrement.content |> @@ -174,9 +174,9 @@ and convert_a (prg: Types.a_exp) : SimpleStatements.simpleArithmetic = | Rand (a) -> SimpleRand (convert_a a) let convert (prg: Types.p_exp) : SSCfg.t = - let result = - match prg with - | Main (_, _, exp) -> - convert_c (SSCfg.create ()) exp - in - {result with inputVal = None; outputVal = None} + match prg with + | Main (i, o, exp) -> + {(convert_c SSCfg.empty exp) with inputOutputVar = Some (i, o)} + +let convert_io (prg: Types.p_exp) (i: int) : SSCfg.t = + {(convert prg) with inputVal = Some i} diff --git a/lib/miniImp/CfgImp.mli b/lib/miniImp/CfgImp.mli index 6f73010..b0f7035 100644 --- a/lib/miniImp/CfgImp.mli +++ b/lib/miniImp/CfgImp.mli @@ -32,3 +32,4 @@ end module SSCfg : Cfg.C with type elt = SimpleStatements.t val convert : Types.p_exp -> SSCfg.t +val convert_io : Types.p_exp -> int -> SSCfg.t diff --git a/lib/miniImp/CfgRISC.ml b/lib/miniImp/CfgRISC.ml new file mode 100644 index 0000000..7c6d42e --- /dev/null +++ b/lib/miniImp/CfgRISC.ml @@ -0,0 +1,459 @@ +module RISCSimpleStatements = struct + type register = { + index: int + } + + 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 register * int + | 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%d r%d => r%d" pp_brop b r1.index r2.index r3.index + | BImmOp (b, r1, i, r3) -> Printf.fprintf ppf "%a r%d %d => r%d" pp_biop b r1.index i r3.index + | URegOp (u, r1, r2) -> Printf.fprintf ppf "%a r%d => r%d" pp_urop u r1.index r2.index + | Load (r1, r2) -> Printf.fprintf ppf "load r%d => r%d" r1.index r2.index + | LoadI (r2, i) -> Printf.fprintf ppf "loadi %d => r%d" i r2.index + | Store (r1, r2) -> Printf.fprintf ppf "store r%d => r%d" 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: int Types.VariableMap.t + } + let _get_opt_register (x: Types.variable) (m: m) : RISCSimpleStatements.register option = + Option.bind + (Types.VariableMap.find_opt x m.assignments) + (fun (x: int) : RISCSimpleStatements.register option -> Some {index = x}) + + 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 = !globalcounter}, {assignments = Types.VariableMap.add x !globalcounter m.assignments}) ) + | Some i -> ({index = i}, m) + + let get_fresh_register (m: m) : RISCSimpleStatements.register * m * Types.variable = + globalcounter := !globalcounter + 1; + let freshvariable = string_of_int !globalcounter in + ({index = !globalcounter}, + {assignments = Types.VariableMap.add freshvariable !globalcounter m.assignments}, + freshvariable) + + let empty : m = + {assignments = Types.VariableMap.empty} + + (* let pp (ppx) (m: m) : unit = *) + (* Printf.fprintf ppx "RegisterMap contents: "; *) + (* List.iter (fun (n, v) -> Printf.fprintf ppx "%s -> %d, " n v) (Types.VariableMap.to_list m.assignments); *) + (* Printf.fprintf ppx "\n"; *) +end + + +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 -> (Nop :: convertedcode, 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 + ) +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 + (LoadI (partialresreg, 1) :: convertedcode, m) + else + (LoadI (partialresreg, 0) :: convertedcode, 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)) -> ( + (LoadI (register, 0) :: 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 + (BRegOp (And, partialresreg1, partialresreg2, register) :: convertedcode, 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 (register, 1) :: 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 + (BRegOp (Or, partialresreg1, partialresreg2, register) :: convertedcode, m) + ) + ) + | SimpleBNot (b) -> ( + match (b) with + | SimpleBoolean (b) ->( + if b then + (LoadI (register, 0) :: convertedcode, m) + else + (LoadI (register, 1) :: convertedcode, m) + ) + | _ -> ( + let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in + let convertedcode, m = c_ss_sb b m convertedcode partialresreg in + (URegOp (Not, partialresreg, register) :: convertedcode, m) + ) + ) + | SimpleBCmp (a1, a2) -> ( + match (a1, a2) with + | (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 + (BImmOp (EqI, partialresreg, i, 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_sa a1 m convertedcode partialresreg1 in + let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in + (BRegOp (Eq, partialresreg1, partialresreg2, register) :: convertedcode, m) + ) + ) + | SimpleBCmpLess (a1, a2) -> ( + match (a1, a2) with + | (SimpleInteger (i), a) -> ( + let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in + let convertedcode, m = c_ss_sa a m convertedcode partialresreg in + (BImmOp (MoreI, partialresreg, i, register) :: convertedcode, 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 + (BImmOp (LessI, partialresreg, i, 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_sa a1 m convertedcode partialresreg1 in + let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in + (BRegOp (Less, partialresreg1, partialresreg2, register) :: convertedcode, m) + ) + ) + | SimpleBCmpLessEq (a1, a2) -> ( + match (a1, a2) with + | (SimpleInteger (i), a) -> ( + let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in + let convertedcode, m = c_ss_sa a m convertedcode partialresreg in + (BImmOp (MoreEqI, partialresreg, i, register) :: convertedcode, 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 + (BImmOp (LessEqI, partialresreg, i, 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_sa a1 m convertedcode partialresreg1 in + let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in + (BRegOp (LessEq, partialresreg1, partialresreg2, register) :: convertedcode, m) + ) + ) + | SimpleBCmpGreater (a1, a2) -> ( + match (a1, a2) with + | (SimpleInteger (i), a) -> ( + let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in + let convertedcode, m = c_ss_sa a m convertedcode partialresreg in + (BImmOp (LessI, partialresreg, i, register) :: convertedcode, 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 + (BImmOp (MoreI, partialresreg, i, 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_sa a1 m convertedcode partialresreg1 in + let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in + (BRegOp (More, partialresreg1, partialresreg2, register) :: convertedcode, m) + ) + ) + | SimpleBCmpGreaterEq (a1, a2) -> ( + match (a1, a2) with + | (SimpleInteger (i), a) -> ( + let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in + let convertedcode, m = c_ss_sa a m convertedcode partialresreg in + (BImmOp (LessEqI, partialresreg, i, register) :: convertedcode, 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 + (BImmOp (MoreEqI, partialresreg, i, 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_sa a1 m convertedcode partialresreg1 in + let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in + (BRegOp (MoreEq, partialresreg1, partialresreg2, register) :: convertedcode, m) + ) + ) + +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 + (Load (r1, register) :: convertedcode, m) + ) + | SimpleInteger (i) -> (LoadI (register, i) :: convertedcode, m) + | SimplePlus (a1, a2) -> ( + match (a1, a2) with + | (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 + (BImmOp (AddI, partialresreg, i, 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_sa a1 m convertedcode partialresreg1 in + let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in + (BRegOp (Add, partialresreg1, partialresreg2, register) :: convertedcode, m) + ) + ) + | SimpleMinus (a1, a2) -> ( + match (a1, a2) with + | (a, SimpleInteger (i)) -> ( + let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in + let convertedcode, m = c_ss_sa a m convertedcode partialresreg in + (BImmOp (SubI, partialresreg, i, 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_sa a1 m convertedcode partialresreg1 in + let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in + (BRegOp (Sub, partialresreg1, partialresreg2, register) :: convertedcode, m) + ) + ) + | SimpleTimes (a1, a2) -> ( + match (a1, a2) with + | (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 + (BImmOp (MultI, partialresreg, i, 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_sa a1 m convertedcode partialresreg1 in + let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in + (BRegOp (Mult, partialresreg1, partialresreg2, register) :: convertedcode, m) + ) + ) + | SimpleDivision (a1, a2) -> ( + match (a1, a2) with + | (a, SimpleInteger (i)) -> ( + let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in + let convertedcode, m = c_ss_sa a m convertedcode partialresreg in + (BImmOp (DivI, partialresreg, i, 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_sa a1 m convertedcode partialresreg1 in + let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in + (BRegOp (Div, partialresreg1, partialresreg2, register) :: convertedcode, m) + ) + ) + | SimpleModulo (a1, a2) -> ( + match (a1, a2) with + | (a, SimpleInteger (i)) -> ( + let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in + let convertedcode, m = c_ss_sa a m convertedcode partialresreg in + (BImmOp (ModI, partialresreg, i, 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_sa a1 m convertedcode partialresreg1 in + let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in + (BRegOp (Mod, partialresreg1, partialresreg2, register) :: convertedcode, m) + ) + ) + | SimplePower (a1, a2) -> ( + match (a1, a2) with + | (a, SimpleInteger (i)) -> ( + let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in + let convertedcode, m = c_ss_sa a m convertedcode partialresreg in + (BImmOp (PowI, partialresreg, i, 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_sa a1 m convertedcode partialresreg1 in + let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in + (BRegOp (Pow, partialresreg1, partialresreg2, register) :: convertedcode, m) + ) + ) + | SimplePowerMod (_a1, _a2, _a3) -> failwith "Not implemented Powermod" + | SimpleRand (a) -> ( + let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in + let convertedcode, m = c_ss_sa a m convertedcode partialresreg in + (URegOp (Rand, partialresreg, register) :: convertedcode, 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 = + let instructions, m = List.fold_right (fun code (convertedcode, m) -> + c_ss_t code m convertedcode) value ([], m) 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 = + 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_content (c: CfgImp.SimpleStatements.t list Cfg.NodeMap.t) : RISCSimpleStatements.t list Cfg.NodeMap.t = + helper c RegisterMap.empty + +let convert (prg: CfgImp.SSCfg.t) : RISCCfg.t = + match prg with + { 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 + } -> { empty = empty; + nodes = nodes; + edges = edges; + reverseEdges = reverseEdges; + inputVal = inputVal; + inputOutputVar = inputOutputVar; + initial = initial; + terminal = terminal; + content = convert_content content; + } diff --git a/lib/miniImp/CfgRISC.mli b/lib/miniImp/CfgRISC.mli new file mode 100644 index 0000000..4d1b650 --- /dev/null +++ b/lib/miniImp/CfgRISC.mli @@ -0,0 +1,53 @@ +module RISCSimpleStatements : sig + type register = { + index: int + } + + 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 register * int + | 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 + + val pp : out_channel -> t -> unit + val pplist : out_channel -> t list -> unit +end + +module RISCCfg : Cfg.C with type elt = RISCSimpleStatements.t + +val convert : CfgImp.SSCfg.t -> RISCCfg.t diff --git a/lib/miniImp/dune b/lib/miniImp/dune index ffeaddc..25890dd 100644 --- a/lib/miniImp/dune +++ b/lib/miniImp/dune @@ -10,7 +10,7 @@ (library (name miniImp) (public_name miniImp) - (modules Lexer Parser Types Semantics CfgImp) + (modules Lexer Parser Types Semantics CfgImp CfgRISC) (libraries cfg utility menhirLib)) (include_subdirs qualified)