diff --git a/lib/miniImp/CfgImp.ml b/lib/miniImp/CfgImp.ml index 0428ea3..c447109 100644 --- a/lib/miniImp/CfgImp.ml +++ b/lib/miniImp/CfgImp.ml @@ -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 diff --git a/lib/miniImp/CfgRISC.ml b/lib/miniImp/CfgRISC.ml index 4494deb..a18651b 100644 --- a/lib/miniImp/CfgRISC.ml +++ b/lib/miniImp/CfgRISC.ml @@ -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) -> ( diff --git a/lib/miniImp/RISC.ml b/lib/miniImp/RISC.ml index 2858078..e694bc0 100644 --- a/lib/miniImp/RISC.ml +++ b/lib/miniImp/RISC.ml @@ -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" diff --git a/lib/miniImp/RISCSemantics.ml b/lib/miniImp/RISCSemantics.ml index cec0683..d01414d 100644 --- a/lib/miniImp/RISCSemantics.ml +++ b/lib/miniImp/RISCSemantics.ml @@ -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) :: _ -> ( diff --git a/lib/miniImp/Semantics.ml b/lib/miniImp/Semantics.ml index b783715..7884884 100644 --- a/lib/miniImp/Semantics.ml +++ b/lib/miniImp/Semantics.ml @@ -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 ) diff --git a/lib/miniImp/Types.ml b/lib/miniImp/Types.ml index 950f5ab..7762cfb 100644 --- a/lib/miniImp/Types.ml +++ b/lib/miniImp/Types.ml @@ -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 := @[%a@]" x helper_a a - | Sequence (c1, c2) -> Format.fprintf ppf "@[Sequence (@;<1 2>%a,@;<1 0>%a@;<0 0>)@]" helper_c c1 helper_c c2 - | If (b, c1, c2) -> Format.fprintf ppf "@[If @[%a@]@;<1 2>then (@[%a@])@;<1 2>else (@[%a@])@]" helper_b b helper_c c1 helper_c c2 - | While (b, c) -> Format.fprintf ppf "@[While @[%a@] do@;<1 2>%a@]@;<0 0>" helper_b b helper_c c - | For (c1, b, c2, c3) -> Format.fprintf ppf "@[For (@;<0 2>%a,@;<1 2>@[%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 := @[%a@]" x helper_a a + | Sequence (c1, c2) -> + fprintf ppf "@[Sequence (@;<1 2>%a,@;<1 0>%a@;<0 0>)@]" + helper_c c1 helper_c c2 + | If (b, c1, c2) -> + fprintf ppf + "@[If @[%a@]@;<1 2>then (@[%a@])@;<1 2>else (@[%a@])@]" + helper_b b helper_c c1 helper_c c2 + | While (b, c) -> + fprintf ppf "@[While @[%a@] do@;<1 2>%a@]@;<0 0>" + helper_b b helper_c c + | For (c1, b, c2, c3) -> + fprintf ppf + "@[For (@;<0 2>%a,@;<1 2>@[%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) diff --git a/lib/miniImp/definedVariables.ml b/lib/miniImp/definedVariables.ml index 4ace70e..6e4b74f 100644 --- a/lib/miniImp/definedVariables.ml +++ b/lib/miniImp/definedVariables.ml @@ -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 diff --git a/lib/miniImp/liveVariables.ml b/lib/miniImp/liveVariables.ml index a8b9ab6..35107df 100644 --- a/lib/miniImp/liveVariables.ml +++ b/lib/miniImp/liveVariables.ml @@ -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 diff --git a/lib/miniImp/reduceRegisters.ml b/lib/miniImp/reduceRegisters.ml index 5ebdf41..420778e 100644 --- a/lib/miniImp/reduceRegisters.ml +++ b/lib/miniImp/reduceRegisters.ml @@ -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 diff --git a/lib/miniImp/replacePowerMod.ml b/lib/miniImp/replacePowerMod.ml index 030fe3e..3b37773 100644 --- a/lib/miniImp/replacePowerMod.ml +++ b/lib/miniImp/replacePowerMod.ml @@ -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