[alias] new API functions for getting the alias sets of a state

To date most API functions return results with respect to a specific
lval. The added functions simply return all the alias sets of a given
state/stmt/function.

src/plugins/alias/src/API.ml

@@ -41,22 +41,21 @@ let check_computed () =
   then
     Options.abort "Static analysis must be called before any function of the API can be called"
 
-
-let lset ~stmt (get_set : Abstract_state.t -> LSet.t) =
+let get_of_stmt ~stmt empty (get : Abstract_state.t -> 'a) =
   check_computed ();
   match Analysis.get_state_before_stmt stmt with
-  | None -> LSet.empty
-  | Some state -> get_set state
+  | None -> empty
+  | Some state -> get state
 
-let vars ~stmt (get_set : Abstract_state.t -> VarSet.t) =
-  check_computed ();
-  match Analysis.get_state_before_stmt stmt with
-  | None -> VarSet.empty
-  | Some state -> get_set state
+let lset ~stmt get_set = get_of_stmt ~stmt LSet.empty get_set
+let vars ~stmt get_set = get_of_stmt ~stmt VarSet.empty get_set
+let get_list ~stmt get = get_of_stmt ~stmt [] get
 
 module Statement = struct
   let points_to_vars ~stmt lv = vars ~stmt (Abstract_state.points_to_vars lv)
   let points_to_lvals ~stmt lv = lset ~stmt (Abstract_state.points_to_lvals lv)
+  let alias_sets_vars ~stmt = get_list ~stmt Abstract_state.alias_sets_vars
+  let alias_sets_lvals ~stmt = get_list ~stmt Abstract_state.alias_sets_lvals
   let alias_vars ~stmt lv = vars ~stmt (Abstract_state.alias_vars lv)
   let alias_lvals ~stmt lv = lset ~stmt (Abstract_state.alias_lvals lv)
   let aliases = alias_lvals (* deprecated *)
@@ -92,6 +91,8 @@ module Function = struct
 
   let points_to_vars ~kf = Statement.points_to_vars ~stmt:(return_stmt kf)
   let points_to_lvals ~kf = Statement.points_to_lvals ~stmt:(return_stmt kf)
+  let alias_sets_vars ~kf = Statement.alias_sets_vars ~stmt:(return_stmt kf)
+  let alias_sets_lvals ~kf = Statement.alias_sets_lvals ~stmt:(return_stmt kf)
   let alias_vars ~kf = Statement.alias_vars ~stmt:(return_stmt kf)
   let alias_lvals ~kf = Statement.alias_lvals ~stmt:(return_stmt kf)
   let aliases = alias_lvals (* deprecated *)

src/plugins/alias/src/API.mli

@@ -52,6 +52,12 @@ module Statement : sig
   (** see [Abstract_state.points_to_lvals] *)
   val points_to_lvals : stmt:stmt -> lval -> LSet.t
 
+  (** see [Abstract_state.alias_sets_vars] *)
+  val alias_sets_vars : stmt:stmt -> VarSet.t list
+
+  (** see [Abstract_state.alias_sets_lvals] *)
+  val alias_sets_lvals : stmt:stmt -> LSet.t list
+
   (** see [Abstract_state.alias_vars] *)
   val alias_vars : stmt:stmt -> lval -> VarSet.t
 
@@ -79,6 +85,12 @@ module Function : sig
   (** see [Abstract_state.points_to_lvals] *)
   val points_to_lvals : kf:kernel_function -> lval -> LSet.t
 
+  (** see [Abstract_state.alias_sets_vars] *)
+  val alias_sets_vars : kf:kernel_function -> VarSet.t list
+
+  (** see [Abstract_state.alias_sets_lvals] *)
+  val alias_sets_lvals : kf:kernel_function -> LSet.t list
+
   (** see [Abstract_state.alias_vars] *)
   val alias_vars : kf:kernel_function -> lval -> VarSet.t
 
@@ -245,6 +257,18 @@ module Abstract_state : sig
   val points_to_set : lval -> t -> LSet.t
   [@@alert deprecated "Use points_to_vars or points_to_lvals instead!"]
 
+  (** all the alias sets of a given state
+      Example: {a,b} → {c} ← {d} ← {e,f}
+      The aliases sets are {{a,b,d}, {e,f}}
+  *)
+  val alias_sets_vars : t -> VarSet.t list
+
+  (** all the alias sets of a given state, including reconstructed lvals
+      Example: {a,b} → {c} ← {d} ← {e,f}
+      The aliases sets are {{a,b,d,*e,*f}, {e,f}}
+  *)
+  val alias_sets_lvals : t -> LSet.t list
+
   (** alias_lvals, then recursively finds other sets of lvals. We
       have the property (if lval [lv] is in abstract state [x]) :
       List.hd (find_transitive_closure lv x) = (find_vertex lv x,

src/plugins/alias/src/abstract_state.ml

@@ -238,11 +238,24 @@ module Readout = struct
     | None -> LSet.empty
     | Some succ_v -> get_lval_set succ_v s
 
+  let alias_sets_vars s =
+    let alias_set_of_vertex (i, _) =
+      let aliases = vars_pointing_to_vertex i s in
+      if VarSet.cardinal aliases >= 2 then Some aliases else None
+    in
+    List.filter_map alias_set_of_vertex @@ VMap.bindings s.vmap
+
+  let alias_sets_lvals s =
+    let alias_set_of_vertex (i, _) =
+      let aliases = lvals_pointing_to_vertex i s in
+      if LSet.cardinal aliases >= 2 then Some aliases else None
+    in
+    List.filter_map alias_set_of_vertex @@ VMap.bindings s.vmap
+
 end
 
 
 module Pretty = struct
-
   let pp_debug fmt s =
     Format.fprintf fmt "@[<v>";
     Format.fprintf fmt "@[Edges:";
@@ -283,13 +296,8 @@ module Pretty = struct
           G.iter_vertex pp_unconnected_vertex s.graph)
 
   let pp_aliases fmt s =
-    let alias_set_of_vertex (i, _) =
-      let aliases = Readout.lvals_pointing_to_vertex i s in
-      if LSet.cardinal aliases >= 2 then Some aliases else None
-    in
-    let alias_sets = List.filter_map alias_set_of_vertex @@ VMap.bindings s.vmap in
+    let alias_sets = Readout.alias_sets_lvals s in
     Pretty_utils.pp_list ~empty:"<none>" ~sep:"@;<2>" LSet.pretty fmt alias_sets
-
 end
 
 (* invariants of type t must be true before and after each functon call *)
@@ -935,6 +943,8 @@ module API = struct
   let points_to_vars = Readout.points_to_vars
   let points_to_set = Readout.points_to_lvals
   let points_to_lvals = Readout.points_to_lvals
+  let alias_sets_vars = Readout.alias_sets_vars
+  let alias_sets_lvals = Readout.alias_sets_lvals
 
   let get_graph s = s.graph
 

src/plugins/alias/src/abstract_state.mli

@@ -65,6 +65,8 @@ val find_all_aliases : lval -> t -> LSet.t
 
 val points_to_vars : lval -> t -> VarSet.t
 val points_to_lvals : lval -> t -> LSet.t
+val alias_sets_vars : t -> VarSet.t list
+val alias_sets_lvals : t -> LSet.t list
 
 val points_to_set : lval -> t -> LSet.t
 [@@alert deprecated "Use points_to_vars or points_to_lvals instead!"]