Style more consistent, replace capitalization with camel case
This commit is contained in:
@ -5,7 +5,7 @@ module Variable = struct
|
||||
let pp (ppf: out_channel) (v: t) : unit =
|
||||
Printf.fprintf ppf "%s" v
|
||||
|
||||
let pplist (ppf: out_channel) (vv: t list) : unit =
|
||||
let pp_list (ppf: out_channel) (vv: t list) : unit =
|
||||
List.iter (Printf.fprintf ppf "%s, ") vv
|
||||
|
||||
let compare a b =
|
||||
@ -21,7 +21,7 @@ module DVCeltSet = Set.Make(Variable)
|
||||
let variables_used (instr : DVCfg.elt)
|
||||
: DVCfg.internal list =
|
||||
|
||||
let helper (acc: DVCeltSet.t) (instr: DVCfg.elt) =
|
||||
let aux (acc: DVCeltSet.t) (instr: DVCfg.elt) =
|
||||
match instr with
|
||||
| Nop
|
||||
| LoadI (_, _) ->
|
||||
@ -36,10 +36,10 @@ let variables_used (instr : DVCfg.elt)
|
||||
DVCeltSet.add r1.index acc
|
||||
in
|
||||
|
||||
helper DVCeltSet.empty instr |> DVCeltSet.to_list
|
||||
aux DVCeltSet.empty instr |> DVCeltSet.to_list
|
||||
|
||||
let variables_defined (instructions : DVCfg.elt) : DVCfg.internal list =
|
||||
let helper (acc: DVCeltSet.t) (instr: DVCfg.elt) =
|
||||
let aux (acc: DVCeltSet.t) (instr: DVCfg.elt) =
|
||||
match instr with
|
||||
| Nop
|
||||
| Store (_, _) -> acc
|
||||
@ -51,10 +51,10 @@ let variables_defined (instructions : DVCfg.elt) : DVCfg.internal list =
|
||||
DVCeltSet.add r3.index acc
|
||||
in
|
||||
|
||||
helper DVCeltSet.empty instructions |> DVCeltSet.to_list
|
||||
aux DVCeltSet.empty instructions |> DVCeltSet.to_list
|
||||
|
||||
let variables (instruction : DVCfg.elt) : DVCfg.internal list =
|
||||
let helper (acc: DVCeltSet.t) (instr: DVCfg.elt) =
|
||||
let aux (acc: DVCeltSet.t) (instr: DVCfg.elt) =
|
||||
match instr with
|
||||
| Nop -> acc
|
||||
| Store (r1, r2) ->
|
||||
@ -73,7 +73,7 @@ let variables (instruction : DVCfg.elt) : DVCfg.internal list =
|
||||
DVCeltSet.add r3.index acc
|
||||
in
|
||||
|
||||
helper DVCeltSet.empty instruction |> DVCeltSet.to_list
|
||||
aux DVCeltSet.empty instruction |> DVCeltSet.to_list
|
||||
|
||||
let variables_all (instructions : DVCfg.elt list) : DVCfg.internal list =
|
||||
List.fold_left (fun (acc: DVCeltSet.t) (instr: DVCfg.elt) ->
|
||||
@ -81,43 +81,44 @@ let variables_all (instructions : DVCfg.elt list) : DVCfg.internal list =
|
||||
) DVCeltSet.empty instructions |> DVCeltSet.to_list
|
||||
|
||||
(* init function, assign the bottom to everything *)
|
||||
let init : (DVCfg.elt list -> DVCfg.internalnode) =
|
||||
(fun l -> {internalin = [];
|
||||
internalout = [];
|
||||
internalbetween = (List.init (List.length l) (fun _ -> ([], [])))})
|
||||
let init : (DVCfg.elt list -> DVCfg.internal_node) =
|
||||
(fun l -> {internal_in = [];
|
||||
internal_out = [];
|
||||
internal_between = (List.init (List.length l) (fun _ -> ([], [])))}
|
||||
)
|
||||
|
||||
let lub (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode =
|
||||
let previnternalvar = Cfg.NodeMap.find node t.internalvar in
|
||||
let lub (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internal_node =
|
||||
let prev_internal_var = Cfg.NodeMap.find node t.internal_var in
|
||||
let code = match Cfg.NodeMap.find_opt node t.t.content with
|
||||
None -> []
|
||||
| Some c -> c
|
||||
in
|
||||
|
||||
let newinternalbetween = (
|
||||
let new_internal_between = (
|
||||
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)
|
||||
(Utility.combine_twice code prev_internal_var.internal_between)
|
||||
) in
|
||||
|
||||
let newinternalin =
|
||||
match newinternalbetween with
|
||||
| [] -> previnternalvar.internalout
|
||||
let new_internal_in =
|
||||
match new_internal_between with
|
||||
| [] -> prev_internal_var.internal_out
|
||||
| (i, _)::_ -> i
|
||||
in
|
||||
|
||||
{ previnternalvar with
|
||||
internalbetween = newinternalbetween;
|
||||
internalin = newinternalin; }
|
||||
{ prev_internal_var with
|
||||
internal_between = new_internal_between;
|
||||
internal_in = new_internal_in; }
|
||||
|
||||
let lucf (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode =
|
||||
let previnternalvar = Cfg.NodeMap.find node t.internalvar in
|
||||
let lucf (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internal_node =
|
||||
let prev_internal_var = Cfg.NodeMap.find node t.internal_var in
|
||||
|
||||
let newinternalout = (
|
||||
if Option.equal (=) (Some node) t.t.terminal then (
|
||||
match t.t.inputOutputVar with
|
||||
match t.t.input_output_var with
|
||||
Some (_, o) -> [o]
|
||||
| None -> []
|
||||
) else (
|
||||
@ -125,35 +126,35 @@ let lucf (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode =
|
||||
match nextnodes with
|
||||
| None -> []
|
||||
| Some (node, None) ->
|
||||
(Cfg.NodeMap.find node t.internalvar).internalin
|
||||
(Cfg.NodeMap.find node t.internal_var).internal_in
|
||||
| Some (node1, Some node2) ->
|
||||
Utility.unique_union
|
||||
(Cfg.NodeMap.find node1 t.internalvar).internalin
|
||||
(Cfg.NodeMap.find node2 t.internalvar).internalin
|
||||
(Cfg.NodeMap.find node1 t.internal_var).internal_in
|
||||
(Cfg.NodeMap.find node2 t.internal_var).internal_in
|
||||
)
|
||||
) in
|
||||
|
||||
let newinternalbetween = (
|
||||
match List.rev previnternalvar.internalbetween with
|
||||
let new_internal_between = (
|
||||
match List.rev prev_internal_var.internal_between 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)
|
||||
(Utility.drop_first_element_list prev_internal_var.internal_between)
|
||||
in
|
||||
newbtwrest @ [(i, newinternalout)]
|
||||
) in
|
||||
|
||||
{ previnternalvar with
|
||||
internalout = newinternalout;
|
||||
internalbetween = newinternalbetween; }
|
||||
{ prev_internal_var with
|
||||
internal_out = newinternalout;
|
||||
internal_between = new_internal_between; }
|
||||
|
||||
let update (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode =
|
||||
let newt = {t with internalvar = (Cfg.NodeMap.add node
|
||||
let update (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internal_node =
|
||||
let newt = {t with internal_var = (Cfg.NodeMap.add node
|
||||
(lucf t node)
|
||||
t.internalvar)} in
|
||||
t.internal_var)} in
|
||||
lub newt node
|
||||
|
||||
|
||||
@ -244,38 +245,38 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
|
||||
(t: DVCfg.t)
|
||||
(node: Cfg.Node.t)
|
||||
: (Variable.t VariableMap.t * DVCfg.t) =
|
||||
let livevars = Cfg.NodeMap.find node t.internalvar in
|
||||
let livevars = Cfg.NodeMap.find node t.internal_var in
|
||||
let code =
|
||||
match Cfg.NodeMap.find_opt node t.t.content with
|
||||
| None -> []
|
||||
| Some x -> x
|
||||
in
|
||||
let newcode, newassignments =
|
||||
let new_code, new_assignments =
|
||||
(List.fold_left2
|
||||
(fun (acc, assignments) btw code ->
|
||||
let na, nc = replace_code btw assignments code in
|
||||
(acc @ [nc], na)
|
||||
)
|
||||
([], assignments)
|
||||
livevars.internalbetween
|
||||
livevars.internal_between
|
||||
code)
|
||||
in
|
||||
|
||||
let newcontent = Cfg.NodeMap.add
|
||||
node
|
||||
newcode
|
||||
new_code
|
||||
t.t.content
|
||||
in
|
||||
|
||||
let newt = { t with t = { t.t with content = newcontent } } in
|
||||
(newassignments, newt)
|
||||
(new_assignments, newt)
|
||||
in
|
||||
|
||||
(* ------------------- *)
|
||||
|
||||
(* at least the input variable should be in the mapping *)
|
||||
let assignments =
|
||||
match t.t.inputOutputVar with
|
||||
match t.t.input_output_var with
|
||||
None -> VariableMap.empty
|
||||
| Some (i, _o) -> (
|
||||
VariableMap.get_or_set_mapping VariableMap.empty [] i |> fst
|
||||
@ -296,7 +297,7 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
|
||||
(* union of all in and out such that v is in the set *)
|
||||
let union : 'a list =
|
||||
List.fold_left
|
||||
(fun (acc: 'a list) (node, (x: DVCfg.internalnode)) ->
|
||||
(fun (acc: 'a list) (node, (x: DVCfg.internal_node)) ->
|
||||
(* not interested in internalin or internalout since information
|
||||
is mirrored into internalbetween *)
|
||||
List.fold_left2
|
||||
@ -315,12 +316,12 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
|
||||
(Utility.unique_union i o) acc
|
||||
)
|
||||
acc
|
||||
x.internalbetween
|
||||
x.internal_between
|
||||
(Cfg.NodeMap.find_opt node t.t.content |>
|
||||
Option.value ~default:[])
|
||||
)
|
||||
[]
|
||||
(Cfg.NodeMap.to_list t.internalvar)
|
||||
(Cfg.NodeMap.to_list t.internal_var)
|
||||
in
|
||||
let assignments, _ =
|
||||
VariableMap.get_or_set_mapping assignments union v in
|
||||
@ -338,8 +339,8 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
|
||||
|
||||
{ newt with
|
||||
t = { newt.t with
|
||||
inputOutputVar =
|
||||
match newt.t.inputOutputVar with
|
||||
input_output_var =
|
||||
match newt.t.input_output_var with
|
||||
None -> None
|
||||
| Some (i, o) -> (
|
||||
match VariableMap.find_opt i mapping,
|
||||
|
||||
Reference in New Issue
Block a user