[inferbo] Use inline record for Loc.Field

Summary: It uses inline record for Loc.Field Depends on D16807279 Reviewed By: ezgicicek Differential Revision: D16807299 fbshipit-source-id: 45eab34a4
6 years ago · 761d8bd614
parent d287177820
commit 761d8bd614
5 changed files with 47 additions and 45 deletions
--- a/infer/src/bufferoverrun/absLoc.ml
+++ b/infer/src/bufferoverrun/absLoc.ml
@ -132,7 +132,7 @@ module Loc = struct
        type t =
          | Var of Var.t
          | Allocsite of Allocsite.t
-          | Field of t * Typ.Fieldname.t
+          | Field of {prefix: t; fn: Typ.Fieldname.t}
          | StarField of {prefix: t; last_field: Typ.Fieldname.t}
        [@@deriving compare]

@ -143,14 +143,14 @@ module Loc = struct
        let append_field l0 ~fn =
          let rec aux = function
            | Var _ | Allocsite _ ->
-                Field (l0, fn)
+                Field {prefix= l0; fn}
            | StarField {last_field} as l when Typ.Fieldname.equal fn last_field ->
                l
            | StarField {prefix} ->
                StarField {prefix; last_field= fn}
-            | Field (_, fn') when Typ.Fieldname.equal fn fn' ->
+            | Field {fn= fn'} when Typ.Fieldname.equal fn fn' ->
                StarField {prefix= l0; last_field= fn}
-            | Field (l, _) ->
+            | Field {prefix= l} ->
                aux l
          in
          aux l0
@ -164,7 +164,7 @@ module Loc = struct
                l
            | StarField {prefix} ->
                StarField {prefix; last_field= fn}
-            | Field (l, _) ->
+            | Field {prefix= l} ->
                aux l
          in
          aux l0
@ -173,7 +173,7 @@ module Loc = struct
        type t = private
          | Var of Var.t
          | Allocsite of Allocsite.t
-          | Field of t * Typ.Fieldname.t
+          | Field of {prefix: t; fn: Typ.Fieldname.t}
          | StarField of {prefix: t; last_field: Typ.Fieldname.t}
        [@@deriving compare]

@ -199,7 +199,7 @@ module Loc = struct
        false
    | Allocsite a ->
        Allocsite.is_unknown a
-    | Field (x, _) | StarField {prefix= x} ->
+    | Field {prefix= x} | StarField {prefix= x} ->
        is_unknown x


@ -215,17 +215,19 @@ module Loc = struct
    | Allocsite a ->
        Allocsite.pp_paren ~paren fmt a
    | Field
-        ( Allocsite
-            (Allocsite.Symbol (SP.Deref ((SP.Deref_COneValuePointer | SP.Deref_CPointer), p)))
-        , f )
+        { prefix=
+            Allocsite
+              (Allocsite.Symbol (SP.Deref ((SP.Deref_COneValuePointer | SP.Deref_CPointer), p)))
+        ; fn= f }
    | Field
-        ( Allocsite
-            (Allocsite.Known
-              {path= Some (SP.Deref ((SP.Deref_COneValuePointer | SP.Deref_CPointer), p))})
-        , f ) ->
+        { prefix=
+            Allocsite
+              (Allocsite.Known
+                {path= Some (SP.Deref ((SP.Deref_COneValuePointer | SP.Deref_CPointer), p))})
+        ; fn= f } ->
        BufferOverrunField.pp ~pp_lhs:(SP.pp_partial_paren ~paren:true)
          ~pp_lhs_alone:(SP.pp_pointer ~paren) ~sep:"->" fmt p f
-    | Field (l, f) ->
+    | Field {prefix= l; fn= f} ->
        BufferOverrunField.pp ~pp_lhs:(pp_paren ~paren:true) ~pp_lhs_alone:(pp_paren ~paren)
          ~sep:"." fmt l f
    | StarField {prefix; last_field} ->
@ -242,14 +244,14 @@ module Loc = struct
  let is_var = function Var _ -> true | _ -> false

  let is_c_strlen = function
-    | Field (_, fn) ->
+    | Field {fn} ->
        Typ.Fieldname.equal fn (BufferOverrunField.c_strlen ())
    | _ ->
        false


  let is_java_collection_internal_array = function
-    | Field (_, fn) ->
+    | Field {fn} ->
        Typ.Fieldname.equal fn BufferOverrunField.java_collection_internal_array
    | _ ->
        false
@ -260,7 +262,7 @@ module Loc = struct
        true
    | Allocsite a ->
        Allocsite.is_pretty a
-    | Field (loc, _) | StarField {prefix= loc} ->
+    | Field {prefix= loc} | StarField {prefix= loc} ->
        is_pretty loc


@ -276,7 +278,7 @@ module Loc = struct
        of_pvar pvar
    | Symb.SymbolPath.Deref _ | Symb.SymbolPath.Callsite _ ->
        of_allocsite (Allocsite.make_symbol path)
-    | Symb.SymbolPath.Field (fn, path) ->
+    | Symb.SymbolPath.Field {fn; prefix= path} ->
        append_field (of_path path) ~fn
    | Symb.SymbolPath.StarField {last_field= fn; prefix} ->
        append_star_field (of_path prefix) ~fn
@ -290,13 +292,13 @@ module Loc = struct


  let is_field_of ~loc ~field_loc =
-    match field_loc with Field (l, _) | StarField {prefix= l} -> equal loc l | _ -> false
+    match field_loc with Field {prefix= l} | StarField {prefix= l} -> equal loc l | _ -> false


  let is_literal_string = function Allocsite a -> Allocsite.is_literal_string a | _ -> None

  let is_literal_string_strlen = function
-    | Field (l, fn) when Typ.Fieldname.equal (BufferOverrunField.c_strlen ()) fn ->
+    | Field {prefix= l; fn} when Typ.Fieldname.equal (BufferOverrunField.c_strlen ()) fn ->
        is_literal_string l
    | _ ->
        None
@ -307,7 +309,7 @@ module Loc = struct
        Pvar.is_global pvar
    | Var (Var.LogicalVar _) | Allocsite _ ->
        false
-    | Field (loc, _) | StarField {prefix= loc} ->
+    | Field {prefix= loc} | StarField {prefix= loc} ->
        is_global loc


@ -318,7 +320,7 @@ module Loc = struct
        Some (Symb.SymbolPath.of_pvar pvar)
    | Allocsite allocsite ->
        Allocsite.get_path allocsite
-    | Field (l, fn) ->
+    | Field {prefix= l; fn} ->
        Option.map (get_path l) ~f:(fun p -> Symb.SymbolPath.field p fn)
    | StarField {prefix; last_field} ->
        get_path prefix |> Option.map ~f:(fun p -> Symb.SymbolPath.star_field p last_field)
@ -329,7 +331,7 @@ module Loc = struct
        None
    | Allocsite allocsite ->
        Allocsite.get_param_path allocsite
-    | Field (l, fn) ->
+    | Field {prefix= l; fn} ->
        Option.map (get_param_path l) ~f:(fun p -> Symb.SymbolPath.field p fn)
    | StarField {prefix; last_field} ->
        get_param_path prefix |> Option.map ~f:(fun p -> Symb.SymbolPath.star_field p last_field)
@ -342,7 +344,7 @@ module Loc = struct
        Allocsite.represents_multiple_values allocsite
    | Field _ as x when is_c_strlen x || is_java_collection_internal_array x ->
        false
-    | Field (l, _) ->
+    | Field {prefix= l} ->
        represents_multiple_values l
    | StarField _ ->
        true
@ -355,7 +357,7 @@ module Loc = struct
        f pvar
    | Allocsite allocsite ->
        Allocsite.exists_pvar ~f allocsite
-    | Field (l, _) | StarField {prefix= l} ->
+    | Field {prefix= l} | StarField {prefix= l} ->
        exists_pvar ~f l


--- a/infer/src/bufferoverrun/bufferOverrunOndemandEnv.ml
+++ b/infer/src/bufferoverrun/bufferOverrunOndemandEnv.ml
@ -51,7 +51,7 @@ let mk pdesc =
                L.(die InternalError) "Deref of unmodeled type `%a`" Typ.Name.pp typename )
          | _ ->
              L.(die InternalError) "Untyped expression is given." ) )
