[infer] Extend annotation framework to handle wider variety of param types

Summary:
Previous implementation supported only stringy params (strings and
stringified bools). Current one exposes a proper variant `Annot.t`,
with support for all possible param values in Java except
numbers (more on that below).

This change is required for implementing `Nullsafe(LOCAL)` as the
annotation used to specify nullsafe behaviour has a more complex
structure than what we've dealt with before.

**Why support for number values was not added**: supporting numbers
requires using `int64`. Unfortunately, adding another variant `Vnum
int64` to `Annot.t` causes a runtime failure on assert in
`MaximumSharing.ml:133`. It seems that it might be enough to flip
`fail_on_nonstring` from `true` to `false`, but since this would
require additional testing and is not required for my case, I'll leave
checking this to whoever needs to use numeric annot params in future.

Reviewed By: ezgicicek

Differential Revision: D19855923

fbshipit-source-id: 878e33856

infer/src/IR/Annot.ml

@@ -11,15 +11,22 @@
 open! IStd
 module F = Format
 
-type parameter = {name: string option; value: string} [@@deriving compare]
+(** Type to represent an [@Annotation] with potentially complex parameter values such as arrays or
+    other annotations. *)
+type t = {class_name: string  (** name of the annotation *); parameters: parameter list}
+[@@deriving compare]
 
-type parameters = parameter list [@@deriving compare]
+and parameter = {name: string option; value: value} [@@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]
+(** Type to represent possible annotation parameter values. Note that support for numeric parameters
+    is missing for now due to an issue with [MaximumSharing] and [int64]. *)
+and value =
+  | Str of string
+  | Bool of bool
+  | Enum of {class_typ: Typ.t; value: string}
+  | Array of value list
+  | Class of Typ.t
+  | Annot of t
 
 let equal = [%compare.equal: t]
 
@@ -29,22 +36,47 @@ let final = {class_name= "final"; parameters= []}
 
 let is_final x = equal final x
 
+let rec has_matching_str_value ~pred = function
+  | Str s ->
+      pred s
+  | Array els ->
+      List.exists els ~f:(has_matching_str_value ~pred)
+  | _ ->
+      false
+
+
 (** Pretty print an annotation. *)
 let prefix = match Language.curr_language_is Java with true -> "@" | false -> "_"
 
-let pp_parameter fmt {name; value} =
+let comma_sep fmt _ = F.pp_print_string fmt ", "
+
+let rec pp_value fmt = function
+  | Str s ->
+      F.pp_print_string fmt s
+  | Bool b ->
+      F.pp_print_bool fmt b
+  | Enum {class_typ; value} ->
+      F.fprintf fmt "%a.%s" (Typ.pp Pp.text) class_typ value
+  | Array values ->
+      F.pp_print_list ~pp_sep:comma_sep pp_value fmt values
+  | Class name ->
+      F.fprintf fmt "%a" (Typ.pp Pp.text) name
+  | Annot a ->
+      F.fprintf fmt "%a" pp a
+
+
+and pp_parameter fmt {name; value} =
   match name with
   | None ->
-      F.fprintf fmt "\"%s\"" value
+      F.fprintf fmt "\"%a\"" pp_value value
   | Some name ->
-      F.fprintf fmt "%s=\"%s\"" name value
+      F.fprintf fmt "%s=\"%a\"" name pp_value value
 
 
-let pp fmt annotation =
-  let pp_sep fmt _ = F.pp_print_string fmt ", " in
-  F.fprintf fmt "%s%s%a" prefix annotation.class_name
-    (F.pp_print_list ~pp_sep pp_parameter)
-    annotation.parameters
+and pp fmt annotation =
+  F.fprintf fmt "%s%s" prefix annotation.class_name ;
+  if not (List.is_empty annotation.parameters) then
+    F.fprintf fmt "(%a)" (F.pp_print_list ~pp_sep:comma_sep pp_parameter) annotation.parameters
 
 
 module Item = struct

