RISC code output

TODO: fix wrong order for conversion in cfgrisc

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;
+                       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

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
+      | 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
+      | 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
+      | 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;
        }

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

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

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)

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)

lib/utility/utility.mli

@@ -1,3 +1,5 @@
 val pow : int -> int -> int
 
 val powmod : int -> int -> int -> int
+
+val fromIntToString : string -> int -> string