elvis/lci
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Implementing cfg for risc

Browse Source
This commit is contained in:
elvis
2024-11-27 20:18:30 +01:00
parent 4e9f08347b
commit 99287d79c5
8 changed files with 554 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files

28
lib/cfg/Cfg.ml
View File

@ -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";

10
lib/cfg/Cfg.mli
View File

@ -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

28
lib/miniImp/CfgImp.ml
View File

@ -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}

1
lib/miniImp/CfgImp.mli
View File

@ -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

459
lib/miniImp/CfgRISC.ml Normal file
View File

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

53
lib/miniImp/CfgRISC.mli Normal file
View File

@ -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

2
lib/miniImp/dune
View File

@ -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)