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

401
lib/miniImp/CfgRISC.ml
View File

@ -49,13 +49,21 @@ module RISCSimpleStatements = struct
let pp (ppf: out_channel) (v: t) : unit = let pp (ppf: out_channel) (v: t) : unit =
let rec pp_t (ppf: out_channel) (v: t) : unit = let rec pp_t (ppf: out_channel) (v: t) : unit =
match v with match v with
Nop -> Printf.fprintf ppf "Nop" 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 Printf.fprintf ppf "Nop"
| BImmOp (b, r1, i, r3) -> Printf.fprintf ppf "%a r%s %d => r%s" pp_biop b r1.index i r3.index | BRegOp (b, r1, r2, r3) ->
| URegOp (u, r1, r2) -> Printf.fprintf ppf "%a r%s => r%s" pp_urop u r1.index r2.index Printf.fprintf ppf "%a r%s r%s => r%s"
| Load (r1, r2) -> Printf.fprintf ppf "Load r%s => r%s" r1.index r2.index pp_brop b r1.index r2.index r3.index
| LoadI (i, r2) -> Printf.fprintf ppf "LoadI %d => r%s" i r2.index | BImmOp (b, r1, i, r3) ->
| Store (r1, r2) -> Printf.fprintf ppf "Store r%s => r%s" r1.index r2.index 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 = and pp_brop (ppf: out_channel) (v: brop) : unit =
match v with match v with
Add -> Printf.fprintf ppf "Add" Add -> Printf.fprintf ppf "Add"
@ -118,7 +126,8 @@ module RegisterMap = struct
({index = string_of_int !globalcounter}, ({index = string_of_int !globalcounter},
{assignments = {assignments =
Types.VariableMap.add x Types.VariableMap.add x
({index = (string_of_int !globalcounter)}: RISCSimpleStatements.register) ({index = (string_of_int !globalcounter)}
: RISCSimpleStatements.register)
m.assignments})) m.assignments}))
| Some i -> (i, m) | Some i -> (i, m)
@ -129,7 +138,8 @@ module RegisterMap = struct
({index = string_of_int !globalcounter}, ({index = string_of_int !globalcounter},
{assignments = {assignments =
Types.VariableMap.add freshvariable Types.VariableMap.add freshvariable
({index = string_of_int !globalcounter}: RISCSimpleStatements.register) ({index = string_of_int !globalcounter}
: RISCSimpleStatements.register)
m.assignments}, m.assignments},
freshvariable) freshvariable)
@ -182,11 +192,16 @@ and c_ss_sb
(convertedcode @ [LoadI (0, register)], m) (convertedcode @ [LoadI (0, register)], m)
) )
| (_, _) -> ( | (_, _) -> (
let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in let partialresreg1, m, _partialresvar1 =
let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in 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 b1 m convertedcode partialresreg1 in
let convertedcode, m = c_ss_sb b2 m convertedcode partialresreg2 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) -> ( | SimpleBOr (b1, b2) -> (
@ -200,11 +215,16 @@ and c_ss_sb
(LoadI (1, register) :: convertedcode, m) (LoadI (1, register) :: convertedcode, m)
) )
| (_, _) -> ( | (_, _) -> (
let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in let partialresreg1, m, _partialresvar1 =
let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in 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 b1 m convertedcode partialresreg1 in
let convertedcode, m = c_ss_sb b2 m convertedcode partialresreg2 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) -> ( | SimpleBNot (b) -> (
@ -216,7 +236,9 @@ and c_ss_sb
(LoadI (1, register) :: convertedcode, m) (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 let convertedcode, m = c_ss_sb b m convertedcode partialresreg in
(convertedcode @ [URegOp (Not, partialresreg, register)], m) (convertedcode @ [URegOp (Not, partialresreg, register)], m)
) )
@ -230,7 +252,9 @@ and c_ss_sb
) )
| (SimpleInteger (i), a) | (SimpleInteger (i), a)
| (a, SimpleInteger (i)) -> ( | (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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (EqI, partialresreg, i, register)], m) (convertedcode @ [BImmOp (EqI, partialresreg, i, register)], m)
) )
@ -241,17 +265,26 @@ and c_ss_sb
) )
| (SimpleVariable (x), a) | (SimpleVariable (x), a)
| (a, SimpleVariable (x)) -> ( | (a, SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in let xreg, m =
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in 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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (Eq, partialresreg, xreg, register)], m) (convertedcode @ [BRegOp (Eq, partialresreg, xreg, register)], m)
) )
| (_, _) -> ( | (_, _) -> (
let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in let partialresreg1, m, _partialresvar1 =
let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in 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 a1 m convertedcode partialresreg1 in
let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 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) -> ( | SimpleBCmpLess (a1, a2) -> (
@ -265,12 +298,16 @@ and c_ss_sb
(convertedcode @ [BImmOp (LessI, xreg, i, register)], m) (convertedcode @ [BImmOp (LessI, xreg, i, register)], m)
) )
| (SimpleInteger (i), a) -> ( | (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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (MoreI, partialresreg, i, register)], m) (convertedcode @ [BImmOp (MoreI, partialresreg, i, register)], m)
) )
| (a, SimpleInteger (i)) -> ( | (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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (LessI, partialresreg, i, register)], m) (convertedcode @ [BImmOp (LessI, partialresreg, i, register)], m)
) )
@ -281,22 +318,31 @@ and c_ss_sb
) )
| (SimpleVariable (x), a) -> ( | (SimpleVariable (x), a) -> (
let xreg, m = RegisterMap.get_or_set_register x m in 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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (Less, xreg, partialresreg, register)], m) (convertedcode @ [BRegOp (Less, xreg, partialresreg, register)], m)
) )
| (a, SimpleVariable (x)) -> ( | (a, SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in 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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (Less, partialresreg, xreg, register)], m) (convertedcode @ [BRegOp (Less, partialresreg, xreg, register)], m)
) )
| (_, _) -> ( | (_, _) -> (
let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in let partialresreg1, m, _partialresvar1 =
let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in 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 a1 m convertedcode partialresreg1 in
let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 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) -> ( | SimpleBCmpLessEq (a1, a2) -> (
@ -310,12 +356,16 @@ and c_ss_sb
(convertedcode @ [BImmOp (LessEqI, xreg, i, register)], m) (convertedcode @ [BImmOp (LessEqI, xreg, i, register)], m)
) )
| (SimpleInteger (i), a) -> ( | (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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (MoreEqI, partialresreg, i, register)], m) (convertedcode @ [BImmOp (MoreEqI, partialresreg, i, register)], m)
) )
| (a, SimpleInteger (i)) -> ( | (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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (LessEqI, partialresreg, i, register)], m) (convertedcode @ [BImmOp (LessEqI, partialresreg, i, register)], m)
) )
@ -326,22 +376,31 @@ and c_ss_sb
) )
| (SimpleVariable (x), a) -> ( | (SimpleVariable (x), a) -> (
let xreg, m = RegisterMap.get_or_set_register x m in 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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (LessEq, xreg, partialresreg, register)], m) (convertedcode @ [BRegOp (LessEq, xreg, partialresreg, register)], m)
) )
| (a, SimpleVariable (x)) -> ( | (a, SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in 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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (LessEq, partialresreg, xreg, register)], m) (convertedcode @ [BRegOp (LessEq, partialresreg, xreg, register)], m)
) )
| (_, _) -> ( | (_, _) -> (
let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in let partialresreg1, m, _partialresvar1 =
let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in 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 a1 m convertedcode partialresreg1 in
let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 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) -> ( | SimpleBCmpGreater (a1, a2) -> (
@ -355,12 +414,16 @@ and c_ss_sb
(convertedcode @ [BImmOp (MoreI, xreg, i, register)], m) (convertedcode @ [BImmOp (MoreI, xreg, i, register)], m)
) )
| (SimpleInteger (i), a) -> ( | (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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (LessI, partialresreg, i, register)], m) (convertedcode @ [BImmOp (LessI, partialresreg, i, register)], m)
) )
| (a, SimpleInteger (i)) -> ( | (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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (MoreI, partialresreg, i, register)], m) (convertedcode @ [BImmOp (MoreI, partialresreg, i, register)], m)
) )
@ -371,22 +434,31 @@ and c_ss_sb
) )
| (SimpleVariable (x), a) -> ( | (SimpleVariable (x), a) -> (
let xreg, m = RegisterMap.get_or_set_register x m in 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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (More, xreg, partialresreg, register)], m) (convertedcode @ [BRegOp (More, xreg, partialresreg, register)], m)
) )
| (a, SimpleVariable (x)) -> ( | (a, SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in 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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (More, partialresreg, xreg, register)], m) (convertedcode @ [BRegOp (More, partialresreg, xreg, register)], m)
) )
| (_, _) -> ( | (_, _) -> (
let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in let partialresreg1, m, _partialresvar1 =
let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in 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 a1 m convertedcode partialresreg1 in
let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 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) -> ( | SimpleBCmpGreaterEq (a1, a2) -> (
@ -400,12 +472,16 @@ and c_ss_sb
(convertedcode @ [BImmOp (MoreEqI, xreg, i, register)], m) (convertedcode @ [BImmOp (MoreEqI, xreg, i, register)], m)
) )
| (SimpleInteger (i), a) -> ( | (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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (LessEqI, partialresreg, i, register)], m) (convertedcode @ [BImmOp (LessEqI, partialresreg, i, register)], m)
) )
| (a, SimpleInteger (i)) -> ( | (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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (MoreEqI, partialresreg, i, register)], m) (convertedcode @ [BImmOp (MoreEqI, partialresreg, i, register)], m)
) )
@ -416,22 +492,31 @@ and c_ss_sb
) )
| (SimpleVariable (x), a) -> ( | (SimpleVariable (x), a) -> (
let xreg, m = RegisterMap.get_or_set_register x m in 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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (MoreEq, xreg, partialresreg, register)], m) (convertedcode @ [BRegOp (MoreEq, xreg, partialresreg, register)], m)
) )
| (a, SimpleVariable (x)) -> ( | (a, SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in 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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (MoreEq, partialresreg, xreg, register)], m) (convertedcode @ [BRegOp (MoreEq, partialresreg, xreg, register)], m)
) )
| (_, _) -> ( | (_, _) -> (
let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in let partialresreg1, m, _partialresvar1 =
let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in 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 a1 m convertedcode partialresreg1 in
let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 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) | (SimpleInteger (i), a)
| (a, SimpleInteger (i)) -> ( | (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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (AddI, partialresreg, i, register)], m) (convertedcode @ [BImmOp (AddI, partialresreg, i, register)], m)
) )
@ -473,37 +560,56 @@ and c_ss_sa
| (SimpleVariable (x), a) | (SimpleVariable (x), a)
| (a, SimpleVariable (x)) -> ( | (a, SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in 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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (Add, partialresreg, xreg, register)], m) (convertedcode @ [BRegOp (Add, partialresreg, xreg, register)], m)
) )
| (_, _) -> ( | (_, _) -> (
let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in let partialresreg1, m, _partialresvar1 =
let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in 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 a1 m convertedcode partialresreg1 in
let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 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) -> ( | SimpleMinus (a1, a2) -> (
match (a1, a2) with match (a1, a2) with
| (SimpleInteger (i), SimpleVariable (x)) -> ( | (SimpleInteger (i), SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in 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 =
(convertedcode @ [LoadI (i, partialresreg); BRegOp (Sub, partialresreg, xreg, register)], m) RegisterMap.get_fresh_register m
in
(convertedcode @
[LoadI (i, partialresreg);
BRegOp (Sub, partialresreg, xreg, register)], m)
) )
| (SimpleVariable (x), SimpleInteger (i)) -> ( | (SimpleVariable (x), SimpleInteger (i)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in let xreg, m = RegisterMap.get_or_set_register x m in
(convertedcode @ [BImmOp (SubI, xreg, i, register)], m) (convertedcode @ [BImmOp (SubI, xreg, i, register)], m)
) )
| (SimpleInteger (i), a) -> ( | (SimpleInteger (i), a) -> (
let partialresregi, m, _partialresvari = RegisterMap.get_fresh_register m in let partialresregi, m, _partialresvari =
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in 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 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)) -> ( | (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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (SubI, partialresreg, i, register)], m) (convertedcode @ [BImmOp (SubI, partialresreg, i, register)], m)
) )
@ -514,22 +620,31 @@ and c_ss_sa
) )
| (SimpleVariable (x), a) -> ( | (SimpleVariable (x), a) -> (
let xreg, m = RegisterMap.get_or_set_register x m in 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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (Sub, xreg, partialresreg, register)], m) (convertedcode @ [BRegOp (Sub, xreg, partialresreg, register)], m)
) )
| (a, SimpleVariable (x)) -> ( | (a, SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in 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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (Sub, partialresreg, xreg, register)], m) (convertedcode @ [BRegOp (Sub, partialresreg, xreg, register)], m)
) )
| (_, _) -> ( | (_, _) -> (
let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in let partialresreg1, m, _partialresvar1 =
let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in 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 a1 m convertedcode partialresreg1 in
let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 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) -> ( | SimpleTimes (a1, a2) -> (
@ -541,7 +656,9 @@ and c_ss_sa
) )
| (SimpleInteger (i), a) | (SimpleInteger (i), a)
| (a, SimpleInteger (i)) -> ( | (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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (MultI, partialresreg, i, register)], m) (convertedcode @ [BImmOp (MultI, partialresreg, i, register)], m)
) )
@ -553,37 +670,56 @@ and c_ss_sa
| (SimpleVariable (x), a) | (SimpleVariable (x), a)
| (a, SimpleVariable (x)) -> ( | (a, SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in 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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (Mult, partialresreg, xreg, register)], m) (convertedcode @ [BRegOp (Mult, partialresreg, xreg, register)], m)
) )
| (_, _) -> ( | (_, _) -> (
let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in let partialresreg1, m, _partialresvar1 =
let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in 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 a1 m convertedcode partialresreg1 in
let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 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) -> ( | SimpleDivision (a1, a2) -> (
match (a1, a2) with match (a1, a2) with
| (SimpleInteger (i), SimpleVariable (x)) -> ( | (SimpleInteger (i), SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in 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 =
(convertedcode @ [LoadI (i, partialresreg); BRegOp (Div, partialresreg, xreg, register)], m) RegisterMap.get_fresh_register m
in
(convertedcode @
[LoadI (i, partialresreg);
BRegOp (Div, partialresreg, xreg, register)], m)
) )
| (SimpleVariable (x), SimpleInteger (i)) -> ( | (SimpleVariable (x), SimpleInteger (i)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in let xreg, m = RegisterMap.get_or_set_register x m in
(convertedcode @ [BImmOp (DivI, xreg, i, register)], m) (convertedcode @ [BImmOp (DivI, xreg, i, register)], m)
) )
| (SimpleInteger (i), a) -> ( | (SimpleInteger (i), a) -> (
let partialresregi, m, _partialresvari = RegisterMap.get_fresh_register m in let partialresregi, m, _partialresvari =
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in 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 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)) -> ( | (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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (DivI, partialresreg, i, register)], m) (convertedcode @ [BImmOp (DivI, partialresreg, i, register)], m)
) )
@ -594,43 +730,64 @@ and c_ss_sa
) )
| (SimpleVariable (x), a) -> ( | (SimpleVariable (x), a) -> (
let xreg, m = RegisterMap.get_or_set_register x m in 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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (Div, xreg, partialresreg, register)], m) (convertedcode @ [BRegOp (Div, xreg, partialresreg, register)], m)
) )
| (a, SimpleVariable (x)) -> ( | (a, SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in 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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (Div, partialresreg, xreg, register)], m) (convertedcode @ [BRegOp (Div, partialresreg, xreg, register)], m)
) )
| (_, _) -> ( | (_, _) -> (
let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in let partialresreg1, m, _partialresvar1 =
let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in 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 a1 m convertedcode partialresreg1 in
let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 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) -> ( | SimpleModulo (a1, a2) -> (
match (a1, a2) with match (a1, a2) with
| (SimpleInteger (i), SimpleVariable (x)) -> ( | (SimpleInteger (i), SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in 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 =
(convertedcode @ [LoadI (i, partialresreg); BRegOp (Mod, partialresreg, xreg, register)], m) RegisterMap.get_fresh_register m
in
(convertedcode @
[LoadI (i, partialresreg);
BRegOp (Mod, partialresreg, xreg, register)], m)
) )
| (SimpleVariable (x), SimpleInteger (i)) -> ( | (SimpleVariable (x), SimpleInteger (i)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in let xreg, m = RegisterMap.get_or_set_register x m in
(convertedcode @ [BImmOp (ModI, xreg, i, register)], m) (convertedcode @ [BImmOp (ModI, xreg, i, register)], m)
) )
| (SimpleInteger (i), a) -> ( | (SimpleInteger (i), a) -> (
let partialresregi, m, _partialresvari = RegisterMap.get_fresh_register m in let partialresregi, m, _partialresvari =
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in 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 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)) -> ( | (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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (ModI, partialresreg, i, register)], m) (convertedcode @ [BImmOp (ModI, partialresreg, i, register)], m)
) )
@ -641,43 +798,64 @@ and c_ss_sa
) )
| (SimpleVariable (x), a) -> ( | (SimpleVariable (x), a) -> (
let xreg, m = RegisterMap.get_or_set_register x m in 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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (Mod, xreg, partialresreg, register)], m) (convertedcode @ [BRegOp (Mod, xreg, partialresreg, register)], m)
) )
| (a, SimpleVariable (x)) -> ( | (a, SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in 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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (Mod, partialresreg, xreg, register)], m) (convertedcode @ [BRegOp (Mod, partialresreg, xreg, register)], m)
) )
| (_, _) -> ( | (_, _) -> (
let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in let partialresreg1, m, _partialresvar1 =
let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in 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 a1 m convertedcode partialresreg1 in
let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 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) -> ( | SimplePower (a1, a2) -> (
match (a1, a2) with match (a1, a2) with
| (SimpleInteger (i), SimpleVariable (x)) -> ( | (SimpleInteger (i), SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in 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 =
(convertedcode @ [LoadI (i, partialresreg); BRegOp (Pow, partialresreg, xreg, register)], m) RegisterMap.get_fresh_register m
in
(convertedcode @
[LoadI (i, partialresreg);
BRegOp (Pow, partialresreg, xreg, register)], m)
) )
| (SimpleVariable (x), SimpleInteger (i)) -> ( | (SimpleVariable (x), SimpleInteger (i)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in let xreg, m = RegisterMap.get_or_set_register x m in
(convertedcode @ [BImmOp (PowI, xreg, i, register)], m) (convertedcode @ [BImmOp (PowI, xreg, i, register)], m)
) )
| (SimpleInteger (i), a) -> ( | (SimpleInteger (i), a) -> (
let partialresregi, m, _partialresvari = RegisterMap.get_fresh_register m in let partialresregi, m, _partialresvari =
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in 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 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)) -> ( | (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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BImmOp (PowI, partialresreg, i, register)], m) (convertedcode @ [BImmOp (PowI, partialresreg, i, register)], m)
) )
@ -688,22 +866,31 @@ and c_ss_sa
) )
| (SimpleVariable (x), a) -> ( | (SimpleVariable (x), a) -> (
let xreg, m = RegisterMap.get_or_set_register x m in 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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (Pow, xreg, partialresreg, register)], m) (convertedcode @ [BRegOp (Pow, xreg, partialresreg, register)], m)
) )
| (a, SimpleVariable (x)) -> ( | (a, SimpleVariable (x)) -> (
let xreg, m = RegisterMap.get_or_set_register x m in 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 let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
(convertedcode @ [BRegOp (Pow, partialresreg, xreg, register)], m) (convertedcode @ [BRegOp (Pow, partialresreg, xreg, register)], m)
) )
| (_, _) -> ( | (_, _) -> (
let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in let partialresreg1, m, _partialresvar1 =
let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in 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 a1 m convertedcode partialresreg1 in
let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 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) -> ( | SimpleRand (a) -> (
@ -742,8 +929,7 @@ let helper
risccode risccode
let convert (prg: CfgImp.SSCfg.t) : RISCCfg.t = let convert (prg: CfgImp.SSCfg.t) : RISCCfg.t =
match prg with let ({ empty: bool;
{ empty: bool;
nodes: Cfg.NodeSet.t; nodes: Cfg.NodeSet.t;
edges: (Cfg.Node.t * (Cfg.Node.t option)) Cfg.NodeMap.t; edges: (Cfg.Node.t * (Cfg.Node.t option)) Cfg.NodeMap.t;
reverseEdges: (Cfg.Node.t list) Cfg.NodeMap.t; reverseEdges: (Cfg.Node.t list) Cfg.NodeMap.t;
@ -752,7 +938,8 @@ let convert (prg: CfgImp.SSCfg.t) : RISCCfg.t =
initial: Cfg.Node.t option; initial: Cfg.Node.t option;
terminal: Cfg.Node.t option; terminal: Cfg.Node.t option;
content: CfgImp.SimpleStatements.t list Cfg.NodeMap.t content: CfgImp.SimpleStatements.t list Cfg.NodeMap.t
} -> }: CfgImp.SSCfg.t) = prg
in
let initial_bindings = let initial_bindings =
match inputOutputVar with match inputOutputVar with
| Some (i, o) -> ( | 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 pp_risci (ppf: out_channel) (v: risci) : unit =
let rec pp_risci (ppf: out_channel) (v: risci) : unit = let rec pp_risci (ppf: out_channel) (v: risci) : unit =
match v with match v with
Nop -> Printf.fprintf ppf "\tNop\n" | Nop ->
| 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 Printf.fprintf ppf "\tNop\n"
| BImmOp (b, r1, i, r3) -> Printf.fprintf ppf "\t%a r%s %d => r%s\n" pp_biop b r1.index i r3.index | BRegOp (b, r1, r2, r3) ->
| URegOp (u, r1, r2) -> Printf.fprintf ppf "\t%a r%s => r%s\n" pp_urop u r1.index r2.index Printf.fprintf ppf "\t%a r%s r%s => r%s\n"
| Load (r1, r2) -> Printf.fprintf ppf "\tLoad r%s => r%s\n" r1.index r2.index pp_brop b r1.index r2.index r3.index
| LoadI (i, r2) -> Printf.fprintf ppf "\tLoadI %d => r%s\n" i r2.index | BImmOp (b, r1, i, r3) ->
| Store (r1, r2) -> Printf.fprintf ppf "\tStore r%s => r%s\n" r1.index r2.index Printf.fprintf ppf "\t%a r%s %d => r%s\n" pp_biop b r1.index i r3.index
| Jump (label) -> Printf.fprintf ppf "\tJump %s\n" label | URegOp (u, r1, r2) ->
| CJump (r, l1, l2) -> Printf.fprintf ppf "\tCJump r%s => %s, %s\n" r.index l1 l2 Printf.fprintf ppf "\t%a r%s => r%s\n" pp_urop u r1.index r2.index
| Label (label) -> Printf.fprintf ppf "%s:" label | 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 = and pp_brop (ppf: out_channel) (v: brop) : unit =
match v with match v with
Add -> Printf.fprintf ppf "Add" Add -> Printf.fprintf ppf "Add"
@ -121,14 +132,18 @@ module RISCAssembly = struct
| Some i -> Printf.fprintf ppf "Some %d\n" i ); | Some i -> Printf.fprintf ppf "Some %d\n" i );
Printf.fprintf ppf "Input/Output Registers: "; Printf.fprintf ppf "Input/Output Registers: ";
( match t.inputoutputreg with ( match t.inputoutputreg with
None -> Printf.fprintf ppf "None\n" | None ->
| Some (i, o) -> Printf.fprintf ppf "[i: Some r%s, o: Some r%s]\n" i.index o.index); 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"; Printf.fprintf ppf "Code:\n";
List.iter (pp_risci ppf) t.code List.iter (pp_risci ppf) t.code
end end
let convert_cfgrisc_risci (i: CfgRISC.RISCSimpleStatements.t list) : (RISCAssembly.risci list) = let convert_cfgrisc_risci (i: CfgRISC.RISCSimpleStatements.t list) :
let rec helper (i: CfgRISC.RISCSimpleStatements.t) : RISCAssembly.risci = (RISCAssembly.risci list) =
let rec helper (i: CfgRISC.RISCSimpleStatements.t)
: RISCAssembly.risci =
match i with match i with
| Nop -> Nop | Nop -> Nop
| BRegOp (brop, r1, r2, r3) -> BRegOp (helper_brop brop, | 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}) {index = r3.index})
| Store (r1, r3) -> Store ({index = r1.index}, | Store (r1, r3) -> Store ({index = r1.index},
{index = r3.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 match brop with
| Add -> Add | Add -> Add
| Sub -> Sub | Sub -> Sub
@ -163,7 +179,8 @@ let convert_cfgrisc_risci (i: CfgRISC.RISCSimpleStatements.t list) : (RISCAssemb
| LessEq -> LessEq | LessEq -> LessEq
| More -> More | More -> More
| MoreEq -> MoreEq | MoreEq -> MoreEq
and helper_biop (biop: CfgRISC.RISCSimpleStatements.biop) : RISCAssembly.biop = and helper_biop (biop: CfgRISC.RISCSimpleStatements.biop)
: RISCAssembly.biop =
match biop with match biop with
| AddI -> AddI | AddI -> AddI
| SubI -> SubI | SubI -> SubI
@ -178,7 +195,8 @@ let convert_cfgrisc_risci (i: CfgRISC.RISCSimpleStatements.t list) : (RISCAssemb
| LessEqI -> LessEqI | LessEqI -> LessEqI
| MoreI -> MoreI | MoreI -> MoreI
| MoreEqI -> MoreEqI | MoreEqI -> MoreEqI
and helper_urop (urop: CfgRISC.RISCSimpleStatements.urop) : RISCAssembly.urop = and helper_urop (urop: CfgRISC.RISCSimpleStatements.urop)
: RISCAssembly.urop =
match urop with match urop with
| Not -> Not | Not -> Not
| Copy -> Copy | Copy -> Copy
@ -186,7 +204,11 @@ let convert_cfgrisc_risci (i: CfgRISC.RISCSimpleStatements.t list) : (RISCAssemb
in in
List.map helper i 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 (* 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 statement, then create the two lists that represent the runs until the
terminal node by choosing always the false statement in guard statements terminal node by choosing always the false statement in guard statements
@ -244,8 +266,12 @@ let rec helper
let label2 = nextLabel () in let label2 = nextLabel () in
let label3 = nextLabel () in let label3 = nextLabel () in
let res1, _ = (helper prg nextnode1 (currentnode :: nextnode2 :: alreadyVisited)) in let res1, _ =
let res2, vis2 = (helper prg nextnode2 (currentnode :: nextnode1 :: alreadyVisited)) in (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 match List.nth currentcode ((List.length currentcode) - 1) with
| BRegOp (_, _, _, r) | BRegOp (_, _, _, r)
@ -253,11 +279,14 @@ let rec helper
| URegOp (_, _, r) | URegOp (_, _, r)
| Load (_, r) | Load (_, r)
| Store (r, _) | Store (r, _)
| LoadI (_, r) -> (([Label label1] : RISCAssembly.risci list) @ | LoadI (_, r) -> (([Label label1]
: RISCAssembly.risci list) @
currentcode @ currentcode @
([CJump (r, label2, label3); Label label2] : RISCAssembly.risci list) @ ([CJump (r, label2, label3); Label label2]
: RISCAssembly.risci list) @
res1 @ res1 @
([Jump label1; Label label3] : RISCAssembly.risci list) @ ([Jump label1; Label label3]
: RISCAssembly.risci list) @
res2 res2
, vis2) , vis2)
| _ -> failwith "Missing instruction at branch" | _ -> failwith "Missing instruction at branch"
@ -266,7 +295,8 @@ let rec helper
let label2 = nextLabel () in let label2 = nextLabel () in
let label3 = 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 res2, _ = (helper prg nextnode2 vis1) in
let res3, vis3 = (helper prg ncs (currentnode :: alreadyVisited)) in let res3, vis3 = (helper prg ncs (currentnode :: alreadyVisited)) in
match List.nth currentcode ((List.length currentcode) - 1) with match List.nth currentcode ((List.length currentcode) - 1) with
@ -276,11 +306,14 @@ let rec helper
| Load (_, r) | Load (_, r)
| Store (r, _) | Store (r, _)
| LoadI (_, r) -> (currentcode @ | LoadI (_, r) -> (currentcode @
([CJump (r, label1, label2); Label label1] : RISCAssembly.risci list) @ ([CJump (r, label1, label2); Label label1]
: RISCAssembly.risci list) @
res1 @ res1 @
([Jump label3; Label label2] : RISCAssembly.risci list) @ ([Jump label3; Label label2]
: RISCAssembly.risci list) @
res2 @ res2 @
([Label label3] : RISCAssembly.risci list) @ ([Label label3]
: RISCAssembly.risci list) @
res3 res3
, vis3) , vis3)
| _ -> failwith "Missing instruction at branch" | _ -> failwith "Missing instruction at branch"

20
lib/miniImp/RISCSemantics.ml
View File

@ -18,7 +18,8 @@ module RISCArchitecture = struct
} }
end 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 (* takes as input a sequence of RISC commands and computes a map to the right
labels for easier execution *) labels for easier execution *)
let rec helper let rec helper
@ -101,7 +102,9 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
| Some i -> | Some i ->
if i + 1 < (List.length lo) then if i + 1 < (List.length lo) then
helper 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 else
prg prg
) )
@ -113,7 +116,7 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
(RegisterMap.find {index = r2.index} prg.registers) (RegisterMap.find {index = r2.index} prg.registers)
in in
helper { prg with helper { prg with
registers = RegisterMap.add {index = r3.index} n prg.registers } registers = RegisterMap.add {index = r3.index} n prg.registers}
tl current_label tl current_label
) )
| BImmOp (biop, r1, i, r3) :: tl -> ( | BImmOp (biop, r1, i, r3) :: tl -> (
@ -122,7 +125,7 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
i i
in in
helper { prg with helper { prg with
registers = RegisterMap.add {index = r3.index} n prg.registers } registers = RegisterMap.add {index = r3.index} n prg.registers}
tl current_label tl current_label
) )
| URegOp (urop, r1, r3) :: tl -> ( | URegOp (urop, r1, r3) :: tl -> (
@ -160,20 +163,23 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
prg.memory prg.memory
in in
helper { prg with helper { prg with
registers = RegisterMap.add {index = r3.index} n prg.registers } registers = RegisterMap.add {index = r3.index} n prg.registers}
tl current_label tl current_label
) )
| LoadI (i, r3) :: tl -> ( | LoadI (i, r3) :: tl -> (
let n = i let n = i
in in
helper { prg with helper { prg with
registers = RegisterMap.add {index = r3.index} n prg.registers } registers = RegisterMap.add {index = r3.index} n prg.registers}
tl current_label tl current_label
) )
| Store (r1, r3) :: tl -> ( | Store (r1, r3) :: tl -> (
let n = RegisterMap.find {index = r1.index} prg.registers in let n = RegisterMap.find {index = r1.index} prg.registers in
let n1 = RegisterMap.find {index = r3.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 | Jump l :: _ -> helper prg (CodeMap.find l prg.code) l
| CJump (r, l1, l2) :: _ -> ( | 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 match exp_a with
Variable v -> ( Variable v -> (
match VariableMap.find_opt v mem.assignments with match VariableMap.find_opt v mem.assignments with
None -> Error (`AbsentAssignment ("The variable " ^ v ^ " is not defined.")) | None ->
| Some a -> Ok a Error (`AbsentAssignment ("The variable " ^ v ^ " is not defined."))
| Some a ->
Ok a
) )
| Integer n -> Ok n | Integer n -> Ok n
| Plus (exp_a1, exp_a2) -> ( | 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 = let reduce (program: p_exp) (iin : int) : (int, [> error]) result =
match program with match program with
Main (vin, vout, expression) -> ( 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 let* resultmem : memory = evaluate mem expression in
match VariableMap.find_opt vout resultmem.assignments with match VariableMap.find_opt vout resultmem.assignments with
None -> Error (`AbsentAssignment ("The output variable is not defined (" ^ vout ^ ")")) | None ->
| Some a -> Ok a Error (`AbsentAssignment
("The output variable is not defined (" ^ vout ^ ")"))
| Some a ->
Ok a
) )

90
lib/miniImp/Types.ml
View File

@ -1,14 +1,16 @@
type variable = string type variable = string
type p_exp = 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 = and c_exp =
Skip Skip
| Assignment of variable * a_exp (* x := a *) | Assignment of variable * a_exp (* x := a *)
| Sequence of c_exp * c_exp (* c; c *) | Sequence of c_exp * c_exp (* c; c *)
| If of b_exp * c_exp * c_exp (* if b then c else 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 *) | 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 *) | For of c_exp * b_exp * c_exp * c_exp
(* for (c; b; c) do c *)
and b_exp = and b_exp =
Boolean of bool (* v *) Boolean of bool (* v *)
| BAnd of b_exp * b_exp (* b && b *) | BAnd of b_exp * b_exp (* b && b *)
@ -32,41 +34,73 @@ and a_exp =
| Rand of a_exp (* rand(0, a) *) | Rand of a_exp (* rand(0, a) *)
let pp_p_exp (ppf: Format.formatter) (p: p_exp) : unit = let pp_p_exp (ppf: Format.formatter) (p: p_exp) : unit =
let open Format in
let rec helper_c (ppf) (c: c_exp) : unit = let rec helper_c (ppf) (c: c_exp) : unit =
match c with match c with
Skip -> Format.fprintf ppf "Skip" | Skip ->
| Assignment (x, a) -> Format.fprintf ppf "%S := @[<h>%a@]" x helper_a a fprintf ppf "Skip"
| Sequence (c1, c2) -> Format.fprintf ppf "@[<hv>Sequence (@;<1 2>%a,@;<1 0>%a@;<0 0>)@]" helper_c c1 helper_c c2 | Assignment (x, a) ->
| 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 fprintf ppf "%S := @[<h>%a@]" x helper_a a
| While (b, c) -> Format.fprintf ppf "@[<hv>While @[<h>%a@] do@;<1 2>%a@]@;<0 0>" helper_b b helper_c c | Sequence (c1, c2) ->
| 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 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) = and helper_b (ppf) (b: b_exp) =
match b with match b with
Boolean (b) -> Format.fprintf ppf "%b" b | Boolean (b) ->
| BAnd (b1, b2) -> Format.fprintf ppf "(%a &&@;<1 2>%a)" helper_b b1 helper_b b2 fprintf ppf "%b" b
| BOr (b1, b2) -> Format.fprintf ppf "(%a ||@;<1 2>%a)" helper_b b1 helper_b b2 | BAnd (b1, b2) ->
| BNot (b) -> Format.fprintf ppf "(not %a)" helper_b b fprintf ppf "(%a &&@;<1 2>%a)" helper_b b1 helper_b b2
| BCmp (a1, a2) -> Format.fprintf ppf "(%a ==@;<1 2>%a)" helper_a a1 helper_a a2 | BOr (b1, b2) ->
| BCmpLess (a1, a2) -> Format.fprintf ppf "(%a <@;<1 2>%a)" helper_a a1 helper_a a2 fprintf ppf "(%a ||@;<1 2>%a)" helper_b b1 helper_b b2
| BCmpLessEq (a1, a2) -> Format.fprintf ppf "(%a <=@;<1 2>%a)" helper_a a1 helper_a a2 | BNot (b) ->
| BCmpGreater (a1, a2) -> Format.fprintf ppf "(%a >@;<1 2>%a)" helper_a a1 helper_a a2 fprintf ppf "(not %a)" helper_b b
| BCmpGreaterEq (a1, a2) -> Format.fprintf ppf "(%a >=@;<1 2>%a)" helper_a a1 helper_a a2 | 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) = and helper_a (ppf) (a: a_exp) =
match a with match a with
Variable v -> Format.fprintf ppf "%S" v | Variable v ->
| Integer n -> Format.fprintf ppf "%i" n fprintf ppf "%S" v
| Plus (a1, a2) -> Format.fprintf ppf "%a +@;<1 2>%a" helper_a a1 helper_a a2 | Integer n ->
| Minus (a1, a2) -> Format.fprintf ppf "%a -@;<1 2>%a" helper_a a1 helper_a a2 fprintf ppf "%i" n
| Times (a1, a2) -> Format.fprintf ppf "%a *@;<1 2>%a" helper_a a1 helper_a a2 | Plus (a1, a2) ->
| Division (a1, a2) -> Format.fprintf ppf "%a /@;<1 2>%a" helper_a a1 helper_a a2 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 | Minus (a1, a2) ->
| Power (a1, a2) -> Format.fprintf ppf "(%a ^@;<1 2>%a)" helper_a a1 helper_a a2 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 | Times (a1, a2) ->
| Rand (a) -> Format.fprintf ppf "Rand (%a)" helper_a a 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 in
match p with match p with
| Main (i, o, exp) -> | 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) 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 = let newinternalout =
match newinternalbetween with match newinternalbetween with
| [] -> previnternalvar.internalin | [] ->
| _ -> (snd (Utility.last_list newinternalbetween)) previnternalvar.internalin
| _ ->
let _, newinternalout = (Utility.last_list newinternalbetween) in
newinternalout
in in
{ previnternalvar with { 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 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 lub newt node

8
lib/miniImp/liveVariables.ml
View File

@ -239,7 +239,10 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
) )
in 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) = : (Variable.t VariableMap.t * DVCfg.t) =
let livevars = Cfg.NodeMap.find node t.internalvar in let livevars = Cfg.NodeMap.find node t.internalvar in
let code = let code =
@ -298,7 +301,8 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
is mirrored into internalbetween *) is mirrored into internalbetween *)
List.fold_left2 List.fold_left2
(fun acc (i, o) code -> (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, match List.mem v i,
List.mem v o, List.mem v o,
List.mem v (variables_defined code) with List.mem v (variables_defined code) with

85
lib/miniImp/reduceRegisters.ml
View File

@ -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 List.sort (fun (_a, fa) (_b, fb) -> Int.compare fb fa) all_variables
|> Utility.take (n-2) |> Utility.take (n-2)
in in
let most_frequent = fst (List.split most_frequent) in let most_frequent, _frequencies = List.split most_frequent in
let least_frequent = fst (List.split least_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 (* we map the most frequent to new registers, so that the first two are
always free *) always free *)
let most_frequent_mapping = (* +3 because starts at 0, but we want to start let most_frequent_mapping = (* +3 because starts at 0, but we want to start
at 1*) 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 |> VariableMap.of_list
in in
(* we map the least to memory *) (* we map the least to memory *)
@ -321,25 +323,26 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
) cfg.content} ) cfg.content}
in in
match newcfg.inputOutputVar with if newcfg.inputOutputVar = None
| None -> newcfg (* if no input or output variables we ignore *) then newcfg (* if no input or output variables we ignore *)
| Some (i, o) -> ( else
let i, o = Option.get newcfg.inputOutputVar in
match (VariableMap.find_opt i most_frequent_mapping, match (VariableMap.find_opt i most_frequent_mapping,
VariableMap.find_opt o most_frequent_mapping, VariableMap.find_opt o most_frequent_mapping,
VariableMap.find_opt i least_frequent_mapping, VariableMap.find_opt i least_frequent_mapping,
VariableMap.find_opt o 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*) with (*we check if in and out are simply remapped or are put in memory*)
| Some i, Some o, _, _ -> | Some i, Some o, _, _, _, _ ->
{ newcfg with inputOutputVar = Some (i, o) } { newcfg with inputOutputVar = Some (i, o) }
| Some i, None, _, Some mo -> ( (* since the output simbol is in memory | Some i, None, _, Some _, _, None ->
we need to first retrive it and then (* we check for the terminal node, if not present we are very confused
put the result in a temporary and dont modify the out variable *)
register *) { newcfg with inputOutputVar = Some (i, o)}
match newcfg.terminal with (* we check for the terminal node, if not | Some i, None, _, Some mo, _, Some n ->
present we are very confused and dont (* since the output simbol is in memory we need to first retrive it
modify the out variable *) and then put the result in a temporary register *)
| None -> { newcfg with inputOutputVar = Some (i, o)}
| Some n -> (
let terminalcontent = ( let terminalcontent = (
match Cfg.NodeMap.find_opt n newcfg.content with match Cfg.NodeMap.find_opt n newcfg.content with
| None -> [] | None -> []
@ -347,18 +350,17 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
) @ [LoadI (mo, {index = "2"}); ) @ [LoadI (mo, {index = "2"});
Load ({index = "2"}, {index = "2"})] Load ({index = "2"}, {index = "2"})]
in in
let content = Cfg.NodeMap.add n terminalcontent newcfg.content in let content =
Cfg.NodeMap.add n terminalcontent newcfg.content
in
{ newcfg with { newcfg with
inputOutputVar = Some (i, "2"); inputOutputVar = Some (i, "2");
content = content content = content
} }
) | None, Some o, Some _, _, _, None ->
) { newcfg with inputOutputVar = Some (i, o) }
| None, Some o, Some mi, _ -> ( (* the input simbol should be stored in | None, Some o, Some mi, _, _, Some n -> (
memory *) (* the input simbol should be stored in memory *)
match newcfg.initial with
| None -> { newcfg with inputOutputVar = Some (i, o) }
| Some n -> (
let initialcontent = let initialcontent =
[(LoadI (mi, {index = "2"}) : RISCCfg.elt); [(LoadI (mi, {index = "2"}) : RISCCfg.elt);
Store ({index = "1"}, {index = "2"})] @ ( Store ({index = "1"}, {index = "2"})] @ (
@ -373,12 +375,10 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
content = content content = content
} }
) )
) | None, None, Some _, Some _, None, None ->
| None, None, Some mi, Some mo -> ( (* both simbols should be in { newcfg with inputOutputVar = Some (i, o) }
memory *) | None, None, Some _, Some mo, None, Some n ->
match newcfg.initial, newcfg.terminal with (* both simbols should be in memory *)
| None, None -> { newcfg with inputOutputVar = Some (i, o) }
| None, Some n -> (
let terminalcontent = ( let terminalcontent = (
match Cfg.NodeMap.find_opt n newcfg.content with match Cfg.NodeMap.find_opt n newcfg.content with
| None -> [] | None -> []
@ -386,13 +386,15 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
) @ [LoadI (mo, {index = "2"}); ) @ [LoadI (mo, {index = "2"});
Load ({index = "2"}, {index = "2"})] Load ({index = "2"}, {index = "2"})]
in in
let content = Cfg.NodeMap.add n terminalcontent newcfg.content in let content =
Cfg.NodeMap.add n terminalcontent newcfg.content
in
{ newcfg with { newcfg with
inputOutputVar = Some (i, "2"); inputOutputVar = Some (i, "2");
content = content content = content
} }
) | None, None, Some mi, Some _, Some n, None ->
| Some n, None -> ( (* both simbols should be in memory *)
let initialcontent = let initialcontent =
[(LoadI (mi, {index = "2"}) : RISCCfg.elt); [(LoadI (mi, {index = "2"}) : RISCCfg.elt);
Store ({index = "1"}, {index = "2"})] @ ( Store ({index = "1"}, {index = "2"})] @ (
@ -406,8 +408,8 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
inputOutputVar = Some ("1", o); inputOutputVar = Some ("1", o);
content = content content = content
} }
) | None, None, Some mi, Some mo, Some ni, Some no ->
| Some ni, Some no -> ( (* both simbols should be in memory *)
let initialcontent = let initialcontent =
[(LoadI (mi, {index = "2"}) : RISCCfg.elt); [(LoadI (mi, {index = "2"}) : RISCCfg.elt);
Store ({index = "1"}, {index = "2"})] @ ( Store ({index = "1"}, {index = "2"})] @ (
@ -423,17 +425,18 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
) @ [LoadI (mo, {index = "2"}); ) @ [LoadI (mo, {index = "2"});
Load ({index = "2"}, {index = "2"})] Load ({index = "2"}, {index = "2"})]
in in
let content = Cfg.NodeMap.add ni initialcontent newcfg.content in let content =
let content = Cfg.NodeMap.add no terminalcontent content in Cfg.NodeMap.add ni initialcontent newcfg.content
in
let content =
Cfg.NodeMap.add no terminalcontent content
in
{ newcfg with { newcfg with
inputOutputVar = Some ("1", "2"); inputOutputVar = Some ("1", "2");
content = content content = content
} }
)
)
| _ -> failwith ("ReduceRegisters: fail to partition a set, some" ^ | _ -> failwith ("ReduceRegisters: fail to partition a set, some" ^
" registers have no binding.") " registers have no binding.")
)
in in
( if List.length all_variables <= n ( 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 | _, Some a -> Some a
) )
| If (b, c1, c2) -> ( | 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 | None, None, None -> None
| Some a, _, _ | Some a, _, _
| _, Some a, _ | _, Some a, _
@ -30,7 +33,11 @@ let rewrite_instructions (prg: Types.p_exp) : Types.p_exp =
| _, Some a -> Some a | _, Some a -> Some a
) )
| For (c1, b, c2, c3) -> ( | 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 | None, None, None, None -> None
| Some a, _, _, _ | Some a, _, _, _
| _, Some a, _, _ | _, Some a, _, _
@ -105,7 +112,11 @@ let rewrite_instructions (prg: Types.p_exp) : Types.p_exp =
in in
(* functions that replace a pattern in a subexpression *) (* 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 if a = pattern then
replace replace
else ( 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) | PowerMod (a1, a2, a3) -> PowerMod (r_o_a a1, r_o_a a2, r_o_a a3)
| Rand (a) -> Rand (r_o_a a) | 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_b = replace_occurrence_b pattern replace in
let r_o_a = replace_occurrence_a pattern replace in let r_o_a = replace_occurrence_a pattern replace in
match b with match b with
@ -197,7 +212,10 @@ let rewrite_instructions (prg: Types.p_exp) : Types.p_exp =
let freshres = new_fresh_var "res" in let freshres = new_fresh_var "res" in
Sequence ( Sequence (
partial freshres a1 a2 a3, 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" | _ -> failwith "PowerMod is not present"
in in