pghs975uc
/
infer_clone
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

[build] upgrade Reason to 1.13.3

Browse Source 
Summary: This is required to upgrade OCaml as our ancient Reason is not available on 4.04.0.

Reviewed By: yunxing

Differential Revision: D4851582

fbshipit-source-id: 994a9a8
master
Jules Villard 8 years ago committed by Facebook Github Bot
parent 093b3c6478
commit b349fb147c
57 changed files with 453 additions and 452 deletions
Show Stats Download Patch File Download Diff File

17
infer/src/IR/Annot.re
Unescape View File

@ -11,9 +11,9 @@ open! IStd;
/** The Smallfoot Intermediate Language: Annotations */ /** The Smallfoot Intermediate Language: Annotations */
let module L = Logging; module L = Logging;
let module F = Format; module F = Format;
type parameters = list string [@@deriving compare]; type parameters = list string [@@deriving compare];
@ -21,7 +21,7 @@ type parameters = list string [@@deriving compare];
/** Type to represent one @Annotation. */ /** Type to represent one @Annotation. */
type t = { type t = {
class_name: string, /** name of the annotation */ class_name: string, /** name of the annotation */
parameters: parameters /** currently only one string parameter */ parameters /** currently only one string parameter */
} }
[@@deriving compare]; [@@deriving compare];
@ -33,13 +33,14 @@ let prefix = Config.curr_language_is Config.Java ? "@" : "_";
let pp fmt annotation => F.fprintf fmt "%s%s" prefix annotation.class_name; let pp fmt annotation => F.fprintf fmt "%s%s" prefix annotation.class_name;
let module Map = PrettyPrintable.MakePPMap { module Map =
PrettyPrintable.MakePPMap {
type nonrec t = t; type nonrec t = t;
let compare = compare; let compare = compare;
let pp = pp; let pp = pp;
}; };
let module Item = { module Item = {
/** Annotation for one item: a list of annotations with visibility. */ /** Annotation for one item: a list of annotations with visibility. */
/* Don't use nonrec due to https://github.com/janestreet/ppx_compare/issues/2 */ /* Don't use nonrec due to https://github.com/janestreet/ppx_compare/issues/2 */
@ -65,7 +66,7 @@ let module Item = {
let is_empty ia => List.is_empty ia; let is_empty ia => List.is_empty ia;
}; };
let module Class = { module Class = {
let objc_str = "ObjC-Class"; let objc_str = "ObjC-Class";
let cpp_str = "Cpp-Class"; let cpp_str = "Cpp-Class";
let of_string class_string => [({class_name: class_string, parameters: []}, true)]; let of_string class_string => [({class_name: class_string, parameters: []}, true)];
@ -73,7 +74,7 @@ let module Class = {
let cpp = of_string cpp_str; let cpp = of_string cpp_str;
}; };
let module Method = { module Method = {
/** Annotation for a method: return value and list of parameters. */ /** Annotation for a method: return value and list of parameters. */
type t = (Item.t, list Item.t) [@@deriving compare]; type t = (Item.t, list Item.t) [@@deriving compare];

12
infer/src/IR/Annot.rei
Unescape View File

@ -11,7 +11,7 @@ open! IStd;
/** The Smallfoot Intermediate Language: Annotations */ /** The Smallfoot Intermediate Language: Annotations */
let module F = Format; module F = Format;
type parameters = list string; type parameters = list string;
@ -19,7 +19,7 @@ type parameters = list string;
/** Type to represent one @Annotation. */ /** Type to represent one @Annotation. */
type t = { type t = {
class_name: string, /** name of the annotation */ class_name: string, /** name of the annotation */
parameters: parameters /** currently only one string parameter */ parameters /** currently only one string parameter */
} }
[@@deriving compare]; [@@deriving compare];
@ -31,9 +31,9 @@ let volatile: t;
/** Pretty print an annotation. */ /** Pretty print an annotation. */
let pp: F.formatter => t => unit; let pp: F.formatter => t => unit;
let module Map: PrettyPrintable.PPMap with type key = t; module Map: PrettyPrintable.PPMap with type key = t;
let module Item: { module Item: {
/** Annotation for one item: a list of annotations with visibility. */ /** Annotation for one item: a list of annotations with visibility. */
type nonrec t = list (t, bool) [@@deriving compare]; type nonrec t = list (t, bool) [@@deriving compare];
@ -50,9 +50,9 @@ let module Item: {
let is_empty: t => bool; let is_empty: t => bool;
}; };
let module Class: {let objc: Item.t; let cpp: Item.t;}; module Class: {let objc: Item.t; let cpp: Item.t;};
let module Method: { module Method: {
/** Annotation for a method: return value and list of parameters. */ /** Annotation for a method: return value and list of parameters. */
type t = (Item.t, list Item.t) [@@deriving compare]; type t = (Item.t, list Item.t) [@@deriving compare];

33
infer/src/IR/AttributesTable.re
Unescape View File

@ -10,11 +10,11 @@ open! IStd;
open! PVariant; open! PVariant;
let module Hashtbl = Caml.Hashtbl; module Hashtbl = Caml.Hashtbl;
let module F = Format; module F = Format;
let module L = Logging; module L = Logging;
type attr_kind = type attr_kind =
| ProcDefined | ProcDefined
@ -24,9 +24,10 @@ type attr_kind =
/** Module to manage the table of attributes. */ /** Module to manage the table of attributes. */
let serializer: Serialization.serializer ProcAttributes.t = Serialization.create_serializer Serialization.Key.attributes; let serializer: Serialization.serializer ProcAttributes.t =
Serialization.create_serializer Serialization.Key.attributes;
let attributes_filename proc_kind::proc_kind pname_file => { let attributes_filename ::proc_kind pname_file => {
let file_suffix = let file_suffix =
switch proc_kind { switch proc_kind {
| ProcDefined => ".attr" | ProcDefined => ".attr"
@ -38,9 +39,9 @@ let attributes_filename proc_kind::proc_kind pname_file => {
/** path to the .attr file for the given procedure in the current results directory */ /** path to the .attr file for the given procedure in the current results directory */
let res_dir_attr_filename create_dir::create_dir proc_kind::proc_kind pname => { let res_dir_attr_filename ::create_dir ::proc_kind pname => {
let pname_file = Typ.Procname.to_filename pname; let pname_file = Typ.Procname.to_filename pname;
let attr_fname = attributes_filename proc_kind::proc_kind pname_file; let attr_fname = attributes_filename ::proc_kind pname_file;
let bucket_dir = { let bucket_dir = {
let base = pname_file; let base = pname_file;
let len = String.length base; let len = String.length base;
@ -61,10 +62,9 @@ let res_dir_attr_filename create_dir::create_dir proc_kind::proc_kind pname => {
/* Load the proc attribute for the defined filename if it exists, /* Load the proc attribute for the defined filename if it exists,
otherwise try to load the declared filename. */ otherwise try to load the declared filename. */
let load_attr defined_only::defined_only proc_name => { let load_attr ::defined_only proc_name => {
let attributes_file proc_kind::proc_kind proc_name => Multilinks.resolve ( let attributes_file ::proc_kind proc_name =>
res_dir_attr_filename create_dir::false proc_kind::proc_kind proc_name Multilinks.resolve (res_dir_attr_filename create_dir::false ::proc_kind proc_name);
);
let attr = let attr =
Serialization.read_from_file serializer (attributes_file proc_kind::ProcDefined proc_name); Serialization.read_from_file serializer (attributes_file proc_kind::ProcDefined proc_name);
if (is_none attr && not defined_only) { if (is_none attr && not defined_only) {
@ -104,8 +104,7 @@ let less_relevant_proc_kinds proc_kind =>
If defined, delete the declared file if it exists. */ If defined, delete the declared file if it exists. */
let write_and_delete proc_name (proc_attributes: ProcAttributes.t) => { let write_and_delete proc_name (proc_attributes: ProcAttributes.t) => {
let proc_kind = create_proc_kind proc_attributes; let proc_kind = create_proc_kind proc_attributes;
let attributes_file proc_kind => let attributes_file proc_kind => res_dir_attr_filename create_dir::true ::proc_kind proc_name;
res_dir_attr_filename create_dir::true proc_kind::proc_kind proc_name;
Serialization.write_to_file serializer (attributes_file proc_kind) data::proc_attributes; Serialization.write_to_file serializer (attributes_file proc_kind) data::proc_attributes;
let upgrade_relevance less_relevant_proc_kind => { let upgrade_relevance less_relevant_proc_kind => {
let fname_declared = DB.filename_to_string (attributes_file less_relevant_proc_kind); let fname_declared = DB.filename_to_string (attributes_file less_relevant_proc_kind);
@ -161,7 +160,7 @@ let attr_tbl = Typ.Procname.Hash.create 16;
let defined_attr_tbl = Typ.Procname.Hash.create 16; let defined_attr_tbl = Typ.Procname.Hash.create 16;
let load_attributes cache::cache proc_name => let load_attributes ::cache proc_name =>
try (Typ.Procname.Hash.find attr_tbl proc_name) { try (Typ.Procname.Hash.find attr_tbl proc_name) {
| Not_found => | Not_found =>
let proc_attributes = load_attr defined_only::false proc_name; let proc_attributes = load_attr defined_only::false proc_name;
@ -178,7 +177,7 @@ let load_attributes cache::cache proc_name =>
proc_attributes proc_attributes
}; };
let load_defined_attributes cache_none::cache_none proc_name => let load_defined_attributes ::cache_none proc_name =>
try (Typ.Procname.Hash.find defined_attr_tbl proc_name) { try (Typ.Procname.Hash.find defined_attr_tbl proc_name) {
| Not_found => | Not_found =>
let proc_attributes = load_attr defined_only::true proc_name; let proc_attributes = load_attr defined_only::true proc_name;
@ -262,8 +261,8 @@ let stats () => {
/* Find the file where the procedure was captured, if a cfg for that file exists. /* Find the file where the procedure was captured, if a cfg for that file exists.
Return also a boolean indicating whether the procedure is defined in an Return also a boolean indicating whether the procedure is defined in an
include file. */ include file. */
let find_file_capturing_procedure cache::cache=true pname => let find_file_capturing_procedure ::cache=true pname =>
switch (load_attributes cache::cache pname) { switch (load_attributes ::cache pname) {
| None => None | None => None
| Some proc_attributes => | Some proc_attributes =>
let source_file = proc_attributes.ProcAttributes.source_file_captured; let source_file = proc_attributes.ProcAttributes.source_file_captured;

4
infer/src/IR/Binop.re
Unescape View File

@ -11,9 +11,9 @@ open! IStd;
/** The Smallfoot Intermediate Language: Binary Operators */ /** The Smallfoot Intermediate Language: Binary Operators */
let module L = Logging; module L = Logging;
let module F = Format; module F = Format;
/** Binary operations */ /** Binary operations */

4
infer/src/IR/Binop.rei
Unescape View File

@ -11,9 +11,9 @@ open! IStd;
/** The Smallfoot Intermediate Language: Binary Operators */ /** The Smallfoot Intermediate Language: Binary Operators */
let module L = Logging; module L = Logging;
let module F = Format; module F = Format;
/** Binary operations */ /** Binary operations */

4
infer/src/IR/CallFlags.re
Unescape View File

@ -11,9 +11,9 @@ open! IStd;
/** The Smallfoot Intermediate Language: Call Flags */ /** The Smallfoot Intermediate Language: Call Flags */
let module L = Logging; module L = Logging;
let module F = Format; module F = Format;
/** Flags for a procedure call */ /** Flags for a procedure call */

4
infer/src/IR/CallFlags.rei
Unescape View File

@ -11,9 +11,9 @@ open! IStd;
/** The Smallfoot Intermediate Language: Call Flags */ /** The Smallfoot Intermediate Language: Call Flags */
let module L = Logging; module L = Logging;
let module F = Format; module F = Format;
/** Flags for a procedure call */ /** Flags for a procedure call */

11
infer/src/IR/Cfg.re
Unescape View File

@ -9,9 +9,9 @@
*/ */
open! IStd; open! IStd;
let module L = Logging; module L = Logging;
let module F = Format; module F = Format;
/** data type for the control flow graph */ /** data type for the control flow graph */
@ -42,7 +42,7 @@ let create_proc_desc cfg (proc_attributes: ProcAttributes.t) => {
/** Iterate over all the nodes in the cfg */ /** Iterate over all the nodes in the cfg */
let iter_all_nodes sorted::sorted=false f cfg => { let iter_all_nodes ::sorted=false f cfg => {
let do_proc_desc _ (pdesc: Procdesc.t) => let do_proc_desc _ (pdesc: Procdesc.t) =>
List.iter f::(fun node => f pdesc node) (Procdesc.get_nodes pdesc); List.iter f::(fun node => f pdesc node) (Procdesc.get_nodes pdesc);
if (not sorted) { if (not sorted) {
@ -120,7 +120,8 @@ let check_cfg_connectedness cfg => {
/** Serializer for control flow graphs */ /** Serializer for control flow graphs */
let cfg_serializer: Serialization.serializer cfg = Serialization.create_serializer Serialization.Key.cfg; let cfg_serializer: Serialization.serializer cfg =
Serialization.create_serializer Serialization.Key.cfg;
/** Load a cfg from a file */ /** Load a cfg from a file */
@ -324,7 +325,7 @@ let mark_unchanged_pdescs cfg_new cfg_old => {
/** Save a cfg into a file */ /** Save a cfg into a file */
let store_cfg_to_file source_file::source_file (filename: DB.filename) (cfg: cfg) => { let store_cfg_to_file ::source_file (filename: DB.filename) (cfg: cfg) => {
inline_java_synthetic_methods cfg; inline_java_synthetic_methods cfg;
if Config.incremental_procs { if Config.incremental_procs {
switch (load_cfg_from_file filename) { switch (load_cfg_from_file filename) {

15
infer/src/IR/Cg.re
Unescape View File

@ -9,13 +9,13 @@
*/ */
open! IStd; open! IStd;
let module Hashtbl = Caml.Hashtbl; module Hashtbl = Caml.Hashtbl;
/** Module for call graphs */ /** Module for call graphs */
let module L = Logging; module L = Logging;
let module F = Format; module F = Format;
type node = Typ.Procname.t; type node = Typ.Procname.t;
@ -55,7 +55,7 @@ let create source_opt => {
{source, node_map: Typ.Procname.Hash.create 3} {source, node_map: Typ.Procname.Hash.create 3}
}; };
let add_node g n defined::defined => let add_node g n ::defined =>
try { try {
let info = Typ.Procname.Hash.find g.node_map n; let info = Typ.Procname.Hash.find g.node_map n;
/* defined and disabled only go from false to true /* defined and disabled only go from false to true
@ -190,7 +190,7 @@ let node_map_iter f g => {
let table = ref []; let table = ref [];
Typ.Procname.Hash.iter (fun node info => table := [(node, info), ...!table]) g.node_map; Typ.Procname.Hash.iter (fun node info => table := [(node, info), ...!table]) g.node_map;
let cmp (n1: Typ.Procname.t, _) (n2: Typ.Procname.t, _) => Typ.Procname.compare n1 n2; let cmp (n1: Typ.Procname.t, _) (n2: Typ.Procname.t, _) => Typ.Procname.compare n1 n2;
List.iter f::(fun (n, info) => f n info) (List.sort cmp::cmp !table) List.iter f::(fun (n, info) => f n info) (List.sort ::cmp !table)
}; };
let get_nodes (g: t) => { let get_nodes (g: t) => {
@ -345,13 +345,14 @@ let get_source (g: t) => g.source;
undefined nodes become defined if at least one side is. */ undefined nodes become defined if at least one side is. */
let extend cg_old cg_new => { let extend cg_old cg_new => {
let (nodes, edges) = get_nodes_and_edges cg_new; let (nodes, edges) = get_nodes_and_edges cg_new;
List.iter f::(fun (node, defined) => add_node cg_old node defined::defined) nodes; List.iter f::(fun (node, defined) => add_node cg_old node ::defined) nodes;
List.iter f::(fun (nfrom, nto) => add_edge cg_old nfrom nto) edges List.iter f::(fun (nfrom, nto) => add_edge cg_old nfrom nto) edges
}; };
/** Begin support for serialization */ /** Begin support for serialization */
let callgraph_serializer: Serialization.serializer (SourceFile.t, nodes_and_edges) = Serialization.create_serializer Serialization.Key.cg; let callgraph_serializer: Serialization.serializer (SourceFile.t, nodes_and_edges) =
Serialization.create_serializer Serialization.Key.cg;
/** Load a call graph from a file */ /** Load a call graph from a file */

4
infer/src/IR/Const.re
Unescape View File

@ -11,9 +11,9 @@ open! IStd;
/** The Smallfoot Intermediate Language: Constants */ /** The Smallfoot Intermediate Language: Constants */
let module L = Logging; module L = Logging;
let module F = Format; module F = Format;
type t = type t =
| Cint IntLit.t /** integer constants */ | Cint IntLit.t /** integer constants */

4
infer/src/IR/Const.rei
Unescape View File

@ -11,9 +11,9 @@ open! IStd;
/** The Smallfoot Intermediate Language: Constants */ /** The Smallfoot Intermediate Language: Constants */
let module L = Logging; module L = Logging;
let module F = Format; module F = Format;
/** Constants */ /** Constants */

4
infer/src/IR/DecompiledExp.re
Unescape View File

@ -11,9 +11,9 @@ open! IStd;
/** The Smallfoot Intermediate Language: Decompiled Expressions */ /** The Smallfoot Intermediate Language: Decompiled Expressions */
let module L = Logging; module L = Logging;
let module F = Format; module F = Format;
/** expression representing the result of decompilation */ /** expression representing the result of decompilation */

4
infer/src/IR/DecompiledExp.rei
Unescape View File

@ -11,9 +11,9 @@ open! IStd;
/** The Smallfoot Intermediate Language: Decompiled Expressions */ /** The Smallfoot Intermediate Language: Decompiled Expressions */
let module L = Logging; module L = Logging;
let module F = Format; module F = Format;
/** expression representing the result of decompilation */ /** expression representing the result of decompilation */

21
infer/src/IR/Exp.re
Unescape View File

@ -9,13 +9,13 @@
*/ */
open! IStd; open! IStd;
let module Hashtbl = Caml.Hashtbl; module Hashtbl = Caml.Hashtbl;
/** The Smallfoot Intermediate Language: Expressions */ /** The Smallfoot Intermediate Language: Expressions */
let module L = Logging; module L = Logging;
let module F = Format; module F = Format;
/* reverse the natural order on Var */ /* reverse the natural order on Var */
type _ident = Ident.t; type _ident = Ident.t;
@ -58,21 +58,24 @@ let equal = [%compare.equal : t];
let hash = Hashtbl.hash; let hash = Hashtbl.hash;
let module Set = Caml.Set.Make { module Set =
Caml.Set.Make {
type nonrec t = t; type nonrec t = t;
let compare = compare; let compare = compare;
}; };
let module Map = Caml.Map.Make { module Map =
Caml.Map.Make {
type nonrec t = t; type nonrec t = t;
let compare = compare; let compare = compare;
}; };
let module Hash = Hashtbl.Make { module Hash =
Hashtbl.Make {
type nonrec t = t; type nonrec t = t;
let equal = equal; let equal = equal;
let hash = hash; let hash = hash;
}; };
let rec is_array_index_of exp1 exp2 => let rec is_array_index_of exp1 exp2 =>
switch exp1 { switch exp1 {

10
infer/src/IR/Exp.rei
Unescape View File

@ -11,9 +11,9 @@ open! IStd;
/** The Smallfoot Intermediate Language: Expressions */ /** The Smallfoot Intermediate Language: Expressions */
let module L = Logging; module L = Logging;
let module F = Format; module F = Format;
type closure = {name: Typ.Procname.t, captured_vars: list (t, Pvar.t, Typ.t)} [@@deriving compare] type closure = {name: Typ.Procname.t, captured_vars: list (t, Pvar.t, Typ.t)} [@@deriving compare]
/** dynamically determined length of an array value, if any */ /** dynamically determined length of an array value, if any */
@ -58,15 +58,15 @@ let hash: t => int;
/** Set of expressions. */ /** Set of expressions. */
let module Set: Caml.Set.S with type elt = t; module Set: Caml.Set.S with type elt = t;
/** Map with expression keys. */ /** Map with expression keys. */
let module Map: Caml.Map.S with type key = t; module Map: Caml.Map.S with type key = t;
/** Hashtable with expression keys. */ /** Hashtable with expression keys. */
let module Hash: Caml.Hashtbl.S with type key = t; module Hash: Caml.Hashtbl.S with type key = t;
/** returns true is index is an array index of arr. */ /** returns true is index is an array index of arr. */

16
infer/src/IR/Fieldname.re
Unescape View File

@ -8,7 +8,7 @@
*/ */
open! IStd; open! IStd;
let module Hashtbl = Caml.Hashtbl; module Hashtbl = Caml.Hashtbl;
type clang_field_info = {qual_class: QualifiedCppName.t, field_name: string} [@@deriving compare]; type clang_field_info = {qual_class: QualifiedCppName.t, field_name: string} [@@deriving compare];
@ -22,21 +22,23 @@ let hidden_str = ".hidden";
let equal = [%compare.equal : t]; let equal = [%compare.equal : t];
let module Set = Caml.Set.Make { module Set =
Caml.Set.Make {
type nonrec t = t; type nonrec t = t;
let compare = compare; let compare = compare;
}; };
let module Map = Caml.Map.Make { module Map =
Caml.Map.Make {
type nonrec t = t; type nonrec t = t;
let compare = compare; let compare = compare;
}; };
let module Clang = { module Clang = {
let from_qualified qual_class field_name => Clang {qual_class, field_name}; let from_qualified qual_class field_name => Clang {qual_class, field_name};
}; };
let module Java = { module Java = {
let from_string n => Java n; let from_string n => Java n;
}; };

8
infer/src/IR/Fieldname.rei
Unescape View File

@ -18,19 +18,19 @@ let equal: t => t => bool;
/** Set for fieldnames */ /** Set for fieldnames */
let module Set: Caml.Set.S with type elt = t; module Set: Caml.Set.S with type elt = t;
/** Map for fieldnames */ /** Map for fieldnames */
let module Map: Caml.Map.S with type key = t; module Map: Caml.Map.S with type key = t;
let module Clang: { module Clang: {
/** Create a clang field name from qualified c++ name */ /** Create a clang field name from qualified c++ name */
let from_qualified: QualifiedCppName.t => string => t; let from_qualified: QualifiedCppName.t => string => t;
}; };
let module Java: { module Java: {
/** Create a java field name from string */ /** Create a java field name from string */
let from_string: string => t; let from_string: string => t;

33
infer/src/IR/Ident.re
Unescape View File

@ -9,15 +9,15 @@
*/ */
open! IStd; open! IStd;
let module Hashtbl = Caml.Hashtbl; module Hashtbl = Caml.Hashtbl;
/** Module for Names and Identifiers */ /** Module for Names and Identifiers */
let module L = Logging; module L = Logging;
let module F = Format; module F = Format;
let module Name = { module Name = {
type t = type t =
| Primed | Primed
| Normal | Normal
@ -68,7 +68,7 @@ let equal_kind = [%compare.equal : kind];
/* timestamp for a path identifier */ /* timestamp for a path identifier */
let path_ident_stamp = (-3); let path_ident_stamp = (-3);
type t = {kind: kind, name: Name.t, stamp: int} [@@deriving compare]; type t = {kind, name: Name.t, stamp: int} [@@deriving compare];
/* most unlikely first */ /* most unlikely first */
let equal i1 i2 => let equal i1 i2 =>
@ -76,32 +76,36 @@ let equal i1 i2 =>
/** {2 Set for identifiers} */ /** {2 Set for identifiers} */
let module IdentSet = Caml.Set.Make { module IdentSet =
Caml.Set.Make {
type nonrec t = t; type nonrec t = t;
let compare = compare; let compare = compare;
}; };
let module IdentMap = Caml.Map.Make { module IdentMap =
Caml.Map.Make {
type nonrec t = t; type nonrec t = t;
let compare = compare; let compare = compare;
}; };
let module IdentHash = Hashtbl.Make { module IdentHash =
Hashtbl.Make {
type nonrec t = t; type nonrec t = t;
let equal = equal; let equal = equal;
let hash (id: t) => Hashtbl.hash id; let hash (id: t) => Hashtbl.hash id;
}; };
let idlist_to_idset ids => let idlist_to_idset ids =>
List.fold f::(fun set id => IdentSet.add id set) init::IdentSet.empty ids; List.fold f::(fun set id => IdentSet.add id set) init::IdentSet.empty ids;
/** {2 Conversion between Names and Strings} */ /** {2 Conversion between Names and Strings} */
let module NameHash = Hashtbl.Make { module NameHash =
Hashtbl.Make {
type t = name; type t = name;
let equal = equal_name; let equal = equal_name;
let hash = Hashtbl.hash; let hash = Hashtbl.hash;
}; };
/** Convert a string to a name */ /** Convert a string to a name */
@ -111,6 +115,7 @@ let string_to_name = Name.from_string;
/** Convert a name to a string. */ /** Convert a name to a string. */
let name_to_string = Name.to_string; let name_to_string = Name.to_string;
/** {2 Functions and Hash Tables for Managing Stamps} */ /** {2 Functions and Hash Tables for Managing Stamps} */
/** Set the stamp of the identifier */ /** Set the stamp of the identifier */
@ -120,7 +125,7 @@ let set_stamp i stamp => {...i, stamp};
/** Get the stamp of the identifier */ /** Get the stamp of the identifier */
let get_stamp i => i.stamp; let get_stamp i => i.stamp;
let module NameGenerator = { module NameGenerator = {
type t = NameHash.t int; type t = NameHash.t int;
let create () :t => NameHash.create 17; let create () :t => NameHash.create 17;

10
infer/src/IR/Ident.rei
Unescape View File

@ -37,17 +37,17 @@ let equal_kind: kind => kind => bool;
/** Set for identifiers. */ /** Set for identifiers. */
let module IdentSet: Caml.Set.S with type elt = t; module IdentSet: Caml.Set.S with type elt = t;
/** Hash table with ident as key. */ /** Hash table with ident as key. */
let module IdentHash: Caml.Hashtbl.S with type key = t; module IdentHash: Caml.Hashtbl.S with type key = t;
/** Map with ident as key. */ /** Map with ident as key. */
let module IdentMap: Caml.Map.S with type key = t; module IdentMap: Caml.Map.S with type key = t;
let module NameGenerator: { module NameGenerator: {
type t; type t;
/** Get the current name generator. */ /** Get the current name generator. */
@ -72,7 +72,7 @@ let kfootprint: kind;
/** hash table with names as keys */ /** hash table with names as keys */
let module NameHash: Caml.Hashtbl.S with type key = name; module NameHash: Caml.Hashtbl.S with type key = name;
/** Name used for primed tmp variables */ /** Name used for primed tmp variables */

2
infer/src/IR/IntLit.re
Unescape View File

@ -9,7 +9,7 @@
*/ */
open! IStd; open! IStd;
let module F = Format; module F = Format;
/** signed and unsigned integer literals */ /** signed and unsigned integer literals */

2
infer/src/IR/IntLit.rei
Unescape View File

@ -9,7 +9,7 @@
*/ */
open! IStd; open! IStd;
let module F = Format; module F = Format;
/** signed and unsigned integer literals */ /** signed and unsigned integer literals */

4
infer/src/IR/Location.re
Unescape View File

@ -8,9 +8,9 @@
*/ */
open! IStd; open! IStd;
let module F = Format; module F = Format;
let module L = Logging; module L = Logging;
/** Location in the original source file */ /** Location in the original source file */

12
infer/src/IR/Mangled.re
Unescape View File

@ -11,7 +11,7 @@ open! IStd;
/** Module for Mangled Names */ /** Module for Mangled Names */
let module F = Format; module F = Format;
type t = {plain: string, mangled: option string} [@@deriving compare]; type t = {plain: string, mangled: option string} [@@deriving compare];
@ -52,12 +52,14 @@ let get_mangled pn =>
/** Pretty print a mangled name */ /** Pretty print a mangled name */
let pp f pn => F.fprintf f "%s" (to_string pn); let pp f pn => F.fprintf f "%s" (to_string pn);
let module Set = Caml.Set.Make { module Set =
Caml.Set.Make {
type nonrec t = t; type nonrec t = t;
let compare = compare; let compare = compare;
}; };
let module Map = Caml.Map.Make { module Map =
Caml.Map.Make {
type nonrec t = t; type nonrec t = t;
let compare = compare; let compare = compare;
}; };

4
infer/src/IR/Mangled.rei
Unescape View File

@ -45,8 +45,8 @@ let pp: Format.formatter => t => unit;
/** Set of Mangled. */ /** Set of Mangled. */
let module Set: Caml.Set.S with type elt = t; module Set: Caml.Set.S with type elt = t;
/** Map with Mangled as key */ /** Map with Mangled as key */
let module Map: Caml.Map.S with type key = t; module Map: Caml.Map.S with type key = t;

6
infer/src/IR/PredSymb.re
Unescape View File

@ -11,9 +11,9 @@ open! IStd;
/** The Smallfoot Intermediate Language: Predicate Symbols */ /** The Smallfoot Intermediate Language: Predicate Symbols */
let module L = Logging; module L = Logging;
let module F = Format; module F = Format;
type func_attribute = type func_attribute =
| FA_sentinel int int /** __attribute__((sentinel(int, int))) */ | FA_sentinel int int /** __attribute__((sentinel(int, int))) */
@ -96,7 +96,7 @@ type taint_kind =
| Tk_unknown | Tk_unknown
[@@deriving compare]; [@@deriving compare];
type taint_info = {taint_source: Typ.Procname.t, taint_kind: taint_kind} [@@deriving compare]; type taint_info = {taint_source: Typ.Procname.t, taint_kind} [@@deriving compare];
/** acquire/release action on a resource */ /** acquire/release action on a resource */

6
infer/src/IR/PredSymb.rei
Unescape View File

@ -11,9 +11,9 @@ open! IStd;
/** The Smallfoot Intermediate Language: Predicate Symbols */ /** The Smallfoot Intermediate Language: Predicate Symbols */
let module L = Logging; module L = Logging;
let module F = Format; module F = Format;
/** {2 Programs and Types} */ /** {2 Programs and Types} */
@ -84,7 +84,7 @@ type taint_kind =
| Tk_integrity_annotation | Tk_integrity_annotation
| Tk_unknown; | Tk_unknown;
type taint_info = {taint_source: Typ.Procname.t, taint_kind: taint_kind}; type taint_info = {taint_source: Typ.Procname.t, taint_kind};
/** acquire/release action on a resource */ /** acquire/release action on a resource */

8
infer/src/IR/ProcAttributes.re
Unescape View File

@ -8,13 +8,13 @@
*/ */
open! IStd; open! IStd;
let module Hashtbl = Caml.Hashtbl; module Hashtbl = Caml.Hashtbl;
/** Attributes of a procedure. */ /** Attributes of a procedure. */
let module L = Logging; module L = Logging;
let module F = Format; module F = Format;
/** flags for a procedure */ /** flags for a procedure */
@ -66,7 +66,7 @@ type t = {
mutable locals: list (Mangled.t, Typ.t), /** name and type of local variables */ mutable locals: list (Mangled.t, Typ.t), /** name and type of local variables */
method_annotation: Annot.Method.t, /** annotations for java methods */ method_annotation: Annot.Method.t, /** annotations for java methods */
objc_accessor: option objc_accessor_type, /** type of ObjC accessor, if any */ objc_accessor: option objc_accessor_type, /** type of ObjC accessor, if any */
proc_flags: proc_flags, /** flags of the procedure */ proc_flags, /** flags of the procedure */
proc_name: Typ.Procname.t, /** name of the procedure */ proc_name: Typ.Procname.t, /** name of the procedure */
ret_type: Typ.t, /** return type */ ret_type: Typ.t, /** return type */
source_file_captured: SourceFile.t /** source file where the procedure was captured */ source_file_captured: SourceFile.t /** source file where the procedure was captured */

2
infer/src/IR/ProcAttributes.rei
Unescape View File

@ -61,7 +61,7 @@ type t = {
mutable locals: list (Mangled.t, Typ.t), /** name and type of local variables */ mutable locals: list (Mangled.t, Typ.t), /** name and type of local variables */
method_annotation: Annot.Method.t, /** annotations for java methods */ method_annotation: Annot.Method.t, /** annotations for java methods */
objc_accessor: option objc_accessor_type, /** type of ObjC accessor, if any */ objc_accessor: option objc_accessor_type, /** type of ObjC accessor, if any */
proc_flags: proc_flags, /** flags of the procedure */ proc_flags, /** flags of the procedure */
proc_name: Typ.Procname.t, /** name of the procedure */ proc_name: Typ.Procname.t, /** name of the procedure */
ret_type: Typ.t, /** return type */ ret_type: Typ.t, /** return type */
source_file_captured: SourceFile.t /** source file where the procedure was captured */ source_file_captured: SourceFile.t /** source file where the procedure was captured */

38
infer/src/IR/Procdesc.re
Unescape View File

@ -9,14 +9,14 @@
*/ */
open! IStd; open! IStd;
let module Hashtbl = Caml.Hashtbl; module Hashtbl = Caml.Hashtbl;
let module L = Logging; module L = Logging;
let module F = Format; module F = Format;
/* =============== START of module Node =============== */ /* =============== START of module Node =============== */
let module Node = { module Node = {
type id = int [@@deriving compare]; type id = int [@@deriving compare];
let equal_id = [%compare.equal : id]; let equal_id = [%compare.equal : id];
type nodekind = type nodekind =
@ -32,7 +32,7 @@ let module Node = {
/** a node */ /** a node */
type t = { type t = {
/** unique id of the node */ /** unique id of the node */
id: id, id,
/** distance to the exit node */ /** distance to the exit node */
mutable dist_exit: option int, mutable dist_exit: option int,
/** exception nodes in the cfg */ /** exception nodes in the cfg */
@ -72,11 +72,13 @@ let module Node = {
let get_id node => node.id; let get_id node => node.id;
let get_succs node => node.succs; let get_succs node => node.succs;
type node = t; type node = t;
let module NodeSet = Caml.Set.Make { module NodeSet =
Caml.Set.Make {
type t = node; type t = node;
let compare = compare; let compare = compare;
}; };
let module IdMap = Caml.Map.Make { module IdMap =
Caml.Map.Make {
type t = id; type t = id;
let compare = compare_id; let compare = compare_id;
}; };
@ -199,7 +201,7 @@ let module Node = {
/** Print extended instructions for the node, /** Print extended instructions for the node,
highlighting the given subinstruction if present */ highlighting the given subinstruction if present */
let pp_instrs pe0 sub_instrs::sub_instrs instro fmt node => { let pp_instrs pe0 ::sub_instrs instro fmt node => {
let pe = let pe =
switch instro { switch instro {
| None => pe0 | None => pe0
@ -249,10 +251,8 @@ let module Node = {
}; };
/** Dump extended instructions for the node */ /** Dump extended instructions for the node */
let d_instrs sub_instrs::(sub_instrs: bool) (curr_instr: option Sil.instr) (node: t) => L.add_print_action ( let d_instrs sub_instrs::(sub_instrs: bool) (curr_instr: option Sil.instr) (node: t) =>
L.PTnode_instrs, L.add_print_action (L.PTnode_instrs, Obj.repr (sub_instrs, curr_instr, node));
Obj.repr (sub_instrs, curr_instr, node)
);
/** Return a description of the cfg node */ /** Return a description of the cfg node */
let get_description pe node => { let get_description pe node => {
@ -273,19 +273,19 @@ let module Node = {
/* =============== END of module Node =============== */ /* =============== END of module Node =============== */
/** Map over nodes */ /** Map over nodes */
let module NodeMap = Caml.Map.Make Node; module NodeMap = Caml.Map.Make Node;
/** Hash table with nodes as keys. */ /** Hash table with nodes as keys. */
let module NodeHash = Hashtbl.Make Node; module NodeHash = Hashtbl.Make Node;
/** Set of nodes. */ /** Set of nodes. */
let module NodeSet = Node.NodeSet; module NodeSet = Node.NodeSet;
/** Map with node id keys. */ /** Map with node id keys. */
let module IdMap = Node.IdMap; module IdMap = Node.IdMap;
/** procedure description */ /** procedure description */
@ -301,7 +301,7 @@ type t = {
/** Only call from Cfg */ /** Only call from Cfg */
let from_proc_attributes called_from_cfg::called_from_cfg attributes => { let from_proc_attributes ::called_from_cfg attributes => {
if (not called_from_cfg) { if (not called_from_cfg) {
assert false assert false
}; };
@ -395,7 +395,7 @@ let is_body_empty pdesc => List.is_empty (Node.get_succs (get_start_node pdesc))
let is_java_synchronized pdesc => pdesc.attributes.is_java_synchronized_method; let is_java_synchronized pdesc => pdesc.attributes.is_java_synchronized_method;
let iter_nodes f pdesc => List.iter f::f (List.rev (get_nodes pdesc)); let iter_nodes f pdesc => List.iter ::f (List.rev (get_nodes pdesc));
let fold_calls f acc pdesc => { let fold_calls f acc pdesc => {
let do_node a node => let do_node a node =>
@ -415,7 +415,7 @@ let iter_instrs f pdesc => {
iter_nodes do_node pdesc iter_nodes do_node pdesc
}; };
let fold_nodes f acc pdesc => List.fold f::f init::acc (List.rev (get_nodes pdesc)); let fold_nodes f acc pdesc => List.fold ::f init::acc (List.rev (get_nodes pdesc));
let fold_instrs f acc pdesc => { let fold_instrs f acc pdesc => {
let fold_node acc node => let fold_node acc node =>

12
infer/src/IR/Procdesc.rei
Unescape View File

@ -11,13 +11,13 @@ open! IStd;
/** node of the control flow graph */ /** node of the control flow graph */
let module Node: { module Node: {
/** type of nodes */ /** type of nodes */
type t [@@deriving compare]; type t [@@deriving compare];
/** node id */ /** node id */
type id = private int [@@deriving compare]; type id = pri int [@@deriving compare];
let equal_id: id => id => bool; let equal_id: id => id => bool;
/** kind of cfg node */ /** kind of cfg node */
@ -120,19 +120,19 @@ let module Node: {
/** Map with node id keys. */ /** Map with node id keys. */
let module IdMap: Caml.Map.S with type key = Node.id; module IdMap: Caml.Map.S with type key = Node.id;
/** Hash table with nodes as keys. */ /** Hash table with nodes as keys. */
let module NodeHash: Caml.Hashtbl.S with type key = Node.t; module NodeHash: Caml.Hashtbl.S with type key = Node.t;
/** Map over nodes. */ /** Map over nodes. */
let module NodeMap: Caml.Map.S with type key = Node.t; module NodeMap: Caml.Map.S with type key = Node.t;
/** Set of nodes. */ /** Set of nodes. */
let module NodeSet: Caml.Set.S with type elt = Node.t; module NodeSet: Caml.Set.S with type elt = Node.t;
/** procedure descriptions */ /** procedure descriptions */

17
infer/src/IR/Pvar.re
Unescape View File

@ -11,9 +11,9 @@ open! IStd;
/** The Smallfoot Intermediate Language */ /** The Smallfoot Intermediate Language */
let module L = Logging; module L = Logging;
let module F = Format; module F = Format;
/** Kind of global variables */ /** Kind of global variables */
@ -301,13 +301,7 @@ let mk_callee (name: Mangled.t) (proc_name: Typ.Procname.t) :t => {
/** create a global variable with the given name */ /** create a global variable with the given name */
let mk_global let mk_global ::is_constexpr=false ::is_pod=true ::is_static_local=false (name: Mangled.t) fname :t => {
is_constexpr::is_constexpr=false
is_pod::is_pod=true
is_static_local::is_static_local=false
(name: Mangled.t)
fname
:t => {
pv_hash: name_hash name, pv_hash: name_hash name,
pv_name: name, pv_name: name,
pv_kind: Global_var (fname, is_constexpr, is_pod, is_static_local) pv_kind: Global_var (fname, is_constexpr, is_pod, is_static_local)
@ -362,9 +356,10 @@ let get_initializer_pname {pv_name, pv_kind} =>
| _ => None | _ => None
}; };
let module Set = PrettyPrintable.MakePPCompareSet { module Set =
PrettyPrintable.MakePPCompareSet {
type nonrec t = t; type nonrec t = t;
let compare = compare; let compare = compare;
let compare_pp = compare_alpha; let compare_pp = compare_alpha;
let pp = pp Pp.text; let pp = pp Pp.text;
}; };

4
infer/src/IR/Pvar.rei
Unescape View File

@ -11,7 +11,7 @@ open! IStd;
/** Program variables. */ /** Program variables. */
let module F = Format; module F = Format;
/** Type for program variables. There are 4 kinds of variables: /** Type for program variables. There are 4 kinds of variables:
@ -154,4 +154,4 @@ let is_pod: t => bool;
/** Get the procname of the initializer function for the given global variable */ /** Get the procname of the initializer function for the given global variable */
let get_initializer_pname: t => option Typ.Procname.t; let get_initializer_pname: t => option Typ.Procname.t;
let module Set: PrettyPrintable.PPSet with type elt = t; module Set: PrettyPrintable.PPSet with type elt = t;

6
infer/src/IR/QualifiedCppName.re
Unescape View File

@ -15,7 +15,7 @@ let equal = [%compare.equal : t];
let empty = []; let empty = [];
let append_qualifier quals qual::qual => List.cons qual quals; let append_qualifier quals ::qual => List.cons qual quals;
let extract_last = let extract_last =
fun fun
@ -45,13 +45,13 @@ let cpp_separator_regex = Str.regexp_string cpp_separator;
"someMethod"]. Avoid using it if possible */ "someMethod"]. Avoid using it if possible */
let of_qual_string str => Str.split cpp_separator_regex str |> List.rev; let of_qual_string str => Str.split cpp_separator_regex str |> List.rev;
let to_separated_string quals sep::sep => List.rev quals |> String.concat sep::sep; let to_separated_string quals ::sep => List.rev quals |> String.concat ::sep;
let to_qual_string = to_separated_string sep::cpp_separator; let to_qual_string = to_separated_string sep::cpp_separator;
let pp fmt quals => Format.fprintf fmt "%s" (to_qual_string quals); let pp fmt quals => Format.fprintf fmt "%s" (to_qual_string quals);
let module Match = { module Match = {
type quals_matcher = Str.regexp; type quals_matcher = Str.regexp;
let matching_separator = "#"; let matching_separator = "#";
let regexp_string_of_qualifiers quals => let regexp_string_of_qualifiers quals =>

2
infer/src/IR/QualifiedCppName.rei
Unescape View File

@ -83,7 +83,7 @@ let pp: Format.formatter => t => unit;
qualifiers to match qualifiers to match
does not match: ["folly","someFunction<int>", "BAD"] - same as previous example does not match: ["folly","someFunction<int>", "BAD"] - same as previous example
*/ */
let module Match: { module Match: {
type quals_matcher; type quals_matcher;
let of_fuzzy_qual_names: list string => quals_matcher; let of_fuzzy_qual_names: list string => quals_matcher;
let match_qualifiers: quals_matcher => t => bool; let match_qualifiers: quals_matcher => t => bool;

57
infer/src/IR/Sil.re
Unescape View File

@ -9,13 +9,13 @@
*/ */
open! IStd; open! IStd;
let module Hashtbl = Caml.Hashtbl; module Hashtbl = Caml.Hashtbl;
/** The Smallfoot Intermediate Language */ /** The Smallfoot Intermediate Language */
let module L = Logging; module L = Logging;
let module F = Format; module F = Format;
/** {2 Programs and Types} */ /** {2 Programs and Types} */
@ -149,10 +149,10 @@ type strexp0 'inst =
type strexp = strexp0 inst; type strexp = strexp0 inst;
let compare_strexp inst::inst=false se1 se2 => let compare_strexp ::inst=false se1 se2 =>
compare_strexp0 (inst ? compare_inst : (fun _ _ => 0)) se1 se2; compare_strexp0 (inst ? compare_inst : (fun _ _ => 0)) se1 se2;
let equal_strexp inst::inst=false se1 se2 => Int.equal (compare_strexp inst::inst se1 se2) 0; let equal_strexp ::inst=false se1 se2 => Int.equal (compare_strexp ::inst se1 se2) 0;
/** an atomic heap predicate */ /** an atomic heap predicate */
@ -199,11 +199,10 @@ type hpred = hpred0 inst;
/** Comparsion between heap predicates. Reverse natural order, and order first by anchor exp. */ /** Comparsion between heap predicates. Reverse natural order, and order first by anchor exp. */
let compare_hpred inst::inst=false hpred1 hpred2 => let compare_hpred ::inst=false hpred1 hpred2 =>
compare_hpred0 (inst ? compare_inst : (fun _ _ => 0)) hpred1 hpred2; compare_hpred0 (inst ? compare_inst : (fun _ _ => 0)) hpred1 hpred2;
let equal_hpred inst::inst=false hpred1 hpred2 => let equal_hpred ::inst=false hpred1 hpred2 => Int.equal (compare_hpred ::inst hpred1 hpred2) 0;
Int.equal (compare_hpred inst::inst hpred1 hpred2) 0;
type hpara = hpara0 inst; type hpara = hpara0 inst;
@ -273,10 +272,11 @@ let elist_to_eset es => List.fold f::(fun set e => Exp.Set.add e set) init::Exp.
/** {2 Sets of heap predicates} */ /** {2 Sets of heap predicates} */
let module HpredSet = Caml.Set.Make { module HpredSet =
Caml.Set.Make {
type t = hpred; type t = hpred;
let compare = compare_hpred inst::false; let compare = compare_hpred inst::false;
}; };
/** {2 Pretty Printing} */ /** {2 Pretty Printing} */
@ -582,7 +582,7 @@ let rec pp_star_seq pp f =>
/** Module Predicates records the occurrences of predicates as parameters /** Module Predicates records the occurrences of predicates as parameters
of (doubly -)linked lists and Epara. Provides unique numbering of (doubly -)linked lists and Epara. Provides unique numbering
for predicates and an iterator. */ for predicates and an iterator. */
let module Predicates: { module Predicates: {
/** predicate environment */ /** predicate environment */
type env; type env;
@ -608,14 +608,16 @@ let module Predicates: {
} = { } = {
/** hash tables for hpara */ /** hash tables for hpara */
let module HparaHash = Hashtbl.Make { module HparaHash =
Hashtbl.Make {
type t = hpara; type t = hpara;
let equal = equal_hpara; let equal = equal_hpara;
let hash = Hashtbl.hash; let hash = Hashtbl.hash;
}; };
/** hash tables for hpara_dll */ /** hash tables for hpara_dll */
let module HparaDllHash = Hashtbl.Make { module HparaDllHash =
Hashtbl.Make {
type t = hpara_dll; type t = hpara_dll;
let equal = equal_hpara_dll; let equal = equal_hpara_dll;
let hash = Hashtbl.hash; let hash = Hashtbl.hash;
@ -1211,8 +1213,8 @@ let atom_expmap (f: Exp.t => Exp.t) =>
fun fun
| Aeq e1 e2 => Aeq (f e1) (f e2) | Aeq e1 e2 => Aeq (f e1) (f e2)
| Aneq e1 e2 => Aneq (f e1) (f e2) | Aneq e1 e2 => Aneq (f e1) (f e2)
| Apred a es => Apred a (List.map f::f es) | Apred a es => Apred a (List.map ::f es)
| Anpred a es => Anpred a (List.map f::f es); | Anpred a es => Anpred a (List.map ::f es);
let atom_list_expmap (f: Exp.t => Exp.t) (alist: list atom) => List.map f::(atom_expmap f) alist; let atom_list_expmap (f: Exp.t => Exp.t) (alist: list atom) => List.map f::(atom_expmap f) alist;
@ -1263,12 +1265,12 @@ let rec strexp_fpv =
| Eexp e _ => exp_fpv e | Eexp e _ => exp_fpv e
| Estruct fld_se_list _ => { | Estruct fld_se_list _ => {
let f (_, se) => strexp_fpv se; let f (_, se) => strexp_fpv se;
List.concat_map f::f fld_se_list List.concat_map ::f fld_se_list
} }
| Earray len idx_se_list _ => { | Earray len idx_se_list _ => {
let fpv_in_len = exp_fpv len; let fpv_in_len = exp_fpv len;
let f (idx, se) => exp_fpv idx @ strexp_fpv se; let f (idx, se) => exp_fpv idx @ strexp_fpv se;
fpv_in_len @ List.concat_map f::f idx_se_list fpv_in_len @ List.concat_map ::f idx_se_list
}; };
let rec hpred_fpv = let rec hpred_fpv =
@ -1900,7 +1902,7 @@ let exp_sub (subst: subst) e => exp_sub_ids (apply_sub subst) e;
/** apply [f] to id's in [instr]. if [sub_id_binders] is false, [f] is only applied to bound id's */ /** apply [f] to id's in [instr]. if [sub_id_binders] is false, [f] is only applied to bound id's */
let instr_sub_ids sub_id_binders::sub_id_binders (f: Ident.t => Exp.t) instr => { let instr_sub_ids ::sub_id_binders (f: Ident.t => Exp.t) instr => {
let sub_id id => let sub_id id =>
switch (exp_sub_ids f (Var id)) { switch (exp_sub_ids f (Var id)) {
| Var id' when not (Ident.equal id id') => id' | Var id' when not (Ident.equal id id') => id'
@ -2247,7 +2249,7 @@ let rec strexp_replace_exp epairs =>
| Eexp e inst => Eexp (exp_replace_exp epairs e) inst | Eexp e inst => Eexp (exp_replace_exp epairs e) inst
| Estruct fsel inst => { | Estruct fsel inst => {
let f (fld, se) => (fld, strexp_replace_exp epairs se); let f (fld, se) => (fld, strexp_replace_exp epairs se);
Estruct (List.map f::f fsel) inst Estruct (List.map ::f fsel) inst
} }
| Earray len isel inst => { | Earray len isel inst => {
let len' = exp_replace_exp epairs len; let len' = exp_replace_exp epairs len;
@ -2255,7 +2257,7 @@ let rec strexp_replace_exp epairs =>
let idx' = exp_replace_exp epairs idx; let idx' = exp_replace_exp epairs idx;
(idx', strexp_replace_exp epairs se) (idx', strexp_replace_exp epairs se)
}; };
Earray len' (List.map f::f isel) inst Earray len' (List.map ::f isel) inst
}; };
let hpred_replace_exp epairs => let hpred_replace_exp epairs =>
@ -2283,11 +2285,12 @@ let hpred_replace_exp epairs =>
/** {2 Compaction} */ /** {2 Compaction} */
let module HpredInstHash = Hashtbl.Make { module HpredInstHash =
Hashtbl.Make {
type t = hpred; type t = hpred;
let equal = equal_hpred inst::true; let equal = equal_hpred inst::true;
let hash = Hashtbl.hash; let hash = Hashtbl.hash;
}; };
type sharing_env = {exph: Exp.Hash.t Exp.t, hpredh: HpredInstHash.t hpred}; type sharing_env = {exph: Exp.Hash.t Exp.t, hpredh: HpredInstHash.t hpred};
@ -2388,7 +2391,7 @@ let sigma_to_sigma_ne sigma :list (list atom, list hpred) =>
]; ];
List.concat_map f::g eqs_sigma_list List.concat_map f::g eqs_sigma_list
}; };
List.fold f::f init::[([], [])] sigma List.fold ::f init::[([], [])] sigma
} else { } else {
[([], sigma)] [([], sigma)]
}; };
@ -2415,9 +2418,8 @@ let hpara_instantiate para e1 e2 elist => {
| Invalid_argument _ => assert false | Invalid_argument _ => assert false
} }
}; };
let subst = sub_of_list ( let subst =
[(para.root, e1), (para.next, e2), ...subst_for_svars] @ subst_for_evars sub_of_list ([(para.root, e1), (para.next, e2), ...subst_for_svars] @ subst_for_evars);
);
(ids_evars, List.map f::(hpred_sub subst) para.body) (ids_evars, List.map f::(hpred_sub subst) para.body)
}; };
@ -2444,7 +2446,8 @@ let hpara_dll_instantiate (para: hpara_dll) cell blink flink elist => {
| Invalid_argument _ => assert false | Invalid_argument _ => assert false
} }
}; };
let subst = sub_of_list ( let subst =
sub_of_list (
[(para.cell, cell), (para.blink, blink), (para.flink, flink), ...subst_for_svars] @ subst_for_evars [(para.cell, cell), (para.blink, blink), (para.flink, flink), ...subst_for_svars] @ subst_for_evars
); );
(ids_evars, List.map f::(hpred_sub subst) para.body_dll) (ids_evars, List.map f::(hpred_sub subst) para.body_dll)

6
infer/src/IR/Sil.rei
Unescape View File

@ -11,7 +11,7 @@ open! IStd;
/** The Smallfoot Intermediate Language */ /** The Smallfoot Intermediate Language */
let module F = Format; module F = Format;
/** {2 Programs and Types} */ /** {2 Programs and Types} */
@ -269,7 +269,7 @@ let equal_hpred: inst::bool? => hpred => hpred => bool;
/** Sets of heap predicates */ /** Sets of heap predicates */
let module HpredSet: Caml.Set.S with type elt = hpred; module HpredSet: Caml.Set.S with type elt = hpred;
/** {2 Compaction} */ /** {2 Compaction} */
@ -460,7 +460,7 @@ let pp_hpara_dll_list: Pp.env => F.formatter => list hpara_dll => unit;
/** Module Predicates records the occurrences of predicates as parameters /** Module Predicates records the occurrences of predicates as parameters
of (doubly -)linked lists and Epara. of (doubly -)linked lists and Epara.
Provides unique numbering for predicates and an iterator. */ Provides unique numbering for predicates and an iterator. */
let module Predicates: { module Predicates: {
/** predicate environment */ /** predicate environment */
type env; type env;

11
infer/src/IR/Subtype.re
Unescape View File

@ -11,9 +11,9 @@ open! IStd;
/** The Smallfoot Intermediate Language: Subtypes */ /** The Smallfoot Intermediate Language: Subtypes */
let module L = Logging; module L = Logging;
let module F = Format; module F = Format;
let list_to_string list => let list_to_string list =>
if (Int.equal (List.length list) 0) { if (Int.equal (List.length list) 0) {
@ -99,10 +99,11 @@ let check_subclass_tenv tenv c1 c2 :result => {
} }
}; };
let module SubtypesMap = Caml.Map.Make { module SubtypesMap =
Caml.Map.Make {
/* pair of subtypes */ /* pair of subtypes */
type t = (Typ.Name.t, Typ.Name.t) [@@deriving compare]; type t = (Typ.Name.t, Typ.Name.t) [@@deriving compare];
}; };
let check_subtype = { let check_subtype = {
let subtMap = ref SubtypesMap.empty; let subtMap = ref SubtypesMap.empty;
@ -150,7 +151,7 @@ let is_cast t => equal_kind (snd t) CAST;
let is_instof t => equal_kind (snd t) INSTOF; let is_instof t => equal_kind (snd t) INSTOF;
let list_intersect equal l1 l2 => { let list_intersect equal l1 l2 => {
let in_l2 a => List.mem equal::equal l2 a; let in_l2 a => List.mem ::equal l2 a;
List.filter f::in_l2 l1 List.filter f::in_l2 l1
}; };

4
infer/src/IR/Subtype.rei
Unescape View File

@ -11,9 +11,9 @@ open! IStd;
/** The Smallfoot Intermediate Language: Subtypes */ /** The Smallfoot Intermediate Language: Subtypes */
let module L = Logging; module L = Logging;
let module F = Format; module F = Format;
type t [@@deriving compare]; type t [@@deriving compare];

33
infer/src/IR/Tenv.re
Unescape View File

@ -8,17 +8,18 @@
*/ */
open! IStd; open! IStd;
let module Hashtbl = Caml.Hashtbl; module Hashtbl = Caml.Hashtbl;
/** Module for Type Environments. */ /** Module for Type Environments. */
/** Hash tables on strings. */ /** Hash tables on strings. */
let module TypenameHash = Hashtbl.Make { module TypenameHash =
Hashtbl.Make {
type t = Typ.Name.t; type t = Typ.Name.t;
let equal tn1 tn2 => Typ.Name.equal tn1 tn2; let equal tn1 tn2 => Typ.Name.equal tn1 tn2;
let hash = Hashtbl.hash; let hash = Hashtbl.hash;
}; };
/** Type for type environment. */ /** Type for type environment. */
@ -42,24 +43,17 @@ let create () => TypenameHash.create 1000;
/** Construct a struct type in a type environment */ /** Construct a struct type in a type environment */
let mk_struct let mk_struct
tenv tenv
default::default=? ::default=?
fields::fields=? ::fields=?
statics::statics=? ::statics=?
methods::methods=? ::methods=?
supers::supers=? ::supers=?
annots::annots=? ::annots=?
specialization::specialization=? ::specialization=?
name => { name => {
let struct_typ = let struct_typ =
Typ.Struct.internal_mk_struct Typ.Struct.internal_mk_struct
default::?default ::?default ::?fields ::?statics ::?methods ::?supers ::?annots ::?specialization ();
fields::?fields
statics::?statics
methods::?methods
supers::?supers
annots::?annots
specialization::?specialization
();
TypenameHash.replace tenv name struct_typ; TypenameHash.replace tenv name struct_typ;
struct_typ struct_typ
}; };
@ -119,7 +113,8 @@ let get_overriden_method tenv pname_java => {
/** Serializer for type environments */ /** Serializer for type environments */
let tenv_serializer: Serialization.serializer t = Serialization.create_serializer Serialization.Key.tenv; let tenv_serializer: Serialization.serializer t =
Serialization.create_serializer Serialization.Key.tenv;
let global_tenv: ref (option t) = ref None; let global_tenv: ref (option t) = ref None;

106
infer/src/IR/Typ.re
Unescape View File

@ -9,13 +9,13 @@
*/ */
open! IStd; open! IStd;
let module Hashtbl = Caml.Hashtbl; module Hashtbl = Caml.Hashtbl;
/** The Smallfoot Intermediate Language: Types */ /** The Smallfoot Intermediate Language: Types */
let module L = Logging; module L = Logging;
let module F = Format; module F = Format;
/** Kinds of integers */ /** Kinds of integers */
@ -122,7 +122,7 @@ let ptr_kind_string =
/** statically determined length of an array type, if any */ /** statically determined length of an array type, if any */
type static_length = option IntLit.t [@@deriving compare]; type static_length = option IntLit.t [@@deriving compare];
let module T = { module T = {
/** types for sil (structured) expressions */ /** types for sil (structured) expressions */
type t = type t =
@ -152,7 +152,7 @@ let module T = {
include T; include T;
let module Name = { module Name = {
type t = name [@@deriving compare]; type t = name [@@deriving compare];
let equal = [%compare.equal : t]; let equal = [%compare.equal : t];
let name = let name =
@ -199,12 +199,12 @@ let module Name = {
| (ObjcProtocol _, ObjcProtocol _) => true | (ObjcProtocol _, ObjcProtocol _) => true
| _ => false | _ => false
}; };
let module C = { module C = {
let from_qual_name qual_name => CStruct qual_name; let from_qual_name qual_name => CStruct qual_name;
let from_string name_str => QualifiedCppName.of_qual_string name_str |> from_qual_name; let from_string name_str => QualifiedCppName.of_qual_string name_str |> from_qual_name;
let union_from_qual_name qual_name => CUnion qual_name; let union_from_qual_name qual_name => CUnion qual_name;
}; };
let module Java = { module Java = {
let from_string name_str => JavaClass (Mangled.from_string name_str); let from_string name_str => JavaClass (Mangled.from_string name_str);
let from_package_class package_name class_name => let from_package_class package_name class_name =>
if (String.equal package_name "") { if (String.equal package_name "") {
@ -220,14 +220,14 @@ let module Name = {
let java_io_serializable = from_string "java.io.Serializable"; let java_io_serializable = from_string "java.io.Serializable";
let java_lang_cloneable = from_string "java.lang.Cloneable"; let java_lang_cloneable = from_string "java.lang.Cloneable";
}; };
let module Cpp = { module Cpp = {
let from_qual_name template_spec_info qual_name => CppClass qual_name template_spec_info; let from_qual_name template_spec_info qual_name => CppClass qual_name template_spec_info;
let is_class = let is_class =
fun fun
| CppClass _ => true | CppClass _ => true
| _ => false; | _ => false;
}; };
let module Objc = { module Objc = {
let from_qual_name qual_name => ObjcClass qual_name; let from_qual_name qual_name => ObjcClass qual_name;
let from_string name_str => QualifiedCppName.of_qual_string name_str |> from_qual_name; let from_string name_str => QualifiedCppName.of_qual_string name_str |> from_qual_name;
let protocol_from_qual_name qual_name => ObjcProtocol qual_name; let protocol_from_qual_name qual_name => ObjcProtocol qual_name;
@ -236,7 +236,8 @@ let module Name = {
| ObjcClass _ => true | ObjcClass _ => true
| _ => false; | _ => false;
}; };
let module Set = Caml.Set.Make { module Set =
Caml.Set.Make {
type nonrec t = t; type nonrec t = t;
let compare = compare; let compare = compare;
}; };
@ -244,11 +245,11 @@ let module Name = {
/** {2 Sets and maps of types} */ /** {2 Sets and maps of types} */
let module Set = Caml.Set.Make T; module Set = Caml.Set.Make T;
let module Map = Caml.Map.Make T; module Map = Caml.Map.Make T;
let module Tbl = Hashtbl.Make T; module Tbl = Hashtbl.Make T;
/** Pretty print a type with all the details, using the C syntax. */ /** Pretty print a type with all the details, using the C syntax. */
@ -383,7 +384,7 @@ let rec java_from_string =
type typ = t [@@deriving compare]; type typ = t [@@deriving compare];
let module Procname = { module Procname = {
/* e.g. ("", "int") for primitive types or ("java.io", "PrintWriter") for objects */ /* e.g. ("", "int") for primitive types or ("java.io", "PrintWriter") for objects */
type java_type = (option string, string); type java_type = (option string, string);
/* compare in inverse order */ /* compare in inverse order */
@ -497,7 +498,7 @@ let module Procname = {
| None => (None, package_classname) | None => (None, package_classname)
}; };
let split_typename typename => split_classname (Name.name typename); let split_typename typename => split_classname (Name.name typename);
let c name mangled template_args is_generic_model::is_generic_model => { let c name mangled template_args ::is_generic_model => {
name, name,
mangled: Some mangled, mangled: Some mangled,
template_args, template_args,
@ -519,7 +520,7 @@ let module Procname = {
}; };
/** Create an objc procedure name from a class_name and method_name. */ /** Create an objc procedure name from a class_name and method_name. */
let objc_cpp class_name method_name kind template_args is_generic_model::is_generic_model => { let objc_cpp class_name method_name kind template_args ::is_generic_model => {
class_name, class_name,
method_name, method_name,
kind, kind,
@ -625,7 +626,7 @@ let module Procname = {
| _ => false; | _ => false;
/** Prints a string of a java procname with the given level of verbosity */ /** Prints a string of a java procname with the given level of verbosity */
let java_to_string withclass::withclass=false (j: java) verbosity => let java_to_string ::withclass=false (j: java) verbosity =>
switch verbosity { switch verbosity {
| Verbose | Verbose
| Non_verbose => | Non_verbose =>
@ -872,9 +873,9 @@ let module Procname = {
}; };
/** Convenient representation of a procname for external tools (e.g. eclipse plugin) */ /** Convenient representation of a procname for external tools (e.g. eclipse plugin) */
let to_simplified_string withclass::withclass=false p => let to_simplified_string ::withclass=false p =>
switch p { switch p {
| Java j => java_to_string withclass::withclass j Simple | Java j => java_to_string ::withclass j Simple
| C {name, mangled} => to_readable_string (name, mangled) false ^ "()" | C {name, mangled} => to_readable_string (name, mangled) false ^ "()"
| ObjC_Cpp osig => c_method_to_string osig Simple | ObjC_Cpp osig => c_method_to_string osig Simple
| Block _ => "block" | Block _ => "block"
@ -886,17 +887,20 @@ let module Procname = {
/** hash function for procname */ /** hash function for procname */
let hash_pname = Hashtbl.hash; let hash_pname = Hashtbl.hash;
let module Hash = Hashtbl.Make { module Hash =
Hashtbl.Make {
type nonrec t = t; type nonrec t = t;
let equal = equal; let equal = equal;
let hash = hash_pname; let hash = hash_pname;
}; };
let module Map = PrettyPrintable.MakePPMap { module Map =
PrettyPrintable.MakePPMap {
type nonrec t = t; type nonrec t = t;
let compare = compare; let compare = compare;
let pp = pp; let pp = pp;
}; };
let module Set = PrettyPrintable.MakePPSet { module Set =
PrettyPrintable.MakePPSet {
type nonrec t = t; type nonrec t = t;
let compare = compare; let compare = compare;
let pp = pp; let pp = pp;
@ -952,13 +956,13 @@ let java_proc_return_typ pname_java =>
| typ => typ | typ => typ
}; };
let module Struct = { module Struct = {
type field = (Fieldname.t, T.t, Annot.Item.t) [@@deriving compare]; type field = (Fieldname.t, T.t, Annot.Item.t) [@@deriving compare];
type fields = list field; type fields = list field;
/** Type for a structured value. */ /** Type for a structured value. */
type t = { type t = {
fields: fields, /** non-static fields */ fields, /** non-static fields */
statics: fields, /** static fields */ statics: fields, /** static fields */
supers: list Name.t, /** superclasses */ supers: list Name.t, /** superclasses */
methods: list Procname.t, /** methods defined */ methods: list Procname.t, /** methods defined */
@ -991,30 +995,30 @@ let module Struct = {
F.fprintf f "%a" Name.pp name F.fprintf f "%a" Name.pp name
}; };
let internal_mk_struct let internal_mk_struct
default::default=? ::default=?
fields::fields=? ::fields=?
statics::statics=? ::statics=?
methods::methods=? ::methods=?
supers::supers=? ::supers=?
annots::annots=? ::annots=?
specialization::specialization=? ::specialization=?
() => { () => {
let mk_struct_ let default_ = {
default::
default={
fields: [], fields: [],
statics: [], statics: [],
methods: [], methods: [],
supers: [], supers: [],
annots: Annot.Item.empty, annots: Annot.Item.empty,
specialization: NoTemplate specialization: NoTemplate
} };
fields::fields=default.fields let mk_struct_
statics::statics=default.statics ::default=default_
methods::methods=default.methods ::fields=default.fields
supers::supers=default.supers ::statics=default.statics
annots::annots=default.annots ::methods=default.methods
specialization::specialization=default.specialization ::supers=default.supers
::annots=default.annots
::specialization=default.specialization
() => { () => {
fields, fields,
statics, statics,
@ -1023,26 +1027,18 @@ let module Struct = {
annots, annots,
specialization specialization
}; };
mk_struct_ mk_struct_ ::?default ::?fields ::?statics ::?methods ::?supers ::?annots ::?specialization ()
default::?default
fields::?fields
statics::?statics
methods::?methods
supers::?supers
annots::?annots
specialization::?specialization
()
}; };
/** the element typ of the final extensible array in the given typ, if any */ /** the element typ of the final extensible array in the given typ, if any */
let rec get_extensible_array_element_typ lookup::lookup (typ: T.t) => let rec get_extensible_array_element_typ ::lookup (typ: T.t) =>
switch typ { switch typ {
| Tarray typ _ => Some typ | Tarray typ _ => Some typ
| Tstruct name => | Tstruct name =>
switch (lookup name) { switch (lookup name) {
| Some {fields} => | Some {fields} =>
switch (List.last fields) { switch (List.last fields) {
| Some (_, fld_typ, _) => get_extensible_array_element_typ lookup::lookup fld_typ | Some (_, fld_typ, _) => get_extensible_array_element_typ ::lookup fld_typ
| None => None | None => None
} }
| None => None | None => None
@ -1051,18 +1047,18 @@ let module Struct = {
}; };
/** If a struct type with field f, return the type of f. If not, return the default */ /** If a struct type with field f, return the type of f. If not, return the default */
let fld_typ lookup::lookup default::default fn (typ: T.t) => let fld_typ ::lookup ::default fn (typ: T.t) =>
switch typ { switch typ {
| Tstruct name => | Tstruct name =>
switch (lookup name) { switch (lookup name) {
| Some {fields} => | Some {fields} =>
List.find f::(fun (f, _, _) => Fieldname.equal f fn) fields |> List.find f::(fun (f, _, _) => Fieldname.equal f fn) fields |>
Option.value_map f::snd3 default::default Option.value_map f::snd3 ::default
| None => default | None => default
} }
| _ => default | _ => default
}; };
let get_field_type_and_annotation lookup::lookup fn (typ: T.t) => let get_field_type_and_annotation ::lookup fn (typ: T.t) =>
switch typ { switch typ {
| Tstruct name | Tstruct name
| Tptr (Tstruct name) _ => | Tptr (Tstruct name) _ =>

35
infer/src/IR/Typ.rei
Unescape View File

@ -11,7 +11,7 @@ open! IStd;
/** The Smallfoot Intermediate Language: Types */ /** The Smallfoot Intermediate Language: Types */
let module F = Format; module F = Format;
/** Kinds of integers */ /** Kinds of integers */
@ -93,7 +93,7 @@ and template_spec_info =
| Template (QualifiedCppName.t, list (option t)) | Template (QualifiedCppName.t, list (option t))
[@@deriving compare]; [@@deriving compare];
let module Name: { module Name: {
/** Named types. */ /** Named types. */
type t = name [@@deriving compare]; type t = name [@@deriving compare];
@ -116,12 +116,12 @@ let module Name: {
/** qualified name of the type, may return nonsense for Java classes */ /** qualified name of the type, may return nonsense for Java classes */
let qual_name: t => QualifiedCppName.t; let qual_name: t => QualifiedCppName.t;
let module C: { module C: {
let from_string: string => t; let from_string: string => t;
let from_qual_name: QualifiedCppName.t => t; let from_qual_name: QualifiedCppName.t => t;
let union_from_qual_name: QualifiedCppName.t => t; let union_from_qual_name: QualifiedCppName.t => t;
}; };
let module Java: { module Java: {
/** Create a typename from a Java classname in the form "package.class" */ /** Create a typename from a Java classname in the form "package.class" */
let from_string: string => t; let from_string: string => t;
@ -135,7 +135,7 @@ let module Name: {
let java_io_serializable: t; let java_io_serializable: t;
let java_lang_cloneable: t; let java_lang_cloneable: t;
}; };
let module Cpp: { module Cpp: {
/** Create a typename from a C++ classname */ /** Create a typename from a C++ classname */
let from_qual_name: template_spec_info => QualifiedCppName.t => t; let from_qual_name: template_spec_info => QualifiedCppName.t => t;
@ -143,7 +143,7 @@ let module Name: {
/** [is_class name] holds if [name] names a C++ class */ /** [is_class name] holds if [name] names a C++ class */
let is_class: t => bool; let is_class: t => bool;
}; };
let module Objc: { module Objc: {
/** Create a typename from a Objc classname */ /** Create a typename from a Objc classname */
let from_string: string => t; let from_string: string => t;
@ -153,7 +153,7 @@ let module Name: {
/** [is_class name] holds if [name] names a Objc class */ /** [is_class name] holds if [name] names a Objc class */
let is_class: t => bool; let is_class: t => bool;
}; };
let module Set: Caml.Set.S with type elt = t; module Set: Caml.Set.S with type elt = t;
}; };
@ -162,13 +162,13 @@ let equal: t => t => bool;
/** Sets of types. */ /** Sets of types. */
let module Set: Caml.Set.S with type elt = t; module Set: Caml.Set.S with type elt = t;
/** Maps with type keys. */ /** Maps with type keys. */
let module Map: Caml.Map.S with type key = t; module Map: Caml.Map.S with type key = t;
let module Tbl: Caml.Hashtbl.S with type key = t; module Tbl: Caml.Hashtbl.S with type key = t;
/** Pretty print a type with all the details. */ /** Pretty print a type with all the details. */
@ -221,7 +221,7 @@ let unsome: string => option t => t;
type typ = t; type typ = t;
let module Procname: { module Procname: {
/** Module for Procedure Names. */ /** Module for Procedure Names. */
@ -260,13 +260,13 @@ let module Procname: {
| ObjCInternalMethod; | ObjCInternalMethod;
/** Hash tables with proc names as keys. */ /** Hash tables with proc names as keys. */
let module Hash: Caml.Hashtbl.S with type key = t; module Hash: Caml.Hashtbl.S with type key = t;
/** Maps from proc names. */ /** Maps from proc names. */
let module Map: PrettyPrintable.PPMap with type key = t; module Map: PrettyPrintable.PPMap with type key = t;
/** Sets of proc names. */ /** Sets of proc names. */
let module Set: PrettyPrintable.PPSet with type elt = t; module Set: PrettyPrintable.PPSet with type elt = t;
/** Create a C procedure name from plain and mangled name. */ /** Create a C procedure name from plain and mangled name. */
let c: QualifiedCppName.t => string => template_spec_info => is_generic_model::bool => c; let c: QualifiedCppName.t => string => template_spec_info => is_generic_model::bool => c;
@ -448,13 +448,14 @@ let module Procname: {
/** Return the return type of [pname_java]. */ /** Return the return type of [pname_java]. */
let java_proc_return_typ: Procname.java => t; let java_proc_return_typ: Procname.java => t;
let module Struct: { module Struct: {
type field = (Fieldname.t, typ, Annot.Item.t) [@@deriving compare]; type field = (Fieldname.t, typ, Annot.Item.t) [@@deriving compare];
type fields = list field; type fields = list field;
/** Type for a structured value. */ /** Type for a structured value. */
type t = private { type t =
fields: fields, /** non-static fields */ pri {
fields, /** non-static fields */
statics: fields, /** static fields */ statics: fields, /** static fields */
supers: list Name.t, /** supers */ supers: list Name.t, /** supers */
methods: list Procname.t, /** methods defined */ methods: list Procname.t, /** methods defined */

4
infer/src/IR/Unop.re
Unescape View File

@ -11,9 +11,9 @@ open! IStd;
/** The Smallfoot Intermediate Language: Unary Operators */ /** The Smallfoot Intermediate Language: Unary Operators */
let module L = Logging; module L = Logging;
let module F = Format; module F = Format;
/** Unary operations */ /** Unary operations */

4
infer/src/IR/Unop.rei
Unescape View File

@ -11,9 +11,9 @@ open! IStd;
/** The Smallfoot Intermediate Language: Unary Operators */ /** The Smallfoot Intermediate Language: Unary Operators */
let module L = Logging; module L = Logging;
let module F = Format; module F = Format;
/** Unary operations */ /** Unary operations */

4
infer/src/backend/InferAnalyze.re
Unescape View File

@ -11,9 +11,9 @@ open! IStd;
/** Main module for the analysis after the capture phase */ /** Main module for the analysis after the capture phase */
let module L = Logging; module L = Logging;
let module F = Format; module F = Format;
/** Create tasks to analyze an execution environment */ /** Create tasks to analyze an execution environment */

2
infer/src/backend/InferAnalyzeExe.re
Unescape View File

@ -10,7 +10,7 @@ open! IStd;
/** Main module for the analysis after the capture phase */ /** Main module for the analysis after the capture phase */
let module L = Logging; module L = Logging;
let register_perf_stats_report () => { let register_perf_stats_report () => {
let stats_dir = Filename.concat Config.results_dir Config.backend_stats_dir_name; let stats_dir = Filename.concat Config.results_dir Config.backend_stats_dir_name;

42
infer/src/backend/InferPrint.re
Unescape View File

@ -9,13 +9,13 @@
*/ */
open! IStd; open! IStd;
let module CLOpt = CommandLineOption; module CLOpt = CommandLineOption;
let module Hashtbl = Caml.Hashtbl; module Hashtbl = Caml.Hashtbl;
let module L = Logging; module L = Logging;
let module F = Format; module F = Format;
let print_usage_exit err_s => { let print_usage_exit err_s => {
L.stderr "Load Error: %s@.@." err_s; L.stderr "Load Error: %s@.@." err_s;
@ -191,7 +191,7 @@ let summary_values summary => {
} }
}; };
let module ProcsCsv = { module ProcsCsv = {
/** Print the header of the procedures csv file, with column names */ /** Print the header of the procedures csv file, with column names */
let pp_header fmt () => let pp_header fmt () =>
@ -236,7 +236,7 @@ let module ProcsCsv = {
}; };
}; };
let module ProcsXml = { module ProcsXml = {
let xml_procs_id = ref 0; let xml_procs_id = ref 0;
/** print proc in xml */ /** print proc in xml */
@ -359,7 +359,7 @@ let should_report (issue_kind: Exceptions.err_kind) issue_type error_desc eclass
} }
}; };
let module IssuesCsv = { module IssuesCsv = {
let csv_issues_id = ref 0; let csv_issues_id = ref 0;
let pp_header fmt () => let pp_header fmt () =>
Format.fprintf Format.fprintf
@ -416,7 +416,8 @@ let module IssuesCsv = {
| "" => "false" | "" => "false"
| v => v | v => v
}; };
let trace = Jsonbug_j.string_of_json_trace { let trace =
Jsonbug_j.string_of_json_trace {
trace: loc_trace_to_jsonbug_record err_data.loc_trace key.err_kind trace: loc_trace_to_jsonbug_record err_data.loc_trace key.err_kind
}; };
incr csv_issues_id; incr csv_issues_id;
@ -447,7 +448,7 @@ let module IssuesCsv = {
}; };
}; };
let module IssuesJson = { module IssuesJson = {
let is_first_item = ref true; let is_first_item = ref true;
let pp_json_open fmt () => F.fprintf fmt "[@?"; let pp_json_open fmt () => F.fprintf fmt "[@?";
let pp_json_close fmt () => F.fprintf fmt "]\n@?"; let pp_json_close fmt () => F.fprintf fmt "]\n@?";
@ -570,7 +571,7 @@ let tests_jsonbug_compare bug1 bug2 =>
(bug2.file, bug2.procedure, bug2.line - bug2.procedure_start_line, bug2.bug_type, bug2.hash) (bug2.file, bug2.procedure, bug2.line - bug2.procedure_start_line, bug2.bug_type, bug2.hash)
); );
let module IssuesTxt = { module IssuesTxt = {
/** Write bug report in text format */ /** Write bug report in text format */
let pp_issues_of_error_log fmt error_filter _ proc_loc_opt _ err_log => { let pp_issues_of_error_log fmt error_filter _ proc_loc_opt _ err_log => {
@ -611,7 +612,7 @@ let pp_text_of_report fmt report => {
List.iter f::pp_row report List.iter f::pp_row report
}; };
let module IssuesXml = { module IssuesXml = {
let xml_issues_id = ref 0; let xml_issues_id = ref 0;
let loc_trace_to_xml linereader ltr => { let loc_trace_to_xml linereader ltr => {
let subtree label contents => Io_infer.Xml.create_tree label [] [Io_infer.Xml.String contents]; let subtree label contents => Io_infer.Xml.create_tree label [] [Io_infer.Xml.String contents];
@ -706,7 +707,7 @@ let module IssuesXml = {
let pp_issues_close fmt () => Io_infer.Xml.pp_close fmt "bugs"; let pp_issues_close fmt () => Io_infer.Xml.pp_close fmt "bugs";
}; };
let module CallsCsv = { module CallsCsv = {
/** Write proc summary stats in csv format */ /** Write proc summary stats in csv format */
let pp_calls fmt summary => { let pp_calls fmt summary => {
@ -726,7 +727,7 @@ let module CallsCsv = {
}; };
}; };
let module Stats = { module Stats = {
type t = { type t = {
files: Hashtbl.t SourceFile.t unit, files: Hashtbl.t SourceFile.t unit,
mutable nchecked: int, mutable nchecked: int,
@ -869,7 +870,7 @@ let module Stats = {
}; };
}; };
let module Report = { module Report = {
let pp_header fmt () => { let pp_header fmt () => {
F.fprintf fmt "Infer Analysis Results -- generated %a@\n@\n" Pp.current_time (); F.fprintf fmt "Infer Analysis Results -- generated %a@\n@\n" Pp.current_time ();
F.fprintf fmt "Summary Report@\n@\n" F.fprintf fmt "Summary Report@\n@\n"
@ -877,7 +878,7 @@ let module Report = {
let pp_stats fmt stats => Stats.pp fmt stats; let pp_stats fmt stats => Stats.pp fmt stats;
}; };
let module Summary = { module Summary = {
let pp_summary_out summary => { let pp_summary_out summary => {
let proc_name = Specs.get_proc_name summary; let proc_name = Specs.get_proc_name summary;
if Config.quiet { if Config.quiet {
@ -946,7 +947,7 @@ let module Summary = {
/** Categorize the preconditions of specs and print stats */ /** Categorize the preconditions of specs and print stats */
let module PreconditionStats = { module PreconditionStats = {
let nr_nopres = ref 0; let nr_nopres = ref 0;
let nr_empty = ref 0; let nr_empty = ref 0;
let nr_onlyallocation = ref 0; let nr_onlyallocation = ref 0;
@ -1182,7 +1183,7 @@ let process_summary filters formats_by_report_kind linereader stats (fname, summ
Config.pp_simple := pp_simple_saved Config.pp_simple := pp_simple_saved
}; };
let module AnalysisResults = { module AnalysisResults = {
type t = list (string, Specs.summary); type t = list (string, Specs.summary);
let spec_files_from_cmdline () => let spec_files_from_cmdline () =>
if CLOpt.is_originator { if CLOpt.is_originator {
@ -1261,7 +1262,8 @@ let module AnalysisResults = {
}; };
/** Serializer for analysis results */ /** Serializer for analysis results */
let analysis_results_serializer: Serialization.serializer t = Serialization.create_serializer Serialization.Key.analysis_results; let analysis_results_serializer: Serialization.serializer t =
Serialization.create_serializer Serialization.Key.analysis_results;
/** Load analysis_results from a file */ /** Load analysis_results from a file */
let load_analysis_results_from_file (filename: DB.filename) :option t => let load_analysis_results_from_file (filename: DB.filename) :option t =>
@ -1275,7 +1277,7 @@ let module AnalysisResults = {
If options - load_results or - save_results are used, If options - load_results or - save_results are used,
all the summaries are loaded in memory */ all the summaries are loaded in memory */
let get_summary_iterator () => { let get_summary_iterator () => {
let iterator_of_summary_list r f => List.iter f::f r; let iterator_of_summary_list r f => List.iter ::f r;
switch Config.load_analysis_results { switch Config.load_analysis_results {
| None => | None =>
switch Config.save_analysis_results { switch Config.save_analysis_results {
@ -1408,7 +1410,7 @@ let print_issues formats_by_report_kind => {
} }
}; };
let main report_csv::report_csv report_json::report_json => { let main ::report_csv ::report_json => {
let formats_by_report_kind = [ let formats_by_report_kind = [
(Issues, init_issues_format_list report_csv report_json), (Issues, init_issues_format_list report_csv report_json),
(Procs, init_procs_format_list ()), (Procs, init_procs_format_list ()),

5
infer/src/backend/PropUtil.re
Unescape View File

@ -183,9 +183,8 @@ let remove_ret tenv (curr_f: Procdesc.t) (p: Prop.t Prop.normal) => {
/** remove locals and return variable from the prop */ /** remove locals and return variable from the prop */
let remove_locals_ret tenv (curr_f: Procdesc.t) p => snd ( let remove_locals_ret tenv (curr_f: Procdesc.t) p =>
remove_locals tenv curr_f (remove_ret tenv curr_f p) snd (remove_locals tenv curr_f (remove_ret tenv curr_f p));
);
/** Remove locals and formal parameters from the prop. /** Remove locals and formal parameters from the prop.

15
infer/src/backend/StatsAggregator.re
Unescape View File

@ -14,11 +14,12 @@ let aggregated_stats_filename = "aggregated_stats.json";
let aggregated_stats_by_target_filename = "aggregated_stats_by_target.json"; let aggregated_stats_by_target_filename = "aggregated_stats_by_target.json";
let json_files_to_ignore_regex = Str.regexp ( let json_files_to_ignore_regex =
Str.regexp (
".*\\(" ^ ".*\\(" ^
Str.quote aggregated_stats_filename ^ Str.quote aggregated_stats_filename ^
"\\|" ^ Str.quote aggregated_stats_by_target_filename ^ "\\)$" "\\|" ^ Str.quote aggregated_stats_by_target_filename ^ "\\)$"
); );
let dir_exists dir => Sys.is_directory dir == `Yes; let dir_exists dir => Sys.is_directory dir == `Yes;
@ -51,9 +52,8 @@ type origin =
let find_stats_files_in_dir dir => { let find_stats_files_in_dir dir => {
let frontend_paths = find_json_files_in_dir (Filename.concat dir Config.frontend_stats_dir_name); let frontend_paths = find_json_files_in_dir (Filename.concat dir Config.frontend_stats_dir_name);
let backend_paths = find_json_files_in_dir (Filename.concat dir Config.backend_stats_dir_name); let backend_paths = find_json_files_in_dir (Filename.concat dir Config.backend_stats_dir_name);
let reporting_paths = find_json_files_in_dir ( let reporting_paths =
Filename.concat dir Config.reporting_stats_dir_name find_json_files_in_dir (Filename.concat dir Config.reporting_stats_dir_name);
);
{frontend_paths, backend_paths, reporting_paths} {frontend_paths, backend_paths, reporting_paths}
}; };
@ -90,9 +90,8 @@ let collect_all_stats_files () => {
switch Config.buck_out { switch Config.buck_out {
| Some p => | Some p =>
if (dir_exists p) { if (dir_exists p) {
let data = load_data_from_infer_deps ( let data =
Filename.concat infer_out Config.buck_infer_deps_file_name load_data_from_infer_deps (Filename.concat infer_out Config.buck_infer_deps_file_name);
);
switch data { switch data {
| Ok r => | Ok r =>
let buck_out_parent = Filename.concat p Filename.parent_dir_name; let buck_out_parent = Filename.concat p Filename.parent_dir_name;

14
infer/src/base/Multilinks.re
Unescape View File

@ -10,9 +10,9 @@ open! IStd;
open! PVariant; open! PVariant;
let module F = Format; module F = Format;
let module L = Logging; module L = Logging;
let multilink_file_name = "multilink.txt"; let multilink_file_name = "multilink.txt";
@ -27,7 +27,7 @@ let multilink_files_cache = String.Table.create size::1 ();
let reset_cache () => String.Table.clear multilink_files_cache; let reset_cache () => String.Table.clear multilink_files_cache;
let read dir::dir :option t => { let read ::dir :option t => {
let multilink_fname = Filename.concat dir multilink_file_name; let multilink_fname = Filename.concat dir multilink_file_name;
switch (Utils.read_file multilink_fname) { switch (Utils.read_file multilink_fname) {
| None => None | None => None
@ -41,16 +41,16 @@ let read dir::dir :option t => {
}; };
/* Write a multilink file in the given directory */ /* Write a multilink file in the given directory */
let write multilinks dir::dir => { let write multilinks ::dir => {
let fname = Filename.concat dir multilink_file_name; let fname = Filename.concat dir multilink_file_name;
let outc = open_out fname; let outc = open_out fname;
String.Table.iteri f::(fun key::_ data::src => output_string outc (src ^ "\n")) multilinks; String.Table.iteri f::(fun key::_ data::src => output_string outc (src ^ "\n")) multilinks;
Out_channel.close outc Out_channel.close outc
}; };
let lookup dir::dir => let lookup ::dir =>
try (Some (String.Table.find_exn multilink_files_cache dir)) { try (Some (String.Table.find_exn multilink_files_cache dir)) {
| Not_found => read dir::dir | Not_found => read ::dir
}; };
let resolve fname => { let resolve fname => {
@ -60,7 +60,7 @@ let resolve fname => {
} else { } else {
let base = Filename.basename fname_s; let base = Filename.basename fname_s;
let dir = Filename.dirname fname_s; let dir = Filename.dirname fname_s;
switch (lookup dir::dir) { switch (lookup ::dir) {
| None => fname | None => fname
| Some links => | Some links =>
try (DB.filename_from_string (String.Table.find_exn links base)) { try (DB.filename_from_string (String.Table.find_exn links base)) {

4
infer/src/base/Multilinks.rei
Unescape View File

@ -8,9 +8,9 @@
*/ */
open! IStd; open! IStd;
let module F = Format; module F = Format;
let module L = Logging; module L = Logging;
/** In-memory representation of multilink files. */ /** In-memory representation of multilink files. */

7
infer/src/clang/Capture.re
Unescape View File

@ -8,7 +8,7 @@
*/ */
open! IStd; open! IStd;
let module CLOpt = CommandLineOption; module CLOpt = CommandLineOption;
/** enable debug mode (to get more data saved to disk for future inspections) */ /** enable debug mode (to get more data saved to disk for future inspections) */
@ -86,7 +86,8 @@ let run_clang_frontend ast_source => {
| `Pipe _ => | `Pipe _ =>
Format.fprintf fmt "stdin of %a" SourceFile.pp trans_unit_ctx.CFrontend_config.source_file Format.fprintf fmt "stdin of %a" SourceFile.pp trans_unit_ctx.CFrontend_config.source_file
}; };
let (decl_index, stmt_index, type_index, ivar_to_property_index) = Clang_ast_main.index_node_pointers ast_decl; let (decl_index, stmt_index, type_index, ivar_to_property_index) =
Clang_ast_main.index_node_pointers ast_decl;
CFrontend_config.pointer_decl_index := decl_index; CFrontend_config.pointer_decl_index := decl_index;
CFrontend_config.pointer_stmt_index := stmt_index; CFrontend_config.pointer_stmt_index := stmt_index;
CFrontend_config.pointer_type_index := type_index; CFrontend_config.pointer_type_index := type_index;
@ -155,7 +156,7 @@ let cc1_capture clang_cmd => {
let root = Unix.getcwd (); let root = Unix.getcwd ();
let orig_argv = ClangCommand.get_orig_argv clang_cmd; let orig_argv = ClangCommand.get_orig_argv clang_cmd;
/* the source file is always the last argument of the original -cc1 clang command */ /* the source file is always the last argument of the original -cc1 clang command */
Utils.filename_to_absolute root::root orig_argv.(Array.length orig_argv - 1) Utils.filename_to_absolute ::root orig_argv.(Array.length orig_argv - 1)
}; };
Logging.out "@\n*** Beginning capture of file %s ***@\n" source_path; Logging.out "@\n*** Beginning capture of file %s ***@\n" source_path;
if ( if (

7
infer/src/clang/ClangCommand.re
Unescape View File

@ -135,12 +135,7 @@ let clang_cc1_cmd_sanitizer cmd => {
file_arg_cmd_sanitizer {...cmd, argv: clang_arguments} file_arg_cmd_sanitizer {...cmd, argv: clang_arguments}
}; };
let mk quoting_style prog::prog args::args => { let mk quoting_style ::prog ::args => {exec: prog, orig_argv: args, argv: args, quoting_style};
exec: prog,
orig_argv: args,
argv: args,
quoting_style
};
let command_to_run cmd => { let command_to_run cmd => {
let mk_cmd normalizer => { let mk_cmd normalizer => {

12
infer/src/clang/ClangWrapper.re
Unescape View File

@ -20,8 +20,8 @@ type action_item =
/** Given a list of arguments for clang [args], return a list of new commands to run according to /** Given a list of arguments for clang [args], return a list of new commands to run according to
the results of `clang -### [args]`. */ the results of `clang -### [args]`. */
let normalize prog::prog args::args :list action_item => { let normalize ::prog ::args :list action_item => {
let cmd = ClangCommand.mk ClangQuotes.SingleQuotes prog::prog args::args; let cmd = ClangCommand.mk ClangQuotes.SingleQuotes ::prog ::args;
let clang_hashhashhash = let clang_hashhashhash =
Printf.sprintf Printf.sprintf
"%s 2>&1" "%s 2>&1"
@ -53,7 +53,7 @@ let normalize prog::prog args::args :list action_item => {
/* split by whitespace */ /* split by whitespace */
Str.split (Str.regexp_string "\" \"") Str.split (Str.regexp_string "\" \"")
) { ) {
| [prog, ...args] => ClangCommand.mk ClangQuotes.EscapedDoubleQuotes prog::prog args::args | [prog, ...args] => ClangCommand.mk ClangQuotes.EscapedDoubleQuotes ::prog ::args
| [] => failwith "ClangWrapper: argv cannot be empty" | [] => failwith "ClangWrapper: argv cannot be empty"
} }
) )
@ -96,11 +96,11 @@ let exec_action_item =
| ClangWarning warning => Logging.stderr "%s@\n" warning | ClangWarning warning => Logging.stderr "%s@\n" warning
| Command clang_cmd => Capture.capture clang_cmd; | Command clang_cmd => Capture.capture clang_cmd;
let exe prog::prog args::args => { let exe ::prog ::args => {
let xx_suffix = String.is_suffix suffix::"++" prog ? "++" : ""; let xx_suffix = String.is_suffix suffix::"++" prog ? "++" : "";
/* use clang in facebook-clang-plugins */ /* use clang in facebook-clang-plugins */
let clang_xx = CFrontend_config.clang_bin xx_suffix; let clang_xx = CFrontend_config.clang_bin xx_suffix;
let commands = normalize prog::clang_xx args::args; let commands = normalize prog::clang_xx ::args;
/* xcodebuild projects may require the object files to be generated by the Apple compiler, eg to /* xcodebuild projects may require the object files to be generated by the Apple compiler, eg to
generate precompiled headers compatible with Apple's clang. */ generate precompiled headers compatible with Apple's clang. */
let (prog, should_run_original_command) = let (prog, should_run_original_command) =
@ -126,6 +126,6 @@ let exe prog::prog args::args => {
"WARNING: `clang -### <args>` returned an empty set of commands to run and no error. Will run the original command directly:@\n %s@\n" "WARNING: `clang -### <args>` returned an empty set of commands to run and no error. Will run the original command directly:@\n %s@\n"
(String.concat sep::" " @@ [prog, ...args]) (String.concat sep::" " @@ [prog, ...args])
}; };
Process.create_process_and_wait prog::prog args::args Process.create_process_and_wait ::prog ::args
} }
}; };

2
infer/src/clang/InferClang.re
Unescape View File

@ -10,6 +10,6 @@ open! IStd;
let () = let () =
switch (Array.to_list Sys.argv) { switch (Array.to_list Sys.argv) {
| [prog, ...args] => ClangWrapper.exe prog::prog args::args | [prog, ...args] => ClangWrapper.exe ::prog ::args
| [] => assert false /* Sys.argv is never empty */ | [] => assert false /* Sys.argv is never empty */
}; };

2
opam
Unescape View File

@ -36,7 +36,7 @@ depends: [
"ocamlfind" {build} "ocamlfind" {build}
"ounit" {="2.0.0"} "ounit" {="2.0.0"}
"ppx_deriving" {>="4.1"} "ppx_deriving" {>="4.1"}
"reason" {="1.4.0"} "reason" {="1.13.3"}
"sawja" {>="1.5.2"} "sawja" {>="1.5.2"}
"xmlm" {>="1.2.0"} "xmlm" {>="1.2.0"}
] ]

6
scripts/refmt.sh
Unescape View File

@ -16,7 +16,7 @@ set -o pipefail
SCRIPT_DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )" SCRIPT_DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )"
refmt \ refmt \
-assume-explicit-arity \ --assume-explicit-arity \
-print-width 100 \ --print-width 100 \
-heuristics-file "$SCRIPT_DIR/unary.txt" \ --heuristics-file "$SCRIPT_DIR/unary.txt" \
"$@" "$@"

2
scripts/reup.sh
Unescape View File

@ -18,5 +18,5 @@ SCRIPT_DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )"
base=`basename $0` base=`basename $0`
tmpfile=`mktemp -t "${base}.XXXX"` tmpfile=`mktemp -t "${base}.XXXX"`
"$SCRIPT_DIR/refmt.sh" -parse re -print re "$@" > "$tmpfile" "$SCRIPT_DIR/refmt.sh" --parse re --print re "$@" > "$tmpfile"
mv "$tmpfile" "${@: -1}" mv "$tmpfile" "${@: -1}"

Write Preview
Loading…
Cancel
Save