diff --git a/bin/main.ml b/bin/main.ml index 4b5bd64..8f8e14a 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -1,11 +1,22 @@ open MiniImp let () = + (* let program = "def main with input x output y as *) + (* x := 2; *) + (* if y < 0 then ( *) + (* y := x + 3; *) + (* x := y; *) + (* ) else *) + (* x := 1 - y;" in *) + let program = "def main with input x output y as x := 2; if y < 0 then ( y := x + 3; - x := y; + if x > 0 then + x := y; + else + x := y + 1; ) else x := 1 - y;" in @@ -19,4 +30,6 @@ let () = let convertedrisccfg = CfgRISC.convert convertedcfg in - Printf.printf "%a" CfgRISC.RISCCfg.pp convertedrisccfg + let risc = RISC.convert convertedrisccfg in + + Printf.printf "%a" RISC.RISCAssembly.pp risc diff --git a/lib/miniImp/CfgRISC.ml b/lib/miniImp/CfgRISC.ml index 1642220..0a71b79 100644 --- a/lib/miniImp/CfgRISC.ml +++ b/lib/miniImp/CfgRISC.ml @@ -47,13 +47,13 @@ module RISCSimpleStatements = struct 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" + 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 + | 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" @@ -712,9 +712,6 @@ let helper (c: CfgImp.SimpleStatements.t list Cfg.NodeMap.t) (m: RegisterMap.m) 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; @@ -734,5 +731,5 @@ let convert (prg: CfgImp.SSCfg.t) : RISCCfg.t = inputOutputVar = inputOutputVar; initial = initial; terminal = terminal; - content = convert_content content; + content = helper content RegisterMap.empty; } diff --git a/lib/miniImp/RISC.ml b/lib/miniImp/RISC.ml new file mode 100644 index 0000000..f59f4b7 --- /dev/null +++ b/lib/miniImp/RISC.ml @@ -0,0 +1,244 @@ +let globalCounterLabel = ref 0 + +let nextLabel () : string = + globalCounterLabel := !globalCounterLabel + 1; + "l" ^ (string_of_int !globalCounterLabel) + +module RISCAssembly = struct + type register = { + index : int + } + + type label = + string + + type risci = + | 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 + | Jump of label + | CJump of register * label * label + | Label of label + 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 + + type t = risci list + + let pp (ppf: out_channel) (t: t) : unit = + let rec pp_risci (ppf: out_channel) (v: risci) : unit = + match v with + Nop -> Printf.fprintf ppf "\tNop\n" + | BRegOp (b, r1, r2, r3) -> Printf.fprintf ppf "\t%a r%d r%d => r%d\n" pp_brop b r1.index r2.index r3.index + | BImmOp (b, r1, i, r3) -> Printf.fprintf ppf "\t%a r%d %d => r%d\n" pp_biop b r1.index i r3.index + | URegOp (u, r1, r2) -> Printf.fprintf ppf "\t%a r%d => r%d\n" pp_urop u r1.index r2.index + | Load (r1, r2) -> Printf.fprintf ppf "\tLoad r%d => r%d\n" r1.index r2.index + | LoadI (r2, i) -> Printf.fprintf ppf "\tLoadI %d => r%d\n" i r2.index + | Store (r1, r2) -> Printf.fprintf ppf "\tStore r%d => r%d\n" r1.index r2.index + | Jump (label) -> Printf.fprintf ppf "\tJump %s\n" label + | CJump (r, l1, l2) -> Printf.fprintf ppf "\tCJump r%d => %s, %s\n" r.index l1 l2 + | Label (label) -> Printf.fprintf ppf "%s:" label + 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 + List.iter (pp_risci ppf) t +end + +let convert_cfgrisc_risci (i: CfgRISC.RISCSimpleStatements.t list) : (RISCAssembly.t) = + let rec helper (i: CfgRISC.RISCSimpleStatements.t) : RISCAssembly.risci = + match i with + | Nop -> Nop + | BRegOp (brop, r1, r2, r3) -> BRegOp (helper_brop brop, + {index = r1.index}, + {index = r2.index}, + {index = r3.index}) + | BImmOp (biop, r1, imm, r3) -> BImmOp (helper_biop biop, + {index = r1.index}, + imm, + {index = r3.index}) + | URegOp (urop, r1, r3) -> URegOp (helper_urop urop, + {index = r1.index}, + {index = r3.index}) + | Load (r1, r3) -> Load ({index = r1.index}, + {index = r3.index}) + | LoadI (r3, imm) -> LoadI ({index = r3.index}, + imm) + | Store (r1, r3) -> Store ({index = r1.index}, + {index = r3.index}) + and helper_brop (brop: CfgRISC.RISCSimpleStatements.brop) : RISCAssembly.brop = + match brop with + | Add -> Add + | Sub -> Sub + | Mult -> Mult + | Div -> Div + | Mod -> Mod + | Pow -> Pow + | And -> And + | Or -> Or + | Eq -> Eq + | Less -> Less + | LessEq -> LessEq + | More -> More + | MoreEq -> MoreEq + and helper_biop (biop: CfgRISC.RISCSimpleStatements.biop) : RISCAssembly.biop = + match biop with + | AddI -> AddI + | SubI -> SubI + | MultI -> MultI + | DivI -> DivI + | ModI -> ModI + | PowI -> PowI + | AndI -> AndI + | OrI -> OrI + | EqI -> EqI + | LessI -> LessI + | LessEqI -> LessEqI + | MoreI -> MoreI + | MoreEqI -> MoreEqI + and helper_urop (urop: CfgRISC.RISCSimpleStatements.urop) : RISCAssembly.urop = + match urop with + | Not -> Not + | Copy -> Copy + | Rand -> Rand + in + List.map helper i + +let nextCommonSuccessor (prg: CfgRISC.RISCCfg.t) (node1: Cfg.Node.t) (node2: Cfg.Node.t) : Cfg.Node.t option = + (* Assume the two input nodes are the two branches of an if then else + statement, then create the two lists that represent the runs until the + terminal node by choosing always the false statement in guard statements + (if the guard is for a while statement it gets ignored, if it is for an + if then else it chooses one of the branches) then find the first common + node in the lists + *) + let rec walk (node: Cfg.Node.t) : Cfg.Node.t list = + node :: match Cfg.NodeMap.find_opt node prg.edges with + | None -> [] + | Some (edge, None) -> (walk edge) + | Some (_, Some edge) -> (walk edge) + in + + let list1 = walk node1 in + let list2 = walk node2 in + let common = List.filter (fun x -> List.mem x list2) list1 in + match common with + [] -> None + | a::_ -> Some a + + +let rec helper (prg: CfgRISC.RISCCfg.t) (currentnode: Cfg.Node.t) (alreadyVisited: Cfg.Node.t list) : RISCAssembly.t * Cfg.Node.t list = + if List.mem currentnode alreadyVisited then + ([], alreadyVisited) + else ( + let nextnodes = (Cfg.NodeMap.find_opt currentnode prg.edges) in + let currentcode = (Cfg.NodeMap.find currentnode prg.content |> convert_cfgrisc_risci) in + match nextnodes with + | Some (nextnode1, None) -> + let res, vis = (helper prg nextnode1) (currentnode :: alreadyVisited) in + (currentcode @ res, vis) + | Some (nextnode1, Some nextnode2) -> ( + let ncs = nextCommonSuccessor prg nextnode1 nextnode2 in + match ncs with + | None -> (* should never happen since the terminal node should always be + rechable *) + failwith "Topology got a little mixed up" + | Some ncs -> ( + if (ncs.id = nextnode2.id) + then (* while or for loop *) + failwith "Not implemented" + else (* if branches *) + let label1 = nextLabel () in + let label2 = nextLabel () in + let label3 = nextLabel () in + + let res1, vis1 = (helper prg nextnode1 (currentnode :: ncs :: alreadyVisited)) in + let res2, _ = (helper prg nextnode2 vis1) in + let res3, vis3 = (helper prg ncs (currentnode :: alreadyVisited)) in + match List.nth currentcode ((List.length currentcode) - 1) with + | BRegOp (_, _, _, r) + | BImmOp (_, _, _, r) + | URegOp (_, _, r) + | Load (_, r) + | LoadI (r, _) -> (currentcode @ + ([CJump (r, label1, label2); Label label1] : RISCAssembly.t) @ + res1 @ + ([Jump label3; Label label2] : RISCAssembly.t) @ + res2 @ + ([Label label3] : RISCAssembly.t) @ + res3 + , vis3) + | _ -> failwith "Missing instruction" + ) + ) + | None -> (currentcode, currentnode :: alreadyVisited) + ) + +let convert (prg: CfgRISC.RISCCfg.t) : RISCAssembly.t = + let res, _ = helper prg (Option.get prg.initial) [] in + res diff --git a/lib/miniImp/RISC.mli b/lib/miniImp/RISC.mli new file mode 100644 index 0000000..d12a017 --- /dev/null +++ b/lib/miniImp/RISC.mli @@ -0,0 +1,56 @@ +module RISCAssembly : sig + type register = { + index : int + } + + type label + type risci = + | 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 + | Jump of label + | CJump of register * label * label + | Label of label + 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 + + type t = risci list + + val pp : out_channel -> t -> unit +end + +val convert : CfgRISC.RISCCfg.t -> RISCAssembly.t diff --git a/lib/miniImp/dune b/lib/miniImp/dune index 25890dd..48684a1 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 CfgRISC) + (modules Lexer Parser Types Semantics CfgImp CfgRISC RISC) (libraries cfg utility menhirLib)) (include_subdirs qualified) diff --git a/lib/utility/utility.ml b/lib/utility/utility.ml index d16e044..4cd3ed2 100644 --- a/lib/utility/utility.ml +++ b/lib/utility/utility.ml @@ -11,3 +11,12 @@ let rec powmod a d = function | n -> let b = (powmod a d (n / 2)) mod d in (((b * b) mod d) * (if n mod 2 = 0 then 1 else a)) mod d + +let rec fromIntToString (alphabet: string) (x: int) : string = + let base = String.length alphabet in + if x < 0 then + "" + else if x < base then + String.get alphabet x |> String.make 1 + else + (fromIntToString (alphabet) (x/base - 1)) ^ (String.get alphabet (x mod base) |> String.make 1) diff --git a/lib/utility/utility.mli b/lib/utility/utility.mli index c5f2cfb..f7cf347 100644 --- a/lib/utility/utility.mli +++ b/lib/utility/utility.mli @@ -1,3 +1,5 @@ val pow : int -> int -> int val powmod : int -> int -> int -> int + +val fromIntToString : string -> int -> string