infer_clone/infer/src/IR/Annot.ml

(*
 * Copyright (c) 2009 - 2013 Monoidics ltd.
 * Copyright (c) 2013 - 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.
 *)

(** The Smallfoot Intermediate Language: Annotations *)
open! IStd
module L = Logging
module F = Format

type parameters = string list [@@deriving compare]

(** Type to represent one @Annotation. *)
type t =
  { class_name: string  (** name of the annotation *)
  ; parameters: parameters  (** currently only one string parameter *) }
  [@@deriving compare]

let volatile = {class_name= "volatile"; parameters= []}

let final = {class_name= "final"; parameters= []}

(** Pretty print an annotation. *)
let prefix = match Config.curr_language_is Config.Java with true -> "@" | false -> "_"

let pp fmt annotation = F.fprintf fmt "%s%s" prefix annotation.class_name

module Map = PrettyPrintable.MakePPMap (struct
  type nonrec t = t

  let compare = compare

  let pp = pp
end)

module Item = struct
  (* Don't use nonrec due to https://github.com/janestreet/ppx_compare/issues/2 *)
  (* type nonrec t = list (t, bool) [@@deriving compare]; *)
  (** Annotation for one item: a list of annotations with visibility. *)
  type _t = (t * bool) list [@@deriving compare]

  type t = _t [@@deriving compare]

  let equal = [%compare.equal : t]

  (** Pretty print an item annotation. *)
  let pp fmt ann =
    let pp fmt (a, _) = pp fmt a in
    F.fprintf fmt "<%a>" (Pp.seq pp) ann

  let to_string ann =
    let pp fmt = pp fmt ann in
    F.asprintf "%t" pp

  (** Empty item annotation. *)
  let empty = []

  (** Check if the item annodation is empty. *)
  let is_empty ia = List.is_empty ia
end

module Class = struct
  let objc_str = "ObjC-Class"

  let cpp_str = "Cpp-Class"

  let of_string class_string = [({class_name= class_string; parameters= []}, true)]

  let objc = of_string objc_str

  let cpp = of_string cpp_str
end

module Method = struct
  (** Annotation for a method: return value and list of parameters. *)
  type t = Item.t * Item.t list [@@deriving compare]

  (** Pretty print a method annotation. *)
  let pp s fmt (ia, ial) = F.fprintf fmt "%a %s(%a)" Item.pp ia s (Pp.seq Item.pp) ial

  (** Empty method annotation. *)
  let empty = ([], [])

  (** Check if the method annodation is empty. *)
  let is_empty (ia, ial) = List.for_all ~f:Item.is_empty (ia :: ial)
end