infer/src/IR/Annot.mli

@@ -11,15 +11,22 @@
 open! IStd
 module F = Format
 
-type parameter = {name: string option; value: string}
+(** Type to represent an [@Annotation] with potentially complex parameter values such as arrays or
+    other annotations. *)
+type t = {class_name: string  (** name of the annotation *); parameters: parameter list}
+[@@deriving compare]
 
-type parameters = parameter list
+and parameter = {name: string option; value: value} [@@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]
+(** Type to represent possible annotation parameter values. Note that support for numeric parameters
+    is missing for now due to an issue with [MaximumSharing] and [int64]. *)
+and value =
+  | Str of string
+  | Bool of bool
+  | Enum of {class_typ: Typ.t; value: string}
+  | Array of value list
+  | Class of Typ.t
+  | Annot of t
 
 val volatile : t
 (** annotation for fields marked with the "volatile" keyword *)
@@ -27,6 +34,10 @@ val volatile : t
 val final : t
 (** annotation for fields marked with the "final" keyword *)
 
+val has_matching_str_value : pred:(string -> bool) -> value -> bool
+(** Check if annotation parameter value contains a string satisfying a predicate. For convenience it
+    works both with raw [Vstr] and [Vstr] inside [Varray]. *)
+
 val pp : F.formatter -> t -> unit
 (** Pretty print an annotation. *)
 

infer/src/IR/Typ.ml

@@ -265,6 +265,8 @@ let mk_array ?default ?quals ?length ?stride elt : t =
   mk ?default ?quals (Tarray {elt; length; stride})
 
 
+let mk_struct name = mk (Tstruct name)
+
 let void = mk Tvoid
 
 let void_star = mk (Tptr (mk Tvoid, Pk_pointer))

infer/src/IR/Typ.mli

@@ -134,6 +134,8 @@ val mk : ?default:t -> ?quals:type_quals -> desc -> t
 val mk_array : ?default:t -> ?quals:type_quals -> ?length:IntLit.t -> ?stride:IntLit.t -> t -> t
 (** Create an array type from a given element type. If [length] or [stride] value is given, use them as static length and size. *)
 
+val mk_struct : name -> t
+
 val void : t
 (** void type *)
 

infer/src/backend/reporting.ml

@@ -126,7 +126,10 @@ let is_suppressed ?(field_name = None) tenv proc_desc kind =
   let annotation_matches (a : Annot.t) =
     let normalize str = Str.global_replace (Str.regexp "[_-]") "" (String.lowercase str) in
     let drop_prefix str = Str.replace_first (Str.regexp "^[A-Za-z]+_") "" str in
-    let normalized_equal s1 a2 = String.equal (normalize s1) (normalize a2.Annot.value) in
+    let normalized_equal s1 a2 =
+      Annot.(
+        has_matching_str_value a2.value ~pred:(fun s -> String.equal (normalize s1) (normalize s)))
+    in
     let is_parameter_suppressed () =
       String.is_suffix a.class_name ~suffix:Annotations.suppress_lint
       && List.exists ~f:(normalized_equal kind.IssueType.unique_id) a.parameters

infer/src/biabduction/Rearrange.ml

@@ -758,7 +758,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc =
     let annot_extract_guarded_by_str ((annot : Annot.t), _) =
       if Annotations.annot_ends_with annot Annotations.guarded_by then
         match annot.parameters with
-        | [Annot.{value= guarded_by_str}] when not (excluded_guardedby_string guarded_by_str) ->
+        | [Annot.{value= Str guarded_by_str}] when not (excluded_guardedby_string guarded_by_str) ->
             Some guarded_by_str
         | _ ->
             None
@@ -769,7 +769,13 @@ let add_guarded_by_constraints tenv prop lexp pdesc =
   let extract_suppress_warnings_str item_annot =
     let annot_suppress_warnings_str ((annot : Annot.t), _) =
       if Annotations.annot_ends_with annot Annotations.suppress_lint then
