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

Minor modifications, adding comments

Browse Source
This commit is contained in:
elvis
2025-01-15 00:10:44 +01:00
parent 11adaa5103
commit cf0bc41a23
15 changed files with 124 additions and 54 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
bin/miniFunInterpreter.ml
View File

@ -58,7 +58,8 @@ let () =
| Lexer.LexingError msg ->
Printf.fprintf stderr "%a: %s\n" print_position lexbuf msg;
exit (-1)
| Parser.Error -> Printf.fprintf stderr "%a: syntax error\n" print_position lexbuf;
| Parser.Error ->
Printf.fprintf stderr "%a: syntax error\n" print_position lexbuf;
exit (-1)
in
let _ =

35
bin/miniImpInterpreterReg.ml
View File

@ -5,7 +5,7 @@ open Lexing
(* Command Arguments *)
let () =
Clap.description "Interpreter for MiniImp language.";
Clap.description "Interpreter for MiniImp language to RISC code.";
let files = Clap.section ~description: "Files to consider." "FILES" in
let values = Clap.section ~description: "Input values." "VALUES" in
@ -36,6 +36,22 @@ let () =
false
in
let checkundefined = Clap.flag
~description: "Optional flag for disabling the check for undefined variables."
~section: values
~unset_long: "undefined"
~unset_short: 'u'
true
in
let optimizereg = Clap.flag
~description: "Optional flag for disabling optimizing registers with liveness analysis."
~section: values
~unset_long: "liveness"
~unset_short: 'l'
true
in
let inputval = Clap.default_int
~description: "Optional input value to feed to the program. \
If not specified it is read from stdin."
@ -85,7 +101,7 @@ let () =
CfgRISC.convert
in
let () = (
if checkundefined then (
match DefinedVariables.compute_defined_variables return_value |>
DefinedVariables.check_undefined_variables
with
@ -94,13 +110,20 @@ let () =
Printf.printf "Error: undefined variables: %a\n"
DefinedVariables.Variable.pplist l;
exit (-1)
) in
) else ();
let return_value =
if optimizereg then
return_value |>
LiveVariables.compute_live_variables |>
LiveVariables.optimize_cfg |>
LiveVariables.compute_cfg
else
return_value
in
let return_value =
return_value |>
LiveVariables.compute_live_variables |>
LiveVariables.optimize_cfg |>
LiveVariables.compute_cfg |>
ReduceRegisters.reduceregisters registers |>
RISC.convert
in

12
lib/analysis/Dataflow.ml
View File

@ -41,7 +41,9 @@ module Make (M: Cfg.PrintableType) (I: Cfg.PrintableType) = struct
match Utility.equality a.internalin b.internalin,
Utility.equality a.internalout b.internalout,
(List.fold_left2 (fun acc (ain, aout) (bin, bout)
-> acc && (Utility.equality ain bin) && (Utility.equality aout bout)
-> acc &&
(Utility.equality ain bin) &&
(Utility.equality aout bout)
) true a.internalbetween b.internalbetween)
with
| true, true, true -> true
@ -54,7 +56,7 @@ module Make (M: Cfg.PrintableType) (I: Cfg.PrintableType) = struct
internalvar: internalnode Cfg.NodeMap.t;
}
let compareinternal (a: internalnode Cfg.NodeMap.t) (b: internalnode Cfg.NodeMap.t) =
let compareinternal a b =
Cfg.NodeMap.fold
(fun node bi acc ->
match Cfg.NodeMap.find_opt node a with
@ -141,7 +143,9 @@ module Make (M: Cfg.PrintableType) (I: Cfg.PrintableType) = struct
let fixed_point
?(init : (elt list -> internalnode) =
(fun _ -> {internalin = []; internalout = []; internalbetween = []}))
(fun _ -> {internalin = [];
internalout = [];
internalbetween = []}))
?(update : (t -> Cfg.Node.t -> internalnode) =
(fun t n -> Cfg.NodeMap.find n t.internalvar))
(t: t)
@ -150,7 +154,7 @@ module Make (M: Cfg.PrintableType) (I: Cfg.PrintableType) = struct
the update function takes the node and the whole structure and is
expected to return the updated structure for the appropriate node,
update function is applied to the resulting structure until no change is
observed
observed with compareinternal function
*)
let rec helper t =
let newt =

4
lib/analysis/Dataflow.mli
View File

@ -18,7 +18,9 @@ module type C = sig
val from_cfg : cfgt -> t
val to_cfg : t -> cfgt
val fixed_point : ?init:(elt list -> internalnode) -> ?update:(t -> Cfg.Node.t -> internalnode) -> t -> t
val fixed_point :
?init:(elt list -> internalnode) ->
?update:(t -> Cfg.Node.t -> internalnode) -> t -> t
val pp : out_channel -> t -> unit
end

