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

Better styling for miniImp

Browse Source
This commit is contained in:
elvis
2025-01-27 01:17:53 +01:00
parent 5e8b339440
commit 4ab0b40cca
10 changed files with 677 additions and 360 deletions
Download Patch File Download Diff File Expand all files Collapse all files

63
lib/miniImp/CfgImp.ml
View File

@ -30,31 +30,52 @@ module SimpleStatements = struct
let pp (ppf: out_channel) (c: t) : unit =
let rec helper_c (ppf) (c: t) : unit =
match c with
| SimpleSkip -> Printf.fprintf ppf "Skip"
| SimpleAssignment (v, a) -> Printf.fprintf ppf "Assignment {%s, %a}" v helper_a a
| SimpleGuard (b) -> Printf.fprintf ppf "Guard {%a}" helper_b b
| SimpleSkip ->
Printf.fprintf ppf "Skip"
| SimpleAssignment (v, a) ->
Printf.fprintf ppf "Assignment {%s, %a}" v helper_a a
| SimpleGuard (b) ->
Printf.fprintf ppf "Guard {%a}" helper_b b
and helper_b (ppf) (c: simpleBoolean) : unit =
match c with
| SimpleBoolean b -> Printf.fprintf ppf "%b" b
| SimpleBAnd (b1, b2) -> Printf.fprintf ppf "{%a && %a}" helper_b b1 helper_b b2
| SimpleBOr (b1, b2) -> Printf.fprintf ppf "{%a || %a}" helper_b b1 helper_b b2
| SimpleBNot b -> Printf.fprintf ppf "{not %a}" helper_b b
| SimpleBCmp (a1, a2) -> Printf.fprintf ppf "{%a == %a}" helper_a a1 helper_a a2
| SimpleBCmpLess (a1, a2) -> Printf.fprintf ppf "{%a < %a}" helper_a a1 helper_a a2
| SimpleBCmpLessEq (a1, a2) -> Printf.fprintf ppf "{%a <= %a}" helper_a a1 helper_a a2
| SimpleBCmpGreater (a1, a2) -> Printf.fprintf ppf "{%a > %a}" helper_a a1 helper_a a2
| SimpleBCmpGreaterEq (a1, a2) -> Printf.fprintf ppf "{%a >= %a}" helper_a a1 helper_a a2
| SimpleBoolean b ->
Printf.fprintf ppf "%b" b
| SimpleBAnd (b1, b2) ->
Printf.fprintf ppf "{%a && %a}" helper_b b1 helper_b b2
| SimpleBOr (b1, b2) ->
Printf.fprintf ppf "{%a || %a}" helper_b b1 helper_b b2
| SimpleBNot b ->
Printf.fprintf ppf "{not %a}" helper_b b
| SimpleBCmp (a1, a2) ->
Printf.fprintf ppf "{%a == %a}" helper_a a1 helper_a a2
| SimpleBCmpLess (a1, a2) ->
Printf.fprintf ppf "{%a < %a}" helper_a a1 helper_a a2
| SimpleBCmpLessEq (a1, a2) ->
Printf.fprintf ppf "{%a <= %a}" helper_a a1 helper_a a2
| SimpleBCmpGreater (a1, a2) ->
Printf.fprintf ppf "{%a > %a}" helper_a a1 helper_a a2
| SimpleBCmpGreaterEq (a1, a2) ->
Printf.fprintf ppf "{%a >= %a}" helper_a a1 helper_a a2
and helper_a (ppf) (c: simpleArithmetic) : unit =
match c with
| SimpleVariable (v) -> Printf.fprintf ppf "%s" v
| SimpleInteger (i) -> Printf.fprintf ppf "%d" i
| SimplePlus (a1, a2) -> Printf.fprintf ppf "{%a + %a}" helper_a a1 helper_a a2
| SimpleMinus (a1, a2) -> Printf.fprintf ppf "{%a - %a}" helper_a a1 helper_a a2
| SimpleTimes (a1, a2) -> Printf.fprintf ppf "{%a * %a}" helper_a a1 helper_a a2
| SimpleDivision (a1, a2) -> Printf.fprintf ppf "{%a / %a}" helper_a a1 helper_a a2
| SimpleModulo (a1, a2) -> Printf.fprintf ppf "{%a %% %a}" helper_a a1 helper_a a2
| SimplePower (a1, a2) -> Printf.fprintf ppf "{%a ^ %a}" helper_a a1 helper_a a2
| SimpleRand (a) -> Printf.fprintf ppf "{rand %a}" helper_a a
| SimpleVariable (v) ->
Printf.fprintf ppf "%s" v
| SimpleInteger (i) ->
Printf.fprintf ppf "%d" i
| SimplePlus (a1, a2) ->
Printf.fprintf ppf "{%a + %a}" helper_a a1 helper_a a2
| SimpleMinus (a1, a2) ->
Printf.fprintf ppf "{%a - %a}" helper_a a1 helper_a a2
| SimpleTimes (a1, a2) ->
Printf.fprintf ppf "{%a * %a}" helper_a a1 helper_a a2
| SimpleDivision (a1, a2) ->
Printf.fprintf ppf "{%a / %a}" helper_a a1 helper_a a2
| SimpleModulo (a1, a2) ->
Printf.fprintf ppf "{%a %% %a}" helper_a a1 helper_a a2
| SimplePower (a1, a2) ->
Printf.fprintf ppf "{%a ^ %a}" helper_a a1 helper_a a2
| SimpleRand (a) ->
Printf.fprintf ppf "{rand %a}" helper_a a
in
helper_c ppf c

417
lib/miniImp/CfgRISC.ml
View File

