Style more consistent, replace capitalization with camel case

This commit is contained in:
elvis
2025-01-27 16:28:23 +01:00
parent 4ab0b40cca
commit 2fbbf4e4d1
23 changed files with 390 additions and 373 deletions

View File

@ -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,