summaryrefslogtreecommitdiff
path: root/src/LlbcAstUtils.ml
diff options
context:
space:
mode:
authorSon Ho2022-03-03 13:20:26 +0100
committerSon Ho2022-03-03 13:20:26 +0100
commit90195f830788f53d214754a732bd094247a91c70 (patch)
tree4f5d2c748e61e06008e77430b29e5da513c4b8bd /src/LlbcAstUtils.ml
parentdf04dee24f1c83998aa314382f70e3961def8f10 (diff)
Rename CFIM to LLBC
Diffstat (limited to 'src/LlbcAstUtils.ml')
-rw-r--r--src/LlbcAstUtils.ml69
1 files changed, 69 insertions, 0 deletions
diff --git a/src/LlbcAstUtils.ml b/src/LlbcAstUtils.ml
new file mode 100644
index 00000000..93ca4448
--- /dev/null
+++ b/src/LlbcAstUtils.ml
@@ -0,0 +1,69 @@
+open LlbcAst
+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_decl] contains loops *)
+let fun_decl_has_loops (fd : fun_decl) : bool = statement_has_loops fd.body
+
+let lookup_fun_sig (fun_id : fun_id) (fun_decls : fun_decl FunDeclId.Map.t) :
+ fun_sig =
+ match fun_id with
+ | Local id -> (FunDeclId.Map.find id fun_decls).signature
+ | Assumed aid -> Assumed.get_assumed_sig aid
+
+let lookup_fun_name (fun_id : fun_id) (fun_decls : fun_decl FunDeclId.Map.t) :
+ Names.fun_name =
+ match fun_id with
+ | Local id -> (FunDeclId.Map.find id fun_decls).name
+ | Assumed aid -> Assumed.get_assumed_name aid
+
+(** 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_decl_get_input_vars (fdef : fun_decl) : var list =
+ let locals = List.tl fdef.locals in
+ Collections.List.prefix fdef.arg_count locals