diff --git a/bin/main.ml b/bin/main.ml index 03a8a0f..e0e6c0e 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -5,15 +5,11 @@ let colorred s = let () = let program = " -def main with input c output m as - a := 0; - b := a + 1; - c := c + b; - a := b * 2; - if a < 3 then - c := 4 - else - c := 6 +def main with input in output out as + out := in; + a := 1; + b := 2; + c := a + a; " in @@ -39,8 +35,12 @@ def main with input c output m as (* Printf.printf "%s\n%a" (colorred "Analysis CFG is") DefinedVariables.DVCfg.pp analysiscfg; *) - (* Printf.printf "%s\n" (colorred "Undefined Variables are:"); *) - (* List.iter (fun v -> Printf.printf "%a, " DefinedVariables.Variable.pp v) (DefinedVariables.check_undefined_variables analysiscfg); *) + (* Printf.printf "%s" (colorred "Undefined Variables are:"); *) + (* ( *) + (* match DefinedVariables.check_undefined_variables analysiscfg with *) + (* | None -> Printf.printf " none"; *) + (* | Some l -> Printf.printf " %a" DefinedVariables.Variable.pplist l; *) + (* ); *) (* Printf.printf "\n"; *) let convertedrisccfg = DefinedVariables.compute_cfg analysiscfg in @@ -48,20 +48,32 @@ def main with input c output m as (* Printf.printf "%s\n%a" (colorred "Converted RISC after analysis CFG is") CfgRISC.RISCCfg.pp convertedrisccfg; *) - let analysiscfg = LiveVariables.compute_live_variables convertedrisccfg in + (* let analysiscfg = LiveVariables.compute_live_variables convertedrisccfg in *) - Printf.printf "%s\n%a" (colorred "Analysis CFG is") LiveVariables.DVCfg.pp analysiscfg; + (* Printf.printf "%s\n%a" (colorred "Live Analysis CFG is") LiveVariables.DVCfg.pp analysiscfg; *) + + (* let convertedrisccfg = LiveVariables.compute_cfg analysiscfg in *) + + (* Printf.printf "%s\n%a" (colorred "Converted RISC with no analysis CFG is") CfgRISC.RISCCfg.pp convertedrisccfg; *) + + + (* let convertedrisccfg = LiveVariables.compute_cfg (LiveVariables.optimize_cfg analysiscfg) in *) + + (* Printf.printf "%s\n%a" (colorred "Converted RISC after analysis CFG is") CfgRISC.RISCCfg.pp convertedrisccfg; *) + + let convertedrisccfg = ReduceRegisters.reduceregisters 4 convertedrisccfg in + + Printf.printf "%s\n%a" (colorred "Converted RISC after reducing registers CFG is") CfgRISC.RISCCfg.pp convertedrisccfg; - let convertedrisccfg = LiveVariables.optimize_cfg analysiscfg |> LiveVariables.compute_cfg in (* ---------------------------------- *) - let _risc = RISC.convert convertedrisccfg in + let risc = RISC.convert convertedrisccfg in - (* Printf.printf "%s\n%a" (colorred "RISC code is") RISC.RISCAssembly.pp risc; *) + Printf.printf "%s\n%a" (colorred "RISC code is") RISC.RISCAssembly.pp risc; - (* let computerisc = RISCSemantics.reduce risc in *) + let computerisc = RISCSemantics.reduce risc in - (* Printf.printf "%s\n%d\n" (colorred "Output of RISC code is") computerisc; *) + Printf.printf "%s\n%d\n" (colorred "Output of RISC code is") computerisc; () diff --git a/dune-project b/dune-project index a984e98..85457a3 100644 --- a/dune-project +++ b/dune-project @@ -12,7 +12,7 @@ (package (name analysis) - (depends ocaml dune)) + (depends ocaml dune utility)) (package (name miniImp) diff --git a/lib/analysis/Dataflow.ml b/lib/analysis/Dataflow.ml index ace70be..9120993 100644 --- a/lib/analysis/Dataflow.ml +++ b/lib/analysis/Dataflow.ml @@ -33,6 +33,16 @@ module Make (M: Cfg.PrintableType) (I: Cfg.PrintableType) = struct internalbetween: (internal list * internal list) list; } + let compareinternalnode (a:internalnode) (b:internalnode) : bool = + 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) + ) true a.internalbetween b.internalbetween) + with + | true, true, true -> true + | _, _, _ -> false + type cfgt = elt Cfg.cfginternal type t = { @@ -40,49 +50,23 @@ 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) = + Cfg.NodeMap.fold + (fun node bi acc -> + match Cfg.NodeMap.find_opt node a with + None -> false + | Some ai -> acc && compareinternalnode ai bi + ) b true + let from_cfg (cfg: cfgt) : t = {t = cfg; internalvar = Cfg.NodeMap.empty} let to_cfg ({t; _}: t) : cfgt = t - let fixed_point - ?(init : (elt list -> internalnode) = - (fun _ -> {internalin = []; internalout = []; internalbetween = []})) - ?(update : (t -> Cfg.Node.t -> internalnode) = - (fun t n -> Cfg.NodeMap.find n t.internalvar)) - (t: t) - : t = - (* init function is applied only once to each node content, - 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 - *) - let rec helper t = - let newt = - {t with - internalvar = Cfg.NodeMap.mapi (fun n _ -> update t n) t.internalvar} - in - if newt = t then newt else helper newt - in - let content = List.fold_left - (fun cfg node -> Cfg.NodeMap.add node {internalin = []; - internalout = []; - internalbetween = []} cfg) - Cfg.NodeMap.empty - (Cfg.NodeSet.to_list t.t.nodes) - in - let content = Cfg.NodeMap.union - (fun _ket _empty code -> Some code) - content - (Cfg.NodeMap.map init t.t.content) - in - helper { t with internalvar = content } - open Cfg - let pp (ppf: out_channel) (c: t) : unit = + let pp (ppf: out_channel) (c: t) : unit = ( Printf.fprintf ppf "Cfg:\n"; Printf.fprintf ppf "Nodes' ids: "; List.iter (fun (x : Node.t) -> Printf.fprintf ppf "%d " x.id) (NodeSet.to_list c.t.nodes); @@ -148,4 +132,54 @@ module Make (M: Cfg.PrintableType) (I: Cfg.PrintableType) = struct Printf.fprintf ppf "\n"; ) (NodeMap.to_list c.internalvar); Printf.fprintf ppf "\n"; + ) + + + let fixed_point + ?(init : (elt list -> internalnode) = + (fun _ -> {internalin = []; internalout = []; internalbetween = []})) + ?(update : (t -> Cfg.Node.t -> internalnode) = + (fun t n -> Cfg.NodeMap.find n t.internalvar)) + (t: t) + : t = + (* init function is applied only once to each node content, + 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 + *) + let rec helper t = + let newt = + {t with + internalvar = Cfg.NodeMap.mapi (fun n _ -> update t n) t.internalvar} + in + if compareinternal newt.internalvar t.internalvar + then newt + else helper newt + in + + let content = + List.fold_left + (fun cfg node -> Cfg.NodeMap.add node {internalin = []; + internalout = []; + internalbetween = []} cfg) + Cfg.NodeMap.empty + (Cfg.NodeSet.to_list t.t.nodes) + in + + let code = (* we add back in the nodes with no code (there is no binding + in the t.t.content map) *) + Cfg.NodeMap.union (fun _n c _empty -> Some c) + t.t.content + (Cfg.NodeMap.of_list + (Cfg.NodeSet.to_list t.t.nodes |> List.map (fun c -> (c, [])))) + in + + let content = Cfg.NodeMap.union + (fun _key _empty code -> Some code) + content + (Cfg.NodeMap.map init code) + in + helper { t with internalvar = content } + end diff --git a/lib/analysis/dune b/lib/analysis/dune index fe21d54..7dd99b4 100644 --- a/lib/analysis/dune +++ b/lib/analysis/dune @@ -1,6 +1,7 @@ (library (name analysis) (public_name analysis) - (modules Cfg Dataflow)) + (modules Cfg Dataflow) + (libraries utility)) (include_subdirs qualified) diff --git a/lib/miniImp/RISC.ml b/lib/miniImp/RISC.ml index 0480db6..93fed0a 100644 --- a/lib/miniImp/RISC.ml +++ b/lib/miniImp/RISC.ml @@ -59,7 +59,8 @@ module RISCAssembly = struct type t = { code : risci list; - inputval: int option + inputval: int option; + inputoutputreg: (register * register) option; } let pp_risci (ppf: out_channel) (v: risci) : unit = @@ -285,4 +286,9 @@ let rec helper let convert (prg: CfgRISC.RISCCfg.t) : RISCAssembly.t = {code = (helper prg (Option.get prg.initial) [] |> fst |> List.append ([Label "main"] : RISCAssembly.risci list)); - inputval = prg.inputVal} + inputval = prg.inputVal; + inputoutputreg = + match prg.inputOutputVar with + None -> None + | Some (i, o) -> Some ({index = i}, {index = o}) + } diff --git a/lib/miniImp/RISC.mli b/lib/miniImp/RISC.mli index 32edc36..fcf163f 100644 --- a/lib/miniImp/RISC.mli +++ b/lib/miniImp/RISC.mli @@ -50,7 +50,8 @@ module RISCAssembly : sig type t = { code : risci list; - inputval: int option + inputval: int option; + inputoutputreg: (register * register) option; } val pp_risci : out_channel -> risci -> unit diff --git a/lib/miniImp/RISCSemantics.ml b/lib/miniImp/RISCSemantics.ml index d371482..db35686 100644 --- a/lib/miniImp/RISCSemantics.ml +++ b/lib/miniImp/RISCSemantics.ml @@ -13,7 +13,8 @@ module RISCArchitecture = struct type t = { code: RISC.RISCAssembly.risci list CodeMap.t; registers: int RegisterMap.t; - memory: int MemoryMap.t + memory: int MemoryMap.t; + outputreg: Register.t; } end @@ -101,7 +102,8 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int = else prg ) - | Nop :: tl -> helper prg tl current_label + | Nop :: tl -> + helper prg tl current_label | BRegOp (brop, r1, r2, r3) :: tl -> ( let n = (match_operator_r brop) (RegisterMap.find {index = r1.index} prg.registers) @@ -136,7 +138,8 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int = ) ) | Load (r1, r3) :: tl -> ( - let n = MemoryMap.find + let n = + MemoryMap.find (RegisterMap.find {index = r1.index} prg.registers) prg.memory in @@ -164,14 +167,29 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int = | Label _ :: tl -> helper prg tl current_label in RegisterMap.find - {index = "out"} + prg.outputreg (helper prg (CodeMap.find "main" prg.code) "main").registers let reduce (prg: RISC.RISCAssembly.t) : int = - reduce_instructions {code = convert prg; - registers = - RegisterMap.singleton - {index = "in"} - (Option.value prg.inputval ~default:0); - memory = MemoryMap.empty} (label_order prg) + reduce_instructions + {code = convert prg; + registers = ( + match prg.inputoutputreg with + | None -> + RegisterMap.singleton + {index = "in"} + (Option.value prg.inputval ~default:0) + | Some (i, _) -> + RegisterMap.singleton + {index = i.index} + (Option.value prg.inputval ~default:0) + ); + memory = MemoryMap.empty; + outputreg = ( + match prg.inputoutputreg with + | None -> {index = "out"} + | Some (_, o) -> {index = o.index} + ) + } + (label_order prg) diff --git a/lib/miniImp/definedVariables.ml b/lib/miniImp/definedVariables.ml index 1b39ac5..7694bb0 100644 --- a/lib/miniImp/definedVariables.ml +++ b/lib/miniImp/definedVariables.ml @@ -50,13 +50,13 @@ let variables_used (instr : DVCfg.elt) : DVCfg.internal list = | Nop | LoadI (_, _) -> acc + | Store (r1, r2) | BRegOp (_, r1, r2, _) -> DVCeltSet.add r1.index acc |> DVCeltSet.add r2.index | BImmOp (_, r1, _, _) | URegOp (_, r1, _) - | Load (r1, _) - | Store (r1, _) -> + | Load (r1, _) -> DVCeltSet.add r1.index acc in @@ -71,24 +71,18 @@ let variables_used_all (instructions : DVCfg.elt list) : DVCfg.internal list = let variables_defined (instructions : DVCfg.elt) : DVCfg.internal list = let helper (acc: DVCeltSet.t) (instr: DVCfg.elt) = match instr with - | Nop -> acc + | Nop + | Store (_, _) -> acc | BRegOp (_, _, _, r3) | BImmOp (_, _, _, r3) | URegOp (_, _, r3) | Load (_, r3) - | LoadI (_, r3) - | Store (_, r3) -> + | LoadI (_, r3) -> DVCeltSet.add r3.index acc in helper DVCeltSet.empty instructions |> DVCeltSet.to_list -let variables_defined_all (instructions : DVCfg.elt list) : DVCfg.internal list = - List.fold_left (fun (acc: DVCeltSet.t) (instr: DVCfg.elt) -> - DVCeltSet.union acc (variables_defined instr |> DVCeltSet.of_list) - ) DVCeltSet.empty instructions |> DVCeltSet.to_list - - (* init function, assign the bottom to everything *) let _init_bottom : (DVCfg.elt list -> DVCfg.internalnode) = @@ -104,91 +98,91 @@ let init_top (all_variables) : (DVCfg.elt list -> DVCfg.internalnode) = (fun _ -> (all_variables, all_variables)))}) -(* piece of code that computes vout for the whole block, not used, - use lub below *) -let _dumb_lub (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode = - let previnternalvar = Cfg.NodeMap.find node t.internalvar in - let code = Cfg.NodeMap.find node t.t.content in - { previnternalvar with - internalout = - Utility.unique_union (variables_defined_all code) (previnternalvar.internalin) - } - - -(* We consider only the propagation in the middle elements during the lub. - This incurs in a performance penality, but it is simpler to implement. - Each node is connected to one previus node. -*) let lub (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode = let previnternalvar = Cfg.NodeMap.find node t.internalvar in let code = match Cfg.NodeMap.find_opt node t.t.content with None -> [] | Some c -> c in + + let newinternalbetween = ( + List.map + (fun (code, (i, _o)) -> + (i, Utility.unique_union i (variables_defined code))) + (List.combine code previnternalvar.internalbetween) + ) in + + let newinternalout = + match newinternalbetween with + | [] -> previnternalvar.internalin + | _ -> (snd (Utility.last_list newinternalbetween)) + in + { previnternalvar with - internalbetween = - List.mapi (* we don't NEED the index but i = 0 is easier to write than - to check if vinout is None *) - (fun i (ithcode, vinout, ithcodeprev) -> - if i = 0 then - let dvin = previnternalvar.internalin in - (dvin, Utility.unique_union dvin (variables_defined ithcode)) - else ( - let ithcodeprev = match ithcodeprev with - None -> ([], []) - | Some x -> x - in - match vinout with - None -> - ([], variables_defined ithcode) - | Some prevdvbtw -> - (snd prevdvbtw, - Utility.unique_union - (variables_defined ithcode) - (ithcodeprev |> fst) - )) - ) - (* ugly code that zips the three lists that we need to compute each vin - and vout for the middle of the code *) - (Utility.combine_thrice - code - (Utility.pad_opt - (Utility.prev previnternalvar.internalbetween None) None (List.length code)) - (Utility.pad previnternalvar.internalbetween None (List.length code)) - ); - internalout = - match previnternalvar.internalbetween with - [] -> previnternalvar.internalin - | _ -> (snd (Utility.last_list previnternalvar.internalbetween)) - } + internalbetween = newinternalbetween; + internalout = newinternalout } let lucf (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode = let previnternalvar = Cfg.NodeMap.find node t.internalvar in + if Option.equal (=) (Some node) t.t.initial then + (* if L is initial set dvin to the "in" register *) + let newinternalin = ( + match t.t.inputOutputVar with + Some (i, _) -> [i] + | None -> [] + ) in + + let newinternalbetween = ( (* set the dvin of each to the previous dvout *) + match previnternalvar.internalbetween with + [] -> [] + | [(_i, o)] -> [(newinternalin, o)] + | (_i, o) :: btwrest -> + (newinternalin, o) :: ( + List.map (fun ((_i, o), (_previ, prevo)) -> (prevo, o)) + (Utility.combine_twice btwrest previnternalvar.internalbetween) + ) + ) in { previnternalvar with - internalin = - match t.t.inputOutputVar with - Some (i, _) -> [i] - | None -> [] - } + internalin = newinternalin; + internalbetween = newinternalbetween } else + (* if L is not initial set dvin to the intersection of the previous node's + dvouts *) let prevnodes = Cfg.NodeMap.find node t.t.reverseEdges in + let newinternalin = ( + match prevnodes with + | [] -> + [] + | [prevnode] -> + (Cfg.NodeMap.find prevnode t.internalvar).internalout + | [prevnode1; prevnode2] -> + Utility.unique_intersection + (Cfg.NodeMap.find prevnode1 t.internalvar).internalout + (Cfg.NodeMap.find prevnode2 t.internalvar).internalout + | prevnode :: restnodes -> + List.fold_left (* intersection of all previous nodes' dvout *) + (fun acc prevnode -> + Utility.unique_intersection + acc + (Cfg.NodeMap.find prevnode t.internalvar).internalout) + (Cfg.NodeMap.find prevnode t.internalvar).internalout + restnodes + ) in + + let newinternalbetween = + match previnternalvar.internalbetween with + [] -> [] + | [(_i, o)] -> [(newinternalin, o)] + | (_i, o) :: btwrest -> + (newinternalin, o) :: ( + List.map (fun ((_i, o), (_previ, prevo)) -> (prevo, o)) + (Utility.combine_twice btwrest previnternalvar.internalbetween) + ) + in { previnternalvar with - internalin = - match prevnodes with - [] -> [] - | [prevnode] -> (Cfg.NodeMap.find prevnode t.internalvar).internalout - | [prevnode1; prevnode2] -> - Utility.unique_intersection - (Cfg.NodeMap.find prevnode1 t.internalvar).internalout - (Cfg.NodeMap.find prevnode2 t.internalvar).internalout - | _ -> - List.fold_left (* intersection of all previous nodes' dvout *) - (fun acc prevnode -> - Utility.unique_intersection acc (Cfg.NodeMap.find prevnode t.internalvar).internalout) - [] - prevnodes - } + internalin = newinternalin; + internalbetween = newinternalbetween } let update (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode = @@ -198,10 +192,16 @@ let update (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode = let compute_defined_variables (cfg: RISCCfg.t) : DVCfg.t = let all_variables = List.fold_left - (fun acc (_, code) -> Utility.unique_union acc (variables_all code)) + (fun acc (_, code) -> + Utility.unique_union acc (variables_all code)) [] (Cfg.NodeMap.to_list cfg.content) in + let all_variables = + match cfg.inputOutputVar with + | None -> all_variables + | Some (i, o) -> Utility.unique_union all_variables [i;o] + in DVCfg.from_cfg cfg |> DVCfg.fixed_point ~init:(init_top all_variables) ~update:update diff --git a/lib/miniImp/definedVariables.mli b/lib/miniImp/definedVariables.mli index cc8e4ea..be2577d 100644 --- a/lib/miniImp/definedVariables.mli +++ b/lib/miniImp/definedVariables.mli @@ -3,6 +3,7 @@ open Analysis module Variable : sig type t val pp : out_channel -> t -> unit + val pplist : out_channel -> t list -> unit end module RISCCfg = CfgRISC.RISCCfg diff --git a/lib/miniImp/dune b/lib/miniImp/dune index b3f830a..f3e43a6 100644 --- a/lib/miniImp/dune +++ b/lib/miniImp/dune @@ -13,6 +13,7 @@ (modules Lexer Parser Types Semantics CfgImp ReplacePowerMod CfgRISC DefinedVariables LiveVariables + ReduceRegisters RISC RISCSemantics) (libraries analysis utility menhirLib)) diff --git a/lib/miniImp/liveVariables.ml b/lib/miniImp/liveVariables.ml index cc2b385..a721d85 100644 --- a/lib/miniImp/liveVariables.ml +++ b/lib/miniImp/liveVariables.ml @@ -24,45 +24,33 @@ let variables_used (instr : DVCfg.elt) : DVCfg.internal list = | Nop | LoadI (_, _) -> acc - | BRegOp (_, r1, r2, _) -> + | BRegOp (_, r1, r2, _) + | Store (r1, r2) -> DVCeltSet.add r1.index acc |> DVCeltSet.add r2.index | BImmOp (_, r1, _, _) | URegOp (_, r1, _) - | Load (r1, _) - | Store (r1, _) -> + | Load (r1, _) -> DVCeltSet.add r1.index acc in helper DVCeltSet.empty instr |> DVCeltSet.to_list -let _variables_used_all (instructions : DVCfg.elt list) : DVCfg.internal list = - List.fold_left (fun (acc: DVCeltSet.t) (instr: DVCfg.elt) -> - DVCeltSet.union acc (variables_used instr |> DVCeltSet.of_list) - ) DVCeltSet.empty instructions |> DVCeltSet.to_list - - let variables_defined (instructions : DVCfg.elt) : DVCfg.internal list = let helper (acc: DVCeltSet.t) (instr: DVCfg.elt) = match instr with - | Nop -> acc + | Nop + | Store (_, _) -> acc | BRegOp (_, _, _, r3) | BImmOp (_, _, _, r3) | URegOp (_, _, r3) | Load (_, r3) - | LoadI (_, r3) - | Store (_, r3) -> + | LoadI (_, r3) -> DVCeltSet.add r3.index acc in helper DVCeltSet.empty instructions |> DVCeltSet.to_list -let _variables_defined_all (instructions : DVCfg.elt list) : DVCfg.internal list = - List.fold_left (fun (acc: DVCeltSet.t) (instr: DVCfg.elt) -> - DVCeltSet.union acc (variables_defined instr |> DVCeltSet.of_list) - ) DVCeltSet.empty instructions |> DVCeltSet.to_list - - (* init function, assign the bottom to everything *) let init : (DVCfg.elt list -> DVCfg.internalnode) = (fun l -> {internalin = []; @@ -75,58 +63,68 @@ let lub (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode = None -> [] | Some c -> c in + + let newinternalbetween = ( + List.map + (fun (code, (_i, o)) -> + (Utility.unique_union + (variables_used code) + (Utility.subtraction o (variables_defined code)), o)) + (Utility.combine_twice code previnternalvar.internalbetween) + ) in + + let newinternalin = + match newinternalbetween with + | [] -> previnternalvar.internalout + | (i, _)::_ -> i + in + { previnternalvar with - internalbetween = - List.map (fun (prevbtw, code, nextprevbtw) -> - let newin = Utility.unique_union (variables_used code) - (Utility.subtraction (snd prevbtw) (variables_defined code)) - in - match nextprevbtw with - None -> (newin, snd prevbtw) - | Some (newout, _) -> (newin, newout) - ) - (Utility.combine_thrice previnternalvar.internalbetween code - (Utility.pad (List.tl previnternalvar.internalbetween) None (List.length previnternalvar.internalbetween))) - ; - internalin = fst (List.hd previnternalvar.internalbetween); - } + internalbetween = newinternalbetween; + internalin = newinternalin; } let lucf (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode = let previnternalvar = Cfg.NodeMap.find node t.internalvar in - if Option.equal (=) (Some node) t.t.terminal then - let outputvarlist = match t.t.inputOutputVar with + + let newinternalout = ( + if Option.equal (=) (Some node) t.t.terminal then ( + match t.t.inputOutputVar with Some (_, o) -> [o] | None -> [] - in - { previnternalvar with - internalout = outputvarlist; - internalbetween = ( - let last_elem = Utility.last_list previnternalvar.internalbetween in - (Utility.drop_last_element_list previnternalvar.internalbetween) @ - [(fst last_elem, outputvarlist)] - ) - } - else - let nextnodes = Cfg.NodeMap.find_opt node t.t.edges in - let newinternalout = match nextnodes with - None -> [] - | Some (node, None) -> (Cfg.NodeMap.find node t.internalvar).internalin + ) else ( + let nextnodes = Cfg.NodeMap.find_opt node t.t.edges in + match nextnodes with + | None -> [] + | Some (node, None) -> + (Cfg.NodeMap.find node t.internalvar).internalin | Some (node1, Some node2) -> Utility.unique_union (Cfg.NodeMap.find node1 t.internalvar).internalin (Cfg.NodeMap.find node2 t.internalvar).internalin - in - { previnternalvar with - internalout = newinternalout; - internalbetween = ( - let last_elem = Utility.last_list previnternalvar.internalbetween in - (Utility.drop_last_element_list previnternalvar.internalbetween) @ - [(fst last_elem, newinternalout)] - ) - } + ) + ) in + + let newinternalbetween = ( + match List.rev previnternalvar.internalbetween with + | [] -> [] + | (i, _o) :: btwrest -> + let btwrest = List.rev btwrest in + let newbtwrest = List.map2 + (fun (i, _o) (nexti, _nexto) -> (i, nexti)) + btwrest + (Utility.drop_first_element_list previnternalvar.internalbetween) + in + newbtwrest @ [(i, newinternalout)] + ) in + + { previnternalvar with + internalout = newinternalout; + internalbetween = newinternalbetween; } 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 @@ -135,10 +133,136 @@ let compute_live_variables (cfg: RISCCfg.t) : DVCfg.t = |> DVCfg.fixed_point ~init:init ~update:update + +module VariableMap = struct + include Map.Make(Variable) + + let first_empty next start m l = + let bindings = + List.fold_left ( + fun acc x -> + match find_opt x m with + | None -> acc + | Some x -> x :: acc) [] l |> List.sort Variable.compare in + + let rec aux x = + if List.mem x bindings + then aux (next x) + else x + in + aux start + + let first_empty_Variable m l = + let next = fun x -> x |> int_of_string |> (+) 1 |> string_of_int in + let start = "1" in + first_empty next start m l + + let get_mapping m l r = + match find_opt r m with + | None -> ( + let newr = first_empty_Variable m l in + let newm = add r newr m in + (newm, newr) + ) + | Some r -> (m, r) +end + + (* just rename the registers that dont share live status *) let optimize_cfg (t: DVCfg.t) : DVCfg.t = - t + let replace_code ((vin, vout): Variable.t list * Variable.t list) + (a: Variable.t VariableMap.t) + (code: DVCfg.elt) + : (Variable.t VariableMap.t * DVCfg.elt) = + match code with + | Nop -> ( + (a, Nop) + ) + | BRegOp (brop, r1, r2, r3) -> ( + let (newa, newr1) = VariableMap.get_mapping a vin r1.index in + let (newa, newr2) = VariableMap.get_mapping newa vin r2.index in + let (newa, newr3) = VariableMap.get_mapping newa vout r3.index in + (newa, BRegOp (brop, {index = newr1}, {index = newr2}, {index = newr3})) + ) + | BImmOp (biop, r1, i, r3) -> ( + let (newa, newr1) = VariableMap.get_mapping a vin r1.index in + let (newa, newr3) = VariableMap.get_mapping newa vout r3.index in + (newa, BImmOp (biop, {index = newr1}, i, {index = newr3})) + ) + | URegOp (urop, r1, r3) -> ( + let (newa, newr1) = VariableMap.get_mapping a vin r1.index in + let (newa, newr3) = VariableMap.get_mapping newa vout r3.index in + (newa, URegOp (urop, {index = newr1}, {index = newr3})) + ) + | Load (r1, r3) -> ( + let (newa, newr1) = VariableMap.get_mapping a vin r1.index in + let (newa, newr3) = VariableMap.get_mapping newa vout r3.index in + (newa, Load ({index = newr1}, {index = newr3})) + ) + | LoadI (i, r3) -> ( + let (newa, newr3) = VariableMap.get_mapping a vout r3.index in + (newa, LoadI (i, {index = newr3})) + ) + | Store (r1, r3) -> ( + let (newa, newr1) = VariableMap.get_mapping a vin r1.index in + let (newa, newr3) = VariableMap.get_mapping newa vout r3.index in + (newa, Store ({index = newr1}, {index = newr3})) + ) + in + let aux (assignments: Variable.t VariableMap.t) (t: DVCfg.t) (node: Cfg.Node.t) + : (Variable.t VariableMap.t * DVCfg.t) = + let livevars = Cfg.NodeMap.find node t.internalvar in + let code = + match Cfg.NodeMap.find_opt node t.t.content with + | None -> [] + | Some x -> x + in + let newcode, newassignments = + (List.fold_left2 + (fun (acc, assignments) btw code -> + let na, nc = replace_code btw assignments code in + (acc @ [nc], na) + ) + ([], assignments) + livevars.internalbetween + code) + in + let newcontent = Cfg.NodeMap.add + node + newcode + t.t.content + in + + let newt = { t with t = { t.t with content = newcontent } } in + (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) + t.t.nodes + (assignments, t) + in + + { newt with + t = { newt.t with + inputOutputVar = + match newt.t.inputOutputVar with + None -> None + | Some (i, o) -> ( + match VariableMap.find_opt i a, VariableMap.find_opt o a with + | None, None -> Some (i, o) + | Some i, None -> Some (i, o) + | None, Some o -> Some (i, o) + | Some i, Some o -> Some (i, o) + ) + }} let compute_cfg (dvcfg: DVCfg.t) : RISCCfg.t = diff --git a/lib/miniImp/reduceRegisters.ml b/lib/miniImp/reduceRegisters.ml new file mode 100644 index 0000000..ef9cf4b --- /dev/null +++ b/lib/miniImp/reduceRegisters.ml @@ -0,0 +1,416 @@ +open Analysis + +module Variable = struct + type t = string + + let _pp (ppf: out_channel) (v: t) : unit = + Printf.fprintf ppf "%s" v + + let _pplist (ppf: out_channel) (vv: t list) : unit = + List.iter (Printf.fprintf ppf "%s, ") vv + + let compare a b = + String.compare a b +end + + +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 helper (acc: int VariableMap.t) (instr: RISCCfg.elt) = + match instr with + | Nop -> + acc + | BRegOp (_, r1, r2, r3) -> + VariableMap.update r1.index add_one acc |> + VariableMap.update r2.index add_one |> + VariableMap.update r3.index add_one + | BImmOp (_, r1, _, r3) + | URegOp (_, r1, r3) + | Load (r1, r3) + | Store (r1, r3) -> + VariableMap.update r1.index add_one acc |> + VariableMap.update r3.index add_one + | LoadI (_, r3) -> + VariableMap.update r3.index add_one acc + in + + helper VariableMap.empty instr |> VariableMap.to_list + +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 (fun _v x y -> Some (x + y)) acc (variables_frequency instr |> VariableMap.of_list) + ) VariableMap.empty instructions |> VariableMap.to_list + + +let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t = + (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 acc (variables_all_frequency code)) + [] + (Cfg.NodeMap.to_list cfg.content) + in + let all_variables = + match cfg.inputOutputVar with + | None -> all_variables + | Some (i, _o) -> ( + match List.assoc_opt i all_variables with + | None -> (i, 1) :: all_variables + | Some f -> (i, f+1) :: (List.remove_assoc i all_variables) + ) + in + let all_variables = + match cfg.inputOutputVar with + | None -> all_variables + | Some (_i, o) -> ( + match List.assoc_opt o all_variables with + | None -> (o, 1) :: all_variables + | Some f -> (o, f+1) :: (List.remove_assoc o all_variables) + ) + in + + let replaceregisters + (remappedregisters: Variable.t VariableMap.t) + (memorymap: int VariableMap.t) + (temporaryregisters: Variable.t list) + (code: RISCCfg.elt list) + : RISCCfg.elt list = + + let tmpreg1: CfgRISC.RISCSimpleStatements.register = + {index = List.nth temporaryregisters 0} in + let tmpreg2: CfgRISC.RISCSimpleStatements.register = + {index = List.nth temporaryregisters 1} in + + let aux (instruction: RISCCfg.elt) : RISCCfg.elt list = + match instruction with + | Nop -> [Nop] + | BRegOp (brop, r1, r2, r3) -> ( + match ( VariableMap.find_opt r1.index remappedregisters, + VariableMap.find_opt r2.index remappedregisters, + VariableMap.find_opt r3.index remappedregisters, + VariableMap.find_opt r1.index memorymap, + VariableMap.find_opt r1.index memorymap, + VariableMap.find_opt r3.index memorymap ) + with + | Some r1, Some r2, Some r3, _, _, _ -> + [BRegOp (brop, {index = r1}, {index = r2}, {index = r3})] + | Some r1, Some r2, None, _, _, Some m3 -> + [BRegOp (brop, {index = r1}, {index = r2}, tmpreg2); + LoadI (m3, tmpreg1); + Store (tmpreg2, tmpreg1)] + | Some r1, None, Some r3, _, Some m2, _ -> + [LoadI (m2, tmpreg2); + Load (tmpreg2, tmpreg2); + BRegOp (brop, {index = r1}, tmpreg2, {index = r3})] + | None, Some r2, Some r3, Some m1, _, _ -> + [LoadI (m1, tmpreg1); + Load (tmpreg1, tmpreg1); + BRegOp (brop, tmpreg1, {index = r2}, {index = r3})] + | None, None, Some r3, Some m1, Some m2, _ -> + [LoadI (m1, tmpreg1); + Load (tmpreg1, tmpreg1); + LoadI (m2, tmpreg2); + Load (tmpreg2, tmpreg2); + BRegOp (brop, tmpreg1, tmpreg2, {index = r3})] + | None, None, None, Some m1, Some m2, Some m3 -> + [LoadI (m1, tmpreg1); + Load (tmpreg1, tmpreg1); + LoadI (m2, tmpreg2); + Load (tmpreg2, tmpreg2); + BRegOp (brop, tmpreg1, tmpreg2, tmpreg2); + LoadI (m3, tmpreg1); + Store (tmpreg2, tmpreg1)] + | _ -> [BRegOp (brop, {index = r1.index}, {index = r2.index}, {index = r3.index})] + ) + | BImmOp (biop, r1, i, r3) -> ( + match ( VariableMap.find_opt r1.index remappedregisters, + VariableMap.find_opt r3.index remappedregisters, + VariableMap.find_opt r1.index memorymap, + VariableMap.find_opt r3.index memorymap ) + with + | Some r1, Some r3, _, _ -> + [BImmOp (biop, {index = r1}, i, {index = r3})] + | Some r1, None, _, Some m3 -> + [BImmOp (biop, {index = r1}, i, tmpreg2); + LoadI (m3, tmpreg1); + Store (tmpreg2, tmpreg1)] + | None, Some r3, Some m1, _ -> + [LoadI (m1, tmpreg1); + Load (tmpreg1, tmpreg1); + BImmOp (biop, tmpreg1, i, {index = r3})] + | None, None, Some m1, Some m3 -> + [LoadI (m1, tmpreg1); + Load (tmpreg1, tmpreg1); + BImmOp (biop, tmpreg1, i, tmpreg2); + LoadI (m3, tmpreg1); + Store (tmpreg2, tmpreg1)] + | _ -> failwith ("ReduceRegisters: fail to partition a set, some" ^ + " registers have no binding.") + ) + | URegOp (urop, r1, r3) ->( + match ( VariableMap.find_opt r1.index remappedregisters, + VariableMap.find_opt r3.index remappedregisters, + VariableMap.find_opt r1.index memorymap, + VariableMap.find_opt r3.index memorymap ) + with + | Some r1, Some r3, _, _ -> + [URegOp (urop, {index = r1}, {index = r3})] + | Some r1, None, _, Some m3 -> + [URegOp (urop, {index = r1}, tmpreg2); + LoadI (m3, tmpreg1); + Store (tmpreg2, tmpreg1)] + | None, Some r3, Some m1, _ -> + [LoadI (m1, tmpreg1); + Load (tmpreg1, tmpreg1); + URegOp (urop, tmpreg1, {index = r3})] + | None, None, Some m1, Some m3 -> + [LoadI (m1, tmpreg1); + Load (tmpreg1, tmpreg1); + URegOp (urop, tmpreg1, tmpreg2); + LoadI (m3, tmpreg1); + Store (tmpreg2, tmpreg1)] + | _ -> failwith ("ReduceRegisters: fail to partition a set, some" ^ + " registers have no binding.") + ) + | Load (r1, r3) -> ( + match ( VariableMap.find_opt r1.index remappedregisters, + VariableMap.find_opt r3.index remappedregisters, + VariableMap.find_opt r1.index memorymap, + VariableMap.find_opt r3.index memorymap ) + with + | Some r1, Some r3, _, _ -> + [Load ({index = r1}, {index = r3})] + | Some r1, None, _, Some m3 -> + [Load ({index = r1}, tmpreg2); + LoadI (m3, tmpreg1); + Store (tmpreg2, tmpreg1)] + | None, Some r3, Some m1, _ -> + [LoadI (m1, tmpreg1); + Load (tmpreg1, tmpreg1); + Load (tmpreg1, {index = r3})] + | None, None, Some m1, Some m3 -> + [LoadI (m1, tmpreg1); + Load (tmpreg1, tmpreg1); + Load (tmpreg1, tmpreg2); + LoadI (m3, tmpreg1); + Store (tmpreg2, tmpreg1)] + | _ -> failwith ("ReduceRegisters: fail to partition a set, some" ^ + " registers have no binding.") + ) + | LoadI (i, r3) -> ( + (* we want to store an integer in memory immediately (strange, but + unless better heuristic to choose the variables to replace we are + stuck) *) + match ( VariableMap.find_opt r3.index remappedregisters, + VariableMap.find_opt r3.index memorymap ) + with + | Some r3, _ -> + [LoadI (i, {index = r3})] + | None, Some m3 -> + [LoadI (i, tmpreg2); + LoadI (m3, tmpreg1); + Store (tmpreg2, tmpreg1)] + | _ -> failwith ("ReduceRegisters: fail to partition a set, some" ^ + " registers have no binding.") + ) + | Store (r1, r3) -> ( + (* we want to maybe store an address in memory (very confusing, don't + think can happen) *) + match ( VariableMap.find_opt r1.index remappedregisters, + VariableMap.find_opt r3.index remappedregisters, + VariableMap.find_opt r1.index memorymap, + VariableMap.find_opt r3.index memorymap ) + with + | Some r1, Some r3, _, _ -> + [Store ({index = r1}, {index = r3})] + | Some r1, None, _, Some m3 -> + [Store ({index = r1}, tmpreg2); + LoadI (m3, tmpreg1); + Store (tmpreg2, tmpreg1)] + | None, Some r3, Some m1, _ -> + [LoadI (m1, tmpreg1); + Load (tmpreg1, tmpreg1); + Store (tmpreg1, {index = r3})] + | None, None, Some m1, Some m3 -> + [LoadI (m1, tmpreg1); + Load (tmpreg1, tmpreg1); + Store (tmpreg1, tmpreg2); + LoadI (m3, tmpreg1); + Store (tmpreg2, tmpreg1)] + | _ -> failwith ("ReduceRegisters: fail to partition a set, some" ^ + " registers have no binding.") + ) + in + + List.map (fun x -> + Printf.printf "Converting: %a\n" CfgRISC.RISCSimpleStatements.pp x; + let tmp = aux x in + Printf.printf "Into: %a\n\n" CfgRISC.RISCSimpleStatements.pplist tmp; + tmp + ) code |> List.concat + in + + + let aux (cfg: RISCCfg.t) all_variables = + (* we keep the first two variables free for immediate use *) + let most_frequent, least_frequent = + List.sort (fun (_a, fa) (_b, fb) -> Int.compare fb fa) all_variables + |> Utility.take (n-2) + in + let most_frequent = fst (List.split most_frequent) in + let least_frequent = fst (List.split least_frequent) in + + (* we map the most frequent to new registers, so that the first two are + always free *) + let most_frequent_mapping = (* +3 because starts at 0, but we want to start + at 1*) + List.mapi (fun n v -> (v, (string_of_int (n+3): Variable.t))) most_frequent + |> VariableMap.of_list + in + (* we map the least to memory *) + let least_frequent_mapping = + List.mapi (fun n v -> (v, (n: int))) least_frequent + |> VariableMap.of_list + in + + Printf.printf "Most freq mapping:\n"; + List.iter (fun (a, b) -> Printf.printf "%s -> %s\n" a b) (VariableMap.to_list most_frequent_mapping); + Printf.printf "Least freq mapping:\n"; + List.iter (fun (a, b) -> Printf.printf "%s -> mem %d\n" a b) (VariableMap.to_list least_frequent_mapping); + + (* we need to replace both at the same time, because we might have mapped + some registers to already used registers, so a double pass might not + differentiate the two *) + (* special care must be taken for the in and out registers *) + let newcfg = { + cfg with + content = Cfg.NodeMap.map + (fun x -> replaceregisters most_frequent_mapping least_frequent_mapping ["1"; "2"] x) + cfg.content} + in + + match newcfg.inputOutputVar with + | None -> newcfg (* if no input or output variables we ignore *) + | Some (i, o) -> ( + match (VariableMap.find_opt i most_frequent_mapping, + VariableMap.find_opt o most_frequent_mapping, + VariableMap.find_opt i least_frequent_mapping, + VariableMap.find_opt o least_frequent_mapping ) + with (*we check if in and out are simply remapped or are put in memory*) + | Some i, Some o, _, _ -> + { newcfg with inputOutputVar = Some (i, o) } + | Some i, None, _, Some mo -> ( (* since the output simbol is in memory + we need to first retrive it and then + put the result in a temporary + register *) + match newcfg.terminal with (* we check for the terminal node, if not + present we are very confused and dont + modify the out variable *) + | None -> { newcfg with inputOutputVar = Some (i, o)} + | Some n -> ( + let terminalcontent = ( + match Cfg.NodeMap.find_opt n newcfg.content with + | None -> [] + | Some x -> x + ) @ [LoadI (mo, {index = "2"}); + Load ({index = "2"}, {index = "2"})] + in + let content = Cfg.NodeMap.add n terminalcontent newcfg.content in + { newcfg with + inputOutputVar = Some (i, "2"); + content = content + } + ) + ) + | None, Some o, Some mi, _ -> ( (* the input simbol should be stored in + memory *) + match newcfg.initial with + | None -> { newcfg with inputOutputVar = Some (i, o) } + | Some n -> ( + let initialcontent = + [(LoadI (mi, {index = "2"}) : RISCCfg.elt); + Store ({index = "1"}, {index = "2"})] @ ( + match Cfg.NodeMap.find_opt n newcfg.content with + | None -> [] + | Some x -> x + ) + in + let content = Cfg.NodeMap.add n initialcontent newcfg.content in + { newcfg with + inputOutputVar = Some ("1", o); + content = content + } + ) + ) + | None, None, Some mi, Some mo -> ( (* both simbols should be in + memory *) + match newcfg.initial, newcfg.terminal with + | None, None -> { newcfg with inputOutputVar = Some (i, o) } + | None, Some n -> ( + let terminalcontent = ( + match Cfg.NodeMap.find_opt n newcfg.content with + | None -> [] + | Some x -> x + ) @ [LoadI (mo, {index = "2"}); + Load ({index = "2"}, {index = "2"})] + in + let content = Cfg.NodeMap.add n terminalcontent newcfg.content in + { newcfg with + inputOutputVar = Some (i, "2"); + content = content + } + ) + | Some n, None -> ( + let initialcontent = + [(LoadI (mi, {index = "2"}) : RISCCfg.elt); + Store ({index = "1"}, {index = "2"})] @ ( + match Cfg.NodeMap.find_opt n newcfg.content with + | None -> [] + | Some x -> x + ) + in + let content = Cfg.NodeMap.add n initialcontent newcfg.content in + { newcfg with + inputOutputVar = Some ("1", o); + content = content + } + ) + | Some ni, Some no -> ( + let initialcontent = + [(LoadI (mi, {index = "2"}) : RISCCfg.elt); + Store ({index = "1"}, {index = "2"})] @ ( + match Cfg.NodeMap.find_opt ni newcfg.content with + | None -> [] + | Some x -> x + ) + in + let terminalcontent = ( + match Cfg.NodeMap.find_opt no newcfg.content with + | None -> [] + | Some x -> x + ) @ [LoadI (mo, {index = "2"}); + Load ({index = "2"}, {index = "2"})] + in + let content = Cfg.NodeMap.add ni initialcontent newcfg.content in + let content = Cfg.NodeMap.add no terminalcontent content in + { newcfg with + inputOutputVar = Some ("1", "2"); + content = content + } + ) + ) + | _ -> failwith ("ReduceRegisters: fail to partition a set, some" ^ + " registers have no binding.") + ) + in + + + ( if List.length all_variables < n + then cfg + else aux cfg all_variables ) diff --git a/lib/miniImp/reduceRegisters.mli b/lib/miniImp/reduceRegisters.mli new file mode 100644 index 0000000..5e04d8d --- /dev/null +++ b/lib/miniImp/reduceRegisters.mli @@ -0,0 +1,3 @@ +module RISCCfg = CfgRISC.RISCCfg + +val reduceregisters : int -> RISCCfg.t -> RISCCfg.t diff --git a/lib/utility/utility.ml b/lib/utility/utility.ml index 52cad39..f4d3489 100644 --- a/lib/utility/utility.ml +++ b/lib/utility/utility.ml @@ -52,6 +52,7 @@ let rec fromIntToString (alphabet: string) (x: int) : string = |> String.make 1) +(* true if every element of la is in lb *) let inclusion la lb = let rec aux la = function @@ -63,6 +64,11 @@ let inclusion la lb = in aux lb la +(* true if lb includes la and la includes lb *) +let equality la lb = + inclusion la lb && inclusion lb la + +(* computes the result of la \setminus lb *) let subtraction la lb = let rec aux la = function @@ -89,23 +95,40 @@ let unique l = let unique_union la lb = unique (la @ lb) +(* returns all elements both in la and in lb *) let unique_intersection la lb = - let rec aux la lb acc = + let rec aux la acc = match la with [] -> acc | a::la -> if List.mem a lb - then aux la lb (a::acc) - else aux la lb acc + then aux la (a::acc) + else aux la acc in - aux la lb [] |> unique + aux la [] |> unique +(* returns a list with at most n items and the rest in the second *) +let rec take (n: int) (l: 'a list) : ('a list * 'a list) = + match n with + | 0 -> ([], l) + | n -> + match l with + | [] -> ([], []) + | i::ls -> + let (t1, t2) = (take (n - 1) ls) in + ((i :: t1), (t2)) +(* returns the list without the last element *) let drop_last_element_list = function | [] -> [] | l -> l |> List.rev |> List.tl |> List.rev +let drop_first_element_list = + function + | [] -> [] + | _::l -> l + (* Complicated way to drop the last element and add a new option element to the beginning *) let prev l a = @@ -152,6 +175,13 @@ let add_to_last_list (la: 'a list list) (a: 'a) : 'a list list = in aux la a +let rec combine_twice la lb = + match (la, lb) with + | [], [] -> [] + | [a], [b] -> [a, b] + | a::la, b::lb -> (a, b) :: (combine_twice la lb) + | _ -> [] + let rec combine_thrice la lb lc = match (la, lb, lc) with | [], [], [] -> [] diff --git a/lib/utility/utility.mli b/lib/utility/utility.mli index 9d77eee..76e7593 100644 --- a/lib/utility/utility.mli +++ b/lib/utility/utility.mli @@ -13,13 +13,17 @@ val int_not : int -> int val fromIntToString : string -> int -> string val inclusion : 'a list -> 'a list -> bool +val equality : 'a list -> 'a list -> bool val subtraction : 'a list -> 'a list -> 'a list val unique : 'a list -> 'a list val unique_union : 'a list -> 'a list -> 'a list val unique_intersection : 'a list -> 'a list -> 'a list -val drop_last_element_list : 'a list -> 'a list +val take : int -> 'a list -> ('a list * 'a list) + +val drop_last_element_list : 'a list -> 'a list +val drop_first_element_list : 'a list -> 'a list val prev : 'a list -> 'a option -> 'a option list val pad : 'a list -> 'a option -> int -> 'a option list @@ -29,4 +33,5 @@ val combine : 'a list -> 'b option list -> ('a * 'b) option list val last_list : 'a list -> 'a val add_to_last_list : 'a list list -> 'a -> 'a list list +val combine_twice : 'a list -> 'b list -> ('a * 'b) list val combine_thrice : 'a list -> 'b list -> 'c list -> ('a * 'b * 'c) list