Convert the Intermediate Representation to Reason.

Reviewed By: jberdine

Differential Revision: D3138490

fbshipit-source-id: e3b53fa

configure.ac

@@ -17,7 +17,7 @@ AC_PREREQ([2.63])
 AC_INIT([Infer],
         [0.8.1],
         [https://github.com/facebook/infer/issues/])
-AC_CONFIG_SRCDIR([infer/src/IR/sil.ml])
+AC_CONFIG_SRCDIR([infer/src/IR/Sil.re])
 
 # WARNING: keep in sync with above
 INFER_MAJOR=0

infer/src/IR/AttributesTable.re

@@ -0,0 +1,86 @@
+/*
+ * Copyright (c) 2015 - present Facebook, Inc.
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+
+open! Utils;
+
+let module F = Format;
+
+let module L = Logging;
+
+
+/** Module to manage the table of attributes. */
+let serializer: Serialization.serializer ProcAttributes.t = Serialization.create_serializer Serialization.attributes_key;
+
+let attributes_filename pname => {
+  let pname_file = Procname.to_filename pname;
+  pname_file ^ ".attr"
+};
+
+
+/** path to the .attr file for the given procedure in the current results directory */
+let res_dir_attr_filename pname => {
+  let attr_fname = attributes_filename pname;
+  let bucket_dir = {
+    let base = Filename.chop_extension attr_fname;
+    let len = String.length base;
+    if (len < 2) {
+      Filename.current_dir_name
+    } else {
+      String.sub base (len - 2) 2
+    }
+  };
+  let filename =
+    DB.Results_dir.path_to_filename
+      DB.Results_dir.Abs_root [Config.attributes_dir_name, bucket_dir, attr_fname];
+  DB.filename_create_dir filename;
+  filename
+};
+
+let store_attributes proc_attributes => {
+  let proc_name = proc_attributes.ProcAttributes.proc_name;
+  let attributes_file = res_dir_attr_filename proc_name;
+  let should_write =
+    /* only overwrite defined procedures */
+    proc_attributes.ProcAttributes.is_defined || not (DB.file_exists attributes_file);
+  if should_write {
+    Serialization.to_file serializer attributes_file proc_attributes
+  }
+};
+
+let load_attributes proc_name => {
+  let attributes_file = res_dir_attr_filename proc_name;
+  Serialization.from_file serializer attributes_file
+};
+
+
+/** Given a procdesure name, find the file where it is defined and */
+/** its corresponding type environment */
+let find_tenv_from_class_of_proc procname =>
+  switch (load_attributes procname) {
+  | None => None
+  | Some attrs =>
+    let source_file = attrs.ProcAttributes.loc.Location.file;
+    let source_dir = DB.source_dir_from_source_file source_file;
+    let tenv_fname = DB.source_dir_get_internal_file source_dir ".tenv";
+    Tenv.load_from_file tenv_fname
+  };
+
+
+/** Given an ObjC class c, extract the type from the tenv where the class was */
+/** defined. We do this by adding a method that is unique to each class, and then */
+/** finding the tenv that corresponds to the class definition.  */
+let get_correct_type_from_objc_class_name c => {
+  let class_method = Procname.get_default_objc_class_method (Mangled.to_string c);
+  switch (find_tenv_from_class_of_proc class_method) {
+  | None => None
+  | Some tenv =>
+    let type_name = Typename.TN_csu (Csu.Class Csu.Objc) c;
+    Option.map (fun st => Sil.Tstruct st) (Tenv.lookup tenv type_name)
+  }
+};

infer/src/IR/AttributesTable.rei

@@ -0,0 +1,30 @@
+/*
+ * Copyright (c) 2015 - present Facebook, Inc.
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+
+open! Utils;
+
+
+/** Module to manage the table of attributes. */
+/** Save .attr file for the procedure into the attributes database. */
+let store_attributes: ProcAttributes.t => unit;
+
+
+/** Load the attributes for the procedure from the attributes database. */
+let load_attributes: Procname.t => option ProcAttributes.t;
+
+
+/** Given a procdesure name, find the file where it is defined and */
+/** its corresponding type environment */
+let find_tenv_from_class_of_proc: Procname.t => option Tenv.t;
+
+
+/** Given an ObjC class c, extract the type from the tenv where the class was */
+/** defined. We do this by adding a method that is unique to each class, and then */
+/** finding the tenv that corresponds to the class definition.  */
+let get_correct_type_from_objc_class_name: Mangled.t => option Sil.typ;

infer/src/IR/Cfg.rei

@@ -0,0 +1,328 @@
+/*
+ * Copyright (c) 2009 - 2013 Monoidics ltd.
+ * Copyright (c) 2013 - present Facebook, Inc.
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+
+open! Utils;
+
+
+/**  Control Flow Graph for Interprocedural Analysis */
+/** {2 ADT node and proc_desc} */
+type node;
+
+type cfg;
+
+
+/** Load a cfg from a file */
+let load_cfg_from_file: DB.filename => option cfg;
+
+
+/** Save a cfg into a file, and save a copy of the source files if the boolean is true */
+let store_cfg_to_file: DB.filename => bool => cfg => unit;
+
+
+/** proc description */
+let module Procdesc: {
+  /** proc description */
+  type t;
+
+  /** Compute the distance of each node to the exit node, if not computed already */
+  let compute_distance_to_exit_node: t => unit;
+
+  /** Create a procdesc */
+  let create: cfg => ProcAttributes.t => t;
+
+  /** [remove cfg name remove_nodes] remove the procdesc [name]
+      from the control flow graph [cfg]. */
+  /** It also removes all the nodes from the procedure from the cfg if remove_nodes is true */
+  let remove: cfg => Procname.t => bool => unit;
+
+  /** Find the procdesc given the proc name. Return None if not found. */
+  let find_from_name: cfg => Procname.t => option t;
+
+  /** Get the attributes of the procedure. */
+  let get_attributes: t => ProcAttributes.t;
+  let get_err_log: t => Errlog.t;
+  let get_exit_node: t => node;
+
+  /** Get flags for the proc desc */
+  let get_flags: t => proc_flags;
+
+  /** Return name and type of formal parameters */
+  let get_formals: t => list (Mangled.t, Sil.typ);
+
+  /** Return loc information for the procedure */
+  let get_loc: t => Location.t;
+
+  /** Return name and type of local variables */
+  let get_locals: t => list (Mangled.t, Sil.typ);
+
+  /** Return name and type of block's captured variables */
+  let get_captured: t => list (Mangled.t, Sil.typ);
+
+  /** Return the visibility attribute */
+  let get_access: t => Sil.access;
+  let get_nodes: t => list node;
+
+  /** Get the procedure's nodes up until the first branching */
+  let get_slope: t => list node;
+
+  /** Get the sliced procedure's nodes up until the first branching */
+  let get_sliced_slope: t => (node => bool) => list node;
+  let get_proc_name: t => Procname.t;
+
+  /** Return the return type of the procedure and type string */
+  let get_ret_type: t => Sil.typ;
+  let get_ret_var: t => Pvar.t;
+  let get_start_node: t => node;
+
+  /** Return [true] iff the procedure is defined, and not just declared */
+  let is_defined: t => bool;
+
+  /** iterate over all the nodes of a procedure */
+  let iter_nodes: (node => unit) => t => unit;
+
+  /** fold over the calls from the procedure: (callee, location) pairs */
+  let fold_calls: ('a => (Procname.t, Location.t) => 'a) => 'a => t => 'a;
+
+  /** iterate over the calls from the procedure: (callee, location) pairs */
+  let iter_calls: ((Procname.t, Location.t) => unit) => t => unit;
+
+  /** iterate over all nodes and their instructions */
+  let iter_instrs: (node => Sil.instr => unit) => t => unit;
+
+  /** fold over all nodes and their instructions */
+  let fold_instrs: ('a => node => Sil.instr => 'a) => 'a => t => 'a;
+
+  /** iterate over all nodes until we reach a branching structure */
+  let iter_slope: (node => unit) => t => unit;
+
+  /** iterate over all calls until we reach a branching structure */
+  let iter_slope_calls: (Procname.t => unit) => t => unit;
+
+  /** iterate between two nodes or until we reach a branching structure */
+  let iter_slope_range: (node => unit) => node => node => unit;
+  let set_exit_node: t => node => unit;
+
+  /** Set a flag for the proc desc */
+  let set_flag: t => string => string => unit;
+  let set_start_node: t => node => unit;
+
+  /** append a list of new local variables to the existing list of local variables */
+  let append_locals: t => list (Mangled.t, Sil.typ) => unit;
+};
+
+
+/** node of the control flow graph */
+let module Node: {
+  type t = node; /** type of nodes */
+  type id = private int;
+
+  /** kind of cfg node */
+  type nodekind =
+    | Start_node of Procdesc.t
+    | Exit_node of Procdesc.t
+    | Stmt_node of string
+    | Join_node
+    | Prune_node of bool Sil.if_kind string /** (true/false branch, if_kind, comment) */
+    | Skip_node of string;
+
+  /** kind of Stmt_node for an exception handler. */
+  let exn_handler_kind: nodekind;
+
+  /** kind of Stmt_node for an exceptions sink. */
+  let exn_sink_kind: nodekind;
+
+  /** kind of Stmt_node for a throw instruction. */
+  let throw_kind: nodekind;
+
+  /** Append the instructions to the list of instructions to execute */
+  let append_instrs: t => list Sil.instr => unit;
+
+  /** Add the instructions at the beginning of the list of instructions to execute */
+  let prepend_instrs: t => list Sil.instr => unit;
+
+  /** Add declarations for local variables and return variable to the node */
+  let add_locals_ret_declaration: t => list (Mangled.t, Sil.typ) => unit;
+
+  /** Compare two nodes */
+  let compare: t => t => int;
+
+  /** [create cfg loc kind instrs proc_desc] create a new cfg node
+      with the given location, kind, list of instructions,
+      procdesc */
+  let create: cfg => Location.t => nodekind => list Sil.instr => Procdesc.t => t;
+
+  /** create a new empty cfg */
+  let create_cfg: unit => cfg;
+
+  /** Dump extended instructions for the node */
+  let d_instrs: sub_instrs::bool => option Sil.instr => t => unit;
+
+  /** Create a dummy node */
+  let dummy: unit => t;
+
+  /** Check if two nodes are equal */
+  let equal: t => t => bool;
+
+  /** Get all the nodes */
+  let get_all_nodes: cfg => list t;
+
+  /** Get the (after/before) dead program variables.
+      After/before indicated with the true/false flag. */
+  let get_dead_pvars: t => bool => list Pvar.t;
+
+  /** Get the distance to the exit node, if it has been computed */
+  let get_distance_to_exit: t => option int;
+
+  /** Return a description of the node */
+  let get_description: printenv => t => string;
+
+  /** Get the exception nodes from the current node */
+  let get_exn: t => list t;
+
+  /** Get the unique id of the node */
+  let get_id: t => id;
+
+  /** compare node ids */
+  let id_compare: id => id => int;
+
+  /** Get the source location of the node */
+  let get_loc: t => Location.t;
+
+  /** Get the source location of the last instruction in the node */
+  let get_last_loc: t => Location.t;
+
+  /** Get the kind of the current node */
+  let get_kind: t => nodekind;
+
+  /** Get the predecessor nodes of the current node */
+  let get_preds: t => list t;
+
+  /** Get a list of unique nodes until the first branch starting
+      from a node with subsequent applications of a generator function */
+  let get_generated_slope: t => (t => list t) => list t;
+
+  /** Get the proc desc associated to the node */
+  let get_proc_desc: t => Procdesc.t;
+
+  /** Get the instructions to be executed */
+  let get_instrs: t => list Sil.instr;
+
+  /** Get the list of callee procnames from the node */
+  let get_callees: t => list Procname.t;
+
+  /** Get the successor nodes of the current node */
+  let get_succs: t => list t;
+
+  /** Get the successor nodes of a node where the given predicate evaluates to true */
+  let get_sliced_succs: t => (t => bool) => list t;
+
+  /** Get the predecessor nodes of a node where the given predicate evaluates to true */
+  let get_sliced_preds: t => (t => bool) => list t;
+
+  /** Hash function for nodes */
+  let hash: t => int;
+
+  /** Comparison for node kind */
+  let kind_compare: nodekind => nodekind => int;
+
+  /** Pretty print the node */
+  let pp: Format.formatter => t => unit;
+  let pp_id: Format.formatter => id => unit;
+
+  /** Print extended instructions for the node,
+      highlighting the given subinstruction if present */
+  let pp_instrs: printenv => sub_instrs::bool => option Sil.instr => Format.formatter => t => unit;
+
+  /** Replace the instructions to be executed. */
+  let replace_instrs: t => list Sil.instr => unit;
+
+  /** Set the (after/before) dead program variables.
+      After/before indicated with the true/false flag. */
+  let set_dead_pvars: t => bool => list Pvar.t => unit;
+
+  /** Set the node kind */
+  let set_kind: t => nodekind => unit;
+
+  /** Set the source location of the node */
+  let set_loc: t => Location.t => unit;
+
+  /** Set the proc desc associated to the node */
+  let set_proc_desc: t => Procdesc.t => unit;
+
+  /** Set the successor nodes and exception nodes, and build predecessor links */
+  let set_succs_exn: cfg => t => list t => list t => unit;
+};
+
+
+/** Hash table with nodes as keys. */
+let module NodeHash: Hashtbl.S with type key = Node.t;
+
+
+/** Set of nodes. */
+let module NodeSet: Set.S with type elt = Node.t;
+
+
+/** Map with node id keys. */
+let module IdMap: Map.S with type key = Node.id;
+
+let pp_node_list: Format.formatter => list Node.t => unit;
+
+
+/** {2 Functions for manipulating an interprocedural CFG} */
+/** Iterate over all the procdesc's */
+let iter_proc_desc: cfg => (Procname.t => Procdesc.t => unit) => unit;
+
+
+/** Get all the procedures (defined and declared) */
+let get_all_procs: cfg => list Procdesc.t;
+
+
+/** Get the procedures whose body is defined in this cfg */
+let get_defined_procs: cfg => list Procdesc.t;
+
+
+/** get the function names which should be analyzed before the other ones */
+let get_priority_procnames: cfg => Procname.Set.t;
+
+
+/** set the function names whose address has been taken in this file */
+let set_procname_priority: cfg => Procname.t => unit;
+
+
+/** remove the return variable from the prop */
+let remove_ret: Procdesc.t => Prop.t Prop.normal => Prop.t Prop.normal;
+
+
+/** remove locals and return variable from the prop */
+let remove_locals_ret: Procdesc.t => Prop.t Prop.normal => Prop.t Prop.normal;
+
+
+/** 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 remove_locals_formals: Procdesc.t => Prop.t Prop.normal => (list Pvar.t, Prop.t Prop.normal);
+
+
+/** remove seed vars from a prop */
+let remove_seed_vars: Prop.t 'a => Prop.t Prop.normal;
+
+
+/** checks whether a cfg is connected or not */
+let check_cfg_connectedness: cfg => unit;
+
+
+/** Removes seeds variables from a prop corresponding to captured variables in an objc block */
+let remove_seed_captured_vars_block: list Mangled.t => Prop.t Prop.normal => Prop.t Prop.normal;
+
+
+/** 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 procdesc is isomorphic but
+    all the type of the parameters are replaced in the instructions according to the list.
+    The virtual calls are also replaced to match the parameter types */
+let specialize_types: Procdesc.t => Procname.t => list (Sil.exp, Sil.typ) => Procdesc.t;

infer/src/IR/Cg.re

@@ -0,0 +1,435 @@
+/*
+ * Copyright (c) 2009 - 2013 Monoidics ltd.
+ * Copyright (c) 2013 - present Facebook, Inc.
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+
+open! Utils;
+
+
+/** Module for call graphs */
+let module L = Logging;
+
+let module F = Format;
+
+type node = Procname.t;
+
+type in_out_calls = {
+  in_calls: int, /** total number of in calls transitively */
+  out_calls: int /** total number of out calls transitively */
+};
+
+type node_info = {
+  /** defined procedure as opposed to just declared */
+  mutable defined: bool,
+  mutable parents: Procname.Set.t,
+  mutable children: Procname.Set.t,
+  /** ancestors are computed lazily */
+  mutable ancestors: option Procname.Set.t,
+  /** heirs are computed lazily */
+  mutable heirs: option Procname.Set.t,
+  /** recursive dependents are computed lazily */
+  mutable recursive_dependents: option Procname.Set.t,
+  /** calls are computed lazily */
+  mutable in_out_calls: option in_out_calls
+};
+
+
+/** Type for call graph */
+type t = {
+  mutable source: DB.source_file, /** path for the source file */
+  mutable nLOC: int, /** number of LOC */
+  node_map: Procname.Hash.t node_info /** map from node to node_info */
+};
+
+let create () => {source: !DB.current_source, nLOC: !Config.nLOC, node_map: Procname.Hash.create 3};
+
+let add_node g n defined::defined =>
+  try {
+    let info = Procname.Hash.find g.node_map n;
+    /* defined and disabled only go from false to true
+       to avoid accidental overwrite to false by calling add_edge */
+    if defined {
+      info.defined = true
+    }
+  } {
+  | Not_found =>
+    let info = {
+      defined,
+      parents: Procname.Set.empty,
+      children: Procname.Set.empty,
+      ancestors: None,
+      heirs: None,
+      recursive_dependents: None,
+      in_out_calls: None
+    };
+    Procname.Hash.add g.node_map n info
+  };
+
+let add_defined_node g n => add_node g n defined::true;
+
+
+/** Compute the ancestors of the node, if not already computed */
+let compute_ancestors g node => {
+  let todo = ref (Procname.Set.singleton node);
+  let seen = ref Procname.Set.empty;
+  let result = ref Procname.Set.empty;
+  while (not (Procname.Set.is_empty !todo)) {
+    let current = Procname.Set.choose !todo;
+    todo := Procname.Set.remove current !todo;
+    if (not (Procname.Set.mem current !seen)) {
+      seen := Procname.Set.add current !seen;
+      let info = Procname.Hash.find g current;
+      switch info.ancestors {
+      | Some ancestors => result := Procname.Set.union !result ancestors
+      | None =>
+        result := Procname.Set.union !result info.parents;
+        todo := Procname.Set.union !todo info.parents
+      }
+    }
+  };
+  !result
+};
+
+
+/** Compute the heirs of the node, if not already computed */
+let compute_heirs g node => {
+  let todo = ref (Procname.Set.singleton node);
+  let seen = ref Procname.Set.empty;
+  let result = ref Procname.Set.empty;
+  while (not (Procname.Set.is_empty !todo)) {
+    let current = Procname.Set.choose !todo;
+    todo := Procname.Set.remove current !todo;
+    if (not (Procname.Set.mem current !seen)) {
+      seen := Procname.Set.add current !seen;
+      let info = Procname.Hash.find g current;
+      switch info.heirs {
+      | Some heirs => result := Procname.Set.union !result heirs
+      | None =>
+        result := Procname.Set.union !result info.children;
+        todo := Procname.Set.union !todo info.children
+      }
+    }
+  };
+  !result
+};
+
+
+/** Compute the ancestors of the node, if not pre-computed already */
+let get_ancestors (g: t) node => {
+  let info = Procname.Hash.find g.node_map node;
+  switch info.ancestors {
+  | None =>
+    let ancestors = compute_ancestors g.node_map node;
+    info.ancestors = Some ancestors;
+    let size = Procname.Set.cardinal ancestors;
+    if (size > 1000) {
+      L.err "%a has %d ancestors@." Procname.pp node size
+    };
+    ancestors
+  | Some ancestors => ancestors
+  }
+};
+
+
+/** Compute the heirs of the node, if not pre-computed already */
+let get_heirs (g: t) node => {
+  let info = Procname.Hash.find g.node_map node;
+  switch info.heirs {
+  | None =>
+    let heirs = compute_heirs g.node_map node;
+    info.heirs = Some heirs;
+    let size = Procname.Set.cardinal heirs;
+    if (size > 1000) {
+      L.err "%a has %d heirs@." Procname.pp node size
+    };
+    heirs
+  | Some heirs => heirs
+  }
+};
+
+let node_defined (g: t) n =>
+  try {
+    let info = Procname.Hash.find g.node_map n;
+    info.defined
+  } {
+  | Not_found => false
+  };
+
+let add_edge g nfrom nto => {
+  add_node g nfrom defined::false;
+  add_node g nto defined::false;
+  let info_from = Procname.Hash.find g.node_map nfrom;
+  let info_to = Procname.Hash.find g.node_map nto;
+  info_from.children = Procname.Set.add nto info_from.children;
+  info_to.parents = 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 [];
+  Procname.Hash.iter (fun node info => table := [(node, info), ...!table]) g.node_map;
+  let cmp (n1: Procname.t, _) (n2: Procname.t, _) => Procname.compare n1 n2;
+  IList.iter (fun (n, info) => f n info) (IList.sort cmp !table)
+};
+
+let get_nodes (g: t) => {
+  let nodes = ref Procname.Set.empty;
+  let f node _ => nodes := Procname.Set.add node !nodes;
+  node_map_iter f g;
+  !nodes
+};
+
+let compute_calls g node => {
+  in_calls: Procname.Set.cardinal (get_ancestors g node),
+  out_calls: 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 = Procname.Hash.find g.node_map node;
+  switch info.in_out_calls {
+  | None =>
+    let calls = compute_calls g node;
+    info.in_out_calls = Some calls;
+    calls
+  | Some calls => calls
+  }
+};
+
+let get_all_nodes (g: t) => {
+  let nodes = Procname.Set.elements (get_nodes g);
+  IList.map (fun node => (node, get_calls g node)) nodes
+};
+
+let get_nodes_and_calls (g: t) => IList.filter (fun (n, _) => node_defined g n) (get_all_nodes g);
+
+let node_get_num_ancestors g n => (n, Procname.Set.cardinal (get_ancestors g n));
+
+let get_edges (g: t) :list ((node, int), (node, int)) => {
+  let edges = ref [];
+  let f node info =>
+    Procname.Set.iter
+      (
+        fun nto => edges := [
+          (node_get_num_ancestors g node, node_get_num_ancestors g nto),
+          ...!edges
+        ]
+      )
+      info.children;
+  node_map_iter f g;
+  !edges
+};
+
+
+/** Return all the children of [n], whether defined or not */
+let get_all_children (g: t) n => (Procname.Hash.find g.node_map n).children;
+
+
+/** Return the children of [n] which are defined */
+let get_defined_children (g: t) n => Procname.Set.filter (node_defined g) (get_all_children g n);
+
+
+/** Return the parents of [n] */
+let get_parents (g: t) n => (Procname.Hash.find g.node_map n).parents;
+
+
+/** Check if [source] recursively calls [dest] */
+let calls_recursively (g: t) source dest => Procname.Set.mem source (get_ancestors g dest);
+
+
+/** Return the children of [n] which are not heirs of [n] */
+let get_nonrecursive_dependents (g: t) n => {
+  let is_not_recursive pn => not (Procname.Set.mem pn (get_ancestors g n));
+  let res0 = Procname.Set.filter is_not_recursive (get_all_children g n);
+  let res = Procname.Set.filter (node_defined g) res0;
+  res
+};
+
+
+/** Return the ancestors of [n] which are also heirs of [n] */
+let compute_recursive_dependents (g: t) n => {
+  let reached_from_n pn => Procname.Set.mem n (get_ancestors g pn);
+  let res0 = Procname.Set.filter reached_from_n (get_ancestors g n);
+  let res = Procname.Set.filter (node_defined g) res0;
+  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 = Procname.Hash.find g.node_map n;
+  switch info.recursive_dependents {
+  | None =>
+    let recursive_dependents = compute_recursive_dependents g n;
+    info.recursive_dependents = Some recursive_dependents;
+    recursive_dependents
+  | Some recursive_dependents => recursive_dependents
+  }
+};
+
+
+/** Return the nodes dependent on [n] */
+let get_dependents (g: t) n =>
+  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 Procname.Set.empty;
+  node_map_iter
+    (
+      fun n info =>
+        if info.defined {
+          nodes := Procname.Set.add n !nodes
+        }
+    )
+    g;
+  let nodes_list = Procname.Set.elements !nodes;
+  IList.map (fun n => (n, get_defined_children g n)) nodes_list
+};
+
+
+/** nodes with defined flag, and edges */
+type nodes_and_edges = (list (node, bool), list (node, node));
+
+
+/** Return the list of nodes, with defined+disabled flags, and the list of edges */
+let get_nodes_and_edges (g: t) :nodes_and_edges => {
+  let nodes = ref [];
+  let edges = ref [];
+  let do_children node nto => edges := [(node, nto), ...!edges];
+  let f node info => {
+    nodes := [(node, info.defined), ...!nodes];
+    Procname.Set.iter (do_children node) info.children
+  };
+  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;
+  let get_node (node, _) => node;
+  IList.map get_node (IList.filter (fun (_, defined) => defined) nodes)
+};
+
+
+/** Return the path of the source file */
+let get_source (g: t) => g.source;
+
+
+/** Return the number of LOC of the source file */
+let get_nLOC (g: t) => g.nLOC;
+
+
+/** [extend cg1 gc2] extends [cg1] in place with nodes and edges from [gc2];
+    undefined nodes become defined if at least one side is. */
+let extend cg_old cg_new => {
+  let (nodes, edges) = get_nodes_and_edges cg_new;
+  IList.iter (fun (node, defined) => add_node cg_old node defined::defined) nodes;
+  IList.iter (fun (nfrom, nto) => add_edge cg_old nfrom nto) edges
+};
+
+
+/** Begin support for serialization */
+let callgraph_serializer: Serialization.serializer (DB.source_file, int, nodes_and_edges) = Serialization.create_serializer Serialization.cg_key;
+
+
+/** Load a call graph from a file */
+let load_from_file (filename: DB.filename) :option t => {
+  let g = create ();
+  switch (Serialization.from_file callgraph_serializer filename) {
+  | None => None
+  | Some (source, nLOC, (nodes, edges)) =>
+    IList.iter
+      (
+        fun (node, defined) =>
+          if defined {
+            add_defined_node g node
+          }
+      )
+      nodes;
+    IList.iter (fun (nfrom, nto) => add_edge g nfrom nto) edges;
+    g.source = source;
+    g.nLOC = nLOC;
+    Some g
+  }
+};
+
+
+/** Save a call graph into a file */
+let store_to_file (filename: DB.filename) (call_graph: t) =>
+  Serialization.to_file
+    callgraph_serializer
+    filename
+    (call_graph.source, call_graph.nLOC, get_nodes_and_edges call_graph);
+
+let pp_graph_dotty get_specs (g: t) fmt => {
+  let nodes_with_calls = get_all_nodes g;
+  let num_specs n =>
+    try (IList.length (get_specs n)) {
+    | exn when SymOp.exn_not_failure exn => (-1)
+    };
+  let get_color (n, _) =>
+    if (num_specs n !== 0) {
+      "green"
+    } else {
+      "red"
+    };
+  let get_shape (n, _) =>
+    if (node_defined g n) {
+      "box"
+    } else {
+      "diamond"
+    };
+  let pp_node fmt (n, _) => F.fprintf fmt "\"%s\"" (Procname.to_filename n);
+  let pp_node_label fmt (n, calls) =>
+    F.fprintf
+      fmt
+      "\"%a | calls=%d %d | specs=%d)\""
+      Procname.pp
+      n
+      calls.in_calls
+      calls.out_calls
+      (num_specs n);
+  F.fprintf fmt "digraph {@\n";
+  IList.iter
+    (
+      fun nc =>
+        F.fprintf
+          fmt
+          "%a [shape=box,label=%a,color=%s,shape=%s]@\n"
+          pp_node
+          nc
+          pp_node_label
+          nc
+          (get_color nc)
+          (get_shape nc)
+    )
+    nodes_with_calls;
+  IList.iter (fun (s, d) => F.fprintf fmt "%a -> %a@\n" pp_node s pp_node d) (get_edges g);
+  F.fprintf fmt "}@."
+};
+
+
+/** Print the current call graph as a dotty file.
+    If the filename is [None], use the current file dir inside the DB dir. */
+let save_call_graph_dotty fname_opt get_specs (g: t) => {
+  let fname_dot =
+    switch fname_opt {
+    | None => DB.Results_dir.path_to_filename DB.Results_dir.Abs_source_dir ["call_graph.dot"]
+    | Some fname => fname
+    };
+  let outc = open_out (DB.filename_to_string fname_dot);
+  let fmt = F.formatter_of_out_channel outc;
+  pp_graph_dotty get_specs g fmt;
+  close_out outc
+};

infer/src/IR/Cg.rei

@@ -0,0 +1,125 @@
+/*
+ * Copyright (c) 2009 - 2013 Monoidics ltd.
+ * Copyright (c) 2013 - present Facebook, Inc.
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+
+open! Utils;
+
+
+/** Module for call graphs */
+type in_out_calls = {
+  in_calls: int, /** total number of in calls transitively */
+  out_calls: int /** total number of out calls transitively */
+};
+
+type t; /** the type of a call graph */
+
+
+/** A call graph consists of a set of nodes (Procname.t), and edges between them.
+    A node can be defined or undefined (to represent whether we have code for it).
+    In an edge from [n1] to [n2], indicating that [n1] calls [n2],
+    [n1] is the parent and [n2] is the child.
+    Node [n1] is dependent on [n2] if there is a path from [n1] to [n2]
+    using the child relationship. */
+/** [add_edge cg f t] adds an edge from [f] to [t] in the call graph [cg].
+    The nodes are also added as undefined, unless already present. */
+let add_edge: t => Procname.t => Procname.t => unit;
+
+
+/** Add a node to the call graph as defined */
+let add_defined_node: t => Procname.t => unit;
+
+
+/** Check if [source] recursively calls [dest] */
+let calls_recursively: t => Procname.t => Procname.t => bool;
+
+
+/** Create an empty call graph */
+let create: unit => t;
+
+
+/** [extend cg1 gc2] extends [cg1] in place with nodes and edges from [gc2];
+    undefined nodes become defined if at least one side is. */
+let extend: t => t => unit;
+
+
+/** Return all the children of [n], whether defined or not */
+let get_all_children: t => Procname.t => Procname.Set.t;
+
+
+/** Compute the ancestors of the node, if not pre-computed already */
+let get_ancestors: t => Procname.t => Procname.Set.t;
+
+
+/** Compute the heirs of the node, if not pre-computed already */
+let get_heirs: t => Procname.t => Procname.Set.t;
+
+
+/** Return the in/out calls of the node */
+let get_calls: t => Procname.t => in_out_calls;
+
+
+/** Return the list of nodes which are defined */
+let get_defined_nodes: t => list Procname.t;
+
+
+/** Return the children of [n] which are defined */
+let get_defined_children: t => Procname.t => Procname.Set.t;
+
+
+/** Return the nodes dependent on [n] */
+let get_dependents: t => Procname.t => Procname.Set.t;
+
+
+/** Return the number of LOC of the source file */
+let get_nLOC: t => int;
+
+
+/** Return the list of nodes with calls */
+let get_nodes_and_calls: t => list (Procname.t, in_out_calls);
+
+
+/** Return all the nodes with their defined children */
+let get_nodes_and_defined_children: t => list (Procname.t, Procname.Set.t);
+
+
+/** Return the list of nodes, with defined flag, and the list of edges */
+let get_nodes_and_edges: t => (list (Procname.t, bool), list (Procname.t, Procname.t));
+
+
+/** Return the children of [n] which are not heirs of [n] and are defined */
+let get_nonrecursive_dependents: t => Procname.t => Procname.Set.t;
+
+
+/** Return the parents of [n] */
+let get_parents: t => Procname.t => Procname.Set.t;
+
+
+/** Return the ancestors of [n] which are also heirs of [n] */
+let get_recursive_dependents: t => Procname.t => Procname.Set.t;
+
+
+/** Return the path of the source file */
+let get_source: t => DB.source_file;
+
+
+/** Load a call graph from a file */
+let load_from_file: DB.filename => option t;
+
+
+/** Returns true if the node is defined */
+let node_defined: t => Procname.t => bool;
+
+
+/** Print the current call graph as a dotty file. If the filename is [None],
+    use the current file dir inside the DB dir. */
+let save_call_graph_dotty: option DB.filename => (Procname.t => list 'a) => t => unit;
+
+
+/** Save a call graph into a file */
+let store_to_file: DB.filename => t => unit;

infer/src/IR/Csu.re

@@ -0,0 +1,49 @@
+/*
+ * Copyright (c) 2015 - present Facebook, Inc.
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+
+open! Utils;
+
+
+/** Internal representation of data structure for Java, Objective-C and C++ classes,
+    C-style structs struct and union,
+    And Objective C protocol */
+type class_kind = | CPP | Java | Objc;
+
+type t = | Class of class_kind | Struct | Union | Protocol;
+
+let name =
+  fun
+  | Class _ => "class"
+  | Struct => "struct"
+  | Union => "union"
+  | Protocol => "protocol";
+
+let class_kind_num =
+  fun
+  | CPP => 1
+  | Java => 2
+  | Objc => 3;
+
+let class_kind_compare ck1 ck2 => class_kind_num ck1 - class_kind_num ck2;
+
+let compare dstruct1 dstruct2 =>
+  switch (dstruct1, dstruct2) {
+  | (Class ck1, Class ck2) => class_kind_compare ck1 ck2
+  | (Class _, _) => (-1)
+  | (_, Class _) => 1
+  | (Struct, Struct) => 0
+  | (Struct, _) => (-1)
+  | (_, Struct) => 1
+  | (Union, Union) => 0
+  | (Union, _) => (-1)
+  | (_, Union) => 1
+  | (Protocol, Protocol) => 0
+  };
+
+let equal tn1 tn2 => compare tn1 tn2 == 0;

infer/src/IR/Csu.rei

@@ -1,31 +1,24 @@
-(*
+/*
  * Copyright (c) 2015 - present Facebook, Inc.
  * All rights reserved.
  *
  * This source code is licensed under the BSD style license found in the
  * LICENSE file in the root directory of this source tree. An additional grant
  * of patent rights can be found in the PATENTS file in the same directory.
- *)
+ */
 
-open! Utils
+open! Utils;
 
-(** Internal representation of data structure for Java, Objective-C and C++ classes,
-    C-style structs struct and union,
-    And Objective C protocol *)
 
-type class_kind =
+/** Internal representation of data structure for Java, Objective-C and C++ classes,
-  | CPP
+    C-style structs struct and union,
-  | Java
+    And Objective C protocol */
-  | Objc
+type class_kind = | CPP | Java | Objc;
 
-type t =
+type t = | Class of class_kind | Struct | Union | Protocol;
-  | Class of class_kind
-  | Struct
-  | Union
-  | Protocol
 
-val name : t -> string
+let name: t => string;
 
-val compare : t -> t -> int
+let compare: t => t => int;
 
-val equal : t -> t -> bool
+let equal: t => t => bool;

infer/src/IR/Ident.re

@@ -0,0 +1,415 @@
+/*
+ * Copyright (c) 2009 - 2013 Monoidics ltd.
+ * Copyright (c) 2013 - present Facebook, Inc.
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+
+open! Utils;
+
+
+/** Module for Names and Identifiers */
+let module L = Logging;
+
+let module F = Format;
+
+type name = string;
+
+type fieldname = {fpos: int, fname: Mangled.t};
+
+type kind = int;
+
+let kprimed = (-1);
+
+let knormal = 0;
+
+let kfootprint = 1;
+
+type t = {kind: int, name: name, stamp: int};
+
+type _ident = t;
+
+
+/** {2 Comparison Functions} */
+let name_compare = string_compare;
+
+let fieldname_compare fn1 fn2 => {
+  let n = int_compare fn1.fpos fn2.fpos;
+  if (n != 0) {
+    n
+  } else {
+    Mangled.compare fn1.fname fn2.fname
+  }
+};
+
+let name_equal = string_equal;
+
+let kind_equal k1 k2 => k1 === k2;
+
+let compare i1 i2 => {
+  let n = i2.kind - i1.kind;
+  if (n != 0) {
+    n
+  } else {
+    let n = name_compare i1.name i2.name;
+    if (n != 0) {
+      n
+    } else {
+      int_compare i1.stamp i2.stamp
+    }
+  }
+};
+
+let equal i1 i2 =>
+  i1.stamp === i2.stamp && i1.kind === i2.kind && name_equal i1.name i2.name
+  /* most unlikely first */;
+
+let fieldname_equal fn1 fn2 => fieldname_compare fn1 fn2 == 0;
+
+let rec ident_list_compare il1 il2 =>
+  switch (il1, il2) {
+  | ([], []) => 0
+  | ([], _) => (-1)
+  | (_, []) => 1
+  | ([i1, ...l1], [i2, ...l2]) =>
+    let n = compare i1 i2;
+    if (n != 0) {
+      n
+    } else {
+      ident_list_compare l1 l2
+    }
+  };
+
+let ident_list_equal ids1 ids2 => ident_list_compare ids1 ids2 == 0;
+
+
+/** {2 Set for identifiers} */
+let module IdentSet = Set.Make {
+  type t = _ident;
+  let compare = compare;
+};
+
+let module IdentMap = Map.Make {
+  type t = _ident;
+  let compare = compare;
+};
+
+let module IdentHash = Hashtbl.Make {
+  type t = _ident;
+  let equal = equal;
+  let hash (id: t) => Hashtbl.hash id;
+};
+
+let module FieldSet = Set.Make {
+  type t = fieldname;
+  let compare = fieldname_compare;
+};
+
+let module FieldMap = Map.Make {
+  type t = fieldname;
+  let compare = fieldname_compare;
+};
+
+let idlist_to_idset ids => IList.fold_left (fun set id => IdentSet.add id set) IdentSet.empty ids;
+
+
+/** {2 Conversion between Names and Strings} */
+let module StringHash = Hashtbl.Make {
+  type t = string;
+  let equal (s1: string) (s2: string) => s1 == s2;
+  let hash = Hashtbl.hash;
+};
+
+let module NameHash = Hashtbl.Make {
+  type t = name;
+  let equal = name_equal;
+  let hash = Hashtbl.hash;
+};
+
+
+/** Convert a string to a name */
+let string_to_name (s: string) => s;
+
+
+/** Create a field name with the given position (field number in the CSU) */
+let create_fieldname (n: Mangled.t) (position: int) => {fpos: position, fname: n};
+
+
+/** Convert a name to a string. */
+let name_to_string (name: name) => name;
+
+
+/** Convert a fieldname to a string. */
+let fieldname_to_string fn => Mangled.to_string fn.fname;
+
+
+/** Convert a fieldname to a simplified string with at most one-level path. */
+let fieldname_to_simplified_string fn => {
+  let s = Mangled.to_string fn.fname;
+  switch (string_split_character s '.') {
+  | (Some s1, s2) =>
+    switch (string_split_character s1 '.') {
+    | (Some _, s4) => s4 ^ "." ^ s2
+    | _ => s
+    }
+  | _ => s
+  }
+};
+
+
+/** Convert a fieldname to a flat string without path. */
+let fieldname_to_flat_string fn => {
+  let s = Mangled.to_string fn.fname;
+  switch (string_split_character s '.') {
+  | (Some _, s2) => s2
+  | _ => s
+  }
+};
+
+
+/** Returns the class part of the fieldname */
+let java_fieldname_get_class fn => {
+  let fn = fieldname_to_string fn;
+  let ri = String.rindex fn '.';
+  String.sub fn 0 ri
+};
+
+
+/** Returns the last component of the fieldname */
+let java_fieldname_get_field fn => {
+  let fn = fieldname_to_string fn;
+  let ri = 1 + String.rindex fn '.';
+  String.sub fn ri (String.length fn - ri)
+};
+
+
+/** Check if the field is the synthetic this$n of a nested class, used to access the n-th outher instance. */
+let java_fieldname_is_outer_instance fn => {
+  let fn = fieldname_to_string fn;
+  let fn_len = String.length fn;
+  let this = ".this$";
+  let this_len = String.length this;
+  let zero_to_nine s => s >= "0" && s <= "9";
+  fn_len > this_len &&
+    String.sub fn (fn_len - this_len - 1) this_len == this &&
+    zero_to_nine (String.sub fn (fn_len - 1) 1)
+};
+
+let fieldname_offset fn => fn.fpos;
+
+
+/** hidded fieldname constant */
+let fieldname_hidden = create_fieldname (Mangled.from_string ".hidden") 0;
+
+
+/** hidded fieldname constant */
+let fieldname_is_hidden fn => fieldname_equal fn fieldname_hidden;
+
+
+/** {2 Functions and Hash Tables for Managing Stamps} */
+/** Set the stamp of the identifier */
+let set_stamp i stamp => {...i, stamp};
+
+
+/** Get the stamp of the identifier */
+let get_stamp i => i.stamp;
+
+let module NameGenerator = {
+  type t = NameHash.t int;
+  let create () :t => NameHash.create 17;
+
+  /** Map from names to stamps. */
+  let name_map = ref (create ());
+  let get_current () => !name_map;
+  let set_current map => name_map := map;
+
+  /** Reset the name generator */
+  let reset () => name_map := create ();
+
+  /** Create a fresh identifier with the given kind and name. */
+  let create_fresh_ident kind name => {
+    let stamp =
+      try {
+        let stamp = NameHash.find !name_map name;
+        NameHash.replace !name_map name (stamp + 1);
+        stamp + 1
+      } {
+      | Not_found =>
+        NameHash.add !name_map name 0;
+        0
+      };
+    {kind, name, stamp}
+  };
+
+  /** Make sure that fresh ids after whis one will be with different stamps */
+  let update_name_hash name stamp =>
+    try {
+      let curr_stamp = NameHash.find !name_map name;
+      let new_stamp = max curr_stamp stamp;
+      NameHash.replace !name_map name new_stamp
+    } {
+    | Not_found => NameHash.add !name_map name stamp
+    };
+};
+
+
+/** Name used for primed tmp variables */
+let name_primed = string_to_name "t";
+
+
+/** Name used for normal tmp variables */
+let name_normal = string_to_name "n";
+
+
+/** Name used for footprint tmp variables */
+let name_footprint = string_to_name "f";
+
+
+/** Name used for spec variables */
+let name_spec = string_to_name "val";
+
+
+/** Name used for the return variable */
+let name_return = Mangled.from_string "return";
+
+
+/** Return the standard name for the given kind */
+let standard_name kind =>
+  if (kind === knormal) {
+    name_normal
+  } else if (kind === kfootprint) {
+    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}
+};
+
+
+/** Create an identifier with default name for the given kind */
+let create kind stamp => create_with_stamp kind (standard_name kind) stamp;
+
+
+/** Generate a normal identifier with the given name and stamp */
+let create_normal name stamp => create_with_stamp knormal name stamp;
+
+
+/** Generate a primed identifier with the given name and stamp */
+let create_primed name stamp => create_with_stamp kprimed name stamp;
+
+
+/** Generate a footprint identifier with the given name and stamp */
+let create_footprint name stamp => create_with_stamp kfootprint name stamp;
+
+
+/** {2 Functions for Identifiers} */
+/** Get a name of an identifier */
+let get_name id => id.name;
+
+let get_kind id => id.kind;
+
+let is_primed (id: t) => id.kind === kprimed;
+
+let is_normal (id: t) => id.kind === knormal;
+
+let is_footprint (id: t) => id.kind === kfootprint;
+
+/* timestamp for a path identifier */
+let path_ident_stamp = (-3);
+
+let is_path (id: t) => id.kind === knormal && id.stamp == path_ident_stamp;
+
+let make_unprimed id =>
+  if (id.kind != kprimed) {
+    assert false
+  } else {
+    {...id, 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);
+  IList.iter upd ids
+};
+
+
+/** Create a fresh identifier with default name for the given kind. */
+let create_fresh kind => NameGenerator.create_fresh_ident kind (standard_name kind);
+
+
+/** 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. */
+let to_string id => {
+  let base_name = name_to_string id.name;
+  let prefix =
+    if (id.kind === kfootprint) {
+      "@"
+    } else if (id.kind === knormal) {
+      ""
+    } else {
+      "_"
+    };
+  let suffix = "$" ^ string_of_int id.stamp;
+  prefix ^ base_name ^ suffix
+};
+
+
+/** Pretty print a name. */
+let pp_name f name => F.fprintf f "%s" (name_to_string name);
+
+let pp_fieldname f fn =>
+  /* only use for debug F.fprintf f "%a#%d" pp_name fn.fname fn.fpos */
+  Mangled.pp f fn.fname;
+
+
+/** Pretty print a name in latex. */
+let pp_name_latex style f (name: name) => Latex.pp_string style f (name_to_string name);
+
+let pp_fieldname_latex style f fn => Latex.pp_string style f (Mangled.to_string fn.fname);
+
+
+/** Pretty print an identifier. */
+let pp pe f id =>
+  switch pe.pe_kind {
+  | PP_TEXT
+  | PP_HTML => F.fprintf f "%s" (to_string id)
+  | PP_LATEX =>
+    let base_name = name_to_string id.name;
+    let style =
+      if (id.kind == kfootprint) {
+        Latex.Boldface
+      } else if (id.kind == knormal) {
+        Latex.Roman
+      } else {
+        Latex.Roman
+      };
+    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);
+
+
+/** pretty printer for lists of names */
+let pp_name_list = pp_comma_seq pp_name;
+
+/*
+ let make_ident_primed id =
+   if id.kind == kprimed then assert false
+   else { id with kind = kprimed }
+ */

infer/src/IR/Ident.rei

@@ -0,0 +1,269 @@
+/*
+ * Copyright (c) 2009 - 2013 Monoidics ltd.
+ * Copyright (c) 2013 - present Facebook, Inc.
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+
+open! Utils;
+
+
+/** Identifiers: program variables and logical variables */
+/** Program and logical variables. */
+type t;
+
+
+/** Names used to replace strings. */
+type name;
+
+
+/** Names for fields of class/struct/union */
+type fieldname;
+
+
+/** Kind of identifiers. */
+type kind;
+
+
+/** Set for identifiers. */
+let module IdentSet: Set.S with type elt = t;
+
+
+/** Hash table with ident as key. */
+let module IdentHash: Hashtbl.S with type key = t;
+
+
+/** Map with ident as key. */
+let module IdentMap: Map.S with type key = t;
+
+
+/** Set for fieldnames */
+let module FieldSet: Set.S with type elt = fieldname;
+
+
+/** Map for fieldnames */
+let module FieldMap: Map.S with type key = fieldname;
+
+let module NameGenerator: {
+  type t;
+
+  /** Get the current name generator. */
+  let get_current: unit => t;
+
+  /** Reset the name generator. */
+  let reset: unit => unit;
+
+  /** Set the current name generator. */
+  let set_current: t => unit;
+};
+
+
+/** Convert an identfier list to an identifier set */
+let idlist_to_idset: list t => IdentSet.t;
+
+let kprimed: kind;
+
+let knormal: kind;
+
+let kfootprint: kind;
+
+
+/** hash table with names as keys */
+let module NameHash: Hashtbl.S with type key = name;
+
+
+/** Name used for primed tmp variables */
+let name_primed: name;
+
+
+/** Name used for spec variables */
+let name_spec: name;
+
+
+/** Name used for the return variable */
+let name_return: Mangled.t;
+
+
+/** Convert a string to a name. */
+let string_to_name: string => name;
+
+
+/** Create a field name at the given position */
+let create_fieldname: Mangled.t => int => fieldname;
+
+
+/** Convert a name to a string. */
+let name_to_string: name => string;
+
+
+/** Convert a field name to a string. */
+let fieldname_to_string: fieldname => string;
+
+
+/** Convert a fieldname to a simplified string with at most one-level path. */
+let fieldname_to_simplified_string: fieldname => string;
+
+
+/** Convert a fieldname to a flat string without path. */
+let fieldname_to_flat_string: fieldname => string;
+
+
+/** The class part of the fieldname */
+let java_fieldname_get_class: fieldname => string;
+
+
+/** The last component of the fieldname */
+let java_fieldname_get_field: fieldname => string;
+
+
+/** Check if the field is the synthetic this$n of a nested class, used to access the n-th outher instance. */
+let java_fieldname_is_outer_instance: fieldname => bool;
+
+
+/** get the offset of a fieldname */
+let fieldname_offset: fieldname => int;
+
+
+/** hidded fieldname constant */
+let fieldname_hidden: fieldname;
+
+
+/** hidded fieldname constant */
+let fieldname_is_hidden: fieldname => bool;
+
+
+/** Name of the identifier. */
+let get_name: t => name;
+
+
+/** Kind of the identifier. */
+let get_kind: t => kind;
+
+
+/** Create an identifier with default name for the given kind */
+let create: kind => int => t;
+
+
+/** Generate a normal identifier with the given name and stamp. */
+let create_normal: name => int => t;
+
+
+/** Generate a primed identifier with the given name and stamp. */
+let create_primed: name => int => t;
+
+
+/** Generate a footprint identifier with the given name and stamp. */
+let create_footprint: name => int => t;
+
+
+/** Update the name generator so that the given id's are not generated again */
+let update_name_generator: list t => unit;
+
+
+/** Create a fresh identifier with default name for the given kind. */
+let create_fresh: kind => t;
+
+
+/** Generate a normal identifier whose name encodes a path given as a string. */
+let create_path: string => t;
+
+
+/** Check whether an identifier is primed or not. */
+let is_primed: t => bool;
+
+
+/** Check whether an identifier is normal or not. */
+let is_normal: t => bool;
+
+
+/** Check whether an identifier is footprint or not. */
+let is_footprint: t => bool;
+
+
+/** Check whether an identifier represents a path or not. */
+let is_path: t => bool;
+
+
+/** Convert a primed ident into a nonprimed one, keeping the stamp. */
+let make_unprimed: t => t;
+
+
+/** Get the stamp of the identifier */
+let get_stamp: t => int;
+
+
+/** Set the stamp of the identifier */
+let set_stamp: t => int => t;
+
+
+/** {2 Comparision Functions} */
+/** Comparison for names. */
+let name_compare: name => name => int;
+
+
+/** Comparison for field names. */
+let fieldname_compare: fieldname => fieldname => int;
+
+
+/** Equality for names. */
+let name_equal: name => name => bool;
+
+
+/** Equality for field names. */
+let fieldname_equal: fieldname => fieldname => bool;
+
+
+/** Equality for kind. */
+let kind_equal: kind => kind => bool;
+
+
+/** Comparison for identifiers. */
+let compare: t => t => int;
+
+
+/** Equality for identifiers. */
+let equal: t => t => bool;
+
+
+/** Comparison for lists of identities */
+let ident_list_compare: list t => list t => int;
+
+
+/** Equality for lists of identities */
+let ident_list_equal: list t => list t => bool;
+
+
+/** {2 Pretty Printing} */
+/** Pretty print a name. */
+let pp_name: Format.formatter => name => unit;
+
+
+/** Pretty print a field name. */
+let pp_fieldname: Format.formatter => fieldname => unit;
+
+
+/** Pretty print a name in latex. */
+let pp_name_latex: Latex.style => Format.formatter => name => unit;
+
+
+/** Pretty print a field name in latex. */
+let pp_fieldname_latex: Latex.style => Format.formatter => fieldname => unit;
+
+
+/** Pretty print an identifier. */
+let pp: printenv => Format.formatter => t => unit;
+
+
+/** Convert an identifier to a string. */
+let to_string: t => string;
+
+
+/** Pretty print a list of identifiers. */
+let pp_list: printenv => Format.formatter => list t => unit;
+
+
+/** Pretty print a list of names. */
+let pp_name_list: Format.formatter => list name => unit;

infer/src/IR/Location.re

@@ -0,0 +1,55 @@
+/*
+ * Copyright (c) 2015 - present Facebook, Inc.
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+
+open! Utils;
+
+let module F = Format;
+
+let module L = Logging;
+
+
+/** Location in the original source file */
+type t = {
+  line: int, /** The line number. -1 means "do not know" */
+  col: int, /** The column number. -1 means "do not know" */
+  file: DB.source_file, /** The name of the source file */
+  nLOC: int /** Lines of code in the source file */
+};
+
+let compare loc1 loc2 => {
+  let n = int_compare loc1.line loc2.line;
+  if (n != 0) {
+    n
+  } else {
+    DB.source_file_compare loc1.file loc2.file
+  }
+};
+
+
+/** Dump a location */
+let d (loc: t) => L.add_print_action (L.PTloc, Obj.repr loc);
+
+
+/** Dummy location */
+let dummy = {line: (-1), col: (-1), file: DB.source_file_empty, nLOC: (-1)};
+
+let equal loc1 loc2 => compare loc1 loc2 == 0;
+
+
+/** Pretty print a location */
+let pp f (loc: t) => F.fprintf f "[line %d]" loc.line;
+
+let to_string loc => {
+  let s = string_of_int loc.line;
+  if (loc.col !== (-1)) {
+    s ^ ":" ^ string_of_int loc.col
+  } else {
+    s
+  }
+};

infer/src/IR/Location.rei

@@ -0,0 +1,39 @@
+/*
+ * Copyright (c) 2015 - present Facebook, Inc.
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+
+open! Utils;
+
+
+/** Location in the original source file */
+type t = {
+  line: int, /** The line number. -1 means "do not know" */
+  col: int, /** The column number. -1 means "do not know" */
+  file: DB.source_file, /** The name of the source file */
+  nLOC: int /** Lines of code in the source file */
+};
+
+let compare: t => t => int;
+
+
+/** Dump a location. */
+let d: t => unit;
+
+
+/** Dummy location */
+let dummy: t;
+
+let equal: t => t => bool;
+
+
+/** Pretty print a location. */
+let pp: Format.formatter => t => unit;
+
+
+/** String representation of a location. */
+let to_string: t => string;

infer/src/IR/Mangled.re

@@ -0,0 +1,87 @@
+/*
+ * Copyright (c) 2009 - 2013 Monoidics ltd.
+ * Copyright (c) 2013 - present Facebook, Inc.
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+
+open! Utils;
+
+
+/** Module for Mangled Names */
+let module F = Format;
+
+type t = {plain: string, mangled: option string};
+
+let mangled_compare so1 so2 =>
+  switch (so1, so2) {
+  | (None, None) => 0
+  | (None, Some _) => (-1)
+  | (Some _, None) => 1
+  | (Some s1, Some s2) => string_compare s1 s2
+  };
+
+let compare pn1 pn2 => {
+  let n = string_compare pn1.plain pn2.plain;
+  if (n != 0) {
+    n
+  } else {
+    mangled_compare pn1.mangled pn2.mangled
+  }
+};
+
+let equal pn1 pn2 => compare pn1 pn2 == 0;
+
+
+/** Convert a string to a mangled name */
+let from_string (s: string) => {plain: s, mangled: None};
+
+
+/** Create a mangled name from a plain and mangled string */
+let mangled (plain: string) (mangled: string) => {
+  plain,
+  mangled: Some (plain ^ "{" ^ mangled ^ "}")
+};
+
+
+/** Convert a mangled name to a string */
+let to_string (pn: t) => pn.plain;
+
+
+/** Convert a full mangled name to a string */
+let to_string_full (pn: t) =>
+  switch pn.mangled {
+  | Some mangled => pn.plain ^ "{" ^ mangled ^ "}"
+  | None => pn.plain
+  };
+
+
+/** Get mangled string if given */
+let get_mangled pn =>
+  switch pn.mangled {
+  | Some s => s
+  | None => pn.plain
+  };
+
+
+/** Create a mangled type name from a package name and a class name */
+let from_package_class package_name class_name =>
+  if (package_name == "") {
+    from_string class_name
+  } else {
+    from_string (package_name ^ "." ^ class_name)
+  };
+
+
+/** Pretty print a mangled name */
+let pp f pn => F.fprintf f "%s" (to_string pn);
+
+type mangled_t = t;
+
+let module MangledSet = Set.Make {
+  type t = mangled_t;
+  let compare = compare;
+};

infer/src/IR/Mangled.rei

@@ -0,0 +1,56 @@
+/*
+ * Copyright (c) 2009 - 2013 Monoidics ltd.
+ * Copyright (c) 2013 - present Facebook, Inc.
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+
+open! Utils;
+
+
+/** Module for Mangled Names */
+/** Type of mangled names */
+type t;
+
+
+/** Comparison for mangled names */
+let compare: t => t => int;
+
+
+/** Equality for mangled names */
+let equal: t => t => bool;
+
+
+/** Convert a string to a mangled name */
+let from_string: string => t;
+
+
+/** Create a mangled type name from a package name and a class name */
+let from_package_class: string => string => t;
+
+
+/** Create a mangled name from a plain and mangled string */
+let mangled: string => string => t;
+
+
+/** Convert a mangled name to a string */
+let to_string: t => string;
+
+
+/** Convert a full mangled name to a string */
+let to_string_full: t => string;
+
+
+/** Get mangled string if given */
+let get_mangled: t => string;
+
+
+/** Pretty print a mangled name */
+let pp: Format.formatter => t => unit;
+
+
+/** Set of Mangled. */
+let module MangledSet: Set.S with type elt = t;

infer/src/IR/ProcAttributes.re

@@ -0,0 +1,68 @@
+/*
+ * Copyright (c) 2015 - present Facebook, Inc.
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+
+open! Utils;
+
+
+/** Attributes of a procedure. */
+let module L = Logging;
+
+let module F = Format;
+
+
+/** Type for ObjC accessors */
+type objc_accessor_type = | Objc_getter of Ident.fieldname | Objc_setter of Ident.fieldname;
+
+type t = {
+  access: Sil.access, /** visibility access */
+  captured: list (Mangled.t, Sil.typ), /** name and type of variables captured in blocks */
+  mutable changed: bool, /** true if proc has changed since last analysis */
+  err_log: Errlog.t, /** Error log for the procedure */
+  exceptions: list string, /** exceptions thrown by the procedure */
+  formals: list (Mangled.t, Sil.typ), /** name and type of formal parameters */
+  func_attributes: list Sil.func_attribute,
+  is_abstract: bool, /** the procedure is abstract */
+  mutable is_bridge_method: bool, /** the procedure is a bridge method */
+  is_defined: bool, /** true if the procedure is defined, and not just declared */
+  is_objc_instance_method: bool, /** the procedure is an objective-C instance method */
+  is_cpp_instance_method: bool, /** the procedure is an C++ instance method */
+  mutable is_synthetic_method: bool, /** the procedure is a synthetic method */
+  language: Config.language, /** language of the procedure */
+  loc: Location.t, /** location of this procedure in the source code */
+  mutable locals: list (Mangled.t, Sil.typ), /** name and type of local variables */
+  method_annotation: Sil.method_annotation, /** annotations for java methods */
+  objc_accessor: option objc_accessor_type, /** type of ObjC accessor, if any */
+  proc_flags: proc_flags, /** flags of the procedure */
+  proc_name: Procname.t, /** name of the procedure */
+  ret_type: Sil.typ /** return type */
+};
+
+let default proc_name language => {
+  access: Sil.Default,
+  captured: [],
+  changed: true,
+  err_log: Errlog.empty (),
+  exceptions: [],
+  formals: [],
+  func_attributes: [],
+  is_abstract: false,
+  is_bridge_method: false,
+  is_cpp_instance_method: false,
+  is_defined: false,
+  is_objc_instance_method: false,
+  is_synthetic_method: false,
+  language,
+  loc: Location.dummy,
+  locals: [],
+  method_annotation: Sil.method_annotation_empty,
+  objc_accessor: None,
+  proc_flags: proc_flags_empty (),
+  proc_name,
+  ret_type: Sil.Tvoid
+};

infer/src/IR/ProcAttributes.rei

@@ -0,0 +1,42 @@
+/*
+ * Copyright (c) 2015 - present Facebook, Inc.
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+
+open! Utils;
+
+
+/** Attributes of a procedure. */
+type objc_accessor_type = | Objc_getter of Ident.fieldname | Objc_setter of Ident.fieldname;
+
+type t = {
+  access: Sil.access, /** visibility access */
+  captured: list (Mangled.t, Sil.typ), /** name and type of variables captured in blocks */
+  mutable changed: bool, /** true if proc has changed since last analysis */
+  err_log: Errlog.t, /** Error log for the procedure */
+  exceptions: list string, /** exceptions thrown by the procedure */
+  formals: list (Mangled.t, Sil.typ), /** name and type of formal parameters */
+  func_attributes: list Sil.func_attribute,
+  is_abstract: bool, /** the procedure is abstract */
+  mutable is_bridge_method: bool, /** the procedure is a bridge method */
+  is_defined: bool, /** true if the procedure is defined, and not just declared */
+  is_objc_instance_method: bool, /** the procedure is an objective-C instance method */
+  is_cpp_instance_method: bool, /** the procedure is an C++ instance method */
+  mutable is_synthetic_method: bool, /** the procedure is a synthetic method */
+  language: Config.language, /** language of the procedure */
+  loc: Location.t, /** location of this procedure in the source code */
+  mutable locals: list (Mangled.t, Sil.typ), /** name and type of local variables */
+  method_annotation: Sil.method_annotation, /** annotations for java methods */
+  objc_accessor: option objc_accessor_type, /** type of ObjC accessor, if any */
+  proc_flags: proc_flags, /** flags of the procedure */
+  proc_name: Procname.t, /** name of the procedure */
+  ret_type: Sil.typ /** return type */
+};
+
+
+/** Create a proc_attributes with default values. */
+let default: Procname.t => Config.language => t;

infer/src/IR/Procname.re

@@ -0,0 +1,576 @@
+/*
+ * Copyright (c) 2009 - 2013 Monoidics ltd.
+ * Copyright (c) 2013 - present Facebook, Inc.
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+
+open! Utils;
+
+
+/** Module for Procedure Names */
+let module L = Logging;
+
+let module F = Format;
+
+type java_type = (option string, string); /* e.g. ("", "int") for primitive types or ("java.io", "PrintWriter") for objects */
+
+type method_kind =
+  | Static /* in Java, procedures called with invokestatic */
+  | Non_Static /* in Java, procedures called with invokevirtual, invokespecial, and invokeinterface */;
+
+
+/** Type of java procedure names. */
+type java = {
+  class_name: java_type,
+  return_type: option java_type, /* option because constructors have no return type */
+  method_name: string,
+  parameters: list java_type,
+  kind: method_kind
+};
+
+
+/** Type of c procedure names. */
+type c = (string, option string);
+
+
+/** Type of Objective C and C++ procedure names: method signatures. */
+type objc_cpp = {class_name: string, method_name: string, mangled: option string};
+
+
+/** Type of Objective C block names. */
+type block = string;
+
+
+/** Type of procedure names. */
+type t = | Java of java | C of c | ObjC_Cpp of objc_cpp | Block of block;
+
+
+/** Level of verbosity of some to_string functions. */
+type detail_level = | Verbose | Non_verbose | Simple;
+
+type objc_method_kind = | Instance_objc_method | Class_objc_method;
+
+let mangled_of_objc_method_kind kind =>
+  switch kind {
+  | Instance_objc_method => Some "instance"
+  | Class_objc_method => Some "class"
+  };
+
+let objc_method_kind_of_bool is_instance =>
+  if is_instance {
+    Instance_objc_method
+  } else {
+    Class_objc_method
+  };
+
+let empty_block = Block "";
+
+let is_verbose v =>
+  switch v {
+  | Verbose => true
+  | _ => false
+  };
+
+type proc_name = t;
+
+let mangled_compare so1 so2 =>
+  switch (so1, so2) {
+  | (None, None) => 0
+  | (None, Some _) => (-1)
+  | (Some _, None) => 1
+  | (Some s1, Some s2) => string_compare s1 s2
+  };
+
+let method_kind_compare k0 k1 =>
+  switch (k0, k1) {
+  | _ when k0 == k1 => 0
+  | (Static, _) => 1
+  | (Non_Static, _) => (-1)
+  };
+
+
+/** A type is a pair (package, type_name) that is translated in a string package.type_name */
+let java_type_to_string_verbosity p verbosity =>
+  switch p {
+  | (None, typ) => typ
+  | (Some p, cls) =>
+    if (is_verbose verbosity) {
+      p ^ "." ^ cls
+    } else {
+      cls
+    }
+  };
+
+let java_type_to_string p => java_type_to_string_verbosity p Verbose;
+
+
+/** Given a list of types, it creates a unique string of types separated by commas */
+let rec java_param_list_to_string inputList verbosity =>
+  switch inputList {
+  | [] => ""
+  | [head] => java_type_to_string_verbosity head verbosity
+  | [head, ...rest] =>
+    java_type_to_string_verbosity head verbosity ^ "," ^ java_param_list_to_string rest verbosity
+  };
+
+
+/** It is the same as java_type_to_string, but Java return types are optional because of constructors without type */
+let java_return_type_to_string j verbosity =>
+  switch j.return_type {
+  | None => ""
+  | Some typ => java_type_to_string_verbosity typ verbosity
+  };
+
+let java_type_compare (p1, c1) (p2, c2) => string_compare c1 c2 |> next mangled_compare p1 p2;
+
+let rec java_type_list_compare jt1 jt2 =>
+  switch (jt1, jt2) {
+  | ([], []) => 0
+  | ([], _) => (-1)
+  | (_, []) => 1
+  | ([x1, ...rest1], [x2, ...rest2]) =>
+    java_type_compare x1 x2 |> next java_type_list_compare rest1 rest2
+  };
+
+let java_return_type_compare jr1 jr2 =>
+  switch (jr1, jr2) {
+  | (None, None) => 0
+  | (None, Some _) => (-1)
+  | (Some _, None) => 1
+  | (Some jt1, Some jt2) => java_type_compare jt1 jt2
+  };
+
+
+/** Compare java procedure names. */
+let java_compare (j1: java) (j2: java) =>
+  string_compare j1.method_name j2.method_name |>
+    next java_type_list_compare j1.parameters j2.parameters |>
+    next java_type_compare j1.class_name j2.class_name |>
+    next java_return_type_compare j1.return_type j2.return_type |>
+    next method_kind_compare j1.kind j2.kind;
+
+let c_function_mangled_compare mangled1 mangled2 =>
+  switch (mangled1, mangled2) {
+  | (Some _, None) => 1
+  | (None, Some _) => (-1)
+  | (None, None) => 0
+  | (Some mangled1, Some mangled2) => string_compare mangled1 mangled2
+  };
+
+
+/** Compare c_method signatures. */
+let c_meth_sig_compare osig1 osig2 =>
+  string_compare osig1.method_name osig2.method_name |>
+    next string_compare osig1.class_name osig2.class_name |>
+    next c_function_mangled_compare osig1.mangled osig2.mangled;
+
+
+/** Given a package.class_name string, it looks for the latest dot and split the string
+    in two (package, class_name) */
+let split_classname package_classname => string_split_character package_classname '.';
+
+let from_string_c_fun (s: string) => C (s, None);
+
+let c (plain: string) (mangled: string) => (plain, Some mangled);
+
+let java class_name return_type method_name parameters kind => {
+  class_name,
+  return_type,
+  method_name,
+  parameters,
+  kind
+};
+
+
+/** Create an objc procedure name from a class_name and method_name. */
+let objc_cpp class_name method_name mangled => {class_name, method_name, mangled};
+
+let get_default_objc_class_method objc_class => {
+  let objc_cpp = objc_cpp objc_class "__find_class_" (Some "internal");
+  ObjC_Cpp objc_cpp
+};
+
+
+/** Create an objc procedure name from a class_name and method_name. */
+let mangled_objc_block name => Block name;
+
+let is_java =
+  fun
+  | Java _ => true
+  | _ => false;
+
+let is_c_method =
+  fun
+  | ObjC_Cpp _ => true
+  | _ => false;
+
+
+/** Replace the class name component of a procedure name.
+    In case of Java, replace package and class name. */
+let replace_class t new_class =>
+  switch t {
+  | Java j => Java {...j, class_name: split_classname new_class}
+  | ObjC_Cpp osig => ObjC_Cpp {...osig, class_name: new_class}
+  | C _
+  | Block _ => t
+  };
+
+
+/** Get the class name of a Objective-C/C++ procedure name. */
+let objc_cpp_get_class_name objc_cpp => objc_cpp.class_name;
+
+
+/** Return the package.classname of a java procname. */
+let java_get_class_name (j: java) => java_type_to_string j.class_name;
+
+
+/** Return the class name of a java procedure name. */
+let java_get_simple_class_name (j: java) => snd j.class_name;
+
+
+/** Return the package of a java procname. */
+let java_get_package (j: java) => fst j.class_name;
+
+
+/** Return the method of a java procname. */
+let java_get_method (j: java) => j.method_name;
+
+
+/** Replace the method of a java procname. */
+let java_replace_method (j: java) mname => {...j, method_name: mname};
+
+
+/** Replace the return type of a java procname. */
+let java_replace_return_type j ret_type => {...j, return_type: Some ret_type};
+
+
+/** Replace the parameters of a java procname. */
+let java_replace_parameters j parameters => {...j, parameters};
+
+
+/** Return the method/function of a procname. */
+let get_method =
+  fun
+  | ObjC_Cpp name => name.method_name
+  | C (name, _) => name
+  | Block name => name
+  | Java j => j.method_name;
+
+
+/** Return the language of the procedure. */
+let get_language =
+  fun
+  | ObjC_Cpp _ => Config.Clang
+  | C _ => Config.Clang
+  | Block _ => Config.Clang
+  | Java _ => Config.Java;
+
+
+/** Return the return type of a java procname. */
+let java_get_return_type (j: java) => java_return_type_to_string j Verbose;
+
+
+/** Return the parameters of a java procname. */
+let java_get_parameters j => j.parameters;
+
+
+/** Return the parameters of a java procname as strings. */
+let java_get_parameters_as_strings j =>
+  IList.map (fun param => java_type_to_string param) j.parameters;
+
+
+/** Return true if the java procedure is static */
+let java_is_static =
+  fun
+  | Java j => j.kind == Static
+  | _ => false;
+
+
+/** Prints a string of a java procname with the given level of verbosity */
+let java_to_string withclass::withclass=false (j: java) verbosity =>
+  switch verbosity {
+  | Verbose
+  | Non_verbose =>
+    /* if verbose, then package.class.method(params): rtype,
+       else rtype package.class.method(params)
+       verbose is used for example to create unique filenames, non_verbose to create reports */
+    let return_type = java_return_type_to_string j verbosity;
+    let params = java_param_list_to_string j.parameters verbosity;
+    let class_name = java_type_to_string_verbosity j.class_name verbosity;
+    let separator =
+      switch (j.return_type, verbosity) {
+      | (None, _) => ""
+      | (Some _, Verbose) => ":"
+      | _ => " "
+      };
+    let output = class_name ^ "." ^ j.method_name ^ "(" ^ params ^ ")";
+    if (verbosity == Verbose) {
+      output ^ separator ^ return_type
+    } else {
+      return_type ^ separator ^ output
+    }
+  | Simple =>
+    /* methodname(...) or without ... if there are no parameters */
+    let cls_prefix =
+      if withclass {
+        java_type_to_string_verbosity j.class_name verbosity ^ "."
+      } else {
+        ""
+      };
+    let params =
+      switch j.parameters {
+      | [] => ""
+      | _ => "..."
+      };
+    let method_name =
+      if (j.method_name == "<init>") {
+        java_get_simple_class_name j
+      } else {
+        cls_prefix ^ j.method_name
+      };
+    method_name ^ "(" ^ params ^ ")"
+  };
+
+
+/** Check if the class name is for an anonymous inner class. */
+let is_anonymous_inner_class_name class_name =>
+  switch (string_split_character class_name '$') {
+  | (Some _, s) =>
+    let is_int =
+      try {
+        ignore (int_of_string (String.trim s));
+        true
+      } {
+      | Failure _ => false
+      };
+    is_int
+  | (None, _) => false
+  };
+
+
+/** Check if the procedure belongs to an anonymous inner class. */
+let java_is_anonymous_inner_class =
+  fun
+  | Java j => is_anonymous_inner_class_name (snd j.class_name)
+  | _ => false;
+
+
+/** Check if the last parameter is a hidden inner class, and remove it if present.
+    This is used in private constructors, where a proxy constructor is generated
+    with an extra parameter and calls the normal constructor. */
+let java_remove_hidden_inner_class_parameter =
+  fun
+  | Java js =>
+    switch (IList.rev js.parameters) {
+    | [(_, s), ...par'] =>
+      if (is_anonymous_inner_class_name s) {
+        Some (Java {...js, parameters: IList.rev par'})
+      } else {
+        None
+      }
+    | [] => None
+    }
+  | _ => None;
+
+
+/** Check if the procedure name is an anonymous inner class constructor. */
+let java_is_anonymous_inner_class_constructor =
+  fun
+  | Java js => {
+      let (_, name) = js.class_name;
+      is_anonymous_inner_class_name name
+    }
+  | _ => false;
+
+
+/** Check if the procedure name is an acess method (e.g. access$100 used to
+    access private members from a nested class. */
+let java_is_access_method =
+  fun
+  | Java js =>
+    switch (string_split_character js.method_name '$') {
+    | (Some "access", s) =>
+      let is_int =
+        try {
+          ignore (int_of_string s);
+          true
+        } {
+        | Failure _ => false
+        };
+      is_int
+    | _ => false
+    }
+  | _ => false;
+
+
+/** Check if the proc name has the type of a java vararg.
+    Note: currently only checks that the last argument has type Object[]. */
+let java_is_vararg =
+  fun
+  | Java js =>
+    switch (IList.rev js.parameters) {
+    | [(_, "java.lang.Object[]"), ..._] => true
+    | _ => false
+    }
+  | _ => false;
+
+
+/** [is_constructor pname] returns true if [pname] is a constructor */
+let is_constructor =
+  fun
+  | Java js => js.method_name == "<init>"
+  | ObjC_Cpp name => name.method_name == "new" || string_is_prefix "init" name.method_name
+  | _ => false;
+
+
+/** [is_objc_dealloc pname] returns true if [pname] is the dealloc method in Objective-C */
+let is_objc_dealloc =
+  fun
+  | ObjC_Cpp name => name.method_name == "dealloc"
+  | _ => false;
+
+let java_is_close =
+  fun
+  | Java js => js.method_name == "close"
+  | _ => false;
+
+
+/** [is_class_initializer pname] returns true if [pname] is a class initializer */
+let is_class_initializer =
+  fun
+  | Java js => js.method_name == "<clinit>"
+  | _ => false;
+
+
+/** [is_infer_undefined pn] returns true if [pn] is a special Infer undefined proc */
+let is_infer_undefined pn =>
+  switch pn {
+  | Java j =>
+    let regexp = Str.regexp "com.facebook.infer.models.InferUndefined";
+    Str.string_match regexp (java_get_class_name j) 0
+  | _ =>
+    /* TODO: add cases for obj-c, c, c++ */
+    false
+  };
+
+
+/** to_string for C_function type */
+let to_readable_string (c1, c2) verbose => {
+  let plain = c1;
+  if verbose {
+    switch c2 {
+    | None => plain
+    | Some s => plain ^ "{" ^ s ^ "}"
+    }
+  } else {
+    plain
+  }
+};
+
+let c_method_to_string osig detail_level =>
+  switch detail_level {
+  | Simple => osig.method_name
+  | Non_verbose => osig.class_name ^ "_" ^ osig.method_name
+  | Verbose =>
+    let m_str =
+      switch osig.mangled {
+      | None => ""
+      | Some s => "{" ^ s ^ "}"
+      };
+    osig.class_name ^ "_" ^ osig.method_name ^ m_str
+  };
+
+
+/** Very verbose representation of an existing Procname.t */
+let to_unique_id pn =>
+  switch pn {
+  | Java j => java_to_string j Verbose
+  | C (c1, c2) => to_readable_string (c1, c2) true
+  | ObjC_Cpp osig => c_method_to_string osig Verbose
+  | Block name => name
+  };
+
+
+/** Convert a proc name to a string for the user to see */
+let to_string p =>
+  switch p {
+  | Java j => java_to_string j Non_verbose
+  | C (c1, c2) => to_readable_string (c1, c2) false
+  | ObjC_Cpp osig => c_method_to_string osig Non_verbose
+  | Block name => name
+  };
+
+
+/** Convenient representation of a procname for external tools (e.g. eclipse plugin) */
+let to_simplified_string withclass::withclass=false p =>
+  switch p {
+  | Java j => java_to_string withclass::withclass j Simple
+  | C (c1, c2) => to_readable_string (c1, c2) false ^ "()"
+  | ObjC_Cpp osig => c_method_to_string osig Simple
+  | Block _ => "block"
+  };
+
+
+/** Convert a proc name to a filename */
+let to_filename proc_name =>
+  Escape.escape_filename @@ string_append_crc_cutoff @@ to_unique_id proc_name;
+
+
+/** Pretty print a proc name */
+let pp f pn => F.fprintf f "%s" (to_string pn);
+
+
+/** Compare function for Procname.t types.
+    These rules create an ordered set of procnames grouped with the following
+    priority (lowest to highest): */
+let compare pn1 pn2 =>
+  switch (pn1, pn2) {
+  | (Java j1, Java j2) => java_compare j1 j2
+  | (Java _, _) => (-1)
+  | (_, Java _) => 1
+  | (
+      C (c1, c2), /* Compare C_function types */
+      C (c3, c4)
+    ) =>
+    string_compare c1 c3 |> next mangled_compare c2 c4
+  | (C _, _) => (-1)
+  | (_, C _) => 1
+  | (
+      Block s1, /* Compare ObjC_block types */
+      Block s2
+    ) =>
+    string_compare s1 s2
+  | (Block _, _) => (-1)
+  | (_, Block _) => 1
+  | (ObjC_Cpp osig1, ObjC_Cpp osig2) => c_meth_sig_compare osig1 osig2
+  };
+
+let equal pn1 pn2 => compare pn1 pn2 == 0;
+
+
+/** hash function for procname */
+let hash_pname = Hashtbl.hash;
+
+let module Hash = Hashtbl.Make {
+  type t = proc_name;
+  let equal = equal;
+  let hash = hash_pname;
+};
+
+let module Map = Map.Make {
+  type t = proc_name;
+  let compare = compare;
+};
+
+let module Set = Set.Make {
+  type t = proc_name;
+  let compare = compare;
+};
+
+
+/** Pretty print a set of proc names */
+let pp_set fmt set => Set.iter (fun pname => F.fprintf fmt "%a " pp pname) set;

infer/src/IR/Procname.rei

@@ -0,0 +1,251 @@
+/*
+ * Copyright (c) 2009 - 2013 Monoidics ltd.
+ * Copyright (c) 2013 - present Facebook, Inc.
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+
+open! Utils;
+
+
+/** Module for Procedure Names. */
+/** Type of java procedure names. */
+type java;
+
+
+/** Type of c procedure names. */
+type c;
+
+
+/** Type of Objective C and C++ procedure names. */
+type objc_cpp;
+
+
+/** Type of Objective C block names. */
+type block;
+
+
+/** Type of procedure names. */
+type t = | Java of java | C of c | ObjC_Cpp of objc_cpp | Block of block;
+
+type java_type = (option string, string);
+
+type method_kind =
+  | Static /* in Java, procedures called with invokestatic */
+  | Non_Static /* in Java, procedures called with invokevirtual, invokespecial, and invokeinterface */;
+
+type objc_method_kind =
+  | Instance_objc_method /* for instance methods in ObjC */
+  | Class_objc_method /* for class methods in ObjC */;
+
+
+/** Hash tables with proc names as keys. */
+let module Hash: Hashtbl.S with type key = t;
+
+
+/** Maps from proc names. */
+let module Map: Map.S with type key = t;
+
+
+/** Sets of proc names. */
+let module Set: Set.S with type elt = t;
+
+
+/** Create a C procedure name from plain and mangled name. */
+let c: string => string => c;
+
+
+/** Comparison for proc names. */
+let compare: t => t => int;
+
+
+/** Empty block name. */
+let empty_block: t;
+
+
+/** Equality for proc names. */
+let equal: t => t => bool;
+
+
+/** Convert a string to a proc name. */
+let from_string_c_fun: string => t;
+
+
+/** Return the language of the procedure. */
+let get_language: t => Config.language;
+
+
+/** Return the method/function of a procname. */
+let get_method: t => string;
+
+
+/** Hash function for procname. */
+let hash_pname: t => int;
+
+
+/** Check if a class string is an anoynmous inner class name. */
+let is_anonymous_inner_class_name: string => bool;
+
+
+/** Check if this is an Objective-C/C++ method name. */
+let is_c_method: t => bool;
+
+
+/** Check if this is a constructor. */
+let is_constructor: t => bool;
+
+
+/** Check if this is a Java procedure name. */
+let is_java: t => bool;
+
+
+/** Check if this is a dealloc method in Objective-C. */
+let is_objc_dealloc: t => bool;
+
+
+/** Create a Java procedure name from its
+    class_name method_name args_type_name return_type_name method_kind. */
+let java: java_type => option java_type => string => list java_type => method_kind => java;
+
+
+/** Replace the parameters of a java procname. */
+let java_replace_parameters: java => list java_type => java;
+
+
+/** Replace the method of a java procname. */
+let java_replace_return_type: java => java_type => java;
+
+
+/** Create an objc block name. */
+let mangled_objc_block: string => t;
+
+
+/** Mangled string for method types. */
+let mangled_of_objc_method_kind: objc_method_kind => option string;
+
+
+/** Create an objc procedure name from a class_name and method_name. */
+let objc_cpp: string => string => option string => objc_cpp;
+
+let get_default_objc_class_method: string => t;
+
+
+/** Get the class name of a Objective-C/C++ procedure name. */
+let objc_cpp_get_class_name: objc_cpp => string;
+
+
+/** Create ObjC method type from a bool is_instance. */
+let objc_method_kind_of_bool: bool => objc_method_kind;
+
+
+/** Return the class name of a java procedure name. */
+let java_get_class_name: java => string;
+
+
+/** Return the simple class name of a java procedure name. */
+let java_get_simple_class_name: java => string;
+
+
+/** Return the package name of a java procedure name. */
+let java_get_package: java => option string;
+
+
+/** Return the method name of a java procedure name. */
+let java_get_method: java => string;
+
+
+/** Return the return type of a java procedure name. */
+let java_get_return_type: java => string;
+
+
+/** Return the parameters of a java procedure name. */
+let java_get_parameters: java => list java_type;
+
+
+/** Return the parameters of a java procname as strings. */
+let java_get_parameters_as_strings: java => list string;
+
+
+/** Check if the procedure name is an acess method (e.g. access$100 used to
+    access private members from a nested class. */
+let java_is_access_method: t => bool;
+
+
+/** Check if the procedure belongs to an anonymous inner class. */
+let java_is_anonymous_inner_class: t => bool;
+
+
+/** Check if the procedure name is an anonymous inner class constructor. */
+let java_is_anonymous_inner_class_constructor: t => bool;
+
+
+/** Check if the method name is "close". */
+let java_is_close: t => bool;
+
+
+/** Check if the java procedure is static. */
+let java_is_static: t => bool;
+
+
+/** Check if the proc name has the type of a java vararg.
+    Note: currently only checks that the last argument has type Object[]. */
+let java_is_vararg: t => bool;
+
+
+/** Check if the last parameter is a hidden inner class, and remove it if present.
+    This is used in private constructors, where a proxy constructor is generated
+    with an extra parameter and calls the normal constructor. */
+let java_remove_hidden_inner_class_parameter: t => option t;
+
+
+/** Replace the method name of an existing java procname. */
+let java_replace_method: java => string => java;
+
+
+/** Convert a java type to a string. */
+let java_type_to_string: java_type => string;
+
+
+/** Check if this is a class initializer. */
+let is_class_initializer: t => bool;
+
+
+/** Check if this is a special Infer undefined procedure. */
+let is_infer_undefined: t => bool;
+
+
+/** Pretty print a proc name. */
+let pp: Format.formatter => t => unit;
+
+
+/** Pretty print a set of proc names. */
+let pp_set: Format.formatter => Set.t => unit;
+
+
+/** Replace the class name component of a procedure name.
+    In case of Java, replace package and class name. */
+let replace_class: t => string => t;
+
+
+/** Given a package.class_name string, look for the latest dot and split the string
+    in two (package, class_name). */
+let split_classname: string => (option string, string);
+
+
+/** Convert a proc name to a string for the user to see. */
+let to_string: t => string;
+
+
+/** Convert a proc name into a easy string for the user to see in an IDE. */
+let to_simplified_string: withclass::bool? => t => string;
+
+
+/** Convert a proc name into a unique identifier. */
+let to_unique_id: t => string;
+
+
+/** Convert a proc name to a filename. */
+let to_filename: t => string;

infer/src/IR/Pvar.re

@@ -0,0 +1,306 @@
+/*
+ * Copyright (c) 2009 - 2013 Monoidics ltd.
+ * Copyright (c) 2013 - present Facebook, Inc.
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+
+open! Utils;
+
+
+/** The Smallfoot Intermediate Language */
+let module L = Logging;
+
+let module F = Format;
+
+
+/** Kind of global variables */
+type pvar_kind =
+  | Local_var of Procname.t /** local variable belonging to a function */
+  | Callee_var of Procname.t /** local variable belonging to a callee */
+  | Abducted_retvar of Procname.t Location.t /** synthetic variable to represent return value */
+  | Abducted_ref_param of Procname.t t Location.t
+  /** synthetic variable to represent param passed by reference */
+  | Global_var /** gloval variable */
+  | Seed_var /** variable used to store the initial value of formal parameters */
+/** Names for program variables. */
+and t = {pv_name: Mangled.t, pv_kind: pvar_kind};
+
+let rec pvar_kind_compare k1 k2 =>
+  switch (k1, k2) {
+  | (Local_var n1, Local_var n2) => Procname.compare n1 n2
+  | (Local_var _, _) => (-1)
+  | (_, Local_var _) => 1
+  | (Callee_var n1, Callee_var n2) => Procname.compare n1 n2
+  | (Callee_var _, _) => (-1)
+  | (_, Callee_var _) => 1
+  | (Abducted_retvar p1 l1, Abducted_retvar p2 l2) =>
+    let n = Procname.compare p1 p2;
+    if (n != 0) {
+      n
+    } else {
+      Location.compare l1 l2
+    }
+  | (Abducted_retvar _, _) => (-1)
+  | (_, Abducted_retvar _) => 1
+  | (Abducted_ref_param p1 pv1 l1, Abducted_ref_param p2 pv2 l2) =>
+    let n = Procname.compare p1 p2;
+    if (n != 0) {
+      n
+    } else {
+      let n = compare pv1 pv2;
+      if (n != 0) {
+        n
+      } else {
+        Location.compare l1 l2
+      }
+    }
+  | (Abducted_ref_param _, _) => (-1)
+  | (_, Abducted_ref_param _) => 1
+  | (Global_var, Global_var) => 0
+  | (Global_var, _) => (-1)
+  | (_, Global_var) => 1
+  | (Seed_var, Seed_var) => 0
+  }
+and compare pv1 pv2 => {
+  let n = Mangled.compare pv1.pv_name pv2.pv_name;
+  if (n != 0) {
+    n
+  } else {
+    pvar_kind_compare pv1.pv_kind pv2.pv_kind
+  }
+};
+
+let equal pvar1 pvar2 => compare pvar1 pvar2 == 0;
+
+let rec _pp f pv => {
+  let name = pv.pv_name;
+  switch pv.pv_kind {
+  | Local_var n =>
+    if !Config.pp_simple {
+      F.fprintf f "%a" Mangled.pp name
+    } else {
+      F.fprintf f "%a$%a" Procname.pp n Mangled.pp name
+    }
+  | Callee_var n =>
+    if !Config.pp_simple {
+      F.fprintf f "%a|callee" Mangled.pp name
+    } else {
+      F.fprintf f "%a$%a|callee" Procname.pp n Mangled.pp name
+    }
+  | Abducted_retvar n l =>
+    if !Config.pp_simple {
+      F.fprintf f "%a|abductedRetvar" Mangled.pp name
+    } else {
+      F.fprintf f "%a$%a%a|abductedRetvar" Procname.pp n Location.pp l Mangled.pp name
+    }
+  | Abducted_ref_param n pv l =>
+    if !Config.pp_simple {
+      F.fprintf f "%a|%a|abductedRefParam" _pp pv Mangled.pp name
+    } else {
+      F.fprintf f "%a$%a%a|abductedRefParam" Procname.pp n Location.pp l Mangled.pp name
+    }
+  | Global_var => F.fprintf f "#GB$%a" Mangled.pp name
+  | Seed_var => 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;
+  switch pv.pv_kind {
+  | Local_var _ => Latex.pp_string Latex.Roman f (Mangled.to_string name)
+  | Callee_var _ =>
+    F.fprintf
+      f
+      "%a_{%a}"
+      (Latex.pp_string Latex.Roman)
+      (Mangled.to_string name)
+      (Latex.pp_string Latex.Roman)
+      "callee"
+  | Abducted_retvar _ =>
+    F.fprintf
+      f
+      "%a_{%a}"
+      (Latex.pp_string Latex.Roman)
+      (Mangled.to_string name)
+      (Latex.pp_string Latex.Roman)
+      "abductedRetvar"
+  | Abducted_ref_param _ =>
+    F.fprintf
+      f
+      "%a_{%a}"
+      (Latex.pp_string Latex.Roman)
+      (Mangled.to_string name)
+      (Latex.pp_string Latex.Roman)
+      "abductedRefParam"
+  | Global_var => Latex.pp_string Latex.Boldface f (Mangled.to_string name)
+  | Seed_var =>
+    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 =>
+  switch pe.pe_kind {
+  | PP_TEXT => _pp f pv
+  | PP_HTML => _pp f pv
+  | PP_LATEX => pp_latex f pv
+  };
+
+
+/** Pretty print a program variable. */
+let pp pe f pv => {
+  let ampersand =
+    switch pe.pe_kind {
+    | PP_TEXT => "&"
+    | PP_HTML => "&"
+    | PP_LATEX => "\\&"
+    };
+  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);
+
+
+/** Pretty print a list of program variables. */
+let pp_list pe f pvl => F.fprintf f "%a" (pp_seq (fun f e => F.fprintf f "%a" (pp pe) e)) pvl;
+
+
+/** Dump a list of program variables. */
+let d_list pvl =>
+  IList.iter
+    (
+      fun pv => {
+        d pv;
+        L.d_str " "
+      }
+    )
+    pvl;
+
+let get_name pv => pv.pv_name;
+
+let to_string pv => Mangled.to_string pv.pv_name;
+
+let get_simplified_name pv => {
+  let s = Mangled.to_string pv.pv_name;
+  switch (string_split_character s '.') {
+  | (Some s1, s2) =>
+    switch (string_split_character s1 '.') {
+    | (Some _, s4) => s4 ^ "." ^ s2
+    | _ => s
+    }
+  | _ => s
+  }
+};
+
+
+/** Check if the pvar is an abucted return var or param passed by ref */
+let is_abducted pv =>
+  switch pv.pv_kind {
+  | Abducted_retvar _
+  | Abducted_ref_param _ => true
+  | _ => false
+  };
+
+
+/** Turn a pvar into a seed pvar (which stored the initial value) */
+let to_seed pv => {...pv, pv_kind: Seed_var};
+
+
+/** Check if the pvar is a local var */
+let is_local pv =>
+  switch pv.pv_kind {
+  | Local_var _ => true
+  | _ => false
+  };
+
+
+/** Check if the pvar is a callee var */
+let is_callee pv =>
+  switch pv.pv_kind {
+  | Callee_var _ => true
+  | _ => false
+  };
+
+
+/** Check if the pvar is a seed var */
+let is_seed pv =>
+  switch pv.pv_kind {
+  | Seed_var => true
+  | _ => false
+  };
+
+
+/** Check if the pvar is a global var */
+let is_global pv => pv.pv_kind == Global_var;
+
+
+/** Check if a pvar is the special "this" var */
+let is_this pvar => Mangled.equal (get_name pvar) (Mangled.from_string "this");
+
+
+/** Check if the pvar is a return var */
+let is_return pv => get_name pv == Ident.name_return;
+
+
+/** Turn an ordinary program variable into a callee program variable */
+let to_callee pname pvar =>
+  switch pvar.pv_kind {
+  | Local_var _ => {...pvar, pv_kind: Callee_var pname}
+  | Global_var => pvar
+  | Callee_var _
+  | Abducted_retvar _
+  | Abducted_ref_param _
+  | Seed_var =>
+    L.d_str "Cannot convert pvar to callee: ";
+    d pvar;
+    L.d_ln ();
+    assert false
+  };
+
+
+/** [mk name proc_name] creates a program var with the given function name */
+let mk (name: Mangled.t) (proc_name: Procname.t) :t => {
+  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
+    for a callee function with the given function name */
+let mk_callee (name: Mangled.t) (proc_name: Procname.t) :t => {
+  pv_name: name,
+  pv_kind: Callee_var proc_name
+};
+
+
+/** create a global variable with the given name */
+let mk_global (name: Mangled.t) :t => {pv_name: name, pv_kind: Global_var};
+
+
+/** create an abducted return variable for a call to [proc_name] at [loc] */
+let mk_abducted_ret (proc_name: Procname.t) (loc: Location.t) :t => {
+  let name = Mangled.from_string ("$RET_" ^ Procname.to_unique_id proc_name);
+  {pv_name: name, pv_kind: Abducted_retvar proc_name loc}
+};
+
+let mk_abducted_ref_param (proc_name: Procname.t) (pv: t) (loc: Location.t) :t => {
+  let name = Mangled.from_string ("$REF_PARAM_" ^ Procname.to_unique_id proc_name);
+  {pv_name: name, pv_kind: Abducted_ref_param proc_name pv loc}
+};

infer/src/IR/Pvar.rei

@@ -0,0 +1,125 @@
+/*
+ * Copyright (c) 2009 - 2013 Monoidics ltd.
+ * Copyright (c) 2013 - present Facebook, Inc.
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+
+open! Utils;
+
+
+/** Program variables. */
+let module F = Format;
+
+
+/** Type for program variables. There are 4 kinds of variables:
+        1) local variables, used for local variables and formal parameters
+        2) callee program variables, used to handle recursion ([x | callee] is distinguished from [x])
+        3) global variables
+        4) seed variables, used to store the initial value of formal parameters
+    */
+type t;
+
+
+/** Compare two pvar's */
+let compare: t => t => int;
+
+
+/** Dump a program variable. */
+let d: t => unit;
+
+
+/** Dump a list of program variables. */
+let d_list: list t => unit;
+
+
+/** Equality for pvar's */
+let equal: t => t => bool;
+
+
+/** Get the name component of a program variable. */
+let get_name: t => Mangled.t;
+
+
+/** [get_ret_pvar proc_name] retuns the return pvar associated with the procedure name */
+let get_ret_pvar: Procname.t => t;
+
+
+/** Get a simplified version of the name component of a program variable. */
+let get_simplified_name: t => string;
+
+
+/** Check if the pvar is an abducted return var or param passed by ref */
+let is_abducted: t => bool;
+
+
+/** Check if the pvar is a callee var */
+let is_callee: t => bool;
+
+
+/** Check if the pvar is a global var */
+let is_global: t => bool;
+
+
+/** Check if the pvar is a local var */
+let is_local: t => bool;
+
+
+/** Check if the pvar is a seed var */
+let is_seed: t => bool;
+
+
+/** Check if the pvar is a return var */
+let is_return: t => bool;
+
+
+/** Check if a pvar is the special "this" var */
+let is_this: t => bool;
+
+
+/** [mk name proc_name suffix] creates a program var with the given function name and suffix */
+let mk: Mangled.t => Procname.t => t;
+
+
+/** create an abducted variable for a parameter passed by reference */
+let mk_abducted_ref_param: Procname.t => t => Location.t => t;
+
+
+/** create an abducted return variable for a call to [proc_name] at [loc] */
+let mk_abducted_ret: Procname.t => Location.t => t;
+
+
+/** [mk_callee name proc_name] creates a program var
+    for a callee function with the given function name */
+let mk_callee: Mangled.t => Procname.t => t;
+
+
+/** create a global variable with the given name */
+let mk_global: Mangled.t => t;
+
+
+/** Pretty print a program variable. */
+let pp: printenv => F.formatter => t => unit;
+
+
+/** Pretty print a list of program variables. */
+let pp_list: printenv => F.formatter => list t => unit;
+
+
+/** Pretty print a pvar which denotes a value, not an address */
+let pp_value: printenv => F.formatter => t => unit;
+
+
+/** Turn an ordinary program variable into a callee program variable */
+let to_callee: Procname.t => t => t;
+
+
+/** Turn a pvar into a seed pvar (which stores the initial value of a stack var) */
+let to_seed: t => t;
+
+
+/** Convert a pvar to string. */
+let to_string: t => string;

infer/src/IR/README.md

@@ -2,11 +2,11 @@
 
 The Intermediate Representation is a format used by the back-end for analysis. It is produced by one of the front-ends, one for each program analyzed.
 
-The main entry point is the intermediate language in [Sil](sil.mli).
+The main entry point is the intermediate language in [Sil](sil.rei).
 
-The control flow graph module is [Cfg](cfg.mli).
+The control flow graph module is [Cfg](cfg.rei).
 
-The call graph module is [Cg](cg.mli).
+The call graph module is [Cg](cg.rei).
 
-The type environment module is [Tenv](tenv.mli).
+The type environment module is [Tenv](tenv.rei).
 

infer/src/IR/Tenv.re

@@ -0,0 +1,172 @@
+/*
+ * Copyright (c) 2016 - present Facebook, Inc.
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+
+open! Utils;
+
+
+/** Module for Type Environments. */
+/** Hash tables on strings. */
+let module TypenameHash = Hashtbl.Make {
+  type t = Typename.t;
+  let equal tn1 tn2 => Typename.equal tn1 tn2;
+  let hash = Hashtbl.hash;
+};
+
+
+/** Type for type environment. */
+type t = TypenameHash.t Sil.struct_typ;
+
+
+/** Create a new type environment. */
+let create () => TypenameHash.create 1000;
+
+
+/** Check if typename is found in tenv */
+let mem tenv name => TypenameHash.mem tenv name;
+
+
+/** Look up a name in the global type environment. */
+let lookup tenv name =>
+  try (Some (TypenameHash.find tenv name)) {
+  | Not_found => None
+  };
+
+
+/** Lookup Java types by name */
+let lookup_java_typ_from_string tenv typ_str => {
+  let rec loop =
+    fun
+    | ""
+    | "void" => Some Sil.Tvoid
+    | "int" => Some (Sil.Tint Sil.IInt)
+    | "byte" => Some (Sil.Tint Sil.IShort)
+    | "short" => Some (Sil.Tint Sil.IShort)
+    | "boolean" => Some (Sil.Tint Sil.IBool)
+    | "char" => Some (Sil.Tint Sil.IChar)
+    | "long" => Some (Sil.Tint Sil.ILong)
+    | "float" => Some (Sil.Tfloat Sil.FFloat)
+    | "double" => Some (Sil.Tfloat Sil.FDouble)
+    | typ_str when String.contains typ_str '[' => {
+        let stripped_typ = String.sub typ_str 0 (String.length typ_str - 2);
+        let array_typ_size = Sil.exp_get_undefined false;
+        switch (loop stripped_typ) {
+        | Some typ => Some (Sil.Tptr (Sil.Tarray typ array_typ_size) Sil.Pk_pointer)
+        | None => None
+        }
+      }
+    | typ_str =>
+      /* non-primitive/non-array type--resolve it in the tenv */
+      {
+        let typename = Typename.Java.from_string typ_str;
+        switch (lookup tenv typename) {
+        | Some struct_typ => Some (Sil.Tstruct struct_typ)
+        | None => None
+        }
+      };
+  loop typ_str
+};
+
+
+/** resolve a type string to a Java *class* type. For strings that may represent primitive or array
+    typs, use [lookup_java_typ_from_string] */
+let lookup_java_class_from_string tenv typ_str =>
+  switch (lookup_java_typ_from_string tenv typ_str) {
+  | Some (Sil.Tstruct struct_typ) => Some struct_typ
+  | _ => None
+  };
+
+
+/** Add a (name,type) pair to the global type environment. */
+let add tenv name struct_typ => TypenameHash.replace tenv name struct_typ;
+
+
+/** Return the declaring class type of [pname_java] */
+let proc_extract_declaring_class_typ tenv pname_java =>
+  lookup_java_class_from_string tenv (Procname.java_get_class_name pname_java);
+
+
+/** Return the return type of [pname_java]. */
+let proc_extract_return_typ tenv pname_java =>
+  lookup_java_typ_from_string tenv (Procname.java_get_return_type pname_java);
+
+
+/** Get method that is being overriden by java_pname (if any) **/
+let get_overriden_method tenv pname_java => {
+  let struct_typ_get_def_method_by_name struct_typ method_name =>
+    IList.find
+      (fun def_method => method_name == Procname.get_method def_method) struct_typ.Sil.def_methods;
+  let rec get_overriden_method_in_superclasses pname_java superclasses =>
+    switch superclasses {
+    | [superclass, ...superclasses_tail] =>
+      switch (lookup tenv superclass) {
+      | Some struct_typ =>
+        try (
+          Some (struct_typ_get_def_method_by_name struct_typ (Procname.java_get_method pname_java))
+        ) {
+        | Not_found =>
+          get_overriden_method_in_superclasses
+            pname_java (superclasses_tail @ struct_typ.Sil.superclasses)
+        }
+      | None => get_overriden_method_in_superclasses pname_java superclasses_tail
+      }
+    | [] => None
+    };
+  switch (proc_extract_declaring_class_typ tenv pname_java) {
+  | Some proc_struct_typ =>
+    get_overriden_method_in_superclasses pname_java proc_struct_typ.superclasses
+  | _ => None
+  }
+};
+
+
+/** expand a type if it is a typename by looking it up in the type environment */
+let expand_type tenv typ =>
+  switch typ {
+  | Sil.Tvar tname =>
+    switch (lookup tenv tname) {
+    | None => assert false
+    | Some struct_typ => Sil.Tstruct struct_typ
+    }
+  | _ => typ
+  };
+
+
+/** Serializer for type environments */
+let tenv_serializer: Serialization.serializer t = Serialization.create_serializer Serialization.tenv_key;
+
+let global_tenv: Lazy.t (option t) =
+  lazy (Serialization.from_file tenv_serializer (DB.global_tenv_fname ()));
+
+
+/** Load a type environment from a file */
+let load_from_file (filename: DB.filename) :option t =>
+  if (filename == DB.global_tenv_fname ()) {
+    Lazy.force global_tenv
+  } else {
+    Serialization.from_file tenv_serializer filename
+  };
+
+
+/** Save a type environment into a file */
+let store_to_file (filename: DB.filename) (tenv: t) =>
+  Serialization.to_file tenv_serializer filename tenv;
+
+let iter f tenv => TypenameHash.iter f tenv;
+
+let fold f tenv => TypenameHash.fold f tenv;
+
+let pp fmt (tenv: t) =>
+  TypenameHash.iter
+    (
+      fun name typ => {
+        Format.fprintf fmt "@[<6>NAME: %s@." (Typename.to_string name);
+        Format.fprintf fmt "@[<6>TYPE: %a@." (Sil.pp_struct_typ pe_text (fun _ () => ())) typ
+      }
+    )
+    tenv;

infer/src/IR/Tenv.rei

@@ -0,0 +1,75 @@
+/*
+ * Copyright (c) 2016 - present Facebook, Inc.
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+
+open! Utils;
+
+
+/** Module for Type Environments. */
+type t; /** Type for type environment. */
+
+
+/** Add a (name,typename) pair to the global type environment. */
+let add: t => Typename.t => Sil.struct_typ => unit;
+
+
+/** Create a new type environment. */
+let create: unit => t;
+
+
+/** Expand a type if it is a typename by looking it up in the type environment. */
+let expand_type: t => Sil.typ => Sil.typ;
+
+
+/** Fold a function over the elements of the type environment. */
+let fold: (Typename.t => Sil.struct_typ => 'a => 'a) => t => 'a => 'a;
+
+
+/** iterate over a type environment */
+let iter: (Typename.t => Sil.struct_typ => unit) => t => unit;
+
+
+/** Load a type environment from a file */
+let load_from_file: DB.filename => option t;
+
+
+/** Look up a name in the global type environment. */
+let lookup: t => Typename.t => option Sil.struct_typ;
+
+
+/** Lookup Java types by name. */
+let lookup_java_typ_from_string: t => string => option Sil.typ;
+
+
+/** resolve a type string to a Java *class* type. For strings that may represent primitive or array
+    typs, use [lookup_java_typ_from_string]. */
+let lookup_java_class_from_string: t => string => option Sil.struct_typ;
+
+
+/** Return the declaring class type of [pname_java] */
+let proc_extract_declaring_class_typ: t => Procname.java => option Sil.struct_typ;
+
+
+/** Return the return type of [pname_java]. */
+let proc_extract_return_typ: t => Procname.java => option Sil.typ;
+
+
+/** Check if typename is found in t */
+let mem: t => Typename.t => bool;
+
+
+/** print a type environment */
+let pp: Format.formatter => t => unit;
+
+
+/** Save a type environment into a file */
+let store_to_file: DB.filename => t => unit;
+
+
+/** Get method that is being overriden by java_pname (if any) **/
+let get_overriden_method: t => Procname.java => option Procname.t;

infer/src/IR/Typename.re

@@ -0,0 +1,61 @@
+/*
+ * Copyright (c) 2015 - present Facebook, Inc.
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+
+open! Utils;
+
+let module F = Format;
+
+
+/** Named types. */
+type t = | TN_typedef of Mangled.t | TN_enum of Mangled.t | TN_csu of Csu.t Mangled.t;
+
+let to_string =
+  fun
+  | TN_enum name
+  | TN_typedef name => Mangled.to_string name
+  | TN_csu csu name => Csu.name csu ^ " " ^ Mangled.to_string name;
+
+let pp f typename => F.fprintf f "%s" (to_string typename);
+
+let name =
+  fun
+  | TN_enum name
+  | TN_typedef name
+  | TN_csu _ name => Mangled.to_string name;
+
+let compare tn1 tn2 =>
+  switch (tn1, tn2) {
+  | (TN_typedef n1, TN_typedef n2) => Mangled.compare n1 n2
+  | (TN_typedef _, _) => (-1)
+  | (_, TN_typedef _) => 1
+  | (TN_enum n1, TN_enum n2) => Mangled.compare n1 n2
+  | (TN_enum _, _) => (-1)
+  | (_, TN_enum _) => 1
+  | (TN_csu csu1 n1, TN_csu csu2 n2) =>
+    let n = Csu.compare csu1 csu2;
+    if (n != 0) {
+      n
+    } else {
+      Mangled.compare n1 n2
+    }
+  };
+
+let equal tn1 tn2 => compare tn1 tn2 == 0;
+
+let module Java = {
+  let from_string class_name_str =>
+    TN_csu (Csu.Class Csu.Java) (Mangled.from_string class_name_str);
+};
+
+type typename_t = t;
+
+let module Set = Set.Make {
+  type t = typename_t;
+  let compare = compare;
+};

infer/src/IR/Typename.rei

@@ -0,0 +1,39 @@
+/*
+ * Copyright (c) 2015 - present Facebook, Inc.
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+
+open! Utils;
+
+
+/** Named types. */
+type t = | TN_typedef of Mangled.t | TN_enum of Mangled.t | TN_csu of Csu.t Mangled.t;
+
+
+/** convert the typename to a string */
+let to_string: t => string;
+
+let pp: Format.formatter => t => unit;
+
+
+/** name of the typename without qualifier */
+let name: t => string;
+
+
+/** Comparison for typenames */
+let compare: t => t => int;
+
+
+/** Equality for typenames */
+let equal: t => t => bool;
+
+let module Java: {
+  /** Create a typename from a Java classname in the form "package.class" */
+  let from_string: string => t;
+};
+
+let module Set: Set.S with type elt = t;

infer/src/IR/attributesTable.ml

@@ -1,73 +0,0 @@
-(*
- * Copyright (c) 2015 - present Facebook, Inc.
- * All rights reserved.
- *
- * This source code is licensed under the BSD style license found in the
- * LICENSE file in the root directory of this source tree. An additional grant
- * of patent rights can be found in the PATENTS file in the same directory.
- *)
-
-open! Utils
-
-module F = Format
-module L = Logging
-
-(** Module to manage the table of attributes. *)
-
-let serializer : ProcAttributes.t Serialization.serializer =
-  Serialization.create_serializer Serialization.attributes_key
-
-let attributes_filename pname =
-  let pname_file = Procname.to_filename pname in
-  pname_file ^ ".attr"
-
-(** path to the .attr file for the given procedure in the current results directory *)
-let res_dir_attr_filename pname =
-  let attr_fname = attributes_filename pname in
-  let bucket_dir =
-    let base = Filename.chop_extension attr_fname in
-    let len = String.length base in
-    if len < 2
-    then Filename.current_dir_name
-    else String.sub base (len - 2) 2 in
-  let filename =
-    DB.Results_dir.path_to_filename
-      DB.Results_dir.Abs_root
-      [Config.attributes_dir_name; bucket_dir; attr_fname] in
-  DB.filename_create_dir filename;
-  filename
-
-let store_attributes proc_attributes =
-  let proc_name = proc_attributes.ProcAttributes.proc_name in
-  let attributes_file = res_dir_attr_filename proc_name in
-  let should_write = (* only overwrite defined procedures *)
-    proc_attributes.ProcAttributes.is_defined ||
-    not (DB.file_exists attributes_file) in
-  if should_write then
-    Serialization.to_file serializer attributes_file proc_attributes
-
-let load_attributes proc_name =
-  let attributes_file = res_dir_attr_filename proc_name in
-  Serialization.from_file serializer attributes_file
-
-(** Given a procdesure name, find the file where it is defined and *)
-(** its corresponding type environment *)
-let find_tenv_from_class_of_proc procname =
-  match load_attributes procname with
-  | None -> None
-  | Some attrs ->
-      let source_file = attrs.ProcAttributes.loc.Location.file in
-      let source_dir = DB.source_dir_from_source_file source_file in
-      let tenv_fname = DB.source_dir_get_internal_file source_dir ".tenv" in
-      Tenv.load_from_file tenv_fname
-
-(** Given an ObjC class c, extract the type from the tenv where the class was *)
-(** defined. We do this by adding a method that is unique to each class, and then *)
-(** finding the tenv that corresponds to the class definition.  *)
-let get_correct_type_from_objc_class_name c =
-  let class_method = Procname.get_default_objc_class_method (Mangled.to_string c) in
-  match find_tenv_from_class_of_proc class_method with
-  | None -> None
-  | Some tenv ->
-      let type_name = Typename.TN_csu (Csu.Class Csu.Objc, c) in
-      Option.map (fun st -> Sil.Tstruct st) (Tenv.lookup tenv type_name)

infer/src/IR/attributesTable.mli

@@ -1,28 +0,0 @@
-(*
- * Copyright (c) 2015 - present Facebook, Inc.
- * All rights reserved.
- *
- * This source code is licensed under the BSD style license found in the
- * LICENSE file in the root directory of this source tree. An additional grant
- * of patent rights can be found in the PATENTS file in the same directory.
- *)
-
-open! Utils
-
-(** Module to manage the table of attributes. *)
-
-
-(** Save .attr file for the procedure into the attributes database. *)
-val store_attributes : ProcAttributes.t -> unit
-
-(** Load the attributes for the procedure from the attributes database. *)
-val load_attributes : Procname.t -> ProcAttributes.t option
-
-(** Given a procdesure name, find the file where it is defined and *)
-(** its corresponding type environment *)
-val find_tenv_from_class_of_proc : Procname.t -> Tenv.t option
-
-(** Given an ObjC class c, extract the type from the tenv where the class was *)
-(** defined. We do this by adding a method that is unique to each class, and then *)
-(** finding the tenv that corresponds to the class definition.  *)
-val get_correct_type_from_objc_class_name : Mangled.t -> Sil.typ option

infer/src/IR/cfg.mli

@@ -1,323 +0,0 @@
-(*
- * Copyright (c) 2009 - 2013 Monoidics ltd.
- * Copyright (c) 2013 - present Facebook, Inc.
- * All rights reserved.
- *
- * This source code is licensed under the BSD style license found in the
- * LICENSE file in the root directory of this source tree. An additional grant
- * of patent rights can be found in the PATENTS file in the same directory.
- *)
-
-open! Utils
-
-(**  Control Flow Graph for Interprocedural Analysis *)
-
-(** {2 ADT node and proc_desc} *)
-
-type node
-type cfg
-
-(** Load a cfg from a file *)
-val load_cfg_from_file: DB.filename -> cfg option
-
-(** Save a cfg into a file, and save a copy of the source files if the boolean is true *)
-val store_cfg_to_file: DB.filename -> bool -> cfg -> unit
-
-(** proc description *)
-module Procdesc : sig
-  (** proc description *)
-  type t
-
-  (** Compute the distance of each node to the exit node, if not computed already *)
-  val compute_distance_to_exit_node : t -> unit
-
-  (** Create a procdesc *)
-  val create : cfg -> ProcAttributes.t -> t
-
-  (** [remove cfg name remove_nodes] remove the procdesc [name]
-      from the control flow graph [cfg]. *)
-  (** It also removes all the nodes from the procedure from the cfg if remove_nodes is true *)
-  val remove: cfg -> Procname.t -> bool -> unit
-
-  (** Find the procdesc given the proc name. Return None if not found. *)
-  val find_from_name : cfg -> Procname.t -> t option
-
-  (** Get the attributes of the procedure. *)
-  val get_attributes : t -> ProcAttributes.t
-
-  val get_err_log : t -> Errlog.t
-
-  val get_exit_node : t -> node
-
-  (** Get flags for the proc desc *)
-  val get_flags : t -> proc_flags
-
-  (** Return name and type of formal parameters *)
-  val get_formals : t -> (Mangled.t * Sil.typ) list
-
-  (** Return loc information for the procedure *)
-  val get_loc : t -> Location.t
-
-  (** Return name and type of local variables *)
-  val get_locals : t -> (Mangled.t * Sil.typ) list
-
-  (** Return name and type of block's captured variables *)
-  val get_captured : t -> (Mangled.t * Sil.typ) list
-
-  (** Return the visibility attribute *)
-  val get_access : t -> Sil.access
-
-  val get_nodes : t -> node list
-
-  (** Get the procedure's nodes up until the first branching *)
-  val get_slope : t -> node list
-
-  (** Get the sliced procedure's nodes up until the first branching *)
-  val get_sliced_slope : t -> (node -> bool) -> node list
-
-  val get_proc_name : t -> Procname.t
-
-  (** Return the return type of the procedure and type string *)
-  val get_ret_type : t -> Sil.typ
-
-  val get_ret_var : t -> Pvar.t
-
-  val get_start_node : t -> node
-
-  (** Return [true] iff the procedure is defined, and not just declared *)
-  val is_defined : t -> bool
-
-  (** iterate over all the nodes of a procedure *)
-  val iter_nodes : (node -> unit) -> t -> unit
-
-  (** fold over the calls from the procedure: (callee, location) pairs *)
-  val fold_calls : ('a -> Procname.t * Location.t -> 'a) -> 'a -> t -> 'a
-
-  (** iterate over the calls from the procedure: (callee, location) pairs *)
-  val iter_calls : (Procname.t * Location.t -> unit) -> t -> unit
-
-  (** iterate over all nodes and their instructions *)
-  val iter_instrs : (node -> Sil.instr -> unit) -> t -> unit
-
-  (** fold over all nodes and their instructions *)
-  val fold_instrs : ('a -> node -> Sil.instr -> 'a) -> 'a -> t -> 'a
-
-  (** iterate over all nodes until we reach a branching structure *)
-  val iter_slope : (node -> unit) -> t -> unit
-
-  (** iterate over all calls until we reach a branching structure *)
-  val iter_slope_calls : (Procname.t -> unit) -> t -> unit
-
-  (** iterate between two nodes or until we reach a branching structure *)
-  val iter_slope_range : (node -> unit) -> node -> node -> unit
-
-  val set_exit_node : t -> node -> unit
-
-  (** Set a flag for the proc desc *)
-  val set_flag : t -> string -> string -> unit
-
-  val set_start_node : t -> node -> unit
-
-  (** append a list of new local variables to the existing list of local variables *)
-  val append_locals : t -> (Mangled.t * Sil.typ) list -> unit
-
-end
-
-(** node of the control flow graph *)
-module Node : sig
-  type t = node (** type of nodes *)
-
-  type id = private int
-
-  (** kind of cfg node *)
-  type nodekind =
-    | Start_node of Procdesc.t
-    | Exit_node of Procdesc.t
-    | Stmt_node of string
-    | Join_node
-    | Prune_node of bool * Sil.if_kind * string (** (true/false branch, if_kind, comment) *)
-    | Skip_node of string
-
-  (** kind of Stmt_node for an exception handler. *)
-  val exn_handler_kind : nodekind
-
-  (** kind of Stmt_node for an exceptions sink. *)
-  val exn_sink_kind : nodekind
-
-  (** kind of Stmt_node for a throw instruction. *)
-  val throw_kind : nodekind
-
-  (** Append the instructions to the list of instructions to execute *)
-  val append_instrs : t -> Sil.instr list -> unit
-
-  (** Add the instructions at the beginning of the list of instructions to execute *)
-  val prepend_instrs : t -> Sil.instr list -> unit
-
-  (** Add declarations for local variables and return variable to the node *)
-  val add_locals_ret_declaration : t -> (Mangled.t * Sil.typ) list -> unit
-
-  (** Compare two nodes *)
-  val compare : t -> t -> int
-
-  (** [create cfg loc kind instrs proc_desc] create a new cfg node
-      with the given location, kind, list of instructions,
-      procdesc *)
-  val create : cfg -> Location.t -> nodekind -> Sil.instr list -> Procdesc.t -> t
-
-  (** create a new empty cfg *)
-  val create_cfg : unit -> cfg
-
-  (** Dump extended instructions for the node *)
-  val d_instrs : sub_instrs: bool -> Sil.instr option -> t -> unit
-
-  (** Create a dummy node *)
-  val dummy : unit -> t
-
-  (** Check if two nodes are equal *)
-  val equal : t -> t -> bool
-
-  (** Get all the nodes *)
-  val get_all_nodes : cfg -> t list
-
-  (** Get the (after/before) dead program variables.
-      After/before indicated with the true/false flag. *)
-  val get_dead_pvars: t -> bool -> Pvar.t list
-
-  (** Get the distance to the exit node, if it has been computed *)
-  val get_distance_to_exit: t -> int option
-
-  (** Return a description of the node *)
-  val get_description : printenv -> t -> string
-
-  (** Get the exception nodes from the current node *)
-  val get_exn : t -> t list
-
-  (** Get the unique id of the node *)
-  val get_id : t -> id
-
-  (** compare node ids *)
-  val id_compare : id -> id -> int
-
-  (** Get the source location of the node *)
-  val get_loc : t -> Location.t
-
-  (** Get the source location of the last instruction in the node *)
-  val get_last_loc : t -> Location.t
-
-  (** Get the kind of the current node *)
-  val get_kind : t -> nodekind
-
-  (** Get the predecessor nodes of the current node *)
-  val get_preds : t -> t list
-
-  (** Get a list of unique nodes until the first branch starting
-      from a node with subsequent applications of a generator function *)
-  val get_generated_slope : t -> (t -> t list) -> t list
-
-  (** Get the proc desc associated to the node *)
-  val get_proc_desc : t -> Procdesc.t
-
-  (** Get the instructions to be executed *)
-  val get_instrs : t -> Sil.instr list
-
-  (** Get the list of callee procnames from the node *)
-  val get_callees : t -> Procname.t list
-
-  (** Get the successor nodes of the current node *)
-  val get_succs : t -> t list
-
-  (** Get the successor nodes of a node where the given predicate evaluates to true *)
-  val get_sliced_succs : t -> (t -> bool) -> t list
-
-  (** Get the predecessor nodes of a node where the given predicate evaluates to true *)
-  val get_sliced_preds : t -> (t -> bool) -> t list
-
-  (** Hash function for nodes *)
-  val hash : t -> int
-
-  (** Comparison for node kind *)
-  val kind_compare : nodekind -> nodekind -> int
-
-  (** Pretty print the node *)
-  val pp : Format.formatter -> t -> unit
-
-  val pp_id : Format.formatter -> id -> unit
-
-  (** Print extended instructions for the node,
-      highlighting the given subinstruction if present *)
-  val pp_instrs :
-    printenv -> sub_instrs: bool -> Sil.instr option -> Format.formatter -> t -> unit
-
-  (** Replace the instructions to be executed. *)
-  val replace_instrs : t -> Sil.instr list -> unit
-
-  (** Set the (after/before) dead program variables.
-      After/before indicated with the true/false flag. *)
-  val set_dead_pvars : t -> bool -> Pvar.t list -> unit
-
-  (** Set the node kind *)
-  val set_kind : t -> nodekind -> unit
-
-  (** Set the source location of the node *)
-  val set_loc : t -> Location.t -> unit
-
-  (** Set the proc desc associated to the node *)
-  val set_proc_desc : t -> Procdesc.t -> unit
-
-  (** Set the successor nodes and exception nodes, and build predecessor links *)
-  val set_succs_exn : cfg -> t -> t list -> t list -> unit
-end
-
-(** Hash table with nodes as keys. *)
-module NodeHash : Hashtbl.S with type key = Node.t
-
-(** Set of nodes. *)
-module NodeSet : Set.S with type elt = Node.t
-
-(** Map with node id keys. *)
-module IdMap : Map.S with type key = Node.id
-
-val pp_node_list : Format.formatter -> Node.t list -> unit
-
-(** {2 Functions for manipulating an interprocedural CFG} *)
-
-(** Iterate over all the procdesc's *)
-val iter_proc_desc : cfg -> (Procname.t -> Procdesc.t -> unit) -> unit
-
-(** Get all the procedures (defined and declared) *)
-val get_all_procs : cfg -> Procdesc.t list
-
-(** Get the procedures whose body is defined in this cfg *)
-val get_defined_procs : cfg -> Procdesc.t list
-
-(** get the function names which should be analyzed before the other ones *)
-val get_priority_procnames : cfg -> Procname.Set.t
-
-(** set the function names whose address has been taken in this file *)
-val set_procname_priority : cfg -> Procname.t -> unit
-
-(** remove the return variable from the prop *)
-val remove_ret : Procdesc.t -> Prop.normal Prop.t -> Prop.normal Prop.t
-
-(** remove locals and return variable from the prop *)
-val remove_locals_ret : Procdesc.t -> Prop.normal Prop.t -> Prop.normal Prop.t
-
-(** 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. *)
-val remove_locals_formals : Procdesc.t -> Prop.normal Prop.t -> Pvar.t list * Prop.normal Prop.t
-
-(** remove seed vars from a prop *)
-val remove_seed_vars : 'a Prop.t -> Prop.normal Prop.t
-
-(** checks whether a cfg is connected or not *)
-val check_cfg_connectedness : cfg -> unit
-
-(** Removes seeds variables from a prop corresponding to captured variables in an objc block *)
-val remove_seed_captured_vars_block : Mangled.t list -> Prop.normal Prop.t -> Prop.normal Prop.t
-
-(** 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 procdesc is isomorphic but
-    all the type of the parameters are replaced in the instructions according to the list.
-    The virtual calls are also replaced to match the parameter types *)
-val specialize_types :
-  Procdesc.t -> Procname.t -> (Sil.exp * Sil.typ) list -> Procdesc.t

infer/src/IR/cg.ml

@@ -1,363 +0,0 @@
-(*
- * Copyright (c) 2009 - 2013 Monoidics ltd.
- * Copyright (c) 2013 - present Facebook, Inc.
- * All rights reserved.
- *
- * This source code is licensed under the BSD style license found in the
- * LICENSE file in the root directory of this source tree. An additional grant
- * of patent rights can be found in the PATENTS file in the same directory.
- *)
-
-open! Utils
-
-(** Module for call graphs *)
-
-module L = Logging
-module F = Format
-
-type node = Procname.t
-
-type in_out_calls =
-  { in_calls: int; (** total number of in calls transitively *)
-    out_calls: int (** total number of out calls transitively *)
-  }
-
-type node_info =
-  {
-    (** defined procedure as opposed to just declared *)
-    mutable defined : bool;
-
-    mutable parents: Procname.Set.t;
-
-    mutable children: Procname.Set.t;
-
-    (** ancestors are computed lazily *)
-    mutable ancestors : Procname.Set.t option;
-
-    (** heirs are computed lazily *)
-    mutable heirs : Procname.Set.t option;
-
-    (** recursive dependents are computed lazily *)
-    mutable recursive_dependents : Procname.Set.t option;
-
-    (** calls are computed lazily *)
-    mutable in_out_calls : in_out_calls option;
-  }
-
-(** Type for call graph *)
-type t =
-  {
-    mutable source : DB.source_file; (** path for the source file *)
-    mutable nLOC : int; (** number of LOC *)
-    node_map : node_info Procname.Hash.t (** map from node to node_info *)
-  }
-
-let create () =
-  { source = !DB.current_source;
-    nLOC = !Config.nLOC;
-    node_map = Procname.Hash.create 3 }
-
-let add_node g n ~defined =
-  try
-    let info = Procname.Hash.find g.node_map n in
-    (* defined and disabled only go from false to true
-       to avoid accidental overwrite to false by calling add_edge *)
-    if defined then info.defined <- true;
-  with Not_found ->
-    let info =
-      { defined = defined;
-        parents = Procname.Set.empty;
-        children = Procname.Set.empty;
-        ancestors = None;
-        heirs = None;
-        recursive_dependents = None;
-        in_out_calls = None } in
-    Procname.Hash.add g.node_map n info
-
-let add_defined_node g n =
-  add_node g n ~defined:true
-
-
-(** Compute the ancestors of the node, if not already computed *)
-let compute_ancestors g node =
-  let todo = ref (Procname.Set.singleton node) in
-  let seen = ref Procname.Set.empty in
-  let result = ref Procname.Set.empty in
-  while not (Procname.Set.is_empty !todo) do
-    let current = Procname.Set.choose !todo in
-    todo := Procname.Set.remove current !todo;
-    if not (Procname.Set.mem current !seen) then
-      begin
-        seen := Procname.Set.add current !seen;
-        let info = Procname.Hash.find g current in
-        match info.ancestors with
-        | Some ancestors ->
-            result := Procname.Set.union !result ancestors
-        | None ->
-            result := Procname.Set.union !result info.parents;
-            todo := Procname.Set.union !todo info.parents
-      end
-  done;
-  !result
-
-(** Compute the heirs of the node, if not already computed *)
-let compute_heirs g node =
-  let todo = ref (Procname.Set.singleton node) in
-  let seen = ref Procname.Set.empty in
-  let result = ref Procname.Set.empty in
-  while not (Procname.Set.is_empty !todo) do
-    let current = Procname.Set.choose !todo in
-    todo := Procname.Set.remove current !todo;
-    if not (Procname.Set.mem current !seen) then
-      begin
-        seen := Procname.Set.add current !seen;
-        let info = Procname.Hash.find g current in
-        match info.heirs with
-        | Some heirs ->
-            result := Procname.Set.union !result heirs
-        | None ->
-            result := Procname.Set.union !result info.children;
-            todo := Procname.Set.union !todo info.children
-      end
-  done;
-  !result
-
-(** Compute the ancestors of the node, if not pre-computed already *)
-let get_ancestors (g: t) node =
-  let info = Procname.Hash.find g.node_map node in
-  match info.ancestors with
-  | None ->
-      let ancestors = compute_ancestors g.node_map node in
-      info.ancestors <- Some ancestors;
-      let size = Procname.Set.cardinal ancestors in
-      if size > 1000 then L.err "%a has %d ancestors@." Procname.pp node size;
-      ancestors
-  | Some ancestors -> ancestors
-
-(** Compute the heirs of the node, if not pre-computed already *)
-let get_heirs (g: t) node =
-  let info = Procname.Hash.find g.node_map node in
-  match info.heirs with
-  | None ->
-      let heirs = compute_heirs g.node_map node in
-      info.heirs <- Some heirs;
-      let size = Procname.Set.cardinal heirs in
-      if size > 1000 then L.err "%a has %d heirs@." Procname.pp node size;
-      heirs
-  | Some heirs -> heirs
-
-let node_defined (g: t) n =
-  try
-    let info = Procname.Hash.find g.node_map n in
-    info.defined
-  with Not_found -> false
-
-let add_edge g nfrom nto =
-  add_node g nfrom ~defined:false;
-  add_node g nto ~defined:false;
-  let info_from = Procname.Hash.find g.node_map nfrom in
-  let info_to = Procname.Hash.find g.node_map nto in
-  info_from.children <- Procname.Set.add nto info_from.children;
-  info_to.parents <- 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
-  Procname.Hash.iter (fun node info -> table := (node, info) :: !table) g.node_map;
-  let cmp ((n1: Procname.t), _) ((n2: Procname.t), _) = Procname.compare n1 n2 in
-  IList.iter (fun (n, info) -> f n info) (IList.sort cmp !table)
-
-let get_nodes (g: t) =
-  let nodes = ref Procname.Set.empty in
-  let f node _ =
-    nodes := Procname.Set.add node !nodes in
-  node_map_iter f g;
-  !nodes
-
-let compute_calls g node =
-  { in_calls = Procname.Set.cardinal (get_ancestors g node);
-    out_calls = 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 = Procname.Hash.find g.node_map node in
-  match info.in_out_calls with
-  | None ->
-      let calls = compute_calls g node in
-      info.in_out_calls <- Some calls;
-      calls
-  | Some calls -> calls
-
-let get_all_nodes (g: t) =
-  let nodes = Procname.Set.elements (get_nodes g) in
-  IList.map (fun node -> (node, get_calls g node)) nodes
-
-let get_nodes_and_calls (g: t) =
-  IList.filter (fun (n, _) -> node_defined g n) (get_all_nodes g)
-
-let node_get_num_ancestors g n =
-  (n, Procname.Set.cardinal (get_ancestors g n))
-
-let get_edges (g: t) : ((node * int) * (node * int)) list =
-  let edges = ref [] in
-  let f node info =
-    Procname.Set.iter
-      (fun nto ->
-         edges :=
-           (node_get_num_ancestors g node, node_get_num_ancestors g nto) :: !edges)
-      info.children in
-  node_map_iter f g;
-  !edges
-
-(** Return all the children of [n], whether defined or not *)
-let get_all_children (g: t) n =
-  (Procname.Hash.find g.node_map n).children
-
-(** Return the children of [n] which are defined *)
-let get_defined_children (g: t) n =
-  Procname.Set.filter (node_defined g) (get_all_children g n)
-
-(** Return the parents of [n] *)
-let get_parents (g: t) n =
-  (Procname.Hash.find g.node_map n).parents
-
-(** Check if [source] recursively calls [dest] *)
-let calls_recursively (g: t) source dest =
-  Procname.Set.mem source (get_ancestors g dest)
-
-(** Return the children of [n] which are not heirs of [n] *)
-let get_nonrecursive_dependents (g: t) n =
-  let is_not_recursive pn = not (Procname.Set.mem pn (get_ancestors g n)) in
-  let res0 = Procname.Set.filter is_not_recursive (get_all_children g n) in
-  let res = 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 = Procname.Set.mem n (get_ancestors g pn) in
-  let res0 = Procname.Set.filter reached_from_n (get_ancestors g n) in
-  let res = 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 = Procname.Hash.find g.node_map n in
-  match info.recursive_dependents with
-  | None ->
-      let recursive_dependents = compute_recursive_dependents g n in
-      info.recursive_dependents <- Some recursive_dependents;
-      recursive_dependents
-  | Some recursive_dependents -> recursive_dependents
-
-(** Return the nodes dependent on [n] *)
-let get_dependents (g: t) n =
-  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 Procname.Set.empty in
-  node_map_iter (fun n info -> if info.defined then nodes := Procname.Set.add n !nodes) g;
-  let nodes_list = Procname.Set.elements !nodes in
-  IList.map (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
-
-(** Return the list of nodes, with defined+disabled flags, and the list of edges *)
-let get_nodes_and_edges (g: t) : nodes_and_edges =
-  let nodes = ref [] in
-  let edges = ref [] in
-  let do_children node nto =
-    edges := (node, nto) :: !edges in
-  let f node info =
-    nodes := (node, info.defined) :: !nodes;
-    Procname.Set.iter (do_children node) info.children 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
-  IList.map get_node
-    (IList.filter (fun (_, defined) -> defined)
-       nodes)
-
-(** Return the path of the source file *)
-let get_source (g: t) =
-  g.source
-
-(** Return the number of LOC of the source file *)
-let get_nLOC (g: t) =
-  g.nLOC
-
-(** [extend cg1 gc2] extends [cg1] in place with nodes and edges from [gc2];
-    undefined nodes become defined if at least one side is. *)
-let extend cg_old cg_new =
-  let nodes, edges = get_nodes_and_edges cg_new in
-  IList.iter (fun (node, defined) -> add_node cg_old node ~defined) nodes;
-  IList.iter (fun (nfrom, nto) -> add_edge cg_old nfrom nto) edges
-
-(** Begin support for serialization *)
-
-let callgraph_serializer : (DB.source_file * int * nodes_and_edges) Serialization.serializer =
-  Serialization.create_serializer Serialization.cg_key
-
-(** Load a call graph from a file *)
-let load_from_file (filename : DB.filename) : t option =
-  let g = create () in
-  match Serialization.from_file callgraph_serializer filename with
-  | None -> None
-  | Some (source, nLOC, (nodes, edges)) ->
-      IList.iter
-        (fun (node, defined) ->
-           if defined then add_defined_node g node)
-        nodes;
-      IList.iter (fun (nfrom, nto) -> add_edge g nfrom nto) edges;
-      g.source <- source;
-      g.nLOC <- nLOC;
-      Some g
-
-(** Save a call graph into a file *)
-let store_to_file (filename : DB.filename) (call_graph : t) =
-  Serialization.to_file
-    callgraph_serializer
-    filename
-    (call_graph.source, call_graph.nLOC, (get_nodes_and_edges call_graph))
-
-let pp_graph_dotty get_specs (g: t) fmt =
-  let nodes_with_calls = get_all_nodes g in
-  let num_specs n = try IList.length (get_specs n) with exn when SymOp.exn_not_failure exn -> - 1 in
-  let get_color (n, _) =
-    if num_specs n != 0 then "green" else "red" in
-  let get_shape (n, _) =
-    if node_defined g n then "box" else "diamond" in
-  let pp_node fmt (n, _) =
-    F.fprintf fmt "\"%s\"" (Procname.to_filename n) in
-  let pp_node_label fmt (n, calls) =
-    F.fprintf fmt "\"%a | calls=%d %d | specs=%d)\""
-      Procname.pp n calls.in_calls calls.out_calls (num_specs n) in
-  F.fprintf fmt "digraph {@\n";
-  IList.iter
-    (fun nc ->
-       F.fprintf fmt "%a [shape=box,label=%a,color=%s,shape=%s]@\n"
-         pp_node nc pp_node_label nc (get_color nc) (get_shape nc))
-    nodes_with_calls;
-  IList.iter
-    (fun (s, d) ->
-       F.fprintf fmt "%a -> %a@\n" pp_node s pp_node d)
-    (get_edges g);
-  F.fprintf fmt "}@."
-
-(** Print the current call graph as a dotty file.
-    If the filename is [None], use the current file dir inside the DB dir. *)
-let save_call_graph_dotty fname_opt get_specs (g: t) =
-  let fname_dot = match fname_opt with
-    | None -> DB.Results_dir.path_to_filename DB.Results_dir.Abs_source_dir ["call_graph.dot"]
-    | Some fname -> fname in
-  let outc = open_out (DB.filename_to_string fname_dot) in
-  let fmt = F.formatter_of_out_channel outc in
-  pp_graph_dotty get_specs g fmt;
-  close_out outc

infer/src/IR/cg.mli

@@ -1,102 +0,0 @@
-(*
- * Copyright (c) 2009 - 2013 Monoidics ltd.
- * Copyright (c) 2013 - present Facebook, Inc.
- * All rights reserved.
- *
- * This source code is licensed under the BSD style license found in the
- * LICENSE file in the root directory of this source tree. An additional grant
- * of patent rights can be found in the PATENTS file in the same directory.
- *)
-
-open! Utils
-
-(** Module for call graphs *)
-
-type in_out_calls =
-  { in_calls: int; (** total number of in calls transitively *)
-    out_calls: int (** total number of out calls transitively *)
-  }
-
-type t (** the type of a call graph *)
-
-(** A call graph consists of a set of nodes (Procname.t), and edges between them.
-    A node can be defined or undefined (to represent whether we have code for it).
-    In an edge from [n1] to [n2], indicating that [n1] calls [n2],
-    [n1] is the parent and [n2] is the child.
-    Node [n1] is dependent on [n2] if there is a path from [n1] to [n2]
-    using the child relationship. *)
-
-(** [add_edge cg f t] adds an edge from [f] to [t] in the call graph [cg].
-    The nodes are also added as undefined, unless already present. *)
-val add_edge : t -> Procname.t -> Procname.t -> unit
-
-(** Add a node to the call graph as defined *)
-val add_defined_node : t -> Procname.t -> unit
-
-(** Check if [source] recursively calls [dest] *)
-val calls_recursively: t -> Procname.t -> Procname.t -> bool
-
-(** Create an empty call graph *)
-val create : unit -> t
-
-(** [extend cg1 gc2] extends [cg1] in place with nodes and edges from [gc2];
-    undefined nodes become defined if at least one side is. *)
-val extend : t -> t -> unit
-
-(** Return all the children of [n], whether defined or not *)
-val get_all_children : t -> Procname.t -> Procname.Set.t
-
-(** Compute the ancestors of the node, if not pre-computed already *)
-val get_ancestors : t -> Procname.t -> Procname.Set.t
-
-(** Compute the heirs of the node, if not pre-computed already *)
-val get_heirs : t -> Procname.t -> Procname.Set.t
-
-(** Return the in/out calls of the node *)
-val get_calls : t -> Procname.t -> in_out_calls
-
-(** Return the list of nodes which are defined *)
-val get_defined_nodes : t -> Procname.t list
-
-(** Return the children of [n] which are defined *)
-val get_defined_children: t -> Procname.t -> Procname.Set.t
-
-(** Return the nodes dependent on [n] *)
-val get_dependents: t -> Procname.t -> Procname.Set.t
-
-(** Return the number of LOC of the source file *)
-val get_nLOC: t -> int
-
-(** Return the list of nodes with calls *)
-val get_nodes_and_calls : t -> (Procname.t * in_out_calls) list
-
-(** Return all the nodes with their defined children *)
-val get_nodes_and_defined_children : t -> (Procname.t * Procname.Set.t) list
-
-(** Return the list of nodes, with defined flag, and the list of edges *)
-val get_nodes_and_edges : t -> (Procname.t * bool) list * (Procname.t * Procname.t) list
-
-(** Return the children of [n] which are not heirs of [n] and are defined *)
-val get_nonrecursive_dependents : t -> Procname.t -> Procname.Set.t
-
-(** Return the parents of [n] *)
-val get_parents : t -> Procname.t -> Procname.Set.t
-
-(** Return the ancestors of [n] which are also heirs of [n] *)
-val get_recursive_dependents: t -> Procname.t -> Procname.Set.t
-
-(** Return the path of the source file *)
-val get_source : t -> DB.source_file
-
-(** Load a call graph from a file *)
-val load_from_file : DB.filename -> t option
-
-(** Returns true if the node is defined *)
-val node_defined : t -> Procname.t -> bool
-
-(** Print the current call graph as a dotty file. If the filename is [None],
-    use the current file dir inside the DB dir. *)
-val save_call_graph_dotty : DB.filename option -> (Procname.t -> 'a list) -> t -> unit
-
-(** Save a call graph into a file *)
-val store_to_file : DB.filename -> t -> unit

infer/src/IR/csu.ml

@@ -1,55 +0,0 @@
-(*
- * Copyright (c) 2015 - present Facebook, Inc.
- * All rights reserved.
- *
- * This source code is licensed under the BSD style license found in the
- * LICENSE file in the root directory of this source tree. An additional grant
- * of patent rights can be found in the PATENTS file in the same directory.
- *)
-
-open! Utils
-
-(** Internal representation of data structure for Java, Objective-C and C++ classes,
-    C-style structs struct and union,
-    And Objective C protocol *)
-
-type class_kind =
-  | CPP
-  | Java
-  | Objc
-
-type t =
-  | Class of class_kind
-  | Struct
-  | Union
-  | Protocol
-
-let name = function
-  | Class _ -> "class"
-  | Struct -> "struct"
-  | Union -> "union"
-  | Protocol -> "protocol"
-
-let class_kind_num = function
-  | CPP -> 1
-  | Java -> 2
-  | Objc -> 3
-
-let class_kind_compare ck1 ck2 =
-  (class_kind_num ck1) - (class_kind_num ck2)
-
-let compare dstruct1 dstruct2 =
-  match dstruct1, dstruct2 with
-  | Class ck1, Class ck2 -> class_kind_compare ck1 ck2
-  | Class _, _ -> -1
-  | _, Class _ -> 1
-  | Struct, Struct -> 0
-  | Struct, _ -> -1
-  | _, Struct -> 1
-  | Union, Union -> 0
-  | Union, _ -> -1
-  | _, Union -> 1
-  | Protocol, Protocol -> 0
-
-let equal tn1 tn2 =
-  compare tn1 tn2 = 0

infer/src/IR/ident.ml

@@ -1,371 +0,0 @@
-(*
- * Copyright (c) 2009 - 2013 Monoidics ltd.
- * Copyright (c) 2013 - present Facebook, Inc.
- * All rights reserved.
- *
- * This source code is licensed under the BSD style license found in the
- * LICENSE file in the root directory of this source tree. An additional grant
- * of patent rights can be found in the PATENTS file in the same directory.
- *)
-
-open! Utils
-
-(** Module for Names and Identifiers *)
-
-module L = Logging
-module F = Format
-
-type name = string
-
-type fieldname =
-  { fpos : int;
-    fname : Mangled.t }
-
-type kind = int
-
-let kprimed = - 1
-let knormal = 0
-let kfootprint = 1
-
-type t =
-  { kind: int;
-    name: name;
-    stamp: int }
-
-type _ident = t
-
-(** {2 Comparison Functions} *)
-
-let name_compare = string_compare
-
-let fieldname_compare fn1 fn2 =
-  let n = int_compare fn1.fpos fn2.fpos in
-  if n <> 0 then n else Mangled.compare fn1.fname fn2.fname
-
-let name_equal = string_equal
-
-let kind_equal k1 k2 = k1 == k2
-
-let compare i1 i2 =
-  let n = i2.kind - i1.kind
-  in if n <> 0 then n
-  else
-    let n = name_compare i1.name i2.name
-    in if n <> 0 then n
-    else int_compare i1.stamp i2.stamp
-
-let equal i1 i2 =
-  i1.stamp == i2.stamp && i1.kind == i2.kind && name_equal i1.name i2.name (* most unlikely first *)
-
-let fieldname_equal fn1 fn2 =
-  fieldname_compare fn1 fn2 = 0
-
-let rec ident_list_compare il1 il2 = match il1, il2 with
-  | [],[] -> 0
-  | [], _ -> - 1
-  | _,[] -> 1
-  | i1:: l1, i2:: l2 ->
-      let n = compare i1 i2
-      in if n <> 0 then n
-      else ident_list_compare l1 l2
-
-let ident_list_equal ids1 ids2 = (ident_list_compare ids1 ids2 = 0)
-
-(** {2 Set for identifiers} *)
-
-module IdentSet = Set.Make
-    (struct
-      type t = _ident
-      let compare = compare
-    end)
-
-module IdentMap = Map.Make
-    (struct
-      type t = _ident
-      let compare = compare
-    end)
-
-module IdentHash =
-  Hashtbl.Make(struct
-    type t = _ident
-    let equal = equal
-    let hash (id: t) = Hashtbl.hash id
-  end)
-
-module FieldSet = Set.Make(struct
-    type t = fieldname
-    let compare = fieldname_compare
-  end)
-
-module FieldMap = Map.Make(struct
-    type t = fieldname
-    let compare = fieldname_compare
-  end)
-
-let idlist_to_idset ids =
-  IList.fold_left (fun set id -> IdentSet.add id set) IdentSet.empty ids
-
-(** {2 Conversion between Names and Strings} *)
-
-module StringHash =
-  Hashtbl.Make(struct
-    type t = string
-    let equal (s1: string) (s2: string) = s1 = s2
-    let hash = Hashtbl.hash
-  end)
-
-module NameHash =
-  Hashtbl.Make(struct
-    type t = name
-    let equal = name_equal
-    let hash = Hashtbl.hash
-  end)
-
-(** Convert a string to a name *)
-let string_to_name (s: string) =
-  s
-
-(** Create a field name with the given position (field number in the CSU) *)
-let create_fieldname (n: Mangled.t) (position: int) =
-  { fpos = position;
-    fname = n }
-
-(** Convert a name to a string. *)
-let name_to_string (name: name) =
-  name
-
-(** Convert a fieldname to a string. *)
-let fieldname_to_string fn = Mangled.to_string fn.fname
-
-(** Convert a fieldname to a simplified string with at most one-level path. *)
-let fieldname_to_simplified_string fn =
-  let s = Mangled.to_string fn.fname in
-  match string_split_character s '.' with
-  | Some s1, s2 ->
-      (match string_split_character s1 '.' with
-       | Some _, s4 -> s4 ^ "." ^ s2
-       | _ -> s)
-  | _ -> s
-
-(** Convert a fieldname to a flat string without path. *)
-let fieldname_to_flat_string fn =
-  let s = Mangled.to_string fn.fname in
-  match string_split_character s '.' with
-  | Some _, s2 -> s2
-  | _ -> s
-
-(** Returns the class part of the fieldname *)
-let java_fieldname_get_class fn =
-  let fn = fieldname_to_string fn in
-  let ri = String.rindex fn '.' in
-  String.sub fn 0 ri
-
-(** Returns the last component of the fieldname *)
-let java_fieldname_get_field fn =
-  let fn = fieldname_to_string fn in
-  let ri = 1 + String.rindex fn '.' in
-  String.sub fn ri (String.length fn - ri)
-
-(** Check if the field is the synthetic this$n of a nested class, used to access the n-th outher instance. *)
-let java_fieldname_is_outer_instance fn =
-  let fn = fieldname_to_string fn in
-  let fn_len = String.length fn in
-  let this = ".this$" in
-  let this_len = String.length this in
-  let zero_to_nine s = s >= "0" && s <= "9" in
-  fn_len > this_len &&
-  String.sub fn (fn_len - this_len - 1) this_len = this &&
-  zero_to_nine (String.sub fn (fn_len - 1) 1)
-
-let fieldname_offset fn = fn.fpos
-
-(** hidded fieldname constant *)
-let fieldname_hidden = create_fieldname (Mangled.from_string ".hidden") 0
-
-(** hidded fieldname constant *)
-let fieldname_is_hidden fn =
-  fieldname_equal fn fieldname_hidden
-
-(** {2 Functions and Hash Tables for Managing Stamps} *)
-
-(** Set the stamp of the identifier *)
-let set_stamp i stamp =
-  { i with stamp = stamp }
-
-(** Get the stamp of the identifier *)
-let get_stamp i =
-  i.stamp
-
-module NameGenerator = struct
-  type t = int NameHash.t
-
-  let create () : t = NameHash.create 17
-
-  (** Map from names to stamps. *)
-  let name_map = ref (create ())
-
-  let get_current () =
-    !name_map
-
-  let set_current map =
-    name_map := map
-
-  (** Reset the name generator *)
-  let reset () =
-    name_map := create ()
-
-  (** Create a fresh identifier with the given kind and name. *)
-  let create_fresh_ident kind name =
-    let stamp =
-      try
-        let stamp = NameHash.find !name_map name in
-        NameHash.replace !name_map name (stamp + 1);
-        stamp + 1
-      with Not_found ->
-        NameHash.add !name_map name 0;
-        0 in
-    { kind = kind; name = name; stamp = stamp }
-
-  (** Make sure that fresh ids after whis one will be with different stamps *)
-  let update_name_hash name stamp =
-    try
-      let curr_stamp = NameHash.find !name_map name in
-      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 primed tmp variables *)
-let name_primed = string_to_name "t"
-
-(** Name used for normal tmp variables *)
-let name_normal = string_to_name "n"
-
-(** Name used for footprint tmp variables *)
-let name_footprint = string_to_name "f"
-
-(** Name used for spec variables *)
-let name_spec = string_to_name "val"
-
-(** Name used for the return variable *)
-let name_return = Mangled.from_string "return"
-
-(** Return the standard name for the given kind *)
-let standard_name kind =
-  if kind == knormal then name_normal
-  else if 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 = kind; name = name; stamp = stamp; }
-
-(** Create an identifier with default name for the given kind *)
-let create kind stamp =
-  create_with_stamp kind (standard_name kind) stamp
-
-(** Generate a normal identifier with the given name and stamp *)
-let create_normal name stamp =
-  create_with_stamp knormal name stamp
-
-(** Generate a primed identifier with the given name and stamp *)
-let create_primed name stamp =
-  create_with_stamp kprimed name stamp
-
-(** Generate a footprint identifier with the given name and stamp *)
-let create_footprint name stamp =
-  create_with_stamp kfootprint name stamp
-
-(** {2 Functions for Identifiers} *)
-
-(** Get a name of an identifier *)
-let get_name id =
-  id.name
-
-let get_kind id =
-  id.kind
-
-let is_primed (id: t) =
-  id.kind == kprimed
-
-let is_normal (id: t) =
-  id.kind == knormal
-
-let is_footprint (id: t) =
-  id.kind == kfootprint
-
-(* timestamp for a path identifier *)
-let path_ident_stamp = - 3
-
-let is_path (id: t) =
-  id.kind == knormal && id.stamp = path_ident_stamp
-
-let make_unprimed id =
-  if id.kind <> kprimed then assert false
-  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
-  IList.iter upd ids
-
-(** Create a fresh identifier with default name for the given kind. *)
-let create_fresh kind =
-  NameGenerator.create_fresh_ident kind (standard_name kind)
-
-(** 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. *)
-let to_string id =
-  let base_name = name_to_string id.name in
-  let prefix =
-    if id.kind == kfootprint then "@"
-    else if id.kind == knormal then ""
-    else "_" in
-  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)
-
-let pp_fieldname f fn =
-  (* only use for debug F.fprintf f "%a#%d" pp_name fn.fname fn.fpos *)
-  Mangled.pp f fn.fname
-
-(** Pretty print a name in latex. *)
-let pp_name_latex style f (name: name) =
-  Latex.pp_string style f (name_to_string name)
-
-let pp_fieldname_latex style f fn =
-  Latex.pp_string style f (Mangled.to_string fn.fname)
-
-(** Pretty print an identifier. *)
-let pp pe f id = match pe.pe_kind with
-  | PP_TEXT | PP_HTML ->
-      F.fprintf f "%s" (to_string id)
-  | PP_LATEX ->
-      let base_name = name_to_string id.name in
-      let style =
-        if id.kind = kfootprint then Latex.Boldface
-        else if id.kind = knormal then Latex.Roman
-        else Latex.Roman 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)
-
-(** pretty printer for lists of names *)
-let pp_name_list = pp_comma_seq pp_name
-
-(*
-let make_ident_primed id =
-  if id.kind == kprimed then assert false
-  else { id with kind = kprimed }
-*)

infer/src/IR/ident.mli

@@ -1,211 +0,0 @@
-(*
- * Copyright (c) 2009 - 2013 Monoidics ltd.
- * Copyright (c) 2013 - present Facebook, Inc.
- * All rights reserved.
- *
- * This source code is licensed under the BSD style license found in the
- * LICENSE file in the root directory of this source tree. An additional grant
- * of patent rights can be found in the PATENTS file in the same directory.
- *)
-
-open! Utils
-
-(** Identifiers: program variables and logical variables *)
-
-(** Program and logical variables. *)
-type t
-
-(** Names used to replace strings. *)
-type name
-
-(** Names for fields of class/struct/union *)
-type fieldname
-
-(** Kind of identifiers. *)
-type kind
-
-(** Set for identifiers. *)
-module IdentSet : Set.S with type elt = t
-
-(** Hash table with ident as key. *)
-module IdentHash : Hashtbl.S with type key = t
-
-(** Map with ident as key. *)
-module IdentMap : Map.S with type key = t
-
-(** Set for fieldnames *)
-module FieldSet : Set.S with type elt = fieldname
-
-(** Map for fieldnames *)
-module FieldMap : Map.S with type key = fieldname
-
-module NameGenerator : sig
-  type t
-
-  (** Get the current name generator. *)
-  val get_current : unit -> t
-
-  (** Reset the name generator. *)
-  val reset : unit -> unit
-
-  (** Set the current name generator. *)
-  val set_current : t -> unit
-end
-
-(** Convert an identfier list to an identifier set *)
-val idlist_to_idset : t list -> IdentSet.t
-
-val kprimed : kind
-val knormal : kind
-val kfootprint : kind
-
-(** hash table with names as keys *)
-module NameHash : Hashtbl.S with type key = name
-
-(** Name used for primed tmp variables *)
-val name_primed : name
-
-(** Name used for spec variables *)
-val name_spec : name
-
-(** Name used for the return variable *)
-val name_return : Mangled.t
-
-(** Convert a string to a name. *)
-val string_to_name : string -> name
-
-(** Create a field name at the given position *)
-val create_fieldname : Mangled.t -> int -> fieldname
-
-(** Convert a name to a string. *)
-val name_to_string : name -> string
-
-(** Convert a field name to a string. *)
-val fieldname_to_string : fieldname -> string
-
-(** Convert a fieldname to a simplified string with at most one-level path. *)
-val fieldname_to_simplified_string : fieldname -> string
-
-(** Convert a fieldname to a flat string without path. *)
-val fieldname_to_flat_string : fieldname -> string
-
-(** The class part of the fieldname *)
-val java_fieldname_get_class : fieldname -> string
-
-(** The last component of the fieldname *)
-val java_fieldname_get_field : fieldname -> string
-
-(** Check if the field is the synthetic this$n of a nested class, used to access the n-th outher instance. *)
-val java_fieldname_is_outer_instance : fieldname -> bool
-
-(** get the offset of a fieldname *)
-val fieldname_offset : fieldname -> int
-
-(** hidded fieldname constant *)
-val fieldname_hidden : fieldname
-
-(** hidded fieldname constant *)
-val fieldname_is_hidden : fieldname -> bool
-
-(** Name of the identifier. *)
-val get_name : t -> name
-
-(** Kind of the identifier. *)
-val get_kind : t -> kind
-
-(** Create an identifier with default name for the given kind *)
-val create : kind -> int -> t
-
-(** Generate a normal identifier with the given name and stamp. *)
-val create_normal : name -> int -> t
-
-(** Generate a primed identifier with the given name and stamp. *)
-val create_primed : name -> int -> t
-
-(** Generate a footprint identifier with the given name and stamp. *)
-val create_footprint : name -> int -> t
-
-(** Update the name generator so that the given id's are not generated again *)
-val update_name_generator : t list -> unit
-
-(** Create a fresh identifier with default name for the given kind. *)
-val create_fresh : kind -> t
-
-(** Generate a normal identifier whose name encodes a path given as a string. *)
-val create_path : string -> t
-
-(** Check whether an identifier is primed or not. *)
-val is_primed : t -> bool
-
-(** Check whether an identifier is normal or not. *)
-val is_normal : t -> bool
-
-(** Check whether an identifier is footprint or not. *)
-val is_footprint : t -> bool
-
-(** Check whether an identifier represents a path or not. *)
-val is_path : t -> bool
-
-(** Convert a primed ident into a nonprimed one, keeping the stamp. *)
-val make_unprimed : t -> t
-
-(** Get the stamp of the identifier *)
-val get_stamp: t -> int
-
-(** Set the stamp of the identifier *)
-val set_stamp: t -> int -> t
-
-(** {2 Comparision Functions} *)
-
-(** Comparison for names. *)
-val name_compare : name -> name -> int
-
-(** Comparison for field names. *)
-val fieldname_compare : fieldname -> fieldname -> int
-
-(** Equality for names. *)
-val name_equal : name -> name -> bool
-
-(** Equality for field names. *)
-val fieldname_equal : fieldname -> fieldname -> bool
-
-(** Equality for kind. *)
-val kind_equal : kind -> kind -> bool
-
-(** Comparison for identifiers. *)
-val compare : t -> t -> int
-
-(** Equality for identifiers. *)
-val equal : t -> t -> bool
-
-(** Comparison for lists of identities *)
-val ident_list_compare : t list -> t list -> int
-
-(** Equality for lists of identities *)
-val ident_list_equal : t list -> t list -> bool
-
-(** {2 Pretty Printing} *)
-
-(** Pretty print a name. *)
-val pp_name : Format.formatter -> name -> unit
-
-(** Pretty print a field name. *)
-val pp_fieldname : Format.formatter -> fieldname -> unit
-
-(** Pretty print a name in latex. *)
-val pp_name_latex : Latex.style -> Format.formatter -> name -> unit
-
-(** Pretty print a field name in latex. *)
-val pp_fieldname_latex : Latex.style -> Format.formatter -> fieldname -> unit
-
-(** Pretty print an identifier. *)
-val pp : printenv -> Format.formatter -> t -> unit
-
-(** Convert an identifier to a string. *)
-val to_string : t -> string
-
-(** Pretty print a list of identifiers. *)
-val pp_list : printenv -> Format.formatter -> t list -> unit
-
-(** Pretty print a list of names. *)
-val pp_name_list : Format.formatter -> name list -> unit

infer/src/IR/location.ml

@@ -1,49 +0,0 @@
-(*
- * Copyright (c) 2015 - present Facebook, Inc.
- * All rights reserved.
- *
- * This source code is licensed under the BSD style license found in the
- * LICENSE file in the root directory of this source tree. An additional grant
- * of patent rights can be found in the PATENTS file in the same directory.
- *)
-
-open! Utils
-
-module F = Format
-module L = Logging
-
-(** Location in the original source file *)
-type t = {
-  line: int; (** The line number. -1 means "do not know" *)
-  col: int; (** The column number. -1 means "do not know" *)
-  file: DB.source_file; (** The name of the source file *)
-  nLOC : int; (** Lines of code in the source file *)
-}
-
-let compare loc1 loc2 =
-  let n = int_compare loc1.line loc2.line in
-  if n <> 0 then n else DB.source_file_compare loc1.file loc2.file
-
-(** Dump a location *)
-let d (loc: t) = L.add_print_action (L.PTloc, Obj.repr loc)
-
-(** Dummy location *)
-let dummy = {
-  line = -1;
-  col = -1;
-  file = DB.source_file_empty;
-  nLOC = -1;
-}
-
-let equal loc1 loc2 =
-  compare loc1 loc2 = 0
-
-(** Pretty print a location *)
-let pp f (loc: t) =
-  F.fprintf f "[line %d]" loc.line
-
-let to_string loc =
-  let s = (string_of_int loc.line) in
-  if (loc.col != -1) then
-    s ^":"^(string_of_int loc.col)
-  else s

infer/src/IR/location.mli

@@ -1,34 +0,0 @@
-(*
- * Copyright (c) 2015 - present Facebook, Inc.
- * All rights reserved.
- *
- * This source code is licensed under the BSD style license found in the
- * LICENSE file in the root directory of this source tree. An additional grant
- * of patent rights can be found in the PATENTS file in the same directory.
- *)
-
-open! Utils
-
-(** Location in the original source file *)
-type t = {
-  line: int; (** The line number. -1 means "do not know" *)
-  col: int; (** The column number. -1 means "do not know" *)
-  file: DB.source_file; (** The name of the source file *)
-  nLOC : int; (** Lines of code in the source file *)
-}
-
-val compare : t -> t -> int
-
-(** Dump a location. *)
-val d : t -> unit
-
-(** Dummy location *)
-val dummy : t
-
-val equal : t -> t -> bool
-
-(** Pretty print a location. *)
-val pp : Format.formatter -> t -> unit
-
-(** String representation of a location. *)
-val to_string : t -> string

infer/src/IR/mangled.ml

@@ -1,74 +0,0 @@
-(*
- * Copyright (c) 2009 - 2013 Monoidics ltd.
- * Copyright (c) 2013 - present Facebook, Inc.
- * All rights reserved.
- *
- * This source code is licensed under the BSD style license found in the
- * LICENSE file in the root directory of this source tree. An additional grant
- * of patent rights can be found in the PATENTS file in the same directory.
- *)
-
-open! Utils
-
-(** Module for Mangled Names *)
-
-module F = Format
-
-type t =
-  { plain: string;
-    mangled: string option }
-
-let mangled_compare so1 so2 = match so1, so2 with
-  | None, None -> 0
-  | None, Some _ -> -1
-  | Some _, None -> 1
-  | Some s1, Some s2 -> string_compare s1 s2
-
-let compare pn1 pn2 =
-  let n = string_compare pn1.plain pn2.plain in
-  if n <> 0 then n else mangled_compare pn1.mangled pn2.mangled
-
-let equal pn1 pn2 =
-  compare pn1 pn2 = 0
-
-(** Convert a string to a mangled name *)
-let from_string (s: string) =
-  { plain = s;
-    mangled = None }
-
-(** Create a mangled name from a plain and mangled string *)
-let mangled (plain: string) (mangled: string) =
-  { plain = plain;
-    mangled = Some (plain ^ "{" ^ mangled ^ "}") }
-
-(** Convert a mangled name to a string *)
-let to_string (pn: t) =
-  pn.plain
-
-(** Convert a full mangled name to a string *)
-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
-
-(** Create a mangled type name from a package name and a class name *)
-let from_package_class package_name class_name =
-  if package_name = "" then from_string class_name
-  else from_string (package_name ^ "." ^ class_name)
-
-(** Pretty print a mangled name *)
-let pp f pn =
-  F.fprintf f "%s" (to_string pn)
-
-
-type mangled_t = t
-module MangledSet = Set.Make
-    (struct
-      type t = mangled_t
-      let compare = compare
-    end)

infer/src/IR/mangled.mli

@@ -1,46 +0,0 @@
-(*
- * Copyright (c) 2009 - 2013 Monoidics ltd.
- * Copyright (c) 2013 - present Facebook, Inc.
- * All rights reserved.
- *
- * This source code is licensed under the BSD style license found in the
- * LICENSE file in the root directory of this source tree. An additional grant
- * of patent rights can be found in the PATENTS file in the same directory.
- *)
-
-open! Utils
-
-(** Module for Mangled Names *)
-
-(** Type of mangled names *)
-type t
-
-(** Comparison for mangled names *)
-val compare : t -> t -> int
-
-(** Equality for mangled names *)
-val equal : t -> t -> bool
-
-(** Convert a string to a mangled name *)
-val from_string : string -> t
-
-(** Create a mangled type name from a package name and a class name *)
-val from_package_class : string -> string -> t
-
-(** Create a mangled name from a plain and mangled string *)
-val mangled : string -> string -> t
-
-(** Convert a mangled name to a string *)
-val to_string : t -> string
-
-(** Convert a full mangled name to a string *)
-val to_string_full : t -> string
-
-(** Get mangled string if given *)
-val get_mangled : t -> string
-
-(** Pretty print a mangled name *)
-val pp : Format.formatter -> t -> unit
-
-(** Set of Mangled. *)
-module MangledSet : Set.S with type elt = t

infer/src/IR/procAttributes.ml

@@ -1,69 +0,0 @@
-(*
- * Copyright (c) 2015 - present Facebook, Inc.
- * All rights reserved.
- *
- * This source code is licensed under the BSD style license found in the
- * LICENSE file in the root directory of this source tree. An additional grant
- * of patent rights can be found in the PATENTS file in the same directory.
- *)
-
-open! Utils
-
-(** Attributes of a procedure. *)
-
-module L = Logging
-module F = Format
-
-(** Type for ObjC accessors *)
-type objc_accessor_type =
-  | Objc_getter of Ident.fieldname
-  | Objc_setter of Ident.fieldname
-
-type t =
-  {
-    access : Sil.access; (** visibility access *)
-    captured : (Mangled.t * Sil.typ) list; (** name and type of variables captured in blocks *)
-    mutable changed : bool; (** true if proc has changed since last analysis *)
-    err_log: Errlog.t; (** Error log for the procedure *)
-    exceptions : string list; (** exceptions thrown by the procedure *)
-    formals : (Mangled.t * Sil.typ) list; (** name and type of formal parameters *)
-    func_attributes : Sil.func_attribute list;
-    is_abstract : bool; (** the procedure is abstract *)
-    mutable is_bridge_method : bool; (** the procedure is a bridge method *)
-    is_defined : bool; (** true if the procedure is defined, and not just declared *)
-    is_objc_instance_method : bool; (** the procedure is an objective-C instance method *)
-    is_cpp_instance_method : bool; (** the procedure is an C++ instance method *)
-    mutable is_synthetic_method : bool; (** the procedure is a synthetic method *)
-    language : Config.language; (** language of the procedure *)
-    loc : Location.t; (** location of this procedure in the source code *)
-    mutable locals : (Mangled.t * Sil.typ) list; (** name and type of local variables *)
-    method_annotation : Sil.method_annotation; (** annotations for java methods *)
-    objc_accessor : objc_accessor_type option; (** type of ObjC accessor, if any *)
-    proc_flags : proc_flags; (** flags of the procedure *)
-    proc_name : Procname.t; (** name of the procedure *)
-    ret_type : Sil.typ; (** return type *)
-  }
-
-let default proc_name language = {
-  access = Sil.Default;
-  captured = [];
-  changed = true;
-  err_log = Errlog.empty ();
-  exceptions = [];
-  formals = [];
-  func_attributes = [];
-  is_abstract = false;
-  is_bridge_method = false;
-  is_cpp_instance_method = false;
-  is_defined = false;
-  is_objc_instance_method = false;
-  is_synthetic_method = false;
-  language;
-  loc = Location.dummy;
-  locals = [];
-  method_annotation = Sil.method_annotation_empty;
-  objc_accessor = None;
-  proc_flags = proc_flags_empty ();
-  proc_name;
-  ret_type = Sil.Tvoid;
-}

infer/src/IR/procAttributes.mli

@@ -1,44 +0,0 @@
-(*
- * Copyright (c) 2015 - present Facebook, Inc.
- * All rights reserved.
- *
- * This source code is licensed under the BSD style license found in the
- * LICENSE file in the root directory of this source tree. An additional grant
- * of patent rights can be found in the PATENTS file in the same directory.
- *)
-
-open! Utils
-
-(** Attributes of a procedure. *)
-
-type objc_accessor_type =
-  | Objc_getter of Ident.fieldname
-  | Objc_setter of Ident.fieldname
-
-type t =
-  {
-    access : Sil.access; (** visibility access *)
-    captured : (Mangled.t * Sil.typ) list; (** name and type of variables captured in blocks *)
-    mutable changed : bool; (** true if proc has changed since last analysis *)
-    err_log: Errlog.t; (** Error log for the procedure *)
-    exceptions : string list; (** exceptions thrown by the procedure *)
-    formals : (Mangled.t * Sil.typ) list; (** name and type of formal parameters *)
-    func_attributes : Sil.func_attribute list;
-    is_abstract : bool; (** the procedure is abstract *)
-    mutable is_bridge_method : bool; (** the procedure is a bridge method *)
-    is_defined : bool; (** true if the procedure is defined, and not just declared *)
-    is_objc_instance_method : bool; (** the procedure is an objective-C instance method *)
-    is_cpp_instance_method : bool; (** the procedure is an C++ instance method *)
-    mutable is_synthetic_method : bool; (** the procedure is a synthetic method *)
-    language : Config.language; (** language of the procedure *)
-    loc : Location.t; (** location of this procedure in the source code *)
-    mutable locals : (Mangled.t * Sil.typ) list; (** name and type of local variables *)
-    method_annotation : Sil.method_annotation; (** annotations for java methods *)
-    objc_accessor : objc_accessor_type option; (** type of ObjC accessor, if any *)
-    proc_flags : proc_flags; (** flags of the procedure *)
-    proc_name : Procname.t; (** name of the procedure *)
-    ret_type : Sil.typ; (** return type *)
-  }
-
-(** Create a proc_attributes with default values. *)
-val default : Procname.t -> Config.language -> t

infer/src/IR/procname.ml

@@ -1,515 +0,0 @@
-(*
- * Copyright (c) 2009 - 2013 Monoidics ltd.
- * Copyright (c) 2013 - present Facebook, Inc.
- * All rights reserved.
- *
- * This source code is licensed under the BSD style license found in the
- * LICENSE file in the root directory of this source tree. An additional grant
- * of patent rights can be found in the PATENTS file in the same directory.
- *)
-
-open! Utils
-
-(** Module for Procedure Names *)
-
-module L = Logging
-module F = Format
-
-type java_type = string option * string (* e.g. ("", "int") for primitive types or ("java.io", "PrintWriter") for objects *)
-
-type method_kind =
-  | Static (* in Java, procedures called with invokestatic *)
-  | Non_Static (* in Java, procedures called with invokevirtual, invokespecial, and invokeinterface *)
-
-(** Type of java procedure names. *)
-type java = {
-  class_name: java_type;
-  return_type: java_type option; (* option because constructors have no return type *)
-  method_name: string;
-  parameters: java_type list;
-  kind: method_kind
-}
-
-(** Type of c procedure names. *)
-type c = string * (string option)
-
-(** Type of Objective C and C++ procedure names: method signatures. *)
-type objc_cpp = {
-  class_name: string;
-  method_name: string;
-  mangled: string option;
-}
-
-(** Type of Objective C block names. *)
-type block = string
-
-(** Type of procedure names. *)
-type t =
-  | Java of java
-  | C of c
-  | ObjC_Cpp of objc_cpp
-  | Block of block
-
-(** Level of verbosity of some to_string functions. *)
-type detail_level =
-  | Verbose
-  | Non_verbose
-  | Simple
-
-type objc_method_kind =
-  | Instance_objc_method
-  | Class_objc_method
-
-let mangled_of_objc_method_kind kind =
-  match kind with
-  | Instance_objc_method -> Some "instance"
-  | Class_objc_method -> Some "class"
-
-let objc_method_kind_of_bool is_instance =
-  if is_instance then Instance_objc_method
-  else Class_objc_method
-
-let empty_block = Block ""
-
-let is_verbose v =
-  match v with
-  | Verbose -> true
-  | _ -> false
-
-type proc_name = t
-
-let mangled_compare so1 so2 = match so1, so2 with
-  | None, None -> 0
-  | None, Some _ -> -1
-  | Some _, None -> 1
-  | Some s1, Some s2 -> string_compare s1 s2
-
-let method_kind_compare k0 k1 =
-  match k0, k1 with
-  | _ when k0 = k1 -> 0
-  | Static, _ -> 1
-  | Non_Static, _ -> -1
-
-(** A type is a pair (package, type_name) that is translated in a string package.type_name *)
-let java_type_to_string_verbosity p verbosity =
-  match p with
-  | (None, typ) -> typ
-  | (Some p, cls) ->
-      if is_verbose verbosity then p ^ "." ^ cls
-      else cls
-
-let java_type_to_string p =
-  java_type_to_string_verbosity p Verbose
-
-(** Given a list of types, it creates a unique string of types separated by commas *)
-let rec java_param_list_to_string inputList verbosity =
-  match inputList with
-  | [] -> ""
-  | [head] -> java_type_to_string_verbosity head verbosity
-  | head :: rest ->
-      (java_type_to_string_verbosity head verbosity) ^ "," ^ (java_param_list_to_string rest verbosity)
-
-(** It is the same as java_type_to_string, but Java return types are optional because of constructors without type *)
-let java_return_type_to_string j verbosity =
-  match j.return_type with
-  | None -> ""
-  | Some typ ->
-      java_type_to_string_verbosity typ verbosity
-
-let java_type_compare (p1, c1) (p2, c2) =
-  string_compare c1 c2 |> next mangled_compare p1 p2
-
-let rec java_type_list_compare jt1 jt2 =
-  match jt1, jt2 with
-  | [], [] -> 0
-  | [], _ -> -1
-  | _, [] -> 1
-  | (x1:: rest1), (x2:: rest2) ->
-      java_type_compare x1 x2 |> next java_type_list_compare rest1 rest2
-
-let java_return_type_compare jr1 jr2 =
-  match jr1, jr2 with
-  | None, None -> 0
-  | None, Some _ -> -1
-  | Some _, None -> 1
-  | Some jt1 , Some jt2 -> java_type_compare jt1 jt2
-
-(** Compare java procedure names. *)
-let java_compare (j1: java) (j2 : java) =
-  string_compare j1.method_name j2.method_name
-  |> next java_type_list_compare j1.parameters j2.parameters
-  |> next java_type_compare j1.class_name j2.class_name
-  |> next java_return_type_compare j1.return_type j2.return_type
-  |> next method_kind_compare j1.kind j2.kind
-
-let c_function_mangled_compare mangled1 mangled2 =
-  match mangled1, mangled2 with
-  | Some _, None -> 1
-  | None, Some _ -> -1
-  | None, None -> 0
-  | Some mangled1, Some mangled2 ->
-      string_compare mangled1 mangled2
-
-(** Compare c_method signatures. *)
-let c_meth_sig_compare osig1 osig2 =
-  string_compare osig1.method_name osig2.method_name
-  |> next string_compare osig1.class_name osig2.class_name
-  |> next c_function_mangled_compare osig1.mangled osig2.mangled
-
-(** Given a package.class_name string, it looks for the latest dot and split the string
-    in two (package, class_name) *)
-let split_classname package_classname =
-  string_split_character package_classname '.'
-
-let from_string_c_fun (s: string) = C (s, None)
-
-let c (plain: string) (mangled: string) = (plain, Some mangled)
-
-let java class_name return_type method_name parameters kind =
-  {
-    class_name;
-    return_type;
-    method_name;
-    parameters;
-    kind;
-  }
-
-(** Create an objc procedure name from a class_name and method_name. *)
-let objc_cpp class_name method_name mangled =
-  {
-    class_name = class_name;
-    method_name = method_name;
-    mangled = mangled;
-  }
-
-let get_default_objc_class_method objc_class =
-  let objc_cpp = objc_cpp objc_class "__find_class_" (Some "internal") in
-  ObjC_Cpp objc_cpp
-
-(** Create an objc procedure name from a class_name and method_name. *)
-let mangled_objc_block name =
-  Block name
-
-let is_java = function
-  | Java _ -> true
-  | _ -> false
-
-let is_c_method = function
-  | ObjC_Cpp _ -> true
-  | _ -> false
-
-(** Replace the class name component of a procedure name.
-    In case of Java, replace package and class name. *)
-let replace_class t new_class = match t with
-  | Java j ->
-      Java { j with class_name = (split_classname new_class) }
-  | ObjC_Cpp osig ->
-      ObjC_Cpp { osig with class_name = new_class }
-  | C _
-  | Block _ ->
-      t
-
-(** Get the class name of a Objective-C/C++ procedure name. *)
-let objc_cpp_get_class_name objc_cpp =
-  objc_cpp.class_name
-
-(** Return the package.classname of a java procname. *)
-let java_get_class_name (j : java) =
-  java_type_to_string j.class_name
-
-(** Return the class name of a java procedure name. *)
-let java_get_simple_class_name (j : java) =
-  snd j.class_name
-
-(** Return the package of a java procname. *)
-let java_get_package (j : java) =
-  fst j.class_name
-
-(** Return the method of a java procname. *)
-let java_get_method (j : java) =
-  j.method_name
-
-(** Replace the method of a java procname. *)
-let java_replace_method (j : java) mname =
-  { j with method_name = mname }
-
-(** Replace the return type of a java procname. *)
-let java_replace_return_type j ret_type =
-  { j with return_type = Some ret_type }
-
-(** Replace the parameters of a java procname. *)
-let java_replace_parameters j parameters =
-  { j with parameters }
-
-(** Return the method/function of a procname. *)
-let get_method = function
-  | ObjC_Cpp name ->
-      name.method_name
-  | C (name, _) ->
-      name
-  | Block name ->
-      name
-  | Java j ->
-      j.method_name
-
-(** Return the language of the procedure. *)
-let get_language = function
-  | ObjC_Cpp _ ->
-      Config.Clang
-  | C _ ->
-      Config.Clang
-  | Block _ ->
-      Config.Clang
-  | Java _ ->
-      Config.Java
-
-
-(** Return the return type of a java procname. *)
-let java_get_return_type (j : java) =
-  java_return_type_to_string j Verbose
-
-(** Return the parameters of a java procname. *)
-let java_get_parameters j =
-  j.parameters
-
-(** Return the parameters of a java procname as strings. *)
-let java_get_parameters_as_strings j =
-  IList.map (fun param -> java_type_to_string param) j.parameters
-
-(** Return true if the java procedure is static *)
-let java_is_static = function
-  | Java j ->
-      j.kind = Static
-  | _ ->
-      false
-
-(** Prints a string of a java procname with the given level of verbosity *)
-let java_to_string ?(withclass = false) (j : java) verbosity =
-  match verbosity with
-  | Verbose | Non_verbose ->
-      (* if verbose, then package.class.method(params): rtype,
-         else rtype package.class.method(params)
-         verbose is used for example to create unique filenames, non_verbose to create reports *)
-      let return_type = java_return_type_to_string j verbosity in
-      let params = java_param_list_to_string j.parameters verbosity in
-      let class_name = java_type_to_string_verbosity j.class_name verbosity in
-      let separator =
-        match j.return_type, verbosity with
-        | (None, _) -> ""
-        | (Some _, Verbose) -> ":"
-        | _ -> " " in
-      let output = class_name ^ "." ^ j.method_name ^ "(" ^ params ^ ")" in
-      if verbosity = Verbose then output ^ separator ^ return_type
-      else return_type ^ separator ^ output
-  | Simple -> (* methodname(...) or without ... if there are no parameters *)
-      let cls_prefix =
-        if withclass then
-          java_type_to_string_verbosity j.class_name verbosity ^ "."
-        else "" in
-      let params =
-        match j.parameters with
-        | [] -> ""
-        | _ -> "..." in
-      let method_name =
-        if j.method_name = "<init>" then
-          java_get_simple_class_name j
-        else
-          cls_prefix ^ j.method_name in
-      method_name ^ "(" ^ params ^ ")"
-
-(** Check if the class name is for an anonymous inner class. *)
-let is_anonymous_inner_class_name class_name =
-  match string_split_character class_name '$' with
-  | Some _, s ->
-      let is_int =
-        try ignore (int_of_string (String.trim s)); true with Failure _ -> false in
-      is_int
-  | None, _ -> false
-
-(** Check if the procedure belongs to an anonymous inner class. *)
-let java_is_anonymous_inner_class = function
-  | Java j -> is_anonymous_inner_class_name (snd j.class_name)
-  | _ -> false
-
-(** Check if the last parameter is a hidden inner class, and remove it if present.
-    This is used in private constructors, where a proxy constructor is generated
-    with an extra parameter and calls the normal constructor. *)
-let java_remove_hidden_inner_class_parameter = function
-  | Java js ->
-      (match IList.rev js.parameters with
-       | (_, s) :: par' ->
-           if is_anonymous_inner_class_name s
-           then Some (Java { js with parameters = IList.rev par'})
-           else None
-       | [] -> None)
-  | _ -> None
-
-(** Check if the procedure name is an anonymous inner class constructor. *)
-let java_is_anonymous_inner_class_constructor = function
-  | Java js ->
-      let _, name = js.class_name in
-      is_anonymous_inner_class_name name
-  | _ -> false
-
-(** Check if the procedure name is an acess method (e.g. access$100 used to
-    access private members from a nested class. *)
-let java_is_access_method = function
-  | Java js ->
-      (match string_split_character js.method_name '$' with
-       | Some "access", s ->
-           let is_int =
-             try ignore (int_of_string s); true with Failure _ -> false in
-           is_int
-       | _ -> false)
-  | _ -> false
-
-(** Check if the proc name has the type of a java vararg.
-    Note: currently only checks that the last argument has type Object[]. *)
-let java_is_vararg = function
-  | Java js ->
-      begin
-        match (IList.rev js.parameters) with
-        | (_,"java.lang.Object[]") :: _ -> true
-        | _ -> false
-      end
-  | _ -> false
-
-(** [is_constructor pname] returns true if [pname] is a constructor *)
-let is_constructor = function
-  | Java js -> js.method_name = "<init>"
-  | ObjC_Cpp name ->
-      (name.method_name = "new") ||
-      string_is_prefix "init" name.method_name
-  | _ -> false
-
-(** [is_objc_dealloc pname] returns true if [pname] is the dealloc method in Objective-C *)
-let is_objc_dealloc = function
-  | ObjC_Cpp name -> name.method_name = "dealloc"
-  | _ -> false
-
-let java_is_close = function
-  | Java js -> js.method_name = "close"
-  | _ -> false
-
-(** [is_class_initializer pname] returns true if [pname] is a class initializer *)
-let is_class_initializer = function
-  | Java js -> js.method_name = "<clinit>"
-  | _ -> false
-
-(** [is_infer_undefined pn] returns true if [pn] is a special Infer undefined proc *)
-let is_infer_undefined pn = match pn with
-  | Java j ->
-      let regexp = Str.regexp "com.facebook.infer.models.InferUndefined" in
-      Str.string_match regexp (java_get_class_name j) 0
-  | _ ->
-      (* TODO: add cases for obj-c, c, c++ *)
-      false
-
-(** to_string for C_function type *)
-let to_readable_string (c1, c2) verbose =
-  let plain = c1 in
-  if verbose then
-    match c2 with
-    | None -> plain
-    | Some s -> plain ^ "{" ^ s ^ "}"
-  else
-    plain
-
-let c_method_to_string osig detail_level =
-  match detail_level with
-  | Simple -> osig.method_name
-  | Non_verbose -> osig.class_name ^ "_" ^ osig.method_name
-  | Verbose ->
-      let m_str = match osig.mangled with
-        | None -> ""
-        | Some s -> "{" ^ s ^ "}" in
-      osig.class_name ^ "_" ^ osig.method_name ^ m_str
-
-(** Very verbose representation of an existing Procname.t *)
-let to_unique_id pn =
-  match pn with
-  | Java j -> java_to_string j Verbose
-  | C (c1, c2) -> to_readable_string (c1, c2) true
-  | ObjC_Cpp osig -> c_method_to_string osig Verbose
-  | Block name -> name
-
-(** Convert a proc name to a string for the user to see *)
-let to_string p =
-  match p with
-  | Java j -> (java_to_string j Non_verbose)
-  | C (c1, c2) ->
-      to_readable_string (c1, c2) false
-  | ObjC_Cpp osig -> c_method_to_string osig Non_verbose
-  | Block name -> name
-
-(** Convenient representation of a procname for external tools (e.g. eclipse plugin) *)
-let to_simplified_string ?(withclass = false) p =
-  match p with
-  | Java j ->
-      (java_to_string ~withclass j Simple)
-  | C (c1, c2) ->
-      to_readable_string (c1, c2) false ^ "()"
-  | ObjC_Cpp osig ->
-      c_method_to_string osig Simple
-  | Block _ ->
-      "block"
-
-(** Convert a proc name to a filename *)
-let to_filename proc_name =
-  Escape.escape_filename @@ string_append_crc_cutoff @@ to_unique_id proc_name
-
-(** Pretty print a proc name *)
-let pp f pn =
-  F.fprintf f "%s" (to_string pn)
-
-(** Compare function for Procname.t types.
-    These rules create an ordered set of procnames grouped with the following
-    priority (lowest to highest): *)
-let compare pn1 pn2 = match pn1, pn2 with
-  | Java j1, Java j2 ->
-      java_compare j1 j2
-  | Java _, _ ->
-      -1
-  | _, Java _ ->
-      1
-  | C (c1, c2), C (c3, c4) -> (* Compare C_function types *)
-      string_compare c1 c3
-      |> next mangled_compare c2 c4
-  | C _, _ ->
-      -1
-  | _, C _ ->
-      1
-  | Block s1, Block s2 -> (* Compare ObjC_block types *)
-      string_compare s1 s2
-  | Block _, _ ->
-      -1
-  | _, Block _ ->
-      1
-  | ObjC_Cpp osig1, ObjC_Cpp osig2 ->
-      c_meth_sig_compare osig1 osig2
-
-let equal pn1 pn2 =
-  compare pn1 pn2 = 0
-
-(** hash function for procname *)
-let hash_pname = Hashtbl.hash
-
-module Hash =
-  Hashtbl.Make(struct
-    type t = proc_name
-    let equal = equal
-    let hash = hash_pname
-  end)
-
-module Map = Map.Make (struct
-    type t = proc_name
-    let compare = compare end)
-
-module Set = Set.Make(struct
-    type t = proc_name
-    let compare = compare
-  end)
-
-(** Pretty print a set of proc names *)
-let pp_set fmt set =
-  Set.iter (fun pname -> F.fprintf fmt "%a " pp pname) set

infer/src/IR/procname.mli

@@ -1,201 +0,0 @@
-(*
- * Copyright (c) 2009 - 2013 Monoidics ltd.
- * Copyright (c) 2013 - present Facebook, Inc.
- * All rights reserved.
- *
- * This source code is licensed under the BSD style license found in the
- * LICENSE file in the root directory of this source tree. An additional grant
- * of patent rights can be found in the PATENTS file in the same directory.
- *)
-
-open! Utils
-
-(** Module for Procedure Names. *)
-
-(** Type of java procedure names. *)
-type java
-
-(** Type of c procedure names. *)
-type c
-
-(** Type of Objective C and C++ procedure names. *)
-type objc_cpp
-
-(** Type of Objective C block names. *)
-type block
-
-(** Type of procedure names. *)
-type t =
-  | Java of java
-  | C of c
-  | ObjC_Cpp of objc_cpp
-  | Block of block
-
-type java_type = string option * string
-
-type method_kind =
-  | Static (* in Java, procedures called with invokestatic *)
-  | Non_Static (* in Java, procedures called with invokevirtual, invokespecial, and invokeinterface *)
-
-type objc_method_kind =
-  | Instance_objc_method (* for instance methods in ObjC *)
-  | Class_objc_method (* for class methods in ObjC *)
-
-(** Hash tables with proc names as keys. *)
-module Hash : Hashtbl.S with type key = t
-
-(** Maps from proc names. *)
-module Map : Map.S with type key = t
-
-(** Sets of proc names. *)
-module Set : Set.S with type elt = t
-
-(** Create a C procedure name from plain and mangled name. *)
-val c : string -> string -> c
-
-(** Comparison for proc names. *)
-val compare : t -> t -> int
-
-(** Empty block name. *)
-val empty_block : t
-
-(** Equality for proc names. *)
-val equal : t -> t -> bool
-
-(** Convert a string to a proc name. *)
-val from_string_c_fun : string -> t
-
-(** Return the language of the procedure. *)
-val get_language : t -> Config.language
-
-(** Return the method/function of a procname. *)
-val get_method : t -> string
-
-(** Hash function for procname. *)
-val hash_pname : t -> int
-
-(** Check if a class string is an anoynmous inner class name. *)
-val is_anonymous_inner_class_name : string -> bool
-
-(** Check if this is an Objective-C/C++ method name. *)
-val is_c_method : t -> bool
-
-(** Check if this is a constructor. *)
-val is_constructor : t -> bool
-
-(** Check if this is a Java procedure name. *)
-val is_java : t -> bool
-
-(** Check if this is a dealloc method in Objective-C. *)
-val is_objc_dealloc : t -> bool
-
-(** Create a Java procedure name from its
-    class_name method_name args_type_name return_type_name method_kind. *)
-val java : java_type -> java_type option -> string -> java_type list -> method_kind -> java
-
-(** Replace the parameters of a java procname. *)
-val java_replace_parameters : java -> java_type list -> java
-
-(** Replace the method of a java procname. *)
-val java_replace_return_type : java -> java_type -> java
-
-(** Create an objc block name. *)
-val mangled_objc_block : string -> t
-
-(** Mangled string for method types. *)
-val mangled_of_objc_method_kind : objc_method_kind -> string option
-
-(** Create an objc procedure name from a class_name and method_name. *)
-val objc_cpp : string -> string -> string option -> objc_cpp
-
-val get_default_objc_class_method : string -> t
-
-(** Get the class name of a Objective-C/C++ procedure name. *)
-val objc_cpp_get_class_name : objc_cpp -> string
-
-(** Create ObjC method type from a bool is_instance. *)
-val objc_method_kind_of_bool : bool -> objc_method_kind
-
-(** Return the class name of a java procedure name. *)
-val java_get_class_name : java -> string
-
-(** Return the simple class name of a java procedure name. *)
-val java_get_simple_class_name : java -> string
-
-(** Return the package name of a java procedure name. *)
-val java_get_package : java -> string option
-
-(** Return the method name of a java procedure name. *)
-val java_get_method : java -> string
-
-(** Return the return type of a java procedure name. *)
-val java_get_return_type : java -> string
-
-(** Return the parameters of a java procedure name. *)
-val java_get_parameters : java -> java_type list
-
-(** Return the parameters of a java procname as strings. *)
-val java_get_parameters_as_strings : java -> string list
-
-(** Check if the procedure name is an acess method (e.g. access$100 used to
-    access private members from a nested class. *)
-val java_is_access_method : t -> bool
-
-(** Check if the procedure belongs to an anonymous inner class. *)
-val java_is_anonymous_inner_class : t -> bool
-
-(** Check if the procedure name is an anonymous inner class constructor. *)
-val java_is_anonymous_inner_class_constructor : t -> bool
-
-(** Check if the method name is "close". *)
-val java_is_close : t -> bool
-
-(** Check if the java procedure is static. *)
-val java_is_static : t -> bool
-
-(** Check if the proc name has the type of a java vararg.
-    Note: currently only checks that the last argument has type Object[]. *)
-val java_is_vararg : t -> bool
-
-(** Check if the last parameter is a hidden inner class, and remove it if present.
-    This is used in private constructors, where a proxy constructor is generated
-    with an extra parameter and calls the normal constructor. *)
-val java_remove_hidden_inner_class_parameter : t -> t option
-
-(** Replace the method name of an existing java procname. *)
-val java_replace_method : java -> string -> java
-
-(** Convert a java type to a string. *)
-val java_type_to_string : java_type -> string
-
-(** Check if this is a class initializer. *)
-val is_class_initializer : t -> bool
-
-(** Check if this is a special Infer undefined procedure. *)
-val is_infer_undefined : t -> bool
-
-(** Pretty print a proc name. *)
-val pp : Format.formatter -> t -> unit
-
-(** Pretty print a set of proc names. *)
-val pp_set : Format.formatter -> Set.t -> unit
-
-(** Replace the class name component of a procedure name.
-    In case of Java, replace package and class name. *)
-val replace_class : t -> string -> t
-
-(** Given a package.class_name string, look for the latest dot and split the string
-    in two (package, class_name). *)
-val split_classname : string -> string option * string
-
-(** Convert a proc name to a string for the user to see. *)
-val to_string : t -> string
-
-(** Convert a proc name into a easy string for the user to see in an IDE. *)
-val to_simplified_string : ?withclass: bool -> t -> string
-
-(** Convert a proc name into a unique identifier. *)
-val to_unique_id : t -> string
-
-(** Convert a proc name to a filename. *)
-val to_filename : t -> string

infer/src/IR/pvar.ml

@@ -1,215 +0,0 @@
-(*
- * Copyright (c) 2009 - 2013 Monoidics ltd.
- * Copyright (c) 2013 - present Facebook, Inc.
- * All rights reserved.
- *
- * This source code is licensed under the BSD style license found in the
- * LICENSE file in the root directory of this source tree. An additional grant
- * of patent rights can be found in the PATENTS file in the same directory.
- *)
-
-open! Utils
-
-(** The Smallfoot Intermediate Language *)
-
-module L = Logging
-module F = Format
-
-(** Kind of global variables *)
-type pvar_kind =
-  | Local_var of Procname.t (** local variable belonging to a function *)
-  | Callee_var of Procname.t (** local variable belonging to a callee *)
-  | Abducted_retvar of Procname.t * Location.t (** synthetic variable to represent return value *)
-  | Abducted_ref_param of Procname.t * t * Location.t
-  (** synthetic variable to represent param passed by reference *)
-  | Global_var (** gloval variable *)
-  | Seed_var (** variable used to store the initial value of formal parameters *)
-
-(** Names for program variables. *)
-and t =
-  { pv_name: Mangled.t;
-    pv_kind: pvar_kind }
-
-let rec pvar_kind_compare k1 k2 = match k1, k2 with
-  | Local_var n1, Local_var n2 -> Procname.compare n1 n2
-  | Local_var _, _ -> - 1
-  | _, Local_var _ -> 1
-  | Callee_var n1, Callee_var n2 -> Procname.compare n1 n2
-  | Callee_var _, _ -> - 1
-  | _, Callee_var _ -> 1
-  | Abducted_retvar (p1, l1), Abducted_retvar (p2, l2) ->
-      let n = Procname.compare p1 p2 in
-      if n <> 0 then n else Location.compare l1 l2
-  | Abducted_retvar _, _ -> - 1
-  | _, Abducted_retvar _ -> 1
-  | Abducted_ref_param (p1, pv1, l1), Abducted_ref_param (p2, pv2, l2) ->
-      let n = Procname.compare p1 p2 in
-      if n <> 0 then n else
-        let n = compare pv1 pv2 in
-        if n <> 0 then n else Location.compare l1 l2
-  | Abducted_ref_param _, _ -> - 1
-  | _, Abducted_ref_param _ -> 1
-  | Global_var, Global_var -> 0
-  | Global_var, _ -> - 1
-  | _, Global_var -> 1
-  | Seed_var, Seed_var -> 0
-
-and compare pv1 pv2 =
-  let n = Mangled.compare pv1.pv_name pv2.pv_name in
-  if n <> 0 then n else pvar_kind_compare pv1.pv_kind pv2.pv_kind
-
-let equal pvar1 pvar2 =
-  compare pvar1 pvar2 = 0
-
-
-let rec _pp f pv =
-  let name = pv.pv_name in
-  match pv.pv_kind with
-  | Local_var n ->
-      if !Config.pp_simple then F.fprintf f "%a" Mangled.pp name
-      else F.fprintf f "%a$%a" Procname.pp n Mangled.pp name
-  | Callee_var n ->
-      if !Config.pp_simple then F.fprintf f "%a|callee" Mangled.pp name
-      else F.fprintf f "%a$%a|callee" Procname.pp n Mangled.pp name
-  | Abducted_retvar (n, l) ->
-      if !Config.pp_simple then F.fprintf f "%a|abductedRetvar" Mangled.pp name
-      else F.fprintf f "%a$%a%a|abductedRetvar" Procname.pp n Location.pp l Mangled.pp name
-  | Abducted_ref_param (n, pv, l) ->
-      if !Config.pp_simple then F.fprintf f "%a|%a|abductedRefParam" _pp pv Mangled.pp name
-      else F.fprintf f "%a$%a%a|abductedRefParam" Procname.pp n Location.pp l Mangled.pp name
-  | Global_var -> F.fprintf f "#GB$%a" Mangled.pp name
-  | Seed_var -> 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 _ ->
-      Latex.pp_string Latex.Roman f (Mangled.to_string name)
-  | Callee_var _ ->
-      F.fprintf f "%a_{%a}" (Latex.pp_string Latex.Roman) (Mangled.to_string name)
-        (Latex.pp_string Latex.Roman) "callee"
-  | Abducted_retvar _ ->
-      F.fprintf f "%a_{%a}" (Latex.pp_string Latex.Roman) (Mangled.to_string name)
-        (Latex.pp_string Latex.Roman) "abductedRetvar"
-  | Abducted_ref_param _ ->
-      F.fprintf f "%a_{%a}" (Latex.pp_string Latex.Roman) (Mangled.to_string name)
-        (Latex.pp_string Latex.Roman) "abductedRefParam"
-  | Global_var ->
-      Latex.pp_string Latex.Boldface f (Mangled.to_string name)
-  | Seed_var ->
-      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.pe_kind with
-  | PP_TEXT -> _pp f pv
-  | PP_HTML -> _pp f pv
-  | PP_LATEX -> pp_latex f pv
-
-(** Pretty print a program variable. *)
-let pp pe f pv =
-  let ampersand = match pe.pe_kind with
-    | PP_TEXT -> "&"
-    | PP_HTML -> "&amp;"
-    | PP_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)
-
-(** Pretty print a list of program variables. *)
-let pp_list pe f pvl =
-  F.fprintf f "%a" (pp_seq (fun f e -> F.fprintf f "%a" (pp pe) e)) pvl
-
-(** Dump a list of program variables. *)
-let d_list pvl =
-  IList.iter (fun pv -> d pv; L.d_str " ") pvl
-
-let get_name pv = pv.pv_name
-
-let to_string pv = Mangled.to_string pv.pv_name
-
-let get_simplified_name pv =
-  let s = Mangled.to_string pv.pv_name in
-  match string_split_character s '.' with
-  | Some s1, s2 ->
-      (match string_split_character s1 '.' with
-       | Some _, s4 -> s4 ^ "." ^ s2
-       | _ -> s)
-  | _ -> s
-
-(** Check if the pvar is an abucted return var or param passed by ref *)
-let is_abducted pv =
-  match pv.pv_kind with
-  | Abducted_retvar _ | Abducted_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 }
-
-(** Check if the pvar is a local var *)
-let is_local pv =
-  match pv.pv_kind with
-  | Local_var _ -> true
-  | _ -> false
-
-(** Check if the pvar is a callee var *)
-let is_callee pv =
-  match pv.pv_kind with
-  | Callee_var _ -> true
-  | _ -> false
-
-(** Check if the pvar is a seed var *)
-let is_seed pv =
-  match pv.pv_kind with
-  | Seed_var -> true
-  | _ -> false
-
-(** Check if the pvar is a global var *)
-let is_global pv =
-  pv.pv_kind = Global_var
-
-(** Check if a pvar is the special "this" var *)
-let is_this pvar =
-  Mangled.equal (get_name pvar) (Mangled.from_string "this")
-
-(** Check if the pvar is a return var *)
-let is_return pv =
-  get_name pv = Ident.name_return
-
-(** Turn an ordinary program variable into a callee program variable *)
-let to_callee pname pvar = match pvar.pv_kind with
-  | Local_var _ ->
-      { pvar with pv_kind = Callee_var pname }
-  | Global_var ->
-      pvar
-  | Callee_var _ | Abducted_retvar _ | Abducted_ref_param _ | Seed_var ->
-      L.d_str "Cannot convert pvar to callee: ";
-      d pvar; L.d_ln ();
-      assert false
-(** [mk name proc_name] creates a program var with the given function name *)
-let mk (name: Mangled.t) (proc_name: Procname.t) : t =
-  { 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
-    for a callee function with the given function name *)
-let mk_callee (name: Mangled.t) (proc_name: Procname.t) : t =
-  { pv_name = name; pv_kind = Callee_var proc_name }
-
-(** create a global variable with the given name *)
-let mk_global (name: Mangled.t) : t =
-  { pv_name = name; pv_kind = Global_var }
-
-(** create an abducted return variable for a call to [proc_name] at [loc] *)
-let mk_abducted_ret (proc_name : Procname.t) (loc : Location.t) : t =
-  let name = Mangled.from_string ("$RET_" ^ (Procname.to_unique_id proc_name)) in
-  { pv_name = name; pv_kind = Abducted_retvar (proc_name, loc) }
-
-let mk_abducted_ref_param (proc_name : Procname.t) (pv : t) (loc : Location.t) : t =
-  let name = Mangled.from_string ("$REF_PARAM_" ^ (Procname.to_unique_id proc_name)) in
-  { pv_name = name; pv_kind = Abducted_ref_param (proc_name, pv, loc) }

infer/src/IR/pvar.mli

@@ -1,99 +0,0 @@
-(*
- * Copyright (c) 2009 - 2013 Monoidics ltd.
- * Copyright (c) 2013 - present Facebook, Inc.
- * All rights reserved.
- *
- * This source code is licensed under the BSD style license found in the
- * LICENSE file in the root directory of this source tree. An additional grant
- * of patent rights can be found in the PATENTS file in the same directory.
- *)
-
-open! Utils
-
-(** Program variables. *)
-
-module F = Format
-
-(** Type for program variables. There are 4 kinds of variables:
-    1) local variables, used for local variables and formal parameters
-    2) callee program variables, used to handle recursion ([x | callee] is distinguished from [x])
-    3) global variables
-    4) seed variables, used to store the initial value of formal parameters
-*)
-type t
-
-(** Compare two pvar's *)
-val compare : t -> t -> int
-
-(** Dump a program variable. *)
-val d : t -> unit
-
-(** Dump a list of program variables. *)
-val d_list : t list -> unit
-
-(** Equality for pvar's *)
-val equal : t -> t -> bool
-
-(** Get the name component of a program variable. *)
-val get_name : t -> Mangled.t
-
-(** [get_ret_pvar proc_name] retuns the return pvar associated with the procedure name *)
-val get_ret_pvar : Procname.t -> t
-
-(** Get a simplified version of the name component of a program variable. *)
-val get_simplified_name : t -> string
-
-(** Check if the pvar is an abducted return var or param passed by ref *)
-val is_abducted : t -> bool
-
-(** Check if the pvar is a callee var *)
-val is_callee : t -> bool
-
-(** Check if the pvar is a global var *)
-val is_global : t -> bool
-
-(** Check if the pvar is a local var *)
-val is_local : t -> bool
-
-(** Check if the pvar is a seed var *)
-val is_seed : t -> bool
-
-(** Check if the pvar is a return var *)
-val is_return : t -> bool
-
-(** Check if a pvar is the special "this" var *)
-val is_this : t -> bool
-
-(** [mk name proc_name suffix] creates a program var with the given function name and suffix *)
-val mk : Mangled.t -> Procname.t -> t
-
-(** create an abducted variable for a parameter passed by reference *)
-val mk_abducted_ref_param : Procname.t -> t -> Location.t -> t
-
-(** create an abducted return variable for a call to [proc_name] at [loc] *)
-val mk_abducted_ret : Procname.t -> Location.t -> t
-
-(** [mk_callee name proc_name] creates a program var
-    for a callee function with the given function name *)
-val mk_callee : Mangled.t -> Procname.t -> t
-
-(** create a global variable with the given name *)
-val mk_global : Mangled.t -> t
-
-(** Pretty print a program variable. *)
-val pp : printenv -> F.formatter -> t -> unit
-
-(** Pretty print a list of program variables. *)
-val pp_list : printenv -> F.formatter -> t list -> unit
-
-(** Pretty print a pvar which denotes a value, not an address *)
-val pp_value : printenv -> F.formatter -> t -> unit
-
-(** Turn an ordinary program variable into a callee program variable *)
-val to_callee : Procname.t -> t -> t
-
-(** Turn a pvar into a seed pvar (which stores the initial value of a stack var) *)
-val to_seed : t -> t
-
-(** Convert a pvar to string. *)
-val to_string : t -> string

infer/src/IR/tenv.ml

@@ -1,168 +0,0 @@
-(*
- * Copyright (c) 2016 - present Facebook, Inc.
- * All rights reserved.
- *
- * This source code is licensed under the BSD style license found in the
- * LICENSE file in the root directory of this source tree. An additional grant
- * of patent rights can be found in the PATENTS file in the same directory.
- *)
-
-open! Utils
-
-(** Module for Type Environments. *)
-
-(** Hash tables on strings. *)
-module TypenameHash =
-  Hashtbl.Make(struct
-    type t = Typename.t
-    let equal tn1 tn2 = Typename.equal tn1 tn2
-    let hash = Hashtbl.hash
-  end)
-
-(** Type for type environment. *)
-type t = Sil.struct_typ TypenameHash.t
-
-(** Create a new type environment. *)
-let create () = TypenameHash.create 1000
-
-(** Check if typename is found in tenv *)
-let mem tenv name =
-  TypenameHash.mem tenv name
-
-(** Look up a name in the global type environment. *)
-let lookup tenv name =
-  try Some (TypenameHash.find tenv name)
-  with Not_found -> None
-
-(** Lookup Java types by name *)
-let lookup_java_typ_from_string tenv typ_str =
-  let rec loop = function
-    | "" | "void" ->
-        Some Sil.Tvoid
-    | "int" ->
-        Some (Sil.Tint Sil.IInt)
-    | "byte" ->
-        Some (Sil.Tint Sil.IShort)
-    | "short" ->
-        Some (Sil.Tint Sil.IShort)
-    | "boolean" ->
-        Some (Sil.Tint Sil.IBool)
-    | "char" ->
-        Some (Sil.Tint Sil.IChar)
-    | "long" ->
-        Some (Sil.Tint Sil.ILong)
-    | "float" ->
-        Some (Sil.Tfloat Sil.FFloat)
-    | "double" ->
-        Some (Sil.Tfloat Sil.FDouble)
-    | typ_str when String.contains typ_str '[' ->
-        let stripped_typ = String.sub typ_str 0 ((String.length typ_str) - 2) in
-        let array_typ_size = Sil.exp_get_undefined false in
-        begin
-          match loop stripped_typ with
-          | Some typ -> Some (Sil.Tptr (Sil.Tarray (typ, array_typ_size), Sil.Pk_pointer))
-          | None -> None
-        end
-    | typ_str ->
-        (* non-primitive/non-array type--resolve it in the tenv *)
-        let typename = Typename.Java.from_string typ_str in
-        begin
-          match lookup tenv typename with
-          | Some struct_typ -> Some (Sil.Tstruct struct_typ)
-          | None -> None
-        end in
-  loop typ_str
-
-(** resolve a type string to a Java *class* type. For strings that may represent primitive or array
-    typs, use [lookup_java_typ_from_string] *)
-let lookup_java_class_from_string tenv typ_str =
-  match lookup_java_typ_from_string tenv typ_str with
-  | Some (Sil.Tstruct struct_typ) -> Some struct_typ
-  | _ -> None
-
-(** Add a (name,type) pair to the global type environment. *)
-let add tenv name struct_typ =
-  TypenameHash.replace tenv name struct_typ
-
-(** Return the declaring class type of [pname_java] *)
-let proc_extract_declaring_class_typ tenv pname_java =
-  lookup_java_class_from_string tenv (Procname.java_get_class_name pname_java)
-
-(** Return the return type of [pname_java]. *)
-let proc_extract_return_typ tenv pname_java =
-  lookup_java_typ_from_string tenv (Procname.java_get_return_type pname_java)
-
-(** Get method that is being overriden by java_pname (if any) **)
-let get_overriden_method tenv pname_java =
-  let struct_typ_get_def_method_by_name struct_typ method_name =
-    IList.find
-      (fun def_method -> method_name = Procname.get_method def_method)
-      struct_typ.Sil.def_methods in
-  let rec get_overriden_method_in_superclasses pname_java superclasses=
-    match superclasses with
-    | superclass :: superclasses_tail ->
-        begin
-          match lookup tenv superclass with
-          | Some struct_typ ->
-              begin
-                try
-                  Some (struct_typ_get_def_method_by_name
-                          struct_typ
-                          (Procname.java_get_method pname_java))
-                with Not_found ->
-                  get_overriden_method_in_superclasses
-                    pname_java
-                    (superclasses_tail @ struct_typ.Sil.superclasses)
-              end
-          | None -> get_overriden_method_in_superclasses pname_java superclasses_tail
-        end
-    | [] -> None in
-  match proc_extract_declaring_class_typ tenv pname_java with
-  | Some proc_struct_typ ->
-      get_overriden_method_in_superclasses pname_java proc_struct_typ.superclasses
-  | _ -> None
-
-
-(** expand a type if it is a typename by looking it up in the type environment *)
-let expand_type tenv typ =
-  match typ with
-  | Sil.Tvar tname ->
-      begin
-        match lookup tenv tname with
-        | None ->
-            assert false
-        | Some struct_typ ->
-            Sil.Tstruct struct_typ
-      end
-  | _ -> typ
-
-(** Serializer for type environments *)
-let tenv_serializer : t Serialization.serializer =
-  Serialization.create_serializer Serialization.tenv_key
-
-let global_tenv: (t option) Lazy.t =
-  lazy (Serialization.from_file tenv_serializer (DB.global_tenv_fname ()))
-
-(** Load a type environment from a file *)
-let load_from_file (filename : DB.filename) : t option =
-  if filename = DB.global_tenv_fname () then
-    Lazy.force global_tenv
-  else
-    Serialization.from_file tenv_serializer filename
-
-(** Save a type environment into a file *)
-let store_to_file (filename : DB.filename) (tenv : t) =
-  Serialization.to_file tenv_serializer filename tenv
-
-let iter f tenv =
-  TypenameHash.iter f tenv
-
-let fold f tenv =
-  TypenameHash.fold f tenv
-
-let pp fmt (tenv : t) =
-  TypenameHash.iter
-    (fun name typ ->
-       Format.fprintf fmt "@[<6>NAME: %s@." (Typename.to_string name);
-       Format.fprintf fmt "@[<6>TYPE: %a@." (Sil.pp_struct_typ pe_text (fun _ () -> ())) typ)
-    tenv

infer/src/IR/tenv.mli

@@ -1,60 +0,0 @@
-(*
- * Copyright (c) 2016 - present Facebook, Inc.
- * All rights reserved.
- *
- * This source code is licensed under the BSD style license found in the
- * LICENSE file in the root directory of this source tree. An additional grant
- * of patent rights can be found in the PATENTS file in the same directory.
- *)
-
-open! Utils
-
-(** Module for Type Environments. *)
-
-type t (** Type for type environment. *)
-
-(** Add a (name,typename) pair to the global type environment. *)
-val add : t -> Typename.t -> Sil.struct_typ -> unit
-
-(** Create a new type environment. *)
-val create : unit -> t
-
-(** Expand a type if it is a typename by looking it up in the type environment. *)
-val expand_type : t -> Sil.typ -> Sil.typ
-
-(** Fold a function over the elements of the type environment. *)
-val fold : (Typename.t -> Sil.struct_typ -> 'a -> 'a) -> t -> 'a -> 'a
-
-(** iterate over a type environment *)
-val iter : (Typename.t -> Sil.struct_typ -> unit) -> t -> unit
-
-(** Load a type environment from a file *)
-val load_from_file : DB.filename -> t option
-
-(** Look up a name in the global type environment. *)
-val lookup : t -> Typename.t -> Sil.struct_typ option
-
-(** Lookup Java types by name. *)
-val lookup_java_typ_from_string : t -> string -> Sil.typ option
-
-(** resolve a type string to a Java *class* type. For strings that may represent primitive or array
-    typs, use [lookup_java_typ_from_string]. *)
-val lookup_java_class_from_string : t -> string -> Sil.struct_typ option
-
-(** Return the declaring class type of [pname_java] *)
-val proc_extract_declaring_class_typ : t -> Procname.java -> Sil.struct_typ option
-
-(** Return the return type of [pname_java]. *)
-val proc_extract_return_typ : t -> Procname.java -> Sil.typ option
-
-(** Check if typename is found in t *)
-val mem : t -> Typename.t -> bool
-
-(** print a type environment *)
-val pp : Format.formatter -> t -> unit
-
-(** Save a type environment into a file *)
-val store_to_file : DB.filename -> t -> unit
-
-(** Get method that is being overriden by java_pname (if any) **)
-val get_overriden_method : t -> Procname.java -> Procname.t option

infer/src/IR/typename.ml

@@ -1,61 +0,0 @@
-(*
- * Copyright (c) 2015 - present Facebook, Inc.
- * All rights reserved.
- *
- * This source code is licensed under the BSD style license found in the
- * LICENSE file in the root directory of this source tree. An additional grant
- * of patent rights can be found in the PATENTS file in the same directory.
- *)
-
-open! Utils
-
-module F = Format
-
-(** Named types. *)
-type t =
-  | TN_typedef of Mangled.t
-  | TN_enum of Mangled.t
-  | TN_csu of Csu.t * Mangled.t
-
-let to_string = function
-  | TN_enum name
-  | TN_typedef name -> Mangled.to_string name
-  | TN_csu (csu, name) ->
-      Csu.name csu ^ " " ^ Mangled.to_string name
-
-let pp f typename =
-  F.fprintf f "%s" (to_string typename)
-
-let name = function
-  | TN_enum name
-  | TN_typedef name
-  | TN_csu (_, name) -> Mangled.to_string name
-
-let compare tn1 tn2 = match tn1, tn2 with
-  | TN_typedef n1, TN_typedef n2 -> Mangled.compare n1 n2
-  | TN_typedef _, _ -> - 1
-  | _, TN_typedef _ -> 1
-  | TN_enum n1, TN_enum n2 -> Mangled.compare n1 n2
-  | TN_enum _, _ -> -1
-  | _, TN_enum _ -> 1
-  | TN_csu (csu1, n1), TN_csu (csu2, n2) ->
-      let n = Csu.compare csu1 csu2 in
-      if n <> 0 then n else Mangled.compare n1 n2
-
-let equal tn1 tn2 =
-  compare tn1 tn2 = 0
-
-module Java =
-struct
-
-  let from_string class_name_str =
-    TN_csu (Csu.Class Csu.Java, Mangled.from_string class_name_str)
-
-end
-
-type typename_t = t
-module Set = Set.Make(
-  struct
-    type t = typename_t
-    let compare = compare
-  end)

infer/src/IR/typename.mli

@@ -1,39 +0,0 @@
-(*
- * Copyright (c) 2015 - present Facebook, Inc.
- * All rights reserved.
- *
- * This source code is licensed under the BSD style license found in the
- * LICENSE file in the root directory of this source tree. An additional grant
- * of patent rights can be found in the PATENTS file in the same directory.
- *)
-
-open! Utils
-
-(** Named types. *)
-type t =
-  | TN_typedef of Mangled.t
-  | TN_enum of Mangled.t
-  | TN_csu of Csu.t * Mangled.t
-
-(** convert the typename to a string *)
-val to_string : t -> string
-
-val pp : Format.formatter -> t -> unit
-
-(** name of the typename without qualifier *)
-val name : t -> string
-
-(** Comparison for typenames *)
-val compare : t -> t -> int
-
-(** Equality for typenames *)
-val equal : t -> t -> bool
-
-module Java : sig
-
-  (** Create a typename from a Java classname in the form "package.class" *)
-  val from_string : string -> t
-
-end
-
-module Set : Set.S with type elt = t

infer/src/Makefile.in

@@ -132,7 +132,7 @@ endif
 DEPENDENCIES = IR backend checkers eradicate harness \
 	facebook/checkers facebook/checkers/graphql facebook/scripts $(EXTRA_DEPS)
 
-OCAMLBUILD = ocamlbuild $(OCAMLBUILD_OPTIONS) -j $(NCPU) $(addprefix -I , $(DEPENDENCIES))
+OCAMLBUILD = rebuild $(OCAMLBUILD_OPTIONS) -j $(NCPU) $(addprefix -I , $(DEPENDENCIES))
 
 .PHONY: all java clang llvm unit checkCopyright build_java build_clang build_llvm build_unit \
 	build_checkCopyright java_annotations clang_annotations llvm_annotations \