1
lib/miniFun/Lexer.mll
View File

@ -81,6 +81,7 @@ rule read = parse
(lexbuf.Lexing.lex_curr_p.Lexing.pos_lnum)
(lexbuf.Lexing.lex_curr_p.Lexing.pos_lnum)
))}
and comments level = parse
| "*)" {if level = 0
then read lexbuf

3
lib/miniFun/Parser.mly
View File

@ -24,7 +24,6 @@
%start prg
(* associativity in order of precedence *)
/*%right rightlowest */
%left lowest
%right TYPEFUNCTION
%left COMMA
@ -35,7 +34,7 @@
%left CMP CMPLESS CMPLESSEQ CMPGREATER CMPGREATEREQ
%left PLUS MINUS
%left TIMES DIVISION MODULO
%left POWER
%right POWER
%right BNOT RAND
%left FIRST SECOND
%left LAMBDA

16
lib/miniImp/CfgImp.ml
View File

@ -25,7 +25,6 @@ module SimpleStatements = struct
| SimpleDivision of simpleArithmetic * simpleArithmetic
| SimpleModulo of simpleArithmetic * simpleArithmetic
| SimplePower of simpleArithmetic * simpleArithmetic
| SimplePowerMod of simpleArithmetic * simpleArithmetic * simpleArithmetic
| SimpleRand of simpleArithmetic
let pp (ppf: out_channel) (c: t) : unit =
@ -55,7 +54,6 @@ module SimpleStatements = struct
| 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
| SimplePowerMod (a1, a2, a3) -> Printf.fprintf ppf "{powmod %a %a %a}" helper_a a1 helper_a a2 helper_a a3
| SimpleRand (a) -> Printf.fprintf ppf "{rand %a}" helper_a a
in
helper_c ppf c
@ -69,18 +67,19 @@ module SSCfg = Cfg.Make(SimpleStatements)
let rec convert_c (prevcfg: SSCfg.t) (prg: Types.c_exp) : SSCfg.t =
let open SimpleStatements in
match prg with
| Skip ->
| Skip -> (* we preserve the skips *)
prevcfg |> SSCfg.addToLastNode SimpleSkip
| Assignment (x, a) ->
| Assignment (x, a) -> (* we simply add the assignment to the terminal node *)
prevcfg |> SSCfg.addToLastNode (SimpleAssignment (x, convert_a a))
| Sequence (c1, c2) ->
| Sequence (c1, c2) -> (* we first convert the first sequence, then the second
using the previous as prevcfg *)
let cfg1 = convert_c prevcfg c1 in
let cfg2 = convert_c cfg1 c2 in
cfg2
| If (b, c1, c2) ->
| If (b, c1, c2) -> (* constructs two branches with a two new nodes *)
let convertedb = convert_b b in
let cfg1 = convert_c SSCfg.empty c1 in
let cfg2 = convert_c SSCfg.empty c2 in
@ -93,7 +92,7 @@ let rec convert_c (prevcfg: SSCfg.t) (prg: Types.c_exp) : SSCfg.t =
NodeMap.add_to_list entrynode (SimpleGuard convertedb) |>
NodeMap.add_to_list exitnode (SimpleSkip) }
| While (b, c) ->
| While (b, c) -> (* constructs a loop, needs three new nodes *)
let convertedb = convert_b b in
let cfg = convert_c SSCfg.empty c in
let cfginitial = Option.get cfg.initial in
@ -124,7 +123,8 @@ let rec convert_c (prevcfg: SSCfg.t) (prg: Types.c_exp) : SSCfg.t =
NodeMap.add_to_list exitnode (SimpleSkip)
} |> SSCfg.concat prevcfg
| For (assignment, guard, increment, body) ->
| For (assignment, guard, increment, body) -> (* constructs a loop, needs
two new nodes *)
let cfgassignment = convert_c SSCfg.empty assignment in
let convertedguard = convert_b guard in
let cfgincrement = convert_c SSCfg.empty increment in

1
lib/miniImp/CfgImp.mli
View File

@ -24,7 +24,6 @@ module SimpleStatements : sig
| SimpleDivision of simpleArithmetic * simpleArithmetic
| SimpleModulo of simpleArithmetic * simpleArithmetic
| SimplePower of simpleArithmetic * simpleArithmetic
| SimplePowerMod of simpleArithmetic * simpleArithmetic * simpleArithmetic
| SimpleRand of simpleArithmetic
val pp : out_channel -> t -> unit

3
lib/miniImp/CfgRISC.ml
View File

