[java] classpath cleanup

Summary:
- Factor out function that walks zip filename entries in jar file.
- Kill dead type (`classpath`) and record field (`classpath`).
- Make some string arguments named.
- Introduce function that folds over classnames in jar file and reduces occurrences of pattern "produce list, fold over it".

Reviewed By: artempyanykh

Differential Revision: D20245756

fbshipit-source-id: ccca47cdd

infer/src/base/Utils.ml

@@ -523,3 +523,16 @@ let set_best_cpu_for worker_id =
   let chosen_core = worker_id * threads_per_core % numcores in
   let chosen_thread_in_core = worker_id * threads_per_core / numcores in
   Setcore.setcore ((chosen_core * threads_per_core) + chosen_thread_in_core)
+
+
+let zip_fold_filenames ~init ~f ~chop_extension ~zip_filename =
+  let file_in = Zip.open_in zip_filename in
+  let collect acc (entry : Zip.entry) =
+    match Filename.split_extension entry.filename with
+    | basename, Some extension when String.equal extension chop_extension ->
+        f acc basename
+    | _ ->
+        acc
+  in
+  let result = List.fold ~f:collect ~init (Zip.entries file_in) in
+  Zip.close_in file_in ; result

infer/src/base/Utils.mli

@@ -178,3 +178,8 @@ val numcores : int
 
 val set_best_cpu_for : int -> unit
 (** Pins processes to CPUs aiming to saturate physical cores evenly *)
+
+val zip_fold_filenames :
+  init:'a -> f:('a -> string -> 'a) -> chop_extension:string -> zip_filename:string -> 'a
+(** fold over each filename in the given [zip_filename] which has as extension [chop_extension]. [f]
+    receives the filename with the extension removed. *)

infer/src/java/jClasspath.ml

@@ -31,7 +31,7 @@ let classpath_of_paths paths =
 
 type file_entry = Singleton of SourceFile.t | Duplicate of (string * SourceFile.t) list
 
-type t = string * file_entry String.Map.t * JBasics.ClassSet.t
+type t = {classpath: string; sources: file_entry String.Map.t; classes: JBasics.ClassSet.t}
 
 (* Open the source file and search for the package declaration.
    Only the case where the package is declared in a single line is supported *)
@@ -107,7 +107,7 @@ let load_from_verbose_output javac_verbose_out =
     | exception End_of_file ->
         In_channel.close file_in ;
         let classpath = classpath_of_paths (String.Set.elements roots @ paths) in
-        (classpath, sources, classes)
+        {classpath; sources; classes}
     | line ->
         if Str.string_match class_filename_re line 0 then
           let path =
@@ -140,32 +140,20 @@ let load_from_verbose_output javac_verbose_out =
   loop [] String.Set.empty String.Map.empty JBasics.ClassSet.empty
 
 
-let classname_of_class_filename class_filename =
-  JBasics.make_cn (String.map ~f:(function '/' -> '.' | c -> c) class_filename)
-
-
-let extract_classnames classnames jar_filename =
-  let file_in = Zip.open_in jar_filename in
-  let collect classes entry =
-    let class_filename = entry.Zip.filename in
-    match Filename.split_extension class_filename with
-    | basename, Some "class" ->
-        classname_of_class_filename basename :: classes
-    | _ ->
-        classes
+let fold_classnames ~init ~f jar_filename =
+  let f acc class_filename =
+    let classname =
+      JBasics.make_cn (String.map ~f:(function '/' -> '.' | c -> c) class_filename)
+    in
+    f acc classname
   in
-  let classnames_after = List.fold ~f:collect ~init:classnames (Zip.entries file_in) in
-  Zip.close_in file_in ; classnames_after
-
-
-let collect_classnames start_classmap jar_filename =
-  List.fold
-    ~f:(fun map cn -> JBasics.ClassSet.add cn map)
-    ~init:start_classmap
-    (extract_classnames [] jar_filename)
+  Utils.zip_fold_filenames ~init ~f ~chop_extension:"class" ~zip_filename:jar_filename
 
 
 let search_classes path =
+  let collect_classnames start_classmap jar_filename =
+    fold_classnames ~f:(fun map cn -> JBasics.ClassSet.add cn map) ~init:start_classmap jar_filename
+  in
   let add_class roots classes class_filename =
     let cn, root_dir = Javalib.extract_class_name_from_file class_filename in
     (add_root_path root_dir roots, JBasics.ClassSet.add cn classes)
@@ -201,17 +189,15 @@ let load_from_arguments classes_out_path =
     split Config.bootclasspath @ split Config.classpath @ String.Set.elements roots
     |> classpath_of_paths
   in
-  (classpath, search_sources (), classes)
+  {classpath; sources= search_sources (); classes}
 
 
 type callee_status = Translated | Missing of JBasics.class_name * JBasics.method_signature
 
 type classmap = JCode.jcode Javalib.interface_or_class JBasics.ClassMap.t
 