@ -49,13 +49,21 @@ 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"
| BRegOp (b, r1, r2, r3) -> Printf.fprintf ppf "%a r%s r%s => r%s" pp_brop b r1.index r2.index r3.index
| BImmOp (b, r1, i, r3) -> Printf.fprintf ppf "%a r%s %d => r%s" pp_biop b r1.index i r3.index
| URegOp (u, r1, r2) -> Printf.fprintf ppf "%a r%s => r%s" pp_urop u r1.index r2.index
| Load (r1, r2) -> Printf.fprintf ppf "Load r%s => r%s" r1.index r2.index
| LoadI (i, r2) -> Printf.fprintf ppf "LoadI %d => r%s" i r2.index
| Store (r1, r2) -> Printf.fprintf ppf "Store r%s => r%s" r1.index r2.index
Nop ->
Printf.fprintf ppf "Nop"
| BRegOp (b, r1, r2, r3) ->
Printf.fprintf ppf "%a r%s r%s => r%s"
pp_brop b r1.index r2.index r3.index
| BImmOp (b, r1, i, r3) ->
Printf.fprintf ppf "%a r%s %d => r%s" pp_biop b r1.index i r3.index
| URegOp (u, r1, r2) ->
Printf.fprintf ppf "%a r%s => r%s" pp_urop u r1.index r2.index
| Load (r1, r2) ->
Printf.fprintf ppf "Load r%s => r%s" r1.index r2.index
| LoadI (i, r2) ->
Printf.fprintf ppf "LoadI %d => r%s" i r2.index
| Store (r1, r2) ->
Printf.fprintf ppf "Store r%s => r%s" r1.index r2.index
and pp_brop (ppf: out_channel) (v: brop) : unit =
match v with
Add -> Printf.fprintf ppf "Add"
@ -118,7 +126,8 @@ module RegisterMap = struct
({index = string_of_int !globalcounter},
{assignments =
Types.VariableMap.add x
({index = (string_of_int !globalcounter)}: RISCSimpleStatements.register)
({index = (string_of_int !globalcounter)}
: RISCSimpleStatements.register)
m.assignments}))
| Some i -> (i, m)
@ -129,7 +138,8 @@ module RegisterMap = struct
({index = string_of_int !globalcounter},
{assignments =
Types.VariableMap.add freshvariable
({index = string_of_int !globalcounter}: RISCSimpleStatements.register)
({index = string_of_int !globalcounter}
: RISCSimpleStatements.register)
m.assignments},
freshvariable)
@ -182,11 +192,16 @@ and c_ss_sb
(convertedcode @ [LoadI (0, register)], m)
)
| (_, _) -> (
let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in
let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in
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
(convertedcode @ [BRegOp (And, partialresreg1, partialresreg2, register)], m)
(convertedcode @
[BRegOp (And, partialresreg1, partialresreg2, register)], m)
)
)
| SimpleBOr (b1, b2) -> (
@ -200,11 +215,16 @@ and c_ss_sb
(LoadI (1, register) :: convertedcode, m)
)
| (_, _) -> (
let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in
let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in
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
(convertedcode @ [BRegOp (Or, partialresreg1, partialresreg2, register)], m)
(convertedcode @
[BRegOp (Or, partialresreg1, partialresreg2, register)], m)
)
)
| SimpleBNot (b) -> (
@ -216,7 +236,9 @@ and c_ss_sb
(LoadI (1, register) :: convertedcode, m)
)
| _ -> (
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sb b m convertedcode partialresreg in
(convertedcode @ [URegOp (Not, partialresreg, register)], m)
)
@ -230,7 +252,9 @@ and c_ss_sb
)
| (SimpleInteger (i), a)
| (a, SimpleInteger (i)) -> (
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (EqI, partialresreg, i, register)], m)
)
@ -241,17 +265,26 @@ and c_ss_sb
)
| (SimpleVariable (x), a)
| (a, SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let xreg, m =
RegisterMap.get_or_set_register x m
in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (Eq, partialresreg, xreg, register)], m)
)
| (_, _) -> (
let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in
let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in
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
(convertedcode @ [BRegOp (Eq, partialresreg1, partialresreg2, register)], m)
(convertedcode @
[BRegOp (Eq, partialresreg1, partialresreg2, register)], m)
)
)
| SimpleBCmpLess (a1, a2) -> (
@ -265,12 +298,16 @@ and c_ss_sb
(convertedcode @ [BImmOp (LessI, xreg, i, register)], m)
)
| (SimpleInteger (i), a) -> (
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (MoreI, partialresreg, i, register)], m)
)
| (a, SimpleInteger (i)) -> (
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (LessI, partialresreg, i, register)], m)
)
@ -281,22 +318,31 @@ and c_ss_sb
)
| (SimpleVariable (x), a) -> (
let xreg, m = RegisterMap.get_or_set_register x m in
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (Less, xreg, partialresreg, register)], m)
)
| (a, SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (Less, partialresreg, xreg, register)], m)
)
| (_, _) -> (
let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in
let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in
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
(convertedcode @ [BRegOp (Less, partialresreg1, partialresreg2, register)], m)
(convertedcode @
[BRegOp (Less, partialresreg1, partialresreg2, register)], m)
)
)
| SimpleBCmpLessEq (a1, a2) -> (
@ -310,12 +356,16 @@ and c_ss_sb
(convertedcode @ [BImmOp (LessEqI, xreg, i, register)], m)
)
| (SimpleInteger (i), a) -> (
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (MoreEqI, partialresreg, i, register)], m)
)
| (a, SimpleInteger (i)) -> (
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (LessEqI, partialresreg, i, register)], m)
)
@ -326,22 +376,31 @@ and c_ss_sb
)
| (SimpleVariable (x), a) -> (
let xreg, m = RegisterMap.get_or_set_register x m in
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (LessEq, xreg, partialresreg, register)], m)
)
| (a, SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (LessEq, partialresreg, xreg, register)], m)
)
| (_, _) -> (
let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in
let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in
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
(convertedcode @ [BRegOp (LessEq, partialresreg1, partialresreg2, register)], m)
(convertedcode @
[BRegOp (LessEq, partialresreg1, partialresreg2, register)], m)
)
)
| SimpleBCmpGreater (a1, a2) -> (
@ -355,12 +414,16 @@ and c_ss_sb
(convertedcode @ [BImmOp (MoreI, xreg, i, register)], m)
)
| (SimpleInteger (i), a) -> (
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (LessI, partialresreg, i, register)], m)
)
| (a, SimpleInteger (i)) -> (
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (MoreI, partialresreg, i, register)], m)
)
@ -371,22 +434,31 @@ and c_ss_sb
)
| (SimpleVariable (x), a) -> (
let xreg, m = RegisterMap.get_or_set_register x m in
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (More, xreg, partialresreg, register)], m)
)
| (a, SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (More, partialresreg, xreg, register)], m)
)
| (_, _) -> (
let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in
let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in
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
(convertedcode @ [BRegOp (More, partialresreg1, partialresreg2, register)], m)
(convertedcode @
[BRegOp (More, partialresreg1, partialresreg2, register)], m)
)
)
| SimpleBCmpGreaterEq (a1, a2) -> (
@ -400,12 +472,16 @@ and c_ss_sb
(convertedcode @ [BImmOp (MoreEqI, xreg, i, register)], m)
)
| (SimpleInteger (i), a) -> (
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (LessEqI, partialresreg, i, register)], m)
)
| (a, SimpleInteger (i)) -> (
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (MoreEqI, partialresreg, i, register)], m)
)
@ -416,22 +492,31 @@ and c_ss_sb
)
| (SimpleVariable (x), a) -> (
let xreg, m = RegisterMap.get_or_set_register x m in
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (MoreEq, xreg, partialresreg, register)], m)
)
| (a, SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (MoreEq, partialresreg, xreg, register)], m)
)
| (_, _) -> (
let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in
let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in
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
(convertedcode @ [BRegOp (MoreEq, partialresreg1, partialresreg2, register)], m)
(convertedcode @
[BRegOp (MoreEq, partialresreg1, partialresreg2, register)], m)
)
)
@ -461,7 +546,9 @@ and c_ss_sa
)
| (SimpleInteger (i), a)
| (a, SimpleInteger (i)) -> (
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (AddI, partialresreg, i, register)], m)
)
@ -473,37 +560,56 @@ and c_ss_sa
| (SimpleVariable (x), a)
| (a, SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (Add, partialresreg, xreg, register)], m)
)
| (_, _) -> (
let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in
let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in
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
(convertedcode @ [BRegOp (Add, partialresreg1, partialresreg2, register)], m)
(convertedcode @
[BRegOp (Add, partialresreg1, partialresreg2, register)], m)
)
)
| SimpleMinus (a1, a2) -> (
match (a1, a2) with
| (SimpleInteger (i), SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
(convertedcode @ [LoadI (i, partialresreg); BRegOp (Sub, partialresreg, xreg, register)], m)
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
(convertedcode @
[LoadI (i, partialresreg);
BRegOp (Sub, partialresreg, xreg, register)], m)
)
| (SimpleVariable (x), SimpleInteger (i)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in
(convertedcode @ [BImmOp (SubI, xreg, i, register)], m)
)
| (SimpleInteger (i), a) -> (
let partialresregi, m, _partialresvari = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresregi, m, _partialresvari =
RegisterMap.get_fresh_register m
in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [LoadI (i, partialresregi); BRegOp (Sub, partialresregi, partialresreg, register)], m)
(convertedcode @
[LoadI (i, partialresregi);
BRegOp (Sub, partialresregi, partialresreg, register)], m)
)
| (a, SimpleInteger (i)) -> (
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (SubI, partialresreg, i, register)], m)
)
@ -514,22 +620,31 @@ and c_ss_sa
)
| (SimpleVariable (x), a) -> (
let xreg, m = RegisterMap.get_or_set_register x m in
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (Sub, xreg, partialresreg, register)], m)
)
| (a, SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (Sub, partialresreg, xreg, register)], m)
)
| (_, _) -> (
let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in
let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in
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
(convertedcode @ [BRegOp (Sub, partialresreg1, partialresreg2, register)], m)
(convertedcode @
[BRegOp (Sub, partialresreg1, partialresreg2, register)], m)
)
)
| SimpleTimes (a1, a2) -> (
@ -541,7 +656,9 @@ and c_ss_sa
)
| (SimpleInteger (i), a)
| (a, SimpleInteger (i)) -> (
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (MultI, partialresreg, i, register)], m)
)
@ -553,37 +670,56 @@ and c_ss_sa
| (SimpleVariable (x), a)
| (a, SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (Mult, partialresreg, xreg, register)], m)
)
| (_, _) -> (
let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in
let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in
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
(convertedcode @ [BRegOp (Mult, partialresreg1, partialresreg2, register)], m)
(convertedcode @
[BRegOp (Mult, partialresreg1, partialresreg2, register)], m)
)
)
| SimpleDivision (a1, a2) -> (
match (a1, a2) with
| (SimpleInteger (i), SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
(convertedcode @ [LoadI (i, partialresreg); BRegOp (Div, partialresreg, xreg, register)], m)
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
(convertedcode @
[LoadI (i, partialresreg);
BRegOp (Div, partialresreg, xreg, register)], m)
)
| (SimpleVariable (x), SimpleInteger (i)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in
(convertedcode @ [BImmOp (DivI, xreg, i, register)], m)
)
| (SimpleInteger (i), a) -> (
let partialresregi, m, _partialresvari = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresregi, m, _partialresvari =
RegisterMap.get_fresh_register m
in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [LoadI (i, partialresregi); BRegOp (Div, partialresregi, partialresreg, register)], m)
(convertedcode @
[LoadI (i, partialresregi);
BRegOp (Div, partialresregi, partialresreg, register)], m)
)
| (a, SimpleInteger (i)) -> (
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (DivI, partialresreg, i, register)], m)
)
@ -594,43 +730,64 @@ and c_ss_sa
)
| (SimpleVariable (x), a) -> (
let xreg, m = RegisterMap.get_or_set_register x m in
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (Div, xreg, partialresreg, register)], m)
)
| (a, SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (Div, partialresreg, xreg, register)], m)
)
| (_, _) -> (
let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in
let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in
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
(convertedcode @ [BRegOp (Div, partialresreg1, partialresreg2, register)], m)
(convertedcode @
[BRegOp (Div, partialresreg1, partialresreg2, register)], m)
)
)
| SimpleModulo (a1, a2) -> (
match (a1, a2) with
| (SimpleInteger (i), SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
(convertedcode @ [LoadI (i, partialresreg); BRegOp (Mod, partialresreg, xreg, register)], m)
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
(convertedcode @
[LoadI (i, partialresreg);
BRegOp (Mod, partialresreg, xreg, register)], m)
)
| (SimpleVariable (x), SimpleInteger (i)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in
(convertedcode @ [BImmOp (ModI, xreg, i, register)], m)
)
| (SimpleInteger (i), a) -> (
let partialresregi, m, _partialresvari = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresregi, m, _partialresvari =
RegisterMap.get_fresh_register m
in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [LoadI (i, partialresregi); BRegOp (Mod, partialresregi, partialresreg, register)], m)
(convertedcode @
[LoadI (i, partialresregi);
BRegOp (Mod, partialresregi, partialresreg, register)], m)
)
| (a, SimpleInteger (i)) -> (
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (ModI, partialresreg, i, register)], m)
)
@ -641,43 +798,64 @@ and c_ss_sa
)
| (SimpleVariable (x), a) -> (
let xreg, m = RegisterMap.get_or_set_register x m in
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (Mod, xreg, partialresreg, register)], m)
)
| (a, SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (Mod, partialresreg, xreg, register)], m)
)
| (_, _) -> (
let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in
let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in
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
(convertedcode @ [BRegOp (Mod, partialresreg1, partialresreg2, register)], m)
(convertedcode @
[BRegOp (Mod, partialresreg1, partialresreg2, register)], m)
)
)
| SimplePower (a1, a2) -> (
match (a1, a2) with
| (SimpleInteger (i), SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
(convertedcode @ [LoadI (i, partialresreg); BRegOp (Pow, partialresreg, xreg, register)], m)
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
(convertedcode @
[LoadI (i, partialresreg);
BRegOp (Pow, partialresreg, xreg, register)], m)
)
| (SimpleVariable (x), SimpleInteger (i)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in
(convertedcode @ [BImmOp (PowI, xreg, i, register)], m)
)
| (SimpleInteger (i), a) -> (
let partialresregi, m, _partialresvari = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresregi, m, _partialresvari =
RegisterMap.get_fresh_register m
in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [LoadI (i, partialresregi); BRegOp (Pow, partialresregi, partialresreg, register)], m)
(convertedcode @
[LoadI (i, partialresregi);
BRegOp (Pow, partialresregi, partialresreg, register)], m)
)
| (a, SimpleInteger (i)) -> (
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (PowI, partialresreg, i, register)], m)
)
@ -688,22 +866,31 @@ and c_ss_sa
)
| (SimpleVariable (x), a) -> (
let xreg, m = RegisterMap.get_or_set_register x m in
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (Pow, xreg, partialresreg, register)], m)
)
| (a, SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let partialresreg, m, _partialresvar =
RegisterMap.get_fresh_register m
in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (Pow, partialresreg, xreg, register)], m)
)
| (_, _) -> (
let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in
let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in
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
(convertedcode @ [BRegOp (Pow, partialresreg1, partialresreg2, register)], m)
(convertedcode @
[BRegOp (Pow, partialresreg1, partialresreg2, register)], m)
)
)
| SimpleRand (a) -> (
@ -742,17 +929,17 @@ let helper
risccode
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
} ->
let ({ 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
}: CfgImp.SSCfg.t) = prg
in
let initial_bindings =
match inputOutputVar with
| Some (i, o) -> (

87
lib/miniImp/RISC.ml
View File

@ -66,16 +66,27 @@ module RISCAssembly = struct
let pp_risci (ppf: out_channel) (v: risci) : 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%s r%s => r%s\n" pp_brop b r1.index r2.index r3.index
| BImmOp (b, r1, i, r3) -> Printf.fprintf ppf "\t%a r%s %d => r%s\n" pp_biop b r1.index i r3.index
| URegOp (u, r1, r2) -> Printf.fprintf ppf "\t%a r%s => r%s\n" pp_urop u r1.index r2.index
| Load (r1, r2) -> Printf.fprintf ppf "\tLoad r%s => r%s\n" r1.index r2.index
| LoadI (i, r2) -> Printf.fprintf ppf "\tLoadI %d => r%s\n" i r2.index
| Store (r1, r2) -> Printf.fprintf ppf "\tStore r%s => r%s\n" r1.index r2.index
| Jump (label) -> Printf.fprintf ppf "\tJump %s\n" label
| CJump (r, l1, l2) -> Printf.fprintf ppf "\tCJump r%s => %s, %s\n" r.index l1 l2
| Label (label) -> Printf.fprintf ppf "%s:" label
| Nop ->
Printf.fprintf ppf "\tNop\n"
| BRegOp (b, r1, r2, r3) ->
Printf.fprintf ppf "\t%a r%s r%s => r%s\n"
pp_brop b r1.index r2.index r3.index
| BImmOp (b, r1, i, r3) ->
Printf.fprintf ppf "\t%a r%s %d => r%s\n" pp_biop b r1.index i r3.index
| URegOp (u, r1, r2) ->
Printf.fprintf ppf "\t%a r%s => r%s\n" pp_urop u r1.index r2.index
| Load (r1, r2) ->
Printf.fprintf ppf "\tLoad r%s => r%s\n" r1.index r2.index
| LoadI (i, r2) ->
Printf.fprintf ppf "\tLoadI %d => r%s\n" i r2.index
| Store (r1, r2) ->
Printf.fprintf ppf "\tStore r%s => r%s\n" r1.index r2.index
| Jump (label) ->
Printf.fprintf ppf "\tJump %s\n" label
| CJump (r, l1, l2) ->
Printf.fprintf ppf "\tCJump r%s => %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"
@ -121,14 +132,18 @@ module RISCAssembly = struct
| Some i -> Printf.fprintf ppf "Some %d\n" i );
Printf.fprintf ppf "Input/Output Registers: ";
( match t.inputoutputreg with
None -> Printf.fprintf ppf "None\n"
| Some (i, o) -> Printf.fprintf ppf "[i: Some r%s, o: Some r%s]\n" i.index o.index);
| None ->
Printf.fprintf ppf "None\n"
| Some (i, o) ->
Printf.fprintf ppf "[i: Some r%s, o: Some r%s]\n" i.index o.index);
Printf.fprintf ppf "Code:\n";
List.iter (pp_risci ppf) t.code
end
let convert_cfgrisc_risci (i: CfgRISC.RISCSimpleStatements.t list) : (RISCAssembly.risci list) =
let rec helper (i: CfgRISC.RISCSimpleStatements.t) : RISCAssembly.risci =
let convert_cfgrisc_risci (i: CfgRISC.RISCSimpleStatements.t list) :
(RISCAssembly.risci list) =
let rec helper (i: CfgRISC.RISCSimpleStatements.t)
: RISCAssembly.risci =
match i with
| Nop -> Nop
| BRegOp (brop, r1, r2, r3) -> BRegOp (helper_brop brop,
@ -148,7 +163,8 @@ let convert_cfgrisc_risci (i: CfgRISC.RISCSimpleStatements.t list) : (RISCAssemb
{index = r3.index})
| Store (r1, r3) -> Store ({index = r1.index},
{index = r3.index})
and helper_brop (brop: CfgRISC.RISCSimpleStatements.brop) : RISCAssembly.brop =
and helper_brop (brop: CfgRISC.RISCSimpleStatements.brop)
: RISCAssembly.brop =
match brop with
| Add -> Add
| Sub -> Sub
@ -163,7 +179,8 @@ let convert_cfgrisc_risci (i: CfgRISC.RISCSimpleStatements.t list) : (RISCAssemb
| LessEq -> LessEq
| More -> More
| MoreEq -> MoreEq
and helper_biop (biop: CfgRISC.RISCSimpleStatements.biop) : RISCAssembly.biop =
and helper_biop (biop: CfgRISC.RISCSimpleStatements.biop)
: RISCAssembly.biop =
match biop with
| AddI -> AddI
| SubI -> SubI
@ -178,7 +195,8 @@ let convert_cfgrisc_risci (i: CfgRISC.RISCSimpleStatements.t list) : (RISCAssemb
| LessEqI -> LessEqI
| MoreI -> MoreI
| MoreEqI -> MoreEqI
and helper_urop (urop: CfgRISC.RISCSimpleStatements.urop) : RISCAssembly.urop =
and helper_urop (urop: CfgRISC.RISCSimpleStatements.urop)
: RISCAssembly.urop =
match urop with
| Not -> Not
| Copy -> Copy
@ -186,7 +204,11 @@ let convert_cfgrisc_risci (i: CfgRISC.RISCSimpleStatements.t list) : (RISCAssemb
in
List.map helper i
let nextCommonSuccessor (prg: CfgRISC.RISCCfg.t) (node1: Cfg.Node.t) (node2: Cfg.Node.t) : Cfg.Node.t option =
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
@ -244,8 +266,12 @@ let rec helper
let label2 = nextLabel () in
let label3 = nextLabel () in
let res1, _ = (helper prg nextnode1 (currentnode :: nextnode2 :: alreadyVisited)) in
let res2, vis2 = (helper prg nextnode2 (currentnode :: nextnode1 :: alreadyVisited)) in
let res1, _ =
(helper prg nextnode1
(currentnode :: nextnode2 :: alreadyVisited)) in
let res2, vis2 =
(helper prg nextnode2
(currentnode :: nextnode1 :: alreadyVisited)) in
match List.nth currentcode ((List.length currentcode) - 1) with
| BRegOp (_, _, _, r)
@ -253,11 +279,14 @@ let rec helper
| URegOp (_, _, r)
| Load (_, r)
| Store (r, _)
| LoadI (_, r) -> (([Label label1] : RISCAssembly.risci list) @
| LoadI (_, r) -> (([Label label1]
: RISCAssembly.risci list) @
currentcode @
([CJump (r, label2, label3); Label label2] : RISCAssembly.risci list) @
([CJump (r, label2, label3); Label label2]
: RISCAssembly.risci list) @
res1 @
([Jump label1; Label label3] : RISCAssembly.risci list) @
([Jump label1; Label label3]
: RISCAssembly.risci list) @
res2
, vis2)
| _ -> failwith "Missing instruction at branch"
@ -266,7 +295,8 @@ let rec helper
let label2 = nextLabel () in
let label3 = nextLabel () in
let res1, vis1 = (helper prg nextnode1 (currentnode :: ncs :: alreadyVisited)) 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
@ -276,11 +306,14 @@ let rec helper
| Load (_, r)
| Store (r, _)
| LoadI (_, r) -> (currentcode @
([CJump (r, label1, label2); Label label1] : RISCAssembly.risci list) @
([CJump (r, label1, label2); Label label1]
: RISCAssembly.risci list) @
res1 @
([Jump label3; Label label2] : RISCAssembly.risci list) @
([Jump label3; Label label2]
: RISCAssembly.risci list) @
res2 @
([Label label3] : RISCAssembly.risci list) @
([Label label3]
: RISCAssembly.risci list) @
res3
, vis3)
| _ -> failwith "Missing instruction at branch"

20
lib/miniImp/RISCSemantics.ml
View File

@ -18,7 +18,8 @@ module RISCArchitecture = struct
}
end
let convert (prg: RISC.RISCAssembly.t) : RISC.RISCAssembly.risci list CodeMap.t =
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 helper
@ -101,7 +102,9 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
| Some i ->
if i + 1 < (List.length lo) then
helper
prg (CodeMap.find (List.nth lo (i+1)) prg.code) (List.nth lo (i+1))
prg
(CodeMap.find (List.nth lo (i+1)) prg.code)
(List.nth lo (i+1))
else
prg
)
@ -113,7 +116,7 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
(RegisterMap.find {index = r2.index} prg.registers)
in
helper { prg with
registers = RegisterMap.add {index = r3.index} n prg.registers }
registers = RegisterMap.add {index = r3.index} n prg.registers}
tl current_label
)
| BImmOp (biop, r1, i, r3) :: tl -> (
@ -122,7 +125,7 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
i
in
helper { prg with
registers = RegisterMap.add {index = r3.index} n prg.registers }
registers = RegisterMap.add {index = r3.index} n prg.registers}
tl current_label
)
| URegOp (urop, r1, r3) :: tl -> (
@ -160,20 +163,23 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
prg.memory
in
helper { prg with
registers = RegisterMap.add {index = r3.index} n prg.registers }
registers = RegisterMap.add {index = r3.index} n prg.registers}
tl current_label
)
| LoadI (i, r3) :: tl -> (
let n = i
in
helper { prg with
registers = RegisterMap.add {index = r3.index} n prg.registers }
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
helper {prg with memory = MemoryMap.add n1 n prg.memory} tl current_label
helper
{ prg with memory = MemoryMap.add n1 n prg.memory }
tl
current_label
)
| Jump l :: _ -> helper prg (CodeMap.find l prg.code) l
| CJump (r, l1, l2) :: _ -> (

16
lib/miniImp/Semantics.ml
View File

@ -53,8 +53,10 @@ and evaluate_a (mem: memory) (exp_a: a_exp) : (int, [> error]) result =
match exp_a with
Variable v -> (
match VariableMap.find_opt v mem.assignments with
None -> Error (`AbsentAssignment ("The variable " ^ v ^ " is not defined."))
| Some a -> Ok a
| None ->
Error (`AbsentAssignment ("The variable " ^ v ^ " is not defined."))
| Some a ->
Ok a
)
| Integer n -> Ok n
| Plus (exp_a1, exp_a2) -> (
@ -148,9 +150,13 @@ and evaluate_b (mem: memory) (exp_b: b_exp) : (bool, [> error]) result =
let reduce (program: p_exp) (iin : int) : (int, [> error]) result =
match program with
Main (vin, vout, expression) -> (
let mem : memory = {assignments = (VariableMap.empty |> VariableMap.add vin iin)} in
let mem : memory =
{ assignments = (VariableMap.empty |> VariableMap.add vin iin) } in
let* resultmem : memory = evaluate mem expression in
match VariableMap.find_opt vout resultmem.assignments with
None -> Error (`AbsentAssignment ("The output variable is not defined (" ^ vout ^ ")"))
| Some a -> Ok a
| None ->
Error (`AbsentAssignment
("The output variable is not defined (" ^ vout ^ ")"))
| Some a ->
Ok a
)

136
lib/miniImp/Types.ml
View File

@ -1,72 +1,106 @@
type variable = string
type p_exp =
Main of variable * variable * c_exp (* def main with input x output y as c *)
Main of variable * variable * c_exp
(* def main with input x output y as c *)
and c_exp =
Skip
| Assignment of variable * a_exp (* x := a *)
| Sequence of c_exp * c_exp (* c; c *)
| If of b_exp * c_exp * c_exp (* if b then c else c *)
| While of b_exp * c_exp (* while b do c *)
| For of c_exp * b_exp * c_exp * c_exp (* for (c; b; c) do c *)
| Assignment of variable * a_exp (* x := a *)
| Sequence of c_exp * c_exp (* c; c *)
| If of b_exp * c_exp * c_exp (* if b then c else c *)
| While of b_exp * c_exp (* while b do c *)
| For of c_exp * b_exp * c_exp * c_exp
(* for (c; b; c) do c *)
and b_exp =
Boolean of bool (* v *)
| BAnd of b_exp * b_exp (* b && b *)
| BOr of b_exp * b_exp (* b || b *)
| BNot of b_exp (* not b *)
| BCmp of a_exp * a_exp (* a == a *)
| BCmpLess of a_exp * a_exp (* a < a *)
| BCmpLessEq of a_exp * a_exp (* a <= a *)
| BCmpGreater of a_exp * a_exp (* a > a *)
| BCmpGreaterEq of a_exp * a_exp (* a >= a *)
Boolean of bool (* v *)
| BAnd of b_exp * b_exp (* b && b *)
| BOr of b_exp * b_exp (* b || b *)
| BNot of b_exp (* not b *)
| BCmp of a_exp * a_exp (* a == a *)
| BCmpLess of a_exp * a_exp (* a < a *)
| BCmpLessEq of a_exp * a_exp (* a <= a *)
| BCmpGreater of a_exp * a_exp (* a > a *)
| BCmpGreaterEq of a_exp * a_exp (* a >= a *)
and a_exp =
Variable of variable (* x *)
| Integer of int (* n *)
| Plus of a_exp * a_exp (* a + a *)
| Minus of a_exp * a_exp (* a - a *)
| Times of a_exp * a_exp (* a * a *)
| Division of a_exp * a_exp (* a / a *)
| Modulo of a_exp * a_exp (* a % a *)
| Power of a_exp * a_exp (* a ^ a *)
| PowerMod of a_exp * a_exp * a_exp (* a ^ a % a *)
| Rand of a_exp (* rand(0, a) *)
Variable of variable (* x *)
| Integer of int (* n *)
| Plus of a_exp * a_exp (* a + a *)
| Minus of a_exp * a_exp (* a - a *)
| Times of a_exp * a_exp (* a * a *)
| Division of a_exp * a_exp (* a / a *)
| Modulo of a_exp * a_exp (* a % a *)
| Power of a_exp * a_exp (* a ^ a *)
| PowerMod of a_exp * a_exp * a_exp (* a ^ a % a *)
| Rand of a_exp (* rand(0, a) *)
let pp_p_exp (ppf: Format.formatter) (p: p_exp) : unit =
let open Format in
let rec helper_c (ppf) (c: c_exp) : unit =
match c with
Skip -> Format.fprintf ppf "Skip"
| Assignment (x, a) -> Format.fprintf ppf "%S := @[<h>%a@]" x helper_a a
| Sequence (c1, c2) -> Format.fprintf ppf "@[<hv>Sequence (@;<1 2>%a,@;<1 0>%a@;<0 0>)@]" helper_c c1 helper_c c2
| If (b, c1, c2) -> Format.fprintf ppf "@[<hv>If @[<h>%a@]@;<1 2>then (@[<hv>%a@])@;<1 2>else (@[<hv>%a@])@]" helper_b b helper_c c1 helper_c c2
| While (b, c) -> Format.fprintf ppf "@[<hv>While @[<h>%a@] do@;<1 2>%a@]@;<0 0>" helper_b b helper_c c
| For (c1, b, c2, c3) -> Format.fprintf ppf "@[<h>For (@;<0 2>%a,@;<1 2>@[<h>%a@],@;<1 2>%a) do@]@;<1 4>%a@;<0 0>" helper_c c1 helper_b b helper_c c2 helper_c c3
| Skip ->
fprintf ppf "Skip"
| Assignment (x, a) ->
fprintf ppf "%S := @[<h>%a@]" x helper_a a
| Sequence (c1, c2) ->
fprintf ppf "@[<hv>Sequence (@;<1 2>%a,@;<1 0>%a@;<0 0>)@]"
helper_c c1 helper_c c2
| If (b, c1, c2) ->
fprintf ppf
"@[<hv>If @[<h>%a@]@;<1 2>then (@[<hv>%a@])@;<1 2>else (@[<hv>%a@])@]"
helper_b b helper_c c1 helper_c c2
| While (b, c) ->
fprintf ppf "@[<hv>While @[<h>%a@] do@;<1 2>%a@]@;<0 0>"
helper_b b helper_c c
| For (c1, b, c2, c3) ->
fprintf ppf
"@[<h>For (@;<0 2>%a,@;<1 2>@[<h>%a@],@;<1 2>%a) do@]@;<1 4>%a@;<0 0>"
helper_c c1 helper_b b helper_c c2 helper_c c3
and helper_b (ppf) (b: b_exp) =
match b with
Boolean (b) -> Format.fprintf ppf "%b" b
| BAnd (b1, b2) -> Format.fprintf ppf "(%a &&@;<1 2>%a)" helper_b b1 helper_b b2
| BOr (b1, b2) -> Format.fprintf ppf "(%a ||@;<1 2>%a)" helper_b b1 helper_b b2
| BNot (b) -> Format.fprintf ppf "(not %a)" helper_b b
| BCmp (a1, a2) -> Format.fprintf ppf "(%a ==@;<1 2>%a)" helper_a a1 helper_a a2
| BCmpLess (a1, a2) -> Format.fprintf ppf "(%a <@;<1 2>%a)" helper_a a1 helper_a a2
| BCmpLessEq (a1, a2) -> Format.fprintf ppf "(%a <=@;<1 2>%a)" helper_a a1 helper_a a2
| BCmpGreater (a1, a2) -> Format.fprintf ppf "(%a >@;<1 2>%a)" helper_a a1 helper_a a2
| BCmpGreaterEq (a1, a2) -> Format.fprintf ppf "(%a >=@;<1 2>%a)" helper_a a1 helper_a a2
| Boolean (b) ->
fprintf ppf "%b" b
| BAnd (b1, b2) ->
fprintf ppf "(%a &&@;<1 2>%a)" helper_b b1 helper_b b2
| BOr (b1, b2) ->
fprintf ppf "(%a ||@;<1 2>%a)" helper_b b1 helper_b b2
| BNot (b) ->
fprintf ppf "(not %a)" helper_b b
| BCmp (a1, a2) ->
fprintf ppf "(%a ==@;<1 2>%a)" helper_a a1 helper_a a2
| BCmpLess (a1, a2) ->
fprintf ppf "(%a <@;<1 2>%a)" helper_a a1 helper_a a2
| BCmpLessEq (a1, a2) ->
fprintf ppf "(%a <=@;<1 2>%a)" helper_a a1 helper_a a2
| BCmpGreater (a1, a2) ->
fprintf ppf "(%a >@;<1 2>%a)" helper_a a1 helper_a a2
| BCmpGreaterEq (a1, a2) ->
fprintf ppf "(%a >=@;<1 2>%a)" helper_a a1 helper_a a2
and helper_a (ppf) (a: a_exp) =
match a with
Variable v -> Format.fprintf ppf "%S" v
| Integer n -> Format.fprintf ppf "%i" n
| Plus (a1, a2) -> Format.fprintf ppf "%a +@;<1 2>%a" helper_a a1 helper_a a2
| Minus (a1, a2) -> Format.fprintf ppf "%a -@;<1 2>%a" helper_a a1 helper_a a2
| Times (a1, a2) -> Format.fprintf ppf "%a *@;<1 2>%a" helper_a a1 helper_a a2
| Division (a1, a2) -> Format.fprintf ppf "%a /@;<1 2>%a" helper_a a1 helper_a a2
| Modulo (a1, a2) -> Format.fprintf ppf "%a %%@;<1 2>%a" helper_a a1 helper_a a2
| Power (a1, a2) -> Format.fprintf ppf "(%a ^@;<1 2>%a)" helper_a a1 helper_a a2
| PowerMod (a1, a2, a3) -> Format.fprintf ppf "(%a ^ %a %% %a)" helper_a a1 helper_a a2 helper_a a3
| Rand (a) -> Format.fprintf ppf "Rand (%a)" helper_a a
| Variable v ->
fprintf ppf "%S" v
| Integer n ->
fprintf ppf "%i" n
| Plus (a1, a2) ->
fprintf ppf "%a +@;<1 2>%a" helper_a a1 helper_a a2
| Minus (a1, a2) ->
fprintf ppf "%a -@;<1 2>%a" helper_a a1 helper_a a2
| Times (a1, a2) ->
fprintf ppf "%a *@;<1 2>%a" helper_a a1 helper_a a2
| Division (a1, a2) ->
fprintf ppf "%a /@;<1 2>%a" helper_a a1 helper_a a2
| Modulo (a1, a2) ->
fprintf ppf "%a %%@;<1 2>%a" helper_a a1 helper_a a2
| Power (a1, a2) ->
fprintf ppf "(%a ^@;<1 2>%a)" helper_a a1 helper_a a2
| PowerMod (a1, a2, a3) ->
fprintf ppf "(%a ^ %a %% %a)" helper_a a1 helper_a a2 helper_a a3
| Rand (a) ->
fprintf ppf "Rand (%a)" helper_a a
in
match p with
| Main (i, o, exp) ->
Format.fprintf ppf "def main with (input %S) (output %S) as @.%a" i o helper_c exp
fprintf ppf "def main with (input %S) (output %S) as @.%a" i o helper_c exp
module VariableMap = Map.Make(String)

11
lib/miniImp/definedVariables.ml
View File

@ -114,8 +114,11 @@ let lub (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode =
let newinternalout =
match newinternalbetween with
| [] -> previnternalvar.internalin
| _ -> (snd (Utility.last_list newinternalbetween))
| [] ->
previnternalvar.internalin
| _ ->
let _, newinternalout = (Utility.last_list newinternalbetween) in
newinternalout
in
{ previnternalvar with
@ -186,7 +189,9 @@ let lucf (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode =
let update (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode =
let newt = {t with internalvar = (Cfg.NodeMap.add node (lucf t node) t.internalvar)} in
let newt =
{t with internalvar = (Cfg.NodeMap.add node (lucf t node) t.internalvar)}
in
lub newt node

8
lib/miniImp/liveVariables.ml
View File

@ -239,7 +239,10 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
)
in
let aux (assignments: Variable.t VariableMap.t) (t: DVCfg.t) (node: Cfg.Node.t)
let aux
(assignments: Variable.t VariableMap.t)
(t: DVCfg.t)
(node: Cfg.Node.t)
: (Variable.t VariableMap.t * DVCfg.t) =
let livevars = Cfg.NodeMap.find node t.internalvar in
let code =
@ -298,7 +301,8 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
is mirrored into internalbetween *)
List.fold_left2
(fun acc (i, o) code ->
(* we also consider the out set if we "use" v as a guard *)
(* we also consider the out set if we "use" v as a
guard *)
match List.mem v i,
List.mem v o,
List.mem v (variables_defined code) with

251
lib/miniImp/reduceRegisters.ml
View File

@ -71,20 +71,20 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
match cfg.inputOutputVar with
| None -> all_variables
| Some (i, _o) -> (
match List.assoc_opt i all_variables with
| None -> (i, 1) :: all_variables
| Some f -> (i, f+1) :: (List.remove_assoc i all_variables)
)
match List.assoc_opt i all_variables with
| None -> (i, 1) :: all_variables
| Some f -> (i, f+1) :: (List.remove_assoc i all_variables)
)
in
let all_variables =
match cfg.inputOutputVar with
| None -> all_variables
| Some (_i, o) -> (
match List.assoc_opt o all_variables with
| None -> (o, 1) :: all_variables
| Some f -> (o, f+1) :: (List.remove_assoc o all_variables)
)
match List.assoc_opt o all_variables with
| None -> (o, 1) :: all_variables
| Some f -> (o, f+1) :: (List.remove_assoc o all_variables)
)
in
(* replace each operation with a list of operations that have the new
@ -181,7 +181,7 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
Store (tmpreg2, tmpreg1)]
| _ -> failwith ("ReduceRegisters: fail to partition a set, some" ^
" registers have no binding.")
)
)
| URegOp (urop, r1, r3) ->(
match ( VariableMap.find_opt r1.index remappedregisters,
VariableMap.find_opt r3.index remappedregisters,
@ -274,7 +274,7 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
Store (tmpreg2, tmpreg1)]
| _ -> failwith ("ReduceRegisters: fail to partition a set, some" ^
" registers have no binding.")
)
)
in
List.map aux code |> List.concat
@ -289,14 +289,16 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
List.sort (fun (_a, fa) (_b, fb) -> Int.compare fb fa) all_variables
|> Utility.take (n-2)
in
let most_frequent = fst (List.split most_frequent) in
let least_frequent = fst (List.split least_frequent) in
let most_frequent, _frequencies = List.split most_frequent in
let least_frequent, _frequencies = List.split least_frequent in
(* we map the most frequent to new registers, so that the first two are
always free *)
let most_frequent_mapping = (* +3 because starts at 0, but we want to start
at 1*)
List.mapi (fun n v -> (v, (string_of_int (n+3): Variable.t))) most_frequent
List.mapi
(fun n v -> (v, (string_of_int (n+3): Variable.t)))
most_frequent
|> VariableMap.of_list
in
(* we map the least to memory *)
@ -321,119 +323,120 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
) cfg.content}
in
match newcfg.inputOutputVar with
| None -> newcfg (* if no input or output variables we ignore *)
| Some (i, o) -> (
match (VariableMap.find_opt i most_frequent_mapping,
VariableMap.find_opt o most_frequent_mapping,
VariableMap.find_opt i least_frequent_mapping,
VariableMap.find_opt o least_frequent_mapping )
with (*we check if in and out are simply remapped or are put in memory*)
| Some i, Some o, _, _ ->
{ newcfg with inputOutputVar = Some (i, o) }
| Some i, None, _, Some mo -> ( (* since the output simbol is in memory
we need to first retrive it and then
put the result in a temporary
register *)
match newcfg.terminal with (* we check for the terminal node, if not
present we are very confused and dont
modify the out variable *)
| None -> { newcfg with inputOutputVar = Some (i, o)}
| Some n -> (
let terminalcontent = (
match Cfg.NodeMap.find_opt n newcfg.content with
| None -> []
| Some x -> x
) @ [LoadI (mo, {index = "2"});
Load ({index = "2"}, {index = "2"})]
in
let content = Cfg.NodeMap.add n terminalcontent newcfg.content in
{ newcfg with
inputOutputVar = Some (i, "2");
content = content
}
)
if newcfg.inputOutputVar = None
then newcfg (* if no input or output variables we ignore *)
else
let i, o = Option.get newcfg.inputOutputVar in
match (VariableMap.find_opt i most_frequent_mapping,
VariableMap.find_opt o most_frequent_mapping,
VariableMap.find_opt i least_frequent_mapping,
VariableMap.find_opt o least_frequent_mapping,
newcfg.initial,
newcfg.terminal )
with (*we check if in and out are simply remapped or are put in memory*)
| Some i, Some o, _, _, _, _ ->
{ newcfg with inputOutputVar = Some (i, o) }
| Some i, None, _, Some _, _, None ->
(* we check for the terminal node, if not present we are very confused
and dont modify the out variable *)
{ newcfg with inputOutputVar = Some (i, o)}
| Some i, None, _, Some mo, _, Some n ->
(* since the output simbol is in memory we need to first retrive it
and then put the result in a temporary register *)
let terminalcontent = (
match Cfg.NodeMap.find_opt n newcfg.content with
| None -> []
| Some x -> x
) @ [LoadI (mo, {index = "2"});
Load ({index = "2"}, {index = "2"})]
in
let content =
Cfg.NodeMap.add n terminalcontent newcfg.content
in
{ newcfg with
inputOutputVar = Some (i, "2");
content = content
}
| None, Some o, Some _, _, _, None ->
{ newcfg with inputOutputVar = Some (i, o) }
| None, Some o, Some mi, _, _, Some n -> (
(* the input simbol should be stored in memory *)
let initialcontent =
[(LoadI (mi, {index = "2"}) : RISCCfg.elt);
Store ({index = "1"}, {index = "2"})] @ (
match Cfg.NodeMap.find_opt n newcfg.content with
| None -> []
| Some x -> x
)
in
let content = Cfg.NodeMap.add n initialcontent newcfg.content in
{ newcfg with
inputOutputVar = Some ("1", o);
content = content
}
)
| None, None, Some _, Some _, None, None ->
{ newcfg with inputOutputVar = Some (i, o) }
| None, None, Some _, Some mo, None, Some n ->
(* both simbols should be in memory *)
let terminalcontent = (
match Cfg.NodeMap.find_opt n newcfg.content with
| None -> []
| Some x -> x
) @ [LoadI (mo, {index = "2"});
Load ({index = "2"}, {index = "2"})]
in
let content =
Cfg.NodeMap.add n terminalcontent newcfg.content
in
{ newcfg with
inputOutputVar = Some (i, "2");
content = content
}
| None, None, Some mi, Some _, Some n, None ->
(* both simbols should be in memory *)
let initialcontent =
[(LoadI (mi, {index = "2"}) : RISCCfg.elt);
Store ({index = "1"}, {index = "2"})] @ (
match Cfg.NodeMap.find_opt n newcfg.content with
| None -> []
| Some x -> x
)
| None, Some o, Some mi, _ -> ( (* the input simbol should be stored in
memory *)
match newcfg.initial with
| None -> { newcfg with inputOutputVar = Some (i, o) }
| Some n -> (
let initialcontent =
[(LoadI (mi, {index = "2"}) : RISCCfg.elt);
Store ({index = "1"}, {index = "2"})] @ (
match Cfg.NodeMap.find_opt n newcfg.content with
| None -> []
| Some x -> x
)
in
let content = Cfg.NodeMap.add n initialcontent newcfg.content in
{ newcfg with
inputOutputVar = Some ("1", o);
content = content
}
)
in
let content = Cfg.NodeMap.add n initialcontent newcfg.content in
{ newcfg with
inputOutputVar = Some ("1", o);
content = content
}
| None, None, Some mi, Some mo, Some ni, Some no ->
(* both simbols should be in memory *)
let initialcontent =
[(LoadI (mi, {index = "2"}) : RISCCfg.elt);
Store ({index = "1"}, {index = "2"})] @ (
match Cfg.NodeMap.find_opt ni newcfg.content with
| None -> []
| Some x -> x
)
| None, None, Some mi, Some mo -> ( (* both simbols should be in
memory *)
match newcfg.initial, newcfg.terminal with
| None, None -> { newcfg with inputOutputVar = Some (i, o) }
| None, Some n -> (
let terminalcontent = (
match Cfg.NodeMap.find_opt n newcfg.content with
| None -> []
| Some x -> x
) @ [LoadI (mo, {index = "2"});
Load ({index = "2"}, {index = "2"})]
in
let content = Cfg.NodeMap.add n terminalcontent newcfg.content in
{ newcfg with
inputOutputVar = Some (i, "2");
content = content
}
)
| Some n, None -> (
let initialcontent =
[(LoadI (mi, {index = "2"}) : RISCCfg.elt);
Store ({index = "1"}, {index = "2"})] @ (
match Cfg.NodeMap.find_opt n newcfg.content with
| None -> []
| Some x -> x
)
in
let content = Cfg.NodeMap.add n initialcontent newcfg.content in
{ newcfg with
inputOutputVar = Some ("1", o);
content = content
}
)
| Some ni, Some no -> (
let initialcontent =
[(LoadI (mi, {index = "2"}) : RISCCfg.elt);
Store ({index = "1"}, {index = "2"})] @ (
match Cfg.NodeMap.find_opt ni newcfg.content with
| None -> []
| Some x -> x
)
in
let terminalcontent = (
match Cfg.NodeMap.find_opt no newcfg.content with
| None -> []
| Some x -> x
) @ [LoadI (mo, {index = "2"});
Load ({index = "2"}, {index = "2"})]
in
let content = Cfg.NodeMap.add ni initialcontent newcfg.content in
let content = Cfg.NodeMap.add no terminalcontent content in
{ newcfg with
inputOutputVar = Some ("1", "2");
content = content
}
)
)
| _ -> failwith ("ReduceRegisters: fail to partition a set, some" ^
" registers have no binding.")
)
in
let terminalcontent = (
match Cfg.NodeMap.find_opt no newcfg.content with
| None -> []
| Some x -> x
) @ [LoadI (mo, {index = "2"});
Load ({index = "2"}, {index = "2"})]
in
let content =
Cfg.NodeMap.add ni initialcontent newcfg.content
in
let content =
Cfg.NodeMap.add no terminalcontent content
in
{ newcfg with
inputOutputVar = Some ("1", "2");
content = content
}
| _ -> failwith ("ReduceRegisters: fail to partition a set, some" ^
" registers have no binding.")
in
( if List.length all_variables <= n

28
lib/miniImp/replacePowerMod.ml
View File

@ -17,7 +17,10 @@ let rewrite_instructions (prg: Types.p_exp) : Types.p_exp =
| _, Some a -> Some a
)
| If (b, c1, c2) -> (
match contains_rewrite_b b, contains_rewrite c1, contains_rewrite c2 with
match contains_rewrite_b b,
contains_rewrite c1,
contains_rewrite c2
with
| None, None, None -> None
| Some a, _, _
| _, Some a, _
@ -30,7 +33,11 @@ let rewrite_instructions (prg: Types.p_exp) : Types.p_exp =
| _, Some a -> Some a
)
| For (c1, b, c2, c3) -> (
match contains_rewrite c1, contains_rewrite_b b, contains_rewrite c2, contains_rewrite c3 with
match contains_rewrite c1,
contains_rewrite_b b,
contains_rewrite c2,
contains_rewrite c3
with
| None, None, None, None -> None
| Some a, _, _, _
| _, Some a, _, _
@ -105,7 +112,11 @@ let rewrite_instructions (prg: Types.p_exp) : Types.p_exp =
in
(* functions that replace a pattern in a subexpression *)
let rec replace_occurrence_a (pattern: Types.a_exp) (replace: Types.a_exp) (a: Types.a_exp) : Types.a_exp =
let rec replace_occurrence_a
(pattern: Types.a_exp)
(replace: Types.a_exp)
(a: Types.a_exp)
: Types.a_exp =
if a = pattern then
replace
else (
@ -122,7 +133,11 @@ let rewrite_instructions (prg: Types.p_exp) : Types.p_exp =
| PowerMod (a1, a2, a3) -> PowerMod (r_o_a a1, r_o_a a2, r_o_a a3)
| Rand (a) -> Rand (r_o_a a)
)
and replace_occurrence_b (pattern: Types.a_exp) (replace: Types.a_exp) (b: Types.b_exp) : Types.b_exp =
and replace_occurrence_b
(pattern: Types.a_exp)
(replace: Types.a_exp)
(b: Types.b_exp)
: Types.b_exp =
let r_o_b = replace_occurrence_b pattern replace in
let r_o_a = replace_occurrence_a pattern replace in
match b with
@ -197,7 +212,10 @@ let rewrite_instructions (prg: Types.p_exp) : Types.p_exp =
let freshres = new_fresh_var "res" in
Sequence (
partial freshres a1 a2 a3,
For (fora1, replace_occurrence_b pwm (Variable freshres) b, fora2, fora3)
For ( fora1,
replace_occurrence_b pwm (Variable freshres) b,
fora2,
fora3 )
)
| _ -> failwith "PowerMod is not present"
in