@ -706,9 +706,6 @@ and c_ss_sa
(convertedcode @ [BRegOp (Pow, partialresreg1, partialresreg2, register)], m)
)
)
| SimplePowerMod (_a1, _a2, _a3) -> (
failwith "not implemented"
)
| SimpleRand (a) -> (
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in

2
lib/miniImp/Parser.mly
View File

@ -32,7 +32,7 @@
%left DIVISION
%left MODULO
%left TIMES
%left POWER
%right POWER
%left DO
%%

47
lib/miniImp/RISCSemantics.ml
View File

@ -19,6 +19,8 @@ module RISCArchitecture = struct
end
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
(prg: RISC.RISCAssembly.risci list)
(current: RISC.RISCAssembly.risci list)
@ -98,7 +100,8 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
None -> prg (* should never happen *)
| 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))
helper
prg (CodeMap.find (List.nth lo (i+1)) prg.code) (List.nth lo (i+1))
else
prg
)
@ -109,32 +112,45 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
(RegisterMap.find {index = r1.index} prg.registers)
(RegisterMap.find {index = r2.index} prg.registers)
in
helper {prg with registers = RegisterMap.add {index = r3.index} n prg.registers} tl current_label
helper { prg with
registers = RegisterMap.add {index = r3.index} n prg.registers }
tl current_label
)
| BImmOp (biop, r1, i, r3) :: tl -> (
let n = (match_operator_i biop)
(RegisterMap.find {index = r1.index} prg.registers)
i
in
helper {prg with registers = RegisterMap.add {index = r3.index} n prg.registers} tl current_label
helper { prg with
registers = RegisterMap.add {index = r3.index} n prg.registers }
tl current_label
)
| URegOp (urop, r1, r3) :: tl -> (
match urop with
| Copy -> (
let n = RegisterMap.find {index = r1.index} prg.registers in
helper {prg with registers = RegisterMap.add {index = r3.index} n prg.registers} tl current_label
helper { prg with
registers =
RegisterMap.add {index = r3.index} n prg.registers }
tl current_label
)
| Not -> (
let n = Utility.int_not
(RegisterMap.find {index = r1.index} prg.registers)
in
helper {prg with registers = RegisterMap.add {index = r3.index} n prg.registers} tl current_label
helper { prg with
registers =
RegisterMap.add {index = r3.index} n prg.registers }
tl current_label
)
| Rand -> (
let n = Random.int
(RegisterMap.find {index = r1.index} prg.registers)
in
helper {prg with registers = RegisterMap.add {index = r3.index} n prg.registers} tl current_label
helper { prg with
registers =
RegisterMap.add {index = r3.index} n prg.registers }
tl current_label
)
)
| Load (r1, r3) :: tl -> (
@ -143,12 +159,16 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
(RegisterMap.find {index = r1.index} prg.registers)
prg.memory
in
helper {prg with registers = RegisterMap.add {index = r3.index} n prg.registers} tl current_label
helper { prg with
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} tl current_label
helper { prg with
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
@ -166,12 +186,17 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
)
| Label _ :: tl -> helper prg tl current_label
in
RegisterMap.find
prg.outputreg
(helper prg (CodeMap.find "main" prg.code) "main").registers
match
RegisterMap.find_opt
prg.outputreg
(helper prg (CodeMap.find "main" prg.code) "main").registers
with
Some x -> x
| None -> failwith "Output register not found"
let reduce (prg: RISC.RISCAssembly.t) : int =
(* takes assembly and execute it *)
reduce_instructions
{code = convert prg;
registers = (

3
lib/miniImp/definedVariables.ml
View File

@ -191,6 +191,7 @@ let update (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode =
let compute_defined_variables (cfg: RISCCfg.t) : DVCfg.t =
(* creates the DVCfg structure and finds the fixed point *)
let all_variables = List.fold_left
(fun acc (_, code) ->
Utility.unique_union acc (variables_all code))
@ -208,6 +209,7 @@ let compute_defined_variables (cfg: RISCCfg.t) : DVCfg.t =
let check_undefined_variables (dvcfg: DVCfg.t) : Variable.t list option =
(* returns all undefined variables previously computed *)
let helper (node: Cfg.Node.t) (dvcfg: DVCfg.t) : Variable.t list option =
let code = match Cfg.NodeMap.find_opt node dvcfg.t.content with
None -> []
@ -257,4 +259,5 @@ let check_undefined_variables (dvcfg: DVCfg.t) : Variable.t list option =
let compute_cfg (dvcfg: DVCfg.t) : RISCCfg.t =
(* no change to the cfg so returned as is *)
DVCfg.to_cfg dvcfg

4
lib/miniImp/liveVariables.ml
View File

@ -238,14 +238,14 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
(newassignments, newt)
in
(* --------- *)
(* ------------------- *)
let assignments = VariableMap.empty in
let a, newt =
Cfg.NodeSet.fold (* for each node we replace all the variables with the
optimized ones *)
(fun node (ass, t) -> aux ass t node)
(fun node (assign, t) -> aux assign t node)
t.t.nodes
(assignments, t)
in

38
lib/miniImp/reduceRegisters.ml
View File

@ -18,7 +18,8 @@ module RISCCfg = CfgRISC.RISCCfg
module VariableMap = Map.Make(Variable)
let variables_frequency (instr : RISCCfg.elt) : (Variable.t * int) list =
let add_one = (fun x -> match x with None -> Some 1 | Some x -> Some (x + 1)) in
let add_one = (fun x -> match x with None -> Some 1 | Some x -> Some (x + 1))
in
let helper (acc: int VariableMap.t) (instr: RISCCfg.elt) : int VariableMap.t =
match instr with
@ -40,7 +41,9 @@ let variables_frequency (instr : RISCCfg.elt) : (Variable.t * int) list =
helper VariableMap.empty instr |> VariableMap.to_list
let variables_all_frequency (instructions : RISCCfg.elt list) : (Variable.t * int) list =
(* computes syntactic frequency of all variables in the code *)
let variables_all_frequency (instructions : RISCCfg.elt list)
: (Variable.t * int) list =
List.fold_left
( fun (acc: int VariableMap.t) (instr: RISCCfg.elt) ->
VariableMap.union
@ -50,16 +53,20 @@ let variables_all_frequency (instructions : RISCCfg.elt list) : (Variable.t * in
let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
(if n < 4 then (failwith "ReduceRegisters: number of registers too small") else ());
(if n < 4 then (
failwith "ReduceRegisters: number of registers too small"
) else ());
(* we get all the variables with associated frequency (only syntactic use) *)
let all_variables = List.fold_left
(fun acc (_, code) ->
Utility.unique_union_assoc (fun _n x y -> x + y) acc (variables_all_frequency code))
Utility.unique_union_assoc
(fun _n x y -> x + y) acc (variables_all_frequency code))
[]
(Cfg.NodeMap.to_list cfg.content)
in
(* add one to in and out variables *)
let all_variables =
match cfg.inputOutputVar with
| None -> all_variables
@ -80,6 +87,8 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
)
in
(* replace each operation with a list of operations that have the new
registers or load from memory *)
let replaceregisters
(remappedregisters: Variable.t VariableMap.t)
(memorymap: int VariableMap.t)
@ -143,7 +152,10 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
BRegOp (brop, tmpreg1, tmpreg2, tmpreg2);
LoadI (m3, tmpreg1);
Store (tmpreg2, tmpreg1)]
| _ -> [BRegOp (brop, {index = r1.index}, {index = r2.index}, {index = r3.index})]
| _ -> [BRegOp (brop,
{index = r1.index},
{index = r2.index},
{index = r3.index})]
)
| BImmOp (biop, r1, i, r3) -> (
match ( VariableMap.find_opt r1.index remappedregisters,
@ -237,8 +249,8 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
" registers have no binding.")
)
| Store (r1, r3) -> (
(* we want to maybe store an address in memory (very confusing, don't
think can happen) *)
(* we want to maybe store an address in memory (very confusing,
but maybe possible) *)
match ( VariableMap.find_opt r1.index remappedregisters,
VariableMap.find_opt r3.index remappedregisters,
VariableMap.find_opt r1.index memorymap,
@ -269,6 +281,8 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
in
(* partition the variables into two sets, most frequent and least frequent
then apply the transformation *)
let aux (cfg: RISCCfg.t) (all_variables: (string * int) list) =
(* we keep the first two variables free for immediate use *)
let most_frequent, least_frequent =
@ -298,8 +312,13 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
let newcfg = {
cfg with
content = Cfg.NodeMap.map
(fun x -> replaceregisters most_frequent_mapping least_frequent_mapping ["1"; "2"] x)
cfg.content}
( fun x ->
replaceregisters
most_frequent_mapping
least_frequent_mapping
["1"; "2"]
x
) cfg.content}
in
match newcfg.inputOutputVar with
@ -417,7 +436,6 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
)
in
( if List.length all_variables <= n
then cfg
else aux cfg all_variables )

6
lib/miniImp/replacePowerMod.ml
View File

@ -1,10 +1,8 @@
let rewrite_instructions (prg: Types.p_exp) : Types.p_exp =
(* function takes a program and replaces all occurrences of powermod with
simpler instructions *)
let i, o, prg = (
match prg with
| Main (i, o, exp) -> i, o, exp
) in
let Main (i, o, prg) = prg in
let rec contains_rewrite (prg: Types.c_exp) : Types.a_exp option =
(* if the ast contains powermod anywhere returns the powermod, otherwise