-        match annot.parameters with [Annot.{value= suppr_str}] -> Some suppr_str | _ -> None
+        (* TODO: @SuppressLint's param is an array of strings, thus we need to match on
+           array. But generally logic here is still broken since it only expects 1 value. *)
+        match annot.parameters with
+        | [Annot.{value= Array [Str suppr_str; _]}] ->
+            Some suppr_str
+        | _ ->
+            None
       else None
     in
     List.find_map ~f:annot_suppress_warnings_str item_annot

infer/src/biabduction/RetainCycles.ml

@@ -66,9 +66,10 @@ let edge_is_strong tenv obj_edge =
   in
   let has_weak_or_unretained_or_assign params =
     List.exists
-      ~f:(fun Annot.{value= att} ->
-        String.equal Config.unsafe_unret att
-        || String.equal Config.weak att || String.equal Config.assign att )
+      ~f:(fun Annot.{value} ->
+        Annot.has_matching_str_value value ~pred:(fun att ->
+            String.equal Config.unsafe_unret att
+            || String.equal Config.weak att || String.equal Config.assign att ) )
       params
   in
   let rc_field =

infer/src/checkers/RequiredProps.ml

@@ -28,8 +28,7 @@ let get_required_props typename tenv =
         not
           (List.exists
              ~f:(fun Annot.{name; value} ->
-               Option.value_map name ~default:false ~f:(fun name -> String.equal "optional" name)
-               && String.equal value "true" )
+               match (name, value) with Some "optional", Annot.Bool true -> true | _ -> false )
              parameters) )
       annot_list
   in
@@ -41,9 +40,11 @@ let get_required_props typename tenv =
              @Prop(varArg = myProp). *)
           List.fold ~init:acc
             ~f:(fun acc Annot.{name; value} ->
-              if Option.value_map name ~default:false ~f:(fun name -> String.equal "varArg" name)
-              then Some value
-              else acc )
+              match (name, value) with
+              | Some "varArg", Annot.Str str_value ->
+                  Some str_value
+              | _ ->
+                  acc )
             parameters
         else acc )
       annot_list

infer/src/clang/cField_decl.ml

@@ -42,15 +42,15 @@ let fields_superclass tenv interface_decl_info =
 let build_sil_field qual_type_to_sil_type tenv class_tname field_name qual_type prop_attributes =
   let prop_atts =
     List.map
-      ~f:(fun att -> Annot.{name= None; value= Clang_ast_j.string_of_property_attribute att})
+      ~f:(fun att -> Annot.{name= None; value= Str (Clang_ast_j.string_of_property_attribute att)})
       prop_attributes
   in
   let annotation_from_type t =
     match t.Typ.desc with
     | Typ.Tptr (_, Typ.Pk_objc_weak) ->
-        [Annot.{name= None; value= Config.weak}]
+        [Annot.{name= None; value= Str Config.weak}]
     | Typ.Tptr (_, Typ.Pk_objc_unsafe_unretained) ->
-        [Annot.{name= None; value= Config.unsafe_unret}]
+        [Annot.{name= None; value= Str Config.unsafe_unret}]
     | _ ->
         []
   in

infer/src/concurrency/RacerD.ml

@@ -876,7 +876,12 @@ let should_report_guardedby_violation classname ({snapshot; tenv; procname} : re
     Fieldname.equal f field_name
     && List.exists a ~f:(fun ((annot : Annot.t), _) ->
            Annotations.annot_ends_with annot Annotations.guarded_by
-           && match annot.parameters with [param] -> not (is_uitthread param.value) | _ -> false )
+           &&
+           match annot.parameters with
+           | [param] ->
+               not (Annot.has_matching_str_value ~pred:is_uitthread param.value)
+           | _ ->
+               false )
   in
   (not snapshot.lock)
   && RacerDDomain.TraceElem.is_write snapshot.access

infer/src/concurrency/RacerDModels.ml

