From 90195f830788f53d214754a732bd094247a91c70 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Thu, 3 Mar 2022 13:20:26 +0100
Subject: Rename CFIM to LLBC

---
 src/LlbcAstUtils.ml | 69 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 69 insertions(+)
 create mode 100644 src/LlbcAstUtils.ml

(limited to 'src/LlbcAstUtils.ml')

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
-- 
cgit v1.2.3