infer_clone/infer/src/checkers/accessPathDomains.ml

(*
 * Copyright (c) 2016 - present Facebook, Inc.
 * All rights reserved.
 *
 * This source code is licensed under the BSD style license found in the
 * LICENSE file in the root directory of this source tree. An additional grant
 * of patent rights can be found in the PATENTS file in the same directory.
 *)

open! IStd

module F = Format

module Set = struct
  module APSet = PrettyPrintable.MakePPSet (struct
      type t = AccessPath.t
      let compare = AccessPath.compare
      let pp_element = AccessPath.pp
    end)

  (** TODO (12086310): best-case behavior of some operations can be improved by adding "abstracted"
      bool recording whether an abstracted access path has been introduced *)
  type astate = APSet.t

  let initial = APSet.empty

  let pp = APSet.pp

  let normalize aps =
    APSet.filter
      (fun lhs -> not (APSet.exists (fun rhs -> lhs != rhs && AccessPath.(<=) ~lhs ~rhs) aps))
      aps

  let add = APSet.add

  let of_list = APSet.of_list

  let mem ap aps =
    APSet.mem ap aps || APSet.exists (fun other_ap -> AccessPath.(<=) ~lhs:ap ~rhs:other_ap) aps

  let mem_fuzzy ap aps =
    let has_overlap ap1 ap2 =
      AccessPath.(<=) ~lhs:ap1 ~rhs:ap2 || AccessPath.(<=) ~lhs:ap2 ~rhs:ap1 in
    APSet.mem ap aps || APSet.exists (has_overlap ap) aps

  let (<=) ~lhs ~rhs =
    if lhs == rhs
    then true
    else
      let rhs_contains lhs_ap =
        mem lhs_ap rhs in
      APSet.subset lhs rhs || APSet.for_all rhs_contains lhs

  let join aps1 aps2 =
    if aps1 == aps2
    then aps1
    else APSet.union aps1 aps2

  let widen ~prev ~next ~num_iters:_ =
    if prev == next
    then prev
    else
      let abstract_access_path ap aps = match ap with
        | AccessPath.Exact exact_ap -> APSet.add (AccessPath.Abstracted exact_ap) aps
        | AccessPath.Abstracted _ -> APSet.add ap aps in
      let diff_aps = APSet.diff next prev in
      APSet.fold abstract_access_path diff_aps initial
      |> join prev
end