blob: 902156f23192f93608859139660653de4f9bea42 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
open CfimAst
open Utils
module T = Types
(** Check if a [statement] contains loops *)
let statement_has_loops (st : statement) : bool =
let obj =
object
inherit [_] iter_statement
method! visit_Loop _ _ = raise Found
end
in
try
obj#visit_statement () st;
false
with Found -> true
(** Check if a [fun_def] contains loops *)
let fun_def_has_loops (fd : fun_def) : bool = statement_has_loops fd.body
let lookup_fun_sig (fun_id : fun_id) (fun_defs : fun_def FunDefId.Map.t) :
fun_sig =
match fun_id with
| Local id -> (FunDefId.Map.find id fun_defs).signature
| Assumed aid ->
let _, sg =
List.find (fun (aid', _) -> aid = aid') Assumed.assumed_sigs
in
sg
let lookup_fun_name (fun_id : fun_id) (fun_defs : fun_def FunDefId.Map.t) :
Identifiers.name =
match fun_id with
| Local id -> (FunDefId.Map.find id fun_defs).name
| Assumed aid ->
let _, sg =
List.find (fun (aid', _) -> aid = aid') Assumed.assumed_names
in
sg
(** Small utility: list the transitive parents of a region var group.
We don't do that in an efficient manner, but it doesn't matter.
TODO: rename to "list_ancestors_..."
*)
let rec list_parent_region_groups (sg : fun_sig) (gid : T.RegionGroupId.id) :
T.RegionGroupId.Set.t =
let rg = T.RegionGroupId.nth sg.regions_hierarchy gid in
let parents =
List.fold_left
(fun s gid ->
(* Compute the parents *)
let parents = list_parent_region_groups sg gid in
(* Parents U current region *)
let parents = T.RegionGroupId.Set.add gid parents in
(* Make the union with the accumulator *)
T.RegionGroupId.Set.union s parents)
T.RegionGroupId.Set.empty rg.parents
in
parents
(** Small utility: same as [list_parent_region_groups], but returns an ordered list. *)
let list_ordered_parent_region_groups (sg : fun_sig) (gid : T.RegionGroupId.id)
: T.RegionGroupId.id list =
let pset = list_parent_region_groups sg gid in
let parents =
List.filter
(fun (rg : T.region_var_group) -> T.RegionGroupId.Set.mem rg.id pset)
sg.regions_hierarchy
in
let parents = List.map (fun (rg : T.region_var_group) -> rg.id) parents in
parents
let fun_def_get_input_vars (fdef : fun_def) : var list =
let locals = List.tl fdef.locals in
Collections.List.prefix fdef.arg_count locals
|