-      | SPath.Field (fn, x) -> (
+      | SPath.Field {fn; prefix= x} -> (
        match BufferOverrunField.get_type fn with
        | None ->
            let lookup = Tenv.lookup tenv in
@ -70,7 +70,7 @@ let mk pdesc =
    let rec may_last_field = function
      | SPath.Pvar _ | SPath.Deref _ | SPath.Callsite _ ->
          true
-      | SPath.Field (fn, x) | SPath.StarField {last_field= fn; prefix= x} ->
+      | SPath.Field {fn; prefix= x} | SPath.StarField {last_field= fn; prefix= x} ->
          may_last_field x
          && Option.value_map ~default:true (typ_of_param_path x) ~f:(fun parent_typ ->
                 match parent_typ.Typ.desc with
--- a/infer/src/bufferoverrun/bufferOverrunSemantics.ml
+++ b/infer/src/bufferoverrun/bufferOverrunSemantics.ml
@ -415,7 +415,7 @@ and eval_locpath ~mode params p mem =
    | Symb.SymbolPath.Deref (_, p) ->
        let v = eval_sympath_partial ~mode params p mem in
        Val.get_all_locs v
-    | Symb.SymbolPath.Field (fn, p) ->
+    | Symb.SymbolPath.Field {fn; prefix= p} ->
        let locs = eval_locpath ~mode params p mem in
        PowLoc.append_field ~fn locs
    | Symb.SymbolPath.StarField {last_field= fn; prefix} ->
--- a/infer/src/bufferoverrun/symb.ml
+++ b/infer/src/bufferoverrun/symb.ml
@ -32,7 +32,7 @@ module SymbolPath = struct
        type partial =
          | Pvar of Pvar.t
          | Deref of deref_kind * partial
-          | Field of Typ.Fieldname.t * partial
+          | Field of {fn: Typ.Fieldname.t; prefix: partial}
          | Callsite of {ret_typ: Typ.t; cs: CallSite.t}
          | StarField of {last_field: Typ.Fieldname.t; prefix: partial}
        [@@deriving compare]
@ -47,7 +47,7 @@ module SymbolPath = struct
          let rec aux = function
            | Pvar _ | Callsite _ ->
                StarField {last_field= fn; prefix= p0}
-            | Deref (_, p) | Field (_, p) ->
+            | Deref (_, p) | Field {prefix= p} ->
                aux p
            | StarField {last_field} as p when Typ.Fieldname.equal fn last_field ->
                p
@ -60,10 +60,10 @@ module SymbolPath = struct
        let field p0 fn =
          let rec aux = function
            | Pvar _ | Callsite _ ->
-                Field (fn, p0)
-            | Field (fn', _) when Typ.Fieldname.equal fn fn' ->
+                Field {fn; prefix= p0}
+            | Field {fn= fn'} when Typ.Fieldname.equal fn fn' ->
                StarField {last_field= fn; prefix= p0}
-            | Field (_, p) | Deref (_, p) ->
+            | Field {prefix= p} | Deref (_, p) ->
                aux p
            | StarField {last_field} as p when Typ.Fieldname.equal fn last_field ->
                p
@ -76,7 +76,7 @@ module SymbolPath = struct
        type partial = private
          | Pvar of Pvar.t
          | Deref of deref_kind * partial
-          | Field of Typ.Fieldname.t * partial
+          | Field of {fn: Typ.Fieldname.t; prefix: partial}
          | Callsite of {ret_typ: Typ.t; cs: CallSite.t}
          | StarField of {last_field: Typ.Fieldname.t; prefix: partial}
        [@@deriving compare]
@ -116,7 +116,7 @@ module SymbolPath = struct
  let rec get_pvar = function
    | Pvar pvar ->
        Some pvar
-    | Deref (_, partial) | Field (_, partial) | StarField {prefix= partial} ->
+    | Deref (_, partial) | Field {prefix= partial} | StarField {prefix= partial} ->
        get_pvar partial
    | Callsite _ ->
        None
@ -131,10 +131,10 @@ module SymbolPath = struct
        F.fprintf fmt "%a[*]" (pp_partial_paren ~paren:true) p
    | Deref ((Deref_COneValuePointer | Deref_CPointer | Deref_JavaPointer), p) ->
        pp_pointer ~paren fmt p
-    | Field (fn, Deref ((Deref_COneValuePointer | Deref_CPointer), p)) ->
+    | Field {fn; prefix= Deref ((Deref_COneValuePointer | Deref_CPointer), p)} ->
        BufferOverrunField.pp ~pp_lhs:(pp_partial_paren ~paren:true)
          ~pp_lhs_alone:(pp_pointer ~paren) ~sep:"->" fmt p fn
-    | Field (fn, p) ->
+    | Field {fn; prefix= p} ->
        BufferOverrunField.pp ~pp_lhs:(pp_partial_paren ~paren:true)
          ~pp_lhs_alone:(pp_partial_paren ~paren) ~sep:"." fmt p fn
    | Callsite {cs} ->
@ -178,7 +178,7 @@ module SymbolPath = struct
    | Deref (Deref_CPointer, p)
    (* Deref_CPointer is unsound here but avoids many FPs for non-array pointers *)
    | Deref ((Deref_COneValuePointer | Deref_JavaPointer), p)
-    | Field (_, p) ->
+    | Field {prefix= p} ->
        represents_multiple_values p


@ -189,7 +189,7 @@ module SymbolPath = struct
        false
    | Deref ((Deref_ArrayIndex | Deref_CPointer), _) ->
        true
-    | Deref ((Deref_COneValuePointer | Deref_JavaPointer), p) | Field (_, p) ->
+    | Deref ((Deref_COneValuePointer | Deref_JavaPointer), p) | Field {prefix= p} ->
        represents_multiple_values_sound p


@ -198,14 +198,14 @@ module SymbolPath = struct
        true
    | Pvar _ ->
        false
-    | Deref (_, p) | Field (_, p) | StarField {prefix= p} ->
+    | Deref (_, p) | Field {prefix= p} | StarField {prefix= p} ->
        represents_callsite_sound_partial p


  let rec exists_pvar_partial ~f = function
    | Pvar pvar ->
        f pvar
-    | Deref (_, p) | Field (_, p) | StarField {prefix= p} ->
+    | Deref (_, p) | Field {prefix= p} | StarField {prefix= p} ->
        exists_pvar_partial ~f p
    | Callsite _ ->
        false
@ -216,7 +216,7 @@ module SymbolPath = struct
        f (Pvar.to_string pvar)
    | Deref (_, x) ->
        exists_str_partial ~f x
-    | Field (fld, x) | StarField {last_field= fld; prefix= x} ->
+    | Field {fn= fld; prefix= x} | StarField {last_field= fld; prefix= x} ->
        f (Typ.Fieldname.to_string fld) || exists_str_partial ~f x
    | Callsite _ ->
        false
@ -235,7 +235,7 @@ module SymbolPath = struct


  let is_cpp_vector_elem = function
-    | Field (fn, _) ->
+    | Field {fn} ->
        BufferOverrunField.is_cpp_vector_elem fn
    | _ ->
        false
--- a/infer/src/bufferoverrun/symb.mli
+++ b/infer/src/bufferoverrun/symb.mli
@ -25,7 +25,7 @@ module SymbolPath : sig
  type partial = private
    | Pvar of Pvar.t
    | Deref of deref_kind * partial
-    | Field of Typ.Fieldname.t * partial
+    | Field of {fn: Typ.Fieldname.t; prefix: partial}
    | Callsite of {ret_typ: Typ.t; cs: CallSite.t}
    | StarField of {last_field: Typ.Fieldname.t; prefix: partial}
        (**