[ocamlformat] Use ocamlformat from github

Summary:
Install ocamlformat from github as part of `make devsetup`, and use it
for formatting OCaml (and jbuild) code.

Reviewed By: jvillard

Differential Revision: D6092464

fbshipit-source-id: 4ba0845

.ocamlformat

@@ -1,2 +1,3 @@
 margin 100
 sparse true
+version v0.1

CONTRIBUTING.md

@@ -145,7 +145,7 @@ module MF = MarkupFormatter
 
 - Use the `_hum` suffix to flag functions that output human-readable strings.
 
-- Format code with ocamlformat.
+- Format code with [ocamlformat](https://github.com/ocaml-ppx/ocamlformat).
 
 ### C/C++/Objective-C
 

Makefile

@@ -138,17 +138,23 @@ fb-setup:
 	$(QUIET)$(call silent_on_success,Facebook setup,\
 	$(MAKE) -C facebook setup)
 
-OCAMLFORMAT_EXE=facebook/dependencies/ocamlformat/src/_build/opt/ocamlformat.exe
+OCAMLFORMAT_EXE?=ocamlformat
 
 .PHONY: fmt
 fmt:
-	parallel $(OCAMLFORMAT_EXE) --no-warn-error -i ::: $$(git diff --name-only $$(git merge-base origin/master HEAD) | grep "\.mli\?$$")
+	parallel $(OCAMLFORMAT_EXE) -i ::: $$(git diff --name-only $$(git merge-base origin/master HEAD) | grep "\.mli\?$$")
+
+JBUILD_ML:=$(shell find * -name 'jbuild*.in' | grep -v workspace)
+
+.PHONY: fmt_jbuild
+fmt_jbuild:
+	parallel $(OCAMLFORMAT_EXE) -i ::: $(JBUILD_ML)
 
 SRC_ML:=$(shell find * \( -name _build -or -name facebook-clang-plugins -or -path facebook/dependencies \) -not -prune -or -type f -and -name '*'.ml -or -name '*'.mli 2>/dev/null)
 
 .PHONY: fmt_all
 fmt_all:
-	parallel $(OCAMLFORMAT_EXE) --no-warn-error -i ::: $(SRC_ML)
+	parallel $(OCAMLFORMAT_EXE) -i ::: $(SRC_ML) $(JBUILD_ML)
 
 # pre-building these avoids race conditions when building, eg src_build and test_build in parallel
 .PHONY: src_build_common
@@ -584,6 +590,8 @@ devsetup: Makefile.autoconf
 	$(QUIET)[ $(OPAM) != "no" ] || (echo 'No `opam` found, aborting setup.' >&2; exit 1)
 	$(QUIET)$(call silent_on_success,installing $(OPAM_DEV_DEPS),\
 	  OPAMSWITCH=$(OPAMSWITCH); $(OPAM) install --yes --no-checksum user-setup $(OPAM_DEV_DEPS))
+	$(QUIET)$(call silent_on_success,installing ocamlformat,\
+	  OPAMSWITCH=$(OPAMSWITCH); $(OPAM) pin add --yes ocamlformat https://github.com/ocaml-ppx/ocamlformat.git#$$(grep version .ocamlformat | cut -d ' ' -f 2))
 	$(QUIET)echo '$(TERM_INFO)*** Running `opam config setup -a`$(TERM_RESET)' >&2
 	$(QUIET)OPAMSWITCH=$(OPAMSWITCH); $(OPAM) config --yes setup -a
 	$(QUIET)echo '$(TERM_INFO)*** Running `opam user-setup`$(TERM_RESET)' >&2

infer/src/IR/Annot.ml

@@ -53,10 +53,12 @@ module Item = struct
     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 = []
 

infer/src/IR/Attributes.ml

@@ -16,11 +16,13 @@ let int64_of_attributes_kind =
   let int64_two = Int64.of_int 2 in
   function ProcUndefined -> Int64.zero | ProcObjCAccessor -> Int64.one | ProcDefined -> int64_two
 
+
 let proc_kind_of_attr (proc_attributes: ProcAttributes.t) =
   if proc_attributes.is_defined then ProcDefined
   else if Option.is_some proc_attributes.objc_accessor then ProcObjCAccessor
   else ProcUndefined
 
+
 module type Data = sig
   val of_pname : Typ.Procname.t -> Sqlite3.Data.t
 
@@ -38,6 +40,7 @@ module Data : Data = struct
     let default () = Sqlite3.Data.TEXT (Typ.Procname.to_filename pname) in
     Base.Hashtbl.find_or_add pname_to_key pname ~default
 
+
   let of_source_file file = Sqlite3.Data.TEXT (SourceFile.to_string file)
 
   let to_proc_attr = function[@warning "-8"] Sqlite3.Data.BLOB b -> Marshal.from_string b 0
@@ -76,6 +79,7 @@ FROM (
   WHERE attr_kind < :akind
         OR (attr_kind = :akind AND source_file < :sfile) )|}
 
+
 let replace pname_blob akind loc_file attr_blob =
   let replace_stmt = get_replace_statement () in
   Sqlite3.bind replace_stmt 1 (* :pname *) pname_blob
@@ -88,6 +92,7 @@ let replace pname_blob akind loc_file attr_blob =
   |> SqliteUtils.check_sqlite_error ~log:"replace bind proc attributes" ;
   SqliteUtils.sqlite_unit_step ~finalize:false ~log:"Attributes.replace" replace_stmt
 
+
 let get_find_more_defined_statement =
   ResultsDir.register_statement
     {|
@@ -97,6 +102,7 @@ WHERE proc_name = :pname
       AND attr_kind > :akind
 |}
 
+
 let should_try_to_update pname_blob akind =
   let find_stmt = get_find_more_defined_statement () in
   Sqlite3.bind find_stmt 1 (* :pname *) pname_blob
@@ -106,14 +112,17 @@ let should_try_to_update pname_blob akind =
   SqliteUtils.sqlite_result_step ~finalize:false ~log:"Attributes.replace" find_stmt
   |> (* there is no entry with a strictly larger "definedness" for that proc name *) Option.is_none
 
+
 let get_select_statement =
   ResultsDir.register_statement "SELECT proc_attributes FROM attributes WHERE proc_name = :k"
 
+
 let get_select_defined_statement =
   ResultsDir.register_statement
     "SELECT proc_attributes FROM attributes WHERE proc_name = :k AND attr_kind = %Ld"
     (int64_of_attributes_kind ProcDefined)
 
+
 let find ~defined pname_blob =
   let select_stmt = if defined then get_select_defined_statement () else get_select_statement () in
   Sqlite3.bind select_stmt 1 pname_blob
@@ -121,6 +130,7 @@ let find ~defined pname_blob =
   SqliteUtils.sqlite_result_step ~finalize:false ~log:"Attributes.find" select_stmt
   |> Option.map ~f:Data.to_proc_attr
 
+
 let load pname = Data.of_pname pname |> find ~defined:false
 
 let store (attr: ProcAttributes.t) =
@@ -129,26 +139,28 @@ let store (attr: ProcAttributes.t) =
   if should_try_to_update key pkind then
     replace key pkind (Data.of_source_file attr.loc.Location.file) (Data.of_proc_attr attr)
 
+
 let load_defined pname = Data.of_pname pname |> find ~defined:true
 
 let find_file_capturing_procedure pname =
   match load pname with
-  | None
+  | None ->
-   -> None
+      None
-  | Some proc_attributes
+  | Some proc_attributes ->
-   -> let source_file = proc_attributes.ProcAttributes.source_file_captured in
+      let source_file = proc_attributes.ProcAttributes.source_file_captured in
       let source_dir = DB.source_dir_from_source_file source_file in
       let origin =
         (* Procedure coming from include files if it has different location
          than the file where it was captured. *)
         match SourceFile.compare source_file proc_attributes.ProcAttributes.loc.file <> 0 with
-        | true
+        | true ->
-         -> `Include
+            `Include
-        | false
+        | false ->
-         -> `Source
+            `Source
       in
       let cfg_fname = DB.source_dir_get_internal_file source_dir ".cfg" in
       let cfg_fname_exists =
         PVariant.( = ) `Yes (Sys.file_exists (DB.filename_to_string cfg_fname))
       in
       if cfg_fname_exists then Some (source_file, origin) else None
+

infer/src/IR/Binop.ml

@@ -52,83 +52,86 @@ let invertible = function PlusA | PlusPI | MinusA | MinusPI -> true | _ -> false
     If the [binop] operation is not invertible, the function raises Assert_failure. *)
 let invert bop =
   match bop with
-  | PlusA
+  | PlusA ->
-   -> MinusA
+      MinusA
-  | PlusPI
+  | PlusPI ->
-   -> MinusPI
+      MinusPI
-  | MinusA
+  | MinusA ->
-   -> PlusA
+      PlusA
-  | MinusPI
+  | MinusPI ->
-   -> PlusPI
+      PlusPI
-  | _
+  | _ ->
-   -> assert false
+      assert false
+
 
 (** This function returns true if 0 is the right unit of [binop].
     The return value false means "don't know". *)
 let is_zero_runit = function PlusA | PlusPI | MinusA | MinusPI | MinusPP -> true | _ -> false
 
 let text = function
-  | PlusA
+  | PlusA ->
-   -> "+"
+      "+"
-  | PlusPI
+  | PlusPI ->
-   -> "+"
+      "+"
-  | MinusA | MinusPP
+  | MinusA | MinusPP ->
-   -> "-"
+      "-"
-  | MinusPI
+  | MinusPI ->
-   -> "-"
+      "-"
-  | Mult
+  | Mult ->
-   -> "*"
+      "*"
-  | Div
+  | Div ->
-   -> "/"
+      "/"
-  | Mod
+  | Mod ->
-   -> "%"
+      "%"
-  | Shiftlt
+  | Shiftlt ->
-   -> "<<"
+      "<<"
-  | Shiftrt
+  | Shiftrt ->
-   -> ">>"
+      ">>"
-  | Lt
+  | Lt ->
-   -> "<"
+      "<"
-  | Gt
+  | Gt ->
-   -> ">"
+      ">"
-  | Le
+  | Le ->
-   -> "<="
+      "<="
-  | Ge
+  | Ge ->
-   -> ">="
+      ">="
-  | Eq
+  | Eq ->
-   -> "=="
+      "=="
-  | Ne
+  | Ne ->
-   -> "!="
+      "!="
-  | BAnd
+  | BAnd ->
-   -> "&"
+      "&"
-  | BXor
+  | BXor ->
-   -> "^"
+      "^"
-  | BOr
+  | BOr ->
-   -> "|"
+      "|"
-  | LAnd
+  | LAnd ->
-   -> "&&"
+      "&&"
-  | LOr
+  | LOr ->
-   -> "||"
+      "||"
+
 
 (** Pretty print a binary operator. *)
 let str pe binop =
   match pe.Pp.kind with
   | HTML -> (
     match binop with
-    | Ge
+    | Ge ->
-     -> " &gt;= "
+        " &gt;= "
-    | Le
+    | Le ->
-     -> " &lt;= "
+        " &lt;= "
-    | Gt
+    | Gt ->
-     -> " &gt; "
+        " &gt; "
-    | Lt
+    | Lt ->
-     -> " &lt; "
+        " &lt; "
-    | Shiftlt
+    | Shiftlt ->
-     -> " &lt;&lt; "
+        " &lt;&lt; "
-    | Shiftrt
+    | Shiftrt ->
-     -> " &gt;&gt; "
+        " &gt;&gt; "
-    | _
+    | _ ->
-     -> text binop )
+        text binop )
   | LATEX -> (
     match binop with Ge -> " \\geq " | Le -> " \\leq " | _ -> text binop )
-  | _
+  | _ ->
-   -> text binop
+      text binop
+

infer/src/IR/BuiltinDecl.ml

@@ -19,6 +19,7 @@ let create_procname name =
   let pname = Typ.Procname.from_string_c_fun name in
   register pname ; pname
 
+
 let create_objc_class_method class_name method_name =
   let method_kind = Typ.Procname.ObjCClassMethod in
   let tname = Typ.Name.Objc.from_string class_name in
@@ -28,6 +29,7 @@ let create_objc_class_method class_name method_name =
   in
   register pname ; pname
 
+
 let is_declared pname = Typ.Procname.Set.mem pname !builtin_decls
 
 let __array_access = create_procname "__array_access"
@@ -83,6 +85,7 @@ let __objc_cast = create_procname "__objc_cast"
 let __objc_dictionary_literal =
   create_objc_class_method "NSDictionary" "dictionaryWithObjects:forKeys:count:"
 
+
 let __objc_release = create_procname "__objc_release"
 
 let __objc_release_autorelease_pool = create_procname "__objc_release_autorelease_pool"

infer/src/IR/CallFlags.ml

@@ -27,9 +27,11 @@ let pp f cf =
   if cf.cf_virtual then F.fprintf f " virtual" ;
   if cf.cf_noreturn then F.fprintf f " noreturn"
 
+
 let default =
   { cf_virtual= false
   ; cf_interface= false
   ; cf_noreturn= false
   ; cf_is_objc_block= false
   ; cf_targets= [] }
+

infer/src/IR/Cfg.ml

@@ -28,10 +28,13 @@ let find_proc_desc_from_name cfg pname =
   try Some (Typ.Procname.Hash.find cfg.proc_desc_table pname)
   with Not_found -> None
 
+
 (** Create a new procdesc *)
 let create_proc_desc cfg (proc_attributes: ProcAttributes.t) =
   let pdesc = Procdesc.from_proc_attributes ~called_from_cfg:true proc_attributes in
-  add_proc_desc cfg proc_attributes.proc_name pdesc ; pdesc
+  add_proc_desc cfg proc_attributes.proc_name pdesc ;
+  pdesc
+
 
 (** Iterate over all the nodes in the cfg *)
 let iter_all_nodes ?(sorted= false) f cfg =
@@ -49,12 +52,14 @@ let iter_all_nodes ?(sorted= false) f cfg =
     |> List.sort ~cmp:[%compare : Procdesc.t * Procdesc.Node.t]
     |> List.iter ~f:(fun (d, n) -> f d n)
 
+
 (** Get all the procdescs (defined and declared) *)
 let get_all_procs cfg =
   let procs = ref [] in
   let f _ pdesc = procs := pdesc :: !procs in
   iter_proc_desc cfg f ; !procs
 
+
 (** Get the procedures whose body is defined in this cfg *)
 let get_defined_procs cfg = List.filter ~f:Procdesc.is_defined (get_all_procs cfg)
 
@@ -67,12 +72,12 @@ let check_cfg_connectedness cfg =
     let succs = Procdesc.Node.get_succs n in
     let preds = Procdesc.Node.get_preds n in
     match Procdesc.Node.get_kind n with
-    | Procdesc.Node.Start_node _
+    | Procdesc.Node.Start_node _ ->
-     -> Int.equal (List.length succs) 0 || List.length preds > 0
+        Int.equal (List.length succs) 0 || List.length preds > 0
-    | Procdesc.Node.Exit_node _
+    | Procdesc.Node.Exit_node _ ->
-     -> List.length succs > 0 || Int.equal (List.length preds) 0
+        List.length succs > 0 || Int.equal (List.length preds) 0
-    | Procdesc.Node.Stmt_node _ | Procdesc.Node.Prune_node _ | Procdesc.Node.Skip_node _
+    | Procdesc.Node.Stmt_node _ | Procdesc.Node.Prune_node _ | Procdesc.Node.Skip_node _ ->
-     -> Int.equal (List.length succs) 0 || Int.equal (List.length preds) 0
+        Int.equal (List.length succs) 0 || Int.equal (List.length preds) 0
     | Procdesc.Node.Join_node ->
       (* Join node has the exception that it may be without predecessors
          and pointing to an exit node *)
@@ -89,14 +94,17 @@ let check_cfg_connectedness cfg =
   let pdescs = get_all_procs cfg in
   List.iter ~f:do_pdesc pdescs
 
+
 (** Serializer for control flow graphs *)
 let cfg_serializer : cfg Serialization.serializer =
   Serialization.create_serializer Serialization.Key.cfg
 
+
 (** Load a cfg from a file *)
 let load_cfg_from_file (filename: DB.filename) : cfg option =
   Serialization.read_from_file cfg_serializer filename
 
+
 (** Save the .attr files for the procedures in the cfg. *)
 let save_attributes source_file cfg =
   let save_proc pdesc =
@@ -110,6 +118,7 @@ let save_attributes source_file cfg =
   in
   List.iter ~f:save_proc (get_all_procs cfg)
 
+
 (** Inline a synthetic (access or bridge) method. *)
 let inline_synthetic_method ret_id etl pdesc loc_call : Sil.instr option =
   let modified = ref None in
@@ -124,70 +133,72 @@ let inline_synthetic_method ret_id etl pdesc loc_call : Sil.instr option =
     match (instr, ret_id, etl) with
     | ( Sil.Load (_, Exp.Lfield (Exp.Var _, fn, ft), bt, _)
       , Some (ret_id, _)
-      , [(* getter for fields *) (e1, _)] )
+      , [(* getter for fields *) (e1, _)] ) ->
-     -> let instr' = Sil.Load (ret_id, Exp.Lfield (e1, fn, ft), bt, loc_call) in
+        let instr' = Sil.Load (ret_id, Exp.Lfield (e1, fn, ft), bt, loc_call) in
         found instr instr'
     | Sil.Load (_, Exp.Lfield (Exp.Lvar pvar, fn, ft), bt, _), Some (ret_id, _), []
-      when Pvar.is_global pvar
+      when Pvar.is_global pvar ->
-     -> (* getter for static fields *)
+        (* getter for static fields *)
         let instr' = Sil.Load (ret_id, Exp.Lfield (Exp.Lvar pvar, fn, ft), bt, loc_call) in
         found instr instr'
-    | Sil.Store (Exp.Lfield (_, fn, ft), bt, _, _), _, [(* setter for fields *) (e1, _); (e2, _)]
+    | Sil.Store (Exp.Lfield (_, fn, ft), bt, _, _), _, [(* setter for fields *) (e1, _); (e2, _)] ->
-     -> let instr' = Sil.Store (Exp.Lfield (e1, fn, ft), bt, e2, loc_call) in
+        let instr' = Sil.Store (Exp.Lfield (e1, fn, ft), bt, e2, loc_call) in
         found instr instr'
     | Sil.Store (Exp.Lfield (Exp.Lvar pvar, fn, ft), bt, _, _), _, [(e1, _)]
-      when Pvar.is_global pvar
+      when Pvar.is_global pvar ->
-     -> (* setter for static fields *)
+        (* setter for static fields *)
         let instr' = Sil.Store (Exp.Lfield (Exp.Lvar pvar, fn, ft), bt, e1, loc_call) in
         found instr instr'
     | Sil.Call (ret_id', Exp.Const Const.Cfun pn, etl', _, cf), _, _
       when Bool.equal (is_none ret_id) (is_none ret_id')
-           && Int.equal (List.length etl') (List.length etl)
+           && Int.equal (List.length etl') (List.length etl) ->
-     -> let instr' = Sil.Call (ret_id, Exp.Const (Const.Cfun pn), etl, loc_call, cf) in
+        let instr' = Sil.Call (ret_id, Exp.Const (Const.Cfun pn), etl, loc_call, cf) in
         found instr instr'
     | Sil.Call (ret_id', Exp.Const Const.Cfun pn, etl', _, cf), _, _
       when Bool.equal (is_none ret_id) (is_none ret_id')
-           && Int.equal (List.length etl' + 1) (List.length etl)
+           && Int.equal (List.length etl' + 1) (List.length etl) ->
-     -> let etl1 =
+        let etl1 =
           match List.rev etl with
           (* remove last element *)
-          | _ :: l
+          | _ :: l ->
-           -> List.rev l
+              List.rev l
-          | []
+          | [] ->
-           -> assert false
+              assert false
         in
         let instr' = Sil.Call (ret_id, Exp.Const (Const.Cfun pn), etl1, loc_call, cf) in
         found instr instr'
-    | _
+    | _ ->
-     -> ()
+        ()
   in
-  Procdesc.iter_instrs do_instr pdesc ; !modified
+  Procdesc.iter_instrs do_instr pdesc ;
+  !modified
+
 
 (** Find synthetic (access or bridge) Java methods in the procedure and inline them in the cfg. *)
 let proc_inline_synthetic_methods cfg pdesc : unit =
   let instr_inline_synthetic_method = function
     | Sil.Call (ret_id, Exp.Const Const.Cfun pn, etl, loc, _) -> (
       match find_proc_desc_from_name cfg pn with
-      | Some pd
+      | Some pd ->
-       -> let is_access = Typ.Procname.java_is_access_method pn in
+          let is_access = Typ.Procname.java_is_access_method pn in
           let attributes = Procdesc.get_attributes pd in
           let is_synthetic = attributes.is_synthetic_method in
           let is_bridge = attributes.is_bridge_method in
           if is_access || is_bridge || is_synthetic then inline_synthetic_method ret_id etl pd loc
           else None
-      | None
+      | None ->
-       -> None )
+          None )
-    | _
+    | _ ->
-     -> None
+        None
   in
   let node_inline_synthetic_methods node =
     let modified = ref false in
     let do_instr instr =
       match instr_inline_synthetic_method instr with
-      | None
+      | None ->
-       -> instr
+          instr
-      | Some instr'
+      | Some instr' ->
-       -> modified := true ;
+          modified := true ;
           instr'
     in
     let instrs = Procdesc.Node.get_instrs node in
@@ -196,11 +207,13 @@ let proc_inline_synthetic_methods cfg pdesc : unit =
   in
   Procdesc.iter_nodes node_inline_synthetic_methods pdesc
 
+
 (** Inline the java synthetic methods in the cfg *)
 let inline_java_synthetic_methods cfg =
   let f pname pdesc = if Typ.Procname.is_java pname then proc_inline_synthetic_methods cfg pdesc in
   iter_proc_desc cfg f
 
+
 (** compute the list of procedures added or changed in [cfg_new] over [cfg_old] *)
 let mark_unchanged_pdescs cfg_new cfg_old =
   let pdescs_eq (pd1: Procdesc.t) (pd2: Procdesc.t) =
@@ -263,19 +276,22 @@ let mark_unchanged_pdescs cfg_new cfg_old =
   in
   Typ.Procname.Hash.iter mark_pdesc_if_unchanged new_procs
 
+
 (** Save a cfg into a file *)
 let store_cfg_to_file ~source_file (filename: DB.filename) (cfg: cfg) =
   inline_java_synthetic_methods cfg ;
   ( if Config.incremental_procs then
       match load_cfg_from_file filename with
-      | Some old_cfg
+      | Some old_cfg ->
-       -> mark_unchanged_pdescs cfg old_cfg
+          mark_unchanged_pdescs cfg old_cfg
-      | None
+      | None ->
-       -> () ) ;
+          () ) ;
   (* NOTE: it's important to write attribute files to disk before writing .cfg file to disk.
      OndemandCapture module relies on it - it uses existance of .cfg file as a barrier to make
      sure that all attributes were written to disk (but not necessarily flushed) *)
-  save_attributes source_file cfg ; Serialization.write_to_file cfg_serializer filename ~data:cfg
+  save_attributes source_file cfg ;
+  Serialization.write_to_file cfg_serializer filename ~data:cfg
+
 
 (** clone a procedure description and apply the type substitutions where
     the parameters are used *)
@@ -289,10 +305,10 @@ let specialize_types_proc callee_pdesc resolved_pdesc substitutions =
     Typ.mk (Tptr (Typ.mk (Tstruct typename), Typ.Pk_pointer))
   in
   let convert_exp = function
-    | Exp.Lvar origin_pvar
+    | Exp.Lvar origin_pvar ->
-     -> Exp.Lvar (convert_pvar origin_pvar)
+        Exp.Lvar (convert_pvar origin_pvar)
-    | exp
+    | exp ->
-     -> exp
+        exp
   in
   let subst_map = ref Ident.IdentMap.empty in
   let redirect_typename origin_id =
@@ -304,23 +320,23 @@ let specialize_types_proc callee_pdesc resolved_pdesc substitutions =
         ( id
         , (Exp.Lvar origin_pvar as origin_exp)
         , {Typ.desc= Tptr ({desc= Tstruct origin_typename}, Pk_pointer)}
-        , loc )
+        , loc ) ->
-     -> let specialized_typname =
+        let specialized_typname =
           try Mangled.Map.find (Pvar.get_name origin_pvar) substitutions
           with Not_found -> origin_typename
         in
         subst_map := Ident.IdentMap.add id specialized_typname !subst_map ;
         Sil.Load (id, convert_exp origin_exp, mk_ptr_typ specialized_typname, loc) :: instrs
-    | Sil.Load (id, (Exp.Var origin_id as origin_exp), ({Typ.desc= Tstruct _} as origin_typ), loc)
+    | Sil.Load (id, (Exp.Var origin_id as origin_exp), ({Typ.desc= Tstruct _} as origin_typ), loc) ->
-     -> let updated_typ : Typ.t =
+        let updated_typ : Typ.t =
           try Typ.mk ~default:origin_typ (Tstruct (Ident.IdentMap.find origin_id !subst_map))
           with Not_found -> origin_typ
         in
         Sil.Load (id, convert_exp origin_exp, updated_typ, loc) :: instrs
-    | Sil.Load (id, origin_exp, origin_typ, loc)
+    | Sil.Load (id, origin_exp, origin_typ, loc) ->
-     -> Sil.Load (id, convert_exp origin_exp, origin_typ, loc) :: instrs
+        Sil.Load (id, convert_exp origin_exp, origin_typ, loc) :: instrs
-    | Sil.Store (assignee_exp, origin_typ, origin_exp, loc)
+    | Sil.Store (assignee_exp, origin_typ, origin_exp, loc) ->
-     -> let set_instr =
+        let set_instr =
           Sil.Store (convert_exp assignee_exp, origin_typ, convert_exp origin_exp, loc)
         in
         set_instr :: instrs
@@ -330,8 +346,8 @@ let specialize_types_proc callee_pdesc resolved_pdesc substitutions =
         , (Exp.Var id, _) :: origin_args
         , loc
         , call_flags )
-      when call_flags.CallFlags.cf_virtual && redirect_typename id <> None
+      when call_flags.CallFlags.cf_virtual && redirect_typename id <> None ->
-     -> let redirected_typename = Option.value_exn (redirect_typename id) in
+        let redirected_typename = Option.value_exn (redirect_typename id) in
         let redirected_typ = mk_ptr_typ redirected_typename in
         let redirected_pname =
           Typ.Procname.replace_class (Typ.Procname.Java callee_pname_java) redirected_typename
@@ -344,30 +360,30 @@ let specialize_types_proc callee_pdesc resolved_pdesc substitutions =
           Sil.Call (return_ids, Exp.Const (Const.Cfun redirected_pname), args, loc, call_flags)
         in
         call_instr :: instrs
-    | Sil.Call (return_ids, origin_call_exp, origin_args, loc, call_flags)
+    | Sil.Call (return_ids, origin_call_exp, origin_args, loc, call_flags) ->
-     -> let converted_args = List.map ~f:(fun (exp, typ) -> (convert_exp exp, typ)) origin_args in
+        let converted_args = List.map ~f:(fun (exp, typ) -> (convert_exp exp, typ)) origin_args in
         let call_instr =
           Sil.Call (return_ids, convert_exp origin_call_exp, converted_args, loc, call_flags)
         in
         call_instr :: instrs
-    | Sil.Prune (origin_exp, loc, is_true_branch, if_kind)
+    | Sil.Prune (origin_exp, loc, is_true_branch, if_kind) ->
-     -> Sil.Prune (convert_exp origin_exp, loc, is_true_branch, if_kind) :: instrs
+        Sil.Prune (convert_exp origin_exp, loc, is_true_branch, if_kind) :: instrs
-    | Sil.Declare_locals (typed_vars, loc)
+    | Sil.Declare_locals (typed_vars, loc) ->
-     -> let new_typed_vars =
+        let new_typed_vars =
           List.map ~f:(fun (pvar, typ) -> (convert_pvar pvar, typ)) typed_vars
         in
         Sil.Declare_locals (new_typed_vars, loc) :: instrs
-    | Sil.Nullify _ | Abstract _ | Sil.Remove_temps _
+    | Sil.Nullify _ | Abstract _ | Sil.Remove_temps _ ->
-     -> (* these are generated instructions that will be replaced by the preanalysis *)
+        (* these are generated instructions that will be replaced by the preanalysis *)
         instrs
   in
   let convert_node_kind = function
-    | Procdesc.Node.Start_node _
+    | Procdesc.Node.Start_node _ ->
-     -> Procdesc.Node.Start_node resolved_pname
+        Procdesc.Node.Start_node resolved_pname
-    | Procdesc.Node.Exit_node _
+    | Procdesc.Node.Exit_node _ ->
-     -> Procdesc.Node.Exit_node resolved_pname
+        Procdesc.Node.Exit_node resolved_pname
-    | node_kind
+    | node_kind ->
-     -> node_kind
+        node_kind
   in
   let node_map = ref Procdesc.NodeMap.empty in
   let rec convert_node node =
@@ -377,10 +393,10 @@ let specialize_types_proc callee_pdesc resolved_pdesc substitutions =
     Procdesc.create_node resolved_pdesc loc kind instrs
   and loop callee_nodes =
     match callee_nodes with
-    | []
+    | [] ->
-     -> []
+        []
-    | node :: other_node
+    | node :: other_node ->
-     -> let converted_node =
+        let converted_node =
           try Procdesc.NodeMap.find node !node_map
           with Not_found ->
             let new_node = convert_node node
@@ -399,6 +415,7 @@ let specialize_types_proc callee_pdesc resolved_pdesc substitutions =
   ignore (loop [callee_start_node]) ;
   resolved_pdesc
 
+
 (** Creates a copy of a procedure description and a list of type substitutions of the form
     (name, typ) where name is a parameter. The resulting proc desc is isomorphic but
     all the type of the parameters are replaced in the instructions according to the list.
@@ -409,11 +426,11 @@ let specialize_types callee_pdesc resolved_pname args =
     List.fold2_exn
       ~f:(fun (params, subts) (param_name, param_typ) (_, arg_typ) ->
         match arg_typ.Typ.desc with
-        | Tptr ({desc= Tstruct typename}, Pk_pointer)
+        | Tptr ({desc= Tstruct typename}, Pk_pointer) ->
-         -> (* Replace the type of the parameter by the type of the argument *)
+            (* Replace the type of the parameter by the type of the argument *)
             ((param_name, arg_typ) :: params, Mangled.Map.add param_name typename subts)
-        | _
+        | _ ->
-         -> ((param_name, param_typ) :: params, subts))
+            ((param_name, param_typ) :: params, subts))
       ~init:([], Mangled.Map.empty) callee_attributes.formals args
   in
   let resolved_attributes =
@@ -430,7 +447,9 @@ let specialize_types callee_pdesc resolved_pname args =
   in
   specialize_types_proc callee_pdesc resolved_pdesc substitutions
 
+
 let pp_proc_signatures fmt cfg =
   F.fprintf fmt "METHOD SIGNATURES@\n@." ;
   let sorted_procs = List.sort ~cmp:Procdesc.compare (get_all_procs cfg) in
   List.iter ~f:(fun pdesc -> F.fprintf fmt "%a@." Procdesc.pp_signature pdesc) sorted_procs
+

infer/src/IR/Cg.ml

@@ -56,12 +56,14 @@ let add_node g n ~defined =
     in
     Typ.Procname.Hash.add g.node_map n info
 
+
 let remove_node_defined g n =
   try
     let info = Typ.Procname.Hash.find g.node_map n in
     info.defined <- false
   with Not_found -> ()
 
+
 let add_defined_node g n = add_node g n ~defined:true
 
 (** Compute the ancestors of the node, if not already computed *)
@@ -76,14 +78,15 @@ let compute_ancestors g node =
       seen := Typ.Procname.Set.add current !seen ;
       let info = Typ.Procname.Hash.find g current in
       match info.ancestors with
-      | Some ancestors
+      | Some ancestors ->
-       -> result := Typ.Procname.Set.union !result ancestors
+          result := Typ.Procname.Set.union !result ancestors
-      | None
+      | None ->
-       -> result := Typ.Procname.Set.union !result info.parents ;
+          result := Typ.Procname.Set.union !result info.parents ;
           todo := Typ.Procname.Set.union !todo info.parents )
   done ;
   !result
 
+
 (** Compute the heirs of the node, if not already computed *)
 let compute_heirs g node =
   let todo = ref (Typ.Procname.Set.singleton node) in
@@ -96,40 +99,43 @@ let compute_heirs g node =
       seen := Typ.Procname.Set.add current !seen ;
       let info = Typ.Procname.Hash.find g current in
       match info.heirs with
-      | Some heirs
+      | Some heirs ->
-       -> result := Typ.Procname.Set.union !result heirs
+          result := Typ.Procname.Set.union !result heirs
-      | None
+      | None ->
-       -> result := Typ.Procname.Set.union !result info.children ;
+          result := Typ.Procname.Set.union !result info.children ;
           todo := Typ.Procname.Set.union !todo info.children )
   done ;
   !result
 
+
 (** Compute the ancestors of the node, if not pre-computed already *)
 let get_ancestors (g: t) node =
   let info = Typ.Procname.Hash.find g.node_map node in
   match info.ancestors with
-  | None
+  | None ->
-   -> let ancestors = compute_ancestors g.node_map node in
+      let ancestors = compute_ancestors g.node_map node in
       info.ancestors <- Some ancestors ;
       let size = Typ.Procname.Set.cardinal ancestors in
       if size > 1000 then
         L.(debug Analysis Medium) "%a has %d ancestors@." Typ.Procname.pp node size ;
       ancestors
-  | Some ancestors
+  | Some ancestors ->
-   -> ancestors
+      ancestors
+
 
 (** Compute the heirs of the node, if not pre-computed already *)
 let get_heirs (g: t) node =
   let info = Typ.Procname.Hash.find g.node_map node in
   match info.heirs with
-  | None
+  | None ->
-   -> let heirs = compute_heirs g.node_map node in
+      let heirs = compute_heirs g.node_map node in
       info.heirs <- Some heirs ;
       let size = Typ.Procname.Set.cardinal heirs in
       if size > 1000 then L.(debug Analysis Medium) "%a has %d heirs@." Typ.Procname.pp node size ;
       heirs
-  | Some heirs
+  | Some heirs ->
-   -> heirs
+      heirs
+
 
 let node_defined (g: t) n =
   try
@@ -137,6 +143,7 @@ let node_defined (g: t) n =
     info.defined
   with Not_found -> false
 
+
 let add_edge g nfrom nto =
   add_node g nfrom ~defined:false ;
   add_node g nto ~defined:false ;
@@ -145,6 +152,7 @@ let add_edge g nfrom nto =
   info_from.children <- Typ.Procname.Set.add nto info_from.children ;
   info_to.parents <- Typ.Procname.Set.add nfrom info_to.parents
 
+
 (** iterate over the elements of a node_map in node order *)
 let node_map_iter f g =
   let table = ref [] in
@@ -152,30 +160,35 @@ let node_map_iter f g =
   let cmp ((n1: Typ.Procname.t), _) ((n2: Typ.Procname.t), _) = Typ.Procname.compare n1 n2 in
   List.iter ~f:(fun (n, info) -> f n info) (List.sort ~cmp !table)
 
+
 let get_nodes (g: t) =
   let nodes = ref Typ.Procname.Set.empty in
   let f node _ = nodes := Typ.Procname.Set.add node !nodes in
   node_map_iter f g ; !nodes
 
+
 let compute_calls g node =
   { in_calls= Typ.Procname.Set.cardinal (get_ancestors g node)
   ; out_calls= Typ.Procname.Set.cardinal (get_heirs g node) }
 
+
 (** Compute the calls of the node, if not pre-computed already *)
 let get_calls (g: t) node =
   let info = Typ.Procname.Hash.find g.node_map node in
   match info.in_out_calls with
-  | None
+  | None ->
-   -> let calls = compute_calls g node in
+      let calls = compute_calls g node in
       info.in_out_calls <- Some calls ;
       calls
-  | Some calls
+  | Some calls ->
-   -> calls
+      calls
+
 
 let get_all_nodes (g: t) =
   let nodes = Typ.Procname.Set.elements (get_nodes g) in
   List.map ~f:(fun node -> (node, get_calls g node)) nodes
 
+
 let get_nodes_and_calls (g: t) = List.filter ~f:(fun (n, _) -> node_defined g n) (get_all_nodes g)
 
 let node_get_num_ancestors g n = (n, Typ.Procname.Set.cardinal (get_ancestors g n))
@@ -189,6 +202,7 @@ let get_edges (g: t) : ((node * int) * (node * int)) list =
   in
   node_map_iter f g ; !edges
 
+
 (** Return all the children of [n], whether defined or not *)
 let get_all_children (g: t) n = (Typ.Procname.Hash.find g.node_map n).children
 
@@ -208,6 +222,7 @@ let get_nonrecursive_dependents (g: t) n =
   let res = Typ.Procname.Set.filter (node_defined g) res0 in
   res
 
+
 (** Return the ancestors of [n] which are also heirs of [n] *)
 let compute_recursive_dependents (g: t) n =
   let reached_from_n pn = Typ.Procname.Set.mem n (get_ancestors g pn) in
@@ -215,21 +230,24 @@ let compute_recursive_dependents (g: t) n =
   let res = Typ.Procname.Set.filter (node_defined g) res0 in
   res
 
+
 (** Compute the ancestors of [n] which are also heirs of [n], if not pre-computed already *)
 let get_recursive_dependents (g: t) n =
   let info = Typ.Procname.Hash.find g.node_map n in
   match info.recursive_dependents with
-  | None
+  | None ->
-   -> let recursive_dependents = compute_recursive_dependents g n in
+      let recursive_dependents = compute_recursive_dependents g n in
       info.recursive_dependents <- Some recursive_dependents ;
       recursive_dependents
-  | Some recursive_dependents
+  | Some recursive_dependents ->
-   -> recursive_dependents
+      recursive_dependents
+
 
 (** Return the nodes dependent on [n] *)
 let get_dependents (g: t) n =
   Typ.Procname.Set.union (get_nonrecursive_dependents g n) (get_recursive_dependents g n)
 
+
 (** Return all the nodes with their defined children *)
 let get_nodes_and_defined_children (g: t) =
   let nodes = ref Typ.Procname.Set.empty in
@@ -237,6 +255,7 @@ let get_nodes_and_defined_children (g: t) =
   let nodes_list = Typ.Procname.Set.elements !nodes in
   List.map ~f:(fun n -> (n, get_defined_children g n)) nodes_list
 
+
 (** nodes with defined flag, and edges *)
 type nodes_and_edges = (node * bool) list * (node * node) list
 
@@ -251,12 +270,14 @@ let get_nodes_and_edges (g: t) : nodes_and_edges =
   in
   node_map_iter f g ; (!nodes, !edges)
 
+
 (** Return the list of nodes which are defined *)
 let get_defined_nodes (g: t) =
   let nodes, _ = get_nodes_and_edges g in
   let get_node (node, _) = node in
   List.map ~f:get_node (List.filter ~f:(fun (_, defined) -> defined) nodes)
 
+
 (** Return the path of the source file *)
 let get_source (g: t) = g.source
 
@@ -267,26 +288,30 @@ let extend cg_old cg_new =
   List.iter ~f:(fun (node, defined) -> add_node cg_old node ~defined) nodes ;
   List.iter ~f:(fun (nfrom, nto) -> add_edge cg_old nfrom nto) edges
 
+
 (** Begin support for serialization *)
 let callgraph_serializer : (SourceFile.t * nodes_and_edges) Serialization.serializer =
   Serialization.create_serializer Serialization.Key.cg
 
+
 (** Load a call graph from a file *)
 let load_from_file (filename: DB.filename) : t option =
   match Serialization.read_from_file callgraph_serializer filename with
-  | None
+  | None ->
-   -> None
+      None
-  | Some (source, (nodes, edges))
+  | Some (source, (nodes, edges)) ->
-   -> let g = create source in
+      let g = create source in
       List.iter ~f:(fun (node, defined) -> if defined then add_defined_node g node) nodes ;
       List.iter ~f:(fun (nfrom, nto) -> add_edge g nfrom nto) edges ;
       Some g
 
+
 (** Save a call graph into a file *)
 let store_to_file (filename: DB.filename) (call_graph: t) =
   Serialization.write_to_file callgraph_serializer filename
     ~data:(call_graph.source, get_nodes_and_edges call_graph)
 
+
 let pp_graph_dotty (g: t) fmt =
   let nodes_with_calls = get_all_nodes g in
   let get_shape (n, _) = if node_defined g n then "box" else "diamond" in
@@ -303,6 +328,7 @@ let pp_graph_dotty (g: t) fmt =
   List.iter ~f:(fun (s, d) -> F.fprintf fmt "%a -> %a@\n" pp_node s pp_node d) (get_edges g) ;
   F.fprintf fmt "}@."
 
+
 (** Print the call graph as a dotty file. *)
 let save_call_graph_dotty source (g: t) =
   let fname_dot =
@@ -311,3 +337,4 @@ let save_call_graph_dotty source (g: t) =
   let outc = Out_channel.create (DB.filename_to_string fname_dot) in
   let fmt = F.formatter_of_out_channel outc in
   pp_graph_dotty g fmt ; Out_channel.close outc
+

infer/src/IR/Const.ml

@@ -26,34 +26,36 @@ let equal = [%compare.equal : t]
 
 let kind_equal c1 c2 =
   let const_kind_number = function
-    | Cint _
+    | Cint _ ->
-     -> 1
+        1
-    | Cfun _
+    | Cfun _ ->
-     -> 2
+        2
-    | Cstr _
+    | Cstr _ ->
-     -> 3
+        3
-    | Cfloat _
+    | Cfloat _ ->
-     -> 4
+        4
-    | Cclass _
+    | Cclass _ ->
-     -> 5
+        5
   in
   Int.equal (const_kind_number c1) (const_kind_number c2)
 
+
 let pp pe f = function
-  | Cint i
+  | Cint i ->
-   -> IntLit.pp f i
+      IntLit.pp f i
   | Cfun fn -> (
     match pe.Pp.kind with
-    | HTML
+    | HTML ->
-     -> F.fprintf f "_fun_%s" (Escape.escape_xml (Typ.Procname.to_string fn))
+        F.fprintf f "_fun_%s" (Escape.escape_xml (Typ.Procname.to_string fn))
-    | _
+    | _ ->
-     -> F.fprintf f "_fun_%s" (Typ.Procname.to_string fn) )
+        F.fprintf f "_fun_%s" (Typ.Procname.to_string fn) )
-  | Cstr s
+  | Cstr s ->
-   -> F.fprintf f "\"%s\"" (String.escaped s)
+      F.fprintf f "\"%s\"" (String.escaped s)
-  | Cfloat v
+  | Cfloat v ->
-   -> F.fprintf f "%f" v
+      F.fprintf f "%f" v
-  | Cclass c
+  | Cclass c ->
-   -> F.fprintf f "%a" Ident.pp_name c
+      F.fprintf f "%a" Ident.pp_name c
+
 
 let to_string c = F.asprintf "%a" (pp Pp.text) c
 
@@ -62,9 +64,10 @@ let iszero_int_float = function Cint i -> IntLit.iszero i | Cfloat 0.0 -> true |
 let isone_int_float = function Cint i -> IntLit.isone i | Cfloat 1.0 -> true | _ -> false
 
 let isminusone_int_float = function
-  | Cint i
+  | Cint i ->
-   -> IntLit.isminusone i
+      IntLit.isminusone i
-  | Cfloat -1.0
+  | Cfloat -1.0 ->
-   -> true
+      true
-  | _
+  | _ ->
-   -> false
+      false
+

infer/src/IR/DecompiledExp.ml

@@ -40,80 +40,81 @@ let eradicate_java () = Config.eradicate && java ()
 
 (** convert a dexp to a string *)
 let rec to_string = function
-  | Darray (de1, de2)
+  | Darray (de1, de2) ->
-   -> to_string de1 ^ "[" ^ to_string de2 ^ "]"
+      to_string de1 ^ "[" ^ to_string de2 ^ "]"
-  | Dbinop (op, de1, de2)
+  | Dbinop (op, de1, de2) ->
-   -> "(" ^ to_string de1 ^ Binop.str Pp.text op ^ to_string de2 ^ ")"
+      "(" ^ to_string de1 ^ Binop.str Pp.text op ^ to_string de2 ^ ")"
-  | Dconst Cfun pn
+  | Dconst Cfun pn ->
-   -> Typ.Procname.to_simplified_string pn
+      Typ.Procname.to_simplified_string pn
-  | Dconst c
+  | Dconst c ->
-   -> Const.to_string c
+      Const.to_string c
-  | Dderef de
+  | Dderef de ->
-   -> "*" ^ to_string de
+      "*" ^ to_string de
-  | Dfcall (fun_dexp, args, _, {cf_virtual= isvirtual})
+  | Dfcall (fun_dexp, args, _, {cf_virtual= isvirtual}) ->
-   -> let pp_arg fmt de = F.fprintf fmt "%s" (to_string de) in
+      let pp_arg fmt de = F.fprintf fmt "%s" (to_string de) in
       let pp_args fmt des =
         if eradicate_java () then ( if des <> [] then F.fprintf fmt "..." )
         else Pp.comma_seq pp_arg fmt des
       in
       let pp_fun fmt = function
-        | Dconst Cfun pname
+        | Dconst Cfun pname ->
-         -> let s =
+            let s =
               match pname with
-              | Typ.Procname.Java pname_java
+              | Typ.Procname.Java pname_java ->
-               -> Typ.Procname.java_get_method pname_java
+                  Typ.Procname.java_get_method pname_java
-              | _
+              | _ ->
-               -> Typ.Procname.to_string pname
+                  Typ.Procname.to_string pname
             in
             F.fprintf fmt "%s" s
-        | de
+        | de ->
-         -> F.fprintf fmt "%s" (to_string de)
+            F.fprintf fmt "%s" (to_string de)
       in
       let receiver, args' =
         match args with
-        | (Dpvar pv) :: args' when isvirtual && Pvar.is_this pv
+        | (Dpvar pv) :: args' when isvirtual && Pvar.is_this pv ->
-         -> (None, args')
+            (None, args')
-        | a :: args' when isvirtual
+        | a :: args' when isvirtual ->
-         -> (Some a, args')
+            (Some a, args')
-        | _
+        | _ ->
-         -> (None, args)
+            (None, args)
       in
       let pp fmt =
         let pp_receiver fmt = function None -> () | Some arg -> F.fprintf fmt "%a." pp_arg arg in
         F.fprintf fmt "%a%a(%a)" pp_receiver receiver pp_fun fun_dexp pp_args args'
       in
       F.asprintf "%t" pp
-  | Darrow (Dpvar pv, f) when Pvar.is_this pv
+  | Darrow (Dpvar pv, f) when Pvar.is_this pv ->
-   -> (* this->fieldname *)
+      (* this->fieldname *)
       Typ.Fieldname.to_simplified_string f
-  | Darrow (de, f)
+  | Darrow (de, f) ->
-   -> if Typ.Fieldname.is_hidden f then to_string de
+      if Typ.Fieldname.is_hidden f then to_string de
       else if java () then to_string de ^ "." ^ Typ.Fieldname.to_flat_string f
       else to_string de ^ "->" ^ Typ.Fieldname.to_string f
-  | Ddot (Dpvar _, fe) when eradicate_java ()
+  | Ddot (Dpvar _, fe) when eradicate_java () ->
-   -> (* static field access *)
+      (* static field access *)
       Typ.Fieldname.to_simplified_string fe
-  | Ddot (de, f)
+  | Ddot (de, f) ->
-   -> if Typ.Fieldname.is_hidden f then "&" ^ to_string de
+      if Typ.Fieldname.is_hidden f then "&" ^ to_string de
       else if java () then to_string de ^ "." ^ Typ.Fieldname.to_flat_string f
       else to_string de ^ "." ^ Typ.Fieldname.to_string f
-  | Dpvar pv
+  | Dpvar pv ->
-   -> Mangled.to_string (Pvar.get_name pv)
+      Mangled.to_string (Pvar.get_name pv)
-  | Dpvaraddr pv
+  | Dpvaraddr pv ->
-   -> let s =
+      let s =
         if eradicate_java () then Pvar.get_simplified_name pv
         else Mangled.to_string (Pvar.get_name pv)
       in
       let ampersand = if eradicate_java () then "" else "&" in
       ampersand ^ s
-  | Dunop (op, de)
+  | Dunop (op, de) ->
-   -> Unop.str op ^ to_string de
+      Unop.str op ^ to_string de
-  | Dsizeof (typ, _, _)
+  | Dsizeof (typ, _, _) ->
-   -> F.asprintf "%a" (Typ.pp_full Pp.text) typ
+      F.asprintf "%a" (Typ.pp_full Pp.text) typ
-  | Dunknown
+  | Dunknown ->
-   -> "unknown"
+      "unknown"
-  | Dretcall (de, _, _, _)
+  | Dretcall (de, _, _, _) ->
-   -> "returned by " ^ to_string de
+      "returned by " ^ to_string de
+
 
 (** Pretty print a dexp. *)
 let pp fmt de = F.fprintf fmt "%s" (to_string de)
@@ -126,14 +127,16 @@ let pp_vpath pe fmt vpath =
       Io_infer.Html.pp_end_color ()
   else F.fprintf fmt "%a" pp vpath
 
+
 let rec has_tmp_var = function
-  | Dpvar pvar | Dpvaraddr pvar
+  | Dpvar pvar | Dpvaraddr pvar ->
-   -> Pvar.is_frontend_tmp pvar
+      Pvar.is_frontend_tmp pvar
-  | Dderef dexp | Ddot (dexp, _) | Darrow (dexp, _) | Dunop (_, dexp) | Dsizeof (_, Some dexp, _)
+  | Dderef dexp | Ddot (dexp, _) | Darrow (dexp, _) | Dunop (_, dexp) | Dsizeof (_, Some dexp, _) ->
-   -> has_tmp_var dexp
+      has_tmp_var dexp
-  | Darray (dexp1, dexp2) | Dbinop (_, dexp1, dexp2)
+  | Darray (dexp1, dexp2) | Dbinop (_, dexp1, dexp2) ->
-   -> has_tmp_var dexp1 || has_tmp_var dexp2
+      has_tmp_var dexp1 || has_tmp_var dexp2
-  | Dretcall (dexp, dexp_list, _, _) | Dfcall (dexp, dexp_list, _, _)
+  | Dretcall (dexp, dexp_list, _, _) | Dfcall (dexp, dexp_list, _, _) ->
-   -> has_tmp_var dexp || List.exists ~f:has_tmp_var dexp_list
+      has_tmp_var dexp || List.exists ~f:has_tmp_var dexp_list
-  | Dconst _ | Dunknown | Dsizeof (_, None, _)
+  | Dconst _ | Dunknown | Dsizeof (_, None, _) ->
-   -> false
+      false
+

infer/src/IR/Errlog.ml

@@ -32,36 +32,39 @@ let pp_loc_trace fmt l = PrettyPrintable.pp_collection ~pp_item:pp_loc_trace_ele
 let contains_exception loc_trace_elem =
   let pred nt =
     match nt with
-    | Exception _
+    | Exception _ ->
-     -> true
+        true
-    | Condition _ | Procedure_start _ | Procedure_end _
+    | Condition _ | Procedure_start _ | Procedure_end _ ->
-     -> false
+        false
   in
   List.exists ~f:pred loc_trace_elem.lt_node_tags
 
+
 let make_trace_element lt_level lt_loc lt_description lt_node_tags =
   {lt_level; lt_loc; lt_description; lt_node_tags}
 
+
 (** Trace of locations *)
 type loc_trace = loc_trace_elem list
 
 let compute_local_exception_line loc_trace =
   let compute_local_exception_line state step =
     match state with
-    | `Stop _
+    | `Stop _ ->
-     -> state
+        state
-    | `Continue (last_known_step_at_level_zero_opt, line_opt)
+    | `Continue (last_known_step_at_level_zero_opt, line_opt) ->
-     -> let last_known_step_at_level_zero_opt' =
+        let last_known_step_at_level_zero_opt' =
           if Int.equal step.lt_level 0 then Some step else last_known_step_at_level_zero_opt
         in
         match last_known_step_at_level_zero_opt' with
-        | Some step_zero when contains_exception step
+        | Some step_zero when contains_exception step ->
-         -> `Stop (last_known_step_at_level_zero_opt', Some step_zero.lt_loc.line)
+            `Stop (last_known_step_at_level_zero_opt', Some step_zero.lt_loc.line)
-        | _
+        | _ ->
-         -> `Continue (last_known_step_at_level_zero_opt', line_opt)
+            `Continue (last_known_step_at_level_zero_opt', line_opt)
   in
   snd (List_.fold_until ~init:(`Continue (None, None)) ~f:compute_local_exception_line loc_trace)
 
+
 type node_id_key = {node_id: int; node_key: int}
 
 type err_key =
@@ -103,11 +106,13 @@ module ErrLogHash = struct
       Hashtbl.hash
         (key.err_kind, key.in_footprint, key.err_name, Localise.error_desc_hash key.err_desc)
 
+
     let equal key1 key2 =
       [%compare.equal : Exceptions.err_kind * bool * IssueType.t]
         (key1.err_kind, key1.in_footprint, key1.err_name)
         (key2.err_kind, key2.in_footprint, key2.err_name)
       && Localise.error_desc_equal key1.err_desc key2.err_desc
+
   end
 
   include Hashtbl.Make (Key)
@@ -122,6 +127,7 @@ let compare x y =
   let bindings x = ErrLogHash.fold (fun k d l -> (k, d) :: l) x [] in
   [%compare : (ErrLogHash.Key.t * ErrDataSet.t) list] (bindings x) (bindings y)
 
+
 (** Empty error log *)
 let empty () = ErrLogHash.create 13
 
@@ -134,11 +140,13 @@ let iter (f: iter_fun) (err_log: t) =
     (fun err_key set -> ErrDataSet.iter (fun err_data -> f err_key err_data) set)
     err_log
 
+
 let fold (f: err_key -> err_data -> 'a -> 'a) t acc =
   ErrLogHash.fold
     (fun err_key set acc -> ErrDataSet.fold (fun err_data acc -> f err_key err_data acc) set acc)
     t acc
 
+
 (** Return the number of elements in the error log which satisfy [filter] *)
 let size filter (err_log: t) =
   let count = ref 0 in
@@ -148,6 +156,7 @@ let size filter (err_log: t) =
     err_log ;
   !count
 
+
 (** Print errors from error log *)
 let pp_errors fmt (errlog: t) =
   let f key _ =
@@ -156,6 +165,7 @@ let pp_errors fmt (errlog: t) =
   in
   ErrLogHash.iter f errlog
 
+
 (** Print warnings from error log *)
 let pp_warnings fmt (errlog: t) =
   let f key _ =
@@ -164,6 +174,7 @@ let pp_warnings fmt (errlog: t) =
   in
   ErrLogHash.iter f errlog
 
+
 (** Print an error log in html format *)
 let pp_html source path_to_root fmt (errlog: t) =
   let pp_eds fmt err_datas =
@@ -191,15 +202,17 @@ let pp_html source path_to_root fmt (errlog: t) =
   F.fprintf fmt "%aINFOS DURING RE-EXECUTION@\n" Io_infer.Html.pp_hline () ;
   ErrLogHash.iter (pp_err_log false Exceptions.Kinfo) errlog
 
+
 (* I use string in case we want to display a different name to the user*)
 let severity_to_str severity =
   match severity with
-  | Exceptions.High
+  | Exceptions.High ->
-   -> "HIGH"
+      "HIGH"
-  | Exceptions.Medium
+  | Exceptions.Medium ->
-   -> "MEDIUM"
+      "MEDIUM"
-  | Exceptions.Low
+  | Exceptions.Low ->
-   -> "LOW"
+      "LOW"
+
 
 (** Add an error description to the error log unless there is
     one already at the same node + session; return true if added *)
@@ -210,12 +223,16 @@ let add_issue tbl err_key (err_datas: ErrDataSet.t) : bool =
     else (
       ErrLogHash.replace tbl err_key (ErrDataSet.union err_datas current_eds) ;
       true )
-  with Not_found -> ErrLogHash.add tbl err_key err_datas ; true
+  with Not_found ->
+    ErrLogHash.add tbl err_key err_datas ;
+    true
+
 
 (** Update an old error log with a new one *)
 let update errlog_old errlog_new =
   ErrLogHash.iter (fun err_key l -> ignore (add_issue errlog_old err_key l)) errlog_new
 
+
 let log_issue err_kind err_log loc (node_id, node_key) session ltr ?linters_def_file ?doc_url exn =
   let error = Exceptions.recognize_exception exn in
   let err_kind = match error.kind with Some err_kind -> err_kind | _ -> err_kind in
@@ -226,10 +243,10 @@ let log_issue err_kind err_log loc (node_id, node_key) session ltr ?linters_def_
   in
   let hide_memory_error =
     match Localise.error_desc_get_bucket error.description with
-    | Some bucket when String.equal bucket Mleak_buckets.ml_bucket_unknown_origin
+    | Some bucket when String.equal bucket Mleak_buckets.ml_bucket_unknown_origin ->
-     -> not Mleak_buckets.should_raise_leak_unknown_origin
+        not Mleak_buckets.should_raise_leak_unknown_origin
-    | _
+    | _ ->
-     -> false
+        false
   in
   let log_it =
     Exceptions.equal_visibility error.visibility Exceptions.Exn_user
@@ -263,7 +280,8 @@ let log_issue err_kind err_log loc (node_id, node_key) session ltr ?linters_def_
     let print_now () =
       L.(debug Analysis Medium)
         "@\n%a@\n@?"
-        (Exceptions.pp_err ~node_key loc err_kind error.name error.description error.ml_loc) () ;
+        (Exceptions.pp_err ~node_key loc err_kind error.name error.description error.ml_loc)
+        () ;
       if err_kind <> Exceptions.Kerror then
         let warn_str =
           let pp fmt =
@@ -274,17 +292,18 @@ let log_issue err_kind err_log loc (node_id, node_key) session ltr ?linters_def_
         in
         let d =
           match err_kind with
-          | Exceptions.Kerror
+          | Exceptions.Kerror ->
-           -> L.d_error
+              L.d_error
-          | Exceptions.Kwarning
+          | Exceptions.Kwarning ->
-           -> L.d_warning
+              L.d_warning
-          | Exceptions.Kinfo | Exceptions.Kadvice | Exceptions.Klike
+          | Exceptions.Kinfo | Exceptions.Kadvice | Exceptions.Klike ->
-           -> L.d_info
+              L.d_info
         in
         d warn_str ; L.d_ln ()
     in
     if should_print_now then print_now ()
 
+
 type err_log = t
 
 (** Global per-file error table *)
@@ -316,6 +335,7 @@ module Err_table = struct
     let pp ~key:err_string ~data:count = F.fprintf fmt " %s:%d" err_string count in
     String.Map.iteri ~f:pp !err_name_map
 
+
   module LocMap = Caml.Map.Make (struct
     type t = ErrDataSet.elt
 
@@ -333,20 +353,20 @@ module Err_table = struct
     let add_err nslm key =
       let map =
         match (key.in_footprint, key.err_kind) with
-        | true, Exceptions.Kerror
+        | true, Exceptions.Kerror ->
-         -> map_err_fp
+            map_err_fp
-        | false, Exceptions.Kerror
+        | false, Exceptions.Kerror ->
-         -> map_err_re
+            map_err_re
-        | true, Exceptions.Kwarning
+        | true, Exceptions.Kwarning ->
-         -> map_warn_fp
+            map_warn_fp
-        | false, Exceptions.Kwarning
+        | false, Exceptions.Kwarning ->
-         -> map_warn_re
+            map_warn_re
-        | _, Exceptions.Kinfo
+        | _, Exceptions.Kinfo ->
-         -> map_info
+            map_info
-        | _, Exceptions.Kadvice
+        | _, Exceptions.Kadvice ->
-         -> map_advice
+            map_advice
-        | _, Exceptions.Klike
+        | _, Exceptions.Klike ->
-         -> map_likes
+            map_likes
       in
       try
         let err_list = LocMap.find nslm !map in
@@ -378,6 +398,7 @@ module Err_table = struct
     LocMap.iter
       (fun nslm err_names -> F.fprintf fmt "%a" (pp Exceptions.Kwarning nslm) err_names)
       !map_warn_re
+
 end
 
 type err_table = Err_table.t
@@ -393,6 +414,7 @@ let err_table_size_footprint ekind =
   let filter ekind' in_footprint = Exceptions.equal_err_kind ekind ekind' && in_footprint in
   Err_table.table_size filter
 
+
 (** Print stats for the global per-file error table *)
 let pp_err_table_stats ekind = Err_table.pp_stats_footprint ekind
 

infer/src/IR/Exceptions.ml

@@ -24,6 +24,7 @@ let equal_visibility = [%compare.equal : visibility]
 let string_of_visibility vis =
   match vis with Exn_user -> "user" | Exn_developer -> "developer" | Exn_system -> "system"
 
+
 (** severity of bugs *)
 type severity =
   | High  (** high severity bug *)
@@ -160,24 +161,24 @@ type t =
 let recognize_exception exn =
   match exn with
   (* all the static names of errors must be defined in Config.IssueType *)
-  | Abduction_case_not_implemented ml_loc
+  | Abduction_case_not_implemented ml_loc ->
-   -> { name= IssueType.abduction_case_not_implemented
+      { name= IssueType.abduction_case_not_implemented
       ; description= Localise.no_desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_developer
       ; severity= Low
       ; kind= None
       ; category= Nocat }
-  | Context_leak (desc, _)
+  | Context_leak (desc, _) ->
-   -> { name= IssueType.context_leak
+      { name= IssueType.context_leak
       ; description= desc
       ; ml_loc= None
       ; visibility= Exn_user
       ; severity= High
       ; kind= None
       ; category= Nocat }
-  | Analysis_stops (desc, ml_loc_opt)
+  | Analysis_stops (desc, ml_loc_opt) ->
-   -> let visibility = if Config.analysis_stops then Exn_user else Exn_developer in
+      let visibility = if Config.analysis_stops then Exn_user else Exn_developer in
       { name= IssueType.analysis_stops
       ; description= desc
       ; ml_loc= ml_loc_opt
@@ -185,40 +186,40 @@ let recognize_exception exn =
       ; severity= Medium
       ; kind= None
       ; category= Nocat }
-  | Array_of_pointsto ml_loc
+  | Array_of_pointsto ml_loc ->
-   -> { name= IssueType.array_of_pointsto
+      { name= IssueType.array_of_pointsto
       ; description= Localise.no_desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_developer
       ; severity= Low
       ; kind= None
       ; category= Nocat }
-  | Array_out_of_bounds_l1 (desc, ml_loc)
+  | Array_out_of_bounds_l1 (desc, ml_loc) ->
-   -> { name= IssueType.array_out_of_bounds_l1
+      { name= IssueType.array_out_of_bounds_l1
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_user
       ; severity= High
       ; kind= Some Kerror
       ; category= Checker }
-  | Array_out_of_bounds_l2 (desc, ml_loc)
+  | Array_out_of_bounds_l2 (desc, ml_loc) ->
-   -> { name= IssueType.array_out_of_bounds_l2
+      { name= IssueType.array_out_of_bounds_l2
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_user
       ; severity= Medium
       ; kind= None
       ; category= Nocat }
-  | Array_out_of_bounds_l3 (desc, ml_loc)
+  | Array_out_of_bounds_l3 (desc, ml_loc) ->
-   -> { name= IssueType.array_out_of_bounds_l3
+      { name= IssueType.array_out_of_bounds_l3
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_developer
       ; severity= Medium
       ; kind= None
       ; category= Nocat }
-  | Assert_failure (f, l, c)
+  | Assert_failure (f, l, c) ->
-   -> let ml_loc = (f, l, c, c) in
+      let ml_loc = (f, l, c, c) in
       { name= IssueType.assert_failure
       ; description= Localise.no_desc
       ; ml_loc= Some ml_loc
@@ -226,48 +227,48 @@ let recognize_exception exn =
       ; severity= High
       ; kind= None
       ; category= Nocat }
-  | Bad_footprint ml_loc
+  | Bad_footprint ml_loc ->
-   -> { name= IssueType.bad_footprint
+      { name= IssueType.bad_footprint
       ; description= Localise.no_desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_developer
       ; severity= Low
       ; kind= None
       ; category= Nocat }
-  | Cannot_star ml_loc
+  | Cannot_star ml_loc ->
-   -> { name= IssueType.cannot_star
+      { name= IssueType.cannot_star
       ; description= Localise.no_desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_developer
       ; severity= Low
       ; kind= None
       ; category= Nocat }
-  | Class_cast_exception (desc, ml_loc)
+  | Class_cast_exception (desc, ml_loc) ->
-   -> { name= IssueType.class_cast_exception
+      { name= IssueType.class_cast_exception
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_user
       ; severity= High
       ; kind= None
       ; category= Prover }
-  | Codequery desc
+  | Codequery desc ->
-   -> { name= IssueType.codequery
+      { name= IssueType.codequery
       ; description= desc
       ; ml_loc= None
       ; visibility= Exn_user
       ; severity= High
       ; kind= None
       ; category= Prover }
-  | Comparing_floats_for_equality (desc, ml_loc)
+  | Comparing_floats_for_equality (desc, ml_loc) ->
-   -> { name= IssueType.comparing_floats_for_equality
+      { name= IssueType.comparing_floats_for_equality
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_user
       ; severity= Medium
       ; kind= None
       ; category= Nocat }
-  | Condition_always_true_false (desc, b, ml_loc)
+  | Condition_always_true_false (desc, b, ml_loc) ->
-   -> let name = if b then IssueType.condition_always_true else IssueType.condition_always_false in
+      let name = if b then IssueType.condition_always_true else IssueType.condition_always_false in
       { name
       ; description= desc
       ; ml_loc= Some ml_loc
@@ -275,21 +276,21 @@ let recognize_exception exn =
       ; severity= Medium
       ; kind= None
       ; category= Nocat }
-  | Custom_error (error_msg, desc)
+  | Custom_error (error_msg, desc) ->
-   -> { name= IssueType.from_string error_msg
+      { name= IssueType.from_string error_msg
       ; description= desc
       ; ml_loc= None
       ; visibility= Exn_user
       ; severity= High
       ; kind= None
       ; category= Checker }
-  | Dangling_pointer_dereference (dko, desc, ml_loc)
+  | Dangling_pointer_dereference (dko, desc, ml_loc) ->
-   -> let visibility =
+      let visibility =
         match dko with
-        | Some _
+        | Some _ ->
-         -> Exn_user (* only show to the user if the category was identified *)
+            Exn_user (* only show to the user if the category was identified *)
-        | None
+        | None ->
-         -> Exn_developer
+            Exn_developer
       in
       { name= IssueType.dangling_pointer_dereference
       ; description= desc
@@ -298,128 +299,128 @@ let recognize_exception exn =
       ; severity= High
       ; kind= None
       ; category= Prover }
-  | Deallocate_stack_variable desc
+  | Deallocate_stack_variable desc ->
-   -> { name= IssueType.deallocate_stack_variable
+      { name= IssueType.deallocate_stack_variable
       ; description= desc
       ; ml_loc= None
       ; visibility= Exn_user
       ; severity= High
       ; kind= None
       ; category= Prover }
-  | Deallocate_static_memory desc
+  | Deallocate_static_memory desc ->
-   -> { name= IssueType.deallocate_static_memory
+      { name= IssueType.deallocate_static_memory
       ; description= desc
       ; ml_loc= None
       ; visibility= Exn_user
       ; severity= High
       ; kind= None
       ; category= Prover }
-  | Deallocation_mismatch (desc, ml_loc)
+  | Deallocation_mismatch (desc, ml_loc) ->
-   -> { name= IssueType.deallocation_mismatch
+      { name= IssueType.deallocation_mismatch
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_user
       ; severity= High
       ; kind= None
       ; category= Prover }
-  | Divide_by_zero (desc, ml_loc)
+  | Divide_by_zero (desc, ml_loc) ->
-   -> { name= IssueType.divide_by_zero
+      { name= IssueType.divide_by_zero
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_user
       ; severity= High
       ; kind= Some Kerror
       ; category= Checker }
-  | Double_lock (desc, ml_loc)
+  | Double_lock (desc, ml_loc) ->
-   -> { name= IssueType.double_lock
+      { name= IssueType.double_lock
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_user
       ; severity= High
       ; kind= Some Kerror
       ; category= Prover }
-  | Eradicate (kind_s, desc)
+  | Eradicate (kind_s, desc) ->
-   -> { name= IssueType.from_string kind_s
+      { name= IssueType.from_string kind_s
       ; description= desc
       ; ml_loc= None
       ; visibility= Exn_user
       ; severity= High
       ; kind= None
       ; category= Prover }
-  | Empty_vector_access (desc, ml_loc)
+  | Empty_vector_access (desc, ml_loc) ->
-   -> { name= IssueType.empty_vector_access
+      { name= IssueType.empty_vector_access
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_user
       ; severity= High
       ; kind= Some Kerror
       ; category= Prover }
-  | Field_not_null_checked (desc, ml_loc)
+  | Field_not_null_checked (desc, ml_loc) ->
-   -> { name= IssueType.field_not_null_checked
+      { name= IssueType.field_not_null_checked
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_user
       ; severity= Medium
       ; kind= Some Kwarning
       ; category= Nocat }
-  | Frontend_warning ((name, hum), desc, ml_loc)
+  | Frontend_warning ((name, hum), desc, ml_loc) ->
-   -> { name= IssueType.from_string name ?hum
+      { name= IssueType.from_string name ?hum
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_user
       ; severity= Medium
       ; kind= None
       ; category= Linters }
-  | Checkers (kind_s, desc)
+  | Checkers (kind_s, desc) ->
-   -> { name= IssueType.from_string kind_s
+      { name= IssueType.from_string kind_s
       ; description= desc
       ; ml_loc= None
       ; visibility= Exn_user
       ; severity= High
       ; kind= None
       ; category= Prover }
-  | Null_dereference (desc, ml_loc)
+  | Null_dereference (desc, ml_loc) ->
-   -> { name= IssueType.null_dereference
+      { name= IssueType.null_dereference
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_user
       ; severity= High
       ; kind= None
       ; category= Prover }
-  | Null_test_after_dereference (desc, ml_loc)
+  | Null_test_after_dereference (desc, ml_loc) ->
-   -> { name= IssueType.null_test_after_dereference
+      { name= IssueType.null_test_after_dereference
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_user
       ; severity= High
       ; kind= None
       ; category= Nocat }
-  | Pointer_size_mismatch (desc, ml_loc)
+  | Pointer_size_mismatch (desc, ml_loc) ->
-   -> { name= IssueType.pointer_size_mismatch
+      { name= IssueType.pointer_size_mismatch
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_user
       ; severity= High
       ; kind= Some Kerror
       ; category= Checker }
-  | Inherently_dangerous_function desc
+  | Inherently_dangerous_function desc ->
-   -> { name= IssueType.inherently_dangerous_function
+      { name= IssueType.inherently_dangerous_function
       ; description= desc
       ; ml_loc= None
       ; visibility= Exn_developer
       ; severity= Medium
       ; kind= None
       ; category= Nocat }
-  | Internal_error desc
+  | Internal_error desc ->
-   -> { name= IssueType.internal_error
+      { name= IssueType.internal_error
       ; description= desc
       ; ml_loc= None
       ; visibility= Exn_developer
       ; severity= High
       ; kind= None
       ; category= Nocat }
-  | Java_runtime_exception (exn_name, _, desc)
+  | Java_runtime_exception (exn_name, _, desc) ->
-   -> let exn_str = Typ.Name.name exn_name in
+      let exn_str = Typ.Name.name exn_name in
       { name= IssueType.from_string exn_str
       ; description= desc
       ; ml_loc= None
@@ -427,8 +428,8 @@ let recognize_exception exn =
       ; severity= High
       ; kind= None
       ; category= Prover }
-  | Leak (fp_part, _, (exn_vis, error_desc), done_array_abstraction, resource, ml_loc)
+  | Leak (fp_part, _, (exn_vis, error_desc), done_array_abstraction, resource, ml_loc) ->
-   -> if done_array_abstraction then
+      if done_array_abstraction then
         { name= IssueType.leak_after_array_abstraction
         ; description= error_desc
         ; ml_loc= Some ml_loc
@@ -447,14 +448,14 @@ let recognize_exception exn =
       else
         let name =
           match resource with
-          | PredSymb.Rmemory _
+          | PredSymb.Rmemory _ ->
-           -> IssueType.memory_leak
+              IssueType.memory_leak
-          | PredSymb.Rfile
+          | PredSymb.Rfile ->
-           -> IssueType.resource_leak
+              IssueType.resource_leak
-          | PredSymb.Rlock
+          | PredSymb.Rlock ->
-           -> IssueType.resource_leak
+              IssueType.resource_leak
-          | PredSymb.Rignore
+          | PredSymb.Rignore ->
-           -> IssueType.memory_leak
+              IssueType.memory_leak
         in
         { name
         ; description= error_desc
@@ -463,8 +464,8 @@ let recognize_exception exn =
         ; severity= High
         ; kind= None
         ; category= Prover }
-  | Missing_fld (fld, ml_loc)
+  | Missing_fld (fld, ml_loc) ->
-   -> let desc = Localise.verbatim_desc (Typ.Fieldname.to_full_string fld) in
+      let desc = Localise.verbatim_desc (Typ.Fieldname.to_full_string fld) in
       { name= IssueType.missing_fld
       ; description= desc
       ; ml_loc= Some ml_loc
@@ -472,32 +473,32 @@ let recognize_exception exn =
       ; severity= Medium
       ; kind= None
       ; category= Nocat }
-  | Premature_nil_termination (desc, ml_loc)
+  | Premature_nil_termination (desc, ml_loc) ->
-   -> { name= IssueType.premature_nil_termination
+      { name= IssueType.premature_nil_termination
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_user
       ; severity= High
       ; kind= None
       ; category= Prover }
-  | Parameter_not_null_checked (desc, ml_loc)
+  | Parameter_not_null_checked (desc, ml_loc) ->
-   -> { name= IssueType.parameter_not_null_checked
+      { name= IssueType.parameter_not_null_checked
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_user
       ; severity= Medium
       ; kind= Some Kwarning
       ; category= Nocat }
-  | Precondition_not_found (desc, ml_loc)
+  | Precondition_not_found (desc, ml_loc) ->
-   -> { name= IssueType.precondition_not_found
+      { name= IssueType.precondition_not_found
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_developer
       ; severity= Low
       ; kind= None
       ; category= Nocat }
-  | Precondition_not_met (desc, ml_loc)
+  | Precondition_not_met (desc, ml_loc) ->
-   -> { name= IssueType.precondition_not_met
+      { name= IssueType.precondition_not_met
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_developer
@@ -505,72 +506,72 @@ let recognize_exception exn =
       ; kind= Some Kwarning
       ; category= Nocat }
       (* always a warning *)
-  | Retain_cycle (_, desc, ml_loc)
+  | Retain_cycle (_, desc, ml_loc) ->
-   -> { name= IssueType.retain_cycle
+      { name= IssueType.retain_cycle
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_user
       ; severity= High
       ; kind= None
       ; category= Prover }
-  | Registered_observer_being_deallocated (desc, ml_loc)
+  | Registered_observer_being_deallocated (desc, ml_loc) ->
-   -> { name= IssueType.registered_observer_being_deallocated
+      { name= IssueType.registered_observer_being_deallocated
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_user
       ; severity= High
       ; kind= Some Kerror
       ; category= Nocat }
-  | Return_expression_required (desc, ml_loc)
+  | Return_expression_required (desc, ml_loc) ->
-   -> { name= IssueType.return_expression_required
+      { name= IssueType.return_expression_required
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_user
       ; severity= Medium
       ; kind= None
       ; category= Nocat }
-  | Stack_variable_address_escape (desc, ml_loc)
+  | Stack_variable_address_escape (desc, ml_loc) ->
-   -> { name= IssueType.stack_variable_address_escape
+      { name= IssueType.stack_variable_address_escape
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_user
       ; severity= High
       ; kind= Some Kerror
       ; category= Nocat }
-  | Return_statement_missing (desc, ml_loc)
+  | Return_statement_missing (desc, ml_loc) ->
-   -> { name= IssueType.return_statement_missing
+      { name= IssueType.return_statement_missing
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_user
       ; severity= Medium
       ; kind= None
       ; category= Nocat }
-  | Return_value_ignored (desc, ml_loc)
+  | Return_value_ignored (desc, ml_loc) ->
-   -> { name= IssueType.return_value_ignored
+      { name= IssueType.return_value_ignored
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_user
       ; severity= Medium
       ; kind= None
       ; category= Nocat }
-  | SymOp.Analysis_failure_exe _
+  | SymOp.Analysis_failure_exe _ ->
-   -> { name= IssueType.failure_exe
+      { name= IssueType.failure_exe
       ; description= Localise.no_desc
       ; ml_loc= None
       ; visibility= Exn_system
       ; severity= Low
       ; kind= None
       ; category= Nocat }
-  | Skip_function desc
+  | Skip_function desc ->
-   -> { name= IssueType.skip_function
+      { name= IssueType.skip_function
       ; description= desc
       ; ml_loc= None
       ; visibility= Exn_developer
       ; severity= Low
       ; kind= None
       ; category= Nocat }
-  | Skip_pointer_dereference (desc, ml_loc)
+  | Skip_pointer_dereference (desc, ml_loc) ->
-   -> { name= IssueType.skip_pointer_dereference
+      { name= IssueType.skip_pointer_dereference
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_user
@@ -578,72 +579,72 @@ let recognize_exception exn =
       ; kind= Some Kinfo
       ; category= Nocat }
       (* always an info *)
-  | Symexec_memory_error ml_loc
+  | Symexec_memory_error ml_loc ->
-   -> { name= IssueType.symexec_memory_error
+      { name= IssueType.symexec_memory_error
       ; description= Localise.no_desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_developer
       ; severity= Low
       ; kind= None
       ; category= Nocat }
-  | Uninitialized_value (desc, ml_loc)
+  | Uninitialized_value (desc, ml_loc) ->
-   -> { name= IssueType.uninitialized_value
+      { name= IssueType.uninitialized_value
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_user
       ; severity= Medium
       ; kind= None
       ; category= Nocat }
-  | Unary_minus_applied_to_unsigned_expression (desc, ml_loc)
+  | Unary_minus_applied_to_unsigned_expression (desc, ml_loc) ->
-   -> { name= IssueType.unary_minus_applied_to_unsigned_expression
+      { name= IssueType.unary_minus_applied_to_unsigned_expression
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_user
       ; severity= Medium
       ; kind= None
       ; category= Nocat }
-  | Unknown_proc
+  | Unknown_proc ->
-   -> { name= IssueType.unknown_proc
+      { name= IssueType.unknown_proc
       ; description= Localise.no_desc
       ; ml_loc= None
       ; visibility= Exn_developer
       ; severity= Low
       ; kind= None
       ; category= Nocat }
-  | Unreachable_code_after (desc, ml_loc)
+  | Unreachable_code_after (desc, ml_loc) ->
-   -> { name= IssueType.unreachable_code_after
+      { name= IssueType.unreachable_code_after
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_user
       ; severity= Medium
       ; kind= None
       ; category= Nocat }
-  | Unsafe_guarded_by_access (desc, ml_loc)
+  | Unsafe_guarded_by_access (desc, ml_loc) ->
-   -> { name= IssueType.unsafe_guarded_by_access
+      { name= IssueType.unsafe_guarded_by_access
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_user
       ; severity= High
       ; kind= None
       ; category= Prover }
-  | Use_after_free (desc, ml_loc)
+  | Use_after_free (desc, ml_loc) ->
-   -> { name= IssueType.use_after_free
+      { name= IssueType.use_after_free
       ; description= desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_user
       ; severity= High
       ; kind= None
       ; category= Prover }
-  | Wrong_argument_number ml_loc
+  | Wrong_argument_number ml_loc ->
-   -> { name= IssueType.wrong_argument_number
+      { name= IssueType.wrong_argument_number
       ; description= Localise.no_desc
       ; ml_loc= Some ml_loc
       ; visibility= Exn_developer
       ; severity= Low
       ; kind= None
       ; category= Nocat }
-  | exn
+  | exn ->
-   -> { name= IssueType.failure_exe
+      { name= IssueType.failure_exe
       ; description=
           Localise.verbatim_desc (F.asprintf "%a: %s" Exn.pp exn (Caml.Printexc.get_backtrace ()))
       ; ml_loc= None
@@ -652,6 +653,7 @@ let recognize_exception exn =
       ; kind= None
       ; category= Nocat }
 
+
 (** print a description of the exception to the html output *)
 let print_exception_html s exn =
   let error = recognize_exception exn in
@@ -661,29 +663,32 @@ let print_exception_html s exn =
   let desc_str = F.asprintf "%a" Localise.pp_error_desc error.description in
   L.d_strln_color Red (s ^ error.name.IssueType.unique_id ^ " " ^ desc_str ^ ml_loc_string)
 
+
 (** string describing an error kind *)
 let err_kind_string = function
-  | Kwarning
+  | Kwarning ->
-   -> "WARNING"
+      "WARNING"
-  | Kerror
+  | Kerror ->
-   -> "ERROR"
+      "ERROR"
-  | Kinfo
+  | Kinfo ->
-   -> "INFO"
+      "INFO"
-  | Kadvice
+  | Kadvice ->
-   -> "ADVICE"
+      "ADVICE"
-  | Klike
+  | Klike ->
-   -> "LIKE"
+      "LIKE"
+
 
 (** string describing an error class *)
 let err_class_string = function
-  | Checker
+  | Checker ->
-   -> "CHECKER"
+      "CHECKER"
-  | Prover
+  | Prover ->
-   -> "PROVER"
+      "PROVER"
-  | Nocat
+  | Nocat ->
-   -> ""
+      ""
-  | Linters
+  | Linters ->
-   -> "Linters"
+      "Linters"
+
 
 (** whether to print the bug key together with the error message *)
 let print_key = false
@@ -695,7 +700,9 @@ let pp_err ~node_key loc ekind ex_name desc ml_loc_opt fmt () =
   F.fprintf fmt "%a:%d: %s: %a %a%a%a@\n" SourceFile.pp loc.Location.file loc.Location.line kind
     IssueType.pp ex_name Localise.pp_error_desc desc pp_key node_key L.pp_ml_loc_opt ml_loc_opt
 
+
 (** Return true if the exception is not serious and should be handled in timeout mode *)
 let handle_exception exn =
   let error = recognize_exception exn in
   equal_visibility error.visibility Exn_user || equal_visibility error.visibility Exn_developer
+

infer/src/IR/Exceptions.mli

@@ -67,8 +67,7 @@ exception Context_leak of Localise.error_desc * Logging.ml_loc
 
 exception Custom_error of string * Localise.error_desc
 
-exception
+exception Dangling_pointer_dereference of
-  Dangling_pointer_dereference of
   PredSymb.dangling_kind option * Localise.error_desc * Logging.ml_loc
 
 exception Deallocate_stack_variable of Localise.error_desc
@@ -97,8 +96,7 @@ exception Internal_error of Localise.error_desc
 
 exception Java_runtime_exception of Typ.Name.t * string * Localise.error_desc
 
-exception
+exception Leak of
-  Leak of
   bool * Sil.hpred * (visibility * Localise.error_desc) * bool * PredSymb.resource * Logging.ml_loc
 
 exception Missing_fld of Typ.Fieldname.t * Logging.ml_loc

infer/src/IR/Exp.ml

@@ -77,6 +77,7 @@ end)
 let rec is_array_index_of exp1 exp2 =
   match exp1 with Lindex (exp, _) -> is_array_index_of exp exp2 | _ -> equal exp1 exp2
 
+
 let is_null_literal = function Const Cint n -> IntLit.isnull n | _ -> false
 
 let is_this = function Lvar pvar -> Pvar.is_this pvar | _ -> false
@@ -88,65 +89,71 @@ let is_zero = function Const Cint n -> IntLit.iszero n | _ -> false
 (** Turn an expression representing a type into the type it represents
     If not a sizeof, return the default type if given, otherwise raise an exception *)
 let texp_to_typ default_opt = function
-  | Sizeof {typ}
+  | Sizeof {typ} ->
-   -> typ
+      typ
-  | _
+  | _ ->
-   -> Typ.unsome "texp_to_typ" default_opt
+      Typ.unsome "texp_to_typ" default_opt
+
 
 (** Return the root of [lexp]. *)
 let rec root_of_lexp lexp =
   match (lexp : t) with
-  | Var _
+  | Var _ ->
-   -> lexp
+      lexp
-  | Const _
+  | Const _ ->
-   -> lexp
+      lexp
-  | Cast (_, e)
+  | Cast (_, e) ->
-   -> root_of_lexp e
+      root_of_lexp e
-  | UnOp _ | BinOp _ | Exn _ | Closure _
+  | UnOp _ | BinOp _ | Exn _ | Closure _ ->
-   -> lexp
+      lexp
-  | Lvar _
+  | Lvar _ ->
-   -> lexp
+      lexp
-  | Lfield (e, _, _)
+  | Lfield (e, _, _) ->
-   -> root_of_lexp e
+      root_of_lexp e
-  | Lindex (e, _)
+  | Lindex (e, _) ->
-   -> root_of_lexp e
+      root_of_lexp e
-  | Sizeof _
+  | Sizeof _ ->
-   -> lexp
+      lexp
+
 
 (** Checks whether an expression denotes a location by pointer arithmetic.
     Currently, catches array - indexing expressions such as a[i] only. *)
 let rec pointer_arith = function
-  | Lfield (e, _, _)
+  | Lfield (e, _, _) ->
-   -> pointer_arith e
+      pointer_arith e
-  | Lindex _
+  | Lindex _ ->
-   -> true
+      true
-  | _
+  | _ ->
-   -> false
+      false
+
 
 let get_undefined footprint =
   Var (Ident.create_fresh (if footprint then Ident.kfootprint else Ident.kprimed))
 
+
 (** returns true if the expression represents a stack-directed address *)
 let rec is_stack_addr e =
   match (e : t) with
-  | Lvar pv
+  | Lvar pv ->
-   -> not (Pvar.is_global pv)
+      not (Pvar.is_global pv)
-  | UnOp (_, e', _) | Cast (_, e') | Lfield (e', _, _) | Lindex (e', _)
+  | UnOp (_, e', _) | Cast (_, e') | Lfield (e', _, _) | Lindex (e', _) ->
-   -> is_stack_addr e'
+      is_stack_addr e'
-  | _
+  | _ ->
-   -> false
+      false
+
 
 (** returns true if the express operates on address of local variable *)
 let rec has_local_addr e =
   match (e : t) with
-  | Lvar pv
+  | Lvar pv ->
-   -> Pvar.is_local pv
+      Pvar.is_local pv
-  | UnOp (_, e', _) | Cast (_, e') | Lfield (e', _, _)
+  | UnOp (_, e', _) | Cast (_, e') | Lfield (e', _, _) ->
-   -> has_local_addr e'
+      has_local_addr e'
-  | BinOp (_, e0, e1) | Lindex (e0, e1)
+  | BinOp (_, e0, e1) | Lindex (e0, e1) ->
-   -> has_local_addr e0 || has_local_addr e1
+      has_local_addr e0 || has_local_addr e1
-  | _
+  | _ ->
-   -> false
+      false
+
 
 (** Create integer constant *)
 let int i = Const (Cint i)
@@ -185,69 +192,70 @@ let lt e1 e2 = BinOp (Lt, e1, e2)
 let get_vars exp =
   let rec get_vars_ exp vars =
     match exp with
-    | Lvar pvar
+    | Lvar pvar ->
-     -> (fst vars, pvar :: snd vars)
+        (fst vars, pvar :: snd vars)
-    | Var id
+    | Var id ->
-     -> (id :: fst vars, snd vars)
+        (id :: fst vars, snd vars)
-    | Cast (_, e) | UnOp (_, e, _) | Lfield (e, _, _) | Exn e | Sizeof {dynamic_length= Some e}
+    | Cast (_, e) | UnOp (_, e, _) | Lfield (e, _, _) | Exn e | Sizeof {dynamic_length= Some e} ->
-     -> get_vars_ e vars
+        get_vars_ e vars
-    | BinOp (_, e1, e2) | Lindex (e1, e2)
+    | BinOp (_, e1, e2) | Lindex (e1, e2) ->
-     -> get_vars_ e1 vars |> get_vars_ e2
+        get_vars_ e1 vars |> get_vars_ e2
-    | Closure {captured_vars}
+    | Closure {captured_vars} ->
-     -> List.fold
+        List.fold
           ~f:(fun vars_acc (captured_exp, _, _) -> get_vars_ captured_exp vars_acc)
           ~init:vars captured_vars
-    | Const (Cint _ | Cfun _ | Cstr _ | Cfloat _ | Cclass _)
+    | Const (Cint _ | Cfun _ | Cstr _ | Cfloat _ | Cclass _) ->
-     -> vars
+        vars
-    | Sizeof _
+    | Sizeof _ ->
-     -> vars
+        vars
   in
   get_vars_ exp ([], [])
 
+
 (** Pretty print an expression. *)
 let rec pp_ pe pp_t f e =
   let pp_exp = pp_ pe pp_t in
   let print_binop_stm_output e1 op e2 =
     match (op : Binop.t) with
-    | Eq | Ne | PlusA | Mult
+    | Eq | Ne | PlusA | Mult ->
-     -> F.fprintf f "(%a %s %a)" pp_exp e2 (Binop.str pe op) pp_exp e1
+        F.fprintf f "(%a %s %a)" pp_exp e2 (Binop.str pe op) pp_exp e1
-    | Lt
+    | Lt ->
-     -> F.fprintf f "(%a %s %a)" pp_exp e2 (Binop.str pe Gt) pp_exp e1
+        F.fprintf f "(%a %s %a)" pp_exp e2 (Binop.str pe Gt) pp_exp e1
-    | Gt
+    | Gt ->
-     -> F.fprintf f "(%a %s %a)" pp_exp e2 (Binop.str pe Lt) pp_exp e1
+        F.fprintf f "(%a %s %a)" pp_exp e2 (Binop.str pe Lt) pp_exp e1
-    | Le
+    | Le ->
-     -> F.fprintf f "(%a %s %a)" pp_exp e2 (Binop.str pe Ge) pp_exp e1
+        F.fprintf f "(%a %s %a)" pp_exp e2 (Binop.str pe Ge) pp_exp e1
-    | Ge
+    | Ge ->
-     -> F.fprintf f "(%a %s %a)" pp_exp e2 (Binop.str pe Le) pp_exp e1
+        F.fprintf f "(%a %s %a)" pp_exp e2 (Binop.str pe Le) pp_exp e1
-    | _
+    | _ ->
-     -> F.fprintf f "(%a %s %a)" pp_exp e1 (Binop.str pe op) pp_exp e2
+        F.fprintf f "(%a %s %a)" pp_exp e1 (Binop.str pe op) pp_exp e2
   in
   match (e : t) with
-  | Var id
+  | Var id ->
-   -> Ident.pp pe f id
+      Ident.pp pe f id
-  | Const c
+  | Const c ->
-   -> F.fprintf f "%a" (Const.pp pe) c
+      F.fprintf f "%a" (Const.pp pe) c
-  | Cast (typ, e)
+  | Cast (typ, e) ->
-   -> F.fprintf f "(%a)%a" pp_t typ pp_exp e
+      F.fprintf f "(%a)%a" pp_t typ pp_exp e
-  | UnOp (op, e, _)
+  | UnOp (op, e, _) ->
-   -> F.fprintf f "%s%a" (Unop.str op) pp_exp e
+      F.fprintf f "%s%a" (Unop.str op) pp_exp e
-  | BinOp (op, Const c, e2) when Config.smt_output
+  | BinOp (op, Const c, e2) when Config.smt_output ->
-   -> print_binop_stm_output (Const c) op e2
+      print_binop_stm_output (Const c) op e2
-  | BinOp (op, e1, e2)
+  | BinOp (op, e1, e2) ->
-   -> F.fprintf f "(%a %s %a)" pp_exp e1 (Binop.str pe op) pp_exp e2
+      F.fprintf f "(%a %s %a)" pp_exp e1 (Binop.str pe op) pp_exp e2
-  | Exn e
+  | Exn e ->
-   -> F.fprintf f "EXN %a" pp_exp e
+      F.fprintf f "EXN %a" pp_exp e
-  | Closure {name; captured_vars}
+  | Closure {name; captured_vars} ->
-   -> let id_exps = List.map ~f:(fun (id_exp, _, _) -> id_exp) captured_vars in
+      let id_exps = List.map ~f:(fun (id_exp, _, _) -> id_exp) captured_vars in
       F.fprintf f "(%a)" (Pp.comma_seq pp_exp) (Const (Cfun name) :: id_exps)
-  | Lvar pv
+  | Lvar pv ->
-   -> Pvar.pp pe f pv
+      Pvar.pp pe f pv
-  | Lfield (e, fld, _)
+  | Lfield (e, fld, _) ->
-   -> F.fprintf f "%a.%a" pp_exp e Typ.Fieldname.pp fld
+      F.fprintf f "%a.%a" pp_exp e Typ.Fieldname.pp fld
-  | Lindex (e1, e2)
+  | Lindex (e1, e2) ->
-   -> F.fprintf f "%a[%a]" pp_exp e1 pp_exp e2
+      F.fprintf f "%a[%a]" pp_exp e1 pp_exp e2
-  | Sizeof {typ; nbytes; dynamic_length; subtype}
+  | Sizeof {typ; nbytes; dynamic_length; subtype} ->
-   -> let pp_len f l = Option.iter ~f:(F.fprintf f "[%a]" pp_exp) l in
+      let pp_len f l = Option.iter ~f:(F.fprintf f "[%a]" pp_exp) l in
       let pp_size f size = Option.iter ~f:(Int.pp f) size in
       let pp_if b pp label f v = if b then F.fprintf f ";%s=%a" label pp v in
       let pp_if_some pp_opt label f opt = pp_if (Option.is_some opt) pp_opt label f opt in
@@ -257,6 +265,7 @@ let rec pp_ pe pp_t f e =
         (pp_if (not (String.equal "" subt_s)) Subtype.pp "sub_t")
         subtype
 
+
 let pp_printenv pe pp_typ f e = pp_ pe (pp_typ pe) f e
 
 let pp f e = pp_printenv Pp.text Typ.pp f e

infer/src/IR/HilExp.ml

@@ -23,78 +23,81 @@ type t =
   [@@deriving compare]
 
 let rec pp fmt = function
-  | AccessPath access_path
+  | AccessPath access_path ->
-   -> AccessPath.pp fmt access_path
+      AccessPath.pp fmt access_path
-  | UnaryOperator (op, e, _)
+  | UnaryOperator (op, e, _) ->
-   -> F.fprintf fmt "%s%a" (Unop.str op) pp e
+      F.fprintf fmt "%s%a" (Unop.str op) pp e
-  | BinaryOperator (op, e1, e2)
+  | BinaryOperator (op, e1, e2) ->
-   -> F.fprintf fmt "%a %s %a" pp e1 (Binop.str Pp.text op) pp e2
+      F.fprintf fmt "%a %s %a" pp e1 (Binop.str Pp.text op) pp e2
-  | Exception e
+  | Exception e ->
-   -> F.fprintf fmt "exception %a" pp e
+      F.fprintf fmt "exception %a" pp e
-  | Closure (pname, _)
+  | Closure (pname, _) ->
-   -> F.fprintf fmt "closure(%a)" Typ.Procname.pp pname
+      F.fprintf fmt "closure(%a)" Typ.Procname.pp pname
-  | Constant c
+  | Constant c ->
-   -> Const.pp Pp.text fmt c
+      Const.pp Pp.text fmt c
-  | Cast (typ, e)
+  | Cast (typ, e) ->
-   -> F.fprintf fmt "(%a) %a" (Typ.pp_full Pp.text) typ pp e
+      F.fprintf fmt "(%a) %a" (Typ.pp_full Pp.text) typ pp e
-  | Sizeof (typ, length)
+  | Sizeof (typ, length) ->
-   -> let pp_length fmt = Option.iter ~f:(F.fprintf fmt "[%a]" pp) in
+      let pp_length fmt = Option.iter ~f:(F.fprintf fmt "[%a]" pp) in
       F.fprintf fmt "sizeof(%a%a)" (Typ.pp_full Pp.text) typ pp_length length
 
+
 let rec get_typ tenv = function
-  | AccessPath access_path
+  | AccessPath access_path ->
-   -> AccessPath.get_typ access_path tenv
+      AccessPath.get_typ access_path tenv
-  | UnaryOperator (_, _, typ_opt)
+  | UnaryOperator (_, _, typ_opt) ->
-   -> typ_opt
+      typ_opt
-  | BinaryOperator ((Lt | Gt | Le | Ge | Eq | Ne | LAnd | LOr), _, _)
+  | BinaryOperator ((Lt | Gt | Le | Ge | Eq | Ne | LAnd | LOr), _, _) ->
-   -> Some (Typ.mk (Typ.Tint Typ.IBool))
+      Some (Typ.mk (Typ.Tint Typ.IBool))
   | BinaryOperator (_, e1, e2) -> (
     match
       (* TODO: doing this properly will require taking account of language-specific coercion
           semantics. Only return a type when the operands have the same type for now *)
       (get_typ tenv e1, get_typ tenv e2)
     with
-    | Some typ1, Some typ2 when Typ.equal typ1 typ2
+    | Some typ1, Some typ2 when Typ.equal typ1 typ2 ->
-     -> Some typ1
+        Some typ1
-    | _
+    | _ ->
-     -> None )
+        None )
-  | Exception t
+  | Exception t ->
-   -> get_typ tenv t
+      get_typ tenv t
-  | Closure _ | Constant Cfun _
+  | Closure _ | Constant Cfun _ ->
-   -> (* We don't have a way to represent function types *)
+      (* We don't have a way to represent function types *)
       None
-  | Constant Cint _
+  | Constant Cint _ ->
-   -> (* TODO: handle signedness *)
+      (* TODO: handle signedness *)
       Some (Typ.mk (Typ.Tint Typ.IInt))
-  | Constant Cfloat _
+  | Constant Cfloat _ ->
-   -> Some (Typ.mk (Typ.Tfloat Typ.FFloat))
+      Some (Typ.mk (Typ.Tfloat Typ.FFloat))
-  | Constant Cclass _
+  | Constant Cclass _ ->
-   -> (* TODO: this only happens in Java. We probably need to change it to `Cclass of Typ.Name.t`
+      (* TODO: this only happens in Java. We probably need to change it to `Cclass of Typ.Name.t`
          to give a useful result here *)
       None
-  | Constant Cstr _
+  | Constant Cstr _ ->
-   -> (* TODO: this will need to behave differently depending on whether we're in C++ or Java *)
+      (* TODO: this will need to behave differently depending on whether we're in C++ or Java *)
       None
-  | Cast (typ, _)
+  | Cast (typ, _) ->
-   -> Some typ
+      Some typ
-  | Sizeof _
+  | Sizeof _ ->
-   -> (* sizeof returns a size_t, which is an unsigned int *)
+      (* sizeof returns a size_t, which is an unsigned int *)
       Some (Typ.mk (Typ.Tint Typ.IUInt))
 
+
 let get_access_paths exp0 =
   let rec get_access_paths_ exp acc =
     match exp with
-    | AccessPath ap
+    | AccessPath ap ->
-     -> ap :: acc
+        ap :: acc
-    | Cast (_, e) | UnaryOperator (_, e, _) | Exception e | Sizeof (_, Some e)
+    | Cast (_, e) | UnaryOperator (_, e, _) | Exception e | Sizeof (_, Some e) ->
-     -> get_access_paths_ e acc
+        get_access_paths_ e acc
-    | BinaryOperator (_, e1, e2)
+    | BinaryOperator (_, e1, e2) ->
-     -> get_access_paths_ e1 acc |> get_access_paths_ e2
+        get_access_paths_ e1 acc |> get_access_paths_ e2
-    | Closure _ | Constant _ | Sizeof _
+    | Closure _ | Constant _ | Sizeof _ ->
-     -> acc
+        acc
   in
   get_access_paths_ exp0 []
 
+
 (* convert an SIL expression into an HIL expression. the [f_resolve_id] function should map an SSA
    temporary variable to the access path it represents. evaluating the HIL expression should
    produce the same result as evaluating the SIL expression and replacing the temporary variables
@@ -102,29 +105,29 @@ let get_access_paths exp0 =
 let of_sil ~include_array_indexes ~f_resolve_id exp typ =
   let rec of_sil_ (exp: Exp.t) typ =
     match exp with
-    | Var id
+    | Var id ->
-     -> let ap =
+        let ap =
           match f_resolve_id (Var.of_id id) with
-          | Some access_path
+          | Some access_path ->
-           -> access_path
+              access_path
-          | None
+          | None ->
-           -> AccessPath.of_id id typ
+              AccessPath.of_id id typ
         in
         AccessPath ap
-    | UnOp (op, e, typ_opt)
+    | UnOp (op, e, typ_opt) ->
-     -> UnaryOperator (op, of_sil_ e typ, typ_opt)
+        UnaryOperator (op, of_sil_ e typ, typ_opt)
-    | BinOp (op, e0, e1)
+    | BinOp (op, e0, e1) ->
-     -> BinaryOperator (op, of_sil_ e0 typ, of_sil_ e1 typ)
+        BinaryOperator (op, of_sil_ e0 typ, of_sil_ e1 typ)
-    | Exn e
+    | Exn e ->
-     -> Exception (of_sil_ e typ)
+        Exception (of_sil_ e typ)
-    | Const c
+    | Const c ->
-     -> Constant c
+        Constant c
-    | Cast (cast_typ, e)
+    | Cast (cast_typ, e) ->
-     -> Cast (cast_typ, of_sil_ e typ)
+        Cast (cast_typ, of_sil_ e typ)
-    | Sizeof {typ; dynamic_length}
+    | Sizeof {typ; dynamic_length} ->
-     -> Sizeof (typ, Option.map ~f:(fun e -> of_sil_ e typ) dynamic_length)
+        Sizeof (typ, Option.map ~f:(fun e -> of_sil_ e typ) dynamic_length)
-    | Closure closure
+    | Closure closure ->
-     -> let environment =
+        let environment =
           List.map
             ~f:(fun (value, pvar, typ) -> (AccessPath.base_of_pvar pvar typ, of_sil_ value typ))
             closure.captured_vars
@@ -132,38 +135,39 @@ let of_sil ~include_array_indexes ~f_resolve_id exp typ =
         Closure (closure.name, environment)
     | Lfield (root_exp, fld, root_exp_typ) -> (
       match AccessPath.of_lhs_exp ~include_array_indexes exp typ ~f_resolve_id with
-      | Some access_path
+      | Some access_path ->
-       -> AccessPath access_path
+          AccessPath access_path
-      | None
+      | None ->
-       -> (* unsupported field expression: represent with a dummy variable *)
+          (* unsupported field expression: represent with a dummy variable *)
           of_sil_
             (Exp.Lfield
                ( Var (Ident.create_normal (Ident.string_to_name (Exp.to_string root_exp)) 0)
                , fld
                , root_exp_typ )) typ )
-    | Lindex (Const Cstr s, index_exp)
+    | Lindex (Const Cstr s, index_exp) ->
-     -> (* indexed string literal (e.g., "foo"[1]). represent this by introducing a dummy variable
+        (* indexed string literal (e.g., "foo"[1]). represent this by introducing a dummy variable
          for the string literal. if you actually need to see the value of the string literal in the
          analysis, you should probably be using SIL. this is unsound if the code modifies the
          literal, e.g. using `const_cast<char*>` *)
         of_sil_ (Exp.Lindex (Var (Ident.create_normal (Ident.string_to_name s) 0), index_exp)) typ
     | Lindex (root_exp, index_exp) -> (
       match AccessPath.of_lhs_exp ~include_array_indexes exp typ ~f_resolve_id with
-      | Some access_path
+      | Some access_path ->
-       -> AccessPath access_path
+          AccessPath access_path
-      | None
+      | None ->
-       -> (* unsupported index expression: represent with a dummy variable *)
+          (* unsupported index expression: represent with a dummy variable *)
           of_sil_
             (Exp.Lindex
                ( Var (Ident.create_normal (Ident.string_to_name (Exp.to_string root_exp)) 0)
                , index_exp )) typ )
     | Lvar _ ->
       match AccessPath.of_lhs_exp ~include_array_indexes exp typ ~f_resolve_id with
-      | Some access_path
+      | Some access_path ->
-       -> AccessPath access_path
+          AccessPath access_path
-      | None
+      | None ->
-       -> L.(die InternalError) "Couldn't convert var expression %a to access path" Exp.pp exp
+          L.(die InternalError) "Couldn't convert var expression %a to access path" Exp.pp exp
   in
   of_sil_ exp typ
 
+
 let is_null_literal = function Constant Cint n -> IntLit.isnull n | _ -> false

infer/src/IR/HilInstr.ml

@@ -14,10 +14,11 @@ module L = Logging
 type call = Direct of Typ.Procname.t | Indirect of AccessPath.t [@@deriving compare]
 
 let pp_call fmt = function
-  | Direct pname
+  | Direct pname ->
-   -> Typ.Procname.pp fmt pname
+      Typ.Procname.pp fmt pname
-  | Indirect access_path
+  | Indirect access_path ->
-   -> F.fprintf fmt "*%a" AccessPath.pp access_path
+      F.fprintf fmt "*%a" AccessPath.pp access_path
+
 
 type t =
   | Assign of AccessPath.t * HilExp.t * Location.t
@@ -26,15 +27,16 @@ type t =
   [@@deriving compare]
 
 let pp fmt = function
-  | Assign (access_path, exp, loc)
+  | Assign (access_path, exp, loc) ->
-   -> F.fprintf fmt "%a := %a [%a]" AccessPath.pp access_path HilExp.pp exp Location.pp loc
+      F.fprintf fmt "%a := %a [%a]" AccessPath.pp access_path HilExp.pp exp Location.pp loc
-  | Assume (exp, _, _, loc)
+  | Assume (exp, _, _, loc) ->
-   -> F.fprintf fmt "assume %a [%a]" HilExp.pp exp Location.pp loc
+      F.fprintf fmt "assume %a [%a]" HilExp.pp exp Location.pp loc
-  | Call (ret_opt, call, actuals, _, loc)
+  | Call (ret_opt, call, actuals, _, loc) ->
-   -> let pp_ret fmt = Option.iter ~f:(F.fprintf fmt "%a := " AccessPath.pp_base) in
+      let pp_ret fmt = Option.iter ~f:(F.fprintf fmt "%a := " AccessPath.pp_base) in
       let pp_actuals fmt = PrettyPrintable.pp_collection ~pp_item:HilExp.pp fmt in
       F.fprintf fmt "%a%a(%a) [%a]" pp_ret ret_opt pp_call call pp_actuals actuals Location.pp loc
 
+
 type translation = Instr of t | Bind of Var.t * AccessPath.t | Unbind of Var.t list | Ignore
 
 (* convert an SIL instruction into an HIL instruction. the [f_resolve_id] function should map an SSA
@@ -46,29 +48,29 @@ let of_sil ~include_array_indexes ~f_resolve_id (instr: Sil.instr) =
   let analyze_id_assignment lhs_id rhs_exp rhs_typ loc =
     let rhs_hil_exp = exp_of_sil rhs_exp rhs_typ in
     match HilExp.get_access_paths rhs_hil_exp with
-    | [rhs_access_path]
+    | [rhs_access_path] ->
-     -> Bind (lhs_id, rhs_access_path)
+        Bind (lhs_id, rhs_access_path)
-    | _
+    | _ ->
-     -> Instr (Assign (((lhs_id, rhs_typ), []), rhs_hil_exp, loc))
+        Instr (Assign (((lhs_id, rhs_typ), []), rhs_hil_exp, loc))
   in
   match instr with
-  | Load (lhs_id, rhs_exp, rhs_typ, loc)
+  | Load (lhs_id, rhs_exp, rhs_typ, loc) ->
-   -> analyze_id_assignment (Var.of_id lhs_id) rhs_exp rhs_typ loc
+      analyze_id_assignment (Var.of_id lhs_id) rhs_exp rhs_typ loc
-  | Store (Lvar lhs_pvar, lhs_typ, rhs_exp, loc) when Pvar.is_ssa_frontend_tmp lhs_pvar
+  | Store (Lvar lhs_pvar, lhs_typ, rhs_exp, loc) when Pvar.is_ssa_frontend_tmp lhs_pvar ->
-   -> analyze_id_assignment (Var.of_pvar lhs_pvar) rhs_exp lhs_typ loc
+      analyze_id_assignment (Var.of_pvar lhs_pvar) rhs_exp lhs_typ loc
   | Call
       ( Some (ret_id, _)
       , Const Cfun callee_pname
       , (target_exp, _) :: (Sizeof {typ= cast_typ}, _) :: _
       , loc
       , _ )
-    when Typ.Procname.equal callee_pname BuiltinDecl.__cast
+    when Typ.Procname.equal callee_pname BuiltinDecl.__cast ->
-   -> analyze_id_assignment (Var.of_id ret_id) target_exp cast_typ loc
+      analyze_id_assignment (Var.of_id ret_id) target_exp cast_typ loc
-  | Store (lhs_exp, typ, rhs_exp, loc)
+  | Store (lhs_exp, typ, rhs_exp, loc) ->
-   -> let lhs_access_path =
+      let lhs_access_path =
         match exp_of_sil lhs_exp typ with
-        | AccessPath ap
+        | AccessPath ap ->
-         -> ap
+            ap
         | BinaryOperator (_, exp0, exp1) -> (
           match
             (* pointer arithmetic. somewhere in one of the expressions, there should be at least
@@ -77,42 +79,43 @@ let of_sil ~include_array_indexes ~f_resolve_id (instr: Sil.instr) =
                SIL instead *)
             HilExp.get_access_paths exp0
           with
-          | ap :: _
+          | ap :: _ ->
-           -> ap
+              ap
           | [] ->
             match HilExp.get_access_paths exp1 with
-            | ap :: _
+            | ap :: _ ->
-             -> ap
+                ap
-            | []
+            | [] ->
-             -> L.(die InternalError)
+                L.(die InternalError)
                   "Invalid pointer arithmetic expression %a used as LHS" Exp.pp lhs_exp )
-        | _
+        | _ ->
-         -> L.(die InternalError) "Non-assignable LHS expression %a" Exp.pp lhs_exp
+            L.(die InternalError) "Non-assignable LHS expression %a" Exp.pp lhs_exp
       in
       Instr (Assign (lhs_access_path, exp_of_sil rhs_exp typ, loc))
-  | Call (ret_opt, call_exp, formals, loc, call_flags)
+  | Call (ret_opt, call_exp, formals, loc, call_flags) ->
-   -> let hil_ret = Option.map ~f:(fun (ret_id, ret_typ) -> (Var.of_id ret_id, ret_typ)) ret_opt in
+      let hil_ret = Option.map ~f:(fun (ret_id, ret_typ) -> (Var.of_id ret_id, ret_typ)) ret_opt in
       let hil_call =
         match exp_of_sil call_exp (Typ.mk Tvoid) with
-        | Constant Cfun procname | Closure (procname, _)
+        | Constant Cfun procname | Closure (procname, _) ->
-         -> Direct procname
+            Direct procname
-        | AccessPath access_path
+        | AccessPath access_path ->
-         -> Indirect access_path
+            Indirect access_path
-        | call_exp
+        | call_exp ->
-         -> L.(die InternalError) "Unexpected call expression %a" HilExp.pp call_exp
+            L.(die InternalError) "Unexpected call expression %a" HilExp.pp call_exp
       in
       let formals = List.map ~f:(fun (exp, typ) -> exp_of_sil exp typ) formals in
       Instr (Call (hil_ret, hil_call, formals, call_flags, loc))
-  | Prune (exp, loc, true_branch, if_kind)
+  | Prune (exp, loc, true_branch, if_kind) ->
-   -> let hil_exp = exp_of_sil exp (Typ.mk (Tint IBool)) in
+      let hil_exp = exp_of_sil exp (Typ.mk (Tint IBool)) in
       let branch = if true_branch then `Then else `Else in
       Instr (Assume (hil_exp, branch, if_kind, loc))
-  | Nullify (pvar, _)
+  | Nullify (pvar, _) ->
-   -> Unbind [Var.of_pvar pvar]
+      Unbind [Var.of_pvar pvar]
-  | Remove_temps (ids, _)
+  | Remove_temps (ids, _) ->
-   -> Unbind (List.map ~f:Var.of_id ids)
+      Unbind (List.map ~f:Var.of_id ids)
   (* ignoring for now; will translate as builtin function call if needed *)
   | Abstract _
-  | Declare_locals _
+  | Declare_locals _ ->
-   -> (* these don't seem useful for most analyses. can translate them later if we want to *)
+      (* these don't seem useful for most analyses. can translate them later if we want to *)
       Ignore
+

infer/src/IR/Ident.ml

@@ -29,16 +29,17 @@ module Name = struct
   let from_string s = FromString s
 
   let to_string = function
-    | Primed
+    | Primed ->
-     -> primed
+        primed
-    | Normal
+    | Normal ->
-     -> normal
+        normal
-    | Footprint
+    | Footprint ->
-     -> footprint
+        footprint
-    | Spec
+    | Spec ->
-     -> spec
+        spec
-    | FromString s
+    | FromString s ->
-     -> s
+        s
+
 end
 
 type name = Name.t [@@deriving compare]
@@ -75,6 +76,7 @@ type t = {kind: kind; name: Name.t; stamp: int} [@@deriving compare]
 let equal i1 i2 =
   Int.equal i1.stamp i2.stamp && equal_kind i1.kind i2.kind && equal_name i1.name i2.name
 
+
 (** {2 Set for identifiers} *)
 module IdentSet = Caml.Set.Make (struct
   type nonrec t = t
@@ -149,6 +151,7 @@ module NameGenerator = struct
     in
     {kind; name; stamp}
 
+
   (** Make sure that fresh ids after whis one will be with different stamps *)
   let update_name_hash name stamp =
     try
@@ -156,6 +159,7 @@ module NameGenerator = struct
       let new_stamp = max curr_stamp stamp in
       NameHash.replace !name_map name new_stamp
     with Not_found -> NameHash.add !name_map name stamp
+
 end
 
 (** Name used for the return variable *)
@@ -167,9 +171,12 @@ let standard_name kind =
   else if equal_kind kind KFootprint then Name.Footprint
   else Name.Primed
 
+
 (** Every identifier with a given stamp should unltimately be created using this function *)
 let create_with_stamp kind name stamp =
-  NameGenerator.update_name_hash name stamp ; {kind; name; stamp}
+  NameGenerator.update_name_hash name stamp ;
+  {kind; name; stamp}
+
 
 (** Create an identifier with default name for the given kind *)
 let create kind stamp = create_with_stamp kind (standard_name kind) stamp
@@ -210,15 +217,18 @@ let make_unprimed id =
   else if has_kind id KNone then {id with kind= KNone}
   else {id with kind= KNormal}
 
+
 (** Update the name generator so that the given id's are not generated again *)
 let update_name_generator ids =
   let upd id = ignore (create_with_stamp id.kind id.name id.stamp) in
   List.iter ~f:upd ids
 
+
 (** Generate a normal identifier whose name encodes a path given as a string. *)
 let create_path pathstring =
   create_normal (string_to_name ("%path%" ^ pathstring)) path_ident_stamp
 
+
 (** {2 Pretty Printing} *)
 
 (** Convert an identifier to a string. *)
@@ -230,6 +240,7 @@ let to_string id =
     let suffix = "$" ^ string_of_int id.stamp in
     prefix ^ base_name ^ suffix
 
+
 (** Pretty print a name. *)
 let pp_name f name = F.fprintf f "%s" (name_to_string name)
 
@@ -239,10 +250,10 @@ let pp_name_latex style f (name: name) = Latex.pp_string style f (name_to_string
 (** Pretty print an identifier. *)
 let pp pe f id =
   match pe.Pp.kind with
-  | TEXT | HTML
+  | TEXT | HTML ->
-   -> F.fprintf f "%s" (to_string id)
+      F.fprintf f "%s" (to_string id)
-  | LATEX
+  | LATEX ->
-   -> let base_name = name_to_string id.name in
+      let base_name = name_to_string id.name in
       let style =
         if has_kind id KFootprint then Latex.Boldface
         else if has_kind id KNormal then Latex.Roman
@@ -250,6 +261,7 @@ let pp pe f id =
       in
       F.fprintf f "%a_{%s}" (Latex.pp_string style) base_name (string_of_int id.stamp)
 
+
 (** pretty printer for lists of identifiers *)
 let pp_list pe = Pp.comma_seq (pp pe)
 

infer/src/IR/IntLit.ml

@@ -21,24 +21,28 @@ exception OversizedShift
 
 let area u i =
   match (i < 0L, u) with
-  | true, false
+  | true, false ->
-   -> (* only representable as signed *) 1
+      (* only representable as signed *) 1
-  | false, _
+  | false, _ ->
-   -> (* in the intersection between signed and unsigned *) 2
+      (* in the intersection between signed and unsigned *) 2
-  | true, true
+  | true, true ->
-   -> (* only representable as unsigned *) 3
+      (* only representable as unsigned *) 3
+
 
 let to_signed (unsigned, i, ptr) =
   if Int.equal (area unsigned i) 3 then None
   else (* not representable as signed *) Some (false, i, ptr)
 
+
 let compare (unsigned1, i1, _) (unsigned2, i2, _) =
   let n = Bool.compare unsigned1 unsigned2 in
   if n <> 0 then n else Int64.compare i1 i2
 
+
 let compare_value (unsigned1, i1, _) (unsigned2, i2, _) =
   [%compare : int * Int64.t] (area unsigned1 i1, i1) (area unsigned2 i2, i2)
 
+
 let eq i1 i2 = Int.equal (compare_value i1 i2) 0
 
 let neq i1 i2 = compare_value i1 i2 <> 0
@@ -86,6 +90,7 @@ let neg (unsigned, i, ptr) = (unsigned, Int64.neg i, ptr)
 let lift binop (unsigned1, i1, ptr1) (unsigned2, i2, ptr2) =
   (unsigned1 || unsigned2, binop i1 i2, ptr1 || ptr2)
 
+
 let lift1 unop (unsigned, i, ptr) = (unsigned, unop i, ptr)
 
 let add i1 i2 = lift Int64.( + ) i1 i2
@@ -108,25 +113,28 @@ let sub i1 i2 = add i1 (neg i2)
 
 let shift_left (unsigned1, i1, ptr1) (_, i2, _) =
   match Int64.to_int i2 with
-  | None
+  | None ->
-   -> L.(die InternalError) "Shifting failed with operand %a" Int64.pp i2
+      L.(die InternalError) "Shifting failed with operand %a" Int64.pp i2
-  | Some i2
+  | Some i2 ->
-   -> if i2 < 0 || i2 >= 64 then raise OversizedShift ;
+      if i2 < 0 || i2 >= 64 then raise OversizedShift ;
       let res = Int64.shift_left i1 i2 in
       (unsigned1, res, ptr1)
 
+
 let shift_right (unsigned1, i1, ptr1) (_, i2, _) =
   match Int64.to_int i2 with
-  | None
+  | None ->
-   -> L.(die InternalError) "Shifting failed with operand %a" Int64.pp i2
+      L.(die InternalError) "Shifting failed with operand %a" Int64.pp i2
-  | Some i2
+  | Some i2 ->
-   -> if i2 < 0 || i2 >= 64 then raise OversizedShift ;
+      if i2 < 0 || i2 >= 64 then raise OversizedShift ;
       let res = Int64.shift_right i1 i2 in
       (unsigned1, res, ptr1)
 
+
 let pp f (unsigned, n, ptr) =
   if ptr && Int64.equal n 0L then F.fprintf f "null"
   else if unsigned then F.fprintf f "%Lu" n
   else F.fprintf f "%Ld" n
 
+
 let to_string i = F.asprintf "%a" pp i

infer/src/IR/Io_infer.ml

@@ -20,10 +20,10 @@ module Html = struct
   let create pk path =
     let fname, dir_path =
       match List.rev path with
-      | fname :: path_rev
+      | fname :: path_rev ->
-       -> (fname, List.rev ((fname ^ ".html") :: path_rev))
+          (fname, List.rev ((fname ^ ".html") :: path_rev))
-      | []
+      | [] ->
-       -> raise (Failure "Html.create")
+          raise (Failure "Html.create")
     in
     let fd = DB.Results_dir.create_file pk dir_path in
     let outc = Unix.out_channel_of_descr fd in
@@ -84,22 +84,25 @@ td.rowname { text-align:right; font-weight:bold; color:#444444; padding-right:2e
     in
     F.fprintf fmt "%s" s ; (fd, fmt)
 
+
   (** Get the full html filename from a path *)
   let get_full_fname source path =
     let dir_path =
       match List.rev path with
-      | fname :: path_rev
+      | fname :: path_rev ->
-       -> List.rev ((fname ^ ".html") :: path_rev)
+          List.rev ((fname ^ ".html") :: path_rev)
-      | []
+      | [] ->
-       -> raise (Failure "Html.open_out")
+          raise (Failure "Html.open_out")
     in
     DB.Results_dir.path_to_filename (DB.Results_dir.Abs_source_dir source) dir_path
 
+
   (** Open an Html file to append data *)
   let open_out source path =
     let full_fname = get_full_fname source path in
     let fd =
-      Unix.openfile (DB.filename_to_string full_fname)
+      Unix.openfile
+        (DB.filename_to_string full_fname)
         ~mode:Unix.([O_WRONLY; O_APPEND])
         ~perm:0o777
     in
@@ -107,14 +110,19 @@ td.rowname { text-align:right; font-weight:bold; color:#444444; padding-right:2e
     let fmt = F.formatter_of_out_channel outc in
     (fd, fmt)
 
+
   (** Return true if the html file was modified since the beginning of the analysis *)
   let modified_during_analysis source path =
     let fname = get_full_fname source path in
     if DB.file_exists fname then DB.file_modified_time fname >= Config.initial_analysis_time
     else false
 
+
   (** Close an Html file *)
-  let close (fd, fmt) = F.fprintf fmt "</body>@\n</html>@." ; Unix.close fd
+  let close (fd, fmt) =
+    F.fprintf fmt "</body>@\n</html>@." ;
+    Unix.close fd
+
 
   (** Print a horizontal line *)
   let pp_hline fmt () = F.fprintf fmt "<hr width=\"100%%\">@\n"
@@ -136,6 +144,7 @@ td.rowname { text-align:right; font-weight:bold; color:#444444; padding-right:2e
     let pr_str = "<a " ^ name_str ^ "href=\"" ^ link_str ^ "\">" ^ text ^ "</a>" in
     F.fprintf fmt " %s" pr_str
 
+
   (** File name for the node, given the procedure name and node id *)
   let node_filename pname id = Typ.Procname.to_filename pname ^ "_node" ^ string_of_int id
 
@@ -161,10 +170,12 @@ td.rowname { text-align:right; font-weight:bold; color:#444444; padding-right:2e
     in
     pp_link ~path:(path_to_root @ ["nodes"; node_fname]) fmt node_text
 
+
   (** Print an html link to the given proc *)
   let pp_proc_link path_to_root proc_name fmt text =
     pp_link ~path:(path_to_root @ [Typ.Procname.to_filename proc_name]) fmt text
 
+
   (** Print an html link to the given line number of the current source file *)
   let pp_line_link ?(with_name= false) ?(text= None) source path_to_root fmt linenum =
     let fname = DB.source_file_encoding source in
@@ -177,6 +188,7 @@ td.rowname { text-align:right; font-weight:bold; color:#444444; padding-right:2e
       fmt
       (match text with Some s -> s | None -> linenum_str)
 
+
   (** Print an html link given node id and session *)
   let pp_session_link ?(with_name= false) ?proc_name source path_to_root fmt
       (node_id, session, linenum) =
@@ -191,6 +203,7 @@ td.rowname { text-align:right; font-weight:bold; color:#444444; padding-right:2e
       ~pos:(Some pos) ~path:path_to_node fmt
       (node_name ^ "#" ^ pos) ;
     F.fprintf fmt "(%a)" (pp_line_link source path_to_root) linenum
+
 end
 
 (* =============== END of module Html =============== *)
@@ -294,22 +307,23 @@ module Xml = struct
 
   (** print an xml node *)
   let rec pp_node newline indent fmt = function
-    | Tree {name; attributes; forest}
+    | Tree {name; attributes; forest} ->
-     -> let indent' = if String.equal newline "" then "" else indent ^ "  " in
+        let indent' = if String.equal newline "" then "" else indent ^ "  " in
         let space = if List.is_empty attributes then "" else " " in
         let pp_inside fmt () =
           match forest with
-          | []
+          | [] ->
-           -> ()
+              ()
-          | [(String s)]
+          | [(String s)] ->
-           -> pp fmt "%s" s
+              pp fmt "%s" s
-          | _
+          | _ ->
-           -> pp fmt "%s%a%s" newline (pp_forest newline indent') forest indent
+              pp fmt "%s%a%s" newline (pp_forest newline indent') forest indent
         in
         pp fmt "%s<%s%s%a>%a</%s>%s" indent name space pp_attributes attributes pp_inside () name
           newline
-    | String s
+    | String s ->
-     -> F.fprintf fmt "%s%s%s" indent s newline
+        F.fprintf fmt "%s%s%s" indent s newline
+
 
   and pp_forest newline indent fmt forest = List.iter ~f:(pp_node newline indent fmt) forest
 
@@ -327,6 +341,7 @@ module Xml = struct
     if on_several_lines then pp_prelude fmt ;
     pp_node newline "" fmt node ;
     if on_several_lines then pp fmt "@."
+
 end
 
 (* =============== END of module Xml =============== *)

infer/src/IR/LintIssues.ml

@@ -22,13 +22,16 @@ let get_err_log procname =
     errLogMap := Typ.Procname.Map.add procname errlog !errLogMap ;
     errlog
 
+
 let lint_issues_serializer : Errlog.t Typ.Procname.Map.t Serialization.serializer =
   Serialization.create_serializer Serialization.Key.lint_issues
 
+
 (** Save issues to a file *)
 let store_issues filename errLogMap =
   Serialization.write_to_file lint_issues_serializer filename ~data:errLogMap
 
+
 (** Load issues from the given file *)
 let load_issues issues_file = Serialization.read_from_file lint_issues_serializer issues_file
 
@@ -42,21 +45,22 @@ let load_issues_to_errlog_map dir =
   let load_issues_to_map issues_file =
     let file = DB.filename_from_string (Filename.concat issues_dir issues_file) in
     match load_issues file with
-    | Some map
+    | Some map ->
-     -> errLogMap
+        errLogMap
         := Typ.Procname.Map.merge
              (fun _ issues1 issues2 ->
                match (issues1, issues2) with
-               | Some issues1, Some issues2
+               | Some issues1, Some issues2 ->
-                -> Errlog.update issues1 issues2 ; Some issues1
+                   Errlog.update issues1 issues2 ; Some issues1
-               | Some issues1, None
+               | Some issues1, None ->
-                -> Some issues1
+                   Some issues1
-               | None, Some issues2
+               | None, Some issues2 ->
-                -> Some issues2
+                   Some issues2
-               | None, None
+               | None, None ->
-                -> None)
+                   None)
              !errLogMap map
-    | None
+    | None ->
-     -> ()
+        ()
   in
   match children_opt with Some children -> Array.iter ~f:load_issues_to_map children | None -> ()
+

infer/src/IR/Localise.ml

@@ -100,11 +100,13 @@ module Tags = struct
   let get tags tag = List.Assoc.find ~equal:String.equal tags tag
 
   let tag_value_records_of_tags tags =
-    List.map ~f:(fun (tag, value) -> {Jsonbug_t.tag= tag; value}) tags
+    List.map ~f:(fun (tag, value) -> {Jsonbug_t.tag; value}) tags
+
 
   let tags_of_tag_value_records (tag_value_records: Jsonbug_t.tag_value_record list) =
     List.map ~f:(fun {Jsonbug_t.tag; value} -> (tag, value)) tag_value_records
 
+
   let lines_of_tags (tags: t) =
     let line_tags =
       String.Set.of_list
@@ -114,6 +116,7 @@ module Tags = struct
       ~f:(fun (tag, value) ->
         if String.Set.mem line_tags tag then Some (int_of_string value) else None)
       tags
+
 end
 
 type error_desc =
@@ -131,15 +134,18 @@ let custom_desc s tags = {no_desc with descriptions= [s]; tags}
 let custom_desc_with_advice description advice tags =
   {no_desc with descriptions= [description]; advice= Some advice; tags}
 
+
 (** pretty print an error description *)
 let pp_error_desc fmt err_desc =
   let pp_item fmt s = F.fprintf fmt "%s" s in
   Pp.seq pp_item fmt err_desc.descriptions
 
+
 (** pretty print an error advice *)
 let pp_error_advice fmt err_desc =
   match err_desc.advice with Some advice -> F.fprintf fmt "%s" advice | None -> ()
 
+
 (** get tags of error description *)
 let error_desc_get_tags err_desc = err_desc.tags
 
@@ -165,6 +171,7 @@ let error_desc_extract_tag_value err_desc tag_to_extract =
   let find_value tag v = match v with t, _ when String.equal t tag -> true | _ -> false in
   match List.find ~f:(find_value tag_to_extract) err_desc.tags with Some (_, s) -> s | None -> ""
 
+
 let error_desc_to_tag_value_pairs err_desc = err_desc.tags
 
 (** returns the content of the value tag of the error_desc *)
@@ -174,6 +181,7 @@ let error_desc_get_tag_value error_desc = error_desc_extract_tag_value error_des
 let error_desc_get_tag_call_procedure error_desc =
   error_desc_extract_tag_value error_desc Tags.call_procedure
 
+
 (** get the bucket value of an error_desc, if any *)
 let error_desc_get_bucket err_desc = Tags.get err_desc.tags Tags.bucket
 
@@ -186,6 +194,7 @@ let error_desc_set_bucket err_desc bucket =
   in
   {err_desc with descriptions; tags}
 
+
 (** get the value tag, if any *)
 let get_value_line_tag tags =
   try
@@ -194,10 +203,12 @@ let get_value_line_tag tags =
     Some [value; line]
   with Not_found -> None
 
+
 (** extract from desc a value on which to apply polymorphic hash and equality *)
 let desc_get_comparable err_desc =
   match get_value_line_tag err_desc.tags with Some sl' -> sl' | None -> err_desc.descriptions
 
+
 (** hash function for error_desc *)
 let error_desc_hash desc = Hashtbl.hash (desc_get_comparable desc)
 
@@ -205,6 +216,7 @@ let error_desc_hash desc = Hashtbl.hash (desc_get_comparable desc)
 let error_desc_equal desc1 desc2 =
   [%compare.equal : string list] (desc_get_comparable desc1) (desc_get_comparable desc2)
 
+
 let _line_tag tags tag loc =
   let line_str = string_of_int loc.Location.line in
   Tags.update tags tag line_str ;
@@ -214,6 +226,7 @@ let _line_tag tags tag loc =
     s ^ ", column " ^ col_str
   else s
 
+
 let at_line_tag tags tag loc = "at " ^ _line_tag tags tag loc
 
 let _line tags loc = _line_tag tags Tags.line loc
@@ -225,39 +238,45 @@ let call_to tags proc_name =
   Tags.update tags Tags.call_procedure proc_name_str ;
   "call to " ^ MF.monospaced_to_string proc_name_str
 
+
 let call_to_at_line tags proc_name loc =
   call_to tags proc_name ^ " " ^ at_line_tag tags Tags.call_line loc
 
+
 let by_call_to tags proc_name = "by " ^ call_to tags proc_name
 
 let by_call_to_ra tags ra = "by " ^ call_to_at_line tags ra.PredSymb.ra_pname ra.PredSymb.ra_loc
 
 let add_by_call_to_opt problem_str tags proc_name_opt =
   match proc_name_opt with
-  | Some proc_name
+  | Some proc_name ->
-   -> problem_str ^ " " ^ by_call_to tags proc_name
+      problem_str ^ " " ^ by_call_to tags proc_name
-  | None
+  | None ->
-   -> problem_str
+      problem_str
+
 
 let rec format_typ typ =
   match typ.Typ.desc with
-  | Typ.Tptr (t, _) when Config.curr_language_is Config.Java
+  | Typ.Tptr (t, _) when Config.curr_language_is Config.Java ->
-   -> format_typ t
+      format_typ t
-  | Typ.Tstruct name
+  | Typ.Tstruct name ->
-   -> Typ.Name.name name
+      Typ.Name.name name
-  | _
+  | _ ->
-   -> Typ.to_string typ
+      Typ.to_string typ
+
 
 let format_field f =
   if Config.curr_language_is Config.Java then Typ.Fieldname.java_get_field f
   else Typ.Fieldname.to_string f
 
+
 let format_method pname =
   match pname with
-  | Typ.Procname.Java pname_java
+  | Typ.Procname.Java pname_java ->
-   -> Typ.Procname.java_get_method pname_java
+      Typ.Procname.java_get_method pname_java
-  | _
+  | _ ->
-   -> Typ.Procname.to_string pname
+      Typ.Procname.to_string pname
+
 
 let mem_dyn_allocated = "memory dynamically allocated"
 
@@ -280,15 +299,18 @@ let _deref_str_null proc_name_opt _problem_str tags =
   let problem_str = add_by_call_to_opt _problem_str tags proc_name_opt in
   {tags; value_pre= Some (pointer_or_object ()); value_post= None; problem_str}
 
+
 (** dereference strings for null dereference *)
 let deref_str_null proc_name_opt =
   let problem_str = "could be null and is dereferenced" in
   _deref_str_null proc_name_opt problem_str (Tags.create ())
 
+
 let access_str_empty proc_name_opt =
   let problem_str = "could be empty and is accessed" in
   _deref_str_null proc_name_opt problem_str (Tags.create ())
 
+
 (** dereference strings for null dereference due to Nullable annotation *)
 let deref_str_nullable proc_name_opt nullable_obj_str =
   let tags = Tags.create () in
@@ -297,6 +319,7 @@ let deref_str_nullable proc_name_opt nullable_obj_str =
   let problem_str = "" in
   _deref_str_null proc_name_opt problem_str tags
 
+
 (** dereference strings for null dereference due to weak captured variable in block *)
 let deref_str_weak_variable_in_block proc_name_opt nullable_obj_str =
   let tags = Tags.create () in
@@ -304,6 +327,7 @@ let deref_str_weak_variable_in_block proc_name_opt nullable_obj_str =
   let problem_str = "" in
   _deref_str_null proc_name_opt problem_str tags
 
+
 (** dereference strings for nonterminal nil arguments in c/objc variadic methods *)
 let deref_str_nil_argument_in_variadic_method pn total_args arg_number =
   let tags = Tags.create () in
@@ -313,11 +337,13 @@ let deref_str_nil_argument_in_variadic_method pn total_args arg_number =
   let problem_str =
     Printf.sprintf
       "could be %s which results in a call to %s with %d arguments instead of %d (%s indicates that the last argument of this variadic %s has been reached)"
-      nil_null (Typ.Procname.to_simplified_string pn) arg_number (total_args - 1) nil_null
+      nil_null
-      function_method
+      (Typ.Procname.to_simplified_string pn)
+      arg_number (total_args - 1) nil_null function_method
   in
   _deref_str_null None problem_str tags
 
+
 (** dereference strings for an undefined value coming from the given procedure *)
 let deref_str_undef (proc_name, loc) =
   let tags = Tags.create () in
@@ -330,20 +356,21 @@ let deref_str_undef (proc_name, loc) =
       "could be assigned by a call to skip function " ^ proc_name_str
       ^ at_line_tag tags Tags.call_line loc ^ " and is dereferenced or freed" }
 
+
 (** dereference strings for a freed pointer dereference *)
 let deref_str_freed ra =
   let tags = Tags.create () in
   let freed_or_closed_by_call =
     let freed_or_closed =
       match ra.PredSymb.ra_res with
-      | PredSymb.Rmemory _
+      | PredSymb.Rmemory _ ->
-       -> "freed"
+          "freed"
-      | PredSymb.Rfile
+      | PredSymb.Rfile ->
-       -> "closed"
+          "closed"
-      | PredSymb.Rignore
+      | PredSymb.Rignore ->
-       -> "freed"
+          "freed"
-      | PredSymb.Rlock
+      | PredSymb.Rlock ->
-       -> "locked"
+          "locked"
     in
     freed_or_closed ^ " " ^ by_call_to_ra tags ra
   in
@@ -352,24 +379,26 @@ let deref_str_freed ra =
   ; value_post= None
   ; problem_str= "was " ^ freed_or_closed_by_call ^ " and is dereferenced or freed" }
 
+
 (** dereference strings for a dangling pointer dereference *)
 let deref_str_dangling dangling_kind_opt =
   let dangling_kind_prefix =
     match dangling_kind_opt with
-    | Some PredSymb.DAuninit
+    | Some PredSymb.DAuninit ->
-     -> "uninitialized "
+        "uninitialized "
-    | Some PredSymb.DAaddr_stack_var
+    | Some PredSymb.DAaddr_stack_var ->
-     -> "deallocated stack "
+        "deallocated stack "
-    | Some PredSymb.DAminusone
+    | Some PredSymb.DAminusone ->
-     -> "-1 "
+        "-1 "
-    | None
+    | None ->
-     -> ""
+        ""
   in
   { tags= Tags.create ()
   ; value_pre= Some (dangling_kind_prefix ^ pointer_or_object ())
   ; value_post= None
   ; problem_str= "could be dangling and is dereferenced or freed" }
 
+
 (** dereference strings for a pointer size mismatch *)
 let deref_str_pointer_size_mismatch typ_from_instr typ_of_object =
   let str_from_typ typ =
@@ -382,52 +411,58 @@ let deref_str_pointer_size_mismatch typ_from_instr typ_of_object =
   ; problem_str= "could be used to access an object of smaller type " ^ str_from_typ typ_of_object
   }
 
+
 (** dereference strings for an array out of bound access *)
 let deref_str_array_bound size_opt index_opt =
   let tags = Tags.create () in
   let size_str_opt =
     match size_opt with
-    | Some n
+    | Some n ->
-     -> let n_str = IntLit.to_string n in
+        let n_str = IntLit.to_string n in
-        Tags.update tags Tags.array_size n_str ; Some ("of size " ^ n_str)
+        Tags.update tags Tags.array_size n_str ;
-    | None
+        Some ("of size " ^ n_str)
-     -> None
+    | None ->
+        None
   in
   let index_str =
     match index_opt with
-    | Some n
+    | Some n ->
-     -> let n_str = IntLit.to_string n in
+        let n_str = IntLit.to_string n in
-        Tags.update tags Tags.array_index n_str ; "index " ^ n_str
+        Tags.update tags Tags.array_index n_str ;
-    | None
+        "index " ^ n_str
-     -> "an index"
+    | None ->
+        "an index"
   in
   { tags
   ; value_pre= Some "array"
   ; value_post= size_str_opt
   ; problem_str= "could be accessed with " ^ index_str ^ " out of bounds" }
 
+
 (** dereference strings for an uninitialized access whose lhs has the given attribute *)
 let deref_str_uninitialized alloc_att_opt =
   let tags = Tags.create () in
   let creation_str =
     match alloc_att_opt with
-    | Some Sil.Apred (Aresource ({ra_kind= Racquire} as ra), _)
+    | Some Sil.Apred (Aresource ({ra_kind= Racquire} as ra), _) ->
-     -> "after allocation " ^ by_call_to_ra tags ra
+        "after allocation " ^ by_call_to_ra tags ra
-    | _
+    | _ ->
-     -> "after declaration"
+        "after declaration"
   in
   { tags
   ; value_pre= Some "value"
   ; value_post= None
   ; problem_str= "was not initialized " ^ creation_str ^ " and is used" }
 
+
 (** Java unchecked exceptions errors *)
 let java_unchecked_exn_desc proc_name exn_name pre_str : error_desc =
   { no_desc with
     descriptions=
       [ MF.monospaced_to_string (Typ.Procname.to_string proc_name)
-      ; ("can throw " ^ MF.monospaced_to_string (Typ.Name.name exn_name))
+      ; "can throw " ^ MF.monospaced_to_string (Typ.Name.name exn_name)
-      ; ("whenever " ^ pre_str) ] }
+      ; "whenever " ^ pre_str ] }
+
 
 let desc_context_leak pname context_typ fieldname leak_path : error_desc =
   let fld_str = Typ.Fieldname.to_string fieldname in
@@ -435,10 +470,10 @@ let desc_context_leak pname context_typ fieldname leak_path : error_desc =
   let leak_path_entry_to_str acc entry =
     let entry_str =
       match entry with
-      | Some fld, _
+      | Some fld, _ ->
-       -> Typ.Fieldname.to_string fld
+          Typ.Fieldname.to_string fld
-      | None, typ
+      | None, typ ->
-       -> Typ.to_string typ
+          Typ.to_string typ
     in
     (* intentionally omit space; [typ_to_string] adds an extra space *)
     acc ^ entry_str ^ " |->\n"
@@ -454,16 +489,18 @@ let desc_context_leak pname context_typ fieldname leak_path : error_desc =
   let preamble =
     let pname_str =
       match pname with
-      | Typ.Procname.Java pname_java
+      | Typ.Procname.Java pname_java ->
-       -> MF.monospaced_to_string
+          MF.monospaced_to_string
-            (Printf.sprintf "%s.%s" (Typ.Procname.java_get_class_name pname_java)
+            (Printf.sprintf "%s.%s"
+               (Typ.Procname.java_get_class_name pname_java)
                (Typ.Procname.java_get_method pname_java))
-      | _
+      | _ ->
-       -> ""
+          ""
     in
     "Context " ^ context_str ^ " may leak during method " ^ pname_str ^ ":\n"
   in
-  {no_desc with descriptions= [(preamble ^ MF.code_to_string (leak_root ^ path_str))]}
+  {no_desc with descriptions= [preamble ^ MF.code_to_string (leak_root ^ path_str)]}
+
 
 let desc_double_lock pname_opt object_str loc =
   let mutex_str = Format.sprintf "Mutex %s" object_str in
@@ -474,6 +511,7 @@ let desc_double_lock pname_opt object_str loc =
   let descriptions = [mutex_str; msg; at_line tags loc] in
   {no_desc with descriptions; tags= !tags}
 
+
 let desc_unsafe_guarded_by_access accessed_fld guarded_by_str loc =
   let line_info = at_line (Tags.create ()) loc in
   let accessed_fld_str = Typ.Fieldname.to_string accessed_fld in
@@ -489,6 +527,7 @@ let desc_unsafe_guarded_by_access accessed_fld guarded_by_str loc =
   in
   {no_desc with descriptions= [msg]}
 
+
 let desc_fragment_retains_view fragment_typ fieldname fld_typ pname : error_desc =
   (* TODO: try advice *)
   let problem =
@@ -503,9 +542,11 @@ let desc_fragment_retains_view fragment_typ fieldname fld_typ pname : error_desc
   in
   {no_desc with descriptions= [problem; consequences; advice]}
 
+
 let desc_custom_error loc : error_desc =
   {no_desc with descriptions= ["detected"; at_line (Tags.create ()) loc]}
 
+
 (** type of access *)
 type access =
   | Last_assigned of int * bool
@@ -517,12 +558,13 @@ type access =
 
 let nullable_annotation_name proc_name =
   match Config.nullable_annotation with
-  | Some name
+  | Some name ->
-   -> name
+      name
-  | None when Typ.Procname.is_java proc_name
+  | None when Typ.Procname.is_java proc_name ->
-   -> "@Nullable"
+      "@Nullable"
-  | None (* default Clang annotation name *)
+  | None (* default Clang annotation name *) ->
-   -> "_Nullable"
+      "_Nullable"
+
 
 let dereference_string proc_name deref_str value_str access_opt loc =
   let tags = deref_str.tags in
@@ -537,40 +579,43 @@ let dereference_string proc_name deref_str value_str access_opt loc =
   in
   let access_desc =
     match access_opt with
-    | None
+    | None ->
-     -> []
+        []
-    | Some Last_accessed (n, _)
+    | Some Last_accessed (n, _) ->
-     -> let line_str = string_of_int n in
+        let line_str = string_of_int n in
-        Tags.update tags Tags.accessed_line line_str ; [("last accessed on line " ^ line_str)]
+        Tags.update tags Tags.accessed_line line_str ;
-    | Some Last_assigned (n, _)
+        ["last accessed on line " ^ line_str]
-     -> let line_str = string_of_int n in
+    | Some Last_assigned (n, _) ->
-        Tags.update tags Tags.assigned_line line_str ; [("last assigned on line " ^ line_str)]
+        let line_str = string_of_int n in
-    | Some Returned_from_call _
+        Tags.update tags Tags.assigned_line line_str ;
-     -> []
+        ["last assigned on line " ^ line_str]
-    | Some Initialized_automatically
+    | Some Returned_from_call _ ->
-     -> ["initialized automatically"]
+        []
+    | Some Initialized_automatically ->
+        ["initialized automatically"]
   in
   let problem_desc =
     let problem_str =
       let annotation_name = nullable_annotation_name proc_name in
       match (Tags.get !tags Tags.nullable_src, Tags.get !tags Tags.weak_captured_var_src) with
-      | Some nullable_src, _
+      | Some nullable_src, _ ->
-       -> if String.equal nullable_src value_str then "is annotated with " ^ annotation_name
+          if String.equal nullable_src value_str then "is annotated with " ^ annotation_name
             ^ " and is dereferenced without a null check"
           else "is indirectly marked " ^ annotation_name ^ " (source: "
             ^ MF.monospaced_to_string nullable_src ^ ") and is dereferenced without a null check"
-      | None, Some weak_var_str
+      | None, Some weak_var_str ->
-       -> if String.equal weak_var_str value_str then
+          if String.equal weak_var_str value_str then
             "is a weak pointer captured in the block and is dereferenced without a null check"
           else "is equal to the variable " ^ MF.monospaced_to_string weak_var_str
             ^ ", a weak pointer captured in the block, and is dereferenced without a null check"
-      | None, None
+      | None, None ->
-       -> deref_str.problem_str
+          deref_str.problem_str
     in
-    [(problem_str ^ " " ^ at_line tags loc)]
+    [problem_str ^ " " ^ at_line tags loc]
   in
   {no_desc with descriptions= value_desc :: access_desc @ problem_desc; tags= !tags}
 
+
 let parameter_field_not_null_checked_desc (desc: error_desc) exp =
   let parameter_not_nullable_desc var =
     let var_s = Pvar.to_string var in
@@ -585,12 +630,12 @@ let parameter_field_not_null_checked_desc (desc: error_desc) exp =
   let field_not_nullable_desc exp =
     let rec exp_to_string exp =
       match exp with
-      | Exp.Lfield (exp', field, _)
+      | Exp.Lfield (exp', field, _) ->
-       -> exp_to_string exp' ^ " -> " ^ Typ.Fieldname.to_string field
+          exp_to_string exp' ^ " -> " ^ Typ.Fieldname.to_string field
-      | Exp.Lvar pvar
+      | Exp.Lvar pvar ->
-       -> Mangled.to_string (Pvar.get_name pvar)
+          Mangled.to_string (Pvar.get_name pvar)
-      | _
+      | _ ->
-       -> ""
+          ""
     in
     let var_s = exp_to_string exp in
     let field_not_null_desc =
@@ -602,16 +647,18 @@ let parameter_field_not_null_checked_desc (desc: error_desc) exp =
     ; tags= (Tags.field_not_null_checked, var_s) :: desc.tags }
   in
   match exp with
-  | Exp.Lvar var
+  | Exp.Lvar var ->
-   -> parameter_not_nullable_desc var
+      parameter_not_nullable_desc var
-  | Exp.Lfield _
+  | Exp.Lfield _ ->
-   -> field_not_nullable_desc exp
+      field_not_nullable_desc exp
-  | _
+  | _ ->
-   -> desc
+      desc
+
 
 let has_tag (desc: error_desc) tag =
   List.exists ~f:(fun (tag', _) -> String.equal tag tag') desc.tags
 
+
 let is_parameter_not_null_checked_desc desc = has_tag desc Tags.parameter_not_null_checked
 
 let is_field_not_null_checked_desc desc = has_tag desc Tags.field_not_null_checked
@@ -619,6 +666,7 @@ let is_field_not_null_checked_desc desc = has_tag desc Tags.field_not_null_check
 let is_parameter_field_not_null_checked_desc desc =
   is_parameter_not_null_checked_desc desc || is_field_not_null_checked_desc desc
 
+
 let is_double_lock_desc desc = has_tag desc Tags.double_lock
 
 let desc_allocation_mismatch alloc dealloc =
@@ -645,9 +693,11 @@ let desc_allocation_mismatch alloc dealloc =
   in
   {no_desc with descriptions= [description]; tags= !tags}
 
+
 let desc_comparing_floats_for_equality loc =
   let tags = Tags.create () in
-  {no_desc with descriptions= [("Comparing floats for equality " ^ at_line tags loc)]; tags= !tags}
+  {no_desc with descriptions= ["Comparing floats for equality " ^ at_line tags loc]; tags= !tags}
+
 
 let desc_condition_always_true_false i cond_str_opt loc =
   let tags = Tags.create () in
@@ -661,11 +711,13 @@ let desc_condition_always_true_false i cond_str_opt loc =
   in
   {no_desc with descriptions= [description]; tags= !tags}
 
+
 let desc_unreachable_code_after loc =
   let tags = Tags.create () in
   let description = "Unreachable code after statement " ^ at_line tags loc in
   {no_desc with descriptions= [description]}
 
+
 let desc_deallocate_stack_variable var_str proc_name loc =
   let tags = Tags.create () in
   Tags.update tags Tags.value var_str ;
@@ -675,6 +727,7 @@ let desc_deallocate_stack_variable var_str proc_name loc =
   in
   {no_desc with descriptions= [description]; tags= !tags}
 
+
 let desc_deallocate_static_memory const_str proc_name loc =
   let tags = Tags.create () in
   Tags.update tags Tags.value const_str ;
@@ -684,24 +737,25 @@ let desc_deallocate_static_memory const_str proc_name loc =
   in
   {no_desc with descriptions= [description]; tags= !tags}
 
+
 let desc_class_cast_exception pname_opt typ_str1 typ_str2 exp_str_opt loc =
   let tags = Tags.create () in
   Tags.update tags Tags.type1 typ_str1 ;
   Tags.update tags Tags.type2 typ_str2 ;
   let in_expression =
     match exp_str_opt with
-    | Some exp_str
+    | Some exp_str ->
-     -> Tags.update tags Tags.value exp_str ;
+        Tags.update tags Tags.value exp_str ;
         " in expression " ^ MF.monospaced_to_string exp_str ^ " "
-    | None
+    | None ->
-     -> " "
+        " "
   in
   let at_line' () =
     match pname_opt with
-    | Some proc_name
+    | Some proc_name ->
-     -> "in " ^ call_to_at_line tags proc_name loc
+        "in " ^ call_to_at_line tags proc_name loc
-    | None
+    | None ->
-     -> at_line tags loc
+        at_line tags loc
   in
   let description =
     Format.asprintf "%a cannot be cast to %a %s %s" MF.pp_monospaced typ_str1 MF.pp_monospaced
@@ -709,6 +763,7 @@ let desc_class_cast_exception pname_opt typ_str1 typ_str2 exp_str_opt loc =
   in
   {no_desc with descriptions= [description]; tags= !tags}
 
+
 let desc_divide_by_zero expr_str loc =
   let tags = Tags.create () in
   Tags.update tags Tags.value expr_str ;
@@ -717,6 +772,7 @@ let desc_divide_by_zero expr_str loc =
   in
   {no_desc with descriptions= [description]; tags= !tags}
 
+
 let desc_empty_vector_access pname_opt object_str loc =
   let vector_str = Format.asprintf "Vector %a" MF.pp_monospaced object_str in
   let desc = access_str_empty pname_opt in
@@ -725,6 +781,7 @@ let desc_empty_vector_access pname_opt object_str loc =
   let descriptions = [vector_str; desc.problem_str; at_line tags loc] in
   {no_desc with descriptions; tags= !tags}
 
+
 let is_empty_vector_access_desc desc = has_tag desc Tags.empty_vector_access
 
 let desc_frontend_warning desc sugg_opt loc =
@@ -736,6 +793,7 @@ let desc_frontend_warning desc sugg_opt loc =
   let description = Format.sprintf "%s %s. %s" desc (at_line tags loc) sugg in
   {no_desc with descriptions= [description]; tags= !tags}
 
+
 let desc_leak hpred_type_opt value_str_opt resource_opt resource_action_opt loc bucket_opt =
   let tags = Tags.create () in
   let () =
@@ -744,28 +802,28 @@ let desc_leak hpred_type_opt value_str_opt resource_opt resource_action_opt loc
   let xxx_allocated_to =
     let value_str, _to, _on =
       match value_str_opt with
-      | None
+      | None ->
-       -> ("", "", "")
+          ("", "", "")
-      | Some s
+      | Some s ->
-       -> Tags.update tags Tags.value s ; (MF.monospaced_to_string s, " to ", " on ")
+          Tags.update tags Tags.value s ; (MF.monospaced_to_string s, " to ", " on ")
     in
     let typ_str =
       match hpred_type_opt with
-      | Some Exp.Sizeof {typ= {desc= Tstruct name}} when Typ.Name.is_class name
+      | Some Exp.Sizeof {typ= {desc= Tstruct name}} when Typ.Name.is_class name ->
-       -> " of type " ^ MF.monospaced_to_string (Typ.Name.name name) ^ " "
+          " of type " ^ MF.monospaced_to_string (Typ.Name.name name) ^ " "
-      | _
+      | _ ->
-       -> " "
+          " "
     in
     let desc_str =
       match resource_opt with
-      | Some PredSymb.Rmemory _
+      | Some PredSymb.Rmemory _ ->
-       -> mem_dyn_allocated ^ _to ^ value_str
+          mem_dyn_allocated ^ _to ^ value_str
-      | Some PredSymb.Rfile
+      | Some PredSymb.Rfile ->
-       -> "resource" ^ typ_str ^ "acquired" ^ _to ^ value_str
+          "resource" ^ typ_str ^ "acquired" ^ _to ^ value_str
-      | Some PredSymb.Rlock
+      | Some PredSymb.Rlock ->
-       -> lock_acquired ^ _on ^ value_str
+          lock_acquired ^ _on ^ value_str
-      | Some PredSymb.Rignore | None
+      | Some PredSymb.Rignore | None ->
-       -> if is_none value_str_opt then "memory" else value_str
+          if is_none value_str_opt then "memory" else value_str
     in
     if String.equal desc_str "" then [] else [desc_str]
   in
@@ -775,14 +833,14 @@ let desc_leak hpred_type_opt value_str_opt resource_opt resource_action_opt loc
   let is_not_rxxx_after =
     let rxxx =
       match resource_opt with
-      | Some PredSymb.Rmemory _
+      | Some PredSymb.Rmemory _ ->
-       -> reachable
+          reachable
-      | Some PredSymb.Rfile | Some PredSymb.Rlock
+      | Some PredSymb.Rfile | Some PredSymb.Rlock ->
-       -> released
+          released
-      | Some PredSymb.Rignore | None
+      | Some PredSymb.Rignore | None ->
-       -> reachable
+          reachable
     in
-    [("is not " ^ rxxx ^ " after " ^ _line tags loc)]
+    ["is not " ^ rxxx ^ " after " ^ _line tags loc]
   in
   let bucket_str =
     match bucket_opt with Some bucket when Config.show_buckets -> bucket | _ -> ""
@@ -790,6 +848,7 @@ let desc_leak hpred_type_opt value_str_opt resource_opt resource_action_opt loc
   { no_desc with
     descriptions= bucket_str :: xxx_allocated_to @ by_call_to @ is_not_rxxx_after; tags= !tags }
 
+
 let desc_buffer_overrun desc = verbatim_desc desc
 
 (** kind of precondition not met *)
@@ -799,15 +858,15 @@ let desc_precondition_not_met kind proc_name loc =
   let tags = Tags.create () in
   let kind_str =
     match kind with
-    | None
+    | None ->
-     -> []
+        []
-    | Some Pnm_bounds
+    | Some Pnm_bounds ->
-     -> ["possible array out of bounds"]
+        ["possible array out of bounds"]
-    | Some Pnm_dangling
+    | Some Pnm_dangling ->
-     -> ["possible dangling pointer dereference"]
+        ["possible dangling pointer dereference"]
   in
-  { no_desc with
+  {no_desc with descriptions= kind_str @ ["in " ^ call_to_at_line tags proc_name loc]; tags= !tags}
-    descriptions= kind_str @ [("in " ^ call_to_at_line tags proc_name loc)]; tags= !tags }
+
 
 let desc_null_test_after_dereference expr_str line loc =
   let tags = Tags.create () in
@@ -819,6 +878,7 @@ let desc_null_test_after_dereference expr_str line loc =
   in
   {no_desc with descriptions= [description]; tags= !tags}
 
+
 let desc_return_expression_required typ_str loc =
   let tags = Tags.create () in
   Tags.update tags Tags.value typ_str ;
@@ -828,6 +888,7 @@ let desc_return_expression_required typ_str loc =
   in
   {no_desc with descriptions= [description]; tags= !tags}
 
+
 let desc_retain_cycle cycle loc cycle_dotty =
   Logging.d_strln "Proposition with retain cycle:" ;
   let ct = ref 1 in
@@ -838,20 +899,20 @@ let desc_retain_cycle cycle loc cycle_dotty =
   in
   let do_edge ((se, _), f, _) =
     match se with
-    | Sil.Eexp (Exp.Lvar pvar, _) when Pvar.equal pvar Sil.block_pvar
+    | Sil.Eexp (Exp.Lvar pvar, _) when Pvar.equal pvar Sil.block_pvar ->
-     -> str_cycle
+        str_cycle
         := !str_cycle ^ " (" ^ string_of_int !ct ^ ") a block capturing "
            ^ MF.monospaced_to_string (Typ.Fieldname.to_string f) ^ "; " ;
         ct := !ct + 1
-    | Sil.Eexp ((Exp.Lvar pvar as e), _)
+    | Sil.Eexp ((Exp.Lvar pvar as e), _) ->
-     -> let e_str = Exp.to_string e in
+        let e_str = Exp.to_string e in
         let e_str = if Pvar.is_seed pvar then remove_old e_str else e_str in
         str_cycle
         := !str_cycle ^ " (" ^ string_of_int !ct ^ ") object " ^ e_str ^ " retaining "
            ^ MF.monospaced_to_string (e_str ^ "." ^ Typ.Fieldname.to_string f) ^ ", " ;
         ct := !ct + 1
-    | Sil.Eexp (Exp.Sizeof {typ}, _)
+    | Sil.Eexp (Exp.Sizeof {typ}, _) ->
-     -> let step =
+        let step =
           " (" ^ string_of_int !ct ^ ") an object of "
           ^ MF.monospaced_to_string (Typ.to_string typ)
           ^ " retaining another object via instance variable "
@@ -859,8 +920,8 @@ let desc_retain_cycle cycle loc cycle_dotty =
         in
         str_cycle := !str_cycle ^ step ;
         ct := !ct + 1
-    | _
+    | _ ->
-     -> ()
+        ()
   in
   List.iter ~f:do_edge cycle ;
   let desc =
@@ -869,36 +930,41 @@ let desc_retain_cycle cycle loc cycle_dotty =
   in
   {no_desc with descriptions= [desc]; tags= !tags; dotty= cycle_dotty}
 
+
 let registered_observer_being_deallocated_str obj_str =
   "Object " ^ obj_str
   ^ " is registered in a notification center but not being removed before deallocation"
 
+
 let desc_registered_observer_being_deallocated pvar loc =
   let tags = Tags.create () in
   let obj_str = MF.monospaced_to_string (Pvar.to_string pvar) in
   { no_desc with
     descriptions=
-      [ ( registered_observer_being_deallocated_str obj_str ^ at_line tags loc
+      [ registered_observer_being_deallocated_str obj_str ^ at_line tags loc
         ^ ". Being still registered as observer of the notification "
-        ^ "center, the deallocated object " ^ obj_str ^ " may be notified in the future." ) ]
+        ^ "center, the deallocated object " ^ obj_str ^ " may be notified in the future." ]
   ; tags= !tags }
 
+
 let desc_return_statement_missing loc =
   let tags = Tags.create () in
-  {no_desc with descriptions= [("Return statement missing " ^ at_line tags loc)]; tags= !tags}
+  {no_desc with descriptions= ["Return statement missing " ^ at_line tags loc]; tags= !tags}
+
 
 let desc_return_value_ignored proc_name loc =
   let tags = Tags.create () in
-  {no_desc with descriptions= [("after " ^ call_to_at_line tags proc_name loc)]; tags= !tags}
+  {no_desc with descriptions= ["after " ^ call_to_at_line tags proc_name loc]; tags= !tags}
+
 
 let desc_unary_minus_applied_to_unsigned_expression expr_str_opt typ_str loc =
   let tags = Tags.create () in
   let expression =
     match expr_str_opt with
-    | Some s
+    | Some s ->
-     -> Tags.update tags Tags.value s ; "expression " ^ s
+        Tags.update tags Tags.value s ; "expression " ^ s
-    | None
+    | None ->
-     -> "an expression"
+        "an expression"
   in
   let description =
     Format.asprintf "A unary minus is applied to %a of type %s %s" MF.pp_monospaced expression
@@ -906,29 +972,32 @@ let desc_unary_minus_applied_to_unsigned_expression expr_str_opt typ_str loc =
   in
   {no_desc with descriptions= [description]; tags= !tags}
 
+
 let desc_skip_function proc_name =
   let tags = Tags.create () in
   let proc_name_str = Typ.Procname.to_string proc_name in
   Tags.update tags Tags.value proc_name_str ;
   {no_desc with descriptions= [proc_name_str]; tags= !tags}
 
+
 let desc_inherently_dangerous_function proc_name =
   let proc_name_str = Typ.Procname.to_string proc_name in
   let tags = Tags.create () in
   Tags.update tags Tags.value proc_name_str ;
   {no_desc with descriptions= [MF.monospaced_to_string proc_name_str]; tags= !tags}
 
+
 let desc_stack_variable_address_escape pvar addr_dexp_str loc =
   let expr_str = Pvar.to_string pvar in
   let tags = Tags.create () in
   Tags.update tags Tags.value expr_str ;
   let escape_to_str =
     match addr_dexp_str with
-    | Some s
+    | Some s ->
-     -> Tags.update tags Tags.escape_to s ;
+        Tags.update tags Tags.escape_to s ;
         "to " ^ s ^ " "
-    | None
+    | None ->
-     -> ""
+        ""
   in
   let variable_str =
     if Pvar.is_frontend_tmp pvar then "temporary"
@@ -939,6 +1008,7 @@ let desc_stack_variable_address_escape pvar addr_dexp_str loc =
   in
   {no_desc with descriptions= [description]; tags= !tags}
 
+
 let desc_uninitialized_dangling_pointer_deref deref expr_str loc =
   let tags = Tags.create () in
   Tags.update tags Tags.value expr_str ;
@@ -948,3 +1018,4 @@ let desc_uninitialized_dangling_pointer_deref deref expr_str loc =
       (at_line tags loc)
   in
   {no_desc with descriptions= [description]; tags= !tags}
+

infer/src/IR/Location.ml

@@ -31,12 +31,15 @@ let pp f (loc: t) =
   F.fprintf f "line %d" loc.line ;
   if loc.col <> -1 then F.fprintf f ", column %d" loc.col
 
+
 let to_string loc =
   let s = string_of_int loc.line in
   if loc.col <> -1 then Printf.sprintf "%s:%d" s loc.col else s
 
+
 (** Pretty print a file-position of a location *)
 let pp_file_pos f (loc: t) =
   let fname = SourceFile.to_string loc.file in
   let pos = to_string loc in
   F.fprintf f "%s:%s" fname pos
+

infer/src/IR/Mangled.ml

@@ -30,6 +30,7 @@ let to_string (pn: t) = pn.plain
 let to_string_full (pn: t) =
   match pn.mangled with Some mangled -> pn.plain ^ "{" ^ mangled ^ "}" | None -> pn.plain
 
+
 (** Get mangled string if given *)
 let get_mangled pn = match pn.mangled with Some s -> s | None -> pn.plain
 

infer/src/IR/Mleak_buckets.ml

@@ -17,16 +17,17 @@ let objc_arc_flag = "objc_arc"
 
 let bucket_to_message bucket =
   match bucket with
-  | `MLeak_cf
+  | `MLeak_cf ->
-   -> "[CF]"
+      "[CF]"
-  | `MLeak_arc
+  | `MLeak_arc ->
-   -> "[ARC]"
+      "[ARC]"
-  | `MLeak_no_arc
+  | `MLeak_no_arc ->
-   -> "[NO ARC]"
+      "[NO ARC]"
-  | `MLeak_cpp
+  | `MLeak_cpp ->
-   -> "[CPP]"
+      "[CPP]"
-  | `MLeak_unknown
+  | `MLeak_unknown ->
-   -> "[UNKNOWN ORIGIN]"
+      "[UNKNOWN ORIGIN]"
+
 
 let contains_all = List.mem ~equal:PVariant.( = ) Config.ml_buckets `MLeak_all
 
@@ -65,6 +66,7 @@ let should_raise_objc_leak typ =
   else if should_raise_leak_no_arc () then Some (bucket_to_message `MLeak_no_arc)
   else None
 
+
 (*
 let bucket_to_string bucket =
   match bucket with

infer/src/IR/Objc_models.ml

@@ -56,6 +56,7 @@ module Core_foundation_model = struct
     ; "__CFURLEnumerator"
     ; "__CFUUID" ]
 
+
   let cf_network =
     [ "_CFHTTPAuthentication"
     ; "__CFHTTPMessage"
@@ -65,6 +66,7 @@ module Core_foundation_model = struct
     ; "__CFNetServiceMonitor"
     ; "__CFNetServiceBrowser" ]
 
+
   let core_media =
     [ "OpaqueCMBlockBuffer"
     ; "opaqueCMBufferQueue"
@@ -76,6 +78,7 @@ module Core_foundation_model = struct
     ; "OpaqueCMClock"
     ; "OpaqueCMTimebase" ]
 
+
   let core_text =
     [ "__CTFont"
     ; "__CTFontCollection"
@@ -91,9 +94,11 @@ module Core_foundation_model = struct
     ; "__CTTextTab"
     ; "__CTTypesetter" ]
 
+
   let core_video =
     ["__CVBuffer"; "__CVMetalTextureCache"; "__CVOpenGLESTextureCache"; "__CVPixelBufferPool"]
 
+
   let image_io = ["CGImageDestination"; "CGImageMetadata"; "CGImageMetadataTag"; "CGImageSource"]
 
   let security =
@@ -107,6 +112,7 @@ module Core_foundation_model = struct
     ; "__SecTrust"
     ; "__SecRequirement" ]
 
+
   let system_configuration =
     [ "__SCDynamicStore"
     ; "__SCNetworkInterface"
@@ -118,6 +124,7 @@ module Core_foundation_model = struct
     ; "__SCNetworkReachability"
     ; "__SCPreferences" ]
 
+
   let core_graphics_types =
     [ "CGAffineTransform"
     ; "CGBase"
@@ -149,10 +156,12 @@ module Core_foundation_model = struct
     ; "CGPDFString"
     ; "CGShading" ]
 
+
   let core_foundation_types =
     core_foundation @ cf_network @ core_media @ core_text @ core_video @ image_io @ security
     @ system_configuration
 
+
   let copy = "Copy"
 
   let create = "Create"
@@ -171,24 +180,27 @@ module Core_foundation_model = struct
 
   let core_lib_to_type_list lib =
     match lib with
-    | Core_foundation
+    | Core_foundation ->
-     -> core_foundation_types
+        core_foundation_types
-    | Core_graphics
+    | Core_graphics ->
-     -> core_graphics_types
+        core_graphics_types
+
 
   let is_objc_memory_model_controlled o =
     List.mem ~equal:String.equal core_foundation_types o
     || List.mem ~equal:String.equal core_graphics_types o
 
+
   let rec is_core_lib lib typ =
     match typ.Typ.desc with
-    | Typ.Tptr (styp, _)
+    | Typ.Tptr (styp, _) ->
-     -> is_core_lib lib styp
+        is_core_lib lib styp
-    | Typ.Tstruct name
+    | Typ.Tstruct name ->
-     -> let core_lib_types = core_lib_to_type_list lib in
+        let core_lib_types = core_lib_to_type_list lib in
         List.mem ~equal:String.equal core_lib_types (Typ.Name.name name)
-    | _
+    | _ ->
-     -> false
+        false
+
 
   let is_core_foundation_type typ = is_core_lib Core_foundation typ
 
@@ -200,6 +212,7 @@ module Core_foundation_model = struct
     is_core_lib_type typ
     && (String.is_substring ~substring:create funct || String.is_substring ~substring:copy funct)
 
+
   let function_arg_is_cftype typ = String.is_substring ~substring:cf_type typ
 
   let is_core_lib_retain typ funct = function_arg_is_cftype typ && String.equal funct cf_retain
@@ -212,6 +225,7 @@ module Core_foundation_model = struct
     in
     List.exists ~f core_graphics_types
 
+
   (*
   let function_arg_is_core_pgraphics typ =
     let res = (String.is_substring ~substring:cf_type typ) in

infer/src/IR/PredSymb.ml

@@ -26,10 +26,11 @@ let equal_access = [%compare.equal : access]
 (** Return the value of the FA_sentinel attribute in [attr_list] if it is found *)
 let get_sentinel_func_attribute_value attr_list =
   match attr_list with
-  | (FA_sentinel (sentinel, null_pos)) :: _
+  | (FA_sentinel (sentinel, null_pos)) :: _ ->
-   -> Some (sentinel, null_pos)
+      Some (sentinel, null_pos)
-  | []
+  | [] ->
-   -> None
+      None
+
 
 type mem_kind =
   | Mmalloc  (** memory allocated with malloc *)
@@ -72,6 +73,7 @@ type res_action =
 let compare_res_action {ra_kind= k1; ra_res= r1} {ra_kind= k2; ra_res= r2} =
   [%compare : res_act_kind * resource] (k1, r1) (k2, r2)
 
+
 (* type aliases for components of t values that compare should ignore *)
 type _annot_item = Annot.Item.t
 
@@ -115,25 +117,27 @@ let equal = [%compare.equal : t]
 
 (** name of the allocation function for the given memory kind *)
 let mem_alloc_pname = function
-  | Mmalloc
+  | Mmalloc ->
-   -> Typ.Procname.from_string_c_fun "malloc"
+      Typ.Procname.from_string_c_fun "malloc"
-  | Mnew
+  | Mnew ->
-   -> Typ.Procname.from_string_c_fun "new"
+      Typ.Procname.from_string_c_fun "new"
-  | Mnew_array
+  | Mnew_array ->
-   -> Typ.Procname.from_string_c_fun "new[]"
+      Typ.Procname.from_string_c_fun "new[]"
-  | Mobjc
+  | Mobjc ->
-   -> Typ.Procname.from_string_c_fun "alloc"
+      Typ.Procname.from_string_c_fun "alloc"
+
 
 (** name of the deallocation function for the given memory kind *)
 let mem_dealloc_pname = function
-  | Mmalloc
+  | Mmalloc ->
-   -> Typ.Procname.from_string_c_fun "free"
+      Typ.Procname.from_string_c_fun "free"
-  | Mnew
+  | Mnew ->
-   -> Typ.Procname.from_string_c_fun "delete"
+      Typ.Procname.from_string_c_fun "delete"
-  | Mnew_array
+  | Mnew_array ->
-   -> Typ.Procname.from_string_c_fun "delete[]"
+      Typ.Procname.from_string_c_fun "delete[]"
-  | Mobjc
+  | Mobjc ->
-   -> Typ.Procname.from_string_c_fun "dealloc"
+      Typ.Procname.from_string_c_fun "dealloc"
+
 
 (** Categories of attributes *)
 type category =
@@ -152,24 +156,25 @@ let equal_category = [%compare.equal : category]
 
 let to_category att =
   match att with
-  | Aresource _ | Adangling _
+  | Aresource _ | Adangling _ ->
-   -> ACresource
+      ACresource
-  | Alocked | Aunlocked
+  | Alocked | Aunlocked ->
-   -> AClock
+      AClock
-  | Aautorelease
+  | Aautorelease ->
-   -> ACautorelease
+      ACautorelease
-  | Adiv0 _
+  | Adiv0 _ ->
-   -> ACdiv0
+      ACdiv0
-  | Aobjc_null
+  | Aobjc_null ->
-   -> ACobjc_null
+      ACobjc_null
-  | Aretval _
+  | Aretval _ ->
-   -> ACretval
+      ACretval
-  | Aundef _
+  | Aundef _ ->
-   -> ACundef
+      ACundef
-  | Aobserver | Aunsubscribed_observer
+  | Aobserver | Aunsubscribed_observer ->
-   -> ACobserver
+      ACobserver
-  | Awont_leak
+  | Awont_leak ->
-   -> ACwontleak
+      ACwontleak
+
 
 let is_undef = function Aundef _ -> true | _ -> false
 
@@ -177,71 +182,72 @@ let is_wont_leak = function Awont_leak -> true | _ -> false
 
 (** convert the attribute to a string *)
 let to_string pe = function
-  | Aresource ra
+  | Aresource ra ->
-   -> let mk_name = function
+      let mk_name = function
-        | Mmalloc
+        | Mmalloc ->
-         -> "ma"
+            "ma"
-        | Mnew
+        | Mnew ->
-         -> "ne"
+            "ne"
-        | Mnew_array
+        | Mnew_array ->
-         -> "na"
+            "na"
-        | Mobjc
+        | Mobjc ->
-         -> "oc"
+            "oc"
       in
       let name =
         match (ra.ra_kind, ra.ra_res) with
-        | Racquire, Rmemory mk
+        | Racquire, Rmemory mk ->
-         -> "MEM" ^ mk_name mk
+            "MEM" ^ mk_name mk
-        | Racquire, Rfile
+        | Racquire, Rfile ->
-         -> "FILE"
+            "FILE"
-        | Rrelease, Rmemory mk
+        | Rrelease, Rmemory mk ->
-         -> "FREED" ^ mk_name mk
+            "FREED" ^ mk_name mk
-        | Rrelease, Rfile
+        | Rrelease, Rfile ->
-         -> "CLOSED"
+            "CLOSED"
-        | _, Rignore
+        | _, Rignore ->
-         -> "IGNORE"
+            "IGNORE"
-        | Racquire, Rlock
+        | Racquire, Rlock ->
-         -> "LOCKED"
+            "LOCKED"
-        | Rrelease, Rlock
+        | Rrelease, Rlock ->
-         -> "UNLOCKED"
+            "UNLOCKED"
       in
       let str_vpath =
         if Config.trace_error then F.asprintf "%a" (DecompiledExp.pp_vpath pe) ra.ra_vpath else ""
       in
       name ^ Binop.str pe Lt ^ Typ.Procname.to_string ra.ra_pname ^ ":"
       ^ string_of_int ra.ra_loc.Location.line ^ Binop.str pe Gt ^ str_vpath
-  | Aautorelease
+  | Aautorelease ->
-   -> "AUTORELEASE"
+      "AUTORELEASE"
-  | Adangling dk
+  | Adangling dk ->
-   -> let dks =
+      let dks =
         match dk with
-        | DAuninit
+        | DAuninit ->
-         -> "UNINIT"
+            "UNINIT"
-        | DAaddr_stack_var
+        | DAaddr_stack_var ->
-         -> "ADDR_STACK"
+            "ADDR_STACK"
-        | DAminusone
+        | DAminusone ->
-         -> "MINUS1"
+            "MINUS1"
       in
       "DANGL" ^ Binop.str pe Lt ^ dks ^ Binop.str pe Gt
-  | Aundef (pn, _, loc, _)
+  | Aundef (pn, _, loc, _) ->
-   -> "UND" ^ Binop.str pe Lt ^ Typ.Procname.to_string pn ^ Binop.str pe Gt ^ ":"
+      "UND" ^ Binop.str pe Lt ^ Typ.Procname.to_string pn ^ Binop.str pe Gt ^ ":"
       ^ string_of_int loc.Location.line
-  | Alocked
+  | Alocked ->
-   -> "LOCKED"
+      "LOCKED"
-  | Aunlocked
+  | Aunlocked ->
-   -> "UNLOCKED"
+      "UNLOCKED"
-  | Adiv0 (_, _)
+  | Adiv0 (_, _) ->
-   -> "DIV0"
+      "DIV0"
-  | Aobjc_null
+  | Aobjc_null ->
-   -> "OBJC_NULL"
+      "OBJC_NULL"
-  | Aretval (pn, _)
+  | Aretval (pn, _) ->
-   -> "RET" ^ Binop.str pe Lt ^ Typ.Procname.to_string pn ^ Binop.str pe Gt
+      "RET" ^ Binop.str pe Lt ^ Typ.Procname.to_string pn ^ Binop.str pe Gt
-  | Aobserver
+  | Aobserver ->
-   -> "OBSERVER"
+      "OBSERVER"
-  | Aunsubscribed_observer
+  | Aunsubscribed_observer ->
-   -> "UNSUBSCRIBED_OBSERVER"
+      "UNSUBSCRIBED_OBSERVER"
-  | Awont_leak
+  | Awont_leak ->
-   -> "WONT_LEAK"
+      "WONT_LEAK"
+
 
 (** dump an attribute *)
 let d_attribute (a: t) = L.add_print_action (L.PTattribute, Obj.repr a)

infer/src/IR/ProcAttributes.ml

@@ -21,6 +21,7 @@ let compare_proc_flags x y =
   let bindings x = Hashtbl.fold (fun k d l -> (k, d) :: l) x [] in
   [%compare : (string * string) list] (bindings x) (bindings y)
 
+
 let proc_flags_empty () : proc_flags = Hashtbl.create 1
 
 let proc_flag_ignore_return = "ignore_return"
@@ -99,3 +100,4 @@ let default proc_name language =
   ; proc_name
   ; ret_type= Typ.mk Typ.Tvoid
   ; source_file_captured= SourceFile.invalid __FILE__ }
+

infer/src/IR/Procdesc.ml

@@ -59,6 +59,7 @@ module Node = struct
     ; preds= []
     ; exn= [] }
 
+
   let compare node1 node2 = Int.compare node1.id node2.id
 
   let hash node = Hashtbl.hash node.id
@@ -98,6 +99,7 @@ module Node = struct
     in
     NodeSet.elements (slice_nodes node.succs)
 
+
   let get_sliced_preds node f =
     let visited = ref NodeSet.empty in
     let rec slice_nodes nodes : NodeSet.t =
@@ -112,16 +114,18 @@ module Node = struct
     in
     NodeSet.elements (slice_nodes node.preds)
 
+
   let get_exn node = node.exn
 
   (** Get the name of the procedure the node belongs to *)
   let get_proc_name node =
     match node.pname_opt with
-    | None
+    | None ->
-     -> L.internal_error "get_proc_name: at node %d@\n" node.id ;
+        L.internal_error "get_proc_name: at node %d@\n" node.id ;
         assert false
-    | Some pname
+    | Some pname ->
-     -> pname
+        pname
+
 
   (** Get the predecessors of the node *)
   let get_preds node = node.preds
@@ -137,6 +141,7 @@ module Node = struct
     in
     nodes start_node
 
+
   (** Get the node kind *)
   let get_kind node = node.kind
 
@@ -149,11 +154,12 @@ module Node = struct
       match instr with
       | Sil.Call (_, exp, _, _, _) -> (
         match exp with Exp.Const Const.Cfun procname -> procname :: callees | _ -> callees )
-      | _
+      | _ ->
-       -> callees
+          callees
     in
     List.fold ~f:collect ~init:[] (get_instrs node)
 
+
   (** Get the location of the node *)
   let get_loc n = n.loc
 
@@ -161,6 +167,7 @@ module Node = struct
   let get_last_loc n =
     match List.rev (get_instrs n) with instr :: _ -> Sil.instr_get_loc instr | [] -> n.loc
 
+
   let pp_id f id = F.fprintf f "%d" id
 
   let pp f node = pp_id f (get_id node)
@@ -189,6 +196,7 @@ module Node = struct
     let instr = Sil.Declare_locals (ptl, loc) in
     prepend_instrs node [instr]
 
+
   (** Print extended instructions for the node,
       highlighting the given subinstruction if present *)
   let pp_instrs pe0 ~sub_instrs instro fmt node =
@@ -201,44 +209,47 @@ module Node = struct
     else
       let () =
         match get_kind node with
-        | Stmt_node s
+        | Stmt_node s ->
-         -> F.fprintf fmt "statements (%s)" s
+            F.fprintf fmt "statements (%s)" s
-        | Prune_node (_, _, descr)
+        | Prune_node (_, _, descr) ->
-         -> F.fprintf fmt "assume %s" descr
+            F.fprintf fmt "assume %s" descr
-        | Exit_node _
+        | Exit_node _ ->
-         -> F.fprintf fmt "exit"
+            F.fprintf fmt "exit"
-        | Skip_node s
+        | Skip_node s ->
-         -> F.fprintf fmt "skip (%s)" s
+            F.fprintf fmt "skip (%s)" s
-        | Start_node _
+        | Start_node _ ->
-         -> F.fprintf fmt "start"
+            F.fprintf fmt "start"
-        | Join_node
+        | Join_node ->
-         -> F.fprintf fmt "join"
+            F.fprintf fmt "join"
       in
       F.fprintf fmt "  %a " Location.pp (get_loc node)
 
+
   (** Dump extended instructions for the node *)
   let d_instrs ~(sub_instrs: bool) (curr_instr: Sil.instr option) (node: t) =
     L.add_print_action (L.PTnode_instrs, Obj.repr (sub_instrs, curr_instr, node))
 
+
   (** Return a description of the cfg node *)
   let get_description pe node =
     let str =
       match get_kind node with
-      | Stmt_node _
+      | Stmt_node _ ->
-       -> "Instructions"
+          "Instructions"
-      | Prune_node (_, _, descr)
+      | Prune_node (_, _, descr) ->
-       -> "Conditional" ^ " " ^ descr
+          "Conditional" ^ " " ^ descr
-      | Exit_node _
+      | Exit_node _ ->
-       -> "Exit"
+          "Exit"
-      | Skip_node _
+      | Skip_node _ ->
-       -> "Skip"
+          "Skip"
-      | Start_node _
+      | Start_node _ ->
-       -> "Start"
+          "Start"
-      | Join_node
+      | Join_node ->
-       -> "Join"
+          "Join"
     in
     let pp fmt = F.fprintf fmt "%s@\n%a@?" str (pp_instrs pe None ~sub_instrs:true) node in
     F.asprintf "%t" pp
+
 end
 
 (* =============== END of module Node =============== *)
@@ -273,6 +284,7 @@ let from_proc_attributes ~called_from_cfg attributes =
   let exit_node = Node.dummy pname_opt in
   {attributes; nodes= []; nodes_num= 0; start_node; exit_node; loop_heads= None}
 
+
 (** Compute the distance of each node to the exit node, if not computed already *)
 let compute_distance_to_exit_node pdesc =
   let exit_node = pdesc.exit_node in
@@ -280,10 +292,10 @@ let compute_distance_to_exit_node pdesc =
     let next_nodes = ref [] in
     let do_node (node: Node.t) =
       match node.dist_exit with
-      | Some _
+      | Some _ ->
-       -> ()
+          ()
-      | None
+      | None ->
-       -> node.dist_exit <- Some dist ;
+          node.dist_exit <- Some dist ;
           next_nodes := node.preds @ !next_nodes
     in
     List.iter ~f:do_node nodes ;
@@ -291,6 +303,7 @@ let compute_distance_to_exit_node pdesc =
   in
   mark_distance 0 [exit_node]
 
+
 (** check or indicate if we have performed preanalysis on the CFG *)
 let did_preanalysis pdesc = pdesc.attributes.did_preanalysis
 
@@ -334,6 +347,7 @@ let get_start_node pdesc = pdesc.start_node
 let get_sliced_slope pdesc f =
   Node.get_generated_slope (get_start_node pdesc) (fun n -> Node.get_sliced_succs n f)
 
+
 (** List of nodes in the procedure up to the first branching *)
 let get_slope pdesc = Node.get_generated_slope (get_start_node pdesc) Node.get_succs
 
@@ -354,6 +368,7 @@ let fold_calls f acc pdesc =
   in
   List.fold ~f:do_node ~init:acc (get_nodes pdesc)
 
+
 (** iterate over the calls from the procedure: (callee,location) pairs *)
 let iter_calls f pdesc = fold_calls (fun _ call -> f call) () pdesc
 
@@ -361,6 +376,7 @@ let iter_instrs f pdesc =
   let do_node node = List.iter ~f:(fun i -> f node i) (Node.get_instrs node) in
   iter_nodes do_node pdesc
 
+
 let fold_nodes f acc pdesc = List.fold ~f ~init:acc (List.rev (get_nodes pdesc))
 
 let fold_instrs f acc pdesc =
@@ -369,23 +385,26 @@ let fold_instrs f acc pdesc =
   in
   fold_nodes fold_node acc pdesc
 
+
 let iter_slope f pdesc =
   let visited = ref NodeSet.empty in
   let rec do_node node =
     visited := NodeSet.add node !visited ;
     f node ;
     match Node.get_succs node with
-    | [n]
+    | [n] ->
-     -> if not (NodeSet.mem n !visited) then do_node n
+        if not (NodeSet.mem n !visited) then do_node n
-    | _
+    | _ ->
-     -> ()
+        ()
   in
   do_node (get_start_node pdesc)
 
+
 let iter_slope_calls f pdesc =
   let do_node node = List.iter ~f:(fun callee_pname -> f callee_pname) (Node.get_callees node) in
   iter_slope do_node pdesc
 
+
 (** iterate between two nodes or until we reach a branching structure *)
 let iter_slope_range f src_node dst_node =
   let visited = ref NodeSet.empty in
@@ -393,13 +412,14 @@ let iter_slope_range f src_node dst_node =
     visited := NodeSet.add node !visited ;
     f node ;
     match Node.get_succs node with
-    | [n]
+    | [n] ->
-     -> if not (NodeSet.mem n !visited) && not (Node.equal node dst_node) then do_node n
+        if not (NodeSet.mem n !visited) && not (Node.equal node dst_node) then do_node n
-    | _
+    | _ ->
-     -> ()
+        ()
   in
   do_node src_node
 
+
 (** Set the exit node of the proc desc *)
 let set_exit_node pdesc node = pdesc.exit_node <- node
 
@@ -413,12 +433,14 @@ let set_start_node pdesc node = pdesc.start_node <- node
 let append_locals pdesc new_locals =
   (pdesc.attributes).locals <- pdesc.attributes.locals @ new_locals
 
+
 (** Set the successor nodes and exception nodes, and build predecessor links *)
 let set_succs_exn_base (node: Node.t) succs exn =
   node.succs <- succs ;
   node.exn <- exn ;
   List.iter ~f:(fun (n: Node.t) -> n.preds <- node :: n.preds) succs
 
+
 (** Create a new cfg node *)
 let create_node pdesc loc kind instrs =
   pdesc.nodes_num <- pdesc.nodes_num + 1 ;
@@ -437,18 +459,20 @@ let create_node pdesc loc kind instrs =
   pdesc.nodes <- node :: pdesc.nodes ;
   node
 
+
 (** Set the successor and exception nodes.
     If this is a join node right before the exit node, add an extra node in the middle,
     otherwise nullify and abstract instructions cannot be added after a conditional. *)
 let node_set_succs_exn pdesc (node: Node.t) succs exn =
   match (node.kind, succs) with
-  | Join_node, [({Node.kind= Exit_node _} as exit_node)]
+  | Join_node, [({Node.kind= Exit_node _} as exit_node)] ->
-   -> let kind = Node.Stmt_node "between_join_and_exit" in
+      let kind = Node.Stmt_node "between_join_and_exit" in
       let node' = create_node pdesc node.loc kind node.instrs in
       set_succs_exn_base node [node'] exn ;
       set_succs_exn_base node' [exit_node] exn
-  | _
+  | _ ->
-   -> set_succs_exn_base node succs exn
+      set_succs_exn_base node succs exn
+
 
 (** Get loop heads for widening.
     It collects all target nodes of back-edges in a depth-first
@@ -457,10 +481,10 @@ let node_set_succs_exn pdesc (node: Node.t) succs exn =
 let get_loop_heads pdesc =
   let rec set_loop_head_rec visited heads wl =
     match wl with
-    | []
+    | [] ->
-     -> heads
+        heads
-    | (n, ancester) :: wl'
+    | (n, ancester) :: wl' ->
-     -> if NodeSet.mem n visited then
+        if NodeSet.mem n visited then
           if NodeSet.mem n ancester then set_loop_head_rec visited (NodeSet.add n heads) wl'
           else set_loop_head_rec visited heads wl'
         else
@@ -474,10 +498,12 @@ let get_loop_heads pdesc =
   pdesc.loop_heads <- Some lh ;
   lh
 
+
 let is_loop_head pdesc (node: Node.t) =
   let lh = match pdesc.loop_heads with Some lh -> lh | None -> get_loop_heads pdesc in
   NodeSet.mem node lh
 
+
 let pp_variable_list fmt etl =
   if List.is_empty etl then Format.fprintf fmt "None"
   else
@@ -485,14 +511,16 @@ let pp_variable_list fmt etl =
       ~f:(fun (id, ty) -> Format.fprintf fmt " %a:%a" Mangled.pp id (Typ.pp_full Pp.text) ty)
       etl
 
+
 let pp_objc_accessor fmt accessor =
   match accessor with
-  | Some ProcAttributes.Objc_getter field
+  | Some ProcAttributes.Objc_getter field ->
-   -> Format.fprintf fmt "Getter of %a, " (Typ.Struct.pp_field Pp.text) field
+      Format.fprintf fmt "Getter of %a, " (Typ.Struct.pp_field Pp.text) field
-  | Some ProcAttributes.Objc_setter field
+  | Some ProcAttributes.Objc_setter field ->
-   -> Format.fprintf fmt "Setter of %a, " (Typ.Struct.pp_field Pp.text) field
+      Format.fprintf fmt "Setter of %a, " (Typ.Struct.pp_field Pp.text) field
-  | None
+  | None ->
-   -> ()
+      ()
+
 
 let pp_signature fmt pdesc =
   let attributes = get_attributes pdesc in
@@ -511,6 +539,8 @@ let pp_signature fmt pdesc =
     Format.fprintf fmt ", Annotation: %a" (Annot.Method.pp pname_string) method_annotation ;
   Format.fprintf fmt "]@\n"
 
+
 let is_specialized pdesc =
   let attributes = get_attributes pdesc in
   attributes.ProcAttributes.is_specialized
+

infer/src/IR/Pvar.ml

@@ -44,67 +44,73 @@ let compare_modulo_this x y =
       else if String.equal "this" (Mangled.to_string x.pv_name) then 0
       else compare_pvar_kind x.pv_kind y.pv_kind
 
+
 let equal = [%compare.equal : t]
 
 let pp_translation_unit fmt = function
-  | TUFile fname
+  | TUFile fname ->
-   -> SourceFile.pp fmt fname
+      SourceFile.pp fmt fname
-  | TUExtern
+  | TUExtern ->
-   -> Format.fprintf fmt "EXTERN"
+      Format.fprintf fmt "EXTERN"
+
 
 let _pp f pv =
   let name = pv.pv_name in
   match pv.pv_kind with
-  | Local_var n
+  | Local_var n ->
-   -> if !Config.pp_simple then F.fprintf f "%a" Mangled.pp name
+      if !Config.pp_simple then F.fprintf f "%a" Mangled.pp name
       else F.fprintf f "%a$%a" Typ.Procname.pp n Mangled.pp name
-  | Callee_var n
+  | Callee_var n ->
-   -> if !Config.pp_simple then F.fprintf f "%a|callee" Mangled.pp name
+      if !Config.pp_simple then F.fprintf f "%a|callee" Mangled.pp name
       else F.fprintf f "%a$%a|callee" Typ.Procname.pp n Mangled.pp name
-  | Abduced_retvar (n, l)
+  | Abduced_retvar (n, l) ->
-   -> if !Config.pp_simple then F.fprintf f "%a|abducedRetvar" Mangled.pp name
+      if !Config.pp_simple then F.fprintf f "%a|abducedRetvar" Mangled.pp name
       else F.fprintf f "%a$[%a]%a|abducedRetvar" Typ.Procname.pp n Location.pp l Mangled.pp name
-  | Abduced_ref_param (n, index, l)
+  | Abduced_ref_param (n, index, l) ->
-   -> if !Config.pp_simple then F.fprintf f "%a|abducedRefParam%d" Mangled.pp name index
+      if !Config.pp_simple then F.fprintf f "%a|abducedRefParam%d" Mangled.pp name index
       else F.fprintf f "%a$[%a]%a|abducedRefParam" Typ.Procname.pp n Location.pp l Mangled.pp name
-  | Global_var (translation_unit, is_const, is_pod, _)
+  | Global_var (translation_unit, is_const, is_pod, _) ->
-   -> F.fprintf f "#GB<%a%s%s>$%a" pp_translation_unit translation_unit
+      F.fprintf f "#GB<%a%s%s>$%a" pp_translation_unit translation_unit
         (if is_const then "|const" else "")
         (if not is_pod then "|!pod" else "")
         Mangled.pp name
-  | Seed_var
+  | Seed_var ->
-   -> F.fprintf f "old_%a" Mangled.pp name
+      F.fprintf f "old_%a" Mangled.pp name
+
 
 (** Pretty print a program variable in latex. *)
 let pp_latex f pv =
   let name = pv.pv_name in
   match pv.pv_kind with
-  | Local_var _
+  | Local_var _ ->
-   -> Latex.pp_string Latex.Roman f (Mangled.to_string name)
+      Latex.pp_string Latex.Roman f (Mangled.to_string name)
-  | Callee_var _
+  | Callee_var _ ->
-   -> F.fprintf f "%a_{%a}" (Latex.pp_string Latex.Roman) (Mangled.to_string name)
+      F.fprintf f "%a_{%a}" (Latex.pp_string Latex.Roman) (Mangled.to_string name)
         (Latex.pp_string Latex.Roman) "callee"
-  | Abduced_retvar _
+  | Abduced_retvar _ ->
-   -> F.fprintf f "%a_{%a}" (Latex.pp_string Latex.Roman) (Mangled.to_string name)
+      F.fprintf f "%a_{%a}" (Latex.pp_string Latex.Roman) (Mangled.to_string name)
         (Latex.pp_string Latex.Roman) "abducedRetvar"
-  | Abduced_ref_param _
+  | Abduced_ref_param _ ->
-   -> F.fprintf f "%a_{%a}" (Latex.pp_string Latex.Roman) (Mangled.to_string name)
+      F.fprintf f "%a_{%a}" (Latex.pp_string Latex.Roman) (Mangled.to_string name)
         (Latex.pp_string Latex.Roman) "abducedRefParam"
-  | Global_var _
+  | Global_var _ ->
-   -> Latex.pp_string Latex.Boldface f (Mangled.to_string name)
+      Latex.pp_string Latex.Boldface f (Mangled.to_string name)
-  | Seed_var
+  | Seed_var ->
-   -> F.fprintf f "%a^{%a}" (Latex.pp_string Latex.Roman) (Mangled.to_string name)
+      F.fprintf f "%a^{%a}" (Latex.pp_string Latex.Roman) (Mangled.to_string name)
         (Latex.pp_string Latex.Roman) "old"
 
+
 (** Pretty print a pvar which denotes a value, not an address *)
 let pp_value pe f pv =
   match pe.Pp.kind with TEXT -> _pp f pv | HTML -> _pp f pv | LATEX -> pp_latex f pv
 
+
 (** Pretty print a program variable. *)
 let pp pe f pv =
   let ampersand = match pe.Pp.kind with TEXT -> "&" | HTML -> "&amp;" | LATEX -> "\\&" in
   F.fprintf f "%s%a" ampersand (pp_value pe) pv
 
+
 (** Dump a program variable. *)
 let d (pvar: t) = L.add_print_action (L.PTpvar, Obj.repr pvar)
 
@@ -123,13 +129,15 @@ let get_simplified_name pv =
   match String.rsplit2 s ~on:'.' with
   | Some (s1, s2) -> (
     match String.rsplit2 s1 ~on:'.' with Some (_, s4) -> s4 ^ "." ^ s2 | _ -> s )
-  | _
+  | _ ->
-   -> s
+      s
+
 
 (** Check if the pvar is an abucted return var or param passed by ref *)
 let is_abduced pv =
   match pv.pv_kind with Abduced_retvar _ | Abduced_ref_param _ -> true | _ -> false
 
+
 (** Turn a pvar into a seed pvar (which stored the initial value) *)
 let to_seed pv = {pv with pv_kind= Seed_var}
 
@@ -173,10 +181,11 @@ let is_frontend_tmp pvar =
   is_sil_tmp name
   ||
   match pvar.pv_kind with
-  | Local_var pname
+  | Local_var pname ->
-   -> Typ.Procname.is_java pname && is_bytecode_tmp name
+      Typ.Procname.is_java pname && is_bytecode_tmp name
-  | _
+  | _ ->
-   -> false
+      false
+
 
 (* in Sawja, variables like $T0_18 are temporaries, but not SSA vars. *)
 let is_ssa_frontend_tmp pvar =
@@ -185,25 +194,28 @@ let is_ssa_frontend_tmp pvar =
   let name = to_string pvar in
   not (String.contains name '_' && String.contains name '$')
 
+
 (** Turn an ordinary program variable into a callee program variable *)
 let to_callee pname pvar =
   match pvar.pv_kind with
-  | Local_var _
+  | Local_var _ ->
-   -> {pvar with pv_kind= Callee_var pname}
+      {pvar with pv_kind= Callee_var pname}
-  | Global_var _
+  | Global_var _ ->
-   -> pvar
+      pvar
-  | Callee_var _ | Abduced_retvar _ | Abduced_ref_param _ | Seed_var
+  | Callee_var _ | Abduced_retvar _ | Abduced_ref_param _ | Seed_var ->
-   -> L.d_str "Cannot convert pvar to callee: " ;
+      L.d_str "Cannot convert pvar to callee: " ;
       d pvar ;
       L.d_ln () ;
       assert false
 
+
 let name_hash (name: Mangled.t) = Hashtbl.hash name
 
 (** [mk name proc_name] creates a program var with the given function name *)
 let mk (name: Mangled.t) (proc_name: Typ.Procname.t) : t =
   {pv_hash= name_hash name; pv_name= name; pv_kind= Local_var proc_name}
 
+
 let get_ret_pvar pname = mk Ident.name_return pname
 
 (** [mk_callee name proc_name] creates a program var
@@ -211,6 +223,7 @@ let get_ret_pvar pname = mk Ident.name_return pname
 let mk_callee (name: Mangled.t) (proc_name: Typ.Procname.t) : t =
   {pv_hash= name_hash name; pv_name= name; pv_kind= Callee_var proc_name}
 
+
 (** create a global variable with the given name *)
 let mk_global ?(is_constexpr= false) ?(is_pod= true) ?(is_static_local= false) (name: Mangled.t)
     translation_unit : t =
@@ -218,27 +231,32 @@ let mk_global ?(is_constexpr= false) ?(is_pod= true) ?(is_static_local= false) (
   ; pv_name= name
   ; pv_kind= Global_var (translation_unit, is_constexpr, is_pod, is_static_local) }
 
+
 (** create a fresh temporary variable local to procedure [pname]. for use in the frontends only! *)
 let mk_tmp name pname =
   let id = Ident.create_fresh Ident.knormal in
   let pvar_mangled = Mangled.from_string (tmp_prefix ^ name ^ Ident.to_string id) in
   mk pvar_mangled pname
 
+
 (** create an abduced return variable for a call to [proc_name] at [loc] *)
 let mk_abduced_ret (proc_name: Typ.Procname.t) (loc: Location.t) : t =
   let name = Mangled.from_string ("$RET_" ^ Typ.Procname.to_unique_id proc_name) in
   {pv_hash= name_hash name; pv_name= name; pv_kind= Abduced_retvar (proc_name, loc)}
 
+
 let mk_abduced_ref_param (proc_name: Typ.Procname.t) (index: int) (loc: Location.t) : t =
   let name = Mangled.from_string ("$REF_PARAM_VAL_" ^ Typ.Procname.to_unique_id proc_name) in
   {pv_hash= name_hash name; pv_name= name; pv_kind= Abduced_ref_param (proc_name, index, loc)}
 
+
 let get_translation_unit pvar =
   match pvar.pv_kind with
-  | Global_var (tu, _, _, _)
+  | Global_var (tu, _, _, _) ->
-   -> tu
+      tu
-  | _
+  | _ ->
-   -> L.(die InternalError) "Expected a global variable"
+      L.(die InternalError) "Expected a global variable"
+
 
 let is_compile_constant pvar = match pvar.pv_kind with Global_var (_, b, _, _) -> b | _ -> false
 
@@ -246,9 +264,10 @@ let is_pod pvar = match pvar.pv_kind with Global_var (_, _, b, _) -> b | _ -> tr
 
 let get_initializer_pname {pv_name; pv_kind} =
   match pv_kind with
-  | Global_var _
+  | Global_var _ ->
-   -> Some
+      Some
         (Typ.Procname.from_string_c_fun
            (Config.clang_initializer_prefix ^ Mangled.to_string_full pv_name))
-  | _
+  | _ ->
-   -> None
+      None
+

infer/src/IR/QualifiedCppName.ml

@@ -25,16 +25,18 @@ let strip_template_args quals =
   let no_template_name s = List.hd_exn (String.split ~on:'<' s) in
   List.map ~f:no_template_name quals
 
+
 let append_template_args_to_last quals ~args =
   match quals with
-  | [last; _] when String.contains last '<'
+  | [last; _] when String.contains last '<' ->
-   -> L.(die InternalError)
+      L.(die InternalError)
         "expected qualified name without template args, but got %s, the last qualifier of %s" last
         (String.concat ~sep:", " quals)
-  | last :: rest
+  | last :: rest ->
-   -> (last ^ args) :: rest
+      (last ^ args) :: rest
-  | []
+  | [] ->
-   -> L.(die InternalError) "expected non-empty qualified name"
+      L.(die InternalError) "expected non-empty qualified name"
+
 
 let to_list = List.rev
 
@@ -68,6 +70,7 @@ module Match = struct
   let regexp_string_of_qualifiers quals =
     Str.quote (to_separated_string ~sep:matching_separator quals) ^ "$"
 
+
   let qualifiers_list_matcher quals_list =
     ( if List.is_empty quals_list then "a^"
     else
@@ -75,6 +78,7 @@ module Match = struct
       List.map ~f:regexp_string_of_qualifiers quals_list |> String.concat ~sep:"\\|" )
     |> Str.regexp
 
+
   let qualifiers_of_fuzzy_qual_name qual_name =
     (* Fail if we detect templates in the fuzzy name. Template instantiations are not taken into
        account when fuzzy matching, and templates may produce wrong results when parsing qualified
@@ -86,12 +90,15 @@ module Match = struct
           L.(die InternalError) "Unexpected template in fuzzy qualified name %s." qual_name ) ;
     of_qual_string qual_name
 
+
   let of_fuzzy_qual_names fuzzy_qual_names =
     List.map fuzzy_qual_names ~f:qualifiers_of_fuzzy_qual_name |> qualifiers_list_matcher
 
+
   let match_qualifiers matcher quals =
     (* qual_name may have qualifiers with template parameters - drop them to whitelist all
        instantiations *)
     let normalized_qualifiers = strip_template_args quals in
     Str.string_match matcher (to_separated_string ~sep:matching_separator normalized_qualifiers) 0
+
 end

infer/src/IR/Subtype.ml

@@ -18,6 +18,7 @@ let list_to_string list =
   if Int.equal (List.length list) 0 then "( sub )"
   else "- {" ^ String.concat ~sep:", " (List.map ~f:Typ.Name.name list) ^ "}"
 
+
 type t' =
   | Exact  (** denotes the current type only *)
   | Subtypes of Typ.Name.t list
@@ -39,27 +40,30 @@ let equal_result = [%compare.equal : result]
 let sub_type tname_subst st_pair =
   let st, kind = st_pair in
   match st with
-  | Subtypes tnames
+  | Subtypes tnames ->
-   -> let tnames' = IList.map_changed tname_subst tnames in
+      let tnames' = IList.map_changed tname_subst tnames in
       if phys_equal tnames tnames' then st_pair else (Subtypes tnames', kind)
-  | Exact
+  | Exact ->
-   -> st_pair
+      st_pair
+
 
 let max_result res1 res2 = if compare_result res1 res2 <= 0 then res2 else res1
 
 let is_interface tenv (class_name: Typ.Name.t) =
   match (class_name, Tenv.lookup tenv class_name) with
-  | JavaClass _, Some {fields= []; methods= []}
+  | JavaClass _, Some {fields= []; methods= []} ->
-   -> true
+      true
-  | _
+  | _ ->
-   -> false
+      false
+
 
 let is_root_class class_name =
   match class_name with
-  | Typ.JavaClass _
+  | Typ.JavaClass _ ->
-   -> Typ.Name.equal class_name Typ.Name.Java.java_lang_object
+      Typ.Name.equal class_name Typ.Name.Java.java_lang_object
-  | _
+  | _ ->
-   -> false
+      false
+
 
 (** check if c1 is a subclass of c2 *)
 let check_subclass_tenv tenv c1 c2 : result =
@@ -69,23 +73,24 @@ let check_subclass_tenv tenv c1 c2 : result =
     if equal_result best_result Yes then Yes
     else
       match classnames with
-      | []
+      | [] ->
-       -> best_result
+          best_result
-      | cn :: cns
+      | cn :: cns ->
-       -> loop (max_result best_result (check cn)) cns
+          loop (max_result best_result (check cn)) cns
   and check cn : result =
     if Typ.Name.equal cn c2 then Yes
     else
       match Tenv.lookup tenv cn with
-      | None when is_root_class cn
+      | None when is_root_class cn ->
-       -> No
+          No
-      | None
+      | None ->
-       -> Unknown
+          Unknown
-      | Some {supers}
+      | Some {supers} ->
-       -> loop No supers
+          loop No supers
   in
   if is_root_class c2 then Yes else check c1
 
+
 module SubtypesMap = Caml.Map.Make (struct
   (* pair of subtypes *)
   type t = Typ.Name.t * Typ.Name.t [@@deriving compare]
@@ -101,6 +106,7 @@ let check_subtype =
         is_subt
     : result )
 
+
 let is_known_subtype tenv c1 c2 : bool = equal_result (check_subtype tenv c1 c2) Yes
 
 let is_known_not_subtype tenv c1 c2 : bool = equal_result (check_subtype tenv c1 c2) No
@@ -110,10 +116,11 @@ let flag_to_string flag = match flag with CAST -> "(cast)" | INSTOF -> "(instof)
 let pp f (t, flag) =
   if Config.print_types then
     match t with
-    | Exact
+    | Exact ->
-     -> F.fprintf f "%s" (flag_to_string flag)
+        F.fprintf f "%s" (flag_to_string flag)
-    | Subtypes list
+    | Subtypes list ->
-     -> F.fprintf f "%s" (list_to_string list ^ flag_to_string flag)
+        F.fprintf f "%s" (list_to_string list ^ flag_to_string flag)
+
 
 let exact = (Exact, NORMAL)
 
@@ -133,56 +140,63 @@ let list_intersect equal l1 l2 =
   let in_l2 a = List.mem ~equal l2 a in
   List.filter ~f:in_l2 l1
 
+
 let join_flag flag1 flag2 =
   match (flag1, flag2) with CAST, _ -> CAST | _, CAST -> CAST | _, _ -> NORMAL
 
+
 let join (s1, flag1) (s2, flag2) =
   let s =
     match (s1, s2) with
-    | Exact, _
+    | Exact, _ ->
-     -> s2
+        s2
-    | _, Exact
+    | _, Exact ->
-     -> s1
+        s1
-    | Subtypes l1, Subtypes l2
+    | Subtypes l1, Subtypes l2 ->
-     -> Subtypes (list_intersect Typ.Name.equal l1 l2)
+        Subtypes (list_intersect Typ.Name.equal l1 l2)
   in
   let flag = join_flag flag1 flag2 in
   (s, flag)
 
+
 let update_flag c1 c2 flag flag' =
   match flag with INSTOF -> if Typ.Name.equal c1 c2 then flag else flag' | _ -> flag'
 
+
 let change_flag st_opt c1 c2 flag' =
   match st_opt with
   | Some st -> (
     match st with
-    | Exact, flag
+    | Exact, flag ->
-     -> let new_flag = update_flag c1 c2 flag flag' in
+        let new_flag = update_flag c1 c2 flag flag' in
         Some (Exact, new_flag)
-    | Subtypes t, flag
+    | Subtypes t, flag ->
-     -> let new_flag = update_flag c1 c2 flag flag' in
+        let new_flag = update_flag c1 c2 flag flag' in
         Some (Subtypes t, new_flag) )
-  | None
+  | None ->
-   -> None
+      None
+
 
 let normalize_subtypes t_opt c1 c2 flag1 flag2 =
   let new_flag = update_flag c1 c2 flag1 flag2 in
   match t_opt with
   | Some t -> (
     match t with
-    | Exact
+    | Exact ->
-     -> Some (t, new_flag)
+        Some (t, new_flag)
-    | Subtypes l
+    | Subtypes l ->
-     -> Some (Subtypes (List.sort ~cmp:Typ.Name.compare l), new_flag) )
+        Some (Subtypes (List.sort ~cmp:Typ.Name.compare l), new_flag) )
-  | None
+  | None ->
-   -> None
+      None
+
 
 let subtypes_to_string t =
   match fst t with
-  | Exact
+  | Exact ->
-   -> "ex" ^ flag_to_string (snd t)
+      "ex" ^ flag_to_string (snd t)
-  | Subtypes l
+  | Subtypes l ->
-   -> list_to_string l ^ flag_to_string (snd t)
+      list_to_string l ^ flag_to_string (snd t)
+
 
 (* c is a subtype when it does not appear in the list l of no-subtypes *)
 let no_subtype_in_list tenv c l = not (List.exists ~f:(is_known_subtype tenv c) l)
@@ -204,21 +218,23 @@ let check_redundancies tenv c l =
   in
   List.fold ~f:aux ~init:([], true) l
 
+
 let rec updates_head f c l =
   match l with
-  | []
+  | [] ->
-   -> []
+      []
-  | ci :: rest
+  | ci :: rest ->
-   -> if is_strict_subtype f ci c then ci :: updates_head f c rest else updates_head f c rest
+      if is_strict_subtype f ci c then ci :: updates_head f c rest else updates_head f c rest
+
 
 (* adds the classes of l2 to l1 and checks that no redundancies or inconsistencies will occur
    A - { X1,..., Xn } is inconsistent if A <: Xi for some i *)
 let rec add_not_subtype tenv c1 l1 l2 =
   match l2 with
-  | []
+  | [] ->
-   -> l1
+      l1
-  | c :: rest
+  | c :: rest ->
-   -> if is_known_subtype tenv c1 c then add_not_subtype tenv c1 l1 rest
+      if is_known_subtype tenv c1 c then add_not_subtype tenv c1 l1 rest
       else
         (* checks for inconsistencies *)
         let l1', should_add = check_redundancies tenv c l1 in
@@ -226,23 +242,24 @@ let rec add_not_subtype tenv c1 l1 l2 =
         let rest' = add_not_subtype tenv c1 l1' rest in
         if should_add then c :: rest' else rest'
 
+
 let get_subtypes tenv (c1, ((st1, flag1): t)) (c2, ((st2, flag2): t)) =
   let is_sub = is_known_subtype tenv c1 c2 in
   let pos_st, neg_st =
     match (st1, st2) with
-    | Exact, Exact
+    | Exact, Exact ->
-     -> if is_sub then (Some st1, None) else (None, Some st1)
+        if is_sub then (Some st1, None) else (None, Some st1)
-    | Exact, Subtypes l2
+    | Exact, Subtypes l2 ->
-     -> if is_sub && no_subtype_in_list tenv c1 l2 then (Some st1, None) else (None, Some st1)
+        if is_sub && no_subtype_in_list tenv c1 l2 then (Some st1, None) else (None, Some st1)
-    | Subtypes l1, Exact
+    | Subtypes l1, Exact ->
-     -> if is_sub then (Some st1, None)
+        if is_sub then (Some st1, None)
         else
           let l1' = updates_head tenv c2 l1 in
           if no_subtype_in_list tenv c2 l1 then
             (Some (Subtypes l1'), Some (Subtypes (add_not_subtype tenv c1 l1 [c2])))
           else (None, Some st1)
-    | Subtypes l1, Subtypes l2
+    | Subtypes l1, Subtypes l2 ->
-     -> if is_interface tenv c2 || is_sub then
+        if is_interface tenv c2 || is_sub then
           if no_subtype_in_list tenv c1 l2 then
             let l2' = updates_head tenv c1 l2 in
             (Some (Subtypes (add_not_subtype tenv c1 l1 l2')), None)
@@ -257,19 +274,21 @@ let get_subtypes tenv (c1, ((st1, flag1): t)) (c2, ((st2, flag2): t)) =
   in
   (normalize_subtypes pos_st c1 c2 flag1 flag2, normalize_subtypes neg_st c1 c2 flag1 flag2)
 
+
 let case_analysis_basic tenv (c1, st) (c2, (_, flag2)) =
   let pos_st, neg_st =
     if is_known_subtype tenv c1 c2 then (Some st, None)
     else if is_known_subtype tenv c2 c1 then
       match st with
-      | Exact, _
+      | Exact, _ ->
-       -> if Typ.Name.equal c1 c2 then (Some st, None) else (None, Some st)
+          if Typ.Name.equal c1 c2 then (Some st, None) else (None, Some st)
-      | Subtypes _, _
+      | Subtypes _, _ ->
-       -> if Typ.Name.equal c1 c2 then (Some st, None) else (Some st, Some st)
+          if Typ.Name.equal c1 c2 then (Some st, None) else (Some st, Some st)
     else (None, Some st)
   in
   (change_flag pos_st c1 c2 flag2, change_flag neg_st c1 c2 flag2)
 
+
 (** [case_analysis (c1, st1) (c2, st2) f] performs case analysis on [c1 <: c2]
     according to [st1] and [st2]
     where f c1 c2 is true if c1 is a subtype of c2.
@@ -280,3 +299,4 @@ let case_analysis_basic tenv (c1, st) (c2, (_, flag2)) =
 let case_analysis tenv (c1, st1) (c2, st2) =
   if Config.subtype_multirange then get_subtypes tenv (c1, st1) (c2, st2)
   else case_analysis_basic tenv (c1, st1) (c2, st2)
+

infer/src/IR/Tenv.ml

@@ -34,6 +34,7 @@ let pp fmt (tenv: t) =
       Format.fprintf fmt "@[<6>TYPE: %a@." (Typ.Struct.pp Pp.text name) typ)
     tenv
 
+
 (** Create a new type environment. *)
 let create () = TypenameHash.create 1000
 
@@ -42,7 +43,9 @@ let mk_struct tenv ?default ?fields ?statics ?methods ?supers ?annots name =
   let struct_typ =
     Typ.Struct.internal_mk_struct ?default ?fields ?statics ?methods ?supers ?annots ()
   in
-  TypenameHash.replace tenv name struct_typ ; struct_typ
+  TypenameHash.replace tenv name struct_typ ;
+  struct_typ
+
 
 (** Check if typename is found in tenv *)
 let mem tenv name = TypenameHash.mem tenv name
@@ -59,8 +62,9 @@ let lookup tenv name : Typ.Struct.t option =
     | CppClass (m, NoTemplate) -> (
       try Some (TypenameHash.find tenv (CStruct m))
       with Not_found -> None )
-    | _
+    | _ ->
-     -> None
+        None
+
 
 (** Add a (name,type) pair to the global type environment. *)
 let add tenv name struct_typ = TypenameHash.replace tenv name struct_typ
@@ -77,15 +81,17 @@ let sort_fields_tenv tenv =
   in
   iter sort_fields_struct tenv
 
+
 (** Add a field to a given struct in the global type environment. *)
 let add_field tenv class_tn_name field =
   match lookup tenv class_tn_name with
-  | Some ({fields} as struct_typ)
+  | Some ({fields} as struct_typ) ->
-   -> if not (List.mem ~equal:equal_fields fields field) then
+      if not (List.mem ~equal:equal_fields fields field) then
         let new_fields = List.merge [field] fields ~cmp:compare_fields in
         ignore (mk_struct tenv ~default:struct_typ ~fields:new_fields ~statics:[] class_tn_name)
-  | _
+  | _ ->
-   -> ()
+      ()
+
 
 (** Get method that is being overriden by java_pname (if any) **)
 let get_overriden_method tenv pname_java =
@@ -103,21 +109,23 @@ let get_overriden_method tenv pname_java =
           Some (struct_typ_get_method_by_name struct_typ (Typ.Procname.java_get_method pname_java))
         with Not_found ->
           get_overriden_method_in_supers pname_java (supers_tail @ struct_typ.supers) )
-      | None
+      | None ->
-       -> get_overriden_method_in_supers pname_java supers_tail )
+          get_overriden_method_in_supers pname_java supers_tail )
-    | []
+    | [] ->
-     -> None
+        None
   in
   match lookup tenv (Typ.Procname.java_get_class_type_name pname_java) with
-  | Some {supers}
+  | Some {supers} ->
-   -> get_overriden_method_in_supers pname_java supers
+      get_overriden_method_in_supers pname_java supers
-  | _
+  | _ ->
-   -> None
+      None
+
 
 (** Serializer for type environments *)
 let tenv_serializer : t Serialization.serializer =
   Serialization.create_serializer Serialization.Key.tenv
 
+
 let global_tenv : t option ref = ref None
 
 (** Load a type environment from a file *)
@@ -128,6 +136,7 @@ let load_from_file (filename: DB.filename) : t option =
     !global_tenv )
   else Serialization.read_from_file tenv_serializer filename
 
+
 (** Save a type environment into a file *)
 let store_to_file (filename: DB.filename) (tenv: t) =
   (* update in-memory global tenv for later uses by this process, e.g. in single-core mode the
@@ -140,13 +149,15 @@ let store_to_file (filename: DB.filename) (tenv: t) =
     let fmt = Format.formatter_of_out_channel out_channel in
     Format.fprintf fmt "%a" pp tenv ; Out_channel.close out_channel
 
+
 exception Found of Typ.Name.t
 
 let language_is tenv lang =
   match TypenameHash.iter (fun n -> raise (Found n)) tenv with
-  | ()
+  | () ->
-   -> false
+      false
-  | exception Found JavaClass _
+  | exception Found JavaClass _ ->
-   -> Config.equal_language lang Java
+      Config.equal_language lang Java
-  | exception Found _
+  | exception Found _ ->
-   -> Config.equal_language lang Clang
+      Config.equal_language lang Clang
+

infer/src/absint/AbstractDomain.ml

@@ -57,34 +57,37 @@ module BottomLifted (Domain : S) = struct
     if phys_equal lhs rhs then true
     else
       match (lhs, rhs) with
-      | Bottom, _
+      | Bottom, _ ->
-       -> true
+          true
-      | _, Bottom
+      | _, Bottom ->
-       -> false
+          false
-      | NonBottom lhs, NonBottom rhs
+      | NonBottom lhs, NonBottom rhs ->
-       -> Domain.( <= ) ~lhs ~rhs
+          Domain.( <= ) ~lhs ~rhs
+
 
   let join astate1 astate2 =
     if phys_equal astate1 astate2 then astate1
     else
       match (astate1, astate2) with
-      | Bottom, _
+      | Bottom, _ ->
-       -> astate2
+          astate2
-      | _, Bottom
+      | _, Bottom ->
-       -> astate1
+          astate1
-      | NonBottom a1, NonBottom a2
+      | NonBottom a1, NonBottom a2 ->
-       -> NonBottom (Domain.join a1 a2)
+          NonBottom (Domain.join a1 a2)
+
 
   let widen ~prev ~next ~num_iters =
     if phys_equal prev next then prev
     else
       match (prev, next) with
-      | Bottom, _
+      | Bottom, _ ->
-       -> next
+          next
-      | _, Bottom
+      | _, Bottom ->
-       -> prev
+          prev
-      | NonBottom prev, NonBottom next
+      | NonBottom prev, NonBottom next ->
-       -> NonBottom (Domain.widen ~prev ~next ~num_iters)
+          NonBottom (Domain.widen ~prev ~next ~num_iters)
+
 
   let pp fmt = function Bottom -> F.fprintf fmt "_|_" | NonBottom astate -> Domain.pp fmt astate
 end
@@ -98,30 +101,33 @@ module TopLifted (Domain : S) = struct
     if phys_equal lhs rhs then true
     else
       match (lhs, rhs) with
-      | _, Top
+      | _, Top ->
-       -> true
+          true
-      | Top, _
+      | Top, _ ->
-       -> false
+          false
-      | NonTop lhs, NonTop rhs
+      | NonTop lhs, NonTop rhs ->
-       -> Domain.( <= ) ~lhs ~rhs
+          Domain.( <= ) ~lhs ~rhs
+
 
   let join astate1 astate2 =
     if phys_equal astate1 astate2 then astate1
     else
       match (astate1, astate2) with
-      | Top, _ | _, Top
+      | Top, _ | _, Top ->
-       -> Top
+          Top
-      | NonTop a1, NonTop a2
+      | NonTop a1, NonTop a2 ->
-       -> NonTop (Domain.join a1 a2)
+          NonTop (Domain.join a1 a2)
+
 
   let widen ~prev ~next ~num_iters =
     if phys_equal prev next then prev
     else
       match (prev, next) with
-      | Top, _ | _, Top
+      | Top, _ | _, Top ->
-       -> Top
+          Top
-      | NonTop prev, NonTop next
+      | NonTop prev, NonTop next ->
-       -> NonTop (Domain.widen ~prev ~next ~num_iters)
+          NonTop (Domain.widen ~prev ~next ~num_iters)
+
 
   let pp fmt = function Top -> F.fprintf fmt "T" | NonTop astate -> Domain.pp fmt astate
 end
@@ -134,16 +140,19 @@ module Pair (Domain1 : S) (Domain2 : S) = struct
     else Domain1.( <= ) ~lhs:(fst lhs) ~rhs:(fst rhs)
       && Domain2.( <= ) ~lhs:(snd lhs) ~rhs:(snd rhs)
 
+
   let join astate1 astate2 =
     if phys_equal astate1 astate2 then astate1
     else (Domain1.join (fst astate1) (fst astate2), Domain2.join (snd astate1) (snd astate2))
 
+
   let widen ~prev ~next ~num_iters =
     if phys_equal prev next then prev
     else
       ( Domain1.widen ~prev:(fst prev) ~next:(fst next) ~num_iters
       , Domain2.widen ~prev:(snd prev) ~next:(snd next) ~num_iters )
 
+
   let pp fmt (astate1, astate2) = F.fprintf fmt "(%a, %a)" Domain1.pp astate1 Domain2.pp astate2
 end
 
@@ -187,34 +196,37 @@ module Map (Key : PrettyPrintable.PrintableOrderedType) (ValueDomain : S) = stru
           with Not_found -> false)
         lhs
 
+
   let join astate1 astate2 =
     if phys_equal astate1 astate2 then astate1
     else
       M.merge
         (fun _ v1_opt v2_opt ->
           match (v1_opt, v2_opt) with
-          | Some v1, Some v2
+          | Some v1, Some v2 ->
-           -> Some (ValueDomain.join v1 v2)
+              Some (ValueDomain.join v1 v2)
-          | Some v, _ | _, Some v
+          | Some v, _ | _, Some v ->
-           -> Some v
+              Some v
-          | None, None
+          | None, None ->
-           -> None)
+              None)
         astate1 astate2
 
+
   let widen ~prev ~next ~num_iters =
     if phys_equal prev next then prev
     else
       M.merge
         (fun _ v1_opt v2_opt ->
           match (v1_opt, v2_opt) with
-          | Some v1, Some v2
+          | Some v1, Some v2 ->
-           -> Some (ValueDomain.widen ~prev:v1 ~next:v2 ~num_iters)
+              Some (ValueDomain.widen ~prev:v1 ~next:v2 ~num_iters)
-          | Some v, _ | _, Some v
+          | Some v, _ | _, Some v ->
-           -> Some v
+              Some v
-          | None, None
+          | None, None ->
-           -> None)
+              None)
         prev next
 
+
   let pp fmt astate = M.pp ~pp_value:ValueDomain.pp fmt astate
 end
 
@@ -230,30 +242,33 @@ module InvertedMap (Key : PrettyPrintable.PrintableOrderedType) (ValueDomain : S
       try M.for_all (fun k rhs_v -> ValueDomain.( <= ) ~lhs:(M.find k lhs) ~rhs:rhs_v) rhs
       with Not_found -> false
 
+
   let join astate1 astate2 =
     if phys_equal astate1 astate2 then astate1
     else
       M.merge
         (fun _ v1_opt v2_opt ->
           match (v1_opt, v2_opt) with
-          | Some v1, Some v2
+          | Some v1, Some v2 ->
-           -> Some (ValueDomain.join v1 v2)
+              Some (ValueDomain.join v1 v2)
-          | _
+          | _ ->
-           -> None)
+              None)
         astate1 astate2
 
+
   let widen ~prev ~next ~num_iters =
     if phys_equal prev next then prev
     else
       M.merge
         (fun _ v1_opt v2_opt ->
           match (v1_opt, v2_opt) with
-          | Some v1, Some v2
+          | Some v1, Some v2 ->
-           -> Some (ValueDomain.widen ~prev:v1 ~next:v2 ~num_iters)
+              Some (ValueDomain.widen ~prev:v1 ~next:v2 ~num_iters)
-          | _
+          | _ ->
-           -> None)
+              None)
         prev next
 
+
   let pp fmt astate = M.pp ~pp_value:ValueDomain.pp fmt astate
 end
 

infer/src/absint/AbstractInterpreter.ml

@@ -53,24 +53,27 @@ struct
     try Some (InvariantMap.find node_id inv_map)
     with Not_found -> None
 
+
   (** extract the postcondition of node [n] from [inv_map] *)
   let extract_post node_id inv_map =
     match extract_state node_id inv_map with Some state -> Some state.post | None -> None
 
+
   (** extract the precondition of node [n] from [inv_map] *)
   let extract_pre node_id inv_map =
     match extract_state node_id inv_map with Some state -> Some state.pre | None -> None
 
+
   let exec_node node astate_pre work_queue inv_map ({ProcData.pdesc} as proc_data) ~debug =
     let node_id = CFG.id node in
     let update_inv_map pre visit_count =
       let compute_post (pre, inv_map) (instr, id_opt) =
         let post = TransferFunctions.exec_instr pre proc_data node instr in
         match id_opt with
-        | Some id
+        | Some id ->
-         -> (post, InvariantMap.add id {pre; post; visit_count} inv_map)
+            (post, InvariantMap.add id {pre; post; visit_count} inv_map)
-        | None
+        | None ->
-         -> (post, inv_map)
+            (post, inv_map)
       in
       (* hack to ensure that we call `exec_instr` on a node even if it has no instructions *)
       let instr_ids = match CFG.instr_ids node with [] -> [(Sil.skip_instr, None)] | l -> l in
@@ -108,6 +111,7 @@ struct
       let visit_count = 1 in
       update_inv_map astate_pre visit_count
 
+
   let rec exec_worklist cfg work_queue inv_map proc_data ~debug =
     let compute_pre node inv_map =
       (* if the [pred] -> [node] transition was normal, use post([pred]) *)
@@ -119,25 +123,26 @@ struct
         List.fold ~f:extract_pre_f ~init:normal_posts (CFG.exceptional_preds cfg node)
       in
       match List.filter_opt all_posts with
-      | post :: posts
+      | post :: posts ->
-       -> Some (List.fold ~f:Domain.join ~init:post posts)
+          Some (List.fold ~f:Domain.join ~init:post posts)
-      | []
+      | [] ->
-       -> None
+          None
     in
     match Scheduler.pop work_queue with
-    | Some (_, [], work_queue')
+    | Some (_, [], work_queue') ->
-     -> exec_worklist cfg work_queue' inv_map proc_data ~debug
+        exec_worklist cfg work_queue' inv_map proc_data ~debug
-    | Some (node, _, work_queue')
+    | Some (node, _, work_queue') ->
-     -> let inv_map_post, work_queue_post =
+        let inv_map_post, work_queue_post =
           match compute_pre node inv_map with
-          | Some astate_pre
+          | Some astate_pre ->
-           -> exec_node node astate_pre work_queue' inv_map proc_data ~debug
+              exec_node node astate_pre work_queue' inv_map proc_data ~debug
-          | None
+          | None ->
-           -> (inv_map, work_queue')
+              (inv_map, work_queue')
         in
         exec_worklist cfg work_queue_post inv_map_post proc_data ~debug
-    | None
+    | None ->
-     -> inv_map
+        inv_map
+
 
   (* compute and return an invariant map for [cfg] *)
   let exec_cfg cfg proc_data ~initial ~debug =
@@ -147,15 +152,18 @@ struct
     in
     exec_worklist cfg work_queue' inv_map' proc_data ~debug
 
+
   (* compute and return an invariant map for [pdesc] *)
   let exec_pdesc ({ProcData.pdesc} as proc_data) =
     exec_cfg (CFG.from_pdesc pdesc) proc_data ~debug:Config.write_html
 
+
   (* compute and return the postcondition of [pdesc] *)
   let compute_post ?(debug= Config.write_html) ({ProcData.pdesc} as proc_data) ~initial =
     let cfg = CFG.from_pdesc pdesc in
     let inv_map = exec_cfg cfg proc_data ~initial ~debug in
     extract_post (CFG.id (CFG.exit_node cfg)) inv_map
+
 end
 
 module MakeWithScheduler (C : ProcCfg.S) (S : Scheduler.Make) (T : TransferFunctions.MakeSIL) =

infer/src/absint/Checkers.ml

@@ -21,13 +21,14 @@ module PP = struct
   let pp_loc_range linereader nbefore nafter fmt loc =
     let printline n =
       match Printer.LineReader.from_loc linereader {loc with Location.line= n} with
-      | Some s
+      | Some s ->
-       -> F.fprintf fmt "%s%s@\n" (if Int.equal n loc.Location.line then "-->" else "   ") s
+          F.fprintf fmt "%s%s@\n" (if Int.equal n loc.Location.line then "-->" else "   ") s
-      | _
+      | _ ->
-       -> ()
+          ()
     in
     F.fprintf fmt "%a:%d@\n" SourceFile.pp loc.Location.file loc.Location.line ;
     for n = loc.Location.line - nbefore to loc.Location.line + nafter do printline n done
+
 end
 
 (* PP *)
@@ -73,33 +74,33 @@ module ST = struct
         match (field_name, PatternMatch.get_this_type proc_attributes) with
         | Some field_name, Some t -> (
           match Typ.Struct.get_field_type_and_annotation ~lookup field_name t with
-          | Some (_, ia)
+          | Some (_, ia) ->
-           -> Annotations.ia_has_annotation_with ia annotation_matches
+              Annotations.ia_has_annotation_with ia annotation_matches
-          | None
+          | None ->
-           -> false )
+              false )
-        | _
+        | _ ->
-         -> false
+            false
       in
       let is_class_suppressed =
         match PatternMatch.get_this_type proc_attributes with
         | Some t -> (
           match PatternMatch.type_get_annotation tenv t with
-          | Some ia
+          | Some ia ->
-           -> Annotations.ia_has_annotation_with ia annotation_matches
+              Annotations.ia_has_annotation_with ia annotation_matches
-          | None
+          | None ->
-           -> false )
+              false )
-        | None
+        | None ->
-         -> false
+            false
       in
       is_method_suppressed || is_field_suppressed || is_class_suppressed
     in
     let trace =
       let origin_elements =
         match origin_loc with
-        | Some oloc
+        | Some oloc ->
-         -> [Errlog.make_trace_element 0 oloc "origin" []]
+            [Errlog.make_trace_element 0 oloc "origin" []]
-        | None
+        | None ->
-         -> []
+            []
       in
       origin_elements @ [Errlog.make_trace_element 0 loc description []]
     in
@@ -108,4 +109,5 @@ module ST = struct
         (Typ.Procname.to_string proc_name) ;
       L.progress "%s@." description ;
       Reporting.log_error_deprecated proc_name ~loc ~ltr:trace exn )
+
 end

infer/src/absint/FormalMap.ml

@@ -27,6 +27,7 @@ let make pdesc =
     ~f:(fun formal_map (base, index) -> AccessPath.BaseMap.add base index formal_map)
     ~init:AccessPath.BaseMap.empty formals_with_nums
 
+
 let empty = AccessPath.BaseMap.empty
 
 let is_formal = AccessPath.BaseMap.mem
@@ -35,10 +36,12 @@ let get_formal_index base t =
   try Some (AccessPath.BaseMap.find base t)
   with Not_found -> None
 
+
 let get_formal_base index t =
   List.find ~f:(fun (_, i) -> Int.equal i index) (AccessPath.BaseMap.bindings t)
   |> Option.map ~f:fst
 
+
 let get_formals_indexes = AccessPath.BaseMap.bindings
 
 let pp = AccessPath.BaseMap.pp ~pp_value:Int.pp

infer/src/absint/LowerHil.ml

@@ -29,7 +29,7 @@ struct
 
   type extras = TransferFunctions.extras
 
-  let exec_instr (actual_state, id_map as astate) extras node instr =
+  let exec_instr ((actual_state, id_map) as astate) extras node instr =
     let f_resolve_id id =
       try Some (IdAccessPathMapDomain.find id id_map)
       with Not_found -> None
@@ -37,16 +37,16 @@ struct
     match
       HilInstr.of_sil ~include_array_indexes:HilConfig.include_array_indexes ~f_resolve_id instr
     with
-    | Bind (id, access_path)
+    | Bind (id, access_path) ->
-     -> let id_map' = IdAccessPathMapDomain.add id access_path id_map in
+        let id_map' = IdAccessPathMapDomain.add id access_path id_map in
         if phys_equal id_map id_map' then astate else (actual_state, id_map')
-    | Unbind ids
+    | Unbind ids ->
-     -> let id_map' =
+        let id_map' =
           List.fold ~f:(fun acc id -> IdAccessPathMapDomain.remove id acc) ~init:id_map ids
         in
         if phys_equal id_map id_map' then astate else (actual_state, id_map')
-    | Instr hil_instr
+    | Instr hil_instr ->
-     -> let actual_state' = TransferFunctions.exec_instr actual_state extras node hil_instr in
+        let actual_state' = TransferFunctions.exec_instr actual_state extras node hil_instr in
         ( if Config.write_html then
             let underyling_node = CFG.underlying_node node in
             NodePrinter.start_session underyling_node ;
@@ -55,8 +55,9 @@ struct
                  (fst astate) HilInstr.pp hil_instr TransferFunctions.Domain.pp actual_state') ;
             NodePrinter.finish_session underyling_node ) ;
         if phys_equal actual_state actual_state' then astate else (actual_state', id_map)
-    | Ignore
+    | Ignore ->
-     -> astate
+        astate
+
 end
 
 module MakeDefault (MakeTransferFunctions : TransferFunctions.MakeHIL) (CFG : ProcCfg.S) =

infer/src/absint/NodePrinter.ml

@@ -18,16 +18,18 @@ let new_session node =
   let pname = Procdesc.Node.get_proc_name node in
   let node_id = (Procdesc.Node.get_id node :> int) in
   match Specs.get_summary pname with
-  | None
+  | None ->
-   -> 0
+      0
-  | Some summary
+  | Some summary ->
-   -> (summary.stats).nodes_visited_fp <- IntSet.add node_id summary.stats.nodes_visited_fp ;
+      (summary.stats).nodes_visited_fp <- IntSet.add node_id summary.stats.nodes_visited_fp ;
       incr summary.Specs.sessions ;
       !(summary.Specs.sessions)
 
+
 let start_session node =
   if Config.write_html then
     let session = new_session node in
     Printer.node_start_session node session
 
+
 let finish_session node = if Config.write_html then Printer.node_finish_session node

infer/src/absint/PatternMatch.ml

@@ -16,10 +16,11 @@ module F = Format
 
 let type_is_object typ =
   match typ.Typ.desc with
-  | Tptr ({desc= Tstruct name}, _)
+  | Tptr ({desc= Tstruct name}, _) ->
-   -> Typ.Name.equal name Typ.Name.Java.java_lang_object
+      Typ.Name.equal name Typ.Name.Java.java_lang_object
-  | _
+  | _ ->
-   -> false
+      false
+
 
 let java_proc_name_with_class_method pn_java class_with_path method_name =
   try
@@ -27,70 +28,81 @@ let java_proc_name_with_class_method pn_java class_with_path method_name =
     && String.equal (Typ.Procname.java_get_method pn_java) method_name
   with _ -> false
 
+
 (** Holds iff the predicate holds on a supertype of the named type, including the type itself *)
 let rec supertype_exists tenv pred name =
   match Tenv.lookup tenv name with
-  | Some ({supers} as struct_typ)
+  | Some ({supers} as struct_typ) ->
-   -> pred name struct_typ || List.exists ~f:(fun name -> supertype_exists tenv pred name) supers
+      pred name struct_typ || List.exists ~f:(fun name -> supertype_exists tenv pred name) supers
-  | None
+  | None ->
-   -> false
+      false
+
 
 let rec supertype_find_map_opt tenv f name =
   match f name with
   | None -> (
     match Tenv.lookup tenv name with
-    | Some {supers}
+    | Some {supers} ->
-     -> List.find_map ~f:(supertype_find_map_opt tenv f) supers
+        List.find_map ~f:(supertype_find_map_opt tenv f) supers
-    | None
+    | None ->
-     -> None )
+        None )
-  | result
+  | result ->
-   -> result
+      result
+
 
 let is_immediate_subtype tenv this_type_name super_type_name =
   match Tenv.lookup tenv this_type_name with
-  | Some {supers}
+  | Some {supers} ->
-   -> List.exists ~f:(Typ.Name.equal super_type_name) supers
+      List.exists ~f:(Typ.Name.equal super_type_name) supers
-  | None
+  | None ->
-   -> false
+      false
+
 
 (** return true if [typ0] <: [typ1] *)
 let is_subtype tenv name0 name1 =
   Typ.Name.equal name0 name1
   || supertype_exists tenv (fun name _ -> Typ.Name.equal name name1) name0
 
+
 let is_subtype_of_str tenv cn1 classname_str =
   let typename = Typ.Name.Java.from_string classname_str in
   is_subtype tenv cn1 typename
 
+
 (** The type the method is invoked on *)
 let get_this_type proc_attributes =
   match proc_attributes.ProcAttributes.formals with (_, t) :: _ -> Some t | _ -> None
 
+
 let type_get_direct_supertypes tenv (typ: Typ.t) =
   match typ.desc with
   | Tptr ({desc= Tstruct name}, _) | Tstruct name -> (
     match Tenv.lookup tenv name with Some {supers} -> supers | None -> [] )
-  | _
+  | _ ->
-   -> []
+      []
+
 
 let type_get_class_name {Typ.desc} =
   match desc with Typ.Tptr (typ, _) -> Typ.name typ | _ -> None
 
+
 let type_get_annotation tenv (typ: Typ.t) : Annot.Item.t option =
   match typ.desc with
   | Tptr ({desc= Tstruct name}, _) | Tstruct name -> (
     match Tenv.lookup tenv name with Some {annots} -> Some annots | None -> None )
-  | _
+  | _ ->
-   -> None
+      None
+
 
 let rec get_type_name {Typ.desc} =
   match desc with
-  | Typ.Tstruct name
+  | Typ.Tstruct name ->
-   -> Typ.Name.name name
+      Typ.Name.name name
-  | Typ.Tptr (t, _)
+  | Typ.Tptr (t, _) ->
-   -> get_type_name t
+      get_type_name t
-  | _
+  | _ ->
-   -> "_"
+      "_"
+
 
 let get_field_type_name tenv (typ: Typ.t) (fieldname: Typ.Fieldname.t) : string option =
   match typ.desc with
@@ -98,74 +110,76 @@ let get_field_type_name tenv (typ: Typ.t) (fieldname: Typ.Fieldname.t) : string
     match Tenv.lookup tenv name with
     | Some {fields} -> (
       match List.find ~f:(function fn, _, _ -> Typ.Fieldname.equal fn fieldname) fields with
-      | Some (_, ft, _)
+      | Some (_, ft, _) ->
-       -> Some (get_type_name ft)
+          Some (get_type_name ft)
-      | None
+      | None ->
-       -> None )
+          None )
-    | None
+    | None ->
-     -> None )
+        None )
-  | _
+  | _ ->
-   -> None
+      None
+
 
 let java_get_const_type_name (const: Const.t) : string =
   match const with
-  | Const.Cstr _
+  | Const.Cstr _ ->
-   -> "java.lang.String"
+      "java.lang.String"
-  | Const.Cint _
+  | Const.Cint _ ->
-   -> "java.lang.Integer"
+      "java.lang.Integer"
-  | Const.Cfloat _
+  | Const.Cfloat _ ->
-   -> "java.lang.Double"
+      "java.lang.Double"
-  | _
+  | _ ->
-   -> "_"
+      "_"
+
 
 let get_vararg_type_names tenv (call_node: Procdesc.Node.t) (ivar: Pvar.t) : string list =
   (* Is this the node creating ivar? *)
   let rec initializes_array instrs =
     match instrs with
     | (Sil.Call (Some (t1, _), Exp.Const Const.Cfun pn, _, _, _))
-      :: (Sil.Store (Exp.Lvar iv, _, Exp.Var t2, _)) :: is
+      :: (Sil.Store (Exp.Lvar iv, _, Exp.Var t2, _)) :: is ->
-     -> Pvar.equal ivar iv && Ident.equal t1 t2
+        Pvar.equal ivar iv && Ident.equal t1 t2
         && Typ.Procname.equal pn (Typ.Procname.from_string_c_fun "__new_array")
         || initializes_array is
-    | _ :: is
+    | _ :: is ->
-     -> initializes_array is
+        initializes_array is
-    | _
+    | _ ->
-     -> false
+        false
   in
   (* Get the type name added to ivar or None *)
   let added_type_name node =
     let rec nvar_type_name nvar instrs =
       match instrs with
-      | (Sil.Load (nv, Exp.Lfield (_, id, t), _, _)) :: _ when Ident.equal nv nvar
+      | (Sil.Load (nv, Exp.Lfield (_, id, t), _, _)) :: _ when Ident.equal nv nvar ->
-       -> get_field_type_name tenv t id
+          get_field_type_name tenv t id
-      | (Sil.Load (nv, _, t, _)) :: _ when Ident.equal nv nvar
+      | (Sil.Load (nv, _, t, _)) :: _ when Ident.equal nv nvar ->
-       -> Some (get_type_name t)
+          Some (get_type_name t)
-      | _ :: is
+      | _ :: is ->
-       -> nvar_type_name nvar is
+          nvar_type_name nvar is
-      | _
+      | _ ->
-       -> None
+          None
     in
     let rec added_nvar array_nvar instrs =
       match instrs with
       | (Sil.Store (Exp.Lindex (Exp.Var iv, _), _, Exp.Var nvar, _)) :: _
-        when Ident.equal iv array_nvar
+        when Ident.equal iv array_nvar ->
-       -> nvar_type_name nvar (Procdesc.Node.get_instrs node)
+          nvar_type_name nvar (Procdesc.Node.get_instrs node)
       | (Sil.Store (Exp.Lindex (Exp.Var iv, _), _, Exp.Const c, _)) :: _
-        when Ident.equal iv array_nvar
+        when Ident.equal iv array_nvar ->
-       -> Some (java_get_const_type_name c)
+          Some (java_get_const_type_name c)
-      | _ :: is
+      | _ :: is ->
-       -> added_nvar array_nvar is
+          added_nvar array_nvar is
-      | _
+      | _ ->
-       -> None
+          None
     in
     let rec array_nvar instrs =
       match instrs with
-      | (Sil.Load (nv, Exp.Lvar iv, _, _)) :: _ when Pvar.equal iv ivar
+      | (Sil.Load (nv, Exp.Lvar iv, _, _)) :: _ when Pvar.equal iv ivar ->
-       -> added_nvar nv instrs
+          added_nvar nv instrs
-      | _ :: is
+      | _ :: is ->
-       -> array_nvar is
+          array_nvar is
-      | _
+      | _ ->
-       -> None
+          None
     in
     array_nvar (Procdesc.Node.get_instrs node)
   in
@@ -176,59 +190,67 @@ let get_vararg_type_names tenv (call_node: Procdesc.Node.t) (ivar: Pvar.t) : str
       match Procdesc.Node.get_preds node with
       | [n] -> (
         match added_type_name node with Some name -> name :: type_names n | None -> type_names n )
-      | _
+      | _ ->
-       -> raise Not_found
+          raise Not_found
   in
   List.rev (type_names call_node)
 
+
 let has_formal_proc_argument_type_names proc_desc argument_type_names =
   let formals = Procdesc.get_formals proc_desc in
   let equal_formal_arg (_, typ) arg_type_name = String.equal (get_type_name typ) arg_type_name in
   Int.equal (List.length formals) (List.length argument_type_names)
   && List.for_all2_exn ~f:equal_formal_arg formals argument_type_names
 
+
 let has_formal_method_argument_type_names cfg pname_java argument_type_names =
   has_formal_proc_argument_type_names cfg
     (Typ.Procname.java_get_class_name pname_java :: argument_type_names)
 
+
 let is_getter pname_java =
   Str.string_match (Str.regexp "get*") (Typ.Procname.java_get_method pname_java) 0
 
+
 let is_setter pname_java =
   Str.string_match (Str.regexp "set*") (Typ.Procname.java_get_method pname_java) 0
 
+
 (** Returns the signature of a field access (class name, field name, field type name) *)
 let get_java_field_access_signature = function
-  | Sil.Load (_, Exp.Lfield (_, fn, ft), bt, _)
+  | Sil.Load (_, Exp.Lfield (_, fn, ft), bt, _) ->
-   -> Some (get_type_name bt, Typ.Fieldname.java_get_field fn, get_type_name ft)
+      Some (get_type_name bt, Typ.Fieldname.java_get_field fn, get_type_name ft)
-  | _
+  | _ ->
-   -> None
+      None
+
 
 (** Returns the formal signature (class name, method name,
     argument type names and return type name) *)
 let get_java_method_call_formal_signature = function
   | Sil.Call (_, Exp.Const Const.Cfun pn, (_, tt) :: args, _, _) -> (
     match pn with
-    | Typ.Procname.Java pn_java
+    | Typ.Procname.Java pn_java ->
-     -> let arg_names = List.map ~f:(function _, t -> get_type_name t) args in
+        let arg_names = List.map ~f:(function _, t -> get_type_name t) args in
         let rt_name = Typ.Procname.java_get_return_type pn_java in
         let m_name = Typ.Procname.java_get_method pn_java in
         Some (get_type_name tt, m_name, arg_names, rt_name)
-    | _
+    | _ ->
-     -> None )
+        None )
-  | _
+  | _ ->
-   -> None
+      None
+
 
 let type_is_class typ =
   match typ.Typ.desc with
-  | Tptr ({desc= Tstruct _}, _)
+  | Tptr ({desc= Tstruct _}, _) ->
-   -> true
+      true
-  | Tptr ({desc= Tarray _}, _)
+  | Tptr ({desc= Tarray _}, _) ->
-   -> true
+      true
-  | Tstruct _
+  | Tstruct _ ->
-   -> true
+      true
-  | _
+  | _ ->
-   -> false
+      false
+
 
 let initializer_classes =
   List.map ~f:Typ.Name.Java.from_string
@@ -239,6 +261,7 @@ let initializer_classes =
     ; "android.support.v4.app.Fragment"
     ; "junit.framework.TestCase" ]
 
+
 let initializer_methods = ["onActivityCreated"; "onAttach"; "onCreate"; "onCreateView"; "setUp"]
 
 (** Check if the type has in its supertypes from the initializer_classes list. *)
@@ -247,59 +270,62 @@ let type_has_initializer (tenv: Tenv.t) (t: Typ.t) : bool =
     List.mem ~equal:Typ.Name.equal initializer_classes typename
   in
   match t.desc with
-  | Typ.Tstruct name | Tptr ({desc= Tstruct name}, _)
+  | Typ.Tstruct name | Tptr ({desc= Tstruct name}, _) ->
-   -> supertype_exists tenv is_initializer_class name
+      supertype_exists tenv is_initializer_class name
-  | _
+  | _ ->
-   -> false
+      false
+
 
 (** Check if the method is one of the known initializer methods. *)
 let method_is_initializer (tenv: Tenv.t) (proc_attributes: ProcAttributes.t) : bool =
   match get_this_type proc_attributes with
-  | Some this_type
+  | Some this_type ->
-   -> if type_has_initializer tenv this_type then
+      if type_has_initializer tenv this_type then
         match proc_attributes.ProcAttributes.proc_name with
-        | Typ.Procname.Java pname_java
+        | Typ.Procname.Java pname_java ->
-         -> let mname = Typ.Procname.java_get_method pname_java in
+            let mname = Typ.Procname.java_get_method pname_java in
             List.exists ~f:(String.equal mname) initializer_methods
-        | _
+        | _ ->
-         -> false
+            false
       else false
-  | None
+  | None ->
-   -> false
+      false
+
 
 (** Get the vararg values by looking for array assignments to the pvar. *)
 let java_get_vararg_values node pvar idenv =
   let values = ref [] in
   let do_instr = function
     | Sil.Store (Exp.Lindex (array_exp, _), _, content_exp, _)
-      when Exp.equal (Exp.Lvar pvar) (Idenv.expand_expr idenv array_exp)
+      when Exp.equal (Exp.Lvar pvar) (Idenv.expand_expr idenv array_exp) ->
-     -> (* Each vararg argument is an assigment to a pvar denoting an array of objects. *)
+        (* Each vararg argument is an assigment to a pvar denoting an array of objects. *)
         values := content_exp :: !values
-    | _
+    | _ ->
-     -> ()
+        ()
   in
   let do_node n = List.iter ~f:do_instr (Procdesc.Node.get_instrs n) in
   let () =
     match Errdesc.find_program_variable_assignment node pvar with
-    | Some (node', _)
+    | Some (node', _) ->
-     -> Procdesc.iter_slope_range do_node node' node
+        Procdesc.iter_slope_range do_node node' node
-    | None
+    | None ->
-     -> ()
+        ()
   in
   !values
 
+
 let proc_calls resolve_attributes pdesc filter : (Typ.Procname.t * ProcAttributes.t) list =
   let res = ref [] in
   let do_instruction _ instr =
     match instr with
     | Sil.Call (_, Exp.Const Const.Cfun callee_pn, _, _, _) -> (
       match resolve_attributes callee_pn with
-      | Some callee_attributes
+      | Some callee_attributes ->
-       -> if filter callee_pn callee_attributes then res := (callee_pn, callee_attributes) :: !res
+          if filter callee_pn callee_attributes then res := (callee_pn, callee_attributes) :: !res
-      | None
+      | None ->
-       -> () )
+          () )
-    | _
+    | _ ->
-     -> ()
+        ()
   in
   let do_node node =
     let instrs = Procdesc.Node.get_instrs node in
@@ -309,47 +335,50 @@ let proc_calls resolve_attributes pdesc filter : (Typ.Procname.t * ProcAttribute
   List.iter ~f:do_node nodes ;
   List.rev !res
 
+
 let override_exists f tenv proc_name =
   let rec super_type_exists tenv super_class_name =
     let super_proc_name = Typ.Procname.replace_class proc_name super_class_name in
     match Tenv.lookup tenv super_class_name with
-    | Some {methods; supers}
+    | Some {methods; supers} ->
-     -> let is_override pname =
+        let is_override pname =
           Typ.Procname.equal pname super_proc_name && not (Typ.Procname.is_constructor pname)
         in
         List.exists ~f:(fun pname -> is_override pname && f pname) methods
         || List.exists ~f:(super_type_exists tenv) supers
-    | _
+    | _ ->
-     -> false
+        false
   in
   f proc_name
   ||
   match proc_name with
-  | Typ.Procname.Java proc_name_java
+  | Typ.Procname.Java proc_name_java ->
-   -> let type_name =
+      let type_name =
         Typ.Name.Java.from_string (Typ.Procname.java_get_class_name proc_name_java)
       in
       List.exists ~f:(super_type_exists tenv)
         (type_get_direct_supertypes tenv (Typ.mk (Tstruct type_name)))
-  | _
+  | _ ->
-   -> false
+      false
+
 
 (* Only java supported at the moment *)
 
 let override_iter f tenv proc_name =
   ignore (override_exists (fun pname -> f pname ; false) tenv proc_name)
 
+
 (** return the set of instance fields that are assigned to a null literal in [procdesc] *)
 let get_fields_nullified procdesc =
   (* walk through the instructions and look for instance fields that are assigned to null *)
   let collect_nullified_flds (nullified_flds, this_ids) _ = function
     | Sil.Store (Exp.Lfield (Exp.Var lhs, fld, _), _, rhs, _)
-      when Exp.is_null_literal rhs && Ident.IdentSet.mem lhs this_ids
+      when Exp.is_null_literal rhs && Ident.IdentSet.mem lhs this_ids ->
-     -> (Typ.Fieldname.Set.add fld nullified_flds, this_ids)
+        (Typ.Fieldname.Set.add fld nullified_flds, this_ids)
-    | Sil.Load (id, rhs, _, _) when Exp.is_this rhs
+    | Sil.Load (id, rhs, _, _) when Exp.is_this rhs ->
-     -> (nullified_flds, Ident.IdentSet.add id this_ids)
+        (nullified_flds, Ident.IdentSet.add id this_ids)
-    | _
+    | _ ->
-     -> (nullified_flds, this_ids)
+        (nullified_flds, this_ids)
   in
   let nullified_flds, _ =
     Procdesc.fold_instrs collect_nullified_flds (Typ.Fieldname.Set.empty, Ident.IdentSet.empty)
@@ -357,10 +386,12 @@ let get_fields_nullified procdesc =
   in
   nullified_flds
 
+
 (** Checks if the exception is an unchecked exception *)
 let is_runtime_exception tenv typename =
   is_subtype_of_str tenv typename "java.lang.RuntimeException"
 
+
 (** Checks if the class name is a Java exception *)
 let is_exception tenv typename = is_subtype_of_str tenv typename "java.lang.Exception"
 
@@ -370,31 +401,34 @@ let is_throwable tenv typename = is_subtype_of_str tenv typename "java.lang.Thro
 (** tests whether any class attributes (e.g., @ThreadSafe) pass check of first argument,
     including for supertypes*)
 let check_class_attributes check tenv = function
-  | Typ.Procname.Java java_pname
+  | Typ.Procname.Java java_pname ->
-   -> let check_class_annots _ {Typ.Struct.annots} = check annots in
+      let check_class_annots _ {Typ.Struct.annots} = check annots in
       supertype_exists tenv check_class_annots (Typ.Procname.java_get_class_type_name java_pname)
-  | _
+  | _ ->
-   -> false
+      false
+
 
 (** tests whether any class attributes (e.g., @ThreadSafe) pass check of first argument,
     for the current class only*)
 let check_current_class_attributes check tenv = function
   | Typ.Procname.Java java_pname -> (
     match Tenv.lookup tenv (Typ.Procname.java_get_class_type_name java_pname) with
-    | Some struct_typ
+    | Some struct_typ ->
-     -> check struct_typ.annots
+        check struct_typ.annots
-    | _
+    | _ ->
-     -> false )
+        false )
-  | _
+  | _ ->
-   -> false
+      false
+
 
 (** find superclasss with attributes (e.g., @ThreadSafe), including current class*)
 let rec find_superclasses_with_attributes check tenv tname =
   match Tenv.lookup tenv tname with
-  | Some struct_typ
+  | Some struct_typ ->
-   -> let result_from_supers =
+      let result_from_supers =
         List.concat (List.map ~f:(find_superclasses_with_attributes check tenv) struct_typ.supers)
       in
       if check struct_typ.annots then tname :: result_from_supers else result_from_supers
-  | _
+  | _ ->
-   -> []
+      []
+

infer/src/absint/ProcCfg.ml

@@ -77,12 +77,14 @@ module InstrNode = struct
     let n = Procdesc.Node.compare_id id1 id2 in
     if n <> 0 then n else compare_index index1 index2
 
+
   let pp_id fmt (id, index) =
     match index with
-    | Node_index
+    | Node_index ->
-     -> Procdesc.Node.pp_id fmt id
+        Procdesc.Node.pp_id fmt id
-    | Instr_index i
+    | Instr_index i ->
-     -> F.fprintf fmt "(%a: %d)" Procdesc.Node.pp_id id i
+        F.fprintf fmt "(%a: %d)" Procdesc.Node.pp_id id i
+
 end
 
 module type S = sig
@@ -202,6 +204,7 @@ module Exceptional = struct
     in
     (pdesc, exceptional_preds)
 
+
   let instrs = Procdesc.Node.get_instrs
 
   let instr_ids n = List.map ~f:(fun i -> (i, None)) (instrs n)
@@ -216,26 +219,29 @@ module Exceptional = struct
     try Procdesc.IdMap.find (Procdesc.Node.get_id n) exn_pred_map
     with Not_found -> []
 
+
   (** get all normal and exceptional successors of [n]. *)
   let succs t n =
     let normal_succs = normal_succs t n in
     match exceptional_succs t n with
-    | []
+    | [] ->
-     -> normal_succs
+        normal_succs
-    | exceptional_succs
+    | exceptional_succs ->
-     -> normal_succs @ exceptional_succs |> List.sort ~cmp:Procdesc.Node.compare
+        normal_succs @ exceptional_succs |> List.sort ~cmp:Procdesc.Node.compare
         |> List.remove_consecutive_duplicates ~equal:Procdesc.Node.equal
 
+
   (** get all normal and exceptional predecessors of [n]. *)
   let preds t n =
     let normal_preds = normal_preds t n in
     match exceptional_preds t n with
-    | []
+    | [] ->
-     -> normal_preds
+        normal_preds
-    | exceptional_preds
+    | exceptional_preds ->
-     -> normal_preds @ exceptional_preds |> List.sort ~cmp:Procdesc.Node.compare
+        normal_preds @ exceptional_preds |> List.sort ~cmp:Procdesc.Node.compare
         |> List.remove_consecutive_duplicates ~equal:Procdesc.Node.equal
 
+
   let proc_desc (pdesc, _) = pdesc
 
   let start_node (pdesc, _) = Procdesc.get_start_node pdesc
@@ -285,6 +291,7 @@ struct
         let id = (Procdesc.Node.get_id t, Instr_index i) in
         (instr, Some id))
       (instrs t)
+
 end
 
 module NodeIdMap (CFG : S) = Caml.Map.Make (struct

infer/src/absint/Scheduler.ml

@@ -58,16 +58,19 @@ module ReversePostorder (CFG : ProcCfg.S) = struct
     let compute_priority cfg node visited_preds =
       List.length (CFG.preds cfg node) - IdSet.cardinal visited_preds
 
+
     let make cfg node =
       let visited_preds = IdSet.empty in
       let priority = compute_priority cfg node visited_preds in
       {node; visited_preds; priority}
 
+
     (* add [node_id] to the visited preds for [t] *)
     let add_visited_pred cfg t node_id =
       let visited_preds' = IdSet.add node_id t.visited_preds in
       let priority' = compute_priority cfg t.node visited_preds' in
       {t with visited_preds= visited_preds'; priority= priority'}
+
   end
 
   type t = {worklist: WorkUnit.t M.t; cfg: CFG.t}
@@ -88,6 +91,7 @@ module ReversePostorder (CFG : ProcCfg.S) = struct
     let new_worklist = List.fold ~f:schedule_succ ~init:t.worklist (CFG.succs t.cfg node) in
     {t with worklist= new_worklist}
 
+
   (* remove and return the node with the highest priority (note that smaller integers have higher
      priority), the ids of its visited predecessors, and new schedule *)
   (* TODO: could do this slightly more efficiently by keeping a list of priority zero nodes for
@@ -109,5 +113,6 @@ module ReversePostorder (CFG : ProcCfg.S) = struct
       Some (node, WorkUnit.visited_preds max_priority_work, t')
     with Not_found -> None
 
+
   let empty cfg = {worklist= M.empty; cfg}
 end

infer/src/absint/Summary.ml

@@ -32,8 +32,9 @@ module Make (P : Payload) : S with type payload = P.payload = struct
 
   let read_summary caller_pdesc callee_pname =
     match Ondemand.analyze_proc_name caller_pdesc callee_pname with
-    | None
+    | None ->
-     -> None
+        None
-    | Some summary
+    | Some summary ->
-     -> P.read_payload summary
+        P.read_payload summary
+
 end

infer/src/absint/Var.ml

@@ -30,10 +30,11 @@ let is_return = function ProgramVar pvar -> Pvar.is_return pvar | LogicalVar _ -
 let is_footprint = function ProgramVar _ -> false | LogicalVar id -> Ident.is_footprint id
 
 let pp fmt = function
-  | ProgramVar pv
+  | ProgramVar pv ->
-   -> Pvar.pp Pp.text fmt pv
+      Pvar.pp Pp.text fmt pv
-  | LogicalVar id
+  | LogicalVar id ->
-   -> Ident.pp Pp.text fmt id
+      Ident.pp Pp.text fmt id
+
 
 module Map = PrettyPrintable.MakePPMap (struct
   type nonrec t = t

infer/src/atd/jbuild.in

@@ -12,5 +12,6 @@ let cflags = common_cflags @ ["-w"; "-27-32-34-35-39"]
   (libraries (atdgen))
  ))
 |}
-     (String.concat " " cflags) (String.concat " " common_optflags)
+     (String.concat " " cflags)
+     (String.concat " " common_optflags)
    |> Jbuild_plugin.V1.send

infer/src/backend/Attribute.ml

@@ -23,38 +23,42 @@ let add tenv ?(footprint= false) ?(polarity= true) prop attr args =
   Prop.prop_atom_and tenv ~footprint prop
     (if polarity then Sil.Apred (attr, args) else Sil.Anpred (attr, args))
 
+
 let attributes_in_same_category attr1 attr2 =
   let cat1 = PredSymb.to_category attr1 in
   let cat2 = PredSymb.to_category attr2 in
   PredSymb.equal_category cat1 cat2
 
+
 (** Replace an attribute associated to the expression *)
 let add_or_replace_check_changed tenv check_attribute_change prop atom =
   match atom with
-  | Sil.Apred (att0, (_ :: _ as exps0)) | Anpred (att0, (_ :: _ as exps0))
+  | Sil.Apred (att0, (_ :: _ as exps0)) | Anpred (att0, (_ :: _ as exps0)) ->
-   -> let pairs = List.map ~f:(fun e -> (e, Prop.exp_normalize_prop tenv prop e)) exps0 in
+      let pairs = List.map ~f:(fun e -> (e, Prop.exp_normalize_prop tenv prop e)) exps0 in
       let _, nexp = List.hd_exn pairs in
       (* len exps0 > 0 by match *)
       let atom_map = function
         | Sil.Apred (att, exp :: _)
         | Anpred (att, exp :: _)
-          when Exp.equal nexp exp && attributes_in_same_category att att0
+          when Exp.equal nexp exp && attributes_in_same_category att att0 ->
-         -> check_attribute_change att att0 ; atom
+            check_attribute_change att att0 ; atom
-        | atom'
+        | atom' ->
-         -> atom'
+            atom'
       in
       let pi = prop.Prop.pi in
       let pi' = IList.map_changed atom_map pi in
       if phys_equal pi pi' then Prop.prop_atom_and tenv prop atom
       else Prop.normalize tenv (Prop.set prop ~pi:pi')
-  | _
+  | _ ->
-   -> prop
+      prop
+
 
 let add_or_replace tenv prop atom =
   (* wrapper for the most common case: do nothing *)
   let check_attr_changed _ _ = () in
   add_or_replace_check_changed tenv check_attr_changed prop atom
 
+
 (** Get all the attributes of the prop *)
 let get_all (prop: 'a Prop.t) =
   let res = ref [] in
@@ -62,34 +66,38 @@ let get_all (prop: 'a Prop.t) =
   List.iter ~f:do_atom prop.pi ;
   List.rev !res
 
+
 (** Get all the attributes of the prop *)
 let get_for_symb prop att =
   List.filter
     ~f:(function Sil.Apred (att', _) | Anpred (att', _) -> PredSymb.equal att' att | _ -> false)
     prop.Prop.pi
 
+
 (** Get the attribute associated to the expression, if any *)
 let get_for_exp tenv (prop: 'a Prop.t) exp =
   let nexp = Prop.exp_normalize_prop tenv prop exp in
   let atom_get_attr attributes atom =
     match atom with
-    | (Sil.Apred (_, es) | Anpred (_, es)) when List.mem ~equal:Exp.equal es nexp
+    | (Sil.Apred (_, es) | Anpred (_, es)) when List.mem ~equal:Exp.equal es nexp ->
-     -> atom :: attributes
+        atom :: attributes
-    | _
+    | _ ->
-     -> attributes
+        attributes
   in
   List.fold ~f:atom_get_attr ~init:[] prop.pi
 
+
 let get tenv prop exp category =
   let atts = get_for_exp tenv prop exp in
   List.find
     ~f:(function
-        | Sil.Apred (att, _) | Anpred (att, _)
+        | Sil.Apred (att, _) | Anpred (att, _) ->
-         -> PredSymb.equal_category (PredSymb.to_category att) category
+            PredSymb.equal_category (PredSymb.to_category att) category
-        | _
+        | _ ->
-         -> false)
+            false)
     atts
 
+
 let get_undef tenv prop exp = get tenv prop exp ACundef
 
 let get_resource tenv prop exp = get tenv prop exp ACresource
@@ -112,11 +120,13 @@ let has_dangling_uninit tenv prop exp =
     ~f:(function Sil.Apred (a, _) -> PredSymb.equal a (Adangling DAuninit) | _ -> false)
     la
 
+
 let filter_atoms tenv ~f prop =
   let pi0 = prop.Prop.pi in
   let pi1 = IList.filter_changed f pi0 in
   if phys_equal pi1 pi0 then prop else Prop.normalize tenv (Prop.set prop ~pi:pi1)
 
+
 let remove tenv prop atom =
   if is_pred atom then
     let natom = Prop.atom_normalize_prop tenv prop atom in
@@ -124,74 +134,80 @@ let remove tenv prop atom =
     filter_atoms tenv ~f prop
   else prop
 
+
 (** Remove an attribute from all the atoms in the heap *)
 let remove_for_attr tenv prop att0 =
   let f = function
-    | Sil.Apred (att, _) | Anpred (att, _)
+    | Sil.Apred (att, _) | Anpred (att, _) ->
-     -> not (PredSymb.equal att0 att)
+        not (PredSymb.equal att0 att)
-    | _
+    | _ ->
-     -> true
+        true
   in
   filter_atoms tenv ~f prop
 
+
 let remove_resource tenv ra_kind ra_res =
   let f = function
-    | Sil.Apred (Aresource res_action, _)
+    | Sil.Apred (Aresource res_action, _) ->
-     -> PredSymb.compare_res_act_kind res_action.ra_kind ra_kind <> 0
+        PredSymb.compare_res_act_kind res_action.ra_kind ra_kind <> 0
         || PredSymb.compare_resource res_action.ra_res ra_res <> 0
-    | _
+    | _ ->
-     -> true
+        true
   in
   filter_atoms tenv ~f
 
+
 (** Apply f to every resource attribute in the prop *)
 let map_resource tenv prop f =
   let attribute_map e = function
-    | PredSymb.Aresource ra
+    | PredSymb.Aresource ra ->
-     -> PredSymb.Aresource (f e ra)
+        PredSymb.Aresource (f e ra)
-    | att
+    | att ->
-     -> att
+        att
   in
   let atom_map = function
-    | Sil.Apred (att, ([e] as es))
+    | Sil.Apred (att, ([e] as es)) ->
-     -> Sil.Apred (attribute_map e att, es)
+        Sil.Apred (attribute_map e att, es)
-    | Sil.Anpred (att, ([e] as es))
+    | Sil.Anpred (att, ([e] as es)) ->
-     -> Sil.Anpred (attribute_map e att, es)
+        Sil.Anpred (attribute_map e att, es)
-    | atom
+    | atom ->
-     -> atom
+        atom
   in
   let pi0 = prop.Prop.pi in
   let pi1 = IList.map_changed atom_map pi0 in
   if phys_equal pi1 pi0 then prop else Prop.normalize tenv (Prop.set prop ~pi:pi1)
 
+
 (* Replace an attribute OBJC_NULL($n1) with OBJC_NULL(var) when var = $n1, and also sets $n1 =
    0 *)
 let replace_objc_null tenv prop lhs_exp rhs_exp =
   match (get_objc_null tenv prop rhs_exp, rhs_exp) with
-  | Some atom, Exp.Var _
+  | Some atom, Exp.Var _ ->
-   -> let prop = remove tenv prop atom in
+      let prop = remove tenv prop atom in
       let prop = Prop.conjoin_eq tenv rhs_exp Exp.zero prop in
       let natom = Sil.atom_replace_exp [(rhs_exp, lhs_exp)] atom in
       add_or_replace tenv prop natom
-  | _
+  | _ ->
-   -> prop
+      prop
+
 
 let rec nullify_exp_with_objc_null tenv prop exp =
   match exp with
-  | Exp.BinOp (_, exp1, exp2)
+  | Exp.BinOp (_, exp1, exp2) ->
-   -> let prop' = nullify_exp_with_objc_null tenv prop exp1 in
+      let prop' = nullify_exp_with_objc_null tenv prop exp1 in
       nullify_exp_with_objc_null tenv prop' exp2
-  | Exp.UnOp (_, exp, _)
+  | Exp.UnOp (_, exp, _) ->
-   -> nullify_exp_with_objc_null tenv prop exp
+      nullify_exp_with_objc_null tenv prop exp
   | Exp.Var _ -> (
     match get_objc_null tenv prop exp with
-    | Some atom
+    | Some atom ->
-     -> let prop' = remove tenv prop atom in
+        let prop' = remove tenv prop atom in
         Prop.conjoin_eq tenv exp Exp.zero prop'
-    | _
+    | _ ->
-     -> prop )
+        prop )
-  | _
+  | _ ->
-   -> prop
+      prop
+
 
 (** mark Exp.Var's or Exp.Lvar's as undefined
 The annotations of the return type of the method get propagated to the return id,
@@ -201,23 +217,24 @@ let mark_vars_as_undefined tenv prop ~ret_exp_opt ~undefined_actuals_by_ref call
     loc path_pos =
   let mark_var_as_undefined ~annot exp prop =
     match exp with
-    | Exp.Var _ | Lvar _
+    | Exp.Var _ | Lvar _ ->
-     -> let att_undef = PredSymb.Aundef (callee_pname, annot, loc, path_pos) in
+        let att_undef = PredSymb.Aundef (callee_pname, annot, loc, path_pos) in
         add_or_replace tenv prop (Apred (att_undef, [exp]))
-    | _
+    | _ ->
-     -> prop
+        prop
   in
   let prop_with_ret_attr =
     match ret_exp_opt with
-    | Some ret_exp
+    | Some ret_exp ->
-     -> mark_var_as_undefined ~annot:ret_annots ret_exp prop
+        mark_var_as_undefined ~annot:ret_annots ret_exp prop
-    | None
+    | None ->
-     -> prop
+        prop
   in
   List.fold
     ~f:(fun prop id -> mark_var_as_undefined ~annot:[] id prop)
     ~init:prop_with_ret_attr undefined_actuals_by_ref
 
+
 (** type for arithmetic problems *)
 type arith_problem =
   (* division by zero *)
@@ -232,68 +249,69 @@ let find_arithmetic_problem tenv proc_node_session prop exp =
   let res = ref prop in
   let check_zero e =
     match Prop.exp_normalize_prop tenv prop e with
-    | Exp.Const c when Const.iszero_int_float c
+    | Exp.Const c when Const.iszero_int_float c ->
-     -> true
+        true
-    | _
+    | _ ->
-     -> res := add_or_replace tenv !res (Apred (Adiv0 proc_node_session, [e])) ;
+        res := add_or_replace tenv !res (Apred (Adiv0 proc_node_session, [e])) ;
         false
   in
   let rec walk = function
-    | Exp.Var _
+    | Exp.Var _ ->
-     -> ()
+        ()
     | Exp.UnOp
         ( Unop.Neg
         , e
         , Some
             ( {Typ.desc= Tint (Typ.IUChar | Typ.IUInt | Typ.IUShort | Typ.IULong | Typ.IULongLong)}
-            as typ ) )
+            as typ ) ) ->
-     -> uminus_unsigned := (e, typ) :: !uminus_unsigned
+        uminus_unsigned := (e, typ) :: !uminus_unsigned
-    | Exp.UnOp (_, e, _)
+    | Exp.UnOp (_, e, _) ->
-     -> walk e
+        walk e
-    | Exp.BinOp (op, e1, e2)
+    | Exp.BinOp (op, e1, e2) ->
-     -> if Binop.equal op Binop.Div || Binop.equal op Binop.Mod then exps_divided
+        if Binop.equal op Binop.Div || Binop.equal op Binop.Mod then exps_divided
           := e2 :: !exps_divided ;
         walk e1 ;
         walk e2
-    | Exp.Exn _
+    | Exp.Exn _ ->
-     -> ()
+        ()
-    | Exp.Closure _
+    | Exp.Closure _ ->
-     -> ()
+        ()
-    | Exp.Const _
+    | Exp.Const _ ->
-     -> ()
+        ()
-    | Exp.Cast (_, e)
+    | Exp.Cast (_, e) ->
-     -> walk e
+        walk e
-    | Exp.Lvar _
+    | Exp.Lvar _ ->
-     -> ()
+        ()
-    | Exp.Lfield (e, _, _)
+    | Exp.Lfield (e, _, _) ->
-     -> walk e
+        walk e
-    | Exp.Lindex (e1, e2)
+    | Exp.Lindex (e1, e2) ->
-     -> walk e1 ; walk e2
+        walk e1 ; walk e2
-    | Exp.Sizeof {dynamic_length= None}
+    | Exp.Sizeof {dynamic_length= None} ->
-     -> ()
+        ()
-    | Exp.Sizeof {dynamic_length= Some len}
+    | Exp.Sizeof {dynamic_length= Some len} ->
-     -> walk len
+        walk len
   in
   walk exp ;
   let problem_opt =
     match (List.find ~f:check_zero !exps_divided, !uminus_unsigned) with
-    | Some e, _
+    | Some e, _ ->
-     -> Some (Div0 e)
+        Some (Div0 e)
-    | None, (e, t) :: _
+    | None, (e, t) :: _ ->
-     -> Some (UminusUnsigned (e, t))
+        Some (UminusUnsigned (e, t))
-    | None, []
+    | None, [] ->
-     -> None
+        None
   in
   (problem_opt, !res)
 
+
 (** Deallocate the stack variables in [pvars], and replace them by normal variables.
     Return the list of stack variables whose address was still present after deallocation. *)
 let deallocate_stack_vars tenv (p: 'a Prop.t) pvars =
   let filter = function
-    | Sil.Hpointsto (Exp.Lvar v, _, _)
+    | Sil.Hpointsto (Exp.Lvar v, _, _) ->
-     -> List.exists ~f:(Pvar.equal v) pvars
+        List.exists ~f:(Pvar.equal v) pvars
-    | _
+    | _ ->
-     -> false
+        false
   in
   let sigma_stack, sigma_other = List.partition_tf ~f:filter p.sigma in
   let fresh_address_vars = ref [] in
@@ -303,12 +321,12 @@ let deallocate_stack_vars tenv (p: 'a Prop.t) pvars =
   let exp_replace =
     List.map
       ~f:(function
-          | Sil.Hpointsto (Exp.Lvar v, _, _)
+          | Sil.Hpointsto (Exp.Lvar v, _, _) ->
-           -> let freshv = Ident.create_fresh Ident.kprimed in
+              let freshv = Ident.create_fresh Ident.kprimed in
               fresh_address_vars := (v, freshv) :: !fresh_address_vars ;
               (Exp.Lvar v, Exp.Var freshv)
-          | _
+          | _ ->
-           -> assert false)
+              assert false)
       sigma_stack
   in
   let pi1 = List.map ~f:(fun (id, e) -> Sil.Aeq (Exp.Var id, e)) (Sil.sub_to_list p.sub) in
@@ -342,6 +360,7 @@ let deallocate_stack_vars tenv (p: 'a Prop.t) pvars =
   let p''' = if changed then Prop.normalize tenv (Prop.set p'' ~pi:filtered_pi) else p'' in
   (!stack_vars_address_in_post, List.fold ~f:(Prop.prop_atom_and tenv) ~init:p''' pi)
 
+
 (** Input of this method is an exp in a prop. Output is a formal variable or path from a
     formal variable that is equal to the expression,
     or the OBJC_NULL attribute of the expression. *)
@@ -353,40 +372,41 @@ let find_equal_formal_path tenv e prop =
         else
           let seen_hpreds = hpred :: seen_hpreds in
           match res with
-          | Some _
+          | Some _ ->
-           -> res
+              res
           | None ->
             match hpred with
             | Sil.Hpointsto (Exp.Lvar pvar1, Sil.Eexp (exp2, Sil.Iformal (_, _)), _)
-              when Exp.equal exp2 e && (Pvar.is_local pvar1 || Pvar.is_seed pvar1)
+              when Exp.equal exp2 e && (Pvar.is_local pvar1 || Pvar.is_seed pvar1) ->
-             -> Some (Exp.Lvar pvar1)
+                Some (Exp.Lvar pvar1)
-            | Sil.Hpointsto (exp1, Sil.Estruct (fields, _), _)
+            | Sil.Hpointsto (exp1, Sil.Estruct (fields, _), _) ->
-             -> List.fold_right
+                List.fold_right
                   ~f:(fun (field, strexp) res ->
                     match res with
-                    | Some _
+                    | Some _ ->
-                     -> res
+                        res
                     | None ->
                       match strexp with
                       | Sil.Eexp (exp2, _) when Exp.equal exp2 e -> (
                         match find_in_sigma exp1 seen_hpreds with
-                        | Some vfs
+                        | Some vfs ->
-                         -> Some (Exp.Lfield (vfs, field, Typ.mk Tvoid))
+                            Some (Exp.Lfield (vfs, field, Typ.mk Tvoid))
-                        | None
+                        | None ->
-                         -> None )
+                            None )
-                      | _
+                      | _ ->
-                       -> None)
+                          None)
                   fields ~init:None
-            | _
+            | _ ->
-             -> None)
+                None)
       prop.Prop.sigma ~init:None
   in
   match find_in_sigma e [] with
-  | Some vfs
+  | Some vfs ->
-   -> Some vfs
+      Some vfs
   | None ->
     match get_objc_null tenv prop e with
-    | Some Apred (Aobjc_null, [_; vfs])
+    | Some Apred (Aobjc_null, [_; vfs]) ->
-     -> Some vfs
+        Some vfs
-    | _
+    | _ ->
-     -> None
+        None
+

infer/src/backend/Differential.ml

@@ -20,21 +20,23 @@ let of_reports ~(current_report: Jsonbug_t.report) ~(previous_report: Jsonbug_t.
   in
   let fold_aux ~key:_ ~data (left, both, right) =
     match data with
-    | `Left left'
+    | `Left left' ->
-     -> (List.rev_append left' left, both, right)
+        (List.rev_append left' left, both, right)
-    | `Both (both', _)
+    | `Both (both', _) ->
-     -> (left, List.rev_append both' both, right)
+        (left, List.rev_append both' both, right)
-    | `Right right'
+    | `Right right' ->
-     -> (left, both, List.rev_append right' right)
+        (left, both, List.rev_append right' right)
   in
   let introduced, preexisting, fixed =
     Map.fold2 (to_map current_report) (to_map previous_report) ~f:fold_aux ~init:([], [], [])
   in
   {introduced; fixed; preexisting}
 
+
 let to_files {introduced; fixed; preexisting} destdir =
   Out_channel.write_all (destdir ^/ "introduced.json")
     ~data:(Jsonbug_j.string_of_report introduced) ;
   Out_channel.write_all (destdir ^/ "fixed.json") ~data:(Jsonbug_j.string_of_report fixed) ;
   Out_channel.write_all (destdir ^/ "preexisting.json")
     ~data:(Jsonbug_j.string_of_report preexisting)
+

infer/src/backend/DifferentialFilters.ml

@@ -29,22 +29,22 @@ module FileRenamings = struct
       try
         match assoc with
         | `Assoc l
-         -> (
+          -> (
             let current_opt = List.Assoc.find ~equal:String.equal l "current" in
             let previous_opt = List.Assoc.find ~equal:String.equal l "previous" in
             match (current_opt, previous_opt) with
-            | Some `String current, Some `String previous
+            | Some `String current, Some `String previous ->
-             -> {current; previous}
+                {current; previous}
-            | None, _
+            | None, _ ->
-             -> raise (Yojson.Json_error "\"current\" field missing")
+                raise (Yojson.Json_error "\"current\" field missing")
-            | Some _, None
+            | Some _, None ->
-             -> raise (Yojson.Json_error "\"previous\" field missing")
+                raise (Yojson.Json_error "\"previous\" field missing")
-            | Some _, Some `String _
+            | Some _, Some `String _ ->
-             -> raise (Yojson.Json_error "\"current\" field is not a string")
+                raise (Yojson.Json_error "\"current\" field is not a string")
-            | Some _, Some _
+            | Some _, Some _ ->
-             -> raise (Yojson.Json_error "\"previous\" field is not a string") )
+                raise (Yojson.Json_error "\"previous\" field is not a string") )
-        | _
+        | _ ->
-         -> raise (Yojson.Json_error "not a record")
+            raise (Yojson.Json_error "not a record")
       with Yojson.Json_error err ->
         L.(die UserError)
           "Error parsing file renamings: %s@\nExpected JSON object of the following form: '%s', but instead got: '%s'"
@@ -52,10 +52,11 @@ module FileRenamings = struct
           (Yojson.Basic.to_string assoc)
     in
     match j with
-    | `List json_renamings
+    | `List json_renamings ->
-     -> List.map ~f:renaming_of_assoc json_renamings
+        List.map ~f:renaming_of_assoc json_renamings
-    | _
+    | _ ->
-     -> L.(die UserError) "Expected JSON list but got '%s'" input
+        L.(die UserError) "Expected JSON list but got '%s'" input
+
 
   let from_json_file file : t = from_json (In_channel.read_all file)
 
@@ -63,12 +64,14 @@ module FileRenamings = struct
     let r = List.find ~f:(fun r -> String.equal current r.current) t in
     Option.map ~f:(fun r -> r.previous) r
 
+
   let pp fmt t =
     let pp_tuple fmt {current; previous} =
       Format.fprintf fmt "{\"current\": \"%s\", \"previous\": \"%s\"}" current previous
     in
     Format.fprintf fmt "[%a]" (Pp.comma_seq pp_tuple) t
 
+
   module VISIBLE_FOR_TESTING_DO_NOT_USE_DIRECTLY = struct
     let from_renamings = from_renamings
 
@@ -82,32 +85,33 @@ end
     intersection of [l1] and [l2] according to [cmd] and additionally satisfy [pred], and [lN'] is
     [lN] minus [dups]. [dups] contains only one witness for each removed issue, taken from [l1]. *)
 let relative_complements ~cmp ?(pred= fun _ -> true) l1 l2 =
-  let rec aux (out_l1, dups, out_l2 as out) in_l1 in_l2 =
+  let rec aux ((out_l1, dups, out_l2) as out) in_l1 in_l2 =
     let is_last_seen_dup v = match dups with ld :: _ -> Int.equal (cmp ld v) 0 | [] -> false in
     match (in_l1, in_l2) with
-    | i :: is, f :: fs when Int.equal (cmp i f) 0
+    | i :: is, f :: fs when Int.equal (cmp i f) 0 ->
-     -> (* i = f *)
+        (* i = f *)
         if pred i then aux (out_l1, i :: dups, out_l2) is fs
         else aux (i :: out_l1, dups, f :: out_l2) is fs
-    | i :: is, f :: _ when cmp i f < 0
+    | i :: is, f :: _ when cmp i f < 0 ->
-     -> (* i < f *)
+        (* i < f *)
         let out_l1' = if is_last_seen_dup i then out_l1 else i :: out_l1 in
         aux (out_l1', dups, out_l2) is in_l2
-    | _ :: _, f :: fs
+    | _ :: _, f :: fs ->
-     -> (* i > f *)
+        (* i > f *)
         let out_l2' = if is_last_seen_dup f then out_l2 else f :: out_l2 in
         aux (out_l1, dups, out_l2') in_l1 fs
-    | i :: is, [] when is_last_seen_dup i
+    | i :: is, [] when is_last_seen_dup i ->
-     -> aux out is in_l2
+        aux out is in_l2
-    | [], f :: fs when is_last_seen_dup f
+    | [], f :: fs when is_last_seen_dup f ->
-     -> aux out in_l1 fs
+        aux out in_l1 fs
-    | _, _
+    | _, _ ->
-     -> (List.rev_append in_l1 out_l1, dups, List.rev_append in_l2 out_l2)
+        (List.rev_append in_l1 out_l1, dups, List.rev_append in_l2 out_l2)
   in
   let l1_sorted = List.sort ~cmp l1 in
   let l2_sorted = List.sort ~cmp l2 in
   aux ([], [], []) l1_sorted l2_sorted
 
+
 type issue_file_with_renaming = Jsonbug_t.jsonbug * string option
 
 let skip_duplicated_types_on_filenames renamings (diff: Differential.t) : Differential.t =
@@ -118,7 +122,7 @@ let skip_duplicated_types_on_filenames renamings (diff: Differential.t) : Differ
     in
     String.compare f1 f2
   in
-  let cmp (issue1, _ as issue_with_previous_file1) (issue2, _ as issue_with_previous_file2) =
+  let cmp ((issue1, _) as issue_with_previous_file1) ((issue2, _) as issue_with_previous_file2) =
     [%compare : int * string * issue_file_with_renaming]
       (issue1.Jsonbug_t.key, issue1.Jsonbug_t.bug_type, issue_with_previous_file1)
       (issue2.Jsonbug_t.key, issue2.Jsonbug_t.bug_type, issue_with_previous_file2)
@@ -142,6 +146,7 @@ let skip_duplicated_types_on_filenames renamings (diff: Differential.t) : Differ
   in
   {introduced; fixed; preexisting}
 
+
 let java_anon_class_pattern = Str.regexp "\\$[0-9]+"
 
 type procedure_id = string
@@ -164,12 +169,14 @@ let compare_procedure_id pid1 pid2 =
   in
   String.compare pid1_norm_trimmed pid2_norm_trimmed
 
+
 let value_of_qualifier_tag qts tag =
   match List.find ~f:(fun elem -> String.equal elem.Jsonbug_t.tag tag) qts with
-  | Some qt
+  | Some qt ->
-   -> Some qt.Jsonbug_t.value
+      Some qt.Jsonbug_t.value
-  | None
+  | None ->
-   -> None
+      None
+
 
 type file_extension = string [@@deriving compare]
 
@@ -206,10 +213,10 @@ let skip_anonymous_class_renamings (diff: Differential.t) : Differential.t =
   let pred (issue: Jsonbug_t.jsonbug) =
     let is_java_file () =
       match extension issue.file with
-      | Some ext
+      | Some ext ->
-       -> String.equal (String.lowercase ext) "java"
+          String.equal (String.lowercase ext) "java"
-      | None
+      | None ->
-       -> false
+          false
     in
     let has_anonymous_class_token () =
       try
@@ -224,11 +231,12 @@ let skip_anonymous_class_renamings (diff: Differential.t) : Differential.t =
   in
   {introduced; fixed; preexisting= preexisting @ diff.preexisting}
 
+
 (* Strip issues whose paths are not among those we're interested in *)
 let interesting_paths_filter (interesting_paths: SourceFile.t list option) =
   match interesting_paths with
-  | Some (paths: SourceFile.t list)
+  | Some (paths: SourceFile.t list) ->
-   -> let interesting_paths_set =
+      let interesting_paths_set =
         paths
         |> List.filter_map ~f:(fun p ->
                if not (SourceFile.is_invalid p) && SourceFile.is_under_project_root p then
@@ -240,8 +248,9 @@ let interesting_paths_filter (interesting_paths: SourceFile.t list option) =
         List.filter
           ~f:(fun issue -> String.Set.mem interesting_paths_set issue.Jsonbug_t.file)
           report
-  | None
+  | None ->
-   -> Fn.id
+      Fn.id
+
 
 let do_filter (diff: Differential.t) (renamings: FileRenamings.t) ~(skip_duplicated_types: bool)
     ~(interesting_paths: SourceFile.t list option) : Differential.t =
@@ -260,6 +269,7 @@ let do_filter (diff: Differential.t) (renamings: FileRenamings.t) ~(skip_duplica
   ; fixed= apply_paths_filter_if_needed `Fixed diff'.fixed
   ; preexisting= apply_paths_filter_if_needed `Preexisting diff'.preexisting }
 
+
 module VISIBLE_FOR_TESTING_DO_NOT_USE_DIRECTLY = struct
   let relative_complements = relative_complements
 

infer/src/backend/InferAnalyze.ml

@@ -21,7 +21,8 @@ let analyze_exe_env_tasks cluster exe_env : Tasks.t =
   let biabduction_only = Config.equal_analyzer Config.analyzer Config.BiAbduction in
   if biabduction_only then
     (* run the biabduction analysis only *)
-    Tasks.create (Interproc.do_analysis_closures exe_env)
+    Tasks.create
+      (Interproc.do_analysis_closures exe_env)
       ~continuation:
         ( if Config.write_html || Config.developer_mode then
             Some
@@ -37,6 +38,7 @@ let analyze_exe_env_tasks cluster exe_env : Tasks.t =
           Callbacks.iterate_callbacks call_graph exe_env ;
           if Config.write_html then Printer.write_all_html_files cluster) ]
 
+
 (** Create tasks to analyze a cluster *)
 let analyze_cluster_tasks cluster_num (cluster: Cluster.t) : Tasks.t =
   let exe_env = Exe_env.from_cluster cluster in
@@ -46,6 +48,7 @@ let analyze_cluster_tasks cluster_num (cluster: Cluster.t) : Tasks.t =
     "@\nProcessing cluster #%d with %d procedures@." (cluster_num + 1) num_procs ;
   analyze_exe_env_tasks cluster exe_env
 
+
 let analyze_cluster cluster_num cluster = Tasks.run (analyze_cluster_tasks cluster_num cluster)
 
 let output_json_makefile_stats clusters =
@@ -60,13 +63,15 @@ let output_json_makefile_stats clusters =
   let f = Out_channel.create (Filename.concat Config.results_dir Config.proc_stats_filename) in
   Yojson.Basic.pretty_to_channel f file_stats
 
+
 let process_cluster_cmdline fname =
   match Cluster.load_from_file (DB.filename_from_string fname) with
-  | None
+  | None ->
-   -> (if Config.keep_going then L.internal_error else L.die InternalError)
+      (if Config.keep_going then L.internal_error else L.die InternalError)
         "Cannot find cluster file %s@." fname
-  | Some (nr, cluster)
+  | Some (nr, cluster) ->
-   -> analyze_cluster (nr - 1) cluster
+      analyze_cluster (nr - 1) cluster
+
 
 let print_legend () =
   L.progress "Starting analysis...@\n" ;
@@ -84,6 +89,7 @@ let print_legend () =
       Config.log_analysis_recursion_timeout ) ;
   L.progress "@\n@?"
 
+
 let cluster_should_be_analyzed ~changed_files cluster =
   let fname = DB.source_dir_to_string cluster in
   (* whether [fname] is one of the [changed_files] *)
@@ -105,33 +111,35 @@ let cluster_should_be_analyzed ~changed_files cluster =
     modified
   in
   match is_changed_file with
-  | Some b
+  | Some b ->
-   -> b
+      b
-  | None when Config.reactive_mode
+  | None when Config.reactive_mode ->
-   -> check_modified ()
+      check_modified ()
-  | None
+  | None ->
-   -> true
+      true
+
 
 let register_active_checkers () =
   match Config.analyzer with
-  | Checkers | Crashcontext
+  | Checkers | Crashcontext ->
-   -> RegisterCheckers.get_active_checkers () |> RegisterCheckers.register
+      RegisterCheckers.get_active_checkers () |> RegisterCheckers.register
-  | BiAbduction | CaptureOnly | CompileOnly | Linters
+  | BiAbduction | CaptureOnly | CompileOnly | Linters ->
-   -> ()
+      ()
+
 
 let main ~changed_files ~makefile =
   BuiltinDefn.init () ;
   ( match Config.modified_targets with
-  | Some file
+  | Some file ->
-   -> MergeCapture.record_modified_targets_from_file file
+      MergeCapture.record_modified_targets_from_file file
-  | None
+  | None ->
-   -> () ) ;
+      () ) ;
   register_active_checkers () ;
   match Config.cluster_cmdline with
-  | Some fname
+  | Some fname ->
-   -> process_cluster_cmdline fname
+      process_cluster_cmdline fname
-  | None
+  | None ->
-   -> if Config.allow_specs_cleanup then DB.Results_dir.clean_specs_dir () ;
+      if Config.allow_specs_cleanup then DB.Results_dir.clean_specs_dir () ;
       let all_clusters = DB.find_source_dirs () in
       let clusters_to_analyze =
         List.filter ~f:(cluster_should_be_analyzed ~changed_files) all_clusters
@@ -144,10 +152,10 @@ let main ~changed_files ~makefile =
         (if Int.equal n_clusters_to_analyze 1 then "" else "s")
         Config.results_dir ;
       let is_java =
-        ( lazy
+        lazy
-        (List.exists
+          (List.exists
-           ~f:(fun cl -> DB.string_crc_has_extension ~ext:"java" (DB.source_dir_to_string cl))
+             ~f:(fun cl -> DB.string_crc_has_extension ~ext:"java" (DB.source_dir_to_string cl))
-           all_clusters) )
+             all_clusters)
       in
       L.debug Analysis Quiet "Dynamic dispatch mode: %s@."
         Config.(string_of_dynamic_dispatch dynamic_dispatch) ;
@@ -164,7 +172,8 @@ let main ~changed_files ~makefile =
           let aggregate_tasks = Tasks.aggregate ~size:Config.procedures_per_process tasks in
           Tasks.Runner.start runner ~tasks:aggregate_tasks
         in
-        List.iteri ~f:cluster_start_tasks clusters_to_analyze ; Tasks.Runner.complete runner )
+        List.iteri ~f:cluster_start_tasks clusters_to_analyze ;
+        Tasks.Runner.complete runner )
       else if makefile <> "" then
         ClusterMakefile.create_cluster_makefile clusters_to_analyze makefile
       else (
@@ -173,9 +182,11 @@ let main ~changed_files ~makefile =
         L.progress "@\nAnalysis finished in %as@." Pp.elapsed_time () ) ;
       output_json_makefile_stats clusters_to_analyze
 
+
 let register_perf_stats_report () =
   let stats_dir = Filename.concat Config.results_dir Config.backend_stats_dir_name in
   let cluster = match Config.cluster_cmdline with Some cl -> "_" ^ cl | None -> "" in
   let stats_base = Config.perf_stats_prefix ^ Filename.basename cluster ^ ".json" in
   let stats_file = Filename.concat stats_dir stats_base in
   PerfStats.register_report_at_exit stats_file
+

infer/src/backend/InferPrint.ml

@@ -13,7 +13,10 @@ module Hashtbl = Caml.Hashtbl
 module L = Logging
 module F = Format
 
-let print_usage_exit err_s = L.user_error "Load Error: %s@\n@." err_s ; Config.print_usage_exit ()
+let print_usage_exit err_s =
+  L.user_error "Load Error: %s@\n@." err_s ;
+  Config.print_usage_exit ()
+
 
 (** return the list of the .specs files in the results dir and libs, if they're defined *)
 let load_specfiles () =
@@ -31,6 +34,7 @@ let load_specfiles () =
   let result_specs_dir = DB.filename_to_string DB.Results_dir.specs_dir in
   specs_files_in_dir result_specs_dir
 
+
 (** Create and initialize latex file *)
 let begin_latex_file fmt =
   let author = "Infer " ^ Version.versionString in
@@ -38,14 +42,17 @@ let begin_latex_file fmt =
   let table_of_contents = true in
   Latex.pp_begin fmt (author, title, table_of_contents)
 
+
 let error_desc_to_csv_string error_desc =
   let pp fmt = F.fprintf fmt "%a" Localise.pp_error_desc error_desc in
   Escape.escape_csv (F.asprintf "%t" pp)
 
+
 let error_advice_to_csv_string error_desc =
   let pp fmt = F.fprintf fmt "%a" Localise.pp_error_advice error_desc in
   Escape.escape_csv (F.asprintf "%t" pp)
 
+
 let error_desc_to_plain_string error_desc =
   let pp fmt = F.fprintf fmt "%a" Localise.pp_error_desc error_desc in
   let s = F.asprintf "%t" pp in
@@ -56,6 +63,7 @@ let error_desc_to_plain_string error_desc =
   in
   s
 
+
 let error_desc_to_dotty_string error_desc = Localise.error_desc_get_dotty error_desc
 
 let error_desc_to_xml_tags error_desc =
@@ -63,6 +71,7 @@ let error_desc_to_xml_tags error_desc =
   let subtree label contents = Io_infer.Xml.create_tree label [] [Io_infer.Xml.String contents] in
   List.map ~f:(fun (tag, value) -> subtree tag (Escape.escape_xml value)) tags
 
+
 let get_bug_hash (kind: string) (type_str: string) (procedure_id: string) (filename: string)
     (node_key: int) (error_desc: Localise.error_desc) =
   let qualifier_tag_call_procedure = Localise.error_desc_get_tag_call_procedure error_desc in
@@ -76,29 +85,30 @@ let get_bug_hash (kind: string) (type_str: string) (procedure_id: string) (filen
     , qualifier_tag_call_procedure
     , qualifier_tag_value )
 
+
 let exception_value = "exception"
 
 let loc_trace_to_jsonbug_record trace_list ekind =
   match ekind with
-  | Exceptions.Kinfo
+  | Exceptions.Kinfo ->
-   -> []
+      []
-  | _
+  | _ ->
-   -> let tag_value_records_of_node_tag nt =
+      let tag_value_records_of_node_tag nt =
         match nt with
-        | Errlog.Condition cond
+        | Errlog.Condition cond ->
-         -> [ {Jsonbug_j.tag= Io_infer.Xml.tag_kind; value= "condition"}
+            [ {Jsonbug_j.tag= Io_infer.Xml.tag_kind; value= "condition"}
             ; {Jsonbug_j.tag= Io_infer.Xml.tag_branch; value= Printf.sprintf "%B" cond} ]
-        | Errlog.Exception exn_name
+        | Errlog.Exception exn_name ->
-         -> let res = [{Jsonbug_j.tag= Io_infer.Xml.tag_kind; value= exception_value}] in
+            let res = [{Jsonbug_j.tag= Io_infer.Xml.tag_kind; value= exception_value}] in
             let exn_str = Typ.Name.name exn_name in
             if String.is_empty exn_str then res
             else {Jsonbug_j.tag= Io_infer.Xml.tag_name; value= exn_str} :: res
-        | Errlog.Procedure_start pname
+        | Errlog.Procedure_start pname ->
-         -> [ {Jsonbug_j.tag= Io_infer.Xml.tag_kind; value= "procedure_start"}
+            [ {Jsonbug_j.tag= Io_infer.Xml.tag_kind; value= "procedure_start"}
             ; {Jsonbug_j.tag= Io_infer.Xml.tag_name; value= Typ.Procname.to_string pname}
             ; {Jsonbug_j.tag= Io_infer.Xml.tag_name_id; value= Typ.Procname.to_filename pname} ]
-        | Errlog.Procedure_end pname
+        | Errlog.Procedure_end pname ->
-         -> [ {Jsonbug_j.tag= Io_infer.Xml.tag_kind; value= "procedure_end"}
+            [ {Jsonbug_j.tag= Io_infer.Xml.tag_kind; value= "procedure_end"}
             ; {Jsonbug_j.tag= Io_infer.Xml.tag_name; value= Typ.Procname.to_string pname}
             ; {Jsonbug_j.tag= Io_infer.Xml.tag_name_id; value= Typ.Procname.to_filename pname} ]
       in
@@ -114,6 +124,7 @@ let loc_trace_to_jsonbug_record trace_list ekind =
       let record_list = List.rev (List.rev_map ~f:trace_item_to_record trace_list) in
       record_list
 
+
 type summary_val =
   { vname: string
   ; vname_id: string
@@ -175,6 +186,7 @@ let summary_values summary =
   ; vproof_coverage= Printf.sprintf "%2.2f" node_coverage
   ; vproof_trace= proof_trace }
 
+
 module ProcsCsv = struct
   (** Print the header of the procedures csv file, with column names *)
   let pp_header fmt () =
@@ -185,6 +197,7 @@ module ProcsCsv = struct
       Io_infer.Xml.tag_weight Io_infer.Xml.tag_proof_coverage Io_infer.Xml.tag_rank
       Io_infer.Xml.tag_in_calls Io_infer.Xml.tag_out_calls Io_infer.Xml.tag_proof_trace
 
+
   (** Write proc summary stats in csv format *)
   let pp_summary fmt summary =
     let pp x = F.fprintf fmt x in
@@ -201,6 +214,7 @@ module ProcsCsv = struct
     pp "%d," sv.vweight ;
     pp "%s," sv.vproof_coverage ;
     pp "%s@\n" sv.vproof_trace
+
 end
 
 let should_report (issue_kind: Exceptions.err_kind) issue_type error_desc eclass =
@@ -232,6 +246,7 @@ let should_report (issue_kind: Exceptions.err_kind) issue_type error_desc eclass
         issue_bucket_is_high
       else true
 
+
 module IssuesCsv = struct
   let csv_issues_id = ref 0
 
@@ -243,15 +258,16 @@ module IssuesCsv = struct
       Io_infer.Xml.tag_key Io_infer.Xml.tag_qualifier_tags Io_infer.Xml.tag_hash "bug_id"
       "always_report" "advice"
 
+
   let pp_issue fmt error_filter procname proc_loc_opt (key: Errlog.err_key)
       (err_data: Errlog.err_data) =
     let pp x = F.fprintf fmt x in
     let source_file =
       match proc_loc_opt with
-      | Some proc_loc
+      | Some proc_loc ->
-       -> proc_loc.Location.file
+          proc_loc.Location.file
-      | None
+      | None ->
-       -> err_data.loc.Location.file
+          err_data.loc.Location.file
     in
     if key.in_footprint && error_filter source_file key.err_desc key.err_name
        && should_report key.err_kind key.err_name key.err_desc err_data.err_class
@@ -273,10 +289,10 @@ module IssuesCsv = struct
       let filename = SourceFile.to_string source_file in
       let always_report =
         match Localise.error_desc_extract_tag_value key.err_desc "always_report" with
-        | ""
+        | "" ->
-         -> "false"
+            "false"
-        | v
+        | v ->
-         -> v
+            v
       in
       let trace =
         Jsonbug_j.string_of_json_trace
@@ -303,9 +319,11 @@ module IssuesCsv = struct
       pp "\"%s\"," always_report ;
       pp "\"%s\"@\n" err_advice_string
 
+
   (** Write bug report in csv format *)
   let pp_issues_of_error_log fmt error_filter _ proc_loc_opt procname err_log =
     Errlog.iter (pp_issue fmt error_filter procname proc_loc_opt) err_log
+
 end
 
 let potential_exception_message = "potential exception at line"
@@ -317,6 +335,7 @@ module IssuesJson = struct
     is_first_item := true ;
     F.fprintf fmt "[@?"
 
+
   let pp_json_close fmt () = F.fprintf fmt "]@\n@?"
 
   let pp_issue fmt error_filter procname proc_loc_opt (key: Errlog.err_key)
@@ -324,10 +343,10 @@ module IssuesJson = struct
     let pp x = F.fprintf fmt x in
     let source_file, procedure_start_line =
       match proc_loc_opt with
-      | Some proc_loc
+      | Some proc_loc ->
-       -> (proc_loc.Location.file, proc_loc.Location.line)
+          (proc_loc.Location.file, proc_loc.Location.line)
-      | None
+      | None ->
-       -> (err_data.loc.Location.file, 0)
+          (err_data.loc.Location.file, 0)
     in
     if SourceFile.is_invalid source_file then
       L.(die InternalError)
@@ -346,20 +365,20 @@ module IssuesJson = struct
       let file = SourceFile.to_string source_file in
       let json_ml_loc =
         match err_data.loc_in_ml_source with
-        | Some (file, lnum, cnum, enum) when Config.reports_include_ml_loc
+        | Some (file, lnum, cnum, enum) when Config.reports_include_ml_loc ->
-         -> Some Jsonbug_j.{file; lnum; cnum; enum}
+            Some Jsonbug_j.{file; lnum; cnum; enum}
-        | _
+        | _ ->
-         -> None
+            None
       in
       let visibility = Exceptions.string_of_visibility err_data.visibility in
       let qualifier =
         let base_qualifier = error_desc_to_plain_string key.err_desc in
         if IssueType.(equal resource_leak) key.err_name then
           match Errlog.compute_local_exception_line err_data.loc_trace with
-          | None
+          | None ->
-           -> base_qualifier
+              base_qualifier
-          | Some line
+          | Some line ->
-           -> let potential_exception_message =
+              let potential_exception_message =
                 Format.asprintf "%a: %s %d" MarkupFormatter.pp_bold "Note"
                   potential_exception_message line
               in
@@ -394,9 +413,11 @@ module IssuesJson = struct
       if not !is_first_item then pp "," else is_first_item := false ;
       pp "%s@?" (Jsonbug_j.string_of_jsonbug bug)
 
+
   (** Write bug report in JSON format *)
   let pp_issues_of_error_log fmt error_filter _ proc_loc_opt procname err_log =
     Errlog.iter (pp_issue fmt error_filter procname proc_loc_opt) err_log
+
 end
 
 let pp_custom_of_report fmt report fields =
@@ -412,71 +433,75 @@ let pp_custom_of_report fmt report fields =
     in
     let pp_field index field =
       match field with
-      | `Issue_field_bug_class
+      | `Issue_field_bug_class ->
-       -> Format.fprintf fmt "%s%s" (comma_separator index) issue.bug_class
+          Format.fprintf fmt "%s%s" (comma_separator index) issue.bug_class
-      | `Issue_field_kind
+      | `Issue_field_kind ->
-       -> Format.fprintf fmt "%s%s" (comma_separator index) issue.kind
+          Format.fprintf fmt "%s%s" (comma_separator index) issue.kind
-      | `Issue_field_bug_type
+      | `Issue_field_bug_type ->
-       -> Format.fprintf fmt "%s%s" (comma_separator index) issue.bug_type
+          Format.fprintf fmt "%s%s" (comma_separator index) issue.bug_type
-      | `Issue_field_qualifier
+      | `Issue_field_qualifier ->
-       -> Format.fprintf fmt "%s%s" (comma_separator index) issue.qualifier
+          Format.fprintf fmt "%s%s" (comma_separator index) issue.qualifier
-      | `Issue_field_severity
+      | `Issue_field_severity ->
-       -> Format.fprintf fmt "%s%s" (comma_separator index) issue.severity
+          Format.fprintf fmt "%s%s" (comma_separator index) issue.severity
-      | `Issue_field_visibility
+      | `Issue_field_visibility ->
-       -> Format.fprintf fmt "%s%s" (comma_separator index) issue.visibility
+          Format.fprintf fmt "%s%s" (comma_separator index) issue.visibility
-      | `Issue_field_line
+      | `Issue_field_line ->
-       -> Format.fprintf fmt "%s%d" (comma_separator index) issue.line
+          Format.fprintf fmt "%s%d" (comma_separator index) issue.line
-      | `Issue_field_column
+      | `Issue_field_column ->
-       -> Format.fprintf fmt "%s%d" (comma_separator index) issue.column
+          Format.fprintf fmt "%s%d" (comma_separator index) issue.column
-      | `Issue_field_procedure
+      | `Issue_field_procedure ->
-       -> Format.fprintf fmt "%s%s" (comma_separator index) issue.procedure
+          Format.fprintf fmt "%s%s" (comma_separator index) issue.procedure
-      | `Issue_field_procedure_id
+      | `Issue_field_procedure_id ->
-       -> Format.fprintf fmt "%s%s" (comma_separator index) issue.procedure_id
+          Format.fprintf fmt "%s%s" (comma_separator index) issue.procedure_id
-      | `Issue_field_procedure_start_line
+      | `Issue_field_procedure_start_line ->
-       -> Format.fprintf fmt "%s%d" (comma_separator index) issue.procedure_start_line
+          Format.fprintf fmt "%s%d" (comma_separator index) issue.procedure_start_line
-      | `Issue_field_file
+      | `Issue_field_file ->
-       -> Format.fprintf fmt "%s%s" (comma_separator index) issue.file
+          Format.fprintf fmt "%s%s" (comma_separator index) issue.file
-      | `Issue_field_bug_trace
+      | `Issue_field_bug_trace ->
-       -> pp_trace fmt issue.bug_trace (comma_separator index)
+          pp_trace fmt issue.bug_trace (comma_separator index)
-      | `Issue_field_key
+      | `Issue_field_key ->
-       -> Format.fprintf fmt "%s%d" (comma_separator index) issue.key
+          Format.fprintf fmt "%s%d" (comma_separator index) issue.key
-      | `Issue_field_hash
+      | `Issue_field_hash ->
-       -> Format.fprintf fmt "%s%d" (comma_separator index) issue.hash
+          Format.fprintf fmt "%s%d" (comma_separator index) issue.hash
-      | `Issue_field_line_offset
+      | `Issue_field_line_offset ->
-       -> Format.fprintf fmt "%s%d" (comma_separator index)
+          Format.fprintf fmt "%s%d" (comma_separator index)
             (issue.line - issue.procedure_start_line)
-      | `Issue_field_procedure_id_without_crc
+      | `Issue_field_procedure_id_without_crc ->
-       -> Format.fprintf fmt "%s%s" (comma_separator index) (DB.strip_crc issue.procedure_id)
+          Format.fprintf fmt "%s%s" (comma_separator index) (DB.strip_crc issue.procedure_id)
-      | `Issue_field_qualifier_contains_potential_exception_note
+      | `Issue_field_qualifier_contains_potential_exception_note ->
-       -> Format.fprintf fmt "%B"
+          Format.fprintf fmt "%B"
             (String.is_substring issue.qualifier ~substring:potential_exception_message)
     in
     List.iteri ~f:pp_field fields ; Format.fprintf fmt "@."
   in
   List.iter ~f:(pp_custom_of_issue fmt) report
 
+
 let tests_jsonbug_compare bug1 bug2 =
   let open Jsonbug_t in
   [%compare : string * string * int * string * int]
     (bug1.file, bug1.procedure, bug1.line - bug1.procedure_start_line, bug1.bug_type, bug1.hash)
     (bug2.file, bug2.procedure, bug2.line - bug2.procedure_start_line, bug2.bug_type, bug2.hash)
 
+
 module IssuesTxt = struct
   let pp_issue fmt error_filter proc_loc_opt (key: Errlog.err_key) (err_data: Errlog.err_data) =
     let source_file =
       match proc_loc_opt with
-      | Some proc_loc
+      | Some proc_loc ->
-       -> proc_loc.Location.file
+          proc_loc.Location.file
-      | None
+      | None ->
-       -> err_data.loc.Location.file
+          err_data.loc.Location.file
     in
     if key.in_footprint && error_filter source_file key.err_desc key.err_name then
       Exceptions.pp_err ~node_key:err_data.node_id_key.node_key err_data.loc key.err_kind
         key.err_name key.err_desc None fmt ()
 
+
   (** Write bug report in text format *)
   let pp_issues_of_error_log fmt error_filter _ proc_loc_opt _ err_log =
     Errlog.iter (pp_issue fmt error_filter proc_loc_opt) err_log
+
 end
 
 let pp_text_of_report fmt report =
@@ -487,6 +512,7 @@ let pp_text_of_report fmt report =
   in
   List.iter ~f:pp_row report ; F.fprintf fmt "@?"
 
+
 module CallsCsv = struct
   (** Write proc summary stats in csv format *)
   let pp_calls fmt summary =
@@ -503,6 +529,7 @@ module CallsCsv = struct
       pp "%a@\n" Specs.CallStats.pp_trace trace
     in
     Specs.CallStats.iter do_call stats.Specs.call_stats
+
 end
 
 module Stats = struct
@@ -536,10 +563,12 @@ module Stats = struct
     ; nwarnings= 0
     ; saved_errors= [] }
 
+
   let process_loc loc stats =
     try Hashtbl.find stats.files loc.Location.file
     with Not_found -> Hashtbl.add stats.files loc.Location.file ()
 
+
   let loc_trace_to_string_list linereader indent_num ltr =
     let res = ref [] in
     let indent_string n =
@@ -569,14 +598,15 @@ module Stats = struct
     List.iter ~f:loc_to_string ltr ;
     List.rev !res
 
+
   let process_err_log error_filter linereader err_log stats =
     let found_errors = ref false in
     let process_row (key: Errlog.err_key) (err_data: Errlog.err_data) =
       let type_str = key.err_name.IssueType.unique_id in
       if key.in_footprint && error_filter key.err_desc key.err_name then
         match key.err_kind with
-        | Exceptions.Kerror
+        | Exceptions.Kerror ->
-         -> found_errors := true ;
+            found_errors := true ;
             stats.nerrors <- stats.nerrors + 1 ;
             let error_strs =
               let pp1 fmt = F.fprintf fmt "%d: %s" stats.nerrors type_str in
@@ -589,17 +619,18 @@ module Stats = struct
             in
             let trace = loc_trace_to_string_list linereader 1 err_data.loc_trace in
             stats.saved_errors <- List.rev_append (error_strs @ trace @ [""]) stats.saved_errors
-        | Exceptions.Kwarning
+        | Exceptions.Kwarning ->
-         -> stats.nwarnings <- stats.nwarnings + 1
+            stats.nwarnings <- stats.nwarnings + 1
-        | Exceptions.Kinfo
+        | Exceptions.Kinfo ->
-         -> stats.ninfos <- stats.ninfos + 1
+            stats.ninfos <- stats.ninfos + 1
-        | Exceptions.Kadvice
+        | Exceptions.Kadvice ->
-         -> stats.nadvice <- stats.nadvice + 1
+            stats.nadvice <- stats.nadvice + 1
-        | Exceptions.Klike
+        | Exceptions.Klike ->
-         -> stats.nlikes <- stats.nlikes + 1
+            stats.nlikes <- stats.nlikes + 1
     in
     Errlog.iter process_row err_log ; !found_errors
 
+
   let process_summary error_filter summary linereader stats =
     let specs = Specs.get_specs_from_payload summary in
     let found_errors =
@@ -619,6 +650,7 @@ module Stats = struct
     if is_defective then stats.ndefective <- stats.ndefective + 1 ;
     process_loc summary.Specs.attributes.ProcAttributes.loc stats
 
+
   let num_files stats = Hashtbl.length stats.files
 
   let pp fmt stats =
@@ -635,6 +667,7 @@ module Stats = struct
     F.fprintf fmt "@\n -------------------@\n" ;
     F.fprintf fmt "@\nDetailed Errors@\n@\n" ;
     List.iter ~f:(fun s -> F.fprintf fmt "%s@\n" s) (List.rev stats.saved_errors)
+
 end
 
 module Report = struct
@@ -642,6 +675,7 @@ module Report = struct
     F.fprintf fmt "Infer Analysis Results -- generated %a@\n@\n" Pp.current_time () ;
     F.fprintf fmt "Summary Report@\n@\n"
 
+
   let pp_stats fmt stats = Stats.pp fmt stats
 end
 
@@ -651,6 +685,7 @@ module Summary = struct
     if CLOpt.equal_command Config.command CLOpt.Report && not Config.quiet then
       L.result "Procedure: %a@\n%a@." Typ.Procname.pp proc_name Specs.pp_summary_text summary
 
+
   (** Write proc summary to latex file *)
   let write_summary_latex fmt summary =
     let proc_name = Specs.get_proc_name summary in
@@ -658,6 +693,7 @@ module Summary = struct
       ("Analysis of function " ^ Latex.convert_string (Typ.Procname.to_string proc_name)) ;
     F.fprintf fmt "@[<v>%a@]" (Specs.pp_summary_latex Black) summary
 
+
   let pp_summary_xml summary fname =
     if Config.xml_specs then
       let base = DB.chop_extension (DB.filename_from_string fname) in
@@ -672,6 +708,7 @@ module Summary = struct
               summary.Specs.attributes.ProcAttributes.loc outf.fmt ;
             Utils.close_outf outf )
 
+
   let print_summary_dot_svg summary fname =
     if Config.svg then
       let base = DB.chop_extension (DB.filename_from_string fname) in
@@ -688,6 +725,7 @@ module Summary = struct
           (Sys.command
              ( "dot -Tsvg \"" ^ DB.filename_to_string dot_file ^ "\" >\""
              ^ DB.filename_to_string svg_file ^ "\"" ))
+
 end
 
 (** Categorize the preconditions of specs and print stats *)
@@ -704,23 +742,27 @@ module PreconditionStats = struct
     let specs = Specs.get_specs_from_payload summary in
     let preconditions = List.map ~f:(fun spec -> Specs.Jprop.to_prop spec.Specs.pre) specs in
     match Prop.CategorizePreconditions.categorize preconditions with
-    | Prop.CategorizePreconditions.Empty
+    | Prop.CategorizePreconditions.Empty ->
-     -> incr nr_empty ; L.result "Procedure: %a footprint:Empty@." Typ.Procname.pp proc_name
+        incr nr_empty ;
-    | Prop.CategorizePreconditions.OnlyAllocation
+        L.result "Procedure: %a footprint:Empty@." Typ.Procname.pp proc_name
-     -> incr nr_onlyallocation ;
+    | Prop.CategorizePreconditions.OnlyAllocation ->
+        incr nr_onlyallocation ;
         L.result "Procedure: %a footprint:OnlyAllocation@." Typ.Procname.pp proc_name
-    | Prop.CategorizePreconditions.NoPres
+    | Prop.CategorizePreconditions.NoPres ->
-     -> incr nr_nopres ; L.result "Procedure: %a footprint:NoPres@." Typ.Procname.pp proc_name
+        incr nr_nopres ;
-    | Prop.CategorizePreconditions.DataConstraints
+        L.result "Procedure: %a footprint:NoPres@." Typ.Procname.pp proc_name
-     -> incr nr_dataconstraints ;
+    | Prop.CategorizePreconditions.DataConstraints ->
+        incr nr_dataconstraints ;
         L.result "Procedure: %a footprint:DataConstraints@." Typ.Procname.pp proc_name
 
+
   let pp_stats () =
     L.result "@.Precondition stats@." ;
     L.result "Procedures with no preconditions: %d@." !nr_nopres ;
     L.result "Procedures with empty precondition: %d@." !nr_empty ;
     L.result "Procedures with only allocation conditions: %d@." !nr_onlyallocation ;
     L.result "Procedures with data constraints: %d@." !nr_dataconstraints
+
 end
 
 (* Wrapper of an issue that compares all parts except the procname *)
@@ -731,6 +773,7 @@ module Issue = struct
   let compare_err_data_ (err_data1: Errlog.err_data) (err_data2: Errlog.err_data) =
     Location.compare err_data1.loc err_data2.loc
 
+
   type proc_name_ = Typ.Procname.t
 
   (* ignore proc name *)
@@ -751,6 +794,7 @@ module Issue = struct
         if num_pruned_issues > 0 then
           L.user_warning "Note: pruned %d duplicate issues" num_pruned_issues ) ;
     issues'
+
 end
 
 let error_filter filters proc_name file error_desc error_name =
@@ -761,6 +805,7 @@ let error_filter filters proc_name file error_desc error_name =
   && (filters.Inferconfig.path_filter file || always_report ())
   && filters.Inferconfig.error_filter error_name && filters.Inferconfig.proc_filter proc_name
 
+
 type report_kind = Issues | Procs | Stats | Calls | Summary [@@deriving compare]
 
 type bug_format_kind = Json | Csv | Tests | Text | Latex [@@deriving compare]
@@ -768,57 +813,63 @@ type bug_format_kind = Json | Csv | Tests | Text | Latex [@@deriving compare]
 let pp_issue_in_format (format_kind, (outf: Utils.outfile)) error_filter
     {Issue.proc_name; proc_location; err_key; err_data} =
   match format_kind with
-  | Csv
+  | Csv ->
-   -> IssuesCsv.pp_issue outf.fmt error_filter proc_name (Some proc_location) err_key err_data
+      IssuesCsv.pp_issue outf.fmt error_filter proc_name (Some proc_location) err_key err_data
-  | Json
+  | Json ->
-   -> IssuesJson.pp_issue outf.fmt error_filter proc_name (Some proc_location) err_key err_data
+      IssuesJson.pp_issue outf.fmt error_filter proc_name (Some proc_location) err_key err_data
-  | Latex
+  | Latex ->
-   -> L.(die InternalError) "Printing issues in latex is not implemented"
+      L.(die InternalError) "Printing issues in latex is not implemented"
-  | Tests
+  | Tests ->
-   -> L.(die InternalError) "Print issues as tests is not implemented"
+      L.(die InternalError) "Print issues as tests is not implemented"
-  | Text
+  | Text ->
-   -> IssuesTxt.pp_issue outf.fmt error_filter (Some proc_location) err_key err_data
+      IssuesTxt.pp_issue outf.fmt error_filter (Some proc_location) err_key err_data
+
 
 let pp_issues_in_format (format_kind, (outf: Utils.outfile)) =
   match format_kind with
-  | Json
+  | Json ->
-   -> IssuesJson.pp_issues_of_error_log outf.fmt
+      IssuesJson.pp_issues_of_error_log outf.fmt
-  | Csv
+  | Csv ->
-   -> IssuesCsv.pp_issues_of_error_log outf.fmt
+      IssuesCsv.pp_issues_of_error_log outf.fmt
-  | Tests
+  | Tests ->
-   -> L.(die InternalError) "Print issues as tests is not implemented"
+      L.(die InternalError) "Print issues as tests is not implemented"
-  | Text
+  | Text ->
-   -> IssuesTxt.pp_issues_of_error_log outf.fmt
+      IssuesTxt.pp_issues_of_error_log outf.fmt
-  | Latex
+  | Latex ->
-   -> L.(die InternalError) "Printing issues in latex is not implemented"
+      L.(die InternalError) "Printing issues in latex is not implemented"
+
 
 let pp_procs_in_format (format_kind, (outf: Utils.outfile)) =
   match format_kind with
-  | Csv
+  | Csv ->
-   -> ProcsCsv.pp_summary outf.fmt
+      ProcsCsv.pp_summary outf.fmt
-  | Json | Latex | Tests | Text
+  | Json | Latex | Tests | Text ->
-   -> L.(die InternalError) "Printing procs in json/latex/tests/text is not implemented"
+      L.(die InternalError) "Printing procs in json/latex/tests/text is not implemented"
+
 
 let pp_calls_in_format (format_kind, (outf: Utils.outfile)) =
   match format_kind with
-  | Csv
+  | Csv ->
-   -> CallsCsv.pp_calls outf.fmt
+      CallsCsv.pp_calls outf.fmt
-  | Json | Tests | Text | Latex
+  | Json | Tests | Text | Latex ->
-   -> L.(die InternalError) "Printing calls in json/tests/text/latex is not implemented"
+      L.(die InternalError) "Printing calls in json/tests/text/latex is not implemented"
+
 
 let pp_stats_in_format (format_kind, _) =
   match format_kind with
-  | Csv
+  | Csv ->
-   -> Stats.process_summary
+      Stats.process_summary
-  | Json | Tests | Text | Latex
+  | Json | Tests | Text | Latex ->
-   -> L.(die InternalError) "Printing stats in json/tests/text/latex is not implemented"
+      L.(die InternalError) "Printing stats in json/tests/text/latex is not implemented"
+
 
 let pp_summary_in_format (format_kind, (outf: Utils.outfile)) =
   match format_kind with
-  | Latex
+  | Latex ->
-   -> Summary.write_summary_latex outf.fmt
+      Summary.write_summary_latex outf.fmt
-  | Json | Csv | Tests | Text
+  | Json | Csv | Tests | Text ->
-   -> L.(die InternalError) "Printing summary in json/csv/tests/text is not implemented"
+      L.(die InternalError) "Printing summary in json/csv/tests/text is not implemented"
+
 
 let pp_issues_of_error_log error_filter linereader proc_loc_opt procname err_log bug_format_list =
   let pp_issues_in_format format =
@@ -826,15 +877,16 @@ let pp_issues_of_error_log error_filter linereader proc_loc_opt procname err_log
   in
   List.iter ~f:pp_issues_in_format bug_format_list
 
+
 let collect_issues summary issues_acc =
   let err_log = summary.Specs.attributes.ProcAttributes.err_log in
   let proc_name = Specs.get_proc_name summary in
   let proc_location = summary.Specs.attributes.ProcAttributes.loc in
   Errlog.fold
-    (fun err_key err_data acc ->
+    (fun err_key err_data acc -> {Issue.proc_name; proc_location; err_key; err_data} :: acc)
-      {Issue.proc_name= proc_name; proc_location; err_key; err_data} :: acc)
     err_log issues_acc
 
+
 let pp_procs summary procs_format_list =
   let pp_procs_in_format format =
     let pp_procs = pp_procs_in_format format in
@@ -842,6 +894,7 @@ let pp_procs summary procs_format_list =
   in
   List.iter ~f:pp_procs_in_format procs_format_list
 
+
 let pp_calls summary calls_format_list =
   let pp_calls_in_format format =
     let pp_calls = pp_calls_in_format format in
@@ -849,6 +902,7 @@ let pp_calls summary calls_format_list =
   in
   List.iter ~f:pp_calls_in_format calls_format_list
 
+
 let pp_stats error_filter linereader summary stats stats_format_list =
   let pp_stats_in_format format =
     let pp_stats = pp_stats_in_format format in
@@ -856,6 +910,7 @@ let pp_stats error_filter linereader summary stats stats_format_list =
   in
   List.iter ~f:pp_stats_in_format stats_format_list
 
+
 let pp_summary summary fname summary_format_list =
   let pp_summary_in_format format =
     let pp_summary = pp_summary_in_format format in
@@ -866,39 +921,42 @@ let pp_summary summary fname summary_format_list =
   Summary.pp_summary_xml summary fname ;
   Summary.print_summary_dot_svg summary fname
 
+
 let pp_summary_by_report_kind formats_by_report_kind summary fname error_filter linereader stats
     file issues_acc =
   let pp_summary_by_report_kind (report_kind, format_list) =
     match (report_kind, format_list) with
-    | Procs, _ :: _
+    | Procs, _ :: _ ->
-     -> pp_procs summary format_list
+        pp_procs summary format_list
-    | Stats, _ :: _
+    | Stats, _ :: _ ->
-     -> pp_stats (error_filter file) linereader summary stats format_list
+        pp_stats (error_filter file) linereader summary stats format_list
-    | Calls, _ :: _
+    | Calls, _ :: _ ->
-     -> pp_calls summary format_list
+        pp_calls summary format_list
-    | Summary, _
+    | Summary, _ ->
-     -> pp_summary summary fname format_list
+        pp_summary summary fname format_list
-    | _
+    | _ ->
-     -> ()
+        ()
   in
-  List.iter ~f:pp_summary_by_report_kind formats_by_report_kind ; collect_issues summary issues_acc
+  List.iter ~f:pp_summary_by_report_kind formats_by_report_kind ;
+  collect_issues summary issues_acc
+
 
 let pp_json_report_by_report_kind formats_by_report_kind fname =
   match Utils.read_file fname with
-  | Ok report_lines
+  | Ok report_lines ->
-   -> let pp_json_issues format_list report =
+      let pp_json_issues format_list report =
         let pp_json_issue (format_kind, (outf: Utils.outfile)) =
           match format_kind with
-          | Tests
+          | Tests ->
-           -> pp_custom_of_report outf.fmt report Config.issues_fields
+              pp_custom_of_report outf.fmt report Config.issues_fields
-          | Text
+          | Text ->
-           -> pp_text_of_report outf.fmt report
+              pp_text_of_report outf.fmt report
-          | Json
+          | Json ->
-           -> L.(die InternalError) "Printing issues from json does not support json output"
+              L.(die InternalError) "Printing issues from json does not support json output"
-          | Csv
+          | Csv ->
-           -> L.(die InternalError) "Printing issues from json does not support csv output"
+              L.(die InternalError) "Printing issues from json does not support csv output"
-          | Latex
+          | Latex ->
-           -> L.(die InternalError) "Printing issues from json does not support latex output"
+              L.(die InternalError) "Printing issues from json does not support latex output"
         in
         List.iter ~f:pp_json_issue format_list
       in
@@ -908,30 +966,33 @@ let pp_json_report_by_report_kind formats_by_report_kind fname =
       in
       let pp_report_by_report_kind (report_kind, format_list) =
         match (report_kind, format_list) with
-        | Issues, _ :: _
+        | Issues, _ :: _ ->
-         -> pp_json_issues format_list sorted_report
+            pp_json_issues format_list sorted_report
-        | _
+        | _ ->
-         -> ()
+            ()
       in
       List.iter ~f:pp_report_by_report_kind formats_by_report_kind
-  | Error error
+  | Error error ->
-   -> L.(die UserError) "Error reading '%s': %s" fname error
+      L.(die UserError) "Error reading '%s': %s" fname error
+
 
 let pp_lint_issues_by_report_kind formats_by_report_kind error_filter linereader procname error_log =
   let pp_summary_by_report_kind (report_kind, format_list) =
     match (report_kind, format_list) with
-    | Issues, _ :: _
+    | Issues, _ :: _ ->
-     -> pp_issues_of_error_log error_filter linereader None procname error_log format_list
+        pp_issues_of_error_log error_filter linereader None procname error_log format_list
-    | _
+    | _ ->
-     -> ()
+        ()
   in
   List.iter ~f:pp_summary_by_report_kind formats_by_report_kind
 
+
 (** Process lint issues of a procedure *)
 let pp_lint_issues filters formats_by_report_kind linereader procname error_log =
   let error_filter = error_filter filters procname in
   pp_lint_issues_by_report_kind formats_by_report_kind error_filter linereader procname error_log
 
+
 (** Process a summary *)
 let process_summary filters formats_by_report_kind linereader stats fname summary issues_acc =
   let file = summary.Specs.attributes.ProcAttributes.loc.Location.file in
@@ -947,6 +1008,7 @@ let process_summary filters formats_by_report_kind linereader stats fname summar
   Config.pp_simple := pp_simple_saved ;
   issues_acc'
 
+
 module AnalysisResults = struct
   type t = (string * Specs.summary) list
 
@@ -963,15 +1025,16 @@ module AnalysisResults = struct
       if List.is_empty Config.anon_args then load_specfiles () else List.rev Config.anon_args )
     else load_specfiles ()
 
+
   (** Load .specs files in memory and return list of summaries *)
   let load_summaries_in_memory () : t =
     let summaries = ref [] in
     let load_file fname =
       match Specs.load_summary (DB.filename_from_string fname) with
-      | None
+      | None ->
-       -> L.(die UserError) "Error: cannot open file %s@." fname
+          L.(die UserError) "Error: cannot open file %s@." fname
-      | Some summary
+      | Some summary ->
-       -> summaries := (fname, summary) :: !summaries
+          summaries := (fname, summary) :: !summaries
     in
     let do_load () = spec_files_from_cmdline () |> List.iter ~f:load_file in
     Utils.without_gc ~f:do_load ;
@@ -987,31 +1050,36 @@ module AnalysisResults = struct
     in
     List.sort ~cmp:summ_cmp !summaries
 
+
   (** Create an iterator which loads spec files one at a time *)
   let iterator_of_spec_files () =
     let sorted_spec_files = List.sort ~cmp:String.compare (spec_files_from_cmdline ()) in
     let do_spec f fname =
       match Specs.load_summary (DB.filename_from_string fname) with
-      | None
+      | None ->
-       -> L.(die UserError) "Error: cannot open file %s@." fname
+          L.(die UserError) "Error: cannot open file %s@." fname
-      | Some summary
+      | Some summary ->
-       -> f (fname, summary)
+          f (fname, summary)
     in
     let iterate f = List.iter ~f:(do_spec f) sorted_spec_files in
     iterate
 
+
   (** Serializer for analysis results *)
   let analysis_results_serializer : t Serialization.serializer =
     Serialization.create_serializer Serialization.Key.analysis_results
 
+
   (** Load analysis_results from a file *)
   let load_analysis_results_from_file (filename: DB.filename) : t option =
     Serialization.read_from_file analysis_results_serializer filename
 
+
   (** Save analysis_results into a file *)
   let store_analysis_results_to_file (filename: DB.filename) (analysis_results: t) =
     Serialization.write_to_file analysis_results_serializer filename ~data:analysis_results
 
+
   (** Return an iterator over all the summaries.
       If options - load_results or - save_results are used,
       all the summaries are loaded in memory *)
@@ -1020,18 +1088,19 @@ module AnalysisResults = struct
     match Config.load_analysis_results with
     | None -> (
       match Config.save_analysis_results with
-      | None
+      | None ->
-       -> iterator_of_spec_files ()
+          iterator_of_spec_files ()
-      | Some s
+      | Some s ->
-       -> let r = load_summaries_in_memory () in
+          let r = load_summaries_in_memory () in
           store_analysis_results_to_file (DB.filename_from_string s) r ;
           iterator_of_summary_list r )
     | Some fname ->
       match load_analysis_results_from_file (DB.filename_from_string fname) with
-      | Some r
+      | Some r ->
-       -> iterator_of_summary_list r
+          iterator_of_summary_list r
-      | None
+      | None ->
-       -> L.(die UserError) "Error: cannot open analysis results file %s@." fname
+          L.(die UserError) "Error: cannot open analysis results file %s@." fname
+
 end
 
 let register_perf_stats_report () =
@@ -1039,11 +1108,13 @@ let register_perf_stats_report () =
   let stats_file = Filename.concat stats_dir (Config.perf_stats_prefix ^ ".json") in
   PerfStats.register_report_at_exit stats_file
 
+
 let mk_format format_kind fname =
   Option.value_map
     ~f:(fun out_file -> [(format_kind, out_file)])
     ~default:[] (Utils.create_outfile fname)
 
+
 let init_issues_format_list report_csv report_json =
   let csv_format = Option.value_map ~f:(mk_format Csv) ~default:[] report_csv in
   let json_format = Option.value_map ~f:(mk_format Json) ~default:[] report_json in
@@ -1051,53 +1122,58 @@ let init_issues_format_list report_csv report_json =
   let txt_format = Option.value_map ~f:(mk_format Text) ~default:[] Config.issues_txt in
   csv_format @ json_format @ tests_format @ txt_format
 
+
 let init_procs_format_list () = Option.value_map ~f:(mk_format Csv) ~default:[] Config.procs_csv
 
 let init_calls_format_list () =
   let csv_format = Option.value_map ~f:(mk_format Csv) ~default:[] Config.calls_csv in
   csv_format
 
+
 let init_stats_format_list () =
   let csv_format = Option.value_map ~f:(mk_format Csv) ~default:[] Config.stats_report in
   csv_format
 
+
 let init_summary_format_list () =
   let latex_format = Option.value_map ~f:(mk_format Latex) ~default:[] Config.latex in
   latex_format
 
+
 let init_files format_list_by_kind =
   let init_files_of_report_kind (report_kind, format_list) =
     let init_files_of_format (format_kind, (outfile: Utils.outfile)) =
       match (format_kind, report_kind) with
-      | Csv, Issues
+      | Csv, Issues ->
-       -> IssuesCsv.pp_header outfile.fmt ()
+          IssuesCsv.pp_header outfile.fmt ()
-      | Csv, Procs
+      | Csv, Procs ->
-       -> ProcsCsv.pp_header outfile.fmt ()
+          ProcsCsv.pp_header outfile.fmt ()
-      | Csv, Stats
+      | Csv, Stats ->
-       -> Report.pp_header outfile.fmt ()
+          Report.pp_header outfile.fmt ()
-      | Json, Issues
+      | Json, Issues ->
-       -> IssuesJson.pp_json_open outfile.fmt ()
+          IssuesJson.pp_json_open outfile.fmt ()
-      | Latex, Summary
+      | Latex, Summary ->
-       -> begin_latex_file outfile.fmt
+          begin_latex_file outfile.fmt
-      | (Csv | Json | Latex | Tests | Text), _
+      | (Csv | Json | Latex | Tests | Text), _ ->
-       -> ()
+          ()
     in
     List.iter ~f:init_files_of_format format_list
   in
   List.iter ~f:init_files_of_report_kind format_list_by_kind
 
+
 let finalize_and_close_files format_list_by_kind stats pdflatex =
   let close_files_of_report_kind (report_kind, format_list) =
     let close_files_of_format (format_kind, (outfile: Utils.outfile)) =
       ( match (format_kind, report_kind) with
-      | Csv, Stats
+      | Csv, Stats ->
-       -> F.fprintf outfile.fmt "%a@?" Report.pp_stats stats
+          F.fprintf outfile.fmt "%a@?" Report.pp_stats stats
-      | Json, Issues
+      | Json, Issues ->
-       -> IssuesJson.pp_json_close outfile.fmt ()
+          IssuesJson.pp_json_close outfile.fmt ()
-      | Latex, Summary
+      | Latex, Summary ->
-       -> Latex.pp_end outfile.fmt ()
+          Latex.pp_end outfile.fmt ()
-      | (Csv | Latex | Tests | Text | Json), _
+      | (Csv | Latex | Tests | Text | Json), _ ->
-       -> () ) ;
+          () ) ;
       Utils.close_outf outfile ;
       (* bug_format_kind report_kind *)
       if [%compare.equal : bug_format_kind * report_kind]
@@ -1107,10 +1183,12 @@ let finalize_and_close_files format_list_by_kind stats pdflatex =
         let pdf_name = Filename.chop_extension outfile.fname ^ ".pdf" in
         ignore (Sys.command ("open " ^ pdf_name)) )
     in
-    List.iter ~f:close_files_of_format format_list ; ()
+    List.iter ~f:close_files_of_format format_list ;
+    ()
   in
   List.iter ~f:close_files_of_report_kind format_list_by_kind
 
+
 let pp_summary_and_issues formats_by_report_kind issue_formats =
   let pdflatex fname = ignore (Sys.command ("pdflatex " ^ fname)) in
   let stats = Stats.create () in
@@ -1131,10 +1209,12 @@ let pp_summary_and_issues formats_by_report_kind issue_formats =
     (Issue.sort_filter_issues !all_issues) ;
   if Config.precondition_stats then PreconditionStats.pp_stats () ;
   LintIssues.load_issues_to_errlog_map Config.lint_issues_dir_name ;
-  Typ.Procname.Map.iter (pp_lint_issues filters formats_by_report_kind linereader)
+  Typ.Procname.Map.iter
+    (pp_lint_issues filters formats_by_report_kind linereader)
     !LintIssues.errLogMap ;
   finalize_and_close_files formats_by_report_kind stats pdflatex
 
+
 let main ~report_csv ~report_json =
   let issue_formats = init_issues_format_list report_csv report_json in
   let formats_by_report_kind =
@@ -1147,7 +1227,8 @@ let main ~report_csv ~report_json =
   if Config.developer_mode then register_perf_stats_report () ;
   init_files formats_by_report_kind ;
   match Config.from_json_report with
-  | Some fname
+  | Some fname ->
-   -> pp_json_report_by_report_kind formats_by_report_kind fname
+      pp_json_report_by_report_kind formats_by_report_kind fname
-  | None
+  | None ->
-   -> pp_summary_and_issues formats_by_report_kind issue_formats
+      pp_summary_and_issues formats_by_report_kind issue_formats
+

infer/src/backend/OndemandCapture.ml

@@ -9,7 +9,7 @@
 open! IStd
 module L = Logging
 
-let compilation_db = (lazy (CompilationDatabase.from_json_files !Config.clang_compilation_dbs))
+let compilation_db = lazy (CompilationDatabase.from_json_files !Config.clang_compilation_dbs)
 
 (** Given proc_attributes try to produce proc_attributes' where proc_attributes'.is_defined = true
     It may trigger capture of extra files to do so and when it does, it waits for
@@ -45,12 +45,12 @@ let try_capture (attributes: ProcAttributes.t) : ProcAttributes.t option =
             SourceFile.pp definition_file Typ.Procname.pp attributes.proc_name
       in
       match definition_file_opt with
-      | None
+      | None ->
-       -> L.(debug Capture Medium)
+          L.(debug Capture Medium)
             "Couldn't find source file for %a (declared in %a)@\n" Typ.Procname.pp
             attributes.proc_name SourceFile.pp decl_file
-      | Some file
+      | Some file ->
-       -> try_compile file ) ;
+          try_compile file ) ;
   (* It's important to call load_defined_attributes again in all cases to make sure we try
      reading from disk again no matter which condition happened. If previous call to
      load_defined_attributes is None, it may mean couple of things:
@@ -62,3 +62,4 @@ let try_capture (attributes: ProcAttributes.t) : ProcAttributes.t option =
      Caveat: it's possible that procedure will be captured in some other unrelated file
              later - infer may ignore it then. *)
   Attributes.load_defined attributes.proc_name
+

infer/src/backend/PerfStats.ml

@@ -47,6 +47,7 @@ let to_json ps =
     ; ("stack_kb", `Float ps.stack_kb)
     ; ("minor_heap_kb", `Float ps.minor_heap_kb) ]
 
+
 let from_json json =
   let open! Yojson.Basic.Util in
   { rtime= json |> member "rtime" |> to_float
@@ -65,6 +66,7 @@ let from_json json =
   ; stack_kb= json |> member "stack_kb" |> to_float
   ; minor_heap_kb= json |> member "minor_heap_kb" |> to_float }
 
+
 let aggregate s =
   let mk_stats f = StatisticsToolbox.compute_statistics (List.map ~f s) in
   let aggr_rtime = mk_stats (fun stats -> stats.rtime) in
@@ -99,6 +101,7 @@ let aggregate s =
     ; ("stack_kb", StatisticsToolbox.to_json aggr_stack_kb)
     ; ("minor_heap_kb", StatisticsToolbox.to_json aggr_minor_heap_kb) ]
 
+
 let stats () =
   let words_to_kb n = n *. float_of_int (Sys.word_size / 8) /. 1024. in
   let words_to_mb n = words_to_kb n /. 1024. in
@@ -123,6 +126,7 @@ let stats () =
   ; stack_kb= words_to_kb (float_of_int gc_stats.stack_size)
   ; minor_heap_kb= words_to_kb (float_of_int gc_ctrl.minor_heap_size) }
 
+
 let report_at_exit file () =
   try
     let json_stats = to_json (stats ()) in
@@ -133,11 +137,14 @@ let report_at_exit file () =
           Yojson.Basic.pretty_to_channel stats_oc json_stats )
     with exc ->
       L.internal_error "Info: failed to write stats to %s@\n%s@\n%s@\n%s@." file
-        (Exn.to_string exc) (Yojson.Basic.pretty_to_string json_stats) (Printexc.get_backtrace ())
+        (Exn.to_string exc)
+        (Yojson.Basic.pretty_to_string json_stats)
+        (Printexc.get_backtrace ())
   with exc ->
     L.internal_error "Info: failed to compute stats for %s@\n%s@\n%s@." file (Exn.to_string exc)
       (Printexc.get_backtrace ())
 
+
 let register_report_at_exit =
   (* take care of not double-registering the same perf stat report *)
   let registered_files = String.Table.create ~size:4 () in
@@ -146,3 +153,4 @@ let register_report_at_exit =
       String.Table.set registered_files ~key:file ~data:() ;
       if not Config.buck_cache_mode then
         Epilogues.register ~f:(report_at_exit file) ("stats reporting in " ^ file) )
+

infer/src/backend/PropUtil.ml

@@ -17,10 +17,10 @@ let get_name_of_objc_static_locals (curr_f: Procdesc.t) p =
     match e with
     | Exp.Lvar pvar
       when Pvar.is_global pvar && Sil.is_static_local_name pname pvar
-           (* is a local static if it's a global and it has a static local name *)
+           (* is a local static if it's a global and it has a static local name *) ->
-     -> [pvar]
+        [pvar]
-    | _
+    | _ ->
-     -> []
+        []
   in
   let hpred_local_static hpred =
     match hpred with Sil.Hpointsto (e, _, _) -> [local_static e] | _ -> []
@@ -28,6 +28,7 @@ let get_name_of_objc_static_locals (curr_f: Procdesc.t) p =
   let vars_sigma = List.map ~f:hpred_local_static p.Prop.sigma in
   List.concat (List.concat vars_sigma)
 
+
 (* returns a list of local variables that points to an objc block in a proposition *)
 let get_name_of_objc_block_locals p =
   let local_blocks e =
@@ -39,44 +40,45 @@ let get_name_of_objc_block_locals p =
   let vars_sigma = List.map ~f:hpred_local_blocks p.Prop.sigma in
   List.concat (List.concat vars_sigma)
 
+
 let remove_abduced_retvars tenv p =
   (* compute the hpreds and pure atoms reachable from the set of seed expressions in [exps] *)
   let compute_reachable p seed_exps =
     let sigma, pi = (p.Prop.sigma, p.Prop.pi) in
     let rec collect_exps exps = function
-      | Sil.Eexp (Exp.Exn e, _)
+      | Sil.Eexp (Exp.Exn e, _) ->
-       -> Exp.Set.add e exps
+          Exp.Set.add e exps
-      | Sil.Eexp (e, _)
+      | Sil.Eexp (e, _) ->
-       -> Exp.Set.add e exps
+          Exp.Set.add e exps
-      | Sil.Estruct (flds, _)
+      | Sil.Estruct (flds, _) ->
-       -> List.fold ~f:(fun exps (_, strexp) -> collect_exps exps strexp) ~init:exps flds
+          List.fold ~f:(fun exps (_, strexp) -> collect_exps exps strexp) ~init:exps flds
-      | Sil.Earray (_, elems, _)
+      | Sil.Earray (_, elems, _) ->
-       -> List.fold ~f:(fun exps (_, strexp) -> collect_exps exps strexp) ~init:exps elems
+          List.fold ~f:(fun exps (_, strexp) -> collect_exps exps strexp) ~init:exps elems
     in
     let rec compute_reachable_hpreds_rec sigma (reach, exps) =
       let add_hpred_if_reachable (reach, exps) = function
-        | Sil.Hpointsto (lhs, rhs, _) as hpred when Exp.Set.mem lhs exps
+        | Sil.Hpointsto (lhs, rhs, _) as hpred when Exp.Set.mem lhs exps ->
-         -> let reach' = Sil.HpredSet.add hpred reach in
+            let reach' = Sil.HpredSet.add hpred reach in
             let exps' = collect_exps exps rhs in
             (reach', exps')
-        | Sil.Hlseg (_, _, exp1, exp2, exp_l) as hpred
+        | Sil.Hlseg (_, _, exp1, exp2, exp_l) as hpred ->
-         -> let reach' = Sil.HpredSet.add hpred reach in
+            let reach' = Sil.HpredSet.add hpred reach in
             let exps' =
               List.fold
                 ~f:(fun exps_acc exp -> Exp.Set.add exp exps_acc)
                 ~init:exps (exp1 :: exp2 :: exp_l)
             in
             (reach', exps')
-        | Sil.Hdllseg (_, _, exp1, exp2, exp3, exp4, exp_l) as hpred
+        | Sil.Hdllseg (_, _, exp1, exp2, exp3, exp4, exp_l) as hpred ->
-         -> let reach' = Sil.HpredSet.add hpred reach in
+            let reach' = Sil.HpredSet.add hpred reach in
             let exps' =
               List.fold
                 ~f:(fun exps_acc exp -> Exp.Set.add exp exps_acc)
                 ~init:exps (exp1 :: exp2 :: exp3 :: exp4 :: exp_l)
             in
             (reach', exps')
-        | _
+        | _ ->
-         -> (reach, exps)
+            (reach, exps)
       in
       let reach', exps' = List.fold ~f:add_hpred_if_reachable ~init:(reach, exps) sigma in
       if Int.equal (Sil.HpredSet.cardinal reach) (Sil.HpredSet.cardinal reach') then (reach, exps)
@@ -88,21 +90,21 @@ let remove_abduced_retvars tenv p =
     (* filter away the pure atoms without reachable exps *)
     let reach_pi =
       let rec exp_contains = function
-        | exp when Exp.Set.mem exp reach_exps
+        | exp when Exp.Set.mem exp reach_exps ->
-         -> true
+            true
-        | Exp.UnOp (_, e, _) | Exp.Cast (_, e) | Exp.Lfield (e, _, _)
+        | Exp.UnOp (_, e, _) | Exp.Cast (_, e) | Exp.Lfield (e, _, _) ->
-         -> exp_contains e
+            exp_contains e
-        | Exp.BinOp (_, e0, e1) | Exp.Lindex (e0, e1)
+        | Exp.BinOp (_, e0, e1) | Exp.Lindex (e0, e1) ->
-         -> exp_contains e0 || exp_contains e1
+            exp_contains e0 || exp_contains e1
-        | _
+        | _ ->
-         -> false
+            false
       in
       List.filter
         ~f:(function
-            | Sil.Aeq (lhs, rhs) | Sil.Aneq (lhs, rhs)
+            | Sil.Aeq (lhs, rhs) | Sil.Aneq (lhs, rhs) ->
-             -> exp_contains lhs || exp_contains rhs
+                exp_contains lhs || exp_contains rhs
-            | Sil.Apred (_, es) | Sil.Anpred (_, es)
+            | Sil.Apred (_, es) | Sil.Anpred (_, es) ->
-             -> List.exists ~f:exp_contains es)
+                List.exists ~f:exp_contains es)
         pi
     in
     (Sil.HpredSet.elements reach_hpreds, reach_pi)
@@ -112,12 +114,12 @@ let remove_abduced_retvars tenv p =
     List.fold
       ~f:(fun pvars hpred ->
         match hpred with
-        | Sil.Hpointsto (Exp.Lvar pvar, _, _)
+        | Sil.Hpointsto (Exp.Lvar pvar, _, _) ->
-         -> let abduceds, normal_pvars = pvars in
+            let abduceds, normal_pvars = pvars in
             if Pvar.is_abduced pvar then (pvar :: abduceds, normal_pvars)
             else (abduceds, pvar :: normal_pvars)
-        | _
+        | _ ->
-         -> pvars)
+            pvars)
       ~init:([], []) p.Prop.sigma
   in
   let _, p' = Attribute.deallocate_stack_vars tenv p abduceds in
@@ -130,26 +132,29 @@ let remove_abduced_retvars tenv p =
   let sigma_reach, pi_reach = compute_reachable p' normal_pvar_set in
   Prop.normalize tenv (Prop.set p' ~pi:pi_reach ~sigma:sigma_reach)
 
+
 let remove_locals tenv (curr_f: Procdesc.t) p =
   let names_of_locals = List.map ~f:(get_name_of_local curr_f) (Procdesc.get_locals curr_f) in
   let names_of_locals' =
     match !Config.curr_language with
-    | Config.Clang
+    | Config.Clang ->
-     -> (* in ObjC to deal with block we need to remove static locals *)
+        (* in ObjC to deal with block we need to remove static locals *)
         let names_of_static_locals = get_name_of_objc_static_locals curr_f p in
         let names_of_block_locals = get_name_of_objc_block_locals p in
         names_of_block_locals @ names_of_locals @ names_of_static_locals
-    | _
+    | _ ->
-     -> names_of_locals
+        names_of_locals
   in
   let removed, p' = Attribute.deallocate_stack_vars tenv p names_of_locals' in
   (removed, remove_abduced_retvars tenv p')
 
+
 let remove_formals tenv (curr_f: Procdesc.t) p =
   let pname = Procdesc.get_proc_name curr_f in
   let formal_vars = List.map ~f:(fun (n, _) -> Pvar.mk n pname) (Procdesc.get_formals curr_f) in
   Attribute.deallocate_stack_vars tenv p formal_vars
 
+
 (** remove the return variable from the prop *)
 let remove_ret tenv (curr_f: Procdesc.t) (p: Prop.normal Prop.t) =
   let pname = Procdesc.get_proc_name curr_f in
@@ -157,10 +162,12 @@ let remove_ret tenv (curr_f: Procdesc.t) (p: Prop.normal Prop.t) =
   let _, p' = Attribute.deallocate_stack_vars tenv p [Pvar.to_callee pname name_of_ret] in
   p'
 
+
 (** remove locals and return variable from the prop *)
 let remove_locals_ret tenv (curr_f: Procdesc.t) p =
   snd (remove_locals tenv curr_f (remove_ret tenv curr_f p))
 
+
 (** Remove locals and formal parameters from the prop.
     Return the list of stack variables whose address was still present after deallocation. *)
 let remove_locals_formals tenv (curr_f: Procdesc.t) p =
@@ -168,14 +175,16 @@ let remove_locals_formals tenv (curr_f: Procdesc.t) p =
   let pvars2, p2 = remove_formals tenv curr_f p1 in
   (pvars1 @ pvars2, p2)
 
+
 (** remove seed vars from a prop *)
 let remove_seed_vars tenv (prop: 'a Prop.t) : Prop.normal Prop.t =
   let hpred_not_seed = function
-    | Sil.Hpointsto (Exp.Lvar pv, _, _)
+    | Sil.Hpointsto (Exp.Lvar pv, _, _) ->
-     -> not (Pvar.is_seed pv)
+        not (Pvar.is_seed pv)
-    | _
+    | _ ->
-     -> true
+        true
   in
   let sigma = prop.sigma in
   let sigma' = List.filter ~f:hpred_not_seed sigma in
   Prop.normalize tenv (Prop.set prop ~sigma:sigma')
+

infer/src/backend/StatsAggregator.ml

@@ -19,6 +19,7 @@ let json_files_to_ignore_regex =
     ( ".*\\(" ^ Str.quote aggregated_stats_filename ^ "\\|"
     ^ Str.quote aggregated_stats_by_target_filename ^ "\\)$" )
 
+
 let dir_exists dir = Sys.is_directory dir = `Yes
 
 let find_json_files_in_dir dir =
@@ -29,12 +30,13 @@ let find_json_files_in_dir dir =
     && Polymorphic_compare.( = ) s.st_kind Unix.S_REG
   in
   match dir_exists dir with
-  | true
+  | true ->
-   -> let content = Array.to_list (Sys.readdir dir) in
+      let content = Array.to_list (Sys.readdir dir) in
       let content_with_path = List.map ~f:(fun p -> Filename.concat dir p) content in
       List.filter ~f:is_valid_json_file content_with_path
-  | false
+  | false ->
-   -> []
+      []
+
 
 type stats_paths =
   {frontend_paths: string list; backend_paths: string list; reporting_paths: string list}
@@ -51,32 +53,34 @@ let find_stats_files_in_dir dir =
   in
   {frontend_paths; backend_paths; reporting_paths}
 
+
 let load_data_from_infer_deps file =
   let error msg = Printf.sprintf ("Error reading '%s': " ^^ msg) file in
   let extract_target_and_path line =
     match String.split ~on:'\t' line with
-    | target :: _ :: path :: _
+    | target :: _ :: path :: _ ->
-     -> if dir_exists path then Ok (target, path)
+        if dir_exists path then Ok (target, path)
         else Error (error "path '%s' is not a valid directory" path)
-    | _
+    | _ ->
-     -> Error (error "malformed input")
+        Error (error "malformed input")
   in
   let parse_lines lines = List.map lines ~f:extract_target_and_path |> Result.all in
   Utils.read_file file |> Result.map_error ~f:(fun msg -> error "%s" msg)
   |> Result.bind ~f:parse_lines
 
+
 let collect_all_stats_files () =
   let infer_out = Config.results_dir in
   let concatenate_paths p1 p2 = if Filename.is_relative p2 then Filename.concat p1 p2 else p2 in
   match Config.buck_out with
-  | Some p
+  | Some p ->
-   -> if dir_exists p then
+      if dir_exists p then
         let data =
           load_data_from_infer_deps (Filename.concat infer_out Config.buck_infer_deps_file_name)
         in
         match data with
-        | Ok r
+        | Ok r ->
-         -> let buck_out_parent = Filename.concat p Filename.parent_dir_name in
+            let buck_out_parent = Filename.concat p Filename.parent_dir_name in
             let targets_files =
               List.map
                 ~f:(fun (t, p) ->
@@ -84,11 +88,12 @@ let collect_all_stats_files () =
                 r
             in
             Ok (Buck_out targets_files)
-        | Error _ as e
+        | Error _ as e ->
-         -> e
+            e
       else Error ("buck-out path '" ^ p ^ "' not found")
-  | None
+  | None ->
-   -> Ok (Infer_out (find_stats_files_in_dir infer_out))
+      Ok (Infer_out (find_stats_files_in_dir infer_out))
+
 
 let aggregate_stats_files paths =
   let open_json_file file = Yojson.Basic.from_file file in
@@ -98,6 +103,7 @@ let aggregate_stats_files paths =
   let all_perf_stats = load_stats paths in
   match all_perf_stats with [] -> None | _ -> Some (PerfStats.aggregate all_perf_stats)
 
+
 type json_aggregated_stats =
   { frontend_json_data: Yojson.Basic.json option
   ; backend_json_data: Yojson.Basic.json option
@@ -112,15 +118,16 @@ let aggregate_all_stats origin =
   let empty_stats_paths = {frontend_paths= []; backend_paths= []; reporting_paths= []} in
   let stats_paths =
     match origin with
-    | Buck_out tf
+    | Buck_out tf ->
-     -> List.fold ~f:(fun acc (_, paths) -> accumulate_paths acc paths) ~init:empty_stats_paths tf
+        List.fold ~f:(fun acc (_, paths) -> accumulate_paths acc paths) ~init:empty_stats_paths tf
-    | Infer_out paths
+    | Infer_out paths ->
-     -> paths
+        paths
   in
   { frontend_json_data= aggregate_stats_files stats_paths.frontend_paths
   ; backend_json_data= aggregate_stats_files stats_paths.backend_paths
   ; reporting_json_data= aggregate_stats_files stats_paths.reporting_paths }
 
+
 let aggregate_stats_by_target tp =
   let to_json f aggr_stats =
     let collect_valid_stats acc t p = match p with Some v -> (t, v) :: acc | None -> acc in
@@ -132,6 +139,7 @@ let aggregate_stats_by_target tp =
   let reporting_json_data = to_json (fun p -> aggregate_stats_files p.reporting_paths) tp in
   {frontend_json_data; backend_json_data; reporting_json_data}
 
+
 let generate_files () =
   let infer_out = Config.results_dir in
   let stats_files = collect_all_stats_files () in
@@ -148,8 +156,8 @@ let generate_files () =
     match json with Some j -> Utils.write_json_to_file destfile j | None -> ()
   in
   ( match origin with
-  | Buck_out tp
+  | Buck_out tp ->
-   -> let j = aggregate_stats_by_target tp in
+      let j = aggregate_stats_by_target tp in
       write_to_json_file_opt
         (Filename.concat aggregated_frontend_stats_dir aggregated_stats_by_target_filename)
         j.frontend_json_data ;
@@ -159,12 +167,16 @@ let generate_files () =
       write_to_json_file_opt
         (Filename.concat aggregated_reporting_stats_dir aggregated_stats_by_target_filename)
         j.reporting_json_data
-  | Infer_out _
+  | Infer_out _ ->
-   -> () ) ;
+      () ) ;
   let j = aggregate_all_stats origin in
-  write_to_json_file_opt (Filename.concat aggregated_frontend_stats_dir aggregated_stats_filename)
+  write_to_json_file_opt
+    (Filename.concat aggregated_frontend_stats_dir aggregated_stats_filename)
     j.frontend_json_data ;
-  write_to_json_file_opt (Filename.concat aggregated_backend_stats_dir aggregated_stats_filename)
+  write_to_json_file_opt
+    (Filename.concat aggregated_backend_stats_dir aggregated_stats_filename)
     j.backend_json_data ;
-  write_to_json_file_opt (Filename.concat aggregated_reporting_stats_dir aggregated_stats_filename)
+  write_to_json_file_opt
+    (Filename.concat aggregated_reporting_stats_dir aggregated_stats_filename)
     j.reporting_json_data
+

infer/src/backend/Tasks.ml

@@ -23,6 +23,7 @@ let create ?(continuation= None) closures =
   in
   {closures; continuations}
 
+
 let empty = {closures= []; continuations= Queue.create ()}
 
 (* Aggregate closures into groups of the given size *)
@@ -35,11 +36,17 @@ let aggregate ~size t =
     {t with closures}
   else t
 
+
 let run t =
   List.iter ~f:(fun f -> f ()) t.closures ;
   Queue.iter ~f:(fun closure -> closure ()) t.continuations
 
-let fork_protect ~f x = L.reset_formatters () ; ResultsDir.new_database_connection () ; f x
+
+let fork_protect ~f x =
+  L.reset_formatters () ;
+  ResultsDir.new_database_connection () ;
+  f x
+
 
 module Runner = struct
   type runner = {pool: ProcessPool.t; all_continuations: closure Queue.t}
@@ -53,7 +60,9 @@ module Runner = struct
       ~f:(fun x -> ProcessPool.start_child ~f:(fun f -> fork_protect ~f ()) ~pool x)
       tasks.closures
 
+
   let complete runner =
     ProcessPool.wait_all runner.pool ;
     Queue.iter ~f:(fun f -> f ()) runner.all_continuations
+
 end

infer/src/backend/absarray.ml

@@ -75,31 +75,32 @@ end = struct
       assert false
     in
     match (se, t.desc, syn_offs) with
-    | _, _, []
+    | _, _, [] ->
-     -> (se, t)
+        (se, t)
     | Sil.Estruct (fsel, _), Tstruct name, (Field (fld, _)) :: syn_offs' -> (
       match Tenv.lookup tenv name with
-      | Some {fields}
+      | Some {fields} ->
-       -> let se' = snd (List.find_exn ~f:(fun (f', _) -> Typ.Fieldname.equal f' fld) fsel) in
+          let se' = snd (List.find_exn ~f:(fun (f', _) -> Typ.Fieldname.equal f' fld) fsel) in
           let t' = snd3 (List.find_exn ~f:(fun (f', _, _) -> Typ.Fieldname.equal f' fld) fields) in
           get_strexp_at_syn_offsets tenv se' t' syn_offs'
-      | None
+      | None ->
-       -> fail () )
+          fail () )
-    | Sil.Earray (_, esel, _), Typ.Tarray (t', _, _), (Index ind) :: syn_offs'
+    | Sil.Earray (_, esel, _), Typ.Tarray (t', _, _), (Index ind) :: syn_offs' ->
-     -> let se' = snd (List.find_exn ~f:(fun (i', _) -> Exp.equal i' ind) esel) in
+        let se' = snd (List.find_exn ~f:(fun (i', _) -> Exp.equal i' ind) esel) in
         get_strexp_at_syn_offsets tenv se' t' syn_offs'
-    | _
+    | _ ->
-     -> fail ()
+        fail ()
+
 
   (** Replace a strexp at the given syntactic offset list *)
   let rec replace_strexp_at_syn_offsets tenv se (t: Typ.t) syn_offs update =
     match (se, t.desc, syn_offs) with
-    | _, _, []
+    | _, _, [] ->
-     -> update se
+        update se
     | Sil.Estruct (fsel, inst), Tstruct name, (Field (fld, _)) :: syn_offs' -> (
       match Tenv.lookup tenv name with
-      | Some {fields}
+      | Some {fields} ->
-       -> let se' = snd (List.find_exn ~f:(fun (f', _) -> Typ.Fieldname.equal f' fld) fsel) in
+          let se' = snd (List.find_exn ~f:(fun (f', _) -> Typ.Fieldname.equal f' fld) fsel) in
           let t' =
             (fun (_, y, _) -> y)
               (List.find_exn ~f:(fun (f', _, _) -> Typ.Fieldname.equal f' fld) fields)
@@ -112,43 +113,46 @@ end = struct
               fsel
           in
           Sil.Estruct (fsel', inst)
-      | None
+      | None ->
-       -> assert false )
+          assert false )
-    | Sil.Earray (len, esel, inst), Tarray (t', _, _), (Index idx) :: syn_offs'
+    | Sil.Earray (len, esel, inst), Tarray (t', _, _), (Index idx) :: syn_offs' ->
-     -> let se' = snd (List.find_exn ~f:(fun (i', _) -> Exp.equal i' idx) esel) in
+        let se' = snd (List.find_exn ~f:(fun (i', _) -> Exp.equal i' idx) esel) in
         let se_mod = replace_strexp_at_syn_offsets tenv se' t' syn_offs' update in
         let esel' =
           List.map ~f:(fun ese -> if Exp.equal (fst ese) idx then (idx, se_mod) else ese) esel
         in
         Sil.Earray (len, esel', inst)
-    | _
+    | _ ->
-     -> assert false
+        assert false
+
 
   (** convert a path into an expression *)
   let path_to_exps (root, syn_offs_in) =
     let rec convert acc = function
-      | []
+      | [] ->
-       -> acc
+          acc
-      | (Field (f, t)) :: syn_offs'
+      | (Field (f, t)) :: syn_offs' ->
-       -> let acc' = List.map ~f:(fun e -> Exp.Lfield (e, f, t)) acc in
+          let acc' = List.map ~f:(fun e -> Exp.Lfield (e, f, t)) acc in
           convert acc' syn_offs'
-      | (Index idx) :: syn_offs'
+      | (Index idx) :: syn_offs' ->
-       -> let acc' = List.map ~f:(fun e -> Exp.Lindex (e, idx)) acc in
+          let acc' = List.map ~f:(fun e -> Exp.Lindex (e, idx)) acc in
           convert acc' syn_offs'
     in
     convert [root] syn_offs_in
 
+
   (** create a path from a root and a list of offsets *)
   let path_from_exp_offsets root offs =
     let offset_to_syn_offset = function
-      | Sil.Off_fld (fld, typ)
+      | Sil.Off_fld (fld, typ) ->
-       -> Field (fld, typ)
+          Field (fld, typ)
-      | Sil.Off_index idx
+      | Sil.Off_index idx ->
-       -> Index idx
+          Index idx
     in
     let syn_offs = List.map ~f:offset_to_syn_offset offs in
     (root, syn_offs)
 
+
   (** path to the root, len, elements and type of a new_array *)
   type strexp_data = path * Sil.strexp * Typ.t
 
@@ -161,6 +165,7 @@ end = struct
     let hpred = List.find_exn ~f:filter sigma in
     (sigma, hpred, syn_offs)
 
+
   (** Find a sub strexp with the given property. Can raise [Not_found] *)
   let find tenv (sigma: sigma) (pred: strexp_data -> bool) : t list =
     let found = ref [] in
@@ -172,86 +177,90 @@ end = struct
         match (se, typ.desc) with
         | Sil.Estruct (fsel, _), Tstruct name -> (
           match Tenv.lookup tenv name with
-          | Some {fields}
+          | Some {fields} ->
-           -> find_offset_fsel sigma_other hpred root offs fsel fields typ
+              find_offset_fsel sigma_other hpred root offs fsel fields typ
-          | None
+          | None ->
-           -> () )
+              () )
-        | Sil.Earray (_, esel, _), Tarray (t, _, _)
+        | Sil.Earray (_, esel, _), Tarray (t, _, _) ->
-         -> find_offset_esel sigma_other hpred root offs esel t
+            find_offset_esel sigma_other hpred root offs esel t
-        | _
+        | _ ->
-         -> ()
+            ()
     and find_offset_fsel sigma_other hpred root offs fsel ftal typ =
       match fsel with
-      | []
+      | [] ->
-       -> ()
+          ()
-      | (f, se) :: fsel'
+      | (f, se) :: fsel' ->
-       -> ( match List.find ~f:(fun (f', _, _) -> Typ.Fieldname.equal f' f) ftal with
+          ( match List.find ~f:(fun (f', _, _) -> Typ.Fieldname.equal f' f) ftal with
-          | Some (_, t, _)
+          | Some (_, t, _) ->
-           -> find_offset_sexp sigma_other hpred root (Field (f, typ) :: offs) se t
+              find_offset_sexp sigma_other hpred root (Field (f, typ) :: offs) se t
-          | None
+          | None ->
-           -> L.d_strln ("Can't find field " ^ Typ.Fieldname.to_string f ^ " in StrexpMatch.find")
+              L.d_strln ("Can't find field " ^ Typ.Fieldname.to_string f ^ " in StrexpMatch.find")
           ) ;
           find_offset_fsel sigma_other hpred root offs fsel' ftal typ
     and find_offset_esel sigma_other hpred root offs esel t =
       match esel with
-      | []
+      | [] ->
-       -> ()
+          ()
-      | (ind, se) :: esel'
+      | (ind, se) :: esel' ->
-       -> find_offset_sexp sigma_other hpred root (Index ind :: offs) se t ;
+          find_offset_sexp sigma_other hpred root (Index ind :: offs) se t ;
           find_offset_esel sigma_other hpred root offs esel' t
     in
     let rec iterate sigma_seen = function
-      | []
+      | [] ->
-       -> ()
+          ()
-      | hpred :: sigma_rest
+      | hpred :: sigma_rest ->
-       -> ( match hpred with
+          ( match hpred with
-          | Sil.Hpointsto (root, se, te)
+          | Sil.Hpointsto (root, se, te) ->
-           -> let sigma_other = sigma_seen @ sigma_rest in
+              let sigma_other = sigma_seen @ sigma_rest in
               find_offset_sexp sigma_other hpred root [] se (Exp.texp_to_typ None te)
-          | _
+          | _ ->
-           -> () ) ;
+              () ) ;
           iterate (hpred :: sigma_seen) sigma_rest
     in
     iterate [] sigma ; !found
 
+
   (** Get the matched strexp *)
   let get_data tenv ((_, hpred, syn_offs): t) =
     match hpred with
-    | Sil.Hpointsto (root, se, te)
+    | Sil.Hpointsto (root, se, te) ->
-     -> let t = Exp.texp_to_typ None te in
+        let t = Exp.texp_to_typ None te in
         let se', t' = get_strexp_at_syn_offsets tenv se t syn_offs in
         let path' = (root, syn_offs) in
         (path', se', t')
-    | _
+    | _ ->
-     -> assert false
+        assert false
+
 
   (** Replace the current hpred *)
   let replace_hpred ((sigma, hpred, _): t) hpred' =
     List.map ~f:(fun hpred'' -> if phys_equal hpred'' hpred then hpred' else hpred'') sigma
 
+
   (** Replace the strexp at the given offset in the given hpred *)
   let hpred_replace_strexp tenv footprint_part hpred syn_offs update =
     let update se' =
       let se_in = update se' in
       match (se', se_in) with
-      | Sil.Earray (len, esel, _), Sil.Earray (_, esel_in, inst2)
+      | Sil.Earray (len, esel, _), Sil.Earray (_, esel_in, inst2) ->
-       -> let orig_indices = List.map ~f:fst esel in
+          let orig_indices = List.map ~f:fst esel in
           let index_is_not_new idx = List.exists ~f:(Exp.equal idx) orig_indices in
           let process_index idx =
             if index_is_not_new idx then idx else Sil.array_clean_new_index footprint_part idx
           in
           let esel_in' = List.map ~f:(fun (idx, se) -> (process_index idx, se)) esel_in in
           Sil.Earray (len, esel_in', inst2)
-      | _, _
+      | _, _ ->
-       -> se_in
+          se_in
     in
     match hpred with
-    | Sil.Hpointsto (root, se, te)
+    | Sil.Hpointsto (root, se, te) ->
-     -> let t = Exp.texp_to_typ None te in
+        let t = Exp.texp_to_typ None te in
         let se' = replace_strexp_at_syn_offsets tenv se t syn_offs update in
         Sil.Hpointsto (root, se', te)
-    | _
+    | _ ->
-     -> assert false
+        assert false
+
 
   (** Replace the strexp at a given position by a new strexp *)
   let replace_strexp tenv footprint_part ((sigma, hpred, syn_offs): t) se_in =
@@ -259,23 +268,25 @@ end = struct
     let hpred' = hpred_replace_strexp tenv footprint_part hpred syn_offs update in
     replace_hpred (sigma, hpred, syn_offs) hpred'
 
+
   (** Replace the index in the array at a given position with the new index *)
   let replace_index tenv footprint_part ((sigma, hpred, syn_offs): t) (index: Exp.t)
       (index': Exp.t) =
     let update se' =
       match se' with
-      | Sil.Earray (len, esel, inst)
+      | Sil.Earray (len, esel, inst) ->
-       -> let esel' =
+          let esel' =
             List.map
               ~f:(fun (e', se') -> if Exp.equal e' index then (index', se') else (e', se'))
               esel
           in
           Sil.Earray (len, esel', inst)
-      | _
+      | _ ->
-       -> assert false
+          assert false
     in
     let hpred' = hpred_replace_strexp tenv footprint_part hpred syn_offs update in
     replace_hpred (sigma, hpred, syn_offs) hpred'
+
 end
 
 (** This function renames expressions in [p]. The renaming is, roughly
@@ -303,6 +314,7 @@ let prop_replace_path_index tenv (p: Prop.exposed Prop.t) (path: StrexpMatch.pat
   in
   Prop.prop_expmap expmap_fun p
 
+
 (** This function uses [update] and transforms the two sigma parts of [p],
     the sigma of the current SH of [p] and that of the footprint of [p]. *)
 let prop_update_sigma_and_fp_sigma tenv (p: Prop.normal Prop.t)
@@ -317,6 +329,7 @@ let prop_update_sigma_and_fp_sigma tenv (p: Prop.normal Prop.t)
   in
   (Prop.normalize tenv ep2, changed || changed2)
 
+
 (** Remember whether array abstraction was performed (to be reset before calling Abs.abstract) *)
 let array_abstraction_performed = ref false
 
@@ -326,7 +339,7 @@ let array_abstraction_performed = ref false
 let generic_strexp_abstract tenv (abstraction_name: string) (p_in: Prop.normal Prop.t)
     (can_abstract_: StrexpMatch.strexp_data -> bool)
     (do_abstract:
-    bool -> Prop.normal Prop.t -> StrexpMatch.strexp_data -> Prop.normal Prop.t * bool)
+      bool -> Prop.normal Prop.t -> StrexpMatch.strexp_data -> Prop.normal Prop.t * bool)
     : Prop.normal Prop.t =
   let can_abstract data =
     let r = can_abstract_ data in
@@ -341,12 +354,12 @@ let generic_strexp_abstract tenv (abstraction_name: string) (p_in: Prop.normal P
   in
   let match_select_next (matchings_cur, matchings_fp) =
     match (matchings_cur, matchings_fp) with
-    | [], []
+    | [], [] ->
-     -> raise Not_found
+        raise Not_found
-    | matched :: cur', fp'
+    | matched :: cur', fp' ->
-     -> (matched, false, (cur', fp'))
+        (matched, false, (cur', fp'))
-    | [], matched :: fp'
+    | [], matched :: fp' ->
-     -> (matched, true, ([], fp'))
+        (matched, true, ([], fp'))
   in
   let rec match_abstract p0 matchings_cur_fp =
     try
@@ -374,6 +387,7 @@ let generic_strexp_abstract tenv (abstraction_name: string) (p_in: Prop.normal P
   let num_matches = List.length matchings_cur + List.length matchings_fp in
   find_then_abstract num_matches p_in
 
+
 (** Return [true] if there's a pointer to the index *)
 let index_is_pointed_to tenv (p: Prop.normal Prop.t) (path: StrexpMatch.path) (index: Exp.t) : bool =
   let indices =
@@ -387,13 +401,14 @@ let index_is_pointed_to tenv (p: Prop.normal Prop.t) (path: StrexpMatch.path) (i
   in
   let pointers = List.concat_map ~f:add_index_to_paths indices in
   let filter = function
-    | Sil.Hpointsto (_, Sil.Eexp (e, _), _)
+    | Sil.Hpointsto (_, Sil.Eexp (e, _), _) ->
-     -> List.exists ~f:(Exp.equal e) pointers
+        List.exists ~f:(Exp.equal e) pointers
-    | _
+    | _ ->
-     -> false
+        false
   in
   List.exists ~f:filter p.Prop.sigma
 
+
 (** Given [p] containing an array at [path], blur [index] in it *)
 let blur_array_index tenv (p: Prop.normal Prop.t) (path: StrexpMatch.path) (index: Exp.t)
     : Prop.normal Prop.t =
@@ -425,12 +440,14 @@ let blur_array_index tenv (p: Prop.normal Prop.t) (path: StrexpMatch.path) (inde
     Prop.normalize tenv p4
   with Not_found -> p
 
+
 (** Given [p] containing an array at [root], blur [indices] in it *)
 let blur_array_indices tenv (p: Prop.normal Prop.t) (root: StrexpMatch.path) (indices: Exp.t list)
     : Prop.normal Prop.t * bool =
   let f prop index = blur_array_index tenv prop root index in
   (List.fold ~f ~init:p indices, List.length indices > 0)
 
+
 (** Given [p] containing an array at [root], only keep [indices] in it *)
 let keep_only_indices tenv (p: Prop.normal Prop.t) (path: StrexpMatch.path) (indices: Exp.t list)
     : Prop.normal Prop.t * bool =
@@ -439,8 +456,8 @@ let keep_only_indices tenv (p: Prop.normal Prop.t) (path: StrexpMatch.path) (ind
       let matched = StrexpMatch.find_path sigma path in
       let _, se, _ = StrexpMatch.get_data tenv matched in
       match se with
-      | Sil.Earray (len, esel, inst)
+      | Sil.Earray (len, esel, inst) ->
-       -> let esel', esel_leftover' =
+          let esel', esel_leftover' =
             List.partition_tf ~f:(fun (e, _) -> List.exists ~f:(Exp.equal e) indices) esel
           in
           if List.is_empty esel_leftover' then (sigma, false)
@@ -448,39 +465,44 @@ let keep_only_indices tenv (p: Prop.normal Prop.t) (path: StrexpMatch.path) (ind
             let se' = Sil.Earray (len, esel', inst) in
             let sigma' = StrexpMatch.replace_strexp tenv footprint_part matched se' in
             (sigma', true)
-      | _
+      | _ ->
-       -> (sigma, false)
+          (sigma, false)
     with Not_found -> (sigma, false)
   in
   prop_update_sigma_and_fp_sigma tenv p prune_sigma
 
+
 (** If the type is array, check whether we should do abstraction *)
 let array_typ_can_abstract {Typ.desc} =
   match desc with
-  | Tarray ({desc= Tptr ({desc= Tfun _}, _)}, _, _)
+  | Tarray ({desc= Tptr ({desc= Tfun _}, _)}, _, _) ->
-   -> false (* don't abstract arrays of pointers *)
+      false (* don't abstract arrays of pointers *)
-  | _
+  | _ ->
-   -> true
+      true
+
 
 (** This function checks whether we can apply an abstraction to a strexp *)
 let strexp_can_abstract ((_, se, typ): StrexpMatch.strexp_data) : bool =
   let can_abstract_se =
     match se with
-    | Sil.Earray (_, esel, _)
+    | Sil.Earray (_, esel, _) ->
-     -> let len = List.length esel in
+        let len = List.length esel in
         len > 1
-    | _
+    | _ ->
-     -> false
+        false
   in
   can_abstract_se && array_typ_can_abstract typ
 
+
 (** This function abstracts a strexp *)
 let strexp_do_abstract tenv footprint_part p ((path, se_in, _): StrexpMatch.strexp_data)
     : Prop.normal Prop.t * bool =
   if Config.trace_absarray && footprint_part then (
-    L.d_str "strexp_do_abstract (footprint)" ; L.d_ln () ) ;
+    L.d_str "strexp_do_abstract (footprint)" ;
+    L.d_ln () ) ;
   if Config.trace_absarray && not footprint_part then (
-    L.d_str "strexp_do_abstract (nonfootprint)" ; L.d_ln () ) ;
+    L.d_str "strexp_do_abstract (nonfootprint)" ;
+    L.d_ln () ) ;
   let prune_and_blur d_keys keep blur path keep_keys blur_keys =
     let p2, changed2 =
       if Config.trace_absarray then ( L.d_str "keep " ; d_keys keep_keys ; L.d_ln () ) ;
@@ -531,12 +553,12 @@ let strexp_do_abstract tenv footprint_part p ((path, se_in, _): StrexpMatch.stre
     let is_pointed index = index_is_pointed_to tenv p path index in
     let should_keep (index, _) =
       match index with
-      | Exp.Const _
+      | Exp.Const _ ->
-       -> is_pointed index
+          is_pointed index
-      | Exp.Var id
+      | Exp.Var id ->
-       -> Ident.is_normal id || is_pointed index
+          Ident.is_normal id || is_pointed index
-      | _
+      | _ ->
-       -> false
+          false
     in
     let abstract = prune_and_blur_indices path in
     filter_abstract Sil.d_exp_list should_keep abstract esel []
@@ -546,15 +568,18 @@ let strexp_do_abstract tenv footprint_part p ((path, se_in, _): StrexpMatch.stre
   in
   if !Config.footprint then do_footprint () else do_reexecution ()
 
+
 let strexp_abstract tenv (p: Prop.normal Prop.t) : Prop.normal Prop.t =
   generic_strexp_abstract tenv "strexp_abstract" p strexp_can_abstract (strexp_do_abstract tenv)
 
+
 let report_error prop =
   L.d_strln "Check after array abstraction: FAIL" ;
   Prop.d_prop prop ;
   L.d_ln () ;
   assert false
 
+
 (** Check performed after the array abstraction to see whether it was successful. Raise assert false in case of failure *)
 let check_after_array_abstraction tenv prop =
   let lookup = Tenv.lookup tenv in
@@ -565,10 +590,10 @@ let check_after_array_abstraction tenv prop =
     else not (Sil.fav_exists (Sil.exp_fav ind) Ident.is_primed)
   in
   let rec check_se root offs typ = function
-    | Sil.Eexp _
+    | Sil.Eexp _ ->
-     -> ()
+        ()
-    | Sil.Earray (_, esel, _)
+    | Sil.Earray (_, esel, _) ->
-     -> (* check that no more than 2 elements are in the array *)
+        (* check that no more than 2 elements are in the array *)
         let typ_elem = Typ.array_elem (Some (Typ.mk Tvoid)) typ in
         if List.length esel > 2 && array_typ_can_abstract typ then
           if List.for_all ~f:(check_index root offs) esel then () else report_error prop
@@ -576,28 +601,31 @@ let check_after_array_abstraction tenv prop =
           List.iter
             ~f:(fun (ind, se) -> check_se root (offs @ [Sil.Off_index ind]) typ_elem se)
             esel
-    | Sil.Estruct (fsel, _)
+    | Sil.Estruct (fsel, _) ->
-     -> List.iter
+        List.iter
           ~f:(fun (f, se) ->
             let typ_f = Typ.Struct.fld_typ ~lookup ~default:(Typ.mk Tvoid) f typ in
             check_se root (offs @ [Sil.Off_fld (f, typ)]) typ_f se)
           fsel
   in
   let check_hpred = function
-    | Sil.Hpointsto (root, se, texp)
+    | Sil.Hpointsto (root, se, texp) ->
-     -> let typ = Exp.texp_to_typ (Some (Typ.mk Tvoid)) texp in
+        let typ = Exp.texp_to_typ (Some (Typ.mk Tvoid)) texp in
         check_se root [] typ se
-    | Sil.Hlseg _ | Sil.Hdllseg _
+    | Sil.Hlseg _ | Sil.Hdllseg _ ->
-     -> ()
+        ()
   in
   let check_sigma sigma = List.iter ~f:check_hpred sigma in
   (* check_footprint_pure prop; *)
   check_sigma prop.Prop.sigma ; check_sigma prop.Prop.sigma_fp
 
+
 (** Apply array abstraction and check the result *)
 let abstract_array_check tenv p =
   let p_res = strexp_abstract tenv p in
-  check_after_array_abstraction tenv p_res ; p_res
+  check_after_array_abstraction tenv p_res ;
+  p_res
+
 
 (** remove redundant elements in an array *)
 let remove_redundant_elements tenv prop =
@@ -634,26 +662,26 @@ let remove_redundant_elements tenv prop =
     in
     match (e, se) with
     | Exp.Const Const.Cint i, Sil.Eexp (Exp.Var id, _)
-      when (not fp_part || IntLit.iszero i) && not (Ident.is_normal id) && occurs_at_most_once id
+      when (not fp_part || IntLit.iszero i) && not (Ident.is_normal id) && occurs_at_most_once id ->
-     -> remove () (* unknown value can be removed in re-execution mode or if the index is zero *)
+        remove () (* unknown value can be removed in re-execution mode or if the index is zero *)
-    | Exp.Var id, Sil.Eexp _ when not (Ident.is_normal id) && occurs_at_most_once id
+    | Exp.Var id, Sil.Eexp _ when not (Ident.is_normal id) && occurs_at_most_once id ->
-     -> remove () (* index unknown can be removed *)
+        remove () (* index unknown can be removed *)
-    | _
+    | _ ->
-     -> true
+        true
   in
   let remove_redundant_se fp_part = function
-    | Sil.Earray (len, esel, inst)
+    | Sil.Earray (len, esel, inst) ->
-     -> let esel' = List.filter ~f:(filter_redundant_e_se fp_part) esel in
+        let esel' = List.filter ~f:(filter_redundant_e_se fp_part) esel in
         Sil.Earray (len, esel', inst)
-    | se
+    | se ->
-     -> se
+        se
   in
   let remove_redundant_hpred fp_part = function
-    | Sil.Hpointsto (e, se, te)
+    | Sil.Hpointsto (e, se, te) ->
-     -> let se' = remove_redundant_se fp_part se in
+        let se' = remove_redundant_se fp_part se in
         Sil.Hpointsto (e, se', te)
-    | hpred
+    | hpred ->
-     -> hpred
+        hpred
   in
   let remove_redundant_sigma fp_part sigma = List.map ~f:(remove_redundant_hpred fp_part) sigma in
   let sigma' = remove_redundant_sigma false prop.Prop.sigma in
@@ -662,3 +690,4 @@ let remove_redundant_elements tenv prop =
     let prop' = Prop.set prop ~sigma:sigma' ~sigma_fp:sigma_fp' in
     Prop.normalize tenv prop'
   else prop
+

infer/src/backend/buckets.ml

@@ -24,22 +24,22 @@ let check_nested_loop path pos_opt =
   let loop_visits_log = ref [] in
   let in_nested_loop () =
     match !loop_visits_log with
-    | true :: true :: _
+    | true :: true :: _ ->
-     -> if verbose then L.d_strln "in nested loop" ;
+        if verbose then L.d_strln "in nested loop" ;
         true
         (* last two loop visits were entering loops *)
-    | _
+    | _ ->
-     -> false
+        false
   in
   let do_node_caller node =
     match Procdesc.Node.get_kind node with
-    | Procdesc.Node.Prune_node (b, (Sil.Ik_dowhile | Sil.Ik_for | Sil.Ik_while), _)
+    | Procdesc.Node.Prune_node (b, (Sil.Ik_dowhile | Sil.Ik_for | Sil.Ik_while), _) ->
-     -> (* if verbose then *)
+        (* if verbose then *)
         (*   L.d_strln ((if b then "enter" else "exit") ^ " node " *)
         (*              ^ (string_of_int (Procdesc.Node.get_id node))); *)
         loop_visits_log := b :: !loop_visits_log
-    | _
+    | _ ->
-     -> ()
+        ()
   in
   let do_any_node _level _node =
     incr trace_length
@@ -49,13 +49,15 @@ let check_nested_loop path pos_opt =
   in
   let f level p _ _ =
     match Paths.Path.curr_node p with
-    | Some node
+    | Some node ->
-     -> do_any_node level node ;
+        do_any_node level node ;
         if Int.equal level 0 then do_node_caller node
-    | None
+    | None ->
-     -> ()
+        ()
   in
-  Paths.Path.iter_shortest_sequence f pos_opt path ; in_nested_loop ()
+  Paths.Path.iter_shortest_sequence f pos_opt path ;
+  in_nested_loop ()
+
 
 (** Check that we know where the value was last assigned,
     and that there is a local access instruction at that line. **)
@@ -66,10 +68,10 @@ let check_access access_opt de_opt =
       let node_instrs = Procdesc.Node.get_instrs node in
       let formals =
         match State.get_prop_tenv_pdesc () with
-        | None
+        | None ->
-         -> []
+            []
-        | Some (_, _, pdesc)
+        | Some (_, _, pdesc) ->
-         -> Procdesc.get_formals pdesc
+            Procdesc.get_formals pdesc
       in
       let formal_names = List.map ~f:fst formals in
       let is_formal pvar =
@@ -78,43 +80,44 @@ let check_access access_opt de_opt =
       in
       let formal_ids = ref [] in
       let process_formal_letref = function
-        | Sil.Load (id, Exp.Lvar pvar, _, _)
+        | Sil.Load (id, Exp.Lvar pvar, _, _) ->
-         -> let is_java_this = Config.curr_language_is Config.Java && Pvar.is_this pvar in
+            let is_java_this = Config.curr_language_is Config.Java && Pvar.is_this pvar in
             if not is_java_this && is_formal pvar then formal_ids := id :: !formal_ids
-        | _
+        | _ ->
-         -> ()
+            ()
       in
-      List.iter ~f:process_formal_letref node_instrs ; !formal_ids
+      List.iter ~f:process_formal_letref node_instrs ;
+      !formal_ids
     in
     let formal_param_used_in_call = ref false in
     let has_call_or_sets_null node =
       let rec exp_is_null exp =
         match exp with
-        | Exp.Const Const.Cint n
+        | Exp.Const Const.Cint n ->
-         -> IntLit.iszero n
+            IntLit.iszero n
-        | Exp.Cast (_, e)
+        | Exp.Cast (_, e) ->
-         -> exp_is_null e
+            exp_is_null e
         | Exp.Var _ | Exp.Lvar _ -> (
           match State.get_const_map () node exp with
-          | Some Const.Cint n
+          | Some Const.Cint n ->
-           -> IntLit.iszero n
+              IntLit.iszero n
-          | _
+          | _ ->
-           -> false )
+              false )
-        | _
+        | _ ->
-         -> false
+            false
       in
       let filter = function
-        | Sil.Call (_, _, etl, _, _)
+        | Sil.Call (_, _, etl, _, _) ->
-         -> let formal_ids = find_formal_ids node in
+            let formal_ids = find_formal_ids node in
             let arg_is_formal_param (e, _) =
               match e with Exp.Var id -> List.exists ~f:(Ident.equal id) formal_ids | _ -> false
             in
             if List.exists ~f:arg_is_formal_param etl then formal_param_used_in_call := true ;
             true
-        | Sil.Store (_, _, e, _)
+        | Sil.Store (_, _, e, _) ->
-         -> exp_is_null e
+            exp_is_null e
-        | _
+        | _ ->
-         -> false
+            false
       in
       List.exists ~f:filter (Procdesc.Node.get_instrs node)
     in
@@ -137,16 +140,18 @@ let check_access access_opt de_opt =
     else None
   in
   match access_opt with
-  | Some Localise.Last_assigned (n, ncf)
+  | Some Localise.Last_assigned (n, ncf) ->
-   -> find_bucket n ncf
+      find_bucket n ncf
-  | Some Localise.Returned_from_call n
+  | Some Localise.Returned_from_call n ->
-   -> find_bucket n false
+      find_bucket n false
-  | Some Localise.Last_accessed (_, is_nullable) when is_nullable
+  | Some Localise.Last_accessed (_, is_nullable) when is_nullable ->
-   -> Some Localise.BucketLevel.b1
+      Some Localise.BucketLevel.b1
   | _ ->
     match de_opt with Some DecompiledExp.Dconst _ -> Some Localise.BucketLevel.b1 | _ -> None
 
+
 let classify_access desc access_opt de_opt is_nullable =
   let default_bucket = if is_nullable then Localise.BucketLevel.b1 else Localise.BucketLevel.b5 in
   let bucket = check_access access_opt de_opt |> Option.value ~default:default_bucket in
   Localise.error_desc_set_bucket desc bucket
+

infer/src/backend/builtin.ml

@@ -37,18 +37,23 @@ let check_register_populated () =
   if Int.equal (Typ.Procname.Hash.length builtin_functions) 0 then
     L.(die InternalError) "Builtins were not initialized"
 
+
 (** check if the function is a builtin *)
 let is_registered name =
   Typ.Procname.Hash.mem builtin_functions name || (check_register_populated () ; false)
 
+
 (** get the symbolic execution handler associated to the builtin function name *)
 let get name : t option =
   try Some (Typ.Procname.Hash.find builtin_functions name)
   with Not_found -> check_register_populated () ; None
 
+
 (** register a builtin [Typ.Procname.t] and symbolic execution handler *)
 let register proc_name sym_exe_fun : registered =
-  Typ.Procname.Hash.replace builtin_functions proc_name sym_exe_fun ; sym_exe_fun
+  Typ.Procname.Hash.replace builtin_functions proc_name sym_exe_fun ;
+  sym_exe_fun
+
 
 (** print the functions registered *)
 let pp_registered fmt () =
@@ -60,5 +65,9 @@ let pp_registered fmt () =
   List.iter ~f:pp !builtin_names ;
   Format.fprintf fmt "@]@."
 
+
 (** print the builtin functions and exit *)
-let print_and_exit () = pp_registered Format.std_formatter () ; L.exit 0
+let print_and_exit () =
+  pp_registered Format.std_formatter () ;
+  L.exit 0
+

infer/src/backend/callbacks.ml

@@ -34,14 +34,17 @@ let cluster_callbacks = ref []
 let register_procedure_callback ?(dynamic_dispath= false) language (callback: proc_callback_t) =
   procedure_callbacks := (language, dynamic_dispath, callback) :: !procedure_callbacks
 
+
 let register_cluster_callback language (callback: cluster_callback_t) =
   cluster_callbacks := (language, callback) :: !cluster_callbacks
 
+
 (** Collect what we need to know about a procedure for the analysis. *)
 let get_procedure_definition exe_env proc_name =
   let tenv = Exe_env.get_tenv exe_env proc_name in
   Option.map ~f:(fun proc_desc -> (tenv, proc_desc)) (Exe_env.get_proc_desc exe_env proc_name)
 
+
 let get_language proc_name = if Typ.Procname.is_java proc_name then Config.Java else Config.Clang
 
 (** Invoke all registered procedure callbacks on the given procedure. *)
@@ -51,10 +54,10 @@ let iterate_procedure_callbacks get_proc_desc exe_env summary proc_desc =
   Config.curr_language := procedure_language ;
   let get_procs_in_file proc_name =
     match Exe_env.get_cfg exe_env proc_name with
-    | Some cfg
+    | Some cfg ->
-     -> List.map ~f:Procdesc.get_proc_name (Cfg.get_defined_procs cfg)
+        List.map ~f:Procdesc.get_proc_name (Cfg.get_defined_procs cfg)
-    | None
+    | None ->
-     -> []
+        []
   in
   let tenv = Exe_env.get_tenv exe_env proc_name in
   let is_specialized = Procdesc.is_specialized proc_desc in
@@ -65,22 +68,24 @@ let iterate_procedure_callbacks get_proc_desc exe_env summary proc_desc =
       else summary)
     !procedure_callbacks
 
+
 (** Invoke all registered cluster callbacks on a cluster of procedures. *)
 let iterate_cluster_callbacks all_procs exe_env get_proc_desc =
   let procedures = List.filter_map ~f:(get_procedure_definition exe_env) all_procs in
   let environment = {procedures; get_proc_desc} in
   let language_matches language =
     match procedures with
-    | (_, pdesc) :: _
+    | (_, pdesc) :: _ ->
-     -> Config.equal_language language (get_language (Procdesc.get_proc_name pdesc))
+        Config.equal_language language (get_language (Procdesc.get_proc_name pdesc))
-    | _
+    | _ ->
-     -> true
+        true
   in
   List.iter
     ~f:(fun (language_opt, cluster_callback) ->
       if language_matches language_opt then cluster_callback environment)
     !cluster_callbacks
 
+
 (** Invoke all procedure and cluster callbacks on a given environment. *)
 let iterate_callbacks call_graph exe_env =
   let saved_language = !Config.curr_language in
@@ -90,24 +95,24 @@ let iterate_callbacks call_graph exe_env =
   in
   let get_proc_desc proc_name =
     match Exe_env.get_proc_desc exe_env proc_name with
-    | Some pdesc
+    | Some pdesc ->
-     -> Some pdesc
+        Some pdesc
-    | None when Config.(equal_dynamic_dispatch dynamic_dispatch Lazy)
+    | None when Config.(equal_dynamic_dispatch dynamic_dispatch Lazy) ->
-     -> Option.bind (Specs.get_summary proc_name) ~f:(fun summary -> summary.Specs.proc_desc_option)
+        Option.bind (Specs.get_summary proc_name) ~f:(fun summary -> summary.Specs.proc_desc_option)
-    | None
+    | None ->
-     -> None
+        None
   in
   let analyze_ondemand summary proc_desc =
     iterate_procedure_callbacks get_proc_desc exe_env summary proc_desc
   in
-  let callbacks = {Ondemand.analyze_ondemand= analyze_ondemand; get_proc_desc} in
+  let callbacks = {Ondemand.analyze_ondemand; get_proc_desc} in
   (* Create and register on-demand analysis callback *)
   let analyze_proc_name pname =
     match Ondemand.get_proc_desc pname with
-    | None
+    | None ->
-     -> L.(die InternalError) "Could not find proc desc for %a" Typ.Procname.pp pname
+        L.(die InternalError) "Could not find proc desc for %a" Typ.Procname.pp pname
-    | Some pdesc
+    | Some pdesc ->
-     -> ignore (Ondemand.analyze_proc_desc pdesc pdesc)
+        ignore (Ondemand.analyze_proc_desc pdesc pdesc)
   in
   Ondemand.set_callbacks callbacks ;
   (* Invoke procedure callbacks using on-demand anlaysis schedulling *)
@@ -117,3 +122,4 @@ let iterate_callbacks call_graph exe_env =
   (* Unregister callbacks *)
   Ondemand.unset_callbacks () ;
   Config.curr_language := saved_language
+

infer/src/backend/callbacks.mli

@@ -30,7 +30,8 @@ type cluster_callback_args =
 
 type cluster_callback_t = cluster_callback_args -> unit
 
-val register_procedure_callback : ?dynamic_dispath:bool -> Config.language -> proc_callback_t -> unit
+val register_procedure_callback :
+  ?dynamic_dispath:bool -> Config.language -> proc_callback_t -> unit
 (** register a procedure callback *)
 
 val register_cluster_callback : Config.language -> cluster_callback_t -> unit

infer/src/backend/cluster.ml

@@ -23,14 +23,17 @@ type serializer_t = int * t
 let serializer : serializer_t Serialization.serializer =
   Serialization.create_serializer Serialization.Key.cluster
 
+
 (** Load a cluster from a file *)
 let load_from_file (filename: DB.filename) : serializer_t option =
   Serialization.read_from_file serializer filename
 
+
 (** Save a cluster into a file *)
 let store_to_file (filename: DB.filename) (data: serializer_t) =
   Serialization.write_to_file serializer filename ~data
 
+
 let cl_name n = "cl" ^ string_of_int n
 
 let cl_file n = "x" ^ cl_name n ^ ".cluster"
@@ -46,3 +49,4 @@ let pp_cluster fmt (nr, cluster) =
   (* touch the target of the rule to let `make` know that the job has been done *)
   F.fprintf fmt "\t%@touch $%@@\n" ;
   F.fprintf fmt "@\n"
+

infer/src/backend/clusterMakefile.ml

@@ -17,10 +17,10 @@ module CLOpt = CommandLineOption
 let pp_prolog fmt clusters =
   let escape = Escape.escape_map (fun c -> if Char.equal c '#' then Some "\\#" else None) in
   let infer_flag_of_compilation_db = function
-    | `Escaped f
+    | `Escaped f ->
-     -> F.sprintf "--compilation-database-escaped '%s'" f
+        F.sprintf "--compilation-database-escaped '%s'" f
-    | `Raw f
+    | `Raw f ->
-     -> F.sprintf "--compilation-database '%s'" f
+        F.sprintf "--compilation-database '%s'" f
   in
   let compilation_dbs_cmd =
     List.map ~f:infer_flag_of_compilation_db !Config.clang_compilation_dbs
@@ -35,6 +35,7 @@ let pp_prolog fmt clusters =
   F.fprintf fmt "test: $(CLUSTERS)@\n" ;
   if Config.show_progress_bar then F.fprintf fmt "\t%@echo@\n@."
 
+
 let pp_epilog fmt () = F.fprintf fmt "@.clean:@.\trm -f $(CLUSTERS)@."
 
 let create_cluster_makefile (clusters: Cluster.t list) (fname: string) =
@@ -48,3 +49,4 @@ let create_cluster_makefile (clusters: Cluster.t list) (fname: string) =
   List.iteri ~f:do_cluster clusters ;
   pp_epilog fmt () ;
   Out_channel.close outc
+

infer/src/backend/crashcontext.ml

@@ -14,23 +14,25 @@ module L = Logging
 let frame_id_of_stackframe frame =
   let loc_str =
     match frame.Stacktrace.line_num with
-    | None
+    | None ->
-     -> frame.Stacktrace.file_str
+        frame.Stacktrace.file_str
-    | Some line
+    | Some line ->
-     -> F.sprintf "%s:%d" frame.Stacktrace.file_str line
+        F.sprintf "%s:%d" frame.Stacktrace.file_str line
   in
   F.sprintf "%s.%s(%s)" frame.Stacktrace.class_str frame.Stacktrace.method_str loc_str
 
+
 let frame_id_of_summary stacktree =
   let short_name = List.hd_exn (Str.split (Str.regexp "(") stacktree.Stacktree_j.method_name) in
   match stacktree.Stacktree_j.location with
-  | None
+  | None ->
-   -> L.(die InternalError)
+      L.(die InternalError)
         "Attempted to take signature of a frame without location information. This is undefined."
-  | Some {line= Some line_num; file}
+  | Some {line= Some line_num; file} ->
-   -> F.sprintf "%s(%s:%d)" short_name (Filename.basename file) line_num
+      F.sprintf "%s(%s:%d)" short_name (Filename.basename file) line_num
-  | Some {file}
+  | Some {file} ->
-   -> F.sprintf "%s(%s)" short_name (Filename.basename file)
+      F.sprintf "%s(%s)" short_name (Filename.basename file)
+
 
 let stracktree_of_frame frame =
   { Stacktree_j.method_name=
@@ -43,6 +45,7 @@ let stracktree_of_frame frame =
         ; blame_range= [] }
   ; callees= [] }
 
+
 (** k = 1 implementation, where k is the number of levels of calls inlined *)
 let stitch_summaries stacktrace_file summary_files out_file =
   let stacktrace = Stacktrace.of_json_file stacktrace_file in
@@ -64,6 +67,7 @@ let stitch_summaries stacktrace_file summary_files out_file =
   let crashcontext = {Stacktree_j.stack= expanded_frames} in
   Ag_util.Json.to_file Stacktree_j.write_crashcontext_t out_file crashcontext
 
+
 let collect_all_summaries root_summaries_dir stacktrace_file stacktraces_dir =
   let method_summaries =
     Utils.directory_fold
@@ -77,19 +81,19 @@ let collect_all_summaries root_summaries_dir stacktrace_file stacktraces_dir =
   in
   let pair_for_stacktrace_file =
     match stacktrace_file with
-    | None
+    | None ->
-     -> None
+        None
-    | Some file
+    | Some file ->
-     -> let crashcontext_dir = Config.results_dir ^/ "crashcontext" in
+        let crashcontext_dir = Config.results_dir ^/ "crashcontext" in
         Utils.create_dir crashcontext_dir ; Some (file, crashcontext_dir ^/ "crashcontext.json")
   in
   let trace_file_regexp = Str.regexp "\\(.*\\)\\.json" in
   let pairs_for_stactrace_dir =
     match stacktraces_dir with
-    | None
+    | None ->
-     -> []
+        []
-    | Some s
+    | Some s ->
-     -> let dir = DB.filename_from_string s in
+        let dir = DB.filename_from_string s in
         let trace_file_matcher path =
           let path_str = DB.filename_to_string path in
           Str.string_match trace_file_regexp path_str 0
@@ -101,24 +105,25 @@ let collect_all_summaries root_summaries_dir stacktrace_file stacktraces_dir =
         in
         try DB.fold_paths_matching ~dir ~p:trace_file_matcher ~init:[] ~f:trace_fold
         with
-        | (* trace_fold runs immediately after trace_file_matcher in the
+        (* trace_fold runs immediately after trace_file_matcher in the
            DB.fold_paths_matching statement below, so we don't need to
            call Str.string_match again. *)
-        Not_found
+        | Not_found
         -> assert false
   in
   let input_output_file_pairs =
     match pair_for_stacktrace_file with
-    | None
+    | None ->
-     -> pairs_for_stactrace_dir
+        pairs_for_stactrace_dir
-    | Some pair
+    | Some pair ->
-     -> pair :: pairs_for_stactrace_dir
+        pair :: pairs_for_stactrace_dir
   in
   let process_stacktrace (stacktrace_file, out_file) =
     stitch_summaries stacktrace_file method_summaries out_file
   in
   List.iter ~f:process_stacktrace input_output_file_pairs
 
+
 let crashcontext_epilogue ~in_buck_mode =
   (* if we are the top-level process, then find the output directory and
      collect all crashcontext summaries under it in a single
@@ -134,4 +139,5 @@ let crashcontext_epilogue ~in_buck_mode =
   in
   collect_all_summaries root_summaries_dir Config.stacktrace Config.stacktraces_dir
 
+
 let pp_stacktree fmt st = Format.fprintf fmt "%s" (Stacktree_j.string_of_stacktree st)

infer/src/backend/exe_env.ml

@@ -32,6 +32,7 @@ let tenv_filename file_base =
     per_source_tenv_filename
   else DB.global_tenv_fname
 
+
 module FilenameHash = Hashtbl.Make (struct
   type t = DB.filename
 
@@ -52,13 +53,16 @@ let new_file_data source cg_fname =
   cfg_file
   ; cfg= None (* Cfg.load_cfg_from_file cfg_file *) }
 
+
 let create_file_data table source cg_fname =
   match FilenameHash.find table cg_fname with
-  | file_data
+  | file_data ->
-   -> file_data
+      file_data
-  | exception Not_found
+  | exception Not_found ->
-   -> let file_data = new_file_data source cg_fname in
+      let file_data = new_file_data source cg_fname in
-      FilenameHash.add table cg_fname file_data ; file_data
+      FilenameHash.add table cg_fname file_data ;
+      file_data
+
 
 (** execution environment *)
 type t =
@@ -77,37 +81,39 @@ let create () =
   ; file_map= FilenameHash.create 1
   ; source_files= SourceFile.Set.empty }
 
+
 (** add call graph from fname in the spec db,
     with relative tenv and cfg, to the execution environment *)
 let add_cg (exe_env: t) (source_dir: DB.source_dir) =
   let cg_fname = DB.source_dir_get_internal_file source_dir ".cg" in
   match Cg.load_from_file cg_fname with
-  | None
+  | None ->
-   -> L.internal_error "Error: cannot load %s@." (DB.filename_to_string cg_fname)
+      L.internal_error "Error: cannot load %s@." (DB.filename_to_string cg_fname)
-  | Some cg
+  | Some cg ->
-   -> let source = Cg.get_source cg in
+      let source = Cg.get_source cg in
       exe_env.source_files <- SourceFile.Set.add source exe_env.source_files ;
       let defined_procs = Cg.get_defined_nodes cg in
       let duplicate_procs_to_print =
         List.filter_map defined_procs ~f:(fun pname ->
             match Attributes.find_file_capturing_procedure pname with
-            | None
+            | None ->
-             -> None
+                None
-            | Some (source_captured, origin)
+            | Some (source_captured, origin) ->
-             -> let multiply_defined = SourceFile.compare source source_captured <> 0 in
+                let multiply_defined = SourceFile.compare source source_captured <> 0 in
                 if multiply_defined then Cg.remove_node_defined cg pname ;
                 if multiply_defined && origin <> `Include then Some (pname, source_captured)
                 else None )
       in
       if Config.dump_duplicate_symbols then
-        Out_channel.with_file (Config.results_dir ^/ Config.duplicates_filename) ~append:true
+        Out_channel.with_file (Config.results_dir ^/ Config.duplicates_filename)
-          ~perm:0o666 ~f:(fun outc ->
+          ~append:true ~perm:0o666 ~f:(fun outc ->
             let fmt = F.formatter_of_out_channel outc in
             List.iter duplicate_procs_to_print ~f:(fun (pname, source_captured) ->
                 F.fprintf fmt "@.DUPLICATE_SYMBOLS source: %a source_captured:%a pname:%a@."
                   SourceFile.pp source SourceFile.pp source_captured Typ.Procname.pp pname ) ) ;
       Cg.extend exe_env.cg cg
 
+
 (** get the global call graph *)
 let get_cg exe_env = exe_env.cg
 
@@ -116,83 +122,94 @@ let get_file_data exe_env pname =
   with Not_found ->
     let source_file_opt =
       match Attributes.load pname with
-      | None
+      | None ->
-       -> L.(debug Analysis Medium) "can't find tenv_cfg_object for %a@." Typ.Procname.pp pname ;
+          L.(debug Analysis Medium) "can't find tenv_cfg_object for %a@." Typ.Procname.pp pname ;
           None
-      | Some proc_attributes when Config.reactive_capture
+      | Some proc_attributes when Config.reactive_capture ->
-       -> let get_captured_file {ProcAttributes.source_file_captured} = source_file_captured in
+          let get_captured_file {ProcAttributes.source_file_captured} = source_file_captured in
           OndemandCapture.try_capture proc_attributes |> Option.map ~f:get_captured_file
-      | Some proc_attributes
+      | Some proc_attributes ->
-       -> Some proc_attributes.ProcAttributes.source_file_captured
+          Some proc_attributes.ProcAttributes.source_file_captured
     in
     let get_file_data_for_source source_file =
       let source_dir = DB.source_dir_from_source_file source_file in
       let cg_fname = DB.source_dir_get_internal_file source_dir ".cg" in
       let file_data = create_file_data exe_env.file_map source_file cg_fname in
-      Typ.Procname.Hash.replace exe_env.proc_map pname file_data ; file_data
+      Typ.Procname.Hash.replace exe_env.proc_map pname file_data ;
+      file_data
     in
     Option.map ~f:get_file_data_for_source source_file_opt
 
+
 (** return the source file associated to the procedure *)
 let get_source exe_env pname =
   Option.map ~f:(fun file_data -> file_data.source) (get_file_data exe_env pname)
 
+
 let file_data_to_tenv file_data =
   if is_none file_data.tenv then file_data.tenv <- Tenv.load_from_file file_data.tenv_file ;
   file_data.tenv
 
+
 let file_data_to_cfg file_data =
   if is_none file_data.cfg then file_data.cfg <- Cfg.load_cfg_from_file file_data.cfg_file ;
   file_data.cfg
 
+
 let java_global_tenv =
-  ( lazy
+  lazy
-  ( match Tenv.load_from_file DB.global_tenv_fname with
+    ( match Tenv.load_from_file DB.global_tenv_fname with
-  | None
+    | None ->
-   -> L.(die InternalError)
+        L.(die InternalError)
-        "Could not load the global tenv at path '%s'" (DB.filename_to_string DB.global_tenv_fname)
+          "Could not load the global tenv at path '%s'"
-  | Some tenv
+          (DB.filename_to_string DB.global_tenv_fname)
-   -> tenv ) )
+    | Some tenv ->
+        tenv )
+
 
 (** return the type environment associated to the procedure *)
 let get_tenv exe_env proc_name =
   match proc_name with
-  | Typ.Procname.Java _
+  | Typ.Procname.Java _ ->
-   -> Lazy.force java_global_tenv
+      Lazy.force java_global_tenv
   | _ ->
     match get_file_data exe_env proc_name with
     | Some file_data -> (
       match file_data_to_tenv file_data with
-      | Some tenv
+      | Some tenv ->
-       -> tenv
+          tenv
-      | None
+      | None ->
-       -> L.(die InternalError)
+          L.(die InternalError)
             "get_tenv: tenv not found for %a in file '%s'" Typ.Procname.pp proc_name
             (DB.filename_to_string file_data.tenv_file) )
-    | None
+    | None ->
-     -> L.(die InternalError) "get_tenv: file_data not found for %a" Typ.Procname.pp proc_name
+        L.(die InternalError) "get_tenv: file_data not found for %a" Typ.Procname.pp proc_name
+
 
 (** return the cfg associated to the procedure *)
 let get_cfg exe_env pname =
   match get_file_data exe_env pname with
-  | None
+  | None ->
-   -> None
+      None
-  | Some file_data
+  | Some file_data ->
-   -> file_data_to_cfg file_data
+      file_data_to_cfg file_data
+
 
 (** return the proc desc associated to the procedure *)
 let get_proc_desc exe_env pname =
   match get_cfg exe_env pname with
-  | Some cfg
+  | Some cfg ->
-   -> Cfg.find_proc_desc_from_name cfg pname
+      Cfg.find_proc_desc_from_name cfg pname
-  | None
+  | None ->
-   -> None
+      None
+
 
 (** Create an exe_env from a source dir *)
 let from_cluster cluster =
   let exe_env = create () in
   add_cg exe_env cluster ; exe_env
 
+
 (** [iter_files f exe_env] applies [f] to the filename and tenv and cfg for each file in [exe_env] *)
 let iter_files f exe_env =
   let do_file _ file_data seen_files_acc =
@@ -206,3 +223,4 @@ let iter_files f exe_env =
       SourceFile.Set.add fname seen_files_acc )
   in
   ignore (Typ.Procname.Hash.fold do_file exe_env.proc_map SourceFile.Set.empty)
+

infer/src/backend/infer.ml

@@ -24,40 +24,44 @@ let run driver_mode =
   analyze_and_report driver_mode ~changed_files ;
   run_epilogue driver_mode
 
+
 let setup () =
   match Config.command with
-  | Analyze
+  | Analyze ->
-   -> ResultsDir.assert_results_dir "have you run capture before?"
+      ResultsDir.assert_results_dir "have you run capture before?"
-  | Report | ReportDiff
+  | Report | ReportDiff ->
-   -> ResultsDir.create_results_dir ()
+      ResultsDir.create_results_dir ()
-  | Diff
+  | Diff ->
-   -> ResultsDir.remove_results_dir () ; ResultsDir.create_results_dir ()
+      ResultsDir.remove_results_dir () ; ResultsDir.create_results_dir ()
-  | Capture | Compile | Run
+  | Capture | Compile | Run ->
-   -> let driver_mode = Lazy.force Driver.mode_from_command_line in
+      let driver_mode = Lazy.force Driver.mode_from_command_line in
       if not
            ( Driver.(equal_mode driver_mode Analyze)
            ||
            Config.(buck || continue_capture || infer_is_clang || infer_is_javac || reactive_mode) )
       then ResultsDir.remove_results_dir () ;
       ResultsDir.create_results_dir ()
-  | Explore
+  | Explore ->
-   -> ResultsDir.assert_results_dir "please run an infer analysis first"
+      ResultsDir.assert_results_dir "please run an infer analysis first"
+
 
 let print_active_checkers () =
   (if Config.print_active_checkers && CLOpt.is_originator then L.result else L.environment_info)
     "Analyzer: %s@."
     Config.(string_of_analyzer analyzer) ;
   (if Config.print_active_checkers && CLOpt.is_originator then L.result else L.environment_info)
-    "Active checkers: %a@." (Pp.seq ~sep:", " RegisterCheckers.pp_checker)
+    "Active checkers: %a@."
+    (Pp.seq ~sep:", " RegisterCheckers.pp_checker)
     (RegisterCheckers.get_active_checkers ())
 
+
 let log_environment_info () =
   L.environment_info "CWD = %s@\n" (Sys.getcwd ()) ;
   ( match Config.inferconfig_file with
-  | Some file
+  | Some file ->
-   -> L.environment_info "Read configuration in %s@\n" file
+      L.environment_info "Read configuration in %s@\n" file
-  | None
+  | None ->
-   -> L.environment_info "No .inferconfig file found@\n" ) ;
+      L.environment_info "No .inferconfig file found@\n" ) ;
   L.environment_info "Project root = %s@\n" Config.project_root ;
   let infer_args =
     Sys.getenv CLOpt.args_env_var |> Option.map ~f:(String.split ~on:CLOpt.env_var_sep)
@@ -67,47 +71,48 @@ let log_environment_info () =
   L.environment_info "command line arguments: %a" Pp.cli_args (Array.to_list Sys.argv) ;
   print_active_checkers ()
 
+
 let () =
   ( if Config.linters_validate_syntax_only then
       match CTLParserHelper.validate_al_files () with
-      | Ok ()
+      | Ok () ->
-       -> L.exit 0
+          L.exit 0
-      | Error e
+      | Error e ->
-       -> print_endline e ; L.exit 3 ) ;
+          print_endline e ; L.exit 3 ) ;
   if Config.print_builtins then Builtin.print_and_exit () ;
   setup () ;
   log_environment_info () ;
   if Config.debug_mode && CLOpt.is_originator then
     L.progress "Logs in %s@." (Config.results_dir ^/ Config.log_file) ;
   match Config.command with
-  | Analyze
+  | Analyze ->
-   -> let pp_cluster_opt fmt = function
+      let pp_cluster_opt fmt = function
-        | None
+        | None ->
-         -> F.fprintf fmt "(no cluster)"
+            F.fprintf fmt "(no cluster)"
-        | Some cluster
+        | Some cluster ->
-         -> F.fprintf fmt "of cluster %s" (Filename.basename cluster)
+            F.fprintf fmt "of cluster %s" (Filename.basename cluster)
       in
       L.environment_info "Starting analysis %a" pp_cluster_opt Config.cluster_cmdline ;
       if Config.developer_mode then InferAnalyze.register_perf_stats_report () ;
       Driver.analyze_and_report Analyze ~changed_files:(Driver.read_config_changed_files ())
-  | Report
+  | Report ->
-   -> InferPrint.main ~report_csv:Config.issues_csv ~report_json:None
+      InferPrint.main ~report_csv:Config.issues_csv ~report_json:None
-  | ReportDiff
+  | ReportDiff ->
-   -> (* at least one report must be passed in input to compute differential *)
+      (* at least one report must be passed in input to compute differential *)
       ( match (Config.report_current, Config.report_previous) with
-      | None, None
+      | None, None ->
-       -> L.(die UserError)
+          L.(die UserError)
             "Expected at least one argument among 'report-current' and 'report-previous'"
-      | _
+      | _ ->
-       -> () ) ;
+          () ) ;
       ReportDiff.reportdiff ~current_report:Config.report_current
         ~previous_report:Config.report_previous
-  | Capture | Compile | Run
+  | Capture | Compile | Run ->
-   -> run (Lazy.force Driver.mode_from_command_line)
+      run (Lazy.force Driver.mode_from_command_line)
-  | Diff
+  | Diff ->
-   -> Diff.diff (Lazy.force Driver.mode_from_command_line)
+      Diff.diff (Lazy.force Driver.mode_from_command_line)
-  | Explore
+  | Explore ->
-   -> let if_some key opt args =
+      let if_some key opt args =
         match opt with None -> args | Some arg -> key :: string_of_int arg :: args
       in
       let if_true key opt args = if not opt then args else key :: args in
@@ -122,3 +127,4 @@ let () =
         L.external_error
           "** Error running the reporting script:@\n**   %s %s@\n** See error above@." prog
           (String.concat ~sep:" " args)
+

infer/src/backend/inferconfig.ml

@@ -30,6 +30,7 @@ let do_not_filter : filters =
   ; error_filter= default_error_filter
   ; proc_filter= default_proc_filter }
 
+
 type filter_config =
   { whitelist: string list
   ; blacklist: string list
@@ -44,12 +45,14 @@ let is_matching patterns source_file =
       with Not_found -> false)
     patterns
 
+
 (** Check if a proc name is matching the name given as string. *)
 let match_method language proc_name method_name =
   not (BuiltinDecl.is_declared proc_name)
   && Config.equal_language (Typ.Procname.get_language proc_name) language
   && String.equal (Typ.Procname.get_method proc_name) method_name
 
+
 (* Module to create matcher based on strings present in the source file *)
 module FileContainsStringMatcher = struct
   type matcher = SourceFile.t -> bool
@@ -59,13 +62,14 @@ module FileContainsStringMatcher = struct
   let file_contains regexp file_in =
     let rec loop () =
       try Str.search_forward regexp (In_channel.input_line_exn file_in) 0 >= 0 with
-      | Not_found
+      | Not_found ->
-       -> loop ()
+          loop ()
-      | End_of_file
+      | End_of_file ->
-       -> false
+          false
     in
     loop ()
 
+
   let create_matcher s_patterns =
     if List.is_empty s_patterns then default_matcher
     else
@@ -81,6 +85,7 @@ module FileContainsStringMatcher = struct
             source_map := SourceFile.Map.add source_file pattern_found !source_map ;
             pattern_found
           with Sys_error _ -> false
+
 end
 
 type method_pattern =
@@ -123,13 +128,14 @@ module FileOrProcMatcher = struct
       fun _ proc_name ->
         match proc_name with Typ.Procname.Java pname_java -> do_java pname_java | _ -> false
 
+
   let create_file_matcher patterns =
     let s_patterns, m_patterns =
       let collect (s_patterns, m_patterns) = function
-        | Source_contains (_, s)
+        | Source_contains (_, s) ->
-         -> (s :: s_patterns, m_patterns)
+            (s :: s_patterns, m_patterns)
-        | Method_pattern (_, mp)
+        | Method_pattern (_, mp) ->
-         -> (s_patterns, mp :: m_patterns)
+            (s_patterns, mp :: m_patterns)
       in
       List.fold ~f:collect ~init:([], []) patterns
     in
@@ -139,15 +145,16 @@ module FileOrProcMatcher = struct
     and m_matcher = create_method_matcher m_patterns in
     fun source_file proc_name -> m_matcher source_file proc_name || s_matcher source_file proc_name
 
+
   let load_matcher = create_file_matcher
 
   let _pp_pattern fmt pattern =
     let pp_string fmt s = Format.fprintf fmt "%s" s in
     let pp_option pp_value fmt = function
-      | None
+      | None ->
-       -> pp_string fmt "None"
+          pp_string fmt "None"
-      | Some value
+      | Some value ->
-       -> Format.fprintf fmt "%a" pp_value value
+          Format.fprintf fmt "%a" pp_value value
     in
     let pp_key_value pp_value fmt (key, value) =
       Format.fprintf fmt "  %s: %a,@\n" key (pp_option pp_value) value
@@ -161,12 +168,15 @@ module FileOrProcMatcher = struct
         ("parameters", mp.parameters)
     and pp_source_contains fmt sc = Format.fprintf fmt "  pattern: %s@\n" sc in
     match pattern with
-    | Method_pattern (language, mp)
+    | Method_pattern (language, mp) ->
-     -> Format.fprintf fmt "Method pattern (%s) {@\n%a}@\n" (Config.string_of_language language)
+        Format.fprintf fmt "Method pattern (%s) {@\n%a}@\n"
+          (Config.string_of_language language)
           pp_method_pattern mp
-    | Source_contains (language, sc)
+    | Source_contains (language, sc) ->
-     -> Format.fprintf fmt "Source contains (%s) {@\n%a}@\n" (Config.string_of_language language)
+        Format.fprintf fmt "Source contains (%s) {@\n%a}@\n"
+          (Config.string_of_language language)
           pp_source_contains sc
+
 end
 
 (* of module FileOrProcMatcher *)
@@ -174,62 +184,63 @@ end
 module OverridesMatcher = struct
   let load_matcher patterns is_subtype proc_name =
     let is_matching = function
-      | Method_pattern (language, mp)
+      | Method_pattern (language, mp) ->
-       -> is_subtype mp.class_name
+          is_subtype mp.class_name
           && Option.value_map ~f:(match_method language proc_name) ~default:false mp.method_name
-      | _
+      | _ ->
-       -> L.(die UserError) "Expecting method pattern"
+          L.(die UserError) "Expecting method pattern"
     in
     List.exists ~f:is_matching patterns
+
 end
 
 let patterns_of_json_with_key (json_key, json) =
   let default_method_pattern = {class_name= ""; method_name= None; parameters= None} in
   let default_source_contains = "" in
   let language_of_string = function
-    | "Java"
+    | "Java" ->
-     -> Ok Config.Java
+        Ok Config.Java
-    | l
+    | l ->
-     -> Error ("JSON key " ^ json_key ^ " not supported for language " ^ l)
+        Error ("JSON key " ^ json_key ^ " not supported for language " ^ l)
   in
   let rec detect_language = function
-    | []
+    | [] ->
-     -> Error ("No language found for " ^ json_key)
+        Error ("No language found for " ^ json_key)
-    | ("language", `String s) :: _
+    | ("language", `String s) :: _ ->
-     -> language_of_string s
+        language_of_string s
-    | _ :: tl
+    | _ :: tl ->
-     -> detect_language tl
+        detect_language tl
   in
   (* Detect the kind of pattern, method pattern or pattern based on the content of the source file.
      Detecting the kind of patterns in a first step makes it easier to parse the parts of the
      pattern in a second step *)
   let detect_pattern assoc =
     match detect_language assoc with
-    | Ok language
+    | Ok language ->
-     -> let is_method_pattern key = List.exists ~f:(String.equal key) ["class"; "method"]
+        let is_method_pattern key = List.exists ~f:(String.equal key) ["class"; "method"]
         and is_source_contains key = List.exists ~f:(String.equal key) ["source_contains"] in
         let rec loop = function
-          | []
+          | [] ->
-           -> Error ("Unknown pattern for " ^ json_key)
+              Error ("Unknown pattern for " ^ json_key)
-          | (key, _) :: _ when is_method_pattern key
+          | (key, _) :: _ when is_method_pattern key ->
-           -> Ok (Method_pattern (language, default_method_pattern))
+              Ok (Method_pattern (language, default_method_pattern))
-          | (key, _) :: _ when is_source_contains key
+          | (key, _) :: _ when is_source_contains key ->
-           -> Ok (Source_contains (language, default_source_contains))
+              Ok (Source_contains (language, default_source_contains))
-          | _ :: tl
+          | _ :: tl ->
-           -> loop tl
+              loop tl
         in
         loop assoc
-    | Error _ as error
+    | Error _ as error ->
-     -> error
+        error
   in
   (* Translate a JSON entry into a matching pattern *)
   let create_pattern (assoc: (string * Yojson.Basic.json) list) =
     let collect_params l =
       let collect accu = function
-        | `String s
+        | `String s ->
-         -> s :: accu
+            s :: accu
-        | _
+        | _ ->
-         -> L.(die UserError)
+            L.(die UserError)
               "Unrecognised parameters in %s"
               (Yojson.Basic.to_string (`Assoc assoc))
       in
@@ -237,74 +248,80 @@ let patterns_of_json_with_key (json_key, json) =
     in
     let create_method_pattern assoc =
       let loop mp = function
-        | key, `String s when String.equal key "class"
+        | key, `String s when String.equal key "class" ->
-         -> {mp with class_name= s}
+            {mp with class_name= s}
-        | key, `String s when String.equal key "method"
+        | key, `String s when String.equal key "method" ->
-         -> {mp with method_name= Some s}
+            {mp with method_name= Some s}
-        | key, `List l when String.equal key "parameters"
+        | key, `List l when String.equal key "parameters" ->
-         -> {mp with parameters= Some (collect_params l)}
+            {mp with parameters= Some (collect_params l)}
-        | key, _ when String.equal key "language"
+        | key, _ when String.equal key "language" ->
-         -> mp
+            mp
-        | _
+        | _ ->
-         -> L.(die UserError) "Failed to parse %s" (Yojson.Basic.to_string (`Assoc assoc))
+            L.(die UserError) "Failed to parse %s" (Yojson.Basic.to_string (`Assoc assoc))
       in
       List.fold ~f:loop ~init:default_method_pattern assoc
     and create_string_contains assoc =
       let loop sc = function
-        | key, `String pattern when String.equal key "source_contains"
+        | key, `String pattern when String.equal key "source_contains" ->
-         -> pattern
+            pattern
-        | key, _ when String.equal key "language"
+        | key, _ when String.equal key "language" ->
-         -> sc
+            sc
-        | _
+        | _ ->
-         -> L.(die UserError) "Failed to parse %s" (Yojson.Basic.to_string (`Assoc assoc))
+            L.(die UserError) "Failed to parse %s" (Yojson.Basic.to_string (`Assoc assoc))
       in
       List.fold ~f:loop ~init:default_source_contains assoc
     in
     match detect_pattern assoc with
-    | Ok Method_pattern (language, _)
+    | Ok Method_pattern (language, _) ->
-     -> Ok (Method_pattern (language, create_method_pattern assoc))
+        Ok (Method_pattern (language, create_method_pattern assoc))
-    | Ok Source_contains (language, _)
+    | Ok Source_contains (language, _) ->
-     -> Ok (Source_contains (language, create_string_contains assoc))
+        Ok (Source_contains (language, create_string_contains assoc))
-    | Error _ as error
+    | Error _ as error ->
-     -> error
+        error
   in
   let warn_user msg = CLOpt.warnf "WARNING: error parsing option %s@\n%s@." json_key msg in
   (* Translate all the JSON entries into matching patterns *)
   let rec translate accu = function
     | `Assoc l -> (
       match create_pattern l with
-      | Ok pattern
+      | Ok pattern ->
-       -> pattern :: accu
+          pattern :: accu
-      | Error msg
+      | Error msg ->
-       -> warn_user msg ; accu )
+          warn_user msg ; accu )
-    | `List l
+    | `List l ->
-     -> List.fold ~f:translate ~init:accu l
+        List.fold ~f:translate ~init:accu l
-    | json
+    | json ->
-     -> warn_user
+        warn_user
           (Printf.sprintf "expected list or assoc json type, but got value %s"
              (Yojson.Basic.to_string json)) ;
         accu
   in
   translate [] json
 
+
 let modeled_expensive_matcher =
   OverridesMatcher.load_matcher (patterns_of_json_with_key Config.patterns_modeled_expensive)
 
+
 let never_return_null_matcher =
   FileOrProcMatcher.load_matcher (patterns_of_json_with_key Config.patterns_never_returning_null)
 
+
 let skip_translation_matcher =
   FileOrProcMatcher.load_matcher (patterns_of_json_with_key Config.patterns_skip_translation)
 
+
 let skip_implementation_matcher =
   FileOrProcMatcher.load_matcher (patterns_of_json_with_key Config.patterns_skip_implementation)
 
+
 let load_filters analyzer =
   { whitelist= Config.analysis_path_regex_whitelist analyzer
   ; blacklist= Config.analysis_path_regex_blacklist analyzer
   ; blacklist_files_containing= Config.analysis_blacklist_files_containing analyzer
   ; suppress_errors= Config.analysis_suppress_errors analyzer }
 
+
 let filters_from_inferconfig inferconfig : filters =
   let path_filter =
     let whitelist_filter : path_filter =
@@ -318,22 +335,24 @@ let filters_from_inferconfig inferconfig : filters =
       FileContainsStringMatcher.create_matcher inferconfig.blacklist_files_containing
     in
     function
-      | source_file
+      | source_file ->
-       -> whitelist_filter source_file && not (blacklist_filter source_file)
+          whitelist_filter source_file && not (blacklist_filter source_file)
           && not (blacklist_files_containing_filter source_file)
   in
   let error_filter = function
-    | error_name
+    | error_name ->
-     -> let error_str = error_name.IssueType.unique_id in
+        let error_str = error_name.IssueType.unique_id in
         not (List.exists ~f:(String.equal error_str) inferconfig.suppress_errors)
   in
   {path_filter; error_filter; proc_filter= default_proc_filter}
 
+
 (* Create filters based on .inferconfig *)
 let create_filters analyzer =
   if not Config.filter_paths then do_not_filter
   else filters_from_inferconfig (load_filters analyzer)
 
+
 (* This function loads and list the path that are being filtered by the analyzer. The results *)
 (* are of the form: path/to/file.java -> {infer, checkers} meaning that analysis results will *)
 (* be reported on path/to/file.java both for infer and for the checkers *)
@@ -357,3 +376,4 @@ let test () =
           let matching_s = String.concat ~sep:", " (List.map ~f:fst matching) in
           L.result "%s -> {%s}@." (SourceFile.to_rel_path source_file) matching_s)
     (Sys.getcwd ())
+

infer/src/backend/interproc.ml

@@ -28,37 +28,41 @@ module NodeVisitSet = Caml.Set.Make (struct
     (* higher id is better *)
     Procdesc.Node.compare n2 n1
 
+
   let compare_distance_to_exit {node= n1} {node= n2} =
     (* smaller means higher priority *)
     let n =
       match (Procdesc.Node.get_distance_to_exit n1, Procdesc.Node.get_distance_to_exit n2) with
-      | None, None
+      | None, None ->
-       -> 0
+          0
-      | None, Some _
+      | None, Some _ ->
-       -> 1
+          1
-      | Some _, None
+      | Some _, None ->
-       -> -1
+          -1
-      | Some d1, Some d2
+      | Some d1, Some d2 ->
-       -> (* shorter distance to exit is better *)
+          (* shorter distance to exit is better *)
           Int.compare d1 d2
     in
     if n <> 0 then n else compare_ids n1 n2
 
+
   let compare_number_of_visits x1 x2 =
     let n = Int.compare x1.visits x2.visits in
     (* visited fewer times is better *)
     if n <> 0 then n else compare_distance_to_exit x1 x2
 
+
   let compare x1 x2 =
     if !Config.footprint then
       match Config.worklist_mode with
-      | 0
+      | 0 ->
-       -> compare_ids x1.node x2.node
+          compare_ids x1.node x2.node
-      | 1
+      | 1 ->
-       -> compare_distance_to_exit x1 x2
+          compare_distance_to_exit x1 x2
-      | _
+      | _ ->
-       -> compare_number_of_visits x1 x2
+          compare_number_of_visits x1 x2
     else compare_ids x1.node x2.node
+
 end)
 
 (** Table for the results of the join operation on nodes. *)
@@ -79,6 +83,7 @@ end = struct
     try Hashtbl.find table i
     with Not_found -> Paths.PathSet.empty
 
+
   let add table i dset = Hashtbl.replace table i dset
 end
 
@@ -98,6 +103,7 @@ module Worklist = struct
     ; todo_set= NodeVisitSet.empty
     ; visit_map= Procdesc.NodeMap.empty }
 
+
   let is_empty (wl: t) : bool = NodeVisitSet.is_empty wl.todo_set
 
   let add (wl: t) (node: Procdesc.Node.t) : unit =
@@ -108,6 +114,7 @@ module Worklist = struct
     in
     wl.todo_set <- NodeVisitSet.add {node; visits} wl.todo_set
 
+
   (** remove the minimum element from the worklist, and increase its number of visits *)
   let remove (wl: t) : Procdesc.Node.t =
     try
@@ -119,6 +126,7 @@ module Worklist = struct
     with Not_found ->
       L.internal_error "@\n...Work list is empty! Impossible to remove edge...@\n" ;
       assert false
+
 end
 
 (* =============== END of module Worklist =============== *)
@@ -129,10 +137,14 @@ let path_set_create_worklist proc_cfg =
   Procdesc.compute_distance_to_exit_node (ProcCfg.Exceptional.proc_desc proc_cfg) ;
   Worklist.create ()
 
+
 let htable_retrieve (htable: (Procdesc.Node.id, Paths.PathSet.t) Hashtbl.t) (key: Procdesc.Node.id)
     : Paths.PathSet.t =
   try Hashtbl.find htable key
-  with Not_found -> Hashtbl.replace htable key Paths.PathSet.empty ; Paths.PathSet.empty
+  with Not_found ->
+    Hashtbl.replace htable key Paths.PathSet.empty ;
+    Paths.PathSet.empty
+
 
 (** Add [d] to the pathset todo at [node] returning true if changed *)
 let path_set_put_todo (wl: Worklist.t) (node: Procdesc.Node.t) (d: Paths.PathSet.t) : bool =
@@ -150,6 +162,7 @@ let path_set_put_todo (wl: Worklist.t) (node: Procdesc.Node.t) (d: Paths.PathSet
   in
   changed
 
+
 let path_set_checkout_todo (wl: Worklist.t) (node: Procdesc.Node.t) : Paths.PathSet.t =
   try
     let node_id = Procdesc.Node.get_id node in
@@ -157,15 +170,18 @@ let path_set_checkout_todo (wl: Worklist.t) (node: Procdesc.Node.t) : Paths.Path
     Hashtbl.replace wl.Worklist.path_set_todo node_id Paths.PathSet.empty ;
     let visited = Hashtbl.find wl.Worklist.path_set_visited node_id in
     let new_visited = Paths.PathSet.union visited todo in
-    Hashtbl.replace wl.Worklist.path_set_visited node_id new_visited ; todo
+    Hashtbl.replace wl.Worklist.path_set_visited node_id new_visited ;
+    todo
   with Not_found -> L.die InternalError "could not find todo for node %a" Procdesc.Node.pp node
 
+
 (* =============== END of the edge_set object =============== *)
 
 let collect_do_abstract_pre pname tenv (pset: Propset.t) : Propset.t =
   if !Config.footprint then Config.run_in_re_execution_mode (Abs.lifted_abstract pname tenv) pset
   else Abs.lifted_abstract pname tenv pset
 
+
 let collect_do_abstract_post pname tenv (pathset: Paths.PathSet.t) : Paths.PathSet.t =
   let abs_option p =
     if Prover.check_inconsistency tenv p then None else Some (Abs.abstract pname tenv p)
@@ -174,16 +190,19 @@ let collect_do_abstract_post pname tenv (pathset: Paths.PathSet.t) : Paths.PathS
     Config.run_in_re_execution_mode (Paths.PathSet.map_option abs_option) pathset
   else Paths.PathSet.map_option abs_option pathset
 
+
 let do_join_pre plist = Dom.proplist_collapse_pre plist
 
 let do_join_post pname tenv (pset: Paths.PathSet.t) =
   if Config.spec_abs_level <= 0 then Dom.pathset_collapse tenv pset
   else Dom.pathset_collapse tenv (Dom.pathset_collapse_impl pname tenv pset)
 
+
 let do_meet_pre tenv pset =
   if Config.meet_level > 0 then Dom.propset_meet_generate_pre tenv pset
   else Propset.to_proplist pset
 
+
 (** Find the preconditions in the current spec table,
     apply meet then join, and return the joined preconditions *)
 let collect_preconditions tenv summary : Prop.normal Specs.Jprop.t list =
@@ -247,6 +266,7 @@ let collect_preconditions tenv summary : Prop.normal Specs.Jprop.t list =
   L.d_ln () ;
   jplist''
 
+
 (* =============== START of symbolic execution =============== *)
 
 (** propagate a set of results to the given node *)
@@ -265,6 +285,7 @@ let propagate (wl: Worklist.t) pname ~is_exception (pset: Paths.PathSet.t)
   let changed = path_set_put_todo wl curr_node edgeset_todo in
   if changed then Worklist.add wl curr_node
 
+
 (** propagate a set of results, including exceptions and divergence *)
 let propagate_nodes_divergence tenv (proc_cfg: ProcCfg.Exceptional.t) (pset: Paths.PathSet.t)
     (succ_nodes: Procdesc.Node.t list) (exn_nodes: Procdesc.Node.t list) (wl: Worklist.t) =
@@ -289,6 +310,7 @@ let propagate_nodes_divergence tenv (proc_cfg: ProcCfg.Exceptional.t) (pset: Pat
   List.iter ~f:(propagate wl pname ~is_exception:false pset_ok) succ_nodes ;
   List.iter ~f:(propagate wl pname ~is_exception:true pset_exn) exn_nodes
 
+
 (* ===================== END of symbolic execution ===================== *)
 (* =============== START of forward_tabulate =============== *)
 
@@ -312,6 +334,7 @@ let do_symexec_join proc_cfg tenv wl curr_node (edgeset_todo: Paths.PathSet.t) =
         new_dset')
     succ_nodes
 
+
 let prop_max_size = ref (0, Prop.prop_emp)
 
 let prop_max_chain_size = ref (0, Prop.prop_emp)
@@ -325,14 +348,17 @@ let check_prop_size_ p _ =
     Prop.d_prop p ;
     L.d_ln () )
 
+
 (* Check prop size and filter out possible unabstracted lists *)
 let check_prop_size edgeset_todo =
   if Config.monitor_prop_size then Paths.PathSet.iter check_prop_size_ edgeset_todo
 
+
 let reset_prop_metrics () =
   prop_max_size := (0, Prop.prop_emp) ;
   prop_max_chain_size := (0, Prop.prop_emp)
 
+
 exception RE_EXE_ERROR
 
 let do_before_node session node =
@@ -341,6 +367,7 @@ let do_before_node session node =
   L.reset_delayed_prints () ;
   Printer.node_start_session node (session :> int)
 
+
 let do_after_node node = Printer.node_finish_session node
 
 (** Return the list of normal ids occurring in the instructions *)
@@ -351,7 +378,10 @@ let instrs_get_normal_vars instrs =
     let exps = Sil.instr_get_exps instr in
     List.iter ~f:do_e exps
   in
-  List.iter ~f:do_instr instrs ; Sil.fav_filter_ident fav Ident.is_normal ; Sil.fav_to_list fav
+  List.iter ~f:do_instr instrs ;
+  Sil.fav_filter_ident fav Ident.is_normal ;
+  Sil.fav_to_list fav
+
 
 (** Perform symbolic execution for a node starting from an initial prop *)
 let do_symbolic_execution proc_cfg handle_exn tenv (node: ProcCfg.Exceptional.node)
@@ -373,6 +403,7 @@ let do_symbolic_execution proc_cfg handle_exn tenv (node: ProcCfg.Exceptional.no
   State.mark_execution_end node ;
   pset
 
+
 let mark_visited summary node =
   let node_id = Procdesc.Node.get_id node in
   let stats = summary.Specs.stats in
@@ -380,6 +411,7 @@ let mark_visited summary node =
     stats.Specs.nodes_visited_fp <- IntSet.add (node_id :> int) stats.Specs.nodes_visited_fp
   else stats.Specs.nodes_visited_re <- IntSet.add (node_id :> int) stats.Specs.nodes_visited_re
 
+
 let forward_tabulate tenv proc_cfg wl =
   let pname = Procdesc.get_proc_name (ProcCfg.Exceptional.proc_desc proc_cfg) in
   let handle_exn_node curr_node exn =
@@ -389,10 +421,10 @@ let forward_tabulate tenv proc_cfg wl =
       State.get_normalized_pre (Abs.abstract_no_symop pname)
     in
     ( match pre_opt with
-    | Some pre
+    | Some pre ->
-     -> L.d_strln "Precondition:" ; Prop.d_prop pre ; L.d_ln ()
+        L.d_strln "Precondition:" ; Prop.d_prop pre ; L.d_ln ()
-    | None
+    | None ->
-     -> () ) ;
+        () ) ;
     L.d_strln "SIL INSTR:" ;
     Procdesc.Node.d_instrs ~sub_instrs:true (State.get_instr ()) curr_node ;
     L.d_ln () ;
@@ -452,14 +484,14 @@ let forward_tabulate tenv proc_cfg wl =
     check_prop_size pathset_todo ;
     print_node_preamble curr_node session pathset_todo ;
     match Procdesc.Node.get_kind curr_node with
-    | Procdesc.Node.Join_node
+    | Procdesc.Node.Join_node ->
-     -> do_symexec_join proc_cfg tenv wl curr_node pathset_todo
+        do_symexec_join proc_cfg tenv wl curr_node pathset_todo
     | Procdesc.Node.Stmt_node _
     | Procdesc.Node.Prune_node _
     | Procdesc.Node.Exit_node _
     | Procdesc.Node.Skip_node _
-    | Procdesc.Node.Start_node _
+    | Procdesc.Node.Start_node _ ->
-     -> exe_iter (do_prop curr_node handle_exn) pathset_todo
+        exe_iter (do_prop curr_node handle_exn) pathset_todo
   in
   let do_node_and_handle curr_node session =
     let pathset_todo = path_set_checkout_todo wl curr_node in
@@ -485,38 +517,40 @@ let forward_tabulate tenv proc_cfg wl =
     mark_visited summary curr_node ;
     (* mark nodes visited in fp and re phases *)
     let session = incr summary.Specs.sessions ; !(summary.Specs.sessions) in
-    do_before_node session curr_node ; do_node_and_handle curr_node session
+    do_before_node session curr_node ;
+    do_node_and_handle curr_node session
   done ;
   L.d_strln ".... Work list empty. Stop ...." ;
   L.d_ln ()
 
+
 (** if possible, produce a (fieldname, typ) path from one of the [src_exps] to [sink_exp] using
     [reachable_hpreds]. *)
 let get_fld_typ_path_opt src_exps sink_exp_ reachable_hpreds_ =
   let strexp_matches target_exp = function
-    | Sil.Eexp (e, _)
+    | Sil.Eexp (e, _) ->
-     -> Exp.equal target_exp e
+        Exp.equal target_exp e
-    | _
+    | _ ->
-     -> false
+        false
   in
   let extend_path hpred (sink_exp, path, reachable_hpreds) =
     match hpred with
-    | Sil.Hpointsto (lhs, Sil.Estruct (flds, _), Exp.Sizeof {typ})
+    | Sil.Hpointsto (lhs, Sil.Estruct (flds, _), Exp.Sizeof {typ}) ->
-     -> List.find ~f:(function _, se -> strexp_matches sink_exp se) flds
+        List.find ~f:(function _, se -> strexp_matches sink_exp se) flds
         |> Option.value_map
              ~f:(function
-                 | fld, _
+                 | fld, _ ->
-                  -> let reachable_hpreds' = Sil.HpredSet.remove hpred reachable_hpreds in
+                     let reachable_hpreds' = Sil.HpredSet.remove hpred reachable_hpreds in
                      (lhs, (Some fld, typ) :: path, reachable_hpreds'))
              ~default:(sink_exp, path, reachable_hpreds)
-    | Sil.Hpointsto (lhs, Sil.Earray (_, elems, _), Exp.Sizeof {typ})
+    | Sil.Hpointsto (lhs, Sil.Earray (_, elems, _), Exp.Sizeof {typ}) ->
-     -> if List.exists ~f:(function _, se -> strexp_matches sink_exp se) elems then
+        if List.exists ~f:(function _, se -> strexp_matches sink_exp se) elems then
           let reachable_hpreds' = Sil.HpredSet.remove hpred reachable_hpreds in
           (* None means "no field name" ~=~ nameless array index *)
           (lhs, (None, typ) :: path, reachable_hpreds')
         else (sink_exp, path, reachable_hpreds)
-    | _
+    | _ ->
-     -> (sink_exp, path, reachable_hpreds)
+        (sink_exp, path, reachable_hpreds)
   in
   (* terminates because [reachable_hpreds] is shrinking on each recursive call *)
   let rec get_fld_typ_path sink_exp path reachable_hpreds =
@@ -530,6 +564,7 @@ let get_fld_typ_path_opt src_exps sink_exp_ reachable_hpreds_ =
   in
   get_fld_typ_path sink_exp_ [] reachable_hpreds_
 
+
 (** report an error if any Context is reachable from a static field *)
 let report_context_leaks pname sigma tenv =
   (* report an error if an expression in [context_exps] is reachable from [field_strexp] *)
@@ -541,10 +576,10 @@ let report_context_leaks pname sigma tenv =
       ~f:(fun (context_exp, name) ->
         if Exp.Set.mem context_exp reachable_exps then
           match get_fld_typ_path_opt fld_exps context_exp reachable_hpreds with
-          | None
+          | None ->
-           -> () (* TODO (T21871205): the underlying issue still need to be fixed *)
+              () (* TODO (T21871205): the underlying issue still need to be fixed *)
-          | Some leak_path
+          | Some leak_path ->
-           -> let err_desc =
+              let err_desc =
                 Errdesc.explain_context_leak pname (Typ.mk (Tstruct name)) fld_name leak_path
               in
               let exn = Exceptions.Context_leak (err_desc, __POS__) in
@@ -558,23 +593,24 @@ let report_context_leaks pname sigma tenv =
         match hpred with
         | Sil.Hpointsto (_, Eexp (exp, _), Sizeof {typ= {desc= Tptr ({desc= Tstruct name}, _)}})
           when not (Exp.is_null_literal exp) && AndroidFramework.is_context tenv name
-               && not (AndroidFramework.is_application tenv name)
+               && not (AndroidFramework.is_application tenv name) ->
-         -> (exp, name) :: exps
+            (exp, name) :: exps
-        | _
+        | _ ->
-         -> exps)
+            exps)
       ~init:[] sigma
   in
   List.iter
     ~f:(function
-        | Sil.Hpointsto (Exp.Lvar pv, Sil.Estruct (static_flds, _), _) when Pvar.is_global pv
+        | Sil.Hpointsto (Exp.Lvar pv, Sil.Estruct (static_flds, _), _) when Pvar.is_global pv ->
-         -> List.iter
+            List.iter
               ~f:(fun (f_name, f_strexp) ->
                 check_reachable_context_from_fld (f_name, f_strexp) context_exps)
               static_flds
-        | _
+        | _ ->
-         -> ())
+            ())
     sigma
 
+
 (** Remove locals and formals,
     and check if the address of a stack variable is left in the result *)
 let remove_locals_formals_and_check tenv proc_cfg p =
@@ -590,6 +626,7 @@ let remove_locals_formals_and_check tenv proc_cfg p =
   in
   List.iter ~f:check_pvar pvars ; p'
 
+
 (** Collect the analysis results for the exit node. *)
 let collect_analysis_result tenv wl proc_cfg : Paths.PathSet.t =
   let exit_node = ProcCfg.Exceptional.exit_node proc_cfg in
@@ -597,6 +634,7 @@ let collect_analysis_result tenv wl proc_cfg : Paths.PathSet.t =
   let pathset = htable_retrieve wl.Worklist.path_set_visited exit_node_id in
   Paths.PathSet.map (remove_locals_formals_and_check tenv proc_cfg) pathset
 
+
 module Pmap = Caml.Map.Make (struct
   type t = Prop.normal Prop.t
 
@@ -606,9 +644,11 @@ end)
 let vset_ref_add_path vset_ref path =
   Paths.Path.iter_all_nodes_nocalls (fun n -> vset_ref := Procdesc.NodeSet.add n !vset_ref) path
 
+
 let vset_ref_add_pathset vset_ref pathset =
   Paths.PathSet.iter (fun _ path -> vset_ref_add_path vset_ref path) pathset
 
+
 let compute_visited vset =
   let res = ref Specs.Visitedset.empty in
   let node_get_all_lines n =
@@ -620,7 +660,9 @@ let compute_visited vset =
   let do_node n =
     res := Specs.Visitedset.add (Procdesc.Node.get_id n, node_get_all_lines n) !res
   in
-  Procdesc.NodeSet.iter do_node vset ; !res
+  Procdesc.NodeSet.iter do_node vset ;
+  !res
+
 
 (** Extract specs from a pathset *)
 let extract_specs tenv pdesc pathset : Prop.normal Specs.spec list =
@@ -665,10 +707,10 @@ let extract_specs tenv pdesc pathset : Prop.normal Specs.spec list =
       in
       let new_posts =
         match post with
-        | None
+        | None ->
-         -> current_posts
+            current_posts
-        | Some (post, path)
+        | Some (post, path) ->
-         -> Paths.PathSet.add_renamed_prop post path current_posts
+            Paths.PathSet.add_renamed_prop post path current_posts
       in
       let new_visited = Specs.Visitedset.union visited current_visited in
       Pmap.add pre (new_posts, new_visited) map
@@ -682,21 +724,20 @@ let extract_specs tenv pdesc pathset : Prop.normal Specs.spec list =
         ~f:(fun (p, path) -> (PropUtil.remove_seed_vars tenv p, path))
         (Paths.PathSet.elements (do_join_post pname tenv posts))
     in
-    let spec =
+    let spec = {Specs.pre= Specs.Jprop.Prop (1, pre); Specs.posts= posts'; Specs.visited} in
-      {Specs.pre= Specs.Jprop.Prop (1, pre); Specs.posts= posts'; Specs.visited= visited}
-    in
     specs := spec :: !specs
   in
   Pmap.iter add_spec pre_post_map ; !specs
 
+
 let collect_postconditions wl tenv proc_cfg : Paths.PathSet.t * Specs.Visitedset.t =
   let pname = Procdesc.get_proc_name (ProcCfg.Exceptional.proc_desc proc_cfg) in
   let pathset = collect_analysis_result tenv wl proc_cfg in
   (* Assuming C++ developers use RAII, remove resources from the constructor posts *)
   let pathset =
     match pname with
-    | Typ.Procname.ObjC_Cpp _
+    | Typ.Procname.ObjC_Cpp _ ->
-     -> if Typ.Procname.is_constructor pname then
+        if Typ.Procname.is_constructor pname then
           Paths.PathSet.map
             (fun prop ->
               Attribute.remove_resource tenv Racquire (Rmemory Mobjc)
@@ -704,8 +745,8 @@ let collect_postconditions wl tenv proc_cfg : Paths.PathSet.t * Specs.Visitedset
                    (Attribute.remove_resource tenv Racquire Rfile prop)))
             pathset
         else pathset
-    | _
+    | _ ->
-     -> pathset
+        pathset
   in
   L.d_strln ("#### [FUNCTION " ^ Typ.Procname.to_string pname ^ "] Analysis result ####") ;
   Propset.d Prop.prop_emp (Paths.PathSet.to_propset tenv pathset) ;
@@ -733,15 +774,17 @@ let collect_postconditions wl tenv proc_cfg : Paths.PathSet.t * Specs.Visitedset
   L.d_ln () ;
   res
 
+
 let create_seed_vars sigma =
   let hpred_add_seed sigma = function
-    | Sil.Hpointsto (Exp.Lvar pv, se, typ) when not (Pvar.is_abduced pv)
+    | Sil.Hpointsto (Exp.Lvar pv, se, typ) when not (Pvar.is_abduced pv) ->
-     -> Sil.Hpointsto (Exp.Lvar (Pvar.to_seed pv), se, typ) :: sigma
+        Sil.Hpointsto (Exp.Lvar (Pvar.to_seed pv), se, typ) :: sigma
-    | _
+    | _ ->
-     -> sigma
+        sigma
   in
   List.fold ~f:hpred_add_seed ~init:[] sigma
 
+
 (** Initialize proposition for execution given formal and global
     parameters. The footprint is initialized according to the
     execution mode. The prop is not necessarily emp, so it
@@ -751,26 +794,27 @@ let prop_init_formals_seed tenv new_formals (prop: 'a Prop.t) : Prop.exposed Pro
     let do_formal (pv, typ) =
       let texp =
         match !Config.curr_language with
-        | Config.Clang
+        | Config.Clang ->
-         -> Exp.Sizeof {typ; nbytes= None; dynamic_length= None; subtype= Subtype.exact}
+            Exp.Sizeof {typ; nbytes= None; dynamic_length= None; subtype= Subtype.exact}
-        | Config.Java
+        | Config.Java ->
-         -> Exp.Sizeof {typ; nbytes= None; dynamic_length= None; subtype= Subtype.subtypes}
+            Exp.Sizeof {typ; nbytes= None; dynamic_length= None; subtype= Subtype.subtypes}
-        | Config.Python
+        | Config.Python ->
-         -> L.die InternalError "prop_init_formals_seed not implemented for Python"
+            L.die InternalError "prop_init_formals_seed not implemented for Python"
       in
       Prop.mk_ptsto_lvar tenv Prop.Fld_init Sil.inst_formal (pv, texp, None)
     in
     List.map ~f:do_formal new_formals
   in
   let sigma_seed =
-    create_seed_vars (* formals already there plus new ones *)
+    create_seed_vars ((* formals already there plus new ones *)
-                     (prop.Prop.sigma @ sigma_new_formals)
+                      prop.Prop.sigma @ sigma_new_formals)
   in
   let sigma = sigma_seed @ sigma_new_formals in
   let new_pi = prop.Prop.pi in
   let prop' = Prop.set (Prop.prop_sigma_star prop sigma) ~pi:new_pi in
   Prop.set prop' ~sigma_fp:(prop'.Prop.sigma_fp @ sigma_new_formals)
 
+
 (** Construct an initial prop by extending [prop] with locals, and formals if [add_formals] is true
     as well as seed variables *)
 let initial_prop tenv (curr_f: Procdesc.t) (prop: 'a Prop.t) add_formals : Prop.normal Prop.t =
@@ -785,6 +829,7 @@ let initial_prop tenv (curr_f: Procdesc.t) (prop: 'a Prop.t) add_formals : Prop.
   let prop2 = prop_init_formals_seed tenv new_formals prop1 in
   Prop.prop_rename_primed_footprint_vars tenv (Prop.normalize tenv prop2)
 
+
 (** Construct an initial prop from the empty prop *)
 let initial_prop_from_emp tenv curr_f = initial_prop tenv curr_f Prop.prop_emp true
 
@@ -801,6 +846,7 @@ let initial_prop_from_pre tenv curr_f pre =
     initial_prop tenv curr_f pre3 false
   else initial_prop tenv curr_f pre false
 
+
 (** Re-execute one precondition and return some spec if there was no re-execution error. *)
 let execute_filter_prop wl tenv proc_cfg init_node (precondition: Prop.normal Specs.Jprop.t)
     : Prop.normal Specs.spec option =
@@ -841,12 +887,12 @@ let execute_filter_prop wl tenv proc_cfg init_node (precondition: Prop.normal Sp
     let pre =
       let p = PropUtil.remove_locals_ret tenv pdesc (Specs.Jprop.to_prop precondition) in
       match precondition with
-      | Specs.Jprop.Prop (n, _)
+      | Specs.Jprop.Prop (n, _) ->
-       -> Specs.Jprop.Prop (n, p)
+          Specs.Jprop.Prop (n, p)
-      | Specs.Jprop.Joined (n, _, jp1, jp2)
+      | Specs.Jprop.Joined (n, _, jp1, jp2) ->
-       -> Specs.Jprop.Joined (n, p, jp1, jp2)
+          Specs.Jprop.Joined (n, p, jp1, jp2)
     in
-    let spec = {Specs.pre= pre; Specs.posts= posts; Specs.visited= visited} in
+    let spec = {Specs.pre; Specs.posts; Specs.visited} in
     L.d_decrease_indent 1 ; do_after_node init_node ; Some spec
   with RE_EXE_ERROR ->
     do_before_node 0 init_node ;
@@ -860,6 +906,7 @@ let execute_filter_prop wl tenv proc_cfg init_node (precondition: Prop.normal Sp
     do_after_node init_node ;
     None
 
+
 let pp_intra_stats wl proc_cfg fmt _ =
   let nstates = ref 0 in
   let nodes = ProcCfg.Exceptional.nodes proc_cfg in
@@ -872,6 +919,7 @@ let pp_intra_stats wl proc_cfg fmt _ =
     nodes ;
   F.fprintf fmt "(%d nodes containing %d states)" (List.length nodes) !nstates
 
+
 type exe_phase = (unit -> unit) * (unit -> Prop.normal Specs.spec list * Specs.phase)
 
 (** Return functions to perform one phase of the analysis for a procedure.
@@ -933,7 +981,8 @@ let perform_analysis_phase tenv (summary: Specs.summary) (proc_cfg: ProcCfg.Exce
             Exceptions.Internal_error
               (Localise.verbatim_desc "Leak_while_collecting_specs_after_footprint")
           in
-          Reporting.log_error_deprecated pname exn ; (* retuning no specs *) []
+          Reporting.log_error_deprecated pname exn ;
+          (* retuning no specs *) []
       in
       (specs, Specs.FOOTPRINT)
     in
@@ -952,10 +1001,10 @@ let perform_analysis_phase tenv (summary: Specs.summary) (proc_cfg: ProcCfg.Exce
         let speco = execute_filter_prop wl tenv proc_cfg start_node p in
         let is_valid =
           match speco with
-          | None
+          | None ->
-           -> false
+              false
-          | Some spec
+          | Some spec ->
-           -> valid_specs := !valid_specs @ [spec] ;
+              valid_specs := !valid_specs @ [spec] ;
               true
         in
         let outcome = if is_valid then "pass" else "fail" in
@@ -982,26 +1031,32 @@ let perform_analysis_phase tenv (summary: Specs.summary) (proc_cfg: ProcCfg.Exce
       L.(debug Analysis Medium) "@\n *** CANDIDATE PRECONDITIONS FOR %a: " Typ.Procname.pp pname ;
       L.(debug Analysis Medium) "@\n================================================@\n" ;
       L.(debug Analysis Medium)
-        "@\n%a @\n@\n" (Specs.Jprop.pp_list Pp.text false) candidate_preconditions ;
+        "@\n%a @\n@\n"
+        (Specs.Jprop.pp_list Pp.text false)
+        candidate_preconditions ;
       L.(debug Analysis Medium) "@\n@\n================================================" ;
       L.(debug Analysis Medium) "@\n *** VALID PRECONDITIONS FOR %a: " Typ.Procname.pp pname ;
       L.(debug Analysis Medium) "@\n================================================@\n" ;
       L.(debug Analysis Medium)
-        "@\n%a @\n@." (Specs.Jprop.pp_list Pp.text true) valid_preconditions ;
+        "@\n%a @\n@."
+        (Specs.Jprop.pp_list Pp.text true)
+        valid_preconditions ;
       (specs, Specs.RE_EXECUTION)
     in
     (go, get_results)
   in
   match Specs.get_phase summary with
-  | Specs.FOOTPRINT
+  | Specs.FOOTPRINT ->
-   -> compute_footprint ()
+      compute_footprint ()
-  | Specs.RE_EXECUTION
+  | Specs.RE_EXECUTION ->
-   -> re_execution ()
+      re_execution ()
+
 
 let set_current_language proc_desc =
   let language = (Procdesc.get_attributes proc_desc).ProcAttributes.language in
   Config.curr_language := language
 
+
 (** reset global values before analysing a procedure *)
 let reset_global_values proc_desc =
   Config.reset_abs_val () ;
@@ -1011,67 +1066,72 @@ let reset_global_values proc_desc =
   Abs.reset_current_rules () ;
   set_current_language proc_desc
 
+
 (* Collect all pairs of the kind (precondition, runtime exception) from a summary *)
 let exception_preconditions tenv pname summary =
   let collect_exceptions pre (exns, all_post_exn) (prop, _) =
     match Tabulation.prop_get_exn_name pname prop with
-    | Some exn_name when PatternMatch.is_runtime_exception tenv exn_name
+    | Some exn_name when PatternMatch.is_runtime_exception tenv exn_name ->
-     -> ((pre, exn_name) :: exns, all_post_exn)
+        ((pre, exn_name) :: exns, all_post_exn)
-    | _
+    | _ ->
-     -> (exns, false)
+        (exns, false)
   in
   let collect_spec errors spec =
     List.fold ~f:(collect_exceptions spec.Specs.pre) ~init:errors spec.Specs.posts
   in
   List.fold ~f:collect_spec ~init:([], true) (Specs.get_specs_from_payload summary)
 
+
 (* Collect all pairs of the kind (precondition, custom error) from a summary *)
 let custom_error_preconditions summary =
   let collect_errors pre (errors, all_post_error) (prop, _) =
     match Tabulation.lookup_custom_errors prop with
-    | None
+    | None ->
-     -> (errors, false)
+        (errors, false)
-    | Some e
+    | Some e ->
-     -> ((pre, e) :: errors, all_post_error)
+        ((pre, e) :: errors, all_post_error)
   in
   let collect_spec errors spec =
     List.fold ~f:(collect_errors spec.Specs.pre) ~init:errors spec.Specs.posts
   in
   List.fold ~f:collect_spec ~init:([], true) (Specs.get_specs_from_payload summary)
 
+
 (* Remove the constrain of the form this != null which is true for all Java virtual calls *)
 let remove_this_not_null tenv prop =
   let collect_hpred (var_option, hpreds) = function
     | Sil.Hpointsto (Exp.Lvar pvar, Sil.Eexp (Exp.Var var, _), _)
-      when Config.curr_language_is Config.Java && Pvar.is_this pvar
+      when Config.curr_language_is Config.Java && Pvar.is_this pvar ->
-     -> (Some var, hpreds)
+        (Some var, hpreds)
-    | hpred
+    | hpred ->
-     -> (var_option, hpred :: hpreds)
+        (var_option, hpred :: hpreds)
   in
   let collect_atom var atoms = function
-    | Sil.Aneq (Exp.Var v, e) when Ident.equal v var && Exp.equal e Exp.null
+    | Sil.Aneq (Exp.Var v, e) when Ident.equal v var && Exp.equal e Exp.null ->
-     -> atoms
+        atoms
-    | a
+    | a ->
-     -> a :: atoms
+        a :: atoms
   in
   match List.fold ~f:collect_hpred ~init:(None, []) prop.Prop.sigma with
-  | None, _
+  | None, _ ->
-   -> prop
+      prop
-  | Some var, filtered_hpreds
+  | Some var, filtered_hpreds ->
-   -> let filtered_atoms = List.fold ~f:(collect_atom var) ~init:[] prop.Prop.pi in
+      let filtered_atoms = List.fold ~f:(collect_atom var) ~init:[] prop.Prop.pi in
       let prop' = Prop.set Prop.prop_emp ~pi:filtered_atoms ~sigma:filtered_hpreds in
       Prop.normalize tenv prop'
 
+
 (** Is true when the precondition does not contain constrains that can be false at call site.
     This means that the post-conditions associated with this precondition cannot be prevented
     by the calling context. *)
 let is_unavoidable tenv pre =
   let prop = remove_this_not_null tenv (Specs.Jprop.to_prop pre) in
   match Prop.CategorizePreconditions.categorize [prop] with
-  | Prop.CategorizePreconditions.NoPres | Prop.CategorizePreconditions.Empty
+  | Prop.CategorizePreconditions.NoPres | Prop.CategorizePreconditions.Empty ->
-   -> true
+      true
-  | _
+  | _ ->
-   -> false
+      false
+
 
 (** Detects if there are specs of the form {precondition} proc {runtime exception} and report
     an error in that case, generating the trace that lead to the runtime exception if the method is
@@ -1085,11 +1145,11 @@ let report_runtime_exceptions tenv pdesc summary =
     is_public_method
     &&
     match pname with
-    | Typ.Procname.Java pname_java
+    | Typ.Procname.Java pname_java ->
-     -> Typ.Procname.java_is_static pname
+        Typ.Procname.java_is_static pname
         && String.equal (Typ.Procname.java_get_method pname_java) "main"
-    | _
+    | _ ->
-     -> false
+        false
   in
   let is_annotated pdesc = Annotations.pdesc_has_return_annot pdesc Annotations.ia_is_verify in
   let exn_preconditions, all_post_exn = exception_preconditions tenv pname summary in
@@ -1105,6 +1165,7 @@ let report_runtime_exceptions tenv pdesc summary =
   in
   List.iter ~f:report exn_preconditions
 
+
 let report_custom_errors tenv summary =
   let pname = Specs.get_proc_name summary in
   let error_preconditions, all_post_error = custom_error_preconditions summary in
@@ -1117,6 +1178,7 @@ let report_custom_errors tenv summary =
   in
   List.iter ~f:report error_preconditions
 
+
 module SpecMap = Caml.Map.Make (struct
   type t = Prop.normal Specs.Jprop.t
 
@@ -1180,7 +1242,7 @@ let update_specs tenv prev_summary phase (new_specs: Specs.NormSpec.t list)
   let convert pre (post_set, visited) =
     res
     := Specs.spec_normalize tenv
-         {Specs.pre= pre; Specs.posts= Paths.PathSet.elements post_set; Specs.visited= visited}
+         {Specs.pre; Specs.posts= Paths.PathSet.elements post_set; Specs.visited}
        :: !res
   in
   List.iter ~f:re_exe_filter old_specs ;
@@ -1190,6 +1252,7 @@ let update_specs tenv prev_summary phase (new_specs: Specs.NormSpec.t list)
   SpecMap.iter convert !current_specs ;
   (!res, !changed)
 
+
 (** update a summary after analysing a procedure *)
 let update_summary tenv prev_summary specs phase res =
   let normal_specs = List.map ~f:(Specs.spec_normalize tenv) specs in
@@ -1201,13 +1264,14 @@ let update_summary tenv prev_summary specs phase res =
   let stats = {prev_summary.Specs.stats with symops; stats_failure} in
   let preposts =
     match phase with
-    | Specs.FOOTPRINT
+    | Specs.FOOTPRINT ->
-     -> Some new_specs
+        Some new_specs
-    | Specs.RE_EXECUTION
+    | Specs.RE_EXECUTION ->
-     -> Some (List.map ~f:(Specs.NormSpec.erase_join_info_pre tenv) new_specs)
+        Some (List.map ~f:(Specs.NormSpec.erase_join_info_pre tenv) new_specs)
   in
-  let payload = {prev_summary.Specs.payload with Specs.preposts= preposts} in
+  let payload = {prev_summary.Specs.payload with Specs.preposts} in
-  {prev_summary with Specs.phase= phase; stats; payload}
+  {prev_summary with Specs.phase; stats; payload}
+
 
 (** Analyze the procedure and return the resulting summary. *)
 let analyze_proc tenv proc_cfg : Specs.summary =
@@ -1225,6 +1289,7 @@ let analyze_proc tenv proc_cfg : Specs.summary =
     report_runtime_exceptions tenv proc_desc updated_summary ;
   updated_summary
 
+
 (** Perform the transition from [FOOTPRINT] to [RE_EXECUTION] in spec table *)
 let transition_footprint_re_exe tenv proc_name joined_pres =
   L.(debug Analysis Medium) "Transition %a from footprint to re-exe@." Typ.Procname.pp proc_name ;
@@ -1243,6 +1308,7 @@ let transition_footprint_re_exe tenv proc_name joined_pres =
   in
   Specs.add_summary proc_name summary'
 
+
 (** Perform phase transition from [FOOTPRINT] to [RE_EXECUTION] for
     the procedures enabled after the analysis of [proc_name] *)
 let perform_transition proc_cfg tenv proc_name =
@@ -1269,15 +1335,17 @@ let perform_transition proc_cfg tenv proc_name =
           "Error in collect_preconditions for %a@." Typ.Procname.pp proc_name ;
         let error = Exceptions.recognize_exception exn in
         let err_str = "exception raised " ^ error.name.IssueType.unique_id in
-        L.(debug Analysis Medium) "Error: %s %a@." err_str L.pp_ml_loc_opt error.ml_loc ; []
+        L.(debug Analysis Medium) "Error: %s %a@." err_str L.pp_ml_loc_opt error.ml_loc ;
+        []
     in
     transition_footprint_re_exe tenv proc_name joined_pres
   in
   match Specs.get_summary proc_name with
-  | Some summary when Specs.equal_phase (Specs.get_phase summary) Specs.FOOTPRINT
+  | Some summary when Specs.equal_phase (Specs.get_phase summary) Specs.FOOTPRINT ->
-   -> transition summary
+      transition summary
-  | _
+  | _ ->
-   -> ()
+      ()
+
 
 (* Create closures for the interprocedural algorithm *)
 let interprocedural_algorithm_closures ~prepare_proc exe_env : Tasks.closure list =
@@ -1289,17 +1357,18 @@ let interprocedural_algorithm_closures ~prepare_proc exe_env : Tasks.closure lis
     | Some proc_desc
       when Config.reactive_mode
            (* in reactive mode, only analyze changed procedures *)
-           && (Procdesc.get_attributes proc_desc).ProcAttributes.changed
+           && (Procdesc.get_attributes proc_desc).ProcAttributes.changed ->
-     -> analyze proc_desc
+        analyze proc_desc
-    | Some proc_desc
+    | Some proc_desc ->
-     -> analyze proc_desc
+        analyze proc_desc
-    | None
+    | None ->
-     -> ()
+        ()
   in
   let procs_to_analyze = Cg.get_defined_nodes call_graph in
   let create_closure proc_name () = process_one_proc proc_name in
   List.map ~f:create_closure procs_to_analyze
 
+
 let analyze_procedure_aux cg_opt tenv proc_desc =
   let proc_name = Procdesc.get_proc_name proc_desc in
   let proc_cfg = ProcCfg.Exceptional.from_pdesc proc_desc in
@@ -1311,17 +1380,20 @@ let analyze_procedure_aux cg_opt tenv proc_desc =
   Specs.add_summary proc_name summaryfp ;
   perform_transition proc_cfg tenv proc_name ;
   let summaryre = Config.run_in_re_execution_mode (analyze_proc tenv) proc_cfg in
-  Specs.add_summary proc_name summaryre ; summaryre
+  Specs.add_summary proc_name summaryre ;
+  summaryre
+
 
 let analyze_procedure {Callbacks.summary; proc_desc; tenv} : Specs.summary =
   let proc_name = Procdesc.get_proc_name proc_desc in
   Specs.add_summary proc_name summary ;
   ( try ignore (analyze_procedure_aux None tenv proc_desc)
     with exn ->
-    reraise_if exn ~f:(fun () -> not (Exceptions.handle_exception exn)) ;
+      reraise_if exn ~f:(fun () -> not (Exceptions.handle_exception exn)) ;
-    Reporting.log_error_deprecated proc_name exn ) ;
+      Reporting.log_error_deprecated proc_name exn ) ;
   Specs.get_summary_unsafe __FILE__ proc_name
 
+
 (** Create closures to perform the analysis of an exe_env *)
 let do_analysis_closures exe_env : Tasks.closure list =
   let get_calls caller_pdesc =
@@ -1350,13 +1422,13 @@ let do_analysis_closures exe_env : Tasks.closure list =
   let callbacks =
     let get_proc_desc proc_name =
       match Exe_env.get_proc_desc exe_env proc_name with
-      | Some pdesc
+      | Some pdesc ->
-       -> Some pdesc
+          Some pdesc
-      | None when Config.(equal_dynamic_dispatch dynamic_dispatch Lazy)
+      | None when Config.(equal_dynamic_dispatch dynamic_dispatch Lazy) ->
-       -> Option.bind (Specs.get_summary proc_name) ~f:(fun summary ->
+          Option.bind (Specs.get_summary proc_name) ~f:(fun summary ->
               summary.Specs.proc_desc_option )
-      | None
+      | None ->
-       -> None
+          None
     in
     let analyze_ondemand _ proc_desc =
       let proc_name = Procdesc.get_proc_name proc_desc in
@@ -1364,7 +1436,7 @@ let do_analysis_closures exe_env : Tasks.closure list =
       let cg = Exe_env.get_cg exe_env in
       analyze_procedure_aux (Some cg) tenv proc_desc
     in
-    {Ondemand.analyze_ondemand= analyze_ondemand; get_proc_desc}
+    {Ondemand.analyze_ondemand; get_proc_desc}
   in
   let prepare_proc pn =
     let should_init = Config.models_mode || is_none (Specs.get_summary pn) in
@@ -1378,6 +1450,7 @@ let do_analysis_closures exe_env : Tasks.closure list =
   in
   closures
 
+
 let visited_and_total_nodes ~filter cfg =
   let filter_node pdesc n =
     Procdesc.is_defined pdesc && filter pdesc
@@ -1386,10 +1459,10 @@ let visited_and_total_nodes ~filter cfg =
     | Procdesc.Node.Stmt_node _
     | Procdesc.Node.Prune_node _
     | Procdesc.Node.Start_node _
-    | Procdesc.Node.Exit_node _
+    | Procdesc.Node.Exit_node _ ->
-     -> true
+        true
-    | Procdesc.Node.Skip_node _ | Procdesc.Node.Join_node
+    | Procdesc.Node.Skip_node _ | Procdesc.Node.Join_node ->
-     -> false
+        false
   in
   let counted_nodes, visited_nodes_re =
     let set = ref Procdesc.NodeSet.empty in
@@ -1404,6 +1477,7 @@ let visited_and_total_nodes ~filter cfg =
   in
   (Procdesc.NodeSet.elements visited_nodes_re, Procdesc.NodeSet.elements counted_nodes)
 
+
 (** Print the stats for the given cfg.
     Consider every defined proc unless a proc with the same name
     was defined in another module, and was the one which was analyzed *)
@@ -1411,10 +1485,10 @@ let print_stats_cfg proc_shadowed source cfg =
   let err_table = Errlog.create_err_table () in
   let filter pdesc =
     match Specs.get_summary (Procdesc.get_proc_name pdesc) with
-    | None
+    | None ->
-     -> false
+        false
-    | Some summary
+    | Some summary ->
-     -> Specs.get_specs_from_payload summary <> []
+        Specs.get_specs_from_payload summary <> []
   in
   let nodes_visited, nodes_total = visited_and_total_nodes ~filter cfg in
   let num_proc = ref 0 in
@@ -1428,14 +1502,14 @@ let print_stats_cfg proc_shadowed source cfg =
   let compute_stats_proc proc_desc =
     let proc_name = Procdesc.get_proc_name proc_desc in
     match Specs.get_summary proc_name with
-    | None
+    | None ->
-     -> ()
+        ()
-    | Some _ when proc_shadowed proc_desc
+    | Some _ when proc_shadowed proc_desc ->
-     -> L.(debug Analysis Medium)
+        L.(debug Analysis Medium)
           "print_stats: ignoring function %a which is also defined in another file@."
           Typ.Procname.pp proc_name
-    | Some summary
+    | Some summary ->
-     -> let stats = summary.Specs.stats in
+        let stats = summary.Specs.stats in
         let err_log = summary.Specs.attributes.ProcAttributes.err_log in
         incr num_proc ;
         let specs = Specs.get_specs_from_payload summary in
@@ -1448,14 +1522,14 @@ let print_stats_cfg proc_shadowed source cfg =
                   Exceptions.equal_err_kind ekind Exceptions.Kerror && in_footprint)
                 err_log )
           with
-          | [], 0
+          | [], 0 ->
-           -> incr num_nospec_noerror_proc
+              incr num_nospec_noerror_proc
-          | _, 0
+          | _, 0 ->
-           -> incr num_spec_noerror_proc
+              incr num_spec_noerror_proc
-          | [], _
+          | [], _ ->
-           -> incr num_nospec_error_proc
+              incr num_nospec_error_proc
-          | _, _
+          | _, _ ->
-           -> incr num_spec_error_proc
+              incr num_spec_error_proc
         in
         tot_symops := !tot_symops + stats.Specs.symops ;
         if Option.is_some stats.Specs.stats_failure then incr num_timeout ;
@@ -1498,6 +1572,7 @@ let print_stats_cfg proc_shadowed source cfg =
   L.(debug Analysis Medium) "%a" print_file_stats () ;
   save_file_stats ()
 
+
 (** Print the stats for all the files in the cluster *)
 let print_stats cluster =
   let exe_env = Exe_env.from_cluster cluster in
@@ -1510,3 +1585,4 @@ let print_stats cluster =
       in
       print_stats_cfg proc_shadowed source cfg)
     exe_env
+

infer/src/backend/mergeCapture.ml

@@ -24,10 +24,12 @@ let modified_targets = ref String.Set.empty
 
 let record_modified_targets_from_file file =
   match Utils.read_file file with
-  | Ok targets
+  | Ok targets ->
-   -> modified_targets := List.fold ~f:String.Set.add ~init:String.Set.empty targets
+      modified_targets := List.fold ~f:String.Set.add ~init:String.Set.empty targets
-  | Error error
+  | Error error ->
-   -> L.user_error "Failed to read modified targets file '%s': %s@." file error ; ()
+      L.user_error "Failed to read modified targets file '%s': %s@." file error ;
+      ()
+
 
 type stats = {mutable files_linked: int; mutable targets_merged: int}
 
@@ -39,6 +41,7 @@ let link_exists s =
     true
   with Unix.Unix_error _ -> false
 
+
 let create_link ~stats src dst =
   if link_exists dst then Unix.unlink dst ;
   Unix.symlink ~src ~dst ;
@@ -50,6 +53,7 @@ let create_link ~stats src dst =
   Unix.utimes src ~access:near_past ~modif:near_past ;
   stats.files_linked <- stats.files_linked + 1
 
+
 (** Create symbolic links recursively from the destination to the source.
     Replicate the structure of the source directory in the destination,
     with files replaced by links to the source. *)
@@ -66,6 +70,7 @@ let rec slink ~stats ~skiplevels src dst =
   else if skiplevels > 0 then ()
   else create_link ~stats src dst
 
+
 (** Determine if the destination should link to the source.
     To check if it was linked before, check if all the captured source files
     from the source are also in the destination.
@@ -113,6 +118,7 @@ let should_link ~target ~target_results_dir ~stats infer_out_src infer_out_dst =
   if r then L.(debug MergeCapture Medium) "%s@." target_results_dir ;
   r
 
+
 (** should_link needs to know whether the source file has changed,
     and  to determine whether the destination has never been copied.
     In both cases, perform the link. *)
@@ -121,8 +127,8 @@ let process_merge_file deps_file =
   let stats = empty_stats () in
   let process_line line =
     match Str.split_delim (Str.regexp (Str.quote "\t")) line with
-    | target :: _ :: target_results_dir :: _
+    | target :: _ :: target_results_dir :: _ ->
-     -> let infer_out_src =
+        let infer_out_src =
           if Filename.is_relative target_results_dir then Filename.dirname (buck_out ())
             ^/ target_results_dir
           else target_results_dir
@@ -131,17 +137,18 @@ let process_merge_file deps_file =
         (* Don't link toplevel files, definitely not .start *)
         if should_link ~target ~target_results_dir ~stats infer_out_src infer_out_dst then
           slink ~stats ~skiplevels infer_out_src infer_out_dst
-    | _
+    | _ ->
-     -> ()
+        ()
   in
   ( match Utils.read_file deps_file with
-  | Ok lines
+  | Ok lines ->
-   -> List.iter ~f:process_line lines
+      List.iter ~f:process_line lines
-  | Error error
+  | Error error ->
-   -> L.internal_error "Couldn't read deps file '%s': %s" deps_file error ) ;
+      L.internal_error "Couldn't read deps file '%s': %s" deps_file error ) ;
   L.progress "Targets merged: %d@\n" stats.targets_merged ;
   L.progress "Files linked: %d@\n" stats.files_linked
 
+
 let merge_captured_targets () =
   let time0 = Mtime_clock.counter () in
   L.progress "Merging captured Buck targets...@\n%!" ;
@@ -149,3 +156,4 @@ let merge_captured_targets () =
   MergeResults.merge_buck_flavors_results infer_deps_file ;
   process_merge_file infer_deps_file ;
   L.progress "Merging captured Buck targets took %a@\n%!" Mtime.Span.pp (Mtime_clock.count time0)
+

infer/src/backend/ondemand.ml

@@ -39,35 +39,39 @@ let is_active, add_active, remove_active =
   in
   (is_active, add_active, remove_active)
 
+
 let should_create_summary proc_name proc_attributes =
   match proc_name with
-  | Typ.Procname.Java _
+  | Typ.Procname.Java _ ->
-   -> true
+      true
-  | _
+  | _ ->
-   -> proc_attributes.ProcAttributes.is_defined
+      proc_attributes.ProcAttributes.is_defined
+
 
 let should_be_analyzed proc_name proc_attributes =
   let already_analyzed () =
     match Specs.get_summary proc_name with
-    | Some summary
+    | Some summary ->
-     -> Specs.equal_status (Specs.get_status summary) Specs.Analyzed
+        Specs.equal_status (Specs.get_status summary) Specs.Analyzed
-    | None
+    | None ->
-     -> false
+        false
   in
   should_create_summary proc_name proc_attributes && not (is_active proc_name)
   && (* avoid infinite loops *)
      not (already_analyzed ())
 
+
 let procedure_should_be_analyzed proc_name =
   match Specs.proc_resolve_attributes proc_name with
-  | Some proc_attributes when Config.reactive_capture && not proc_attributes.is_defined
+  | Some proc_attributes when Config.reactive_capture && not proc_attributes.is_defined ->
-   -> (* try to capture procedure first *)
+      (* try to capture procedure first *)
       let defined_proc_attributes = OndemandCapture.try_capture proc_attributes in
       Option.value_map ~f:(should_be_analyzed proc_name) ~default:false defined_proc_attributes
-  | Some proc_attributes
+  | Some proc_attributes ->
-   -> should_be_analyzed proc_name proc_attributes
+      should_be_analyzed proc_name proc_attributes
-  | None
+  | None ->
-   -> false
+      false
+
 
 type global_state =
   { abs_val: int
@@ -89,6 +93,7 @@ let save_global_state () =
   ; name_generator= Ident.NameGenerator.get_current ()
   ; symexec_state= State.save_state () }
 
+
 let restore_global_state st =
   Config.abs_val := st.abs_val ;
   Abs.set_current_rules st.abstraction_rules ;
@@ -99,6 +104,7 @@ let restore_global_state st =
   State.restore_state st.symexec_state ;
   Timeout.resume_previous_timeout ()
 
+
 let run_proc_analysis analyze_proc curr_pdesc callee_pdesc =
   let curr_pname = Procdesc.get_proc_name curr_pdesc in
   let callee_pname = Procdesc.get_proc_name callee_pdesc in
@@ -130,7 +136,7 @@ let run_proc_analysis analyze_proc curr_pdesc callee_pdesc =
     Reporting.log_error summary exn ;
     let stats = {summary.Specs.stats with Specs.stats_failure= Some kind} in
     let payload = {summary.Specs.payload with Specs.preposts= Some []} in
-    let new_summary = {summary with Specs.stats= stats; payload} in
+    let new_summary = {summary with Specs.stats; payload} in
     Specs.store_summary new_summary ;
     remove_active callee_pname ;
     log_elapsed_time () ;
@@ -151,44 +157,50 @@ let run_proc_analysis analyze_proc curr_pdesc callee_pdesc =
     L.internal_error "@\nERROR RUNNING BACKEND: %a %s@\n@\nBACK TRACE@\n%s@?" Typ.Procname.pp
       callee_pname (Exn.to_string exn) (Printexc.get_backtrace ()) ;
     match exn with
-    | SymOp.Analysis_failure_exe kind
+    | SymOp.Analysis_failure_exe kind ->
-     -> (* in production mode, log the timeout/crash and continue with the summary we had before
+        (* in production mode, log the timeout/crash and continue with the summary we had before
             the failure occurred *)
         log_error_and_continue exn initial_summary kind
-    | _
+    | _ ->
-     -> (* this happens with assert false or some other unrecognized exception *)
+        (* this happens with assert false or some other unrecognized exception *)
         log_error_and_continue exn initial_summary (FKcrash (Exn.to_string exn))
 
+
 let analyze_proc_desc curr_pdesc callee_pdesc : Specs.summary option =
   let callee_pname = Procdesc.get_proc_name callee_pdesc in
   let proc_attributes = Procdesc.get_attributes callee_pdesc in
   match !callbacks_ref with
-  | None
+  | None ->
-   -> L.(die InternalError)
+      L.(die InternalError)
         "No callbacks registered to analyze proc desc %a when analyzing %a" Typ.Procname.pp
-        callee_pname Typ.Procname.pp (Procdesc.get_proc_name curr_pdesc)
+        callee_pname Typ.Procname.pp
-  | Some callbacks
+        (Procdesc.get_proc_name curr_pdesc)
-   -> if should_be_analyzed callee_pname proc_attributes then
+  | Some callbacks ->
+      if should_be_analyzed callee_pname proc_attributes then
         Some (run_proc_analysis callbacks.analyze_ondemand curr_pdesc callee_pdesc)
       else Specs.get_summary callee_pname
 
+
 (** analyze_proc_name curr_pdesc proc_name performs an on-demand analysis of proc_name triggered
     during the analysis of curr_pname *)
 let analyze_proc_name curr_pdesc callee_pname : Specs.summary option =
   match !callbacks_ref with
-  | None
+  | None ->
-   -> L.(die InternalError)
+      L.(die InternalError)
         "No callbacks registered to analyze proc name %a when analyzing %a@." Typ.Procname.pp
-        callee_pname Typ.Procname.pp (Procdesc.get_proc_name curr_pdesc)
+        callee_pname Typ.Procname.pp
-  | Some callbacks
+        (Procdesc.get_proc_name curr_pdesc)
-   -> if procedure_should_be_analyzed callee_pname then
+  | Some callbacks ->
+      if procedure_should_be_analyzed callee_pname then
         match callbacks.get_proc_desc callee_pname with
-        | Some callee_pdesc
+        | Some callee_pdesc ->
-         -> analyze_proc_desc curr_pdesc callee_pdesc
+            analyze_proc_desc curr_pdesc callee_pdesc
-        | None
+        | None ->
-         -> Specs.get_summary callee_pname
+            Specs.get_summary callee_pname
       else Specs.get_summary callee_pname
 
+
 (** Find a proc desc for the procedure, perhaps loading it from disk. *)
 let get_proc_desc callee_pname =
   match !callbacks_ref with Some callbacks -> callbacks.get_proc_desc callee_pname | None -> None
+

infer/src/backend/paths.ml

@@ -118,44 +118,51 @@ end = struct
   let get_description path =
     match path with Pnode (_, _, _, _, _, descr_opt) -> descr_opt | _ -> None
 
+
   let add_description path description =
     let add_descr descr_option description =
       match descr_option with Some descr -> descr ^ " " ^ description | None -> description
     in
     match path with
-    | Pnode (node, exn_opt, session, path, stats, descr_opt)
+    | Pnode (node, exn_opt, session, path, stats, descr_opt) ->
-     -> let description = add_descr descr_opt description in
+        let description = add_descr descr_opt description in
         Pnode (node, exn_opt, session, path, stats, Some description)
-    | _
+    | _ ->
-     -> path
+        path
+
 
   let set_dummy_stats stats =
     stats.max_length <- -1 ;
     stats.linear_num <- -1.0
 
+
   let rec curr_node = function
-    | Pstart (node, _)
+    | Pstart (node, _) ->
-     -> Some node
+        Some node
-    | Pnode (node, _, _, _, _, _)
+    | Pnode (node, _, _, _, _, _) ->
-     -> Some node
+        Some node
-    | Pcall (path, _, _, _)
+    | Pcall (path, _, _, _) ->
-     -> curr_node path
+        curr_node path
-    | Pjoin _
+    | Pjoin _ ->
-     -> None
+        None
+
 
   let start node = Pstart (node, get_dummy_stats ())
 
   let extend (node: Procdesc.Node.t) exn_opt session path =
     Pnode (node, exn_opt, session, path, get_dummy_stats (), None)
 
+
   let join p1 p2 = Pjoin (p1, p2, get_dummy_stats ())
 
   let add_call include_subtrace p pname p_sub =
     if include_subtrace then Pcall (p, pname, ExecCompleted p_sub, get_dummy_stats ()) else p
 
+
   let add_skipped_call p pname reason loc_opt =
     Pcall (p, pname, ExecSkipped (reason, loc_opt), get_dummy_stats ())
 
+
   (** functions in this module either do not assume, or do not re-establish, the invariant on dummy
       stats *)
   module Invariant = struct
@@ -164,30 +171,32 @@ end = struct
 
     (** return the stats of the path, assumes that the stats are computed *)
     let get_stats = function
-      | Pstart (_, stats)
+      | Pstart (_, stats) ->
-       -> stats
+          stats
-      | Pnode (_, _, _, _, stats, _)
+      | Pnode (_, _, _, _, stats, _) ->
-       -> stats
+          stats
-      | Pjoin (_, _, stats)
+      | Pjoin (_, _, stats) ->
-       -> stats
+          stats
-      | Pcall (_, _, _, stats)
+      | Pcall (_, _, _, stats) ->
-       -> stats
+          stats
+
 
     (** restore the invariant that all the stats are dummy, so the path is ready for another
         traversal assumes that the stats are computed beforehand, and ensures that the invariant
         holds afterwards *)
     let rec reset_stats = function
-      | Pstart (_, stats)
+      | Pstart (_, stats) ->
-       -> if not (stats_is_dummy stats) then set_dummy_stats stats
+          if not (stats_is_dummy stats) then set_dummy_stats stats
-      | Pnode (_, _, _, path, stats, _) | Pcall (path, _, ExecSkipped _, stats)
+      | Pnode (_, _, _, path, stats, _) | Pcall (path, _, ExecSkipped _, stats) ->
-       -> if not (stats_is_dummy stats) then ( reset_stats path ; set_dummy_stats stats )
+          if not (stats_is_dummy stats) then ( reset_stats path ; set_dummy_stats stats )
-      | Pjoin (path1, path2, stats)
+      | Pjoin (path1, path2, stats) ->
-       -> if not (stats_is_dummy stats) then (
+          if not (stats_is_dummy stats) then (
             reset_stats path1 ; reset_stats path2 ; set_dummy_stats stats )
-      | Pcall (path1, _, ExecCompleted path2, stats)
+      | Pcall (path1, _, ExecCompleted path2, stats) ->
-       -> if not (stats_is_dummy stats) then (
+          if not (stats_is_dummy stats) then (
             reset_stats path1 ; reset_stats path2 ; set_dummy_stats stats )
 
+
     (** Iterate [f] over the path and compute the stats, assuming the invariant: all the stats are
         dummy.  Function [f] (typically with side-effects) is applied once to every node, and
         max_length in the stats is the length of a longest sequence of nodes in the path where [f]
@@ -198,13 +207,13 @@ end = struct
     let rec compute_stats do_calls (f: Procdesc.Node.t -> bool) =
       let nodes_found stats = stats.max_length > 0 in
       function
-        | Pstart (node, stats)
+        | Pstart (node, stats) ->
-         -> if stats_is_dummy stats then
+            if stats_is_dummy stats then
               let found = f node in
               stats.max_length <- (if found then 1 else 0) ;
               stats.linear_num <- 1.0
-        | Pnode (node, _, _, path, stats, _)
+        | Pnode (node, _, _, path, stats, _) ->
-         -> if stats_is_dummy stats then (
+            if stats_is_dummy stats then (
               compute_stats do_calls f path ;
               let stats1 = get_stats path in
               let found =
@@ -213,21 +222,21 @@ end = struct
               in
               stats.max_length <- (if found then 1 + stats1.max_length else 0) ;
               stats.linear_num <- stats1.linear_num )
-        | Pjoin (path1, path2, stats)
+        | Pjoin (path1, path2, stats) ->
-         -> if stats_is_dummy stats then (
+            if stats_is_dummy stats then (
               compute_stats do_calls f path1 ;
               compute_stats do_calls f path2 ;
               let stats1, stats2 = (get_stats path1, get_stats path2) in
               stats.max_length <- max stats1.max_length stats2.max_length ;
               stats.linear_num <- stats1.linear_num +. stats2.linear_num )
-        | Pcall (path1, _, ExecCompleted path2, stats)
+        | Pcall (path1, _, ExecCompleted path2, stats) ->
-         -> if stats_is_dummy stats then
+            if stats_is_dummy stats then
               let stats2 =
                 match do_calls with
-                | true
+                | true ->
-                 -> compute_stats do_calls f path2 ; get_stats path2
+                    compute_stats do_calls f path2 ; get_stats path2
-                | false
+                | false ->
-                 -> {max_length= 0; linear_num= 0.0}
+                    {max_length= 0; linear_num= 0.0}
               in
               let stats1 =
                 let f' =
@@ -239,11 +248,12 @@ end = struct
               in
               stats.max_length <- stats1.max_length + stats2.max_length ;
               stats.linear_num <- stats1.linear_num
-        | Pcall (path, _, ExecSkipped _, stats)
+        | Pcall (path, _, ExecSkipped _, stats) ->
-         -> if stats_is_dummy stats then
+            if stats_is_dummy stats then
               let stats1 = compute_stats do_calls f path ; get_stats path in
               stats.max_length <- stats1.max_length ;
               stats.linear_num <- stats1.linear_num
+
   end
 
   (* End of module Invariant *)
@@ -252,18 +262,23 @@ end = struct
     Invariant.compute_stats false (fun node -> f node ; true) path ;
     Invariant.reset_stats path
 
+
   let get_path_pos node =
     let pn = Procdesc.Node.get_proc_name node in
     let n_id = Procdesc.Node.get_id node in
     (pn, (n_id :> int))
 
+
   let contains_position path pos =
     let found = ref false in
     let f node =
       if PredSymb.equal_path_pos (get_path_pos node) pos then found := true ;
       true
     in
-    Invariant.compute_stats true f path ; Invariant.reset_stats path ; !found
+    Invariant.compute_stats true f path ;
+    Invariant.reset_stats path ;
+    !found
+
 
   (** iterate over the longest sequence belonging to the path,
       restricting to those where [filter] holds of some element.
@@ -273,27 +288,30 @@ end = struct
       (filter: Procdesc.Node.t -> bool) (path: t) : unit =
     let rec doit level session path prev_exn_opt =
       match path with
-      | Pstart _
+      | Pstart _ ->
-       -> f level path session prev_exn_opt
+          f level path session prev_exn_opt
-      | Pnode (_, exn_opt, session', p, _, _)
+      | Pnode (_, exn_opt, session', p, _, _) ->
-       -> (* no two consecutive exceptions *)
+          (* no two consecutive exceptions *)
           let next_exn_opt = if prev_exn_opt <> None then None else exn_opt in
           doit level (session' :> int) p next_exn_opt ;
           f level path session prev_exn_opt
-      | Pjoin (p1, p2, _)
+      | Pjoin (p1, p2, _) ->
-       -> if (Invariant.get_stats p1).max_length <= (Invariant.get_stats p2).max_length then
+          if (Invariant.get_stats p1).max_length <= (Invariant.get_stats p2).max_length then
             doit level session p1 prev_exn_opt
           else doit level session p2 prev_exn_opt
-      | Pcall (p1, _, ExecCompleted p2, _)
+      | Pcall (p1, _, ExecCompleted p2, _) ->
-       -> let next_exn_opt = None in
+          let next_exn_opt = None in
           (* exn must already be inside the call *)
           doit level session p1 next_exn_opt ;
           doit (level + 1) session p2 next_exn_opt
-      | Pcall (p, _, ExecSkipped _, _)
+      | Pcall (p, _, ExecSkipped _, _) ->
-       -> let next_exn_opt = None in
+          let next_exn_opt = None in
           doit level session p next_exn_opt ; f level path session prev_exn_opt
     in
-    Invariant.compute_stats true filter path ; doit 0 0 path None ; Invariant.reset_stats path
+    Invariant.compute_stats true filter path ;
+    doit 0 0 path None ;
+    Invariant.reset_stats path
+
 
   (** iterate over the shortest sequence belonging to the path,
       restricting to those containing the given position if given.
@@ -304,10 +322,10 @@ end = struct
       (pos_opt: PredSymb.path_pos option) (path: t) : unit =
     let filter node =
       match pos_opt with
-      | None
+      | None ->
-       -> true
+          true
-      | Some pos
+      | Some pos ->
-       -> PredSymb.equal_path_pos (get_path_pos node) pos
+          PredSymb.equal_path_pos (get_path_pos node) pos
     in
     let path_pos_at_path p =
       try match curr_node p with Some node -> pos_opt <> None && filter node | None -> false
@@ -320,15 +338,16 @@ end = struct
         if path_pos_at_path p then position_seen := true ;
         log := (level, p, session, exn_opt) :: !log
       in
-      iter_shortest_sequence_filter g filter path ; !log
+      iter_shortest_sequence_filter g filter path ;
+      !log
     in
     let sequence_up_to_last_seen =
       if !position_seen then
         let rec remove_until_seen = function
-          | (_, p, _, _ as x) :: l
+          | ((_, p, _, _) as x) :: l ->
-           -> if path_pos_at_path p then List.rev (x :: l) else remove_until_seen l
+              if path_pos_at_path p then List.rev (x :: l) else remove_until_seen l
-          | []
+          | [] ->
-           -> []
+              []
         in
         remove_until_seen inverse_sequence
       else List.rev inverse_sequence
@@ -337,6 +356,7 @@ end = struct
       ~f:(fun (level, p, session, exn_opt) -> f level p session exn_opt)
       sequence_up_to_last_seen
 
+
   (** return the node visited most, and number of visits, in the shortest linear sequence *)
   let repetitions path =
     let map = ref Procdesc.NodeMap.empty in
@@ -346,8 +366,8 @@ end = struct
           let n = Procdesc.NodeMap.find node !map in
           map := Procdesc.NodeMap.add node (n + 1) !map
         with Not_found -> map := Procdesc.NodeMap.add node 1 !map )
-      | None
+      | None ->
-       -> ()
+          ()
     in
     iter_shortest_sequence (fun _ p _ _ -> add_node (curr_node p)) None path ;
     let max_rep_node = ref (Procdesc.Node.dummy None) in
@@ -360,6 +380,7 @@ end = struct
       !map ;
     (!max_rep_node, !max_rep_num)
 
+
   let stats_string path =
     Invariant.compute_stats true (fun _ -> true) path ;
     let node, repetitions = repetitions path in
@@ -370,6 +391,7 @@ end = struct
     in
     Invariant.reset_stats path ; str
 
+
   let pp_stats fmt path = F.fprintf fmt "%s" (stats_string path)
 
   let d_stats path = L.d_str (stats_string path)
@@ -397,12 +419,12 @@ end = struct
       if not (path_seen path) (* avoid exponential blowup *) then
         match path with
         (* build a map from delayed paths to a unique number *)
-        | Pstart _
+        | Pstart _ ->
-         -> ()
+            ()
-        | Pnode (_, _, _, p, _, _) | Pcall (p, _, ExecSkipped _, _)
+        | Pnode (_, _, _, p, _, _) | Pcall (p, _, ExecSkipped _, _) ->
-         -> add_delayed p
+            add_delayed p
-        | Pjoin (p1, p2, _) | Pcall (p1, _, ExecCompleted p2, _)
+        | Pjoin (p1, p2, _) | Pcall (p1, _, ExecCompleted p2, _) ->
-         -> (* delay paths occurring in a join *)
+            (* delay paths occurring in a join *)
             add_delayed p1 ; add_delayed p2 ; add_path p1 ; add_path p2
     in
     let rec doit n fmt path =
@@ -412,16 +434,16 @@ end = struct
         F.fprintf fmt "P%d" num
       with Not_found ->
         match path with
-        | Pstart (node, _)
+        | Pstart (node, _) ->
-         -> F.fprintf fmt "n%a" Procdesc.Node.pp node
+            F.fprintf fmt "n%a" Procdesc.Node.pp node
-        | Pnode (node, _, session, path, _, _)
+        | Pnode (node, _, session, path, _, _) ->
-         -> F.fprintf fmt "%a(s%d).n%a" (doit (n - 1)) path (session :> int) Procdesc.Node.pp node
+            F.fprintf fmt "%a(s%d).n%a" (doit (n - 1)) path (session :> int) Procdesc.Node.pp node
-        | Pjoin (path1, path2, _)
+        | Pjoin (path1, path2, _) ->
-         -> F.fprintf fmt "(%a + %a)" (doit (n - 1)) path1 (doit (n - 1)) path2
+            F.fprintf fmt "(%a + %a)" (doit (n - 1)) path1 (doit (n - 1)) path2
-        | Pcall (path1, _, ExecCompleted path2, _)
+        | Pcall (path1, _, ExecCompleted path2, _) ->
-         -> F.fprintf fmt "(%a{%a})" (doit (n - 1)) path1 (doit (n - 1)) path2
+            F.fprintf fmt "(%a{%a})" (doit (n - 1)) path1 (doit (n - 1)) path2
-        | Pcall (path, _, ExecSkipped (reason, _), _)
+        | Pcall (path, _, ExecSkipped (reason, _), _) ->
-         -> F.fprintf fmt "(%a: %s)" (doit (n - 1)) path reason
+            F.fprintf fmt "(%a: %s)" (doit (n - 1)) path reason
     in
     let print_delayed () =
       if not (PathMap.is_empty !delayed) then
@@ -431,21 +453,23 @@ end = struct
     in
     add_delayed path ; doit 0 fmt path ; print_delayed ()
 
+
   let d p = L.add_print_action (L.PTpath, Obj.repr p)
 
   let rec contains p1 p2 =
     match p2 with
-    | Pjoin (p2', p2'', _)
+    | Pjoin (p2', p2'', _) ->
-     -> contains p1 p2' || contains p1 p2''
+        contains p1 p2' || contains p1 p2''
-    | _
+    | _ ->
-     -> phys_equal p1 p2
+        phys_equal p1 p2
+
 
   let create_loc_trace path pos_opt : Errlog.loc_trace =
     let trace = ref [] in
     let g level path _ exn_opt =
       match (path, curr_node path) with
-      | Pcall (_, pname, ExecSkipped (reason, loc_opt), _), Some curr_node
+      | Pcall (_, pname, ExecSkipped (reason, loc_opt), _), Some curr_node ->
-       -> let curr_loc = Procdesc.Node.get_loc curr_node in
+          let curr_loc = Procdesc.Node.get_loc curr_node in
           let descr =
             Format.sprintf "Skipping %s: %s" (Typ.Procname.to_simplified_string pname) reason
           in
@@ -460,48 +484,48 @@ end = struct
                 trace := Errlog.make_trace_element (level + 1) loc definition_descr [] :: !trace)
             loc_opt
       | _, Some curr_node
-       -> (
+        -> (
           let curr_loc = Procdesc.Node.get_loc curr_node in
           match Procdesc.Node.get_kind curr_node with
-          | Procdesc.Node.Join_node
+          | Procdesc.Node.Join_node ->
-           -> () (* omit join nodes from error traces *)
+              () (* omit join nodes from error traces *)
-          | Procdesc.Node.Start_node pname
+          | Procdesc.Node.Start_node pname ->
-           -> let descr = "start of procedure " ^ Typ.Procname.to_simplified_string pname in
+              let descr = "start of procedure " ^ Typ.Procname.to_simplified_string pname in
               let node_tags = [Errlog.Procedure_start pname] in
               trace := Errlog.make_trace_element level curr_loc descr node_tags :: !trace
-          | Procdesc.Node.Prune_node (is_true_branch, if_kind, _)
+          | Procdesc.Node.Prune_node (is_true_branch, if_kind, _) ->
-           -> let descr =
+              let descr =
                 match (is_true_branch, if_kind) with
-                | true, Sil.Ik_if
+                | true, Sil.Ik_if ->
-                 -> "Taking true branch"
+                    "Taking true branch"
-                | false, Sil.Ik_if
+                | false, Sil.Ik_if ->
-                 -> "Taking false branch"
+                    "Taking false branch"
-                | true, (Sil.Ik_for | Sil.Ik_while | Sil.Ik_dowhile)
+                | true, (Sil.Ik_for | Sil.Ik_while | Sil.Ik_dowhile) ->
-                 -> "Loop condition is true. Entering loop body"
+                    "Loop condition is true. Entering loop body"
-                | false, (Sil.Ik_for | Sil.Ik_while | Sil.Ik_dowhile)
+                | false, (Sil.Ik_for | Sil.Ik_while | Sil.Ik_dowhile) ->
-                 -> "Loop condition is false. Leaving loop"
+                    "Loop condition is false. Leaving loop"
-                | true, Sil.Ik_switch
+                | true, Sil.Ik_switch ->
-                 -> "Switch condition is true. Entering switch case"
+                    "Switch condition is true. Entering switch case"
-                | false, Sil.Ik_switch
+                | false, Sil.Ik_switch ->
-                 -> "Switch condition is false. Skipping switch case"
+                    "Switch condition is false. Skipping switch case"
-                | true, (Sil.Ik_bexp | Sil.Ik_land_lor)
+                | true, (Sil.Ik_bexp | Sil.Ik_land_lor) ->
-                 -> "Condition is true"
+                    "Condition is true"
-                | false, (Sil.Ik_bexp | Sil.Ik_land_lor)
+                | false, (Sil.Ik_bexp | Sil.Ik_land_lor) ->
-                 -> "Condition is false"
+                    "Condition is false"
               in
               let node_tags = [Errlog.Condition is_true_branch] in
               trace := Errlog.make_trace_element level curr_loc descr node_tags :: !trace
-          | Procdesc.Node.Exit_node pname
+          | Procdesc.Node.Exit_node pname ->
-           -> let descr = "return from a call to " ^ Typ.Procname.to_string pname in
+              let descr = "return from a call to " ^ Typ.Procname.to_string pname in
               let node_tags = [Errlog.Procedure_end pname] in
               trace := Errlog.make_trace_element level curr_loc descr node_tags :: !trace
-          | _
+          | _ ->
-           -> let descr, node_tags =
+              let descr, node_tags =
                 match exn_opt with
-                | None
+                | None ->
-                 -> ("", [])
+                    ("", [])
-                | Some exn_name
+                | Some exn_name ->
-                 -> let exn_str = Typ.Name.name exn_name in
+                    let exn_str = Typ.Name.name exn_name in
                     let desc =
                       if String.is_empty exn_str then "exception" else "exception " ^ exn_str
                     in
@@ -509,14 +533,14 @@ end = struct
               in
               let descr =
                 match get_description path with
-                | Some path_descr
+                | Some path_descr ->
-                 -> if String.length descr > 0 then descr ^ " " ^ path_descr else path_descr
+                    if String.length descr > 0 then descr ^ " " ^ path_descr else path_descr
-                | None
+                | None ->
-                 -> descr
+                    descr
               in
               trace := Errlog.make_trace_element level curr_loc descr node_tags :: !trace )
-      | _, None
+      | _, None ->
-       -> ()
+          ()
     in
     iter_shortest_sequence g pos_opt path ;
     let compare lt1 lt2 =
@@ -525,6 +549,7 @@ end = struct
     in
     let relevant lt = lt.Errlog.lt_node_tags <> [] in
     IList.remove_irrelevant_duplicates compare relevant (List.rev !trace)
+
 end
 
 (* =============== END of the Path module ===============*)
@@ -612,6 +637,7 @@ end = struct
     let f prop path = plist := (prop, path) :: !plist in
     PropMap.iter f ps ; !plist
 
+
   let to_proplist ps = List.map ~f:fst (elements ps)
 
   let to_propset tenv ps = Propset.from_proplist tenv (to_proplist ps)
@@ -624,6 +650,7 @@ end = struct
     List.iter ~f:(fun p -> filtered_map := PropMap.remove p !filtered_map) !elements ;
     !filtered_map
 
+
   let partition f ps =
     let elements = ref [] in
     PropMap.iter (fun p _ -> elements := p :: !elements) ps ;
@@ -633,6 +660,7 @@ end = struct
       !elements ;
     (!el1, !el2)
 
+
   (** It's the caller's resposibility to ensure that Prop.prop_rename_primed_footprint_vars was called on the prop *)
   let add_renamed_prop (p: Prop.normal Prop.t) (path: Path.t) (ps: t) : t =
     let path_new =
@@ -643,6 +671,7 @@ end = struct
     in
     PropMap.add p path_new ps
 
+
   let union (ps1: t) (ps2: t) : t = PropMap.fold add_renamed_prop ps1 ps2
 
   (** check if the nodes in path p1 are a subset of those in p2 (not trace subset) *)
@@ -654,6 +683,7 @@ end = struct
     in
     Procdesc.NodeSet.subset (get_nodes p1) (get_nodes p2)
 
+
   (** difference between pathsets for the differential fixpoint *)
   let diff (ps1: t) (ps2: t) : t =
     let res = ref ps1 in
@@ -666,6 +696,7 @@ end = struct
     in
     PropMap.iter rem ps2 ; !res
 
+
   let is_empty = PropMap.is_empty
 
   let iter = PropMap.iter
@@ -679,6 +710,7 @@ end = struct
     in
     iter do_elem ps ; !res
 
+
   let map f ps = map_option (fun p -> Some (f p)) ps
 
   let size ps =
@@ -687,6 +719,7 @@ end = struct
     let () = PropMap.iter add ps in
     !res
 
+
   let pp pe fmt ps =
     let count = ref 0 in
     let pp_path fmt path = F.fprintf fmt "[path: %a@\n%a]" Path.pp_stats path Path.pp path in
@@ -696,6 +729,7 @@ end = struct
     in
     iter f ps
 
+
   let d (ps: t) = L.add_print_action (L.PTpathset, Obj.repr ps)
 
   let filter_path path ps =
@@ -703,9 +737,11 @@ end = struct
     let f prop path' = if Path.contains path path' then plist := prop :: !plist in
     iter f ps ; !plist
 
+
   (** It's the caller's resposibility to ensure that Prop.prop_rename_primed_footprint_vars was called on the list *)
   let from_renamed_list (pl: ('a Prop.t * Path.t) list) : t =
     List.fold ~f:(fun ps (p, pa) -> add_renamed_prop p pa ps) ~init:empty pl
+
 end
 
 (* =============== END of the PathSet module ===============*)

infer/src/backend/preanal.ml

@@ -22,10 +22,10 @@ let add_dispatch_calls pdesc cg tenv =
       || call_flags.CallFlags.cf_interface
     in
     let instr_is_dispatch_call = function
-      | Sil.Call (_, _, _, _, call_flags)
+      | Sil.Call (_, _, _, _, call_flags) ->
-       -> call_flags_is_dispatch call_flags
+          call_flags_is_dispatch call_flags
-      | _
+      | _ ->
-       -> false
+          false
     in
     let has_dispatch_call instrs = List.exists ~f:instr_is_dispatch_call instrs in
     let replace_dispatch_calls = function
@@ -36,7 +36,7 @@ let add_dispatch_calls pdesc cg tenv =
           , loc
           , call_flags ) as instr
         when call_flags_is_dispatch call_flags
-       -> (
+        -> (
           (* the frontend should not populate the list of targets *)
           assert (List.is_empty call_flags.CallFlags.cf_targets) ;
           let receiver_typ_no_ptr =
@@ -47,8 +47,8 @@ let add_dispatch_calls pdesc cg tenv =
             List.sort ~cmp:(fun (_, p1) (_, p2) -> Typ.Procname.compare p1 p2) overrides
           in
           match sorted_overrides with
-          | (_, target_pname) :: _ as all_targets
+          | (_, target_pname) :: _ as all_targets ->
-           -> let targets_to_add =
+              let targets_to_add =
                 if sound_dynamic_dispatch then List.map ~f:snd all_targets
                 else
                   (* if sound dispatch is turned off, consider only the first target. we do this
@@ -60,10 +60,10 @@ let add_dispatch_calls pdesc cg tenv =
                 targets_to_add ;
               let call_flags' = {call_flags with CallFlags.cf_targets= targets_to_add} in
               Sil.Call (ret_id, call_exp, args, loc, call_flags')
-          | []
+          | [] ->
-           -> instr )
+              instr )
-      | instr
+      | instr ->
-       -> instr
+          instr
     in
     let instrs = Procdesc.Node.get_instrs node in
     if has_dispatch_call instrs then List.map ~f:replace_dispatch_calls instrs
@@ -72,6 +72,7 @@ let add_dispatch_calls pdesc cg tenv =
   let pname = Procdesc.get_proc_name pdesc in
   Procdesc.iter_nodes (node_add_dispatch_calls pname) pdesc
 
+
 (** add instructions to perform abstraction *)
 let add_abstraction_instructions pdesc =
   let open Procdesc in
@@ -85,10 +86,10 @@ let add_abstraction_instructions pdesc =
   in
   let node_requires_abstraction node =
     match Node.get_kind node with
-    | Node.Start_node _ | Node.Join_node
+    | Node.Start_node _ | Node.Join_node ->
-     -> false
+        false
-    | Node.Exit_node _ | Node.Stmt_node _ | Node.Prune_node _ | Node.Skip_node _
+    | Node.Exit_node _ | Node.Stmt_node _ | Node.Prune_node _ | Node.Skip_node _ ->
-     -> converging_node node
+        converging_node node
   in
   let do_node node =
     let loc = Node.get_last_loc node in
@@ -96,6 +97,7 @@ let add_abstraction_instructions pdesc =
   in
   Procdesc.iter_nodes do_node pdesc
 
+
 module BackwardCfg = ProcCfg.Backward (ProcCfg.Exceptional)
 module LivenessAnalysis = AbstractInterpreter.Make (BackwardCfg) (Liveness.TransferFunctions)
 module VarDomain = Liveness.Domain
@@ -115,16 +117,17 @@ module NullifyTransferFunctions = struct
 
   type extras = LivenessAnalysis.invariant_map
 
-  let postprocess (reaching_defs, _ as astate) node {ProcData.extras} =
+  let postprocess ((reaching_defs, _) as astate) node {ProcData.extras} =
     let node_id = Procdesc.Node.get_id (CFG.underlying_node node) in
     match LivenessAnalysis.extract_state node_id extras with
     (* note: because the analysis is backward, post and pre are reversed *)
-    | Some {AbstractInterpreter.post= live_before; pre= live_after}
+    | Some {AbstractInterpreter.post= live_before; pre= live_after} ->
-     -> let to_nullify = VarDomain.diff (VarDomain.union live_before reaching_defs) live_after in
+        let to_nullify = VarDomain.diff (VarDomain.union live_before reaching_defs) live_after in
         let reaching_defs' = VarDomain.diff reaching_defs to_nullify in
         (reaching_defs', to_nullify)
-    | None
+    | None ->
-     -> astate
+        astate
+
 
   let cache_node = ref (Procdesc.Node.dummy None)
 
@@ -142,34 +145,36 @@ module NullifyTransferFunctions = struct
       cache_instr := last_instr ;
       last_instr
 
+
   let is_last_instr_in_node instr node = phys_equal (last_instr_in_node node) instr
 
-  let exec_instr (active_defs, to_nullify as astate) extras node instr =
+  let exec_instr ((active_defs, to_nullify) as astate) extras node instr =
     let astate' =
       match instr with
-      | Sil.Load (lhs_id, _, _, _)
+      | Sil.Load (lhs_id, _, _, _) ->
-       -> (VarDomain.add (Var.of_id lhs_id) active_defs, to_nullify)
+          (VarDomain.add (Var.of_id lhs_id) active_defs, to_nullify)
-      | Sil.Call (lhs_id, _, _, _, _)
+      | Sil.Call (lhs_id, _, _, _, _) ->
-       -> let active_defs' =
+          let active_defs' =
             Option.value_map
               ~f:(fun (id, _) -> VarDomain.add (Var.of_id id) active_defs)
               ~default:active_defs lhs_id
           in
           (active_defs', to_nullify)
-      | Sil.Store (Exp.Lvar lhs_pvar, _, _, _)
+      | Sil.Store (Exp.Lvar lhs_pvar, _, _, _) ->
-       -> (VarDomain.add (Var.of_pvar lhs_pvar) active_defs, to_nullify)
+          (VarDomain.add (Var.of_pvar lhs_pvar) active_defs, to_nullify)
-      | Sil.Store _ | Prune _ | Declare_locals _ | Remove_temps _ | Abstract _
+      | Sil.Store _ | Prune _ | Declare_locals _ | Remove_temps _ | Abstract _ ->
-       -> astate
+          astate
-      | Sil.Nullify _
+      | Sil.Nullify _ ->
-       -> L.(die InternalError)
+          L.(die InternalError)
             "Should not add nullify instructions before running nullify analysis!"
     in
     if is_last_instr_in_node instr node then postprocess astate' node extras else astate'
+
 end
 
 module NullifyAnalysis =
-  AbstractInterpreter.MakeNoCFG (Scheduler.ReversePostorder (ProcCfg.Exceptional))
+  AbstractInterpreter.MakeNoCFG
-    (NullifyTransferFunctions)
+    (Scheduler.ReversePostorder (ProcCfg.Exceptional)) (NullifyTransferFunctions)
 
 let add_nullify_instrs pdesc tenv liveness_inv_map =
   let address_taken_vars =
@@ -178,10 +183,10 @@ let add_nullify_instrs pdesc tenv liveness_inv_map =
     else
       let initial = AddressTaken.Domain.empty in
       match AddressTaken.Analyzer.compute_post (ProcData.make_default pdesc tenv) ~initial with
-      | Some post
+      | Some post ->
-       -> post
+          post
-      | None
+      | None ->
-       -> AddressTaken.Domain.empty
+          AddressTaken.Domain.empty
   in
   let nullify_proc_cfg = ProcCfg.Exceptional.from_pdesc pdesc in
   let nullify_proc_data = ProcData.make pdesc tenv liveness_inv_map in
@@ -206,48 +211,55 @@ let add_nullify_instrs pdesc tenv liveness_inv_map =
   List.iter
     ~f:(fun node ->
       match NullifyAnalysis.extract_post (ProcCfg.Exceptional.id node) nullify_inv_map with
-      | Some (_, to_nullify)
+      | Some (_, to_nullify) ->
-       -> let pvars_to_nullify, ids_to_remove =
+          let pvars_to_nullify, ids_to_remove =
             VarDomain.fold
               (fun var (pvars_acc, ids_acc) ->
                 match Var.to_exp var with
                 (* we nullify all address taken variables at the end of the procedure *)
                 | Exp.Lvar pvar
-                  when not (AddressTaken.Domain.mem pvar address_taken_vars)
+                  when not (AddressTaken.Domain.mem pvar address_taken_vars) ->
-                 -> (pvar :: pvars_acc, ids_acc)
+                    (pvar :: pvars_acc, ids_acc)
-                | Exp.Var id
+                | Exp.Var id ->
-                 -> (pvars_acc, id :: ids_acc)
+                    (pvars_acc, id :: ids_acc)
-                | _
+                | _ ->
-                 -> (pvars_acc, ids_acc))
+                    (pvars_acc, ids_acc))
               to_nullify ([], [])
           in
           node_add_removetmps_instructions node ids_to_remove ;
           node_add_nullify_instructions node pvars_to_nullify
-      | None
+      | None ->
-       -> ())
+          ())
     (ProcCfg.Exceptional.nodes nullify_proc_cfg) ;
   (* nullify all address taken variables *)
   if not (AddressTaken.Domain.is_empty address_taken_vars) then
     let exit_node = ProcCfg.Exceptional.exit_node nullify_proc_cfg in
     node_add_nullify_instructions exit_node (AddressTaken.Domain.elements address_taken_vars)
 
+
 let do_liveness pdesc tenv =
   let liveness_proc_cfg = BackwardCfg.from_pdesc pdesc in
   let initial = Liveness.Domain.empty in
   let liveness_inv_map =
-    LivenessAnalysis.exec_cfg liveness_proc_cfg (ProcData.make_default pdesc tenv) ~initial
+    LivenessAnalysis.exec_cfg liveness_proc_cfg
-      ~debug:false
+      (ProcData.make_default pdesc tenv)
+      ~initial ~debug:false
   in
-  add_nullify_instrs pdesc tenv liveness_inv_map ; Procdesc.signal_did_preanalysis pdesc
+  add_nullify_instrs pdesc tenv liveness_inv_map ;
+  Procdesc.signal_did_preanalysis pdesc
+
 
 let do_abstraction pdesc =
-  add_abstraction_instructions pdesc ; Procdesc.signal_did_preanalysis pdesc
+  add_abstraction_instructions pdesc ;
+  Procdesc.signal_did_preanalysis pdesc
+
 
 let do_dynamic_dispatch pdesc cg tenv =
   ( match Config.dynamic_dispatch with
-  | Interface | Sound
+  | Interface | Sound ->
-   -> let pname = Procdesc.get_proc_name pdesc in
+      let pname = Procdesc.get_proc_name pdesc in
       if Typ.Procname.is_java pname then add_dispatch_calls pdesc cg tenv
-  | NoDynamicDispatch | Lazy
+  | NoDynamicDispatch | Lazy ->
-   -> () ) ;
+      () ) ;
   Procdesc.signal_did_preanalysis pdesc
+

infer/src/backend/printer.ml

@@ -44,6 +44,7 @@ module LineReader = struct
       In_channel.close cin ;
       Array.of_list (List.rev !lines)
 
+
   let file_data (hash: t) fname =
     try Some (Hashtbl.find hash fname)
     with Not_found ->
@@ -52,14 +53,16 @@ module LineReader = struct
         Hashtbl.add hash fname lines_arr ; Some lines_arr
       with exn when SymOp.exn_not_failure exn -> None
 
+
   let from_file_linenum_original hash fname linenum =
     match file_data hash fname with
-    | None
+    | None ->
-     -> None
+        None
-    | Some lines_arr
+    | Some lines_arr ->
-     -> if linenum > 0 && linenum <= Array.length lines_arr then Some lines_arr.(linenum - 1)
+        if linenum > 0 && linenum <= Array.length lines_arr then Some lines_arr.(linenum - 1)
         else None
 
+
   let from_file_linenum hash fname linenum = from_file_linenum_original hash fname linenum
 
   let from_loc hash loc = from_file_linenum hash loc.Location.file loc.Location.line
@@ -71,10 +74,10 @@ let curr_html_formatter = ref F.std_formatter
 (** Return true if the node was visited during footprint and during re-execution*)
 let node_is_visited node =
   match Specs.get_summary (Procdesc.Node.get_proc_name node) with
-  | None
+  | None ->
-   -> (false, false)
+      (false, false)
-  | Some summary
+  | Some summary ->
-   -> let stats = summary.Specs.stats in
+      let stats = summary.Specs.stats in
       let is_visited_fp =
         IntSet.mem (Procdesc.Node.get_id node :> int) stats.Specs.nodes_visited_fp
       in
@@ -83,11 +86,13 @@ let node_is_visited node =
       in
       (is_visited_fp, is_visited_re)
 
+
 (** Return true if the node was visited during analysis *)
 let is_visited node =
   let visited_fp, visited_re = node_is_visited node in
   visited_fp || visited_re
 
+
 (* =============== START of module NodesHtml =============== *)
 
 (** Print information into html files for nodes
@@ -102,13 +107,16 @@ end = struct
   let log_files = Hashtbl.create 11
 
   let pp_node_link fmt node =
-    Io_infer.Html.pp_node_link [".."] (Procdesc.Node.get_proc_name node) ~description:""
+    Io_infer.Html.pp_node_link [".."]
+      (Procdesc.Node.get_proc_name node)
+      ~description:""
       ~preds:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_preds node) :> int list)
       ~succs:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_succs node) :> int list)
       ~exn:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_exn node) :> int list)
       ~isvisited:(is_visited node) ~isproof:false fmt
       (Procdesc.Node.get_id node :> int)
 
+
   let start_node nodeid loc proc_name preds succs exns source =
     let node_fname = Io_infer.Html.node_filename proc_name nodeid in
     let modified = Io_infer.Html.modified_during_analysis source ["nodes"; node_fname] in
@@ -138,11 +146,13 @@ end = struct
       true )
     else false
 
+
   let finish_node proc_name nodeid source =
     let node_fname = Io_infer.Html.node_filename proc_name nodeid in
     let fd = Hashtbl.find log_files (node_fname, source) in
     Unix.close fd ;
     curr_html_formatter := F.std_formatter
+
 end
 
 (* =============== END of module NodesHtml =============== *)
@@ -152,148 +162,149 @@ end
 let force_delayed_print fmt =
   let pe_default = if Config.write_html then Pp.html Black else Pp.text in
   function
-    | L.PTatom, a
+    | L.PTatom, a ->
-     -> let a : Sil.atom = Obj.obj a in
+        let a : Sil.atom = Obj.obj a in
         Sil.pp_atom pe_default fmt a
-    | L.PTattribute, a
+    | L.PTattribute, a ->
-     -> let a : PredSymb.t = Obj.obj a in
+        let a : PredSymb.t = Obj.obj a in
         F.pp_print_string fmt (PredSymb.to_string pe_default a)
-    | L.PTdecrease_indent, n
+    | L.PTdecrease_indent, n ->
-     -> let n : int = Obj.obj n in
+        let n : int = Obj.obj n in
         for _ = 1 to n do F.fprintf fmt "@]" done
-    | L.PTexp, e
+    | L.PTexp, e ->
-     -> let e : Exp.t = Obj.obj e in
+        let e : Exp.t = Obj.obj e in
         Sil.pp_exp_printenv pe_default fmt e
-    | L.PTexp_list, el
+    | L.PTexp_list, el ->
-     -> let el : Exp.t list = Obj.obj el in
+        let el : Exp.t list = Obj.obj el in
         Sil.pp_exp_list pe_default fmt el
-    | L.PThpred, hpred
+    | L.PThpred, hpred ->
-     -> let hpred : Sil.hpred = Obj.obj hpred in
+        let hpred : Sil.hpred = Obj.obj hpred in
         Sil.pp_hpred pe_default fmt hpred
-    | L.PTincrease_indent, n
+    | L.PTincrease_indent, n ->
-     -> let n : int = Obj.obj n in
+        let n : int = Obj.obj n in
         let s = ref "" in
         for _ = 1 to n do s := "  " ^ !s done ;
         F.fprintf fmt "%s@[" !s
-    | L.PTinstr, i
+    | L.PTinstr, i ->
-     -> let i : Sil.instr = Obj.obj i in
+        let i : Sil.instr = Obj.obj i in
         if Config.write_html then
           F.fprintf fmt "%a%a%a" Io_infer.Html.pp_start_color Pp.Green
             (Sil.pp_instr (Pp.html Green))
             i Io_infer.Html.pp_end_color ()
         else Sil.pp_instr Pp.text fmt i
-    | L.PTinstr_list, il
+    | L.PTinstr_list, il ->
-     -> let il : Sil.instr list = Obj.obj il in
+        let il : Sil.instr list = Obj.obj il in
         if Config.write_html then
           F.fprintf fmt "%a%a%a" Io_infer.Html.pp_start_color Pp.Green
             (Sil.pp_instr_list (Pp.html Green))
             il Io_infer.Html.pp_end_color ()
         else Sil.pp_instr_list Pp.text fmt il
-    | L.PTjprop_list, shallow_jpl
+    | L.PTjprop_list, shallow_jpl ->
-     -> let (shallow: bool), (jpl: Prop.normal Specs.Jprop.t list) = Obj.obj shallow_jpl in
+        let (shallow: bool), (jpl: Prop.normal Specs.Jprop.t list) = Obj.obj shallow_jpl in
         Specs.Jprop.pp_list pe_default shallow fmt jpl
-    | L.PTjprop_short, jp
+    | L.PTjprop_short, jp ->
-     -> let jp : Prop.normal Specs.Jprop.t = Obj.obj jp in
+        let jp : Prop.normal Specs.Jprop.t = Obj.obj jp in
         Specs.Jprop.pp_short pe_default fmt jp
-    | L.PTloc, loc
+    | L.PTloc, loc ->
-     -> let loc : Location.t = Obj.obj loc in
+        let loc : Location.t = Obj.obj loc in
         Location.pp fmt loc
-    | L.PTnode_instrs, b_n
+    | L.PTnode_instrs, b_n ->
-     -> let (b: bool), (io: Sil.instr option), (n: Procdesc.Node.t) = Obj.obj b_n in
+        let (b: bool), (io: Sil.instr option), (n: Procdesc.Node.t) = Obj.obj b_n in
         if Config.write_html then
           F.fprintf fmt "%a%a%a" Io_infer.Html.pp_start_color Pp.Green
             (Procdesc.Node.pp_instrs (Pp.html Green) io ~sub_instrs:b)
             n Io_infer.Html.pp_end_color ()
         else F.fprintf fmt "%a" (Procdesc.Node.pp_instrs Pp.text io ~sub_instrs:b) n
-    | L.PToff, off
+    | L.PToff, off ->
-     -> let off : Sil.offset = Obj.obj off in
+        let off : Sil.offset = Obj.obj off in
         Sil.pp_offset pe_default fmt off
-    | L.PToff_list, offl
+    | L.PToff_list, offl ->
-     -> let offl : Sil.offset list = Obj.obj offl in
+        let offl : Sil.offset list = Obj.obj offl in
         Sil.pp_offset_list pe_default fmt offl
-    | L.PTpathset, ps
+    | L.PTpathset, ps ->
-     -> let ps : Paths.PathSet.t = Obj.obj ps in
+        let ps : Paths.PathSet.t = Obj.obj ps in
         F.fprintf fmt "%a@\n" (Paths.PathSet.pp pe_default) ps
-    | L.PTpi, pi
+    | L.PTpi, pi ->
-     -> let pi : Sil.atom list = Obj.obj pi in
+        let pi : Sil.atom list = Obj.obj pi in
         Prop.pp_pi pe_default fmt pi
-    | L.PTpath, path
+    | L.PTpath, path ->
-     -> let path : Paths.Path.t = Obj.obj path in
+        let path : Paths.Path.t = Obj.obj path in
         Paths.Path.pp fmt path
-    | L.PTprop, p
+    | L.PTprop, p ->
-     -> let p : Prop.normal Prop.t = Obj.obj p in
+        let p : Prop.normal Prop.t = Obj.obj p in
         Prop.pp_prop pe_default fmt p
-    | L.PTproplist, x
+    | L.PTproplist, x ->
-     -> let (p: Prop.normal Prop.t), (pl: Prop.normal Prop.t list) = Obj.obj x in
+        let (p: Prop.normal Prop.t), (pl: Prop.normal Prop.t list) = Obj.obj x in
         Propgraph.pp_proplist pe_default "PROP" (p, false) fmt pl
-    | L.PTprop_list_with_typ, plist
+    | L.PTprop_list_with_typ, plist ->
-     -> let pl : Prop.normal Prop.t list = Obj.obj plist in
+        let pl : Prop.normal Prop.t list = Obj.obj plist in
         F.fprintf fmt "%a" (Prop.pp_proplist_with_typ pe_default) pl
-    | L.PTprop_with_typ, p
+    | L.PTprop_with_typ, p ->
-     -> let p : Prop.normal Prop.t = Obj.obj p in
+        let p : Prop.normal Prop.t = Obj.obj p in
         Prop.pp_prop_with_typ pe_default fmt p
-    | L.PTpvar, pvar
+    | L.PTpvar, pvar ->
-     -> let pvar : Pvar.t = Obj.obj pvar in
+        let pvar : Pvar.t = Obj.obj pvar in
         Pvar.pp pe_default fmt pvar
-    | L.PTsexp, se
+    | L.PTsexp, se ->
-     -> let se : Sil.strexp = Obj.obj se in
+        let se : Sil.strexp = Obj.obj se in
         Sil.pp_sexp pe_default fmt se
-    | L.PTsexp_list, sel
+    | L.PTsexp_list, sel ->
-     -> let sel : Sil.strexp list = Obj.obj sel in
+        let sel : Sil.strexp list = Obj.obj sel in
         Sil.pp_sexp_list pe_default fmt sel
-    | L.PTsigma, sigma
+    | L.PTsigma, sigma ->
-     -> let sigma : Sil.hpred list = Obj.obj sigma in
+        let sigma : Sil.hpred list = Obj.obj sigma in
         Prop.pp_sigma pe_default fmt sigma
-    | L.PTspec, spec
+    | L.PTspec, spec ->
-     -> let spec : Prop.normal Specs.spec = Obj.obj spec in
+        let spec : Prop.normal Specs.spec = Obj.obj spec in
         Specs.pp_spec (if Config.write_html then Pp.html Blue else Pp.text) None fmt spec
-    | L.PTstr, s
+    | L.PTstr, s ->
-     -> let s : string = Obj.obj s in
+        let s : string = Obj.obj s in
         F.fprintf fmt "%s" s
-    | L.PTstr_color, s
+    | L.PTstr_color, s ->
-     -> let (s: string), (c: Pp.color) = Obj.obj s in
+        let (s: string), (c: Pp.color) = Obj.obj s in
         if Config.write_html then
           F.fprintf fmt "%a%s%a" Io_infer.Html.pp_start_color c s Io_infer.Html.pp_end_color ()
         else F.fprintf fmt "%s" s
-    | L.PTstrln, s
+    | L.PTstrln, s ->
-     -> let s : string = Obj.obj s in
+        let s : string = Obj.obj s in
         F.fprintf fmt "%s@\n" s
-    | L.PTstrln_color, s
+    | L.PTstrln_color, s ->
-     -> let (s: string), (c: Pp.color) = Obj.obj s in
+        let (s: string), (c: Pp.color) = Obj.obj s in
         if Config.write_html then
           F.fprintf fmt "%a%s%a@\n" Io_infer.Html.pp_start_color c s Io_infer.Html.pp_end_color ()
         else F.fprintf fmt "%s@\n" s
-    | L.PTsub, sub
+    | L.PTsub, sub ->
-     -> let sub : Sil.subst = Obj.obj sub in
+        let sub : Sil.subst = Obj.obj sub in
         Prop.pp_sub pe_default fmt sub
-    | L.PTtexp_full, te
+    | L.PTtexp_full, te ->
-     -> let te : Exp.t = Obj.obj te in
+        let te : Exp.t = Obj.obj te in
         Sil.pp_texp_full pe_default fmt te
-    | L.PTtyp_full, t
+    | L.PTtyp_full, t ->
-     -> let t : Typ.t = Obj.obj t in
+        let t : Typ.t = Obj.obj t in
         Typ.pp_full pe_default fmt t
-    | L.PTtyp_list, tl
+    | L.PTtyp_list, tl ->
-     -> let tl : Typ.t list = Obj.obj tl in
+        let tl : Typ.t list = Obj.obj tl in
         Pp.seq (Typ.pp pe_default) fmt tl
-    | L.PTerror, s
+    | L.PTerror, s ->
-     -> let s : string = Obj.obj s in
+        let s : string = Obj.obj s in
         if Config.write_html then
           F.fprintf fmt "%aERROR: %s%a" Io_infer.Html.pp_start_color Pp.Red s
             Io_infer.Html.pp_end_color ()
         else F.fprintf fmt "ERROR: %s" s
-    | L.PTwarning, s
+    | L.PTwarning, s ->
-     -> let s : string = Obj.obj s in
+        let s : string = Obj.obj s in
         if Config.write_html then
           F.fprintf fmt "%aWARNING: %s%a" Io_infer.Html.pp_start_color Pp.Orange s
             Io_infer.Html.pp_end_color ()
         else F.fprintf fmt "WARNING: %s" s
-    | L.PTinfo, s
+    | L.PTinfo, s ->
-     -> let s : string = Obj.obj s in
+        let s : string = Obj.obj s in
         if Config.write_html then
           F.fprintf fmt "%aINFO: %s%a" Io_infer.Html.pp_start_color Pp.Blue s
             Io_infer.Html.pp_end_color ()
         else F.fprintf fmt "INFO: %s" s
 
+
 (** Set printer hook as soon as this module is loaded *)
 let () = L.printer_hook := force_delayed_print
 
@@ -307,6 +318,7 @@ let force_delayed_prints () =
   L.reset_delayed_prints () ;
   Config.forcing_delayed_prints := false
 
+
 (** Start a session, and create a new html fine for the node if it does not exist yet *)
 let start_session node (loc: Location.t) proc_name session source =
   let node_id = Procdesc.Node.get_id node in
@@ -324,6 +336,7 @@ let start_session node (loc: Location.t) proc_name session source =
     ((node_id :> int), session, loc.Location.line) ;
   F.fprintf !curr_html_formatter "<LISTING>%a" Io_infer.Html.pp_start_color Pp.Black
 
+
 let node_start_session node session =
   if Config.write_html then
     let loc = Procdesc.Node.get_loc node in
@@ -331,16 +344,19 @@ let node_start_session node session =
     let pname = Procdesc.Node.get_proc_name node in
     start_session node loc pname session source
 
+
 (** Finish a session, and perform delayed print actions if required *)
 let node_finish_session node =
   if not Config.only_cheap_debug then force_delayed_prints () else L.reset_delayed_prints () ;
   if Config.write_html then (
     F.fprintf !curr_html_formatter "</LISTING>%a" Io_infer.Html.pp_end_color () ;
     let source = (Procdesc.Node.get_loc node).file in
-    NodesHtml.finish_node (Procdesc.Node.get_proc_name node)
+    NodesHtml.finish_node
+      (Procdesc.Node.get_proc_name node)
       (Procdesc.Node.get_id node :> int)
       source )
 
+
 (** Write html file for the procedure.
     The boolean indicates whether to print whole seconds only *)
 let write_proc_html pdesc =
@@ -368,12 +384,13 @@ let write_proc_html pdesc =
           (Procdesc.Node.get_id n :> int))
       nodes ;
     match Specs.get_summary pname with
-    | None
+    | None ->
-     -> ()
+        ()
-    | Some summary
+    | Some summary ->
-     -> Specs.pp_summary_html source Black fmt summary ;
+        Specs.pp_summary_html source Black fmt summary ;
         Io_infer.Html.close (fd, fmt)
 
+
 (** Creare a hash table mapping line numbers to the set of errors occurring on that line *)
 let create_table_err_per_line err_log =
   let err_per_line = Hashtbl.create 17 in
@@ -389,10 +406,12 @@ let create_table_err_per_line err_log =
   in
   Errlog.iter add_err err_log ; err_per_line
 
+
 (** Create error message for html file *)
 let create_err_message err_string =
   "\n<div class=\"msg\" style=\"margin-left:9ex\">" ^ err_string ^ "</div>"
 
+
 let write_html_proc source proof_cover table_nodes_at_linenum global_err_log proc_desc =
   let proc_name = Procdesc.get_proc_name proc_desc in
   let process_node n =
@@ -408,22 +427,23 @@ let write_html_proc source proof_cover table_nodes_at_linenum global_err_log pro
     Procdesc.is_defined proc_desc && SourceFile.equal proc_loc.Location.file source
     &&
     match Attributes.find_file_capturing_procedure proc_name with
-    | None
+    | None ->
-     -> true
+        true
-    | Some (source_captured, _)
+    | Some (source_captured, _) ->
-     -> SourceFile.equal source_captured (Procdesc.get_loc proc_desc).file
+        SourceFile.equal source_captured (Procdesc.get_loc proc_desc).file
   in
   if process_proc then (
     List.iter ~f:process_node (Procdesc.get_nodes proc_desc) ;
     match Specs.get_summary proc_name with
-    | None
+    | None ->
-     -> ()
+        ()
-    | Some summary
+    | Some summary ->
-     -> List.iter
+        List.iter
           ~f:(fun sp -> proof_cover := Specs.Visitedset.union sp.Specs.visited !proof_cover)
           (Specs.get_specs_from_payload summary) ;
         Errlog.update global_err_log summary.Specs.attributes.ProcAttributes.err_log )
 
+
 (** Create filename.ext.html. *)
 let write_html_file linereader filename procs =
   let fname_encoding = DB.source_file_encoding filename in
@@ -437,10 +457,10 @@ let write_html_file linereader filename procs =
   let print_one_line proof_cover table_nodes_at_linenum table_err_per_line line_number =
     let line_html =
       match LineReader.from_file_linenum linereader filename line_number with
-      | Some line_raw
+      | Some line_raw ->
-       -> Escape.escape_xml line_raw
+          Escape.escape_xml line_raw
-      | None
+      | None ->
-       -> raise End_of_file
+          raise End_of_file
     in
     let nodes_at_linenum =
       try Hashtbl.find table_nodes_at_linenum line_number
@@ -473,21 +493,21 @@ let write_html_file linereader filename procs =
     List.iter
       ~f:(fun n ->
         match Procdesc.Node.get_kind n with
-        | Procdesc.Node.Start_node proc_name
+        | Procdesc.Node.Start_node proc_name ->
-         -> let num_specs =
+            let num_specs =
               match Specs.get_summary proc_name with
-              | None
+              | None ->
-               -> 0
+                  0
-              | Some summary
+              | Some summary ->
-               -> List.length (Specs.get_specs_from_payload summary)
+                  List.length (Specs.get_specs_from_payload summary)
             in
             let label =
               Escape.escape_xml (Typ.Procname.to_string proc_name) ^ ": " ^ string_of_int num_specs
               ^ " specs"
             in
             Io_infer.Html.pp_proc_link [fname_encoding] proc_name fmt label
-        | _
+        | _ ->
-         -> ())
+            ())
       nodes_at_linenum ;
     List.iter
       ~f:(fun err_string -> F.fprintf fmt "%s" (create_err_message err_string))
@@ -511,6 +531,7 @@ let write_html_file linereader filename procs =
     Errlog.pp_html filename [fname_encoding] fmt global_err_log ;
     Io_infer.Html.close (fd, fmt)
 
+
 (** Create filename.ext.html for each file in the cluster. *)
 let write_all_html_files cluster =
   let exe_env = Exe_env.from_cluster cluster in
@@ -518,10 +539,10 @@ let write_all_html_files cluster =
   let () = List.iter ~f:load_proc_desc (Cg.get_defined_nodes (Exe_env.get_cg exe_env)) in
   let opt_whitelist_regex =
     match Config.write_html_whitelist_regex with
-    | []
+    | [] ->
-     -> None
+        None
-    | _ as reg_list
+    | _ as reg_list ->
-     -> Some (Str.regexp (String.concat ~sep:"\\|" reg_list))
+        Some (Str.regexp (String.concat ~sep:"\\|" reg_list))
   in
   let is_whitelisted file =
     Option.value_map opt_whitelist_regex ~default:true ~f:(fun regex ->
@@ -543,3 +564,4 @@ let write_all_html_files cluster =
         (fun file -> write_html_file linereader file (Cfg.get_all_procs cfg))
         source_files_in_cfg)
     exe_env
+

infer/src/backend/propgraph.ml

@@ -27,14 +27,15 @@ let from_prop p = p
 
 (** Return [true] if root node *)
 let rec is_root = function
-  | Exp.Var id
+  | Exp.Var id ->
-   -> Ident.is_normal id
+      Ident.is_normal id
-  | Exp.Exn _ | Exp.Closure _ | Exp.Const _ | Exp.Lvar _
+  | Exp.Exn _ | Exp.Closure _ | Exp.Const _ | Exp.Lvar _ ->
-   -> true
+      true
-  | Exp.Cast (_, e)
+  | Exp.Cast (_, e) ->
-   -> is_root e
+      is_root e
-  | Exp.UnOp _ | Exp.BinOp _ | Exp.Lfield _ | Exp.Lindex _ | Exp.Sizeof _
+  | Exp.UnOp _ | Exp.BinOp _ | Exp.Lfield _ | Exp.Lindex _ | Exp.Sizeof _ ->
-   -> false
+      false
+
 
 (** Return [true] if the nodes are connected. Used to compute reachability. *)
 let nodes_connected n1 n2 = Exp.equal n1 n2
@@ -46,35 +47,37 @@ let edge_is_hpred = function Ehpred _ -> true | Eatom _ -> false | Esub_entry _
 
 (** Return the source of the edge *)
 let edge_get_source = function
-  | Ehpred Sil.Hpointsto (e, _, _)
+  | Ehpred Sil.Hpointsto (e, _, _) ->
-   -> Some e
+      Some e
-  | Ehpred Sil.Hlseg (_, _, e, _, _)
+  | Ehpred Sil.Hlseg (_, _, e, _, _) ->
-   -> Some e
+      Some e
-  | Ehpred Sil.Hdllseg (_, _, e1, _, _, _, _)
+  | Ehpred Sil.Hdllseg (_, _, e1, _, _, _, _) ->
-   -> Some e1 (* only one direction supported for now *)
+      Some e1 (* only one direction supported for now *)
-  | Eatom Sil.Aeq (e1, _)
+  | Eatom Sil.Aeq (e1, _) ->
-   -> Some e1
+      Some e1
-  | Eatom Sil.Aneq (e1, _)
+  | Eatom Sil.Aneq (e1, _) ->
-   -> Some e1
+      Some e1
-  | Eatom (Sil.Apred (_, e :: _) | Anpred (_, e :: _))
+  | Eatom (Sil.Apred (_, e :: _) | Anpred (_, e :: _)) ->
-   -> Some e
+      Some e
-  | Eatom (Sil.Apred (_, []) | Anpred (_, []))
+  | Eatom (Sil.Apred (_, []) | Anpred (_, [])) ->
-   -> None
+      None
-  | Esub_entry (x, _)
+  | Esub_entry (x, _) ->
-   -> Some (Exp.Var x)
+      Some (Exp.Var x)
+
 
 (** Return the successor nodes of the edge *)
 let edge_get_succs = function
-  | Ehpred hpred
+  | Ehpred hpred ->
-   -> Exp.Set.elements (Prop.hpred_get_targets hpred)
+      Exp.Set.elements (Prop.hpred_get_targets hpred)
-  | Eatom Sil.Aeq (_, e2)
+  | Eatom Sil.Aeq (_, e2) ->
-   -> [e2]
+      [e2]
-  | Eatom Sil.Aneq (_, e2)
+  | Eatom Sil.Aneq (_, e2) ->
-   -> [e2]
+      [e2]
-  | Eatom (Sil.Apred _ | Anpred _)
+  | Eatom (Sil.Apred _ | Anpred _) ->
-   -> []
+      []
-  | Esub_entry (_, e)
+  | Esub_entry (_, e) ->
-   -> [e]
+      [e]
+
 
 let get_sigma footprint_part g = if footprint_part then g.Prop.sigma_fp else g.Prop.sigma
 
@@ -95,11 +98,13 @@ let edge_from_source g n footprint_part is_hpred =
   in
   match List.filter ~f:starts_from edges with [] -> None | edge :: _ -> Some edge
 
+
 (** [get_succs g n footprint_part is_hpred] returns the successor nodes of [n] in [g].
     [footprint_part] indicates whether to search the successors in the footprint part, and [is_pred] whether to follow hpred edges. *)
 let get_succs g n footprint_part is_hpred =
   match edge_from_source g n footprint_part is_hpred with None -> [] | Some e -> edge_get_succs e
 
+
 (** [get_edges footprint_part g] returns the list of edges in [g], in the footprint part if [fotprint_part] is true *)
 let get_edges footprint_part g =
   let hpreds = get_sigma footprint_part g in
@@ -108,22 +113,25 @@ let get_edges footprint_part g =
   List.map ~f:(fun hpred -> Ehpred hpred) hpreds @ List.map ~f:(fun a -> Eatom a) atoms
   @ List.map ~f:(fun entry -> Esub_entry entry) subst_entries
 
+
 let edge_equal e1 e2 =
   match (e1, e2) with
-  | Ehpred hp1, Ehpred hp2
+  | Ehpred hp1, Ehpred hp2 ->
-   -> Sil.equal_hpred hp1 hp2
+      Sil.equal_hpred hp1 hp2
-  | Eatom a1, Eatom a2
+  | Eatom a1, Eatom a2 ->
-   -> Sil.equal_atom a1 a2
+      Sil.equal_atom a1 a2
-  | Esub_entry (x1, e1), Esub_entry (x2, e2)
+  | Esub_entry (x1, e1), Esub_entry (x2, e2) ->
-   -> Ident.equal x1 x2 && Exp.equal e1 e2
+      Ident.equal x1 x2 && Exp.equal e1 e2
-  | _
+  | _ ->
-   -> false
+      false
+
 
 (** [contains_edge footprint_part g e] returns true if the graph [g] contains edge [e],
     searching the footprint part if [footprint_part] is true. *)
 let contains_edge (footprint_part: bool) (g: t) (e: edge) =
   List.exists ~f:(fun e' -> edge_equal e e') (get_edges footprint_part g)
 
+
 (** [iter_edges footprint_part f g] iterates function [f] on the edges in [g] in the same order as returned by [get_edges];
     if [footprint_part] is true the edges are taken from the footprint part. *)
 let iter_edges footprint_part f g = List.iter ~f (get_edges footprint_part g)
@@ -140,66 +148,71 @@ type diff =
 let compute_exp_diff (e1: Exp.t) (e2: Exp.t) : Obj.t list =
   if Exp.equal e1 e2 then [] else [Obj.repr e2]
 
+
 (** Compute the subobjects in [se2] which are different from those in [se1] *)
 let rec compute_sexp_diff (se1: Sil.strexp) (se2: Sil.strexp) : Obj.t list =
   match (se1, se2) with
-  | Sil.Eexp (e1, _), Sil.Eexp (e2, _)
+  | Sil.Eexp (e1, _), Sil.Eexp (e2, _) ->
-   -> if Exp.equal e1 e2 then [] else [Obj.repr se2]
+      if Exp.equal e1 e2 then [] else [Obj.repr se2]
-  | Sil.Estruct (fsel1, _), Sil.Estruct (fsel2, _)
+  | Sil.Estruct (fsel1, _), Sil.Estruct (fsel2, _) ->
-   -> compute_fsel_diff fsel1 fsel2
+      compute_fsel_diff fsel1 fsel2
-  | Sil.Earray (e1, esel1, _), Sil.Earray (e2, esel2, _)
+  | Sil.Earray (e1, esel1, _), Sil.Earray (e2, esel2, _) ->
-   -> compute_exp_diff e1 e2 @ compute_esel_diff esel1 esel2
+      compute_exp_diff e1 e2 @ compute_esel_diff esel1 esel2
-  | _
+  | _ ->
-   -> [Obj.repr se2]
+      [Obj.repr se2]
+
 
 and compute_fsel_diff fsel1 fsel2 : Obj.t list =
   match (fsel1, fsel2) with
-  | (f1, se1) :: fsel1', (f2, se2 as x) :: fsel2' -> (
+  | (f1, se1) :: fsel1', ((f2, se2) as x) :: fsel2' -> (
     match Typ.Fieldname.compare f1 f2 with
-    | n when n < 0
+    | n when n < 0 ->
-     -> compute_fsel_diff fsel1' fsel2
+        compute_fsel_diff fsel1' fsel2
-    | 0
+    | 0 ->
-     -> compute_sexp_diff se1 se2 @ compute_fsel_diff fsel1' fsel2'
+        compute_sexp_diff se1 se2 @ compute_fsel_diff fsel1' fsel2'
-    | _
+    | _ ->
-     -> Obj.repr x :: compute_fsel_diff fsel1 fsel2' )
+        Obj.repr x :: compute_fsel_diff fsel1 fsel2' )
-  | _, []
+  | _, [] ->
-   -> []
+      []
-  | [], x :: fsel2'
+  | [], x :: fsel2' ->
-   -> Obj.repr x :: compute_fsel_diff [] fsel2'
+      Obj.repr x :: compute_fsel_diff [] fsel2'
+
 
 and compute_esel_diff esel1 esel2 : Obj.t list =
   match (esel1, esel2) with
-  | (e1, se1) :: esel1', (e2, se2 as x) :: esel2' -> (
+  | (e1, se1) :: esel1', ((e2, se2) as x) :: esel2' -> (
     match Exp.compare e1 e2 with
-    | n when n < 0
+    | n when n < 0 ->
-     -> compute_esel_diff esel1' esel2
+        compute_esel_diff esel1' esel2
-    | 0
+    | 0 ->
-     -> compute_sexp_diff se1 se2 @ compute_esel_diff esel1' esel2'
+        compute_sexp_diff se1 se2 @ compute_esel_diff esel1' esel2'
-    | _
+    | _ ->
-     -> Obj.repr x :: compute_esel_diff esel1 esel2' )
+        Obj.repr x :: compute_esel_diff esel1 esel2' )
-  | _, []
+  | _, [] ->
-   -> []
+      []
-  | [], x :: esel2'
+  | [], x :: esel2' ->
-   -> Obj.repr x :: compute_esel_diff [] esel2'
+      Obj.repr x :: compute_esel_diff [] esel2'
+
 
 (** Compute the subobjects in [newedge] which are different from those in [oldedge] *)
 let compute_edge_diff (oldedge: edge) (newedge: edge) : Obj.t list =
   match (oldedge, newedge) with
-  | Ehpred Sil.Hpointsto (_, se1, e1), Ehpred Sil.Hpointsto (_, se2, e2)
+  | Ehpred Sil.Hpointsto (_, se1, e1), Ehpred Sil.Hpointsto (_, se2, e2) ->
-   -> compute_sexp_diff se1 se2 @ compute_exp_diff e1 e2
+      compute_sexp_diff se1 se2 @ compute_exp_diff e1 e2
-  | Eatom Sil.Aeq (_, e1), Eatom Sil.Aeq (_, e2)
+  | Eatom Sil.Aeq (_, e1), Eatom Sil.Aeq (_, e2) ->
-   -> compute_exp_diff e1 e2
+      compute_exp_diff e1 e2
-  | Eatom Sil.Aneq (_, e1), Eatom Sil.Aneq (_, e2)
+  | Eatom Sil.Aneq (_, e1), Eatom Sil.Aneq (_, e2) ->
-   -> compute_exp_diff e1 e2
+      compute_exp_diff e1 e2
   | Eatom Sil.Apred (_, es1), Eatom Sil.Apred (_, es2)
-  | Eatom Sil.Anpred (_, es1), Eatom Sil.Anpred (_, es2)
+  | Eatom Sil.Anpred (_, es1), Eatom Sil.Anpred (_, es2) ->
-   -> List.concat
+      List.concat
         ( try List.map2_exn ~f:compute_exp_diff es1 es2
           with Invalid_argument _ -> [] )
-  | Esub_entry (_, e1), Esub_entry (_, e2)
+  | Esub_entry (_, e1), Esub_entry (_, e2) ->
-   -> compute_exp_diff e1 e2
+      compute_exp_diff e1 e2
-  | _
+  | _ ->
-   -> [Obj.repr newedge]
+      [Obj.repr newedge]
+
 
 (** [compute_diff oldgraph newgraph] returns the list of edges which are only in [newgraph] *)
 let compute_diff default_color oldgraph newgraph : diff =
@@ -211,21 +224,21 @@ let compute_diff default_color oldgraph newgraph : diff =
         match edge_get_source edge with
         | Some source -> (
           match edge_from_source oldgraph source footprint_part (edge_is_hpred edge) with
-          | None
+          | None ->
-           -> let changed_obj =
+              let changed_obj =
                 match edge with
-                | Ehpred hpred
+                | Ehpred hpred ->
-                 -> Obj.repr hpred
+                    Obj.repr hpred
-                | Eatom a
+                | Eatom a ->
-                 -> Obj.repr a
+                    Obj.repr a
-                | Esub_entry entry
+                | Esub_entry entry ->
-                 -> Obj.repr entry
+                    Obj.repr entry
               in
               changed := changed_obj :: !changed
-          | Some oldedge
+          | Some oldedge ->
-           -> changed := compute_edge_diff oldedge edge @ !changed )
+              changed := compute_edge_diff oldedge edge @ !changed )
-        | None
+        | None ->
-         -> ()
+            ()
     in
     List.iter ~f:build_changed newedges ;
     let colormap (o: Obj.t) =
@@ -241,11 +254,13 @@ let compute_diff default_color oldgraph newgraph : diff =
   ; diff_changed_foot= changed_foot
   ; diff_cmap_foot= colormap_foot }
 
+
 (** [diff_get_colormap footprint_part diff] returns the colormap of a computed diff,
     selecting the footprint colormap if [footprint_part] is true. *)
 let diff_get_colormap footprint_part diff =
   if footprint_part then diff.diff_cmap_foot else diff.diff_cmap_norm
 
+
 (** Print a list of propositions, prepending each one with the given string.
     If !Config.pring_using_diff is true, print the diff w.r.t. the given prop,
     extracting its local stack vars if the boolean is true. *)
@@ -264,38 +279,40 @@ let pp_proplist pe0 s (base_prop, extract_stack) f plist =
     else pe0
   in
   let rec pp_seq_newline n f = function
-    | []
+    | [] ->
-     -> ()
+        ()
     | [_x]
-     -> (
+      -> (
         let pe = update_pe_diff _x in
         let x = add_base_stack _x in
         match pe.kind with
-        | TEXT
+        | TEXT ->
-         -> F.fprintf f "%s %d of %d:@\n%a" s n num (Prop.pp_prop pe) x
+            F.fprintf f "%s %d of %d:@\n%a" s n num (Prop.pp_prop pe) x
-        | HTML
+        | HTML ->
-         -> F.fprintf f "%s %d of %d:@\n%a@\n" s n num (Prop.pp_prop pe) x
+            F.fprintf f "%s %d of %d:@\n%a@\n" s n num (Prop.pp_prop pe) x
-        | LATEX
+        | LATEX ->
-         -> F.fprintf f "@[%a@]@\n" (Prop.pp_prop pe) x )
+            F.fprintf f "@[%a@]@\n" (Prop.pp_prop pe) x )
-    | _x :: l
+    | _x :: l ->
-     -> let pe = update_pe_diff _x in
+        let pe = update_pe_diff _x in
         let x = add_base_stack _x in
         match pe.kind with
-        | TEXT
+        | TEXT ->
-         -> F.fprintf f "%s %d of %d:@\n%a@\n%a" s n num (Prop.pp_prop pe) x
+            F.fprintf f "%s %d of %d:@\n%a@\n%a" s n num (Prop.pp_prop pe) x
               (pp_seq_newline (n + 1))
               l
-        | HTML
+        | HTML ->
-         -> F.fprintf f "%s %d of %d:@\n%a@\n%a" s n num (Prop.pp_prop pe) x
+            F.fprintf f "%s %d of %d:@\n%a@\n%a" s n num (Prop.pp_prop pe) x
               (pp_seq_newline (n + 1))
               l
-        | LATEX
+        | LATEX ->
-         -> F.fprintf f "@[%a@]\\\\@\n\\bigvee\\\\@\n%a" (Prop.pp_prop pe) x
+            F.fprintf f "@[%a@]\\\\@\n\\bigvee\\\\@\n%a" (Prop.pp_prop pe) x
               (pp_seq_newline (n + 1))
               l
   in
   pp_seq_newline 1 f plist
 
+
 (** dump a propset *)
 let d_proplist (p: 'a Prop.t) (pl: 'b Prop.t list) =
   L.add_print_action (L.PTproplist, Obj.repr (p, pl))
+

infer/src/backend/propset.ml

@@ -35,6 +35,7 @@ let add tenv p pset =
     ~f:(fun pset' p' -> PropSet.add (Prop.prop_rename_primed_footprint_vars tenv p') pset')
     ~init:pset ps
 
+
 (** Singleton set. *)
 let singleton tenv p = add tenv p PropSet.empty
 
@@ -71,6 +72,7 @@ let map_option tenv f pset =
   let plist = List.map ~f:(function Some p -> p | None -> assert false) plisto in
   from_proplist tenv plist
 
+
 (** Apply function to all the elements of [propset]. *)
 let map tenv f pset = from_proplist tenv (List.map ~f (to_proplist pset))
 
@@ -80,6 +82,7 @@ let fold f a pset =
   let l = to_proplist pset in
   List.fold ~f ~init:a l
 
+
 (** [iter f pset] computes (f p1;f p2;..;f pN)
     where [p1 ... pN] are the elements of pset, in increasing order. *)
 let iter = PropSet.iter
@@ -95,6 +98,8 @@ let pp pe prop f pset =
   let plist = to_proplist pset in
   Propgraph.pp_proplist pe "PROP" (prop, false) f plist
 
+
 let d p ps =
   let plist = to_proplist ps in
   Propgraph.d_proplist p plist
+

infer/src/backend/reporting.ml

@@ -30,6 +30,7 @@ let log_issue_from_errlog err_kind err_log ?loc ?node_id ?session ?ltr ?linters_
   if not Config.filtering (* no-filtering takes priority *) || issue_type.IssueType.enabled then
     Errlog.log_issue err_kind err_log loc node_id session ltr ?linters_def_file ?doc_url exn
 
+
 let log_issue_from_summary err_kind summary ?loc ?node_id ?session ?ltr ?linters_def_file ?doc_url
     exn =
   let is_generated_method = Typ.Procname.java_is_generated (Specs.get_proc_name summary) in
@@ -44,20 +45,22 @@ let log_issue_from_summary err_kind summary ?loc ?node_id ?session ?ltr ?linters
     log_issue_from_errlog err_kind err_log ?loc ?node_id ?session ?ltr ?linters_def_file ?doc_url
       exn
 
+
 let log_issue_deprecated ?(store_summary= false) err_kind proc_name ?loc ?node_id ?session ?ltr
     ?linters_def_file ?doc_url exn =
   match Specs.get_summary proc_name with
-  | Some summary
+  | Some summary ->
-   -> log_issue_from_summary err_kind summary ?loc ?node_id ?session ?ltr ?linters_def_file
+      log_issue_from_summary err_kind summary ?loc ?node_id ?session ?ltr ?linters_def_file
         ?doc_url exn ;
       if store_summary then
         (* TODO (#16348004): This is currently needed as ThreadSafety works as a cluster checker *)
         Specs.store_summary summary
-  | None
+  | None ->
-   -> L.(die InternalError)
+      L.(die InternalError)
         "Trying to report error on procedure %a, but cannot because no summary exists for this procedure. Did you mean to log the error on the caller of %a instead?"
         Typ.Procname.pp proc_name Typ.Procname.pp proc_name
 
+
 let log_error_from_errlog = log_issue_from_errlog Exceptions.Kerror
 
 let log_warning_from_errlog = log_issue_from_errlog Exceptions.Kwarning
@@ -73,8 +76,11 @@ let log_info = log_issue_from_summary Exceptions.Kwarning
 let log_error_deprecated ?(store_summary= false) =
   log_issue_deprecated ~store_summary Exceptions.Kerror
 
+
 let log_warning_deprecated ?(store_summary= false) =
   log_issue_deprecated ~store_summary Exceptions.Kwarning
 
+
 let log_info_deprecated ?(store_summary= false) =
   log_issue_deprecated ~store_summary Exceptions.Kinfo
+

infer/src/backend/specs.ml

@@ -43,23 +43,26 @@ module Jprop = struct
   let to_number = function Prop (n, _) -> n | Joined (n, _, _, _) -> n
 
   let rec fav_add_dfs tenv fav = function
-    | Prop (_, p)
+    | Prop (_, p) ->
-     -> Prop.prop_fav_add_dfs tenv fav p
+        Prop.prop_fav_add_dfs tenv fav p
-    | Joined (_, p, jp1, jp2)
+    | Joined (_, p, jp1, jp2) ->
-     -> Prop.prop_fav_add_dfs tenv fav p ; fav_add_dfs tenv fav jp1 ; fav_add_dfs tenv fav jp2
+        Prop.prop_fav_add_dfs tenv fav p ; fav_add_dfs tenv fav jp1 ; fav_add_dfs tenv fav jp2
+
 
   let rec normalize tenv = function
-    | Prop (n, p)
+    | Prop (n, p) ->
-     -> Prop (n, Prop.normalize tenv p)
+        Prop (n, Prop.normalize tenv p)
-    | Joined (n, p, jp1, jp2)
+    | Joined (n, p, jp1, jp2) ->
-     -> Joined (n, Prop.normalize tenv p, normalize tenv jp1, normalize tenv jp2)
+        Joined (n, Prop.normalize tenv p, normalize tenv jp1, normalize tenv jp2)
+
 
   (** Return a compact representation of the jprop *)
   let rec compact sh = function
-    | Prop (n, p)
+    | Prop (n, p) ->
-     -> Prop (n, Prop.prop_compact sh p)
+        Prop (n, Prop.prop_compact sh p)
-    | Joined (n, p, jp1, jp2)
+    | Joined (n, p, jp1, jp2) ->
-     -> Joined (n, Prop.prop_compact sh p, compact sh jp1, compact sh jp2)
+        Joined (n, Prop.prop_compact sh p, compact sh jp1, compact sh jp2)
+
 
   (** Print the toplevel prop *)
   let pp_short pe f jp = Prop.pp_prop pe f (to_prop jp)
@@ -73,59 +76,65 @@ module Jprop = struct
   (** Print a list of joined props, the boolean indicates whether to print subcomponents of joined props *)
   let pp_list pe shallow f jplist =
     let rec pp_seq_newline f = function
-      | []
+      | [] ->
-       -> ()
+          ()
-      | [(Prop (n, p))]
+      | [(Prop (n, p))] ->
-       -> F.fprintf f "PROP %d:@\n%a" n (Prop.pp_prop pe) p
+          F.fprintf f "PROP %d:@\n%a" n (Prop.pp_prop pe) p
-      | [(Joined (n, p, p1, p2))]
+      | [(Joined (n, p, p1, p2))] ->
-       -> if not shallow then F.fprintf f "%a@\n" pp_seq_newline [p1] ;
+          if not shallow then F.fprintf f "%a@\n" pp_seq_newline [p1] ;
           if not shallow then F.fprintf f "%a@\n" pp_seq_newline [p2] ;
           F.fprintf f "PROP %d (join of %d,%d):@\n%a" n (get_id p1) (get_id p2) (Prop.pp_prop pe) p
-      | jp :: l
+      | jp :: l ->
-       -> F.fprintf f "%a@\n" pp_seq_newline [jp] ;
+          F.fprintf f "%a@\n" pp_seq_newline [jp] ;
           pp_seq_newline f l
     in
     pp_seq_newline f jplist
 
+
   (** dump a joined prop list, the boolean indicates whether to print toplevel props only *)
   let d_list (shallow: bool) (jplist: Prop.normal t list) =
     L.add_print_action (L.PTjprop_list, Obj.repr (shallow, jplist))
 
+
   let rec fav_add fav = function
-    | Prop (_, p)
+    | Prop (_, p) ->
-     -> Prop.prop_fav_add fav p
+        Prop.prop_fav_add fav p
-    | Joined (_, p, jp1, jp2)
+    | Joined (_, p, jp1, jp2) ->
-     -> Prop.prop_fav_add fav p ; fav_add fav jp1 ; fav_add fav jp2
+        Prop.prop_fav_add fav p ; fav_add fav jp1 ; fav_add fav jp2
+
 
   let rec jprop_sub sub = function
-    | Prop (n, p)
+    | Prop (n, p) ->
-     -> Prop (n, Prop.prop_sub sub p)
+        Prop (n, Prop.prop_sub sub p)
-    | Joined (n, p, jp1, jp2)
+    | Joined (n, p, jp1, jp2) ->
-     -> let p' = Prop.prop_sub sub p in
+        let p' = Prop.prop_sub sub p in
         let jp1' = jprop_sub sub jp1 in
         let jp2' = jprop_sub sub jp2 in
         Joined (n, p', jp1', jp2')
 
+
   let filter (f: 'a t -> 'b option) jpl =
     let rec do_filter acc = function
-      | []
+      | [] ->
-       -> acc
+          acc
       | (Prop _ as jp) :: jpl -> (
         match f jp with Some x -> do_filter (x :: acc) jpl | None -> do_filter acc jpl )
       | (Joined (_, _, jp1, jp2) as jp) :: jpl ->
         match f jp with
-        | Some x
+        | Some x ->
-         -> do_filter (x :: acc) jpl
+            do_filter (x :: acc) jpl
-        | None
+        | None ->
-         -> do_filter acc (jpl @ [jp1; jp2])
+            do_filter acc (jpl @ [jp1; jp2])
     in
     do_filter [] jpl
 
+
   let rec map (f: 'a Prop.t -> 'b Prop.t) = function
-    | Prop (n, p)
+    | Prop (n, p) ->
-     -> Prop (n, f p)
+        Prop (n, f p)
-    | Joined (n, p, jp1, jp2)
+    | Joined (n, p, jp1, jp2) ->
-     -> Joined (n, f p, map f jp1, map f jp2)
+        Joined (n, f p, map f jp1, map f jp2)
+
 
   (*
   let rec jprop_sub sub = function
@@ -159,6 +168,7 @@ let visited_str vis =
   Int.Set.iter ~f:(fun n -> s := !s ^ " " ^ string_of_int n) !lines ;
   !s
 
+
 (** A spec consists of:
     pre: a joined prop
     post: a list of props with path
@@ -189,12 +199,14 @@ end = struct
     List.iter ~f:(fun (p, _) -> Prop.prop_fav_add_dfs tenv fav p) spec.posts ;
     fav
 
+
   let spec_sub tenv sub spec =
     { pre= Jprop.normalize tenv (Jprop.jprop_sub sub spec.pre)
     ; posts=
         List.map ~f:(fun (p, path) -> (Prop.normalize tenv (Prop.prop_sub sub p), path)) spec.posts
     ; visited= spec.visited }
 
+
   (** Convert spec into normal form w.r.t. variable renaming *)
   let normalize tenv (spec: Prop.normal spec) : Prop.normal spec =
     let fav = spec_fav tenv spec in
@@ -208,16 +220,19 @@ end = struct
     in
     spec_sub tenv sub spec
 
+
   (** Return a compact representation of the spec *)
   let compact sh spec =
     let pre = Jprop.compact sh spec.pre in
     let posts = List.map ~f:(fun (p, path) -> (Prop.prop_compact sh p, path)) spec.posts in
     {pre; posts; visited= spec.visited}
 
+
   (** Erase join info from pre of spec *)
   let erase_join_info_pre tenv spec =
     let spec' = {spec with pre= Jprop.Prop (1, Jprop.to_prop spec.pre)} in
     normalize tenv spec'
+
 end
 
 (** Convert spec into normal form w.r.t. variable renaming *)
@@ -256,6 +271,7 @@ module CallStats = struct
     let do_call pn_loc = PnameLocHash.add hash pn_loc empty_trace in
     List.iter ~f:do_call calls ; hash
 
+
   let trace t proc_name loc res in_footprint =
     let tr_old =
       try PnameLocHash.find t (proc_name, loc)
@@ -266,21 +282,23 @@ module CallStats = struct
     let tr_new = trace_add tr_old res in_footprint in
     PnameLocHash.replace t (proc_name, loc) tr_new
 
+
   let tr_elem_str (cr, in_footprint) =
     let s1 =
       match cr with
-      | CR_success
+      | CR_success ->
-       -> "OK"
+          "OK"
-      | CR_not_met
+      | CR_not_met ->
-       -> "NotMet"
+          "NotMet"
-      | CR_not_found
+      | CR_not_found ->
-       -> "NotFound"
+          "NotFound"
-      | CR_skip
+      | CR_skip ->
-       -> "Skip"
+          "Skip"
     in
     let s2 = if in_footprint then "FP" else "RE" in
     s1 ^ ":" ^ s2
 
+
   let pp_trace fmt tr = Pp.seq (fun fmt x -> F.fprintf fmt "%s" (tr_elem_str x)) fmt (List.rev tr)
 
   let iter f t =
@@ -294,6 +312,7 @@ module CallStats = struct
     in
     List.iter ~f:(fun (x, tr) -> f x tr) sorted_elems
 
+
   (*
   let pp fmt t =
     let do_call (pname, loc) tr =
@@ -358,51 +377,55 @@ let clear_spec_tbl () = Typ.Procname.Hash.clear spec_tbl
 
 let pp_failure_kind_opt fmt failure_kind_opt =
   match failure_kind_opt with
-  | Some failure_kind
+  | Some failure_kind ->
-   -> SymOp.pp_failure_kind fmt failure_kind
+      SymOp.pp_failure_kind fmt failure_kind
-  | None
+  | None ->
-   -> F.fprintf fmt "NONE"
+      F.fprintf fmt "NONE"
+
 
 let pp_errlog fmt err_log =
   F.fprintf fmt "ERRORS: @[<h>%a@]@\n%!" Errlog.pp_errors err_log ;
   F.fprintf fmt "WARNINGS: @[<h>%a@]" Errlog.pp_warnings err_log
 
+
 let pp_stats fmt stats =
   F.fprintf fmt "FAILURE:%a SYMOPS:%d@\n" pp_failure_kind_opt stats.stats_failure stats.symops
 
+
 (** Print the spec *)
 let pp_spec pe num_opt fmt spec =
   let num_str =
     match num_opt with
-    | None
+    | None ->
-     -> "----------"
+        "----------"
-    | Some (n, tot)
+    | Some (n, tot) ->
-     -> Format.sprintf "%d of %d [nvisited:%s]" n tot (visited_str spec.visited)
+        Format.sprintf "%d of %d [nvisited:%s]" n tot (visited_str spec.visited)
   in
   let pre = Jprop.to_prop spec.pre in
   let pe_post = Prop.prop_update_obj_sub pe pre in
   let post_list = List.map ~f:fst spec.posts in
   match pe.Pp.kind with
-  | TEXT
+  | TEXT ->
-   -> F.fprintf fmt "--------------------------- %s ---------------------------@\n" num_str ;
+      F.fprintf fmt "--------------------------- %s ---------------------------@\n" num_str ;
       F.fprintf fmt "PRE:@\n%a@\n" (Prop.pp_prop Pp.text) pre ;
       F.fprintf fmt "%a@\n" (Propgraph.pp_proplist pe_post "POST" (pre, true)) post_list ;
       F.fprintf fmt "----------------------------------------------------------------"
-  | HTML
+  | HTML ->
-   -> F.fprintf fmt "--------------------------- %s ---------------------------@\n" num_str ;
+      F.fprintf fmt "--------------------------- %s ---------------------------@\n" num_str ;
       F.fprintf fmt "PRE:@\n%a%a%a@\n" Io_infer.Html.pp_start_color Pp.Blue
         (Prop.pp_prop (Pp.html Blue))
         pre Io_infer.Html.pp_end_color () ;
       F.fprintf fmt "%a" (Propgraph.pp_proplist pe_post "POST" (pre, true)) post_list ;
       F.fprintf fmt "----------------------------------------------------------------"
-  | LATEX
+  | LATEX ->
-   -> F.fprintf fmt "\\textbf{\\large Requires}\\\\@\n@[%a%a%a@]\\\\@\n" Latex.pp_color Pp.Blue
+      F.fprintf fmt "\\textbf{\\large Requires}\\\\@\n@[%a%a%a@]\\\\@\n" Latex.pp_color Pp.Blue
         (Prop.pp_prop (Pp.latex Blue))
         pre Latex.pp_color pe.Pp.color ;
       F.fprintf fmt "\\textbf{\\large Ensures}\\\\@\n@[%a@]"
         (Propgraph.pp_proplist pe_post "POST" (pre, true))
         post_list
 
+
 (** Dump a spec *)
 let d_spec (spec: 'a spec) = L.add_print_action (L.PTspec, Obj.repr spec)
 
@@ -410,29 +433,31 @@ let pp_specs pe fmt specs =
   let total = List.length specs in
   let cnt = ref 0 in
   match pe.Pp.kind with
-  | TEXT
+  | TEXT ->
-   -> List.iter
+      List.iter
         ~f:(fun spec ->
           incr cnt ;
           F.fprintf fmt "%a" (pp_spec pe (Some (!cnt, total))) spec)
         specs
-  | HTML
+  | HTML ->
-   -> List.iter
+      List.iter
         ~f:(fun spec ->
           incr cnt ;
           F.fprintf fmt "%a<br>@\n" (pp_spec pe (Some (!cnt, total))) spec)
         specs
-  | LATEX
+  | LATEX ->
-   -> List.iter
+      List.iter
         ~f:(fun spec ->
           incr cnt ;
           F.fprintf fmt "\\subsection*{Spec %d of %d}@\n\\(%a\\)@\n" !cnt total (pp_spec pe None)
             spec)
         specs
 
+
 let describe_phase summary =
   ("Phase", if equal_phase summary.phase FOOTPRINT then "FOOTPRINT" else "RE_EXECUTION")
 
+
 (** Return the signature of a procedure declaration as a string *)
 let get_signature summary =
   let s = ref "" in
@@ -449,6 +474,7 @@ let get_signature summary =
   let decl = F.asprintf "%t" pp in
   decl ^ "(" ^ !s ^ ")"
 
+
 let get_specs_from_preposts preposts = Option.value_map ~f:NormSpec.tospecs ~default:[] preposts
 
 let get_specs_from_payload summary = get_specs_from_preposts summary.payload.preposts
@@ -459,6 +485,7 @@ let pp_summary_no_stats_specs fmt summary =
   F.fprintf fmt "%a@\n" pp_status summary.status ;
   F.fprintf fmt "%a@\n" pp_pair (describe_phase summary)
 
+
 let pp_payload pe fmt
     { preposts
     ; typestate
@@ -470,21 +497,29 @@ let pp_payload pe fmt
     ; annot_map
     ; uninit } =
   let pp_opt prefix pp fmt = function
-    | Some x
+    | Some x ->
-     -> F.fprintf fmt "%s: %a@\n" prefix pp x
+        F.fprintf fmt "%s: %a@\n" prefix pp x
-    | None
+    | None ->
-     -> ()
+        ()
   in
   F.fprintf fmt "%a%a%a%a%a%a%a%a%a@\n"
     (pp_opt "PrePosts" (pp_specs pe))
     (Option.map ~f:NormSpec.tospecs preposts)
     (pp_opt "TypeState" (TypeState.pp TypeState.unit_ext))
-    typestate (pp_opt "CrashContext" Crashcontext.pp_stacktree) crashcontext_frame
+    typestate
-    (pp_opt "Quandary" QuandarySummary.pp) quandary (pp_opt "Siof" SiofDomain.pp) siof
+    (pp_opt "CrashContext" Crashcontext.pp_stacktree)
-    (pp_opt "RacerD" RacerDDomain.pp_summary) racerd
+    crashcontext_frame
-    (pp_opt "BufferOverrun" BufferOverrunDomain.Summary.pp) buffer_overrun
+    (pp_opt "Quandary" QuandarySummary.pp)
-    (pp_opt "AnnotationReachability" AnnotReachabilityDomain.pp) annot_map
+    quandary (pp_opt "Siof" SiofDomain.pp) siof
-    (pp_opt "Uninitialised" UninitDomain.pp_summary) uninit
+    (pp_opt "RacerD" RacerDDomain.pp_summary)
+    racerd
+    (pp_opt "BufferOverrun" BufferOverrunDomain.Summary.pp)
+    buffer_overrun
+    (pp_opt "AnnotationReachability" AnnotReachabilityDomain.pp)
+    annot_map
+    (pp_opt "Uninitialised" UninitDomain.pp_summary)
+    uninit
+
 
 let pp_summary_text fmt summary =
   let err_log = summary.attributes.ProcAttributes.err_log in
@@ -493,6 +528,7 @@ let pp_summary_text fmt summary =
   F.fprintf fmt "%a@\n%a%a" pp_errlog err_log pp_stats summary.stats (pp_payload pe)
     summary.payload
 
+
 let pp_summary_latex color fmt summary =
   let err_log = summary.attributes.ProcAttributes.err_log in
   let pe = Pp.latex color in
@@ -503,6 +539,7 @@ let pp_summary_latex color fmt summary =
   F.fprintf fmt "\\end{verbatim}@\n" ;
   F.fprintf fmt "%a@\n" (pp_specs pe) (get_specs_from_payload summary)
 
+
 let pp_summary_html source color fmt summary =
   let err_log = summary.attributes.ProcAttributes.err_log in
   let pe = Pp.html color in
@@ -516,6 +553,7 @@ let pp_summary_html source color fmt summary =
   pp_payload pe fmt summary.payload ;
   F.fprintf fmt "</LISTING>@\n"
 
+
 let empty_stats calls =
   { stats_failure= None
   ; symops= 0
@@ -523,12 +561,14 @@ let empty_stats calls =
   ; nodes_visited_re= IntSet.empty
   ; call_stats= CallStats.init calls }
 
+
 let payload_compact sh payload =
   match payload.preposts with
-  | Some specs
+  | Some specs ->
-   -> {payload with preposts= Some (List.map ~f:(NormSpec.compact sh) specs)}
+      {payload with preposts= Some (List.map ~f:(NormSpec.compact sh) specs)}
-  | None
+  | None ->
-   -> payload
+      payload
+
 
 (** Return a compact representation of the summary *)
 let summary_compact sh summary = {summary with payload= payload_compact sh summary.payload}
@@ -539,15 +579,18 @@ let add_summary (proc_name: Typ.Procname.t) (summary: summary) : unit =
     "Adding summary for %a@\n@[<v 2>  %a@]@." Typ.Procname.pp proc_name pp_summary_text summary ;
   Typ.Procname.Hash.replace spec_tbl proc_name summary
 
+
 let specs_filename pname =
   let pname_file = Typ.Procname.to_filename pname in
   pname_file ^ Config.specs_files_suffix
 
+
 (** path to the .specs file for the given procedure in the current results directory *)
 let res_dir_specs_filename pname =
   DB.Results_dir.path_to_filename DB.Results_dir.Abs_root
     [Config.specs_dir_name; specs_filename pname]
 
+
 (** paths to the .specs file for the given procedure in the current spec libraries *)
 let specs_library_filenames pname =
   List.map
@@ -555,16 +598,20 @@ let specs_library_filenames pname =
       DB.filename_from_string (Filename.concat specs_dir (specs_filename pname)))
     Config.specs_library
 
+
 (** paths to the .specs file for the given procedure in the models folder *)
 let specs_models_filename pname =
   DB.filename_from_string (Filename.concat Config.models_dir (specs_filename pname))
 
+
 let summary_exists_in_models pname =
   Sys.file_exists (DB.filename_to_string (specs_models_filename pname)) = `Yes
 
+
 let summary_serializer : summary Serialization.serializer =
   Serialization.create_serializer Serialization.Key.summary
 
+
 (** Load procedure summary from the given file *)
 let load_summary specs_file = Serialization.read_from_file summary_serializer specs_file
 
@@ -575,57 +622,61 @@ let load_summary_to_spec_table proc_name =
     match load_summary models_dir with None -> false | Some summ -> add summ
   in
   let rec load_summary_libs = function
-    | (* try to load the summary from a list of libs *)
+    (* try to load the summary from a list of libs *)
-    []
+    | [] ->
-     -> false
+        false
     | spec_path :: spec_paths ->
       match load_summary spec_path with
-      | None
+      | None ->
-       -> load_summary_libs spec_paths
+          load_summary_libs spec_paths
-      | Some summ
+      | Some summ ->
-       -> add summ
+          add summ
   in
   let load_summary_ziplibs zip_specs_filename =
     let zip_specs_path = Filename.concat Config.specs_dir_name zip_specs_filename in
     match ZipLib.load summary_serializer zip_specs_path with
-    | None
+    | None ->
-     -> false
+        false
-    | Some summary
+    | Some summary ->
-     -> add summary
+        add summary
   in
   let default_spec_dir = res_dir_specs_filename proc_name in
   match load_summary default_spec_dir with
-  | None
+  | None ->
-   -> (* search on models, libzips, and libs *)
+      (* search on models, libzips, and libs *)
       load_summary_models (specs_models_filename proc_name)
       || load_summary_ziplibs (specs_filename proc_name)
       || load_summary_libs (specs_library_filenames proc_name)
-  | Some summ
+  | Some summ ->
-   -> add summ
+      add summ
+
 
 let rec get_summary proc_name =
   try Some (Typ.Procname.Hash.find spec_tbl proc_name)
   with Not_found -> if load_summary_to_spec_table proc_name then get_summary proc_name else None
 
+
 let get_summary_unsafe s proc_name =
   match get_summary proc_name with
-  | None
+  | None ->
-   -> L.(die InternalError)
+      L.(die InternalError)
         "[%s] Specs.get_summary_unsafe: %a Not found" s Typ.Procname.pp proc_name
-  | Some summary
+  | Some summary ->
-   -> summary
+      summary
+
 
 (** Check if the procedure is from a library:
     It's not defined, and there is no spec file for it. *)
 let proc_is_library proc_attributes =
   if not proc_attributes.ProcAttributes.is_defined then
     match get_summary proc_attributes.ProcAttributes.proc_name with
-    | None
+    | None ->
-     -> true
+        true
-    | Some _
+    | Some _ ->
-     -> false
+        false
   else false
 
+
 (** Try to find the attributes for a defined proc.
     First look at specs (to get attributes computed by analysis)
     then look at the attributes table.
@@ -638,27 +689,29 @@ let proc_resolve_attributes proc_name =
   in
   match from_specs () with
   | Some attributes
-   -> (
+    -> (
       if attributes.ProcAttributes.is_defined then Some attributes
       else
         match from_attributes_table () with
-        | Some attributes'
+        | Some attributes' ->
-         -> Some attributes'
+            Some attributes'
-        | None
+        | None ->
-         -> Some attributes )
+            Some attributes )
-  | None
+  | None ->
-   -> from_attributes_table ()
+      from_attributes_table ()
+
 
 (** Like proc_resolve_attributes but start from a proc_desc. *)
 let pdesc_resolve_attributes proc_desc =
   let proc_name = Procdesc.get_proc_name proc_desc in
   match proc_resolve_attributes proc_name with
-  | Some proc_attributes
+  | Some proc_attributes ->
-   -> proc_attributes
+      proc_attributes
-  | None
+  | None ->
-   -> (* this should not happen *)
+      (* this should not happen *)
       assert false
 
+
 let summary_exists proc_name = match get_summary proc_name with Some _ -> true | None -> false
 
 let get_status summary = summary.status
@@ -684,9 +737,11 @@ let store_summary (summ1: summary) =
   let proc_name = get_proc_name final_summary in
   (* Make sure the summary in memory is identical to the saved one *)
   add_summary proc_name final_summary ;
-  Serialization.write_to_file summary_serializer (res_dir_specs_filename proc_name)
+  Serialization.write_to_file summary_serializer
+    (res_dir_specs_filename proc_name)
     ~data:final_summary
 
+
 let empty_payload =
   { preposts= None
   ; typestate= None
@@ -699,6 +754,7 @@ let empty_payload =
   ; buffer_overrun= None
   ; uninit= None }
 
+
 (** [init_summary (depend_list, nodes,
     proc_flags, calls, in_out_calls_opt, proc_attributes)]
     initializes the summary for [proc_name] given dependent procs in list [depend_list]. *)
@@ -710,10 +766,12 @@ let init_summary (nodes, proc_flags, calls, proc_attributes, proc_desc_option) =
     ; payload= empty_payload
     ; stats= empty_stats calls
     ; status= Pending
-    ; attributes= {proc_attributes with ProcAttributes.proc_flags= proc_flags}
+    ; attributes= {proc_attributes with ProcAttributes.proc_flags}
     ; proc_desc_option }
   in
-  Typ.Procname.Hash.replace spec_tbl proc_attributes.ProcAttributes.proc_name summary ; summary
+  Typ.Procname.Hash.replace spec_tbl proc_attributes.ProcAttributes.proc_name summary ;
+  summary
+
 
 let dummy =
   init_summary
@@ -723,6 +781,7 @@ let dummy =
     , ProcAttributes.default Typ.Procname.empty_block Config.Java
     , None )
 
+
 (** Reset a summary rebuilding the dependents and preserving the proc attributes if present. *)
 let reset_summary proc_desc =
   let proc_desc_option =
@@ -732,6 +791,7 @@ let reset_summary proc_desc =
   let proc_flags = attributes.ProcAttributes.proc_flags in
   init_summary ([], proc_flags, [], attributes, proc_desc_option)
 
+
 (* =============== END of support for spec tables =============== *)
 (*
 let rec post_equal pl1 pl2 = match pl1, pl2 with

infer/src/backend/state.ml

@@ -57,6 +57,7 @@ let initial () =
   ; last_session= 0
   ; failure_map= NodeHash.create 1 }
 
+
 (** Global state *)
 let gs = ref (initial ())
 
@@ -66,6 +67,7 @@ let save_state () =
   gs := initial () ;
   old
 
+
 (** Restore the old state. *)
 let restore_state st = gs := st
 
@@ -77,12 +79,15 @@ let get_failure_stats node =
   try NodeHash.find !gs.failure_map node
   with Not_found ->
     let fs = {instr_fail= 0; instr_ok= 0; node_fail= 0; node_ok= 0; first_failure= None} in
-    NodeHash.add !gs.failure_map node fs ; fs
+    NodeHash.add !gs.failure_map node fs ;
+    fs
+
 
 let add_diverging_states pset =
   !gs.diverging_states_proc <- Paths.PathSet.union pset !gs.diverging_states_proc ;
   !gs.diverging_states_node <- Paths.PathSet.union pset !gs.diverging_states_node
 
+
 let get_diverging_states_node () = !gs.diverging_states_node
 
 let get_diverging_states_proc () = !gs.diverging_states_proc
@@ -91,10 +96,11 @@ let get_instr () = !gs.last_instr
 
 let get_loc () =
   match !gs.last_instr with
-  | Some instr
+  | Some instr ->
-   -> Sil.instr_get_loc instr
+      Sil.instr_get_loc instr
-  | None
+  | None ->
-   -> Procdesc.Node.get_loc !gs.last_node
+      Procdesc.Node.get_loc !gs.last_node
+
 
 let get_node () = !gs.last_node
 
@@ -106,26 +112,27 @@ let node_simple_key node =
     if Sil.instr_is_auxiliary instr then ()
     else
       match instr with
-      | Sil.Load _
+      | Sil.Load _ ->
-       -> add_key 1
+          add_key 1
-      | Sil.Store _
+      | Sil.Store _ ->
-       -> add_key 2
+          add_key 2
-      | Sil.Prune _
+      | Sil.Prune _ ->
-       -> add_key 3
+          add_key 3
-      | Sil.Call _
+      | Sil.Call _ ->
-       -> add_key 4
+          add_key 4
-      | Sil.Nullify _
+      | Sil.Nullify _ ->
-       -> add_key 5
+          add_key 5
-      | Sil.Abstract _
+      | Sil.Abstract _ ->
-       -> add_key 6
+          add_key 6
-      | Sil.Remove_temps _
+      | Sil.Remove_temps _ ->
-       -> add_key 7
+          add_key 7
-      | Sil.Declare_locals _
+      | Sil.Declare_locals _ ->
-       -> add_key 8
+          add_key 8
   in
   List.iter ~f:do_instr (Procdesc.Node.get_instrs node) ;
   Hashtbl.hash !key
 
+
 (** key for a node: look at the current node, successors and predecessors *)
 let node_key node =
   let succs = Procdesc.Node.get_succs node in
@@ -135,6 +142,7 @@ let node_key node =
   in
   Hashtbl.hash v
 
+
 (** normalize the list of instructions by renaming let-bound ids *)
 let instrs_normalize instrs =
   let bound_ids =
@@ -151,6 +159,7 @@ let instrs_normalize instrs =
   in
   List.map ~f:(Sil.instr_sub subst) instrs
 
+
 (** Create a function to find duplicate nodes.
     A node is a duplicate of another one if they have the same kind and location
     and normalized (w.r.t. renaming of let - bound ids) list of instructions. *)
@@ -202,10 +211,10 @@ let mk_find_duplicate_nodes proc_desc : Procdesc.Node.t -> Procdesc.NodeSet.t =
       let (_, node_normalized_instrs), _ =
         let filter (node', _) = Procdesc.Node.equal node node' in
         match List.partition_tf ~f:filter elements with
-        | [this], others
+        | [this], others ->
-         -> (this, others)
+            (this, others)
-        | _
+        | _ ->
-         -> raise Not_found
+            raise Not_found
       in
       let duplicates =
         let equal_normalized_instrs (_, normalized_instrs') =
@@ -220,6 +229,7 @@ let mk_find_duplicate_nodes proc_desc : Procdesc.Node.t -> Procdesc.NodeSet.t =
   in
   find_duplicate_nodes
 
+
 let get_node_id () = Procdesc.Node.get_id !gs.last_node
 
 let get_node_id_key () = (Procdesc.Node.get_id !gs.last_node, node_key !gs.last_node)
@@ -228,17 +238,20 @@ let get_inst_update pos =
   let loc = get_loc () in
   Sil.inst_update loc pos
 
+
 let get_path () =
   match !gs.last_path with
-  | None
+  | None ->
-   -> (Paths.Path.start !gs.last_node, None)
+      (Paths.Path.start !gs.last_node, None)
-  | Some (path, pos_opt)
+  | Some (path, pos_opt) ->
-   -> (path, pos_opt)
+      (path, pos_opt)
+
 
 let get_loc_trace () : Errlog.loc_trace =
   let path, pos_opt = get_path () in
   Paths.Path.create_loc_trace path pos_opt
 
+
 let get_prop_tenv_pdesc () = !gs.last_prop_tenv_pdesc
 
 (** extract the footprint of the prop, and turn it into a normalized precondition using spec variables *)
@@ -260,34 +273,38 @@ let extract_pre p tenv pdesc abstract_fun =
   in
   Prop.normalize tenv (Prop.prop_sub sub pre')
 
+
 (** return the normalized precondition extracted form the last prop seen, if any
     the abstraction function is a parameter to get around module dependencies *)
 let get_normalized_pre (abstract_fun: Tenv.t -> Prop.normal Prop.t -> Prop.normal Prop.t)
     : Prop.normal Prop.t option =
   match get_prop_tenv_pdesc () with
-  | None
+  | None ->
-   -> None
+      None
-  | Some (prop, tenv, pdesc)
+  | Some (prop, tenv, pdesc) ->
-   -> Some (extract_pre prop tenv pdesc abstract_fun)
+      Some (extract_pre prop tenv pdesc abstract_fun)
+
 
 let get_session () = !gs.last_session
 
 let get_path_pos () =
   let pname =
     match get_prop_tenv_pdesc () with
-    | Some (_, _, pdesc)
+    | Some (_, _, pdesc) ->
-     -> Procdesc.get_proc_name pdesc
+        Procdesc.get_proc_name pdesc
-    | None
+    | None ->
-     -> Typ.Procname.from_string_c_fun "unknown_procedure"
+        Typ.Procname.from_string_c_fun "unknown_procedure"
   in
   let nid = get_node_id () in
   (pname, (nid :> int))
 
+
 let mark_execution_start node =
   let fs = get_failure_stats node in
   fs.instr_ok <- 0 ;
   fs.instr_fail <- 0
 
+
 let mark_execution_end node =
   let fs = get_failure_stats node in
   let success = Int.equal fs.instr_fail 0 in
@@ -295,10 +312,12 @@ let mark_execution_end node =
   fs.instr_fail <- 0 ;
   if success then fs.node_ok <- fs.node_ok + 1 else fs.node_fail <- fs.node_fail + 1
 
+
 let mark_instr_ok () =
   let fs = get_failure_stats (get_node ()) in
   fs.instr_ok <- fs.instr_ok + 1
 
+
 let mark_instr_fail exn =
   let loc = get_loc () in
   let key = (get_node_id_key () :> int * int) in
@@ -309,6 +328,7 @@ let mark_instr_fail exn =
     fs.first_failure <- Some (loc, key, (session :> int), loc_trace, exn) ;
   fs.instr_fail <- fs.instr_fail + 1
 
+
 type log_issue =
   ?store_summary:bool -> Typ.Procname.t -> ?loc:Location.t -> ?node_id:int * int -> ?session:int
   -> ?ltr:Errlog.loc_trace -> ?linters_def_file:string -> ?doc_url:string -> exn -> unit
@@ -317,16 +337,17 @@ let process_execution_failures (log_issue: log_issue) pname =
   let do_failure _ fs =
     (* L.out "Node:%a node_ok:%d node_fail:%d@." Procdesc.Node.pp node fs.node_ok fs.node_fail; *)
     match (fs.node_ok, fs.first_failure) with
-    | 0, Some (loc, key, _, loc_trace, exn) when not Config.debug_exceptions
+    | 0, Some (loc, key, _, loc_trace, exn) when not Config.debug_exceptions ->
-     -> let error = Exceptions.recognize_exception exn in
+        let error = Exceptions.recognize_exception exn in
         let desc' = Localise.verbatim_desc ("exception: " ^ error.name.IssueType.unique_id) in
         let exn' = Exceptions.Analysis_stops (desc', error.ml_loc) in
         log_issue pname ~loc ~node_id:key ~ltr:loc_trace exn'
-    | _
+    | _ ->
-     -> ()
+        ()
   in
   NodeHash.iter do_failure !gs.failure_map
 
+
 let set_instr (instr: Sil.instr) = !gs.last_instr <- Some instr
 
 let set_path path pos_opt = !gs.last_path <- Some (path, pos_opt)
@@ -337,6 +358,7 @@ let set_node (node: Procdesc.Node.t) =
   !gs.last_instr <- None ;
   !gs.last_node <- node
 
+
 let set_session (session: int) = !gs.last_session <- session
 
 let get_const_map () = !gs.const_map

infer/src/backend/timeout.ml

@@ -26,48 +26,59 @@ module GlobalState = struct
 
   let pop () =
     match !stack with
-    | top_status :: l
+    | top_status :: l ->
-     -> stack := l ;
+        stack := l ;
         Some top_status
-    | []
+    | [] ->
-     -> None
+        None
+
 
   let push status = stack := status :: !stack
 end
 
 let set_alarm nsecs =
   match Config.os_type with
-  | Config.Unix | Config.Cygwin
+  | Config.Unix | Config.Cygwin ->
-   -> ignore
+      ignore
         (Unix.setitimer Unix.ITIMER_REAL
            { Unix.it_interval= 3.0
            ; (* try again after 3 seconds if the signal is lost *)
            Unix.it_value= nsecs })
-  | Config.Win32
+  | Config.Win32 ->
-   -> SymOp.set_wallclock_alarm nsecs
+      SymOp.set_wallclock_alarm nsecs
+
 
 let unset_alarm () =
   match Config.os_type with
-  | Config.Unix | Config.Cygwin
+  | Config.Unix | Config.Cygwin ->
-   -> set_alarm 0.0
+      set_alarm 0.0
-  | Config.Win32
+  | Config.Win32 ->
-   -> SymOp.unset_wallclock_alarm ()
+      SymOp.unset_wallclock_alarm ()
+
 
 let get_seconds_remaining () =
   match Config.os_type with
-  | Config.Unix | Config.Cygwin
+  | Config.Unix | Config.Cygwin ->
-   -> (Unix.getitimer Unix.ITIMER_REAL).Unix.it_value
+      (Unix.getitimer Unix.ITIMER_REAL).Unix.it_value
-  | Config.Win32
+  | Config.Win32 ->
-   -> SymOp.get_remaining_wallclock_time ()
+      SymOp.get_remaining_wallclock_time ()
+
 
 let get_current_status ~keep_symop_total =
   let seconds_remaining = get_seconds_remaining () in
   let symop_state = SymOp.save_state ~keep_symop_total in
   {seconds_remaining; symop_state}
 
-let set_status status = SymOp.restore_state status.symop_state ; set_alarm status.seconds_remaining
 
-let timeout_action _ = unset_alarm () ; raise (SymOp.Analysis_failure_exe FKtimeout)
+let set_status status =
+  SymOp.restore_state status.symop_state ;
+  set_alarm status.seconds_remaining
+
+
+let timeout_action _ =
+  unset_alarm () ;
+  raise (SymOp.Analysis_failure_exe FKtimeout)
+
 
 let () =
   (* Can't use Core since it wraps signal handlers and alarms with catch-all exception handlers that
@@ -75,24 +86,27 @@ let () =
   let module Gc = Caml.Gc in
   let module Sys = Caml.Sys in
   match Config.os_type with
-  | Config.Unix | Config.Cygwin
+  | Config.Unix | Config.Cygwin ->
-   -> Sys.set_signal Sys.sigvtalrm (Sys.Signal_handle timeout_action) ;
+      Sys.set_signal Sys.sigvtalrm (Sys.Signal_handle timeout_action) ;
       Sys.set_signal Sys.sigalrm (Sys.Signal_handle timeout_action)
-  | Config.Win32
+  | Config.Win32 ->
-   -> SymOp.set_wallclock_timeout_handler timeout_action ;
+      SymOp.set_wallclock_timeout_handler timeout_action ;
       (* use the Gc alarm for periodic timeout checks *)
       ignore (Gc.create_alarm SymOp.check_wallclock_alarm)
 
+
 let unwind () = unset_alarm () ; SymOp.unset_alarm () ; GlobalState.pop ()
 
 let suspend_existing_timeout ~keep_symop_total =
   let current_status = get_current_status ~keep_symop_total in
   unset_alarm () ; GlobalState.push current_status
 
+
 let resume_previous_timeout () =
   let status_opt = unwind () in
   Option.iter ~f:set_status status_opt
 
+
 let exe_timeout f x =
   let suspend_existing_timeout_and_start_new_one () =
     suspend_existing_timeout ~keep_symop_total:true ;
@@ -101,9 +115,13 @@ let exe_timeout f x =
   in
   try
     SymOp.try_finally
-      ~f:(fun () -> suspend_existing_timeout_and_start_new_one () ; f x ; None)
+      ~f:(fun () ->
+        suspend_existing_timeout_and_start_new_one () ;
+        f x ;
+        None)
       ~finally:resume_previous_timeout
   with SymOp.Analysis_failure_exe kind ->
     L.progressbar_timeout_event kind ;
     Errdesc.warning_err (State.get_loc ()) "TIMEOUT: %a@." SymOp.pp_failure_kind kind ;
     Some kind
+

infer/src/base/CommandDoc.ml

@@ -48,6 +48,7 @@ let mk_command_doc ~see_also:see_also_commands ?environment:environment_opt ?fil
     ~date:Version.man_pages_last_modify_date ~synopsis:[`Pre synopsis] ~environment ~files
     ~see_also
 
+
 let analyze =
   mk_command_doc ~title:"Infer Analysis" ~short_description:"analyze the files captured by infer"
     ~synopsis:{|$(b,infer) $(b,analyze) $(i,[options])
@@ -55,6 +56,7 @@ $(b,infer) $(i,[options])|}
     ~description:[`P "Analyze the files captured in the project results directory and report."]
     ~see_also:CLOpt.([Report; Run])
 
+
 let capture =
   mk_command_doc ~title:"Infer Compilation Capture"
     ~short_description:"capture source files for later analysis"
@@ -76,6 +78,7 @@ $(b,infer) $(b,capture) $(i,[--no-xcpretty]) $(i,[options]) $(b,--) $(b,xcodebui
       ]
     ~see_also:CLOpt.([Analyze; Compile; Run])
 
+
 let compile =
   mk_command_doc ~title:"Infer Project Compilation"
     ~short_description:"compile project from within the infer environment"
@@ -103,6 +106,7 @@ let compile =
       ]
     ~see_also:CLOpt.([Capture])
 
+
 let diff =
   mk_command_doc ~title:"Infer Differential Analysis of a Project"
     ~short_description:"Report the difference between two versions of a project"
@@ -110,6 +114,7 @@ let diff =
     ~description:[`P "EXPERIMENTAL AND IN NO WAY READY TO USE"]
     ~see_also:CLOpt.([ReportDiff; Run])
 
+
 let explore =
   mk_command_doc ~title:"Infer Explore"
     ~short_description:"explore the error traces in infer reports"
@@ -120,6 +125,7 @@ let explore =
       ]
     ~see_also:CLOpt.([Report; Run])
 
+
 let infer =
   mk_command_doc ~title:"Infer Static Analyzer"
     ~short_description:"static analysis for Java and C/C++/Objective-C/Objective-C++"
@@ -199,6 +205,7 @@ $(b,infer) $(i,[options])|}
   }|}
       ] ~see_also:CLOpt.all_commands "infer"
 
+
 let report =
   mk_command_doc ~title:"Infer Reporting" ~short_description:"compute and manipulate infer results"
     ~synopsis:"$(b,infer) $(b,report) $(i,[options]) [$(i,file.specs)...]"
@@ -210,6 +217,7 @@ let report =
       ]
     ~see_also:CLOpt.([ReportDiff; Run])
 
+
 let reportdiff =
   mk_command_doc ~title:"Infer Report Difference"
     ~short_description:"compute the differences between two infer reports"
@@ -229,6 +237,7 @@ let reportdiff =
       ; `P "All three files follow the same format as normal infer reports." ]
     ~see_also:CLOpt.([Report])
 
+
 let run =
   mk_command_doc ~title:"Infer Analysis of a Project"
     ~short_description:"capture source files, analyze, and report"
@@ -242,6 +251,7 @@ $(b,infer) $(i,[options]) $(b,--) $(i,compile command)|}
 $(b,infer) $(b,analyze) $(i,[options])|} ]
     ~see_also:CLOpt.([Analyze; Capture; Report])
 
+
 let command_to_data =
   let mk cmd mk_doc =
     let name = CLOpt.name_of_command cmd in
@@ -258,5 +268,7 @@ let command_to_data =
   ; mk ReportDiff reportdiff
   ; mk Run run ]
 
+
 let data_of_command command =
   List.Assoc.find_exn ~equal:CLOpt.equal_command command_to_data command
+

infer/src/base/CommandLineOption.ml

@@ -24,11 +24,13 @@ let is_env_var_set v = Option.value (Option.map (Sys.getenv v) ~f:(( = ) "1")) ~
     options are relative. *)
 let init_work_dir, is_originator =
   match Sys.getenv "INFER_CWD" with
-  | Some dir
+  | Some dir ->
-   -> (dir, false)
+      (dir, false)
-  | None
+  | None ->
-   -> let real_cwd = Utils.realpath (Sys.getcwd ()) in
+      let real_cwd = Utils.realpath (Sys.getcwd ()) in
-      Unix.putenv ~key:"INFER_CWD" ~data:real_cwd ; (real_cwd, true)
+      Unix.putenv ~key:"INFER_CWD" ~data:real_cwd ;
+      (real_cwd, true)
+
 
 let strict_mode_env_var = "INFER_STRICT_MODE"
 
@@ -39,6 +41,7 @@ let warnf =
   else if not is_originator then fun fmt -> F.ifprintf F.err_formatter fmt
   else F.eprintf
 
+
 (** This is the subset of Arg.spec that we actually use. What's important is that all these specs
     call back functions. We use this to mark deprecated arguments. What's not important is that, eg,
     Arg.Float is missing. *)
@@ -49,14 +52,15 @@ type spec =
   | Rest of (string -> unit)
 
 let to_arg_spec = function
-  | Unit f
+  | Unit f ->
-   -> Arg.Unit f
+      Arg.Unit f
-  | String f
+  | String f ->
-   -> Arg.String f
+      Arg.String f
-  | Symbol (symbols, f)
+  | Symbol (symbols, f) ->
-   -> Arg.Symbol (symbols, f)
+      Arg.Symbol (symbols, f)
-  | Rest f
+  | Rest f ->
-   -> Arg.Rest f
+      Arg.Rest f
+
 
 let to_arg_spec_triple (x, spec, y) = (x, to_arg_spec spec, y)
 
@@ -75,15 +79,16 @@ type anon_arg_action =
 let anon_arg_action_of_parse_mode parse_mode =
   let parse_subcommands, parse_argfiles, on_unknown =
     match parse_mode with
-    | InferCommand
+    | InferCommand ->
-     -> (true, true, `Reject)
+        (true, true, `Reject)
-    | Javac
+    | Javac ->
-     -> (false, true, `Skip)
+        (false, true, `Skip)
-    | NoParse
+    | NoParse ->
-     -> (false, false, `Skip)
+        (false, false, `Skip)
   in
   {parse_subcommands; parse_argfiles; on_unknown}
 
+
 (* NOTE: All variants must be also added to `all_commands` below *)
 type command =
   | Analyze
@@ -110,6 +115,7 @@ let command_to_name =
   ; (ReportDiff, "reportdiff")
   ; (Run, "run") ]
 
+
 let all_commands = List.map ~f:fst command_to_name
 
 let name_of_command = List.Assoc.find_exn ~equal:equal_command command_to_name
@@ -122,6 +128,7 @@ let command_of_exe_name exe_name =
   List.find_map command_to_name ~f:(fun (cmd, name) ->
       if String.equal exe_name (exe_name_of_command_name name) then Some cmd else None )
 
+
 type command_doc =
   { title: Cmdliner.Manpage.title
   ; manual_before_options: Cmdliner.Manpage.block list
@@ -140,54 +147,58 @@ type desc =
 
 let dashdash ?short long =
   match (long, short) with
-  | "", (None | Some "") | "--", _
+  | "", (None | Some "") | "--", _ ->
-   -> long
+      long
-  | "", Some short
+  | "", Some short ->
-   -> "-" ^ short
+      "-" ^ short
-  | _
+  | _ ->
-   -> "--" ^ long
+      "--" ^ long
+
 
 let xdesc {long; short; spec} =
   let key long short =
     match (long, short) with
-    | "", ""
+    | "", "" ->
-     -> ""
+        ""
-    | "--", _
+    | "--", _ ->
-     -> "--"
+        "--"
-    | "", _
+    | "", _ ->
-     -> "-" ^ short
+        "-" ^ short
-    | _
+    | _ ->
-     -> "--" ^ long
+        "--" ^ long
   in
   let xspec =
     match spec with
     (* translate Symbol to String for better formatting of --help messages *)
-    | Symbol (symbols, action)
+    | Symbol (symbols, action) ->
-     -> String
+        String
           (fun arg ->
             if List.mem ~equal:String.equal symbols arg then action arg
             else
               raise
                 (Arg.Bad
                    (F.sprintf "wrong argument '%s'; option '%s' expects one of: %s" arg
-                      (dashdash ~short long) (String.concat ~sep:" | " symbols))))
+                      (dashdash ~short long)
-    | _
+                      (String.concat ~sep:" | " symbols))))
-     -> spec
+    | _ ->
+        spec
   in
   (* Arg doesn't need to know anything about documentation since we generate our own *)
   (key long short, xspec, "")
 
+
 let check_no_duplicates desc_list =
   let rec check_for_duplicates_ = function
-    | [] | [_]
+    | [] | [_] ->
-     -> true
+        true
-    | (x, _, _) :: (y, _, _) :: _ when x <> "" && x = y
+    | (x, _, _) :: (y, _, _) :: _ when x <> "" && x = y ->
-     -> L.(die InternalError) "Multiple definitions of command line option: %s" x
+        L.(die InternalError) "Multiple definitions of command line option: %s" x
-    | _ :: tl
+    | _ :: tl ->
-     -> check_for_duplicates_ tl
+        check_for_duplicates_ tl
   in
   check_for_duplicates_ (List.sort ~cmp:(fun (x, _, _) (y, _, _) -> String.compare x y) desc_list)
 
+
 let parse_mode_desc_lists = List.map ~f:(fun parse_mode -> (parse_mode, ref [])) all_parse_modes
 
 module SectionMap = Caml.Map.Make (struct
@@ -205,11 +216,13 @@ module SectionMap = Caml.Map.Make (struct
       -1
     else (* reverse order *)
       String.compare s2 s1
+
 end)
 
 let help_sections_desc_lists =
   List.map all_commands ~f:(fun command -> (command, ref SectionMap.empty))
 
+
 let visible_descs_list = ref []
 
 let hidden_descs_list = ref []
@@ -236,16 +249,16 @@ let add parse_mode sections desc =
         let oxford_comma l =
           let rec aux acc l =
             match (l, acc) with
-            | [], _
+            | [], _ ->
-             -> assert false
+                assert false
-            | [x], []
+            | [x], [] ->
-             -> x
+                x
-            | [x; y], []
+            | [x; y], [] ->
-             -> Printf.sprintf "%s and %s" x y
+                Printf.sprintf "%s and %s" x y
-            | [x; y], acc
+            | [x; y], acc ->
-             -> Printf.sprintf "%s, %s, and %s" (String.concat ~sep:", " (List.rev acc)) x y
+                Printf.sprintf "%s, %s, and %s" (String.concat ~sep:", " (List.rev acc)) x y
-            | x :: tl, acc
+            | x :: tl, acc ->
-             -> aux (x :: acc) tl
+                aux (x :: acc) tl
           in
           aux [] l
         in
@@ -263,26 +276,27 @@ let add parse_mode sections desc =
     visible_descs_list := desc_infer :: !visible_descs_list ;
     ()
 
+
 let deprecate_desc parse_mode ~long ~short ~deprecated desc =
   let warn () =
     match parse_mode with
-    | Javac | NoParse
+    | Javac | NoParse ->
-     -> ()
+        ()
-    | InferCommand
+    | InferCommand ->
-     -> warnf "WARNING: '-%s' is deprecated. Use '--%s'%s instead.@." deprecated long
+        warnf "WARNING: '-%s' is deprecated. Use '--%s'%s instead.@." deprecated long
           (if short = "" then "" else Printf.sprintf " or '-%s'" short)
   in
   let warn_then_f f x = warn () ; f x in
   let deprecated_spec =
     match desc.spec with
-    | Unit f
+    | Unit f ->
-     -> Unit (warn_then_f f)
+        Unit (warn_then_f f)
-    | String f
+    | String f ->
-     -> String (warn_then_f f)
+        String (warn_then_f f)
-    | Symbol (symbols, f)
+    | Symbol (symbols, f) ->
-     -> Symbol (symbols, warn_then_f f)
+        Symbol (symbols, warn_then_f f)
-    | Rest _ as spec
+    | Rest _ as spec ->
-     -> spec
+        spec
   in
   let deprecated_decode_json ~inferconfig_dir j =
     warnf "WARNING: in .inferconfig: '%s' is deprecated. Use '%s' instead." deprecated long ;
@@ -295,6 +309,7 @@ let deprecate_desc parse_mode ~long ~short ~deprecated desc =
   ; spec= deprecated_spec
   ; decode_json= deprecated_decode_json }
 
+
 let mk ?(deprecated= []) ?(parse_mode= InferCommand) ?(in_help= []) ~long ?short:short0 ~default
     ~meta doc ~default_to_string ~decode_json ~mk_setter ~mk_spec =
   let variable = ref default in
@@ -323,6 +338,7 @@ let mk ?(deprecated= []) ?(parse_mode= InferCommand) ?(in_help= []) ~long ?short
       deprecate_desc parse_mode ~long ~short ~deprecated desc |> add parse_mode [] ) ;
   variable
 
+
 (* begin parsing state *)
 (* arguments passed to Arg.parse_argv_dynamic, susceptible to be modified on the fly when parsing *)
 let args_to_parse : string array ref = ref (Array.of_list [])
@@ -359,9 +375,11 @@ let path_json_decoder ~long ~inferconfig_dir json =
   in
   [dashdash long; abs_path]
 
+
 let list_json_decoder json_decoder ~inferconfig_dir json =
   List.concat (YBU.convert_each (json_decoder ~inferconfig_dir) json)
 
+
 let mk_set var value ?(deprecated= []) ~long ?short ?parse_mode ?in_help ?(meta= "") doc =
   let setter () = var := value in
   ignore
@@ -369,6 +387,7 @@ let mk_set var value ?(deprecated= []) ~long ?short ?parse_mode ?in_help ?(meta=
        ~default_to_string:(fun () -> "") ~decode_json:(string_json_decoder ~long)
        ~mk_setter:(fun _ _ -> setter ()) ~mk_spec:(fun _ -> Unit setter ))
 
+
 let mk_with_reset value ~reset_doc ?deprecated ~long ?parse_mode mk =
   let var = mk () in
   if not (String.equal "" long) then
@@ -377,6 +396,7 @@ let mk_with_reset value ~reset_doc ?deprecated ~long ?parse_mode mk =
     mk_set var value ?deprecated ~long:(long ^ "-reset") ?parse_mode reset_doc ;
   var
 
+
 let reset_doc_opt ~long = Printf.sprintf "Cancel the effect of $(b,%s)." (dashdash long)
 
 let reset_doc_list ~long = Printf.sprintf "Set $(b,%s) to the empty list." (dashdash long)
@@ -393,6 +413,7 @@ let mk_option ?(default= None) ?(default_to_string= fun _ -> "") ~f ?(mk_reset=
     mk_with_reset None ~reset_doc ~long ?parse_mode mk
   else mk ()
 
+
 let mk_bool ?(deprecated_no= []) ?(default= false) ?(f= fun b -> b) ?(deprecated= []) ~long ?short
     ?parse_mode ?in_help ?(meta= "") doc0 =
   let nolong =
@@ -407,10 +428,10 @@ let mk_bool ?(deprecated_no= []) ?(default= false) ?(f= fun b -> b) ?(deprecated
   in
   let doc long short =
     match short with
-    | Some short
+    | Some short ->
-     -> doc0 ^ " (Conversely: $(b,--" ^ long ^ ") | $(b,-" ^ String.of_char short ^ "))"
+        doc0 ^ " (Conversely: $(b,--" ^ long ^ ") | $(b,-" ^ String.of_char short ^ "))"
-    | None
+    | None ->
-     -> doc0 ^ " (Conversely: $(b,--" ^ long ^ "))"
+        doc0 ^ " (Conversely: $(b,--" ^ long ^ "))"
   in
   let doc, nodoc =
     if String.equal doc0 "" then ("", "")
@@ -435,6 +456,7 @@ let mk_bool ?(deprecated_no= []) ?(default= false) ?(f= fun b -> b) ?(deprecated
        ~mk_spec) ;
   var
 
+
 let mk_bool_group ?(deprecated_no= []) ?(default= false) ?f:(f0 = Fn.id) ?(deprecated= []) ~long
     ?short ?parse_mode ?in_help ?meta doc children no_children =
   let f b =
@@ -444,34 +466,40 @@ let mk_bool_group ?(deprecated_no= []) ?(default= false) ?f:(f0 = Fn.id) ?(depre
   in
   mk_bool ~deprecated ~deprecated_no ~default ~long ?short ~f ?parse_mode ?in_help ?meta doc
 
+
 let mk_int ~default ?(f= Fn.id) ?(deprecated= []) ~long ?short ?parse_mode ?in_help ?(meta= "int")
     doc =
   mk ~deprecated ~long ?short ~default ?parse_mode ?in_help ~meta doc
     ~default_to_string:string_of_int ~mk_setter:(fun var str -> var := f (int_of_string str))
     ~decode_json:(string_json_decoder ~long) ~mk_spec:(fun set -> String set )
 
+
 let mk_int_opt ?default ?f:(f0 = Fn.id) ?(deprecated= []) ~long ?short ?parse_mode ?in_help
     ?(meta= "int") doc =
   let default_to_string = function Some f -> string_of_int f | None -> "" in
   let f s = Some (f0 (int_of_string s)) in
   mk_option ~deprecated ~long ?short ~default ~default_to_string ~f ?parse_mode ?in_help ~meta doc
 
+
 let mk_float ~default ?(deprecated= []) ~long ?short ?parse_mode ?in_help ?(meta= "float") doc =
   mk ~deprecated ~long ?short ~default ?parse_mode ?in_help ~meta doc
     ~default_to_string:string_of_float ~mk_setter:(fun var str -> var := float_of_string str)
     ~decode_json:(string_json_decoder ~long) ~mk_spec:(fun set -> String set )
 
+
 let mk_float_opt ?default ?(deprecated= []) ~long ?short ?parse_mode ?in_help ?(meta= "float") doc =
   let default_to_string = function Some f -> string_of_float f | None -> "" in
   let f s = Some (float_of_string s) in
   mk_option ~deprecated ~long ?short ~default ~default_to_string ~f ?parse_mode ?in_help ~meta doc
 
+
 let mk_string ~default ?(f= fun s -> s) ?(deprecated= []) ~long ?short ?parse_mode ?in_help
     ?(meta= "string") doc =
   mk ~deprecated ~long ?short ~default ?parse_mode ?in_help ~meta doc
     ~default_to_string:(fun s -> s) ~mk_setter:(fun var str -> var := f str)
     ~decode_json:(string_json_decoder ~long) ~mk_spec:(fun set -> String set )
 
+
 let mk_string_opt ?default ?(f= fun s -> s) ?mk_reset ?(deprecated= []) ~long ?short ?parse_mode
     ?in_help ?(meta= "string") doc =
   let default_to_string = function Some s -> s | None -> "" in
@@ -479,6 +507,7 @@ let mk_string_opt ?default ?(f= fun s -> s) ?mk_reset ?(deprecated= []) ~long ?s
   mk_option ~deprecated ~long ?short ~default ~default_to_string ~f ?mk_reset ?parse_mode ?in_help
     ~meta doc
 
+
 let mk_string_list ?(default= []) ?(f= fun s -> s) ?(deprecated= []) ~long ?short ?parse_mode
     ?in_help ?(meta= "string") doc =
   let mk () =
@@ -490,6 +519,7 @@ let mk_string_list ?(default= []) ?(f= fun s -> s) ?(deprecated= []) ~long ?shor
   let reset_doc = reset_doc_list ~long in
   mk_with_reset [] ~reset_doc ~long ?parse_mode mk
 
+
 let normalize_path_in_args_being_parsed ?(f= Fn.id) ~is_anon_arg str =
   if Filename.is_relative str then
     (* Replace relative paths with absolute ones on the fly in the args being parsed. This assumes
@@ -502,6 +532,7 @@ let normalize_path_in_args_being_parsed ?(f= Fn.id) ~is_anon_arg str =
     abs_path
   else str
 
+
 let mk_path_helper ~setter ~default_to_string ~default ~deprecated ~long ~short ~parse_mode
     ~in_help ~meta ~decode_json doc =
   mk ~deprecated ~long ?short ~default ?parse_mode ?in_help ~meta doc ~decode_json
@@ -510,6 +541,7 @@ let mk_path_helper ~setter ~default_to_string ~default ~deprecated ~long ~short
       let abs_path = normalize_path_in_args_being_parsed ~is_anon_arg:false str in
       setter var abs_path) ~mk_spec:(fun set -> String set )
 
+
 let mk_path ~default ?(f= Fn.id) ?(deprecated= []) ~long ?short ?parse_mode ?in_help
     ?(meta= "path") =
   mk_path_helper
@@ -518,6 +550,7 @@ let mk_path ~default ?(f= Fn.id) ?(deprecated= []) ~long ?short ?parse_mode ?in_
     ~default_to_string:(fun s -> s)
     ~default ~deprecated ~long ~short ~parse_mode ~in_help ~meta
 
+
 let mk_path_opt ?default ?(deprecated= []) ~long ?short ?parse_mode ?in_help ?(meta= "path") doc =
   let mk () =
     mk_path_helper
@@ -529,6 +562,7 @@ let mk_path_opt ?default ?(deprecated= []) ~long ?short ?parse_mode ?in_help ?(m
   let reset_doc = reset_doc_opt ~long in
   mk_with_reset None ~reset_doc ~long ?parse_mode mk
 
+
 let mk_path_list ?(default= []) ?(deprecated= []) ~long ?short ?parse_mode ?in_help ?(meta= "path")
     doc =
   let mk () =
@@ -541,10 +575,12 @@ let mk_path_list ?(default= []) ?(deprecated= []) ~long ?short ?parse_mode ?in_h
   let reset_doc = reset_doc_list ~long in
   mk_with_reset [] ~reset_doc ~long ?parse_mode mk
 
+
 let mk_symbols_meta symbols =
   let strings = List.map ~f:fst symbols in
   Printf.sprintf "{ %s }" (String.concat ~sep:" | " strings)
 
+
 let mk_symbol ~default ~symbols ~eq ?(f= Fn.id) ?(deprecated= []) ~long ?short ?parse_mode ?in_help
     ?meta doc =
   let strings = List.map ~f:fst symbols in
@@ -556,6 +592,7 @@ let mk_symbol ~default ~symbols ~eq ?(f= Fn.id) ?(deprecated= []) ~long ?short ?
     ~default_to_string:(fun s -> to_string s) ~mk_setter:(fun var str -> var := of_string str |> f)
     ~decode_json:(string_json_decoder ~long) ~mk_spec:(fun set -> Symbol (strings, set) )
 
+
 let mk_symbol_opt ~symbols ?(f= Fn.id) ?(mk_reset= true) ?(deprecated= []) ~long ?short ?parse_mode
     ?in_help ?meta doc =
   let strings = List.map ~f:fst symbols in
@@ -571,6 +608,7 @@ let mk_symbol_opt ~symbols ?(f= Fn.id) ?(mk_reset= true) ?(deprecated= []) ~long
     mk_with_reset None ~reset_doc ~long ?parse_mode mk
   else mk ()
 
+
 let mk_symbol_seq ?(default= []) ~symbols ~eq ?(deprecated= []) ~long ?short ?parse_mode ?in_help
     ?meta doc =
   let sym_to_str = List.map ~f:(fun (x, y) -> (y, x)) symbols in
@@ -584,6 +622,7 @@ let mk_symbol_seq ?(default= []) ~symbols ~eq ?(deprecated= []) ~long ?short ?pa
       [dashdash long; String.concat ~sep:"," (YBU.convert_each YBU.to_string json)]) ~mk_spec:
     (fun set -> String set )
 
+
 let mk_set_from_json ~default ~default_to_string ~f ?(deprecated= []) ~long ?short ?parse_mode
     ?in_help ?(meta= "json") doc =
   mk ~deprecated ~long ?short ?parse_mode ?in_help ~meta doc ~default ~default_to_string
@@ -591,6 +630,7 @@ let mk_set_from_json ~default ~default_to_string ~f ?(deprecated= []) ~long ?sho
     ~decode_json:(fun ~inferconfig_dir:_ json -> [dashdash long; Yojson.Basic.to_string json])
     ~mk_spec:(fun set -> String set )
 
+
 let mk_json ?(deprecated= []) ~long ?short ?parse_mode ?in_help ?(meta= "json") doc =
   mk ~deprecated ~long ?short ?parse_mode ?in_help ~meta doc ~default:(`List [])
     ~default_to_string:Yojson.Basic.to_string
@@ -598,6 +638,7 @@ let mk_json ?(deprecated= []) ~long ?short ?parse_mode ?in_help ?(meta= "json")
     ~decode_json:(fun ~inferconfig_dir:_ json -> [dashdash long; Yojson.Basic.to_string json])
     ~mk_spec:(fun set -> String set )
 
+
 (** [mk_anon] always return the same ref. Anonymous arguments are only accepted if
     [parse_action_accept_unknown_args] is true. *)
 let mk_anon () = rev_anon_args
@@ -609,6 +650,7 @@ let mk_rest ?(parse_mode= InferCommand) ?(in_help= []) doc =
     {long= "--"; short= ""; meta= ""; doc; spec; decode_json= (fun ~inferconfig_dir:_ _ -> [])} ;
   rest
 
+
 let normalize_desc_list speclist =
   let norm k =
     let remove_no s =
@@ -623,19 +665,20 @@ let normalize_desc_list speclist =
   in
   let compare_specs {long= x} {long= y} =
     match (x, y) with
-    | "--", "--"
+    | "--", "--" ->
-     -> 0
+        0
-    | "--", _
+    | "--", _ ->
-     -> 1
+        1
-    | _, "--"
+    | _, "--" ->
-     -> -1
+        -1
-    | _
+    | _ ->
-     -> let lower_norm s = String.lowercase @@ norm s in
+        let lower_norm s = String.lowercase @@ norm s in
         String.compare (lower_norm x) (lower_norm y)
   in
   let sort speclist = List.sort ~cmp:compare_specs speclist in
   sort speclist
 
+
 let mk_command_doc ~title ~section ~version ~date ~short_description ~synopsis ~description
     ?options ?exit_status ?environment ?files ?notes ?bugs ?examples ~see_also command_str =
   let add_if section blocks =
@@ -644,7 +687,7 @@ let mk_command_doc ~title ~section ~version ~date ~short_description ~synopsis ~
   let manual_before_options =
     [ `S Cmdliner.Manpage.s_name
     ; (* the format of the following line is mandated by man(7) *)
-    `Pre (Printf.sprintf "%s - %s" command_str short_description)
+      `Pre (Printf.sprintf "%s - %s" command_str short_description)
     ; `S Cmdliner.Manpage.s_synopsis
     ; `Blocks synopsis
     ; `S Cmdliner.Manpage.s_description
@@ -669,6 +712,7 @@ let mk_command_doc ~title ~section ~version ~date ~short_description ~synopsis ~
   in
   command_doc
 
+
 let set_curr_speclist_for_parse_mode ~usage parse_mode =
   let curr_usage status =
     prerr_endline (String.concat_array ~sep:" " !args_to_parse) ;
@@ -694,15 +738,18 @@ let set_curr_speclist_for_parse_mode ~usage parse_mode =
   assert (check_no_duplicates !curr_speclist) ;
   curr_usage
 
+
 let select_parse_mode ~usage parse_mode =
   let print_usage = set_curr_speclist_for_parse_mode ~usage parse_mode in
   anon_arg_action := anon_arg_action_of_parse_mode parse_mode ;
   print_usage
 
+
 let string_of_command command =
   let _, s, _ = List.Assoc.find_exn !subcommands ~equal:equal_command command in
   s
 
+
 let mk_rest_actions ?(parse_mode= InferCommand) ?(in_help= []) doc ~usage decode_action =
   let rest = ref [] in
   let spec =
@@ -715,6 +762,7 @@ let mk_rest_actions ?(parse_mode= InferCommand) ?(in_help= []) doc ~usage decode
     {long= "--"; short= ""; meta= ""; doc; spec; decode_json= (fun ~inferconfig_dir:_ _ -> [])} ;
   rest
 
+
 let mk_subcommand command ?on_unknown_arg:(on_unknown = `Reject) ~name ?deprecated_long ?parse_mode
     ?in_help command_doc =
   let switch () =
@@ -722,19 +770,20 @@ let mk_subcommand command ?on_unknown_arg:(on_unknown = `Reject) ~name ?deprecat
     anon_arg_action := {(!anon_arg_action) with on_unknown}
   in
   ( match deprecated_long with
-  | Some long
+  | Some long ->
-   -> ignore
+      ignore
         (mk ~long ~default:() ?parse_mode ?in_help ~meta:"" "" ~default_to_string:(fun () -> "")
            ~decode_json:(fun ~inferconfig_dir:_ _ ->
              raise (Arg.Bad ("Bad option in config file: " ^ long)))
            ~mk_setter:(fun _ _ ->
              warnf "WARNING: '%s' is deprecated. Please use '%s' instead.@\n" (dashdash long) name ;
              switch ()) ~mk_spec:(fun set -> Unit (fun () -> set "") ))
-  | None
+  | None ->
-   -> () ) ;
+      () ) ;
   subcommands := (command, (command_doc, name, in_help)) :: !subcommands ;
   subcommand_actions := (name, switch) :: !subcommand_actions
 
+
 (* drop well-balanced first and last characters in [s] that satisfy the [drop] predicate; for
    instance, [lrstrip ~drop:(function | 'a' | 'x' -> true | _ -> false) "xaabax"] returns "ab" *)
 let rec lrstrip ~drop s =
@@ -746,17 +795,19 @@ let rec lrstrip ~drop s =
       lrstrip ~drop (String.slice s 1 (n - 1))
     else s
 
+
 let args_from_argfile arg =
   let abs_fname =
     let fname = String.slice arg 1 (String.length arg) in
     normalize_path_in_args_being_parsed ~f:(fun s -> "@" ^ s) ~is_anon_arg:true fname
   in
   match In_channel.read_lines abs_fname with
-  | lines
+  | lines ->
-   -> let strip = lrstrip ~drop:(function '"' | '\'' -> true | _ -> false) in
+      let strip = lrstrip ~drop:(function '"' | '\'' -> true | _ -> false) in
       List.map ~f:strip lines
-  | exception e
+  | exception e ->
-   -> raise (Arg.Bad ("Error reading argument file '" ^ abs_fname ^ "': " ^ Exn.to_string e))
+      raise (Arg.Bad ("Error reading argument file '" ^ abs_fname ^ "': " ^ Exn.to_string e))
+
 
 exception SubArguments of string list
 
@@ -769,29 +820,31 @@ let anon_fun arg =
   then
     let command_switch = List.Assoc.find_exn !subcommand_actions ~equal:String.equal arg in
     match (!curr_command, is_originator) with
-    | None, _ | Some _, false
+    | None, _ | Some _, false ->
-     -> command_switch ()
+        command_switch ()
-    | Some command, true
+    | Some command, true ->
-     -> raise
+        raise
           (Arg.Bad
              (Printf.sprintf "More than one subcommand specified: '%s', '%s'"
                 (string_of_command command) arg))
   else
     match !anon_arg_action.on_unknown with
-    | `Add
+    | `Add ->
-     -> rev_anon_args := arg :: !rev_anon_args
+        rev_anon_args := arg :: !rev_anon_args
-    | `Skip
+    | `Skip ->
-     -> ()
+        ()
-    | `Reject
+    | `Reject ->
-     -> raise (Arg.Bad (Printf.sprintf "Unexpected anonymous argument: '%s'" arg))
+        raise (Arg.Bad (Printf.sprintf "Unexpected anonymous argument: '%s'" arg))
+
 
 let decode_inferconfig_to_argv path =
   let json =
     match Utils.read_json_file path with
-    | Ok json
+    | Ok json ->
-     -> json
+        json
-    | Error msg
+    | Error msg ->
-     -> warnf "WARNING: Could not read or parse Infer config in %s:@\n%s@." path msg ; `Assoc []
+        warnf "WARNING: Could not read or parse Infer config in %s:@\n%s@." path msg ;
+        `Assoc []
   in
   let desc_list = List.Assoc.find_exn ~equal:equal_parse_mode parse_mode_desc_lists InferCommand in
   let json_config = YBU.to_assoc json in
@@ -808,15 +861,17 @@ let decode_inferconfig_to_argv path =
       in
       decode_json ~inferconfig_dir json_val @ result
     with
-    | Not_found
+    | Not_found ->
-     -> warnf "WARNING: while reading config file %s:@\nUnknown option %s@." path key ; result
+        warnf "WARNING: while reading config file %s:@\nUnknown option %s@." path key ;
-    | YBU.Type_error (msg, json)
+        result
-     -> warnf "WARNING: while reading config file %s:@\nIll-formed value %s for option %s: %s@."
+    | YBU.Type_error (msg, json) ->
+        warnf "WARNING: while reading config file %s:@\nIll-formed value %s for option %s: %s@."
           path (Yojson.Basic.to_string json) key msg ;
         result
   in
   List.fold ~f:one_config_item ~init:[] json_config
 
+
 (** separator of argv elements when encoded into environment variables *)
 let env_var_sep = '^'
 
@@ -831,19 +886,22 @@ let encode_argv_to_env argv =
          false))
        argv)
 
+
 let decode_env_to_argv env =
   String.split ~on:env_var_sep env |> List.filter ~f:(Fn.non String.is_empty)
 
+
 (** [prefix_before_rest (prefix @ ["--" :: rest])] is [prefix] where "--" is not in [prefix]. *)
 let rev_prefix_before_rest args =
   let rec rev_prefix_before_rest_ rev_keep = function
-    | [] | "--" :: _
+    | [] | "--" :: _ ->
-     -> rev_keep
+        rev_keep
-    | keep :: args
+    | keep :: args ->
-     -> rev_prefix_before_rest_ (keep :: rev_keep) args
+        rev_prefix_before_rest_ (keep :: rev_keep) args
   in
   rev_prefix_before_rest_ [] args
 
+
 (** environment variable use to pass arguments from parent to child processes *)
 let args_env_var = "INFER_ARGS"
 
@@ -867,8 +925,8 @@ let parse_args ~usage initial_action ?initial_command args =
     try
       Arg.parse_argv_dynamic ~current:arg_being_parsed !args_to_parse curr_speclist anon_fun usage
     with
-    | SubArguments args
+    | SubArguments args ->
-     -> (* stop parsing the current arguments and parse [args] for a while *)
+        (* stop parsing the current arguments and parse [args] for a while *)
         let saved_args = !args_to_parse in
         let saved_current = !arg_being_parsed in
         args_to_parse := Array.of_list (exe_name :: args) ;
@@ -878,18 +936,19 @@ let parse_args ~usage initial_action ?initial_command args =
         args_to_parse := saved_args ;
         arg_being_parsed := saved_current ;
         parse_loop ()
-    | Arg.Bad usage_msg
+    | Arg.Bad usage_msg ->
-     -> if !anon_arg_action.on_unknown <> `Reject && is_unknown usage_msg then (
+        if !anon_arg_action.on_unknown <> `Reject && is_unknown usage_msg then (
           anon_fun !args_to_parse.(!arg_being_parsed) ;
           parse_loop () )
         else Pervasives.(prerr_string usage_msg ; exit 1)
-    | Arg.Help _
+    | Arg.Help _ ->
-     -> (* we handle --help by ourselves and error on -help, so Arg has no way to raise Help
+        (* we handle --help by ourselves and error on -help, so Arg has no way to raise Help
            anymore *)
         assert false
   in
   parse_loop () ; curr_usage
 
+
 let parse ?config_file ~usage action initial_command =
   let env_args = decode_env_to_argv (Option.value (Sys.getenv args_env_var) ~default:"") in
   let inferconfig_args =
@@ -921,7 +980,8 @@ let parse ?config_file ~usage action initial_command =
   let curr_usage =
     let cl_args = match Array.to_list Sys.argv with _ :: tl -> tl | [] -> [] in
     let curr_usage = parse_args ~usage action ?initial_command cl_args in
-    add_parsed_args_to_args_to_export () ; curr_usage
+    add_parsed_args_to_args_to_export () ;
+    curr_usage
   in
   let to_export =
     let argv_to_export = decode_env_to_argv !args_to_export in
@@ -935,7 +995,9 @@ let parse ?config_file ~usage action initial_command =
       "@" ^ file
     else ""
   in
-  Unix.putenv ~key:args_env_var ~data:to_export ; (!curr_command, curr_usage)
+  Unix.putenv ~key:args_env_var ~data:to_export ;
+  (!curr_command, curr_usage)
+
 
 let wrap_line indent_string wrap_length line0 =
   let line = indent_string ^ line0 in
@@ -965,17 +1027,18 @@ let wrap_line indent_string wrap_length line0 =
   let rev_lines, _, line, _ = List.fold ~f:add_word_to_paragraph ~init:([], false, "", 0) words in
   List.rev (line :: rev_lines)
 
+
 let show_manual ?internal_section format default_doc command_opt =
   let command_doc =
     match command_opt with
-    | None
+    | None ->
-     -> default_doc
+        default_doc
     | Some command ->
       match List.Assoc.find_exn ~equal:equal_command !subcommands command with
-      | Some command_doc, _, _
+      | Some command_doc, _, _ ->
-       -> command_doc
+          command_doc
-      | None, _, _
+      | None, _, _ ->
-       -> L.(die InternalError) "No manual for internal command %s" (string_of_command command)
+          L.(die InternalError) "No manual for internal command %s" (string_of_command command)
   in
   let pp_meta f meta =
     match meta with "" -> () | meta -> F.fprintf f " $(i,%s)" (Cmdliner.Manpage.escape meta)
@@ -1001,21 +1064,21 @@ let show_manual ?internal_section format default_doc command_opt =
   in
   let option_blocks =
     match command_doc.manual_options with
-    | `Replace blocks
+    | `Replace blocks ->
-     -> `S Cmdliner.Manpage.s_options :: blocks
+        `S Cmdliner.Manpage.s_options :: blocks
-    | `Prepend blocks
+    | `Prepend blocks ->
-     -> let hidden =
+        let hidden =
           match internal_section with
-          | Some section
+          | Some section ->
-           -> `S section
+              `S section
               :: `P "Use at your own risk."
-                 :: List.concat_map ~f:block_of_desc (normalize_desc_list !hidden_descs_list)
+              :: List.concat_map ~f:block_of_desc (normalize_desc_list !hidden_descs_list)
-          | None
+          | None ->
-           -> []
+              []
         in
         match command_opt with
-        | Some command
+        | Some command ->
-         -> let sections =
+            let sections =
               List.Assoc.find_exn ~equal:equal_command help_sections_desc_lists command
             in
             SectionMap.fold
@@ -1024,8 +1087,8 @@ let show_manual ?internal_section format default_doc command_opt =
                 :: (if String.equal section Cmdliner.Manpage.s_options then blocks else [])
                 @ List.concat_map ~f:block_of_desc (normalize_desc_list descs) @ result)
               !sections hidden
-        | None
+        | None ->
-         -> `S Cmdliner.Manpage.s_options :: blocks
+            `S Cmdliner.Manpage.s_options :: blocks
             @ List.concat_map ~f:block_of_desc (normalize_desc_list !visible_descs_list) @ hidden
   in
   let blocks =
@@ -1035,3 +1098,4 @@ let show_manual ?internal_section format default_doc command_opt =
   in
   Cmdliner.Manpage.print format Format.std_formatter (command_doc.title, blocks) ;
   ()
+

infer/src/base/DB.ml

@@ -30,6 +30,7 @@ let append_crc_cutoff ?(key= "") ?(crc_only= false) name =
   in
   if crc_only then crc_str else Printf.sprintf "%s%c%s" name_up_to_cutoff crc_token crc_str
 
+
 (* Lengh of .crc part: 32 characters of digest, plus 1 character of crc_token *)
 let dot_crc_len = 1 + 32
 
@@ -38,10 +39,11 @@ let strip_crc str = String.slice str 0 (-dot_crc_len)
 let string_crc_has_extension ~ext name_crc =
   let name = strip_crc name_crc in
   match Filename.split_extension name with
-  | _, Some ext'
+  | _, Some ext' ->
-   -> String.equal ext ext'
+      String.equal ext ext'
-  | _, None
+  | _, None ->
-   -> false
+      false
+
 
 let curr_source_file_encoding = `Enc_crc
 
@@ -49,15 +51,16 @@ let curr_source_file_encoding = `Enc_crc
 let source_file_encoding source_file =
   let source_file_s = SourceFile.to_string source_file in
   match curr_source_file_encoding with
-  | `Enc_base
+  | `Enc_base ->
-   -> Filename.basename source_file_s
+      Filename.basename source_file_s
-  | `Enc_path_with_underscores
+  | `Enc_path_with_underscores ->
-   -> Escape.escape_path source_file_s
+      Escape.escape_path source_file_s
-  | `Enc_crc
+  | `Enc_crc ->
-   -> let base = Filename.basename source_file_s in
+      let base = Filename.basename source_file_s in
       let dir = Filename.dirname source_file_s in
       append_crc_cutoff ~key:dir base
 
+
 (** {2 Source Dirs} *)
 
 (** source directory: the directory inside the results dir corresponding to a source file *)
@@ -74,10 +77,12 @@ let source_dir_get_internal_file source_dir extension =
   let fname = source_dir_name ^ extension in
   Filename.concat source_dir fname
 
+
 (** get the source directory corresponding to a source file *)
 let source_dir_from_source_file source_file =
   Filename.concat Config.captured_dir (source_file_encoding source_file)
 
+
 (** Find the source directories in the results dir *)
 let find_source_dirs () =
   let source_dirs = ref [] in
@@ -97,6 +102,7 @@ let find_source_dirs () =
     files_in_results_dir ;
   List.rev !source_dirs
 
+
 (** {2 Filename} *)
 
 type filename = string [@@deriving compare]
@@ -132,10 +138,12 @@ let file_modified_time ?(symlink= false) fname =
     stat.Unix.st_mtime
   with Unix.Unix_error _ -> L.(die InternalError) "File %s does not exist." fname
 
+
 let filename_create_dir fname =
   let dirname = Filename.dirname fname in
   if Sys.file_exists dirname <> `Yes then Utils.create_dir dirname
 
+
 let read_whole_file fd = In_channel.input_all (Unix.in_channel_of_descr fd)
 
 (** Update the file contents with the update function provided.
@@ -158,11 +166,13 @@ let update_file_with_lock dir fname update =
   let str = update buf in
   let i = Unix.write fd ~buf:str ~pos:0 ~len:(String.length str) in
   if Int.equal i (String.length str) then (
-    Unix.lockf fd ~mode:Unix.F_ULOCK ~len:0L ; Unix.close fd )
+    Unix.lockf fd ~mode:Unix.F_ULOCK ~len:0L ;
+    Unix.close fd )
   else (
     L.internal_error "@\nsave_with_lock: fail on path: %s@." path ;
     assert false )
 
+
 (** Read a file using a lock to allow write attempts in parallel. *)
 let read_file_with_lock dir fname =
   let path = Filename.concat dir fname in
@@ -171,10 +181,13 @@ let read_file_with_lock dir fname =
     try
       Unix.lockf fd ~mode:Unix.F_RLOCK ~len:0L ;
       let buf = read_whole_file fd in
-      Unix.lockf fd ~mode:Unix.F_ULOCK ~len:0L ; Unix.close fd ; Some buf
+      Unix.lockf fd ~mode:Unix.F_ULOCK ~len:0L ;
+      Unix.close fd ;
+      Some buf
     with Unix.Unix_error _ -> L.(die ExternalError) "read_file_with_lock: Unix error"
   with Unix.Unix_error _ -> None
 
+
 (** {2 Results Directory} *)
 
 module Results_dir = struct
@@ -190,28 +203,30 @@ module Results_dir = struct
 
   let filename_from_base base path =
     let rec f = function
-      | []
+      | [] ->
-       -> base
+          base
-      | name :: names
+      | name :: names ->
-       -> Filename.concat (f names)
+          Filename.concat (f names)
             (if String.equal name ".." then Filename.parent_dir_name else name)
     in
     f (List.rev path)
 
+
   (** convert a path to a filename *)
   let path_to_filename pk path =
     let base =
       match pk with
-      | Abs_root
+      | Abs_root ->
-       -> Config.results_dir
+          Config.results_dir
-      | Abs_source_dir source
+      | Abs_source_dir source ->
-       -> let dir = source_dir_from_source_file source in
+          let dir = source_dir_from_source_file source in
           source_dir_to_string dir
-      | Rel
+      | Rel ->
-       -> Filename.current_dir_name
+          Filename.current_dir_name
     in
     filename_from_base base path
 
+
   (** directory of spec files *)
   let specs_dir = path_to_filename Abs_root [Config.specs_dir_name]
 
@@ -223,44 +238,49 @@ module Results_dir = struct
     Utils.create_dir (path_to_filename Abs_root [Config.captured_dir_name]) ;
     Utils.create_dir (path_to_filename (Abs_source_dir source) [])
 
+
   let clean_specs_dir () =
     Utils.create_dir specs_dir ;
     (* create dir just in case it doesn't exist to avoid errors *)
     let files_to_remove = Array.map ~f:(Filename.concat specs_dir) (Sys.readdir specs_dir) in
     Array.iter ~f:Sys.remove files_to_remove
 
+
   (** create a file at the given path, creating any missing directories *)
   let create_file pk path =
     let rec create = function
-      | []
+      | [] ->
-       -> let fname = path_to_filename pk [] in
+          let fname = path_to_filename pk [] in
           Utils.create_dir fname ; fname
-      | name :: names
+      | name :: names ->
-       -> let new_path = Filename.concat (create names) name in
+          let new_path = Filename.concat (create names) name in
           Utils.create_dir new_path ; new_path
     in
     let filename, dir_path =
       match List.rev path with
-      | filename :: dir_path
+      | filename :: dir_path ->
-       -> (filename, dir_path)
+          (filename, dir_path)
-      | []
+      | [] ->
-       -> L.(die InternalError) "create_path"
+          L.(die InternalError) "create_path"
     in
     let full_fname = Filename.concat (create dir_path) filename in
     Unix.openfile full_fname ~mode:Unix.([O_WRONLY; O_CREAT; O_TRUNC]) ~perm:0o777
+
 end
 
 let global_tenv_fname =
   let basename = Config.global_tenv_filename in
   filename_concat Config.captured_dir basename
 
+
 let is_source_file path =
   List.exists ~f:(fun ext -> Filename.check_suffix path ext) Config.source_file_extentions
 
+
 let infer_start_time =
-  ( lazy
+  lazy
-  (file_modified_time (Results_dir.path_to_filename Results_dir.Abs_root [Config.start_filename]))
+    (file_modified_time (Results_dir.path_to_filename Results_dir.Abs_root [Config.start_filename]))
-  )
+
 
 (** Return whether filename was updated after analysis started. File doesn't have to exist *)
 let file_was_updated_after_start fname =
@@ -270,12 +290,14 @@ let file_was_updated_after_start fname =
   else (* since file doesn't exist, it wasn't modified *)
     false
 
+
 (** Mark a file as updated by changing its timestamps to be one second in the future.
     This guarantees that it appears updated after start. *)
 let mark_file_updated fname =
   let near_future = Unix.gettimeofday () +. 1. in
   Unix.utimes fname ~access:near_future ~modif:near_future
 
+
 (** Fold over all file paths recursively under [dir] which match [p]. *)
 let fold_paths_matching ~dir ~p ~init ~f =
   let rec paths path_list dir =
@@ -287,6 +309,7 @@ let fold_paths_matching ~dir ~p ~init ~f =
   in
   paths init dir
 
+
 (** Return all absolute paths recursively under root_dir, matching the given
     matcher function p *)
 let paths_matching dir p = fold_paths_matching ~dir ~p ~init:[] ~f:(fun x xs -> x :: xs)

infer/src/base/Die.ml

@@ -21,25 +21,27 @@ exception InferExit of int
 
 let raise_error error ~msg =
   match error with
-  | ExternalError
+  | ExternalError ->
-   -> raise (InferExternalError msg)
+      raise (InferExternalError msg)
-  | InternalError
+  | InternalError ->
-   -> raise (InferInternalError msg)
+      raise (InferInternalError msg)
-  | UserError
+  | UserError ->
-   -> raise (InferUserError msg)
+      raise (InferUserError msg)
+
 
 let die error fmt = F.kasprintf (fun msg -> raise_error error ~msg) fmt
 
 let exit exitcode = raise (InferExit exitcode)
 
 let exit_code_of_exception = function
-  | InferUserError _
+  | InferUserError _ ->
-   -> 1
+      1
-  | InferExternalError _
+  | InferExternalError _ ->
-   -> 3
+      3
-  | InferInternalError _
+  | InferInternalError _ ->
-   -> 4
+      4
-  | InferExit exitcode
+  | InferExit exitcode ->
-   -> exitcode
+      exitcode
-  | _
+  | _ ->
-   -> (* exit code 2 is used by the OCaml runtime in cases of uncaught exceptions *) 2
+      (* exit code 2 is used by the OCaml runtime in cases of uncaught exceptions *) 2
+

infer/src/base/Die.mli

@@ -17,9 +17,8 @@ exception InferInternalError of string
 
 exception InferUserError of string
 
-exception
+exception InferExit of int
-  InferExit of
+    (** This can be used to avoid scattering exit invocations all over the codebase *)
-  int(** This can be used to avoid scattering exit invocations all over the codebase *)
 
 (** kind of error for [die], with similar semantics as [Logging.{external,internal,user}_error] *)
 type error = ExternalError | InternalError | UserError

infer/src/base/Epilogues.ml

@@ -12,14 +12,16 @@ module F = Format
 (* Run the epilogues when we get SIGINT (Control-C). We do not want to mask SIGINT unless at least
    one epilogue has been registered, so make this value lazy. *)
 let activate_run_epilogues_on_signal =
-  ( lazy
+  lazy
-  (let run_epilogues_on_signal s =
+    (let run_epilogues_on_signal s =
-     F.eprintf "*** %s: Caught %s, time to die@." (Filename.basename Sys.executable_name)
+       F.eprintf "*** %s: Caught %s, time to die@."
-       (Signal.to_string s) ;
+         (Filename.basename Sys.executable_name)
-     (* Epilogues are registered with [at_exit] so exiting will make them run. *)
+         (Signal.to_string s) ;
-     Pervasives.exit 0
+       (* Epilogues are registered with [at_exit] so exiting will make them run. *)
-   in
+       Pervasives.exit 0
-   Signal.Expert.handle Signal.int run_epilogues_on_signal) )
+     in
+     Signal.Expert.handle Signal.int run_epilogues_on_signal)
+
 
 let register ~f desc =
   let f_no_exn () =
@@ -33,3 +35,4 @@ let register ~f desc =
   Pervasives.at_exit f_no_exn ;
   (* Register signal masking. *)
   Lazy.force activate_run_epilogues_on_signal
+

infer/src/base/Escape.ml

@@ -26,99 +26,106 @@ let escape_map map_fun s =
   else (* not escaping anything, so don't waste memory on a copy of the string *)
     s
 
+
 let escape_csv s =
   let map = function
-    | '"'
+    | '"' ->
-     -> Some "\"\""
+        Some "\"\""
-    | c when Char.to_int c > 127
+    | c when Char.to_int c > 127 ->
-     -> Some "?" (* non-ascii character: escape *)
+        Some "?" (* non-ascii character: escape *)
-    | _
+    | _ ->
-     -> None
+        None
   in
   escape_map map s
 
+
 let escape_xml s =
   let map = function
-    | '"'
+    | '"' ->
-     -> (* on next line to avoid bad indentation *)
+        (* on next line to avoid bad indentation *)
         Some """
-    | '>'
+    | '>' ->
-     -> Some ">"
+        Some ">"
-    | '<'
+    | '<' ->
-     -> Some "&lt;"
+        Some "&lt;"
-    | '&'
+    | '&' ->
-     -> Some "&amp;"
+        Some "&amp;"
-    | '%'
+    | '%' ->
-     -> Some "&#37;"
+        Some "&#37;"
-    | c when Char.to_int c > 127
+    | c when Char.to_int c > 127 ->
-     -> (* non-ascii character: escape *)
+        (* non-ascii character: escape *)
         Some ("&#" ^ string_of_int (Char.to_int c) ^ ";")
-    | _
+    | _ ->
-     -> None
+        None
   in
   escape_map map s
 
+
 let escape_url s =
   let map = function
-    | '!'
+    | '!' ->
-     -> Some "%21"
+        Some "%21"
-    | '#'
+    | '#' ->
-     -> Some "%23"
+        Some "%23"
-    | '$'
+    | '$' ->
-     -> Some "%24"
+        Some "%24"
-    | '&'
+    | '&' ->
-     -> Some "%26"
+        Some "%26"
-    | '\''
+    | '\'' ->
-     -> Some "%27"
+        Some "%27"
-    | '('
+    | '(' ->
-     -> Some "%28"
+        Some "%28"
-    | ')'
+    | ')' ->
-     -> Some "%29"
+        Some "%29"
-    | '*'
+    | '*' ->
-     -> Some "%2A"
+        Some "%2A"
-    | '+'
+    | '+' ->
-     -> Some "%2B"
+        Some "%2B"
-    | ','
+    | ',' ->
-     -> Some "%2C"
+        Some "%2C"
-    | '/'
+    | '/' ->
-     -> Some "%2F"
+        Some "%2F"
-    | ':'
+    | ':' ->
-     -> Some "%3A"
+        Some "%3A"
-    | ';'
+    | ';' ->
-     -> Some "%3B"
+        Some "%3B"
-    | '='
+    | '=' ->
-     -> Some "%3D"
+        Some "%3D"
-    | '?'
+    | '?' ->
-     -> Some "%3F"
+        Some "%3F"
-    | '@'
+    | '@' ->
-     -> Some "%40"
+        Some "%40"
-    | '['
+    | '[' ->
-     -> Some "%5B"
+        Some "%5B"
-    | ']'
+    | ']' ->
-     -> Some "%5D"
+        Some "%5D"
-    | _
+    | _ ->
-     -> None
+        None
   in
   escape_map map s
 
+
 let escape_dotty s =
   let map = function '"' -> Some "\\\"" | '\\' -> Some "\\\\" | _ -> None in
   escape_map map s
 
+
 let escape_path s =
   let map = function
-    | c
+    | c ->
-     -> if String.equal (Char.escaped c) Filename.dir_sep then Some "_" else None
+        if String.equal (Char.escaped c) Filename.dir_sep then Some "_" else None
   in
   escape_map map s
 
+
 (* Python 2 sucks at utf8 so do not write unicode file names to disk
    as Python may need to see them *)
 let escape_filename s =
   let map = function
-    | c when Char.to_int c > 127
+    | c when Char.to_int c > 127 ->
-     -> Some "?" (* non-ascii character: escape *)
+        Some "?" (* non-ascii character: escape *)
-    | _
+    | _ ->
-     -> None
+        None
   in
   escape_map map s
+