-type classpath = {path: string; channel: Javalib.class_path}
-
 type program =
-  { classpath: classpath
+  { classpath_channel: Javalib.class_path
   ; models: classmap
   ; mutable classmap: classmap
   ; callees: callee_status Procname.Hash.t }
@@ -220,7 +206,7 @@ let get_classmap program = program.classmap
 
 let mem_classmap cn program = JBasics.ClassMap.mem cn program.classmap
 
-let get_classpath_channel program = program.classpath.channel
+let get_classpath_channel program = program.classpath_channel
 
 let get_models program = program.models
 
@@ -250,7 +236,7 @@ let iter_missing_callees program ~f =
   Procname.Hash.iter select program.callees
 
 
-let cleanup program = Javalib.close_class_path program.classpath.channel
+let cleanup program = Javalib.close_class_path program.classpath_channel
 
 let lookup_node cn program =
   try Some (JBasics.ClassMap.find cn (get_classmap program))
@@ -273,19 +259,19 @@ let collect_classes start_classmap jar_filename =
     try JBasics.ClassMap.add cn (javalib_get_class classpath cn) classmap
     with JBasics.Class_structure_error _ -> classmap
   in
-  let classmap = List.fold ~f:collect ~init:start_classmap (extract_classnames [] jar_filename) in
+  let classmap = fold_classnames ~f:collect ~init:start_classmap jar_filename in
   Javalib.close_class_path classpath ;
   classmap
 
 
-let load_program classpath classes =
+let load_program ~classpath classes =
   L.(debug Capture Medium) "loading program ... %!" ;
   let models =
     JModels.get_models_jar_filename ()
     |> Option.fold ~init:JBasics.ClassMap.empty ~f:collect_classes
   in
   let program =
-    { classpath= {path= classpath; channel= Javalib.class_path classpath}
+    { classpath_channel= Javalib.class_path classpath
     ; models
     ; classmap= JBasics.ClassMap.empty
     ; callees= Procname.Hash.create 128 }

infer/src/java/jClasspath.mli

@@ -12,7 +12,7 @@ open Javalib_pack
 (** map entry for source files with potential basename collision within the same compiler call *)
 type file_entry = Singleton of SourceFile.t | Duplicate of (string * SourceFile.t) list
 
-type t = string * file_entry String.Map.t * JBasics.ClassSet.t
+type t = {classpath: string; sources: file_entry String.Map.t; classes: JBasics.ClassSet.t}
 
 val load_from_verbose_output : string -> t
 (** load the list of source files and the list of classes from the javac verbose file *)
@@ -32,7 +32,7 @@ val get_models : program -> classmap
 
 val cleanup : program -> unit
 
-val load_program : string -> JBasics.ClassSet.t -> program
+val load_program : classpath:string -> JBasics.ClassSet.t -> program
 (** load a java program *)
 
 val lookup_node : JBasics.class_name -> program -> JCode.jcode Javalib.interface_or_class option

infer/src/java/jMain.ml

@@ -122,7 +122,7 @@ let main load_sources_and_classes =
   | false, true ->
       JModels.set_models ~jar_filename:Config.biabduction_models_jar ) ;
   JBasics.set_permissive true ;
-  let classpath, sources, classes =
+  let JClasspath.{classpath; sources; classes} =
     match load_sources_and_classes with
     | `FromVerboseOut verbose_out_file ->
         JClasspath.load_from_verbose_output verbose_out_file
@@ -133,7 +133,7 @@ let main load_sources_and_classes =
   L.(debug Capture Quiet)
     "Translating %d source files (%d classes)@." (String.Map.length sources)
     (JBasics.ClassSet.cardinal classes) ;
-  let program = JClasspath.load_program classpath classes in
+  let program = JClasspath.load_program ~classpath classes in
   do_all_files sources program
 
 

infer/src/java/jModels.ml

@@ -17,16 +17,15 @@ module StringHash = Caml.Hashtbl.Make (String)
 
 let models_specs_filenames = StringHash.create 1
 
+let specs_file_extension = String.chop_prefix_exn ~prefix:"." Config.specs_files_suffix
+
 let collect_specs_filenames jar_filename =
-  let zip_channel = Zip.open_in jar_filename in
-  let collect entry =
-    let filename = entry.Zip.filename in
-    if Filename.check_suffix filename Config.specs_files_suffix then
-      let proc_filename = Filename.chop_extension (Filename.basename filename) in
-      StringHash.replace models_specs_filenames proc_filename ()
+  let f () filename =
+    let proc_filename = Filename.basename filename in
+    StringHash.replace models_specs_filenames proc_filename ()
   in
-  List.iter ~f:collect (Zip.entries zip_channel) ;
-  Zip.close_in zip_channel
+  Utils.zip_fold_filenames ~init:() ~f ~chop_extension:specs_file_extension
+    ~zip_filename:jar_filename
 
 
 let set_models ~jar_filename =