@@ -277,7 +277,7 @@ let is_thread_safe item_annot =
     List.exists ~f:(Annotations.annot_ends_with annot) threadsafe_annotations
     &&
     match annot.Annot.parameters with
-    | [Annot.{name= Some "enableChecks"; value= "false"}] ->
+    | [Annot.{name= Some "enableChecks"; value= Bool false}] ->
         false
     | _ ->
         true
@@ -291,7 +291,7 @@ let is_assumed_thread_safe item_annot =
     Annotations.annot_ends_with annot Annotations.thread_safe
     &&
     match annot.Annot.parameters with
-    | [Annot.{name= Some "enableChecks"; value= "false"}] ->
+    | [Annot.{name= Some "enableChecks"; value= Bool false}] ->
         true
     | _ ->
         false

infer/src/java/jAnnotation.ml

@@ -9,21 +9,75 @@
 open! IStd
 open Javalib_pack
 
+let translate_basic_type = function
+  | `Bool ->
+      Typ.boolean
+  | `Byte ->
+      Typ.java_byte
+  | `Char ->
+      Typ.char
+  | `Double ->
+      Typ.double
+  | `Float ->
+      Typ.float
+  | `Int ->
+      Typ.int
+  | `Long ->
+      Typ.long
+  | `Short ->
+      Typ.java_short
+
+
+let rec translate_value_type = function
+  | JBasics.TBasic basic ->
+      translate_basic_type basic
+  | JBasics.TObject obj ->
+      translate_object_type obj
+
+
+and translate_object_type = function
+  | JBasics.TClass cn ->
+      Typ.mk_struct (Typ.Name.Java.from_string (JBasics.cn_name cn))
+  | JBasics.TArray vt ->
+      Typ.mk_array (translate_value_type vt)
+
+
+let rec translate_value_exn = function
+  | JBasics.EVCstString s ->
+      Annot.Str s
+  | JBasics.EVCstBoolean 0 ->
+      Annot.Bool false
+  | JBasics.EVCstBoolean 1 ->
+      Annot.Bool true
+  | JBasics.EVEnum (cn, value) ->
+      Annot.Enum {class_typ= Typ.mk_struct (Typ.Name.Java.from_string (JBasics.cn_name cn)); value}
+  | JBasics.EVArray values ->
+      Annot.Array (List.map values ~f:translate_value |> List.filter_opt)
+  | JBasics.EVClass (Some typ) ->
+      Annot.Class (translate_value_type typ)
+  | JBasics.EVClass _ ->
+      Annot.Class Typ.void
+  | JBasics.EVAnnotation ann ->
+      Annot.Annot (translate ann)
+  | _ ->
+      raise (Invalid_argument "Annotation value not supported")
+
+
+and translate_value element_value =
+  match translate_value_exn element_value with
+  | value ->
+      Some value
+  | exception Invalid_argument _ ->
+      None
+
+
 (** Translate an annotation. *)
-let translate a : Annot.t =
+and translate a : Annot.t =
   let class_name = JBasics.cn_name a.JBasics.kind in
-  let rec translate_value_pair acc (x, value) =
-    match value with
-    | JBasics.EVArray (JBasics.EVCstString s :: l) ->
-        translate_value_pair (Annot.{name= Some x; value= s} :: acc) (x, JBasics.EVArray l)
-    | JBasics.EVCstString s ->
-        Annot.{name= Some x; value= s} :: acc
-    | JBasics.EVCstBoolean 0 ->
-        (* just translate bools as strings. means we can't distinguish between a boolean false
-           literal parameter and string literal "false" parameter, but that's ok. *)
-        Annot.{name= Some x; value= "false"} :: acc
-    | JBasics.EVCstBoolean 1 ->
-        Annot.{name= Some x; value= "true"} :: acc
+  let translate_value_pair acc (x, value) =
+    match translate_value value with
+    | Some translated ->
+        Annot.{name= Some x; value= translated} :: acc
     | _ ->
         acc
   in