[build] upgrade Reason to 1.13.3

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

@ -11,9 +11,9 @@ open! IStd;
/** 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];
@ -21,7 +21,7 @@ type parameters = list string [@@deriving compare];
/** Type to represent one @Annotation. */
type t = {
class_name: string, /** name of the annotation */
parameters: parameters /** currently only one string parameter */
parameters /** currently only one string parameter */
}
[@@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 module Map = PrettyPrintable.MakePPMap {
type nonrec t = t;
let compare = compare;
let pp = pp;
};
module Map =
PrettyPrintable.MakePPMap {
type nonrec t = t;
let compare = compare;
let pp = pp;
};
let module Item = {
module Item = {
/** Annotation for one item: a list of annotations with visibility. */
/* 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 module Class = {
module Class = {
let objc_str = "ObjC-Class";
let cpp_str = "Cpp-Class";
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 module Method = {
module Method = {
/** Annotation for a method: return value and list of parameters. */
type t = (Item.t, list Item.t) [@@deriving compare];

@ -11,7 +11,7 @@ open! IStd;
/** The Smallfoot Intermediate Language: Annotations */
let module F = Format;
module F = Format;
type parameters = list string;
@ -19,7 +19,7 @@ type parameters = list string;
/** Type to represent one @Annotation. */
type t = {
class_name: string, /** name of the annotation */
parameters: parameters /** currently only one string parameter */
parameters /** currently only one string parameter */
}
[@@deriving compare];
@ -31,9 +31,9 @@ let volatile: t;
/** Pretty print an annotation. */
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. */
type nonrec t = list (t, bool) [@@deriving compare];
@ -50,9 +50,9 @@ let module Item: {
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. */
type t = (Item.t, list Item.t) [@@deriving compare];

@ -10,11 +10,11 @@ open! IStd;
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 =
| ProcDefined
@ -24,9 +24,10 @@ type attr_kind =
/** 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 =
switch proc_kind {
| 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 */
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 attr_fname = attributes_filename proc_kind::proc_kind pname_file;
let attr_fname = attributes_filename ::proc_kind pname_file;
let bucket_dir = {
let base = pname_file;
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,
otherwise try to load the declared filename. */
let load_attr defined_only::defined_only proc_name => {
let attributes_file proc_kind::proc_kind proc_name => Multilinks.resolve (
res_dir_attr_filename create_dir::false proc_kind::proc_kind proc_name
);
let load_attr ::defined_only proc_name => {
let attributes_file ::proc_kind proc_name =>
Multilinks.resolve (res_dir_attr_filename create_dir::false ::proc_kind proc_name);
let attr =
Serialization.read_from_file serializer (attributes_file proc_kind::ProcDefined proc_name);
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. */
let write_and_delete proc_name (proc_attributes: ProcAttributes.t) => {
let proc_kind = create_proc_kind proc_attributes;
let attributes_file proc_kind =>
res_dir_attr_filename create_dir::true proc_kind::proc_kind proc_name;
let attributes_file proc_kind => res_dir_attr_filename create_dir::true ::proc_kind proc_name;
Serialization.write_to_file serializer (attributes_file proc_kind) data::proc_attributes;
let upgrade_relevance 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 load_attributes cache::cache proc_name =>
let load_attributes ::cache proc_name =>
try (Typ.Procname.Hash.find attr_tbl proc_name) {
| Not_found =>
let proc_attributes = load_attr defined_only::false proc_name;
@ -178,7 +177,7 @@ let load_attributes cache::cache proc_name =>
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) {
| Not_found =>
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.
Return also a boolean indicating whether the procedure is defined in an
include file. */
let find_file_capturing_procedure cache::cache=true pname =>
switch (load_attributes cache::cache pname) {
let find_file_capturing_procedure ::cache=true pname =>
switch (load_attributes ::cache pname) {
| None => None
| Some proc_attributes =>
let source_file = proc_attributes.ProcAttributes.source_file_captured;

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

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

@ -11,9 +11,9 @@ open! IStd;
/** 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 */

@ -11,9 +11,9 @@ open! IStd;
/** 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 */

@ -9,9 +9,9 @@
*/
open! IStd;
let module L = Logging;
module L = Logging;
let module F = Format;
module F = Format;
/** 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 */
let iter_all_nodes sorted::sorted=false f cfg => {
let iter_all_nodes ::sorted=false f cfg => {
let do_proc_desc _ (pdesc: Procdesc.t) =>
List.iter f::(fun node => f pdesc node) (Procdesc.get_nodes pdesc);
if (not sorted) {
@ -120,7 +120,8 @@ let check_cfg_connectedness cfg => {
/** 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 */
@ -324,7 +325,7 @@ let mark_unchanged_pdescs cfg_new cfg_old => {
/** 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;
if Config.incremental_procs {
switch (load_cfg_from_file filename) {

@ -9,13 +9,13 @@
*/
open! IStd;
let module Hashtbl = Caml.Hashtbl;
module Hashtbl = Caml.Hashtbl;
/** Module for call graphs */
let module L = Logging;
module L = Logging;
let module F = Format;
module F = Format;
type node = Typ.Procname.t;
@ -55,7 +55,7 @@ let create source_opt => {
{source, node_map: Typ.Procname.Hash.create 3}
};
let add_node g n defined::defined =>
let add_node g n ::defined =>
try {
let info = Typ.Procname.Hash.find g.node_map n;
/* defined and disabled only go from false to true
@ -190,7 +190,7 @@ let node_map_iter f g => {
let table = ref [];
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;
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) => {
@ -345,13 +345,14 @@ let get_source (g: t) => g.source;
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;
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
};
/** 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 */

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

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

@ -11,9 +11,9 @@ open! IStd;
/** 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 */

@ -11,9 +11,9 @@ open! IStd;
/** 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 */

@ -9,13 +9,13 @@
*/
open! IStd;
let module Hashtbl = Caml.Hashtbl;
module Hashtbl = Caml.Hashtbl;
/** 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 */
type _ident = Ident.t;
@ -58,21 +58,24 @@ let equal = [%compare.equal : t];
let hash = Hashtbl.hash;
let module Set = Caml.Set.Make {
type nonrec t = t;
let compare = compare;
};
module Set =
Caml.Set.Make {
type nonrec t = t;
let compare = compare;
};
let module Map = Caml.Map.Make {
type nonrec t = t;
let compare = compare;
};
module Map =
Caml.Map.Make {
type nonrec t = t;
let compare = compare;
};
let module Hash = Hashtbl.Make {
type nonrec t = t;
let equal = equal;
let hash = hash;
};
module Hash =
Hashtbl.Make {
type nonrec t = t;
let equal = equal;
let hash = hash;
};
let rec is_array_index_of exp1 exp2 =>
switch exp1 {

@ -11,9 +11,9 @@ open! IStd;
/** 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]
/** dynamically determined length of an array value, if any */
@ -58,15 +58,15 @@ let hash: t => int;
/** 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. */
let module Map: Caml.Map.S with type key = t;
module Map: Caml.Map.S with type key = t;
/** 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. */

@ -8,7 +8,7 @@
*/
open! IStd;
let module Hashtbl = Caml.Hashtbl;
module Hashtbl = Caml.Hashtbl;
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 module Set = Caml.Set.Make {
type nonrec t = t;
let compare = compare;
};
module Set =
Caml.Set.Make {
type nonrec t = t;
let compare = compare;
};
let module Map = Caml.Map.Make {
type nonrec t = t;
let compare = compare;
};
module Map =
Caml.Map.Make {
type nonrec t = t;
let compare = compare;
};
let module Clang = {
module Clang = {
let from_qualified qual_class field_name => Clang {qual_class, field_name};
};
let module Java = {
module Java = {
let from_string n => Java n;
};

@ -18,19 +18,19 @@ let equal: t => t => bool;
/** 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 */
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 */
let from_qualified: QualifiedCppName.t => string => t;
};
let module Java: {
module Java: {
/** Create a java field name from string */
let from_string: string => t;

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

@ -37,17 +37,17 @@ let equal_kind: kind => kind => bool;
/** 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. */
let module IdentHash: Caml.Hashtbl.S with type key = t;
module IdentHash: Caml.Hashtbl.S with type key = t;
/** 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;
/** Get the current name generator. */
@ -72,7 +72,7 @@ let kfootprint: kind;
/** 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 */

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

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

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

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

@ -45,8 +45,8 @@ let pp: Format.formatter => t => unit;
/** 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 */
let module Map: Caml.Map.S with type key = t;
module Map: Caml.Map.S with type key = t;

@ -11,9 +11,9 @@ open! IStd;
/** The Smallfoot Intermediate Language: Predicate Symbols */
let module L = Logging;
module L = Logging;
let module F = Format;
module F = Format;
type func_attribute =
| FA_sentinel int int /** __attribute__((sentinel(int, int))) */
@ -96,7 +96,7 @@ type taint_kind =
| Tk_unknown
[@@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 */

@ -11,9 +11,9 @@ open! IStd;
/** The Smallfoot Intermediate Language: Predicate Symbols */
let module L = Logging;
module L = Logging;
let module F = Format;
module F = Format;
/** {2 Programs and Types} */
@ -84,7 +84,7 @@ type taint_kind =
| Tk_integrity_annotation
| 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 */

@ -8,13 +8,13 @@
*/
open! IStd;
let module Hashtbl = Caml.Hashtbl;
module Hashtbl = Caml.Hashtbl;
/** Attributes of a procedure. */
let module L = Logging;
module L = Logging;
let module F = Format;
module F = Format;
/** flags for a procedure */
@ -66,7 +66,7 @@ type t = {
mutable locals: list (Mangled.t, Typ.t), /** name and type of local variables */
method_annotation: Annot.Method.t, /** 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_flags, /** flags of the procedure */
proc_name: Typ.Procname.t, /** name of the procedure */
ret_type: Typ.t, /** return type */
source_file_captured: SourceFile.t /** source file where the procedure was captured */

@ -61,7 +61,7 @@ type t = {
mutable locals: list (Mangled.t, Typ.t), /** name and type of local variables */
method_annotation: Annot.Method.t, /** 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_flags, /** flags of the procedure */
proc_name: Typ.Procname.t, /** name of the procedure */
ret_type: Typ.t, /** return type */
source_file_captured: SourceFile.t /** source file where the procedure was captured */

@ -9,14 +9,14 @@
*/
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 =============== */
let module Node = {
module Node = {
type id = int [@@deriving compare];
let equal_id = [%compare.equal : id];
type nodekind =
@ -32,7 +32,7 @@ let module Node = {
/** a node */
type t = {
/** unique id of the node */
id: id,
id,
/** distance to the exit node */
mutable dist_exit: option int,
/** exception nodes in the cfg */
@ -72,14 +72,16 @@ let module Node = {
let get_id node => node.id;
let get_succs node => node.succs;
type node = t;
let module NodeSet = Caml.Set.Make {
type t = node;
let compare = compare;
};
let module IdMap = Caml.Map.Make {
type t = id;
let compare = compare_id;
};
module NodeSet =
Caml.Set.Make {
type t = node;
let compare = compare;
};
module IdMap =
Caml.Map.Make {
type t = id;
let compare = compare_id;
};
let get_sliced_succs node f => {
let visited = ref NodeSet.empty;
let rec slice_nodes nodes :NodeSet.t => {
@ -199,7 +201,7 @@ let module Node = {
/** Print extended instructions for the node,
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 =
switch instro {
| None => pe0
@ -249,10 +251,8 @@ let module 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 (
L.PTnode_instrs,
Obj.repr (sub_instrs, curr_instr, node)
);
let d_instrs sub_instrs::(sub_instrs: bool) (curr_instr: option Sil.instr) (node: t) =>
L.add_print_action (L.PTnode_instrs, Obj.repr (sub_instrs, curr_instr, node));
/** Return a description of the cfg node */
let get_description pe node => {
@ -273,19 +273,19 @@ let module Node = {
/* =============== END of module Node =============== */
/** Map over nodes */
let module NodeMap = Caml.Map.Make Node;
module NodeMap = Caml.Map.Make Node;
/** Hash table with nodes as keys. */
let module NodeHash = Hashtbl.Make Node;
module NodeHash = Hashtbl.Make Node;
/** Set of nodes. */
let module NodeSet = Node.NodeSet;
module NodeSet = Node.NodeSet;
/** Map with node id keys. */
let module IdMap = Node.IdMap;
module IdMap = Node.IdMap;
/** procedure description */
@ -301,7 +301,7 @@ type t = {
/** 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) {
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 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 do_node a node =>
@ -415,7 +415,7 @@ let iter_instrs f 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_node acc node =>

@ -11,13 +11,13 @@ open! IStd;
/** node of the control flow graph */
let module Node: {
module Node: {
/** type of nodes */
type t [@@deriving compare];
/** node id */
type id = private int [@@deriving compare];
type id = pri int [@@deriving compare];
let equal_id: id => id => bool;
/** kind of cfg node */
@ -120,19 +120,19 @@ let module Node: {
/** 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. */
let module NodeHash: Caml.Hashtbl.S with type key = Node.t;
module NodeHash: Caml.Hashtbl.S with type key = Node.t;
/** 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. */
let module NodeSet: Caml.Set.S with type elt = Node.t;
module NodeSet: Caml.Set.S with type elt = Node.t;
/** procedure descriptions */

@ -11,9 +11,9 @@ open! IStd;
/** The Smallfoot Intermediate Language */
let module L = Logging;
module L = Logging;
let module F = Format;
module F = Format;
/** 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 */
let mk_global
is_constexpr::is_constexpr=false
is_pod::is_pod=true
is_static_local::is_static_local=false
(name: Mangled.t)
fname
:t => {
let mk_global ::is_constexpr=false ::is_pod=true ::is_static_local=false (name: Mangled.t) fname :t => {
pv_hash: name_hash name,
pv_name: name,
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
};
let module Set = PrettyPrintable.MakePPCompareSet {
type nonrec t = t;
let compare = compare;
let compare_pp = compare_alpha;
let pp = pp Pp.text;
};
module Set =
PrettyPrintable.MakePPCompareSet {
type nonrec t = t;
let compare = compare;
let compare_pp = compare_alpha;
let pp = pp Pp.text;
};

@ -11,7 +11,7 @@ open! IStd;
/** Program variables. */
let module F = Format;
module F = Format;
/** 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 */
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;

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

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

@ -9,13 +9,13 @@
*/
open! IStd;
let module Hashtbl = Caml.Hashtbl;
module Hashtbl = Caml.Hashtbl;
/** The Smallfoot Intermediate Language */
let module L = Logging;
module L = Logging;
let module F = Format;
module F = Format;
/** {2 Programs and Types} */
@ -149,10 +149,10 @@ type 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;
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 */
@ -199,11 +199,10 @@ type hpred = hpred0 inst;
/** 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;
let equal_hpred inst::inst=false hpred1 hpred2 =>
Int.equal (compare_hpred inst::inst hpred1 hpred2) 0;
let equal_hpred ::inst=false hpred1 hpred2 => Int.equal (compare_hpred ::inst hpred1 hpred2) 0;
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} */
let module HpredSet = Caml.Set.Make {
type t = hpred;
let compare = compare_hpred inst::false;
};
module HpredSet =
Caml.Set.Make {
type t = hpred;
let compare = compare_hpred inst::false;
};
/** {2 Pretty Printing} */
@ -582,7 +582,7 @@ let rec pp_star_seq pp f =>
/** Module Predicates records the occurrences of predicates as parameters
of (doubly -)linked lists and Epara. Provides unique numbering
for predicates and an iterator. */
let module Predicates: {
module Predicates: {
/** predicate environment */
type env;
@ -608,18 +608,20 @@ let module Predicates: {
} = {
/** hash tables for hpara */
let module HparaHash = Hashtbl.Make {
type t = hpara;
let equal = equal_hpara;
let hash = Hashtbl.hash;
};
module HparaHash =
Hashtbl.Make {
type t = hpara;
let equal = equal_hpara;
let hash = Hashtbl.hash;
};
/** hash tables for hpara_dll */
let module HparaDllHash = Hashtbl.Make {
type t = hpara_dll;
let equal = equal_hpara_dll;
let hash = Hashtbl.hash;
};
module HparaDllHash =
Hashtbl.Make {
type t = hpara_dll;
let equal = equal_hpara_dll;
let hash = Hashtbl.hash;
};
/** Map each visited hpara to a unique number and a boolean denoting whether it has been emitted,
also keep a list of hparas still to be emitted. Same for hpara_dll. */
@ -1211,8 +1213,8 @@ let atom_expmap (f: Exp.t => Exp.t) =>
fun
| Aeq e1 e2 => Aeq (f e1) (f e2)
| Aneq e1 e2 => Aneq (f e1) (f e2)
| Apred a es => Apred a (List.map f::f es)
| Anpred a es => Anpred a (List.map f::f es);
| Apred a es => Apred a (List.map ::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;
@ -1263,12 +1265,12 @@ let rec strexp_fpv =
| Eexp e _ => exp_fpv e
| Estruct fld_se_list _ => {
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 _ => {
let fpv_in_len = exp_fpv len;
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 =
@ -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 */
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 =>
switch (exp_sub_ids f (Var 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
| Estruct fsel inst => {
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 => {
let len' = exp_replace_exp epairs len;
@ -2255,7 +2257,7 @@ let rec strexp_replace_exp epairs =>
let idx' = exp_replace_exp epairs idx;
(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 =>
@ -2283,11 +2285,12 @@ let hpred_replace_exp epairs =>
/** {2 Compaction} */
let module HpredInstHash = Hashtbl.Make {
type t = hpred;
let equal = equal_hpred inst::true;
let hash = Hashtbl.hash;
};
module HpredInstHash =
Hashtbl.Make {
type t = hpred;
let equal = equal_hpred inst::true;
let hash = Hashtbl.hash;
};
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.fold f::f init::[([], [])] sigma
List.fold ::f init::[([], [])] sigma
} else {
[([], sigma)]
};
@ -2415,9 +2418,8 @@ let hpara_instantiate para e1 e2 elist => {
| Invalid_argument _ => assert false
}
};
let subst = sub_of_list (
[(para.root, e1), (para.next, e2), ...subst_for_svars] @ subst_for_evars
);
let subst =
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)
};
@ -2444,9 +2446,10 @@ let hpara_dll_instantiate (para: hpara_dll) cell blink flink elist => {
| Invalid_argument _ => assert false
}
};
let subst = sub_of_list (
[(para.cell, cell), (para.blink, blink), (para.flink, flink), ...subst_for_svars] @ subst_for_evars
);
let subst =
sub_of_list (
[(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)
};

@ -11,7 +11,7 @@ open! IStd;
/** The Smallfoot Intermediate Language */
let module F = Format;
module F = Format;
/** {2 Programs and Types} */
@ -269,7 +269,7 @@ let equal_hpred: inst::bool? => hpred => hpred => bool;
/** 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} */
@ -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
of (doubly -)linked lists and Epara.
Provides unique numbering for predicates and an iterator. */
let module Predicates: {
module Predicates: {
/** predicate environment */
type env;

@ -11,9 +11,9 @@ open! IStd;
/** The Smallfoot Intermediate Language: Subtypes */
let module L = Logging;
module L = Logging;
let module F = Format;
module F = Format;
let list_to_string list =>
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 {
/* pair of subtypes */
type t = (Typ.Name.t, Typ.Name.t) [@@deriving compare];
};
module SubtypesMap =
Caml.Map.Make {
/* pair of subtypes */
type t = (Typ.Name.t, Typ.Name.t) [@@deriving compare];
};
let check_subtype = {
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 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
};

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

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

@ -9,13 +9,13 @@
*/
open! IStd;
let module Hashtbl = Caml.Hashtbl;
module Hashtbl = Caml.Hashtbl;
/** The Smallfoot Intermediate Language: Types */
let module L = Logging;
module L = Logging;
let module F = Format;
module F = Format;
/** Kinds of integers */
@ -122,7 +122,7 @@ let ptr_kind_string =
/** statically determined length of an array type, if any */
type static_length = option IntLit.t [@@deriving compare];
let module T = {
module T = {
/** types for sil (structured) expressions */
type t =
@ -152,7 +152,7 @@ let module T = {
include T;
let module Name = {
module Name = {
type t = name [@@deriving compare];
let equal = [%compare.equal : t];
let name =
@ -199,12 +199,12 @@ let module Name = {
| (ObjcProtocol _, ObjcProtocol _) => true
| _ => false
};
let module C = {
module C = {
let from_qual_name qual_name => CStruct 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 module Java = {
module Java = {
let from_string name_str => JavaClass (Mangled.from_string name_str);
let from_package_class package_name class_name =>
if (String.equal package_name "") {
@ -220,14 +220,14 @@ let module Name = {
let java_io_serializable = from_string "java.io.Serializable";
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 is_class =
fun
| CppClass _ => true
| _ => false;
};
let module Objc = {
module Objc = {
let from_qual_name qual_name => ObjcClass 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;
@ -236,19 +236,20 @@ let module Name = {
| ObjcClass _ => true
| _ => false;
};
let module Set = Caml.Set.Make {
type nonrec t = t;
let compare = compare;
};
module Set =
Caml.Set.Make {
type nonrec t = t;
let compare = compare;
};
};
/** {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. */
@ -383,7 +384,7 @@ let rec java_from_string =
type typ = t [@@deriving compare];
let module Procname = {
module Procname = {
/* e.g. ("", "int") for primitive types or ("java.io", "PrintWriter") for objects */
type java_type = (option string, string);
/* compare in inverse order */
@ -497,7 +498,7 @@ let module Procname = {
| None => (None, package_classname)
};
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,
mangled: Some mangled,
template_args,
@ -519,7 +520,7 @@ let module Procname = {
};
/** 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,
method_name,
kind,
@ -625,7 +626,7 @@ let module Procname = {
| _ => false;
/** 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 {
| Verbose
| Non_verbose =>
@ -872,9 +873,9 @@ let module Procname = {
};
/** 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 {
| 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 ^ "()"
| ObjC_Cpp osig => c_method_to_string osig Simple
| Block _ => "block"
@ -886,21 +887,24 @@ let module Procname = {
/** hash function for procname */
let hash_pname = Hashtbl.hash;
let module Hash = Hashtbl.Make {
type nonrec t = t;
let equal = equal;
let hash = hash_pname;
};
let module Map = PrettyPrintable.MakePPMap {
type nonrec t = t;
let compare = compare;
let pp = pp;
};
let module Set = PrettyPrintable.MakePPSet {
type nonrec t = t;
let compare = compare;
let pp = pp;
};
module Hash =
Hashtbl.Make {
type nonrec t = t;
let equal = equal;
let hash = hash_pname;
};
module Map =
PrettyPrintable.MakePPMap {
type nonrec t = t;
let compare = compare;
let pp = pp;
};
module Set =
PrettyPrintable.MakePPSet {
type nonrec t = t;
let compare = compare;
let pp = pp;
};
/** Pretty print a set of proc names */
let pp_set fmt set => Set.iter (fun pname => F.fprintf fmt "%a " pp pname) set;
@ -952,13 +956,13 @@ let java_proc_return_typ pname_java =>
| typ => typ
};
let module Struct = {
module Struct = {
type field = (Fieldname.t, T.t, Annot.Item.t) [@@deriving compare];
type fields = list field;
/** Type for a structured value. */
type t = {
fields: fields, /** non-static fields */
fields, /** non-static fields */
statics: fields, /** static fields */
supers: list Name.t, /** superclasses */
methods: list Procname.t, /** methods defined */
@ -991,30 +995,30 @@ let module Struct = {
F.fprintf f "%a" Name.pp name
};
let internal_mk_struct
default::default=?
fields::fields=?
statics::statics=?
methods::methods=?
supers::supers=?
annots::annots=?
specialization::specialization=?
::default=?
::fields=?
::statics=?
::methods=?
::supers=?
::annots=?
::specialization=?
() => {
let default_ = {
fields: [],
statics: [],
methods: [],
supers: [],
annots: Annot.Item.empty,
specialization: NoTemplate
};
let mk_struct_
default::
default={
fields: [],
statics: [],
methods: [],
supers: [],
annots: Annot.Item.empty,
specialization: NoTemplate
}
fields::fields=default.fields
statics::statics=default.statics
methods::methods=default.methods
supers::supers=default.supers
annots::annots=default.annots
specialization::specialization=default.specialization
::default=default_
::fields=default.fields
::statics=default.statics
::methods=default.methods
::supers=default.supers
::annots=default.annots
::specialization=default.specialization
() => {
fields,
statics,
@ -1023,26 +1027,18 @@ let module Struct = {
annots,
specialization
};
mk_struct_
default::?default
fields::?fields
statics::?statics
methods::?methods
supers::?supers
annots::?annots
specialization::?specialization
()
mk_struct_ ::?default ::?fields ::?statics ::?methods ::?supers ::?annots ::?specialization ()
};
/** 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 {
| Tarray typ _ => Some typ
| Tstruct name =>
switch (lookup name) {
| Some {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
@ -1051,18 +1047,18 @@ let module Struct = {
};
/** 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 {
| Tstruct name =>
switch (lookup name) {
| Some {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
}
| _ => 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 {
| Tstruct name
| Tptr (Tstruct name) _ =>

@ -11,7 +11,7 @@ open! IStd;
/** The Smallfoot Intermediate Language: Types */
let module F = Format;
module F = Format;
/** Kinds of integers */
@ -93,7 +93,7 @@ and template_spec_info =
| Template (QualifiedCppName.t, list (option t))
[@@deriving compare];
let module Name: {
module Name: {
/** Named types. */
type t = name [@@deriving compare];
@ -116,12 +116,12 @@ let module Name: {
/** qualified name of the type, may return nonsense for Java classes */
let qual_name: t => QualifiedCppName.t;
let module C: {
module C: {
let from_string: string => t;
let 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" */
let from_string: string => t;
@ -135,7 +135,7 @@ let module Name: {
let java_io_serializable: t;
let java_lang_cloneable: t;
};
let module Cpp: {
module Cpp: {
/** Create a typename from a C++ classname */
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 */
let is_class: t => bool;
};
let module Objc: {
module Objc: {
/** Create a typename from a Objc classname */
let from_string: string => t;
@ -153,7 +153,7 @@ let module Name: {
/** [is_class name] holds if [name] names a Objc class */
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. */
let module Set: Caml.Set.S with type elt = t;
module Set: Caml.Set.S with type elt = t;
/** 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. */
@ -221,7 +221,7 @@ let unsome: string => option t => t;
type typ = t;
let module Procname: {
module Procname: {
/** Module for Procedure Names. */
@ -260,13 +260,13 @@ let module Procname: {
| ObjCInternalMethod;
/** 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. */
let module Map: PrettyPrintable.PPMap with type key = t;
module Map: PrettyPrintable.PPMap with type key = t;
/** 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. */
let c: QualifiedCppName.t => string => template_spec_info => is_generic_model::bool => c;
@ -448,19 +448,20 @@ let module Procname: {
/** Return the return type of [pname_java]. */
let java_proc_return_typ: Procname.java => t;
let module Struct: {
module Struct: {
type field = (Fieldname.t, typ, Annot.Item.t) [@@deriving compare];
type fields = list field;
/** Type for a structured value. */
type t = private {
fields: fields, /** non-static fields */
statics: fields, /** static fields */
supers: list Name.t, /** supers */
methods: list Procname.t, /** methods defined */
annots: Annot.Item.t, /** annotations */
specialization: template_spec_info /** template specialization */
};
type t =
pri {
fields, /** non-static fields */
statics: fields, /** static fields */
supers: list Name.t, /** supers */
methods: list Procname.t, /** methods defined */
annots: Annot.Item.t, /** annotations */
specialization: template_spec_info /** template specialization */
};
type lookup = Name.t => option t;
/** Pretty print a struct type. */

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

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

@ -11,9 +11,9 @@ open! IStd;
/** 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 */

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

@ -9,13 +9,13 @@
*/
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 => {
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 */
let pp_header fmt () =>
@ -236,7 +236,7 @@ let module ProcsCsv = {
};
};
let module ProcsXml = {
module ProcsXml = {
let xml_procs_id = ref 0;
/** 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 pp_header fmt () =>
Format.fprintf
@ -416,9 +416,10 @@ let module IssuesCsv = {
| "" => "false"
| v => v
};
let trace = Jsonbug_j.string_of_json_trace {
trace: loc_trace_to_jsonbug_record err_data.loc_trace key.err_kind
};
let trace =
Jsonbug_j.string_of_json_trace {
trace: loc_trace_to_jsonbug_record err_data.loc_trace key.err_kind
};
incr csv_issues_id;
pp "%s," (Exceptions.err_class_string err_data.err_class);
pp "%s," kind;
@ -447,7 +448,7 @@ let module IssuesCsv = {
};
};
let module IssuesJson = {
module IssuesJson = {
let is_first_item = ref true;
let pp_json_open fmt () => F.fprintf fmt "[@?";
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)
);
let module IssuesTxt = {
module IssuesTxt = {
/** Write bug report in text format */
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
};
let module IssuesXml = {
module IssuesXml = {
let xml_issues_id = ref 0;
let loc_trace_to_xml linereader ltr => {
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 module CallsCsv = {
module CallsCsv = {
/** Write proc summary stats in csv format */
let pp_calls fmt summary => {
@ -726,7 +727,7 @@ let module CallsCsv = {
};
};
let module Stats = {
module Stats = {
type t = {
files: Hashtbl.t SourceFile.t unit,
mutable nchecked: int,
@ -869,7 +870,7 @@ let module Stats = {
};
};
let module Report = {
module Report = {
let pp_header fmt () => {
F.fprintf fmt "Infer Analysis Results -- generated %a@\n@\n" Pp.current_time ();
F.fprintf fmt "Summary Report@\n@\n"
@ -877,7 +878,7 @@ let module Report = {
let pp_stats fmt stats => Stats.pp fmt stats;
};
let module Summary = {
module Summary = {
let pp_summary_out summary => {
let proc_name = Specs.get_proc_name summary;
if Config.quiet {
@ -946,7 +947,7 @@ let module Summary = {
/** Categorize the preconditions of specs and print stats */
let module PreconditionStats = {
module PreconditionStats = {
let nr_nopres = ref 0;
let nr_empty = 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
};
let module AnalysisResults = {
module AnalysisResults = {
type t = list (string, Specs.summary);
let spec_files_from_cmdline () =>
if CLOpt.is_originator {
@ -1261,7 +1262,8 @@ let module AnalysisResults = {
};
/** 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 */
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,
all the summaries are loaded in memory */
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 {
| None =>
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 = [
(Issues, init_issues_format_list report_csv report_json),
(Procs, init_procs_format_list ()),

@ -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 */
let remove_locals_ret tenv (curr_f: Procdesc.t) p => snd (
remove_locals tenv curr_f (remove_ret tenv curr_f p)
);
let remove_locals_ret tenv (curr_f: Procdesc.t) p =>
snd (remove_locals tenv curr_f (remove_ret tenv curr_f p));
/** Remove locals and formal parameters from the prop.

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

@ -10,9 +10,9 @@ open! IStd;
open! PVariant;
let module F = Format;
module F = Format;
let module L = Logging;
module L = Logging;
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 read dir::dir :option t => {
let read ::dir :option t => {
let multilink_fname = Filename.concat dir multilink_file_name;
switch (Utils.read_file multilink_fname) {
| None => None
@ -41,16 +41,16 @@ let read dir::dir :option t => {
};
/* 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 outc = open_out fname;
String.Table.iteri f::(fun key::_ data::src => output_string outc (src ^ "\n")) multilinks;
Out_channel.close outc
};
let lookup dir::dir =>
let lookup ::dir =>
try (Some (String.Table.find_exn multilink_files_cache dir)) {
| Not_found => read dir::dir
| Not_found => read ::dir
};
let resolve fname => {
@ -60,7 +60,7 @@ let resolve fname => {
} else {
let base = Filename.basename fname_s;
let dir = Filename.dirname fname_s;
switch (lookup dir::dir) {
switch (lookup ::dir) {
| None => fname
| Some links =>
try (DB.filename_from_string (String.Table.find_exn links base)) {

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

@ -8,7 +8,7 @@
*/
open! IStd;
let module CLOpt = CommandLineOption;
module CLOpt = CommandLineOption;
/** enable debug mode (to get more data saved to disk for future inspections) */
@ -86,7 +86,8 @@ let run_clang_frontend ast_source => {
| `Pipe _ =>
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_stmt_index := stmt_index;
CFrontend_config.pointer_type_index := type_index;
@ -155,7 +156,7 @@ let cc1_capture clang_cmd => {
let root = Unix.getcwd ();
let orig_argv = ClangCommand.get_orig_argv clang_cmd;
/* 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;
if (

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

@ -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
the results of `clang -### [args]`. */
let normalize prog::prog args::args :list action_item => {
let cmd = ClangCommand.mk ClangQuotes.SingleQuotes prog::prog args::args;
let normalize ::prog ::args :list action_item => {
let cmd = ClangCommand.mk ClangQuotes.SingleQuotes ::prog ::args;
let clang_hashhashhash =
Printf.sprintf
"%s 2>&1"
@ -53,7 +53,7 @@ let normalize prog::prog args::args :list action_item => {
/* split by whitespace */
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"
}
)
@ -96,11 +96,11 @@ let exec_action_item =
| ClangWarning warning => Logging.stderr "%s@\n" warning
| 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 ? "++" : "";
/* use clang in facebook-clang-plugins */
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
generate precompiled headers compatible with Apple's clang. */
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"
(String.concat sep::" " @@ [prog, ...args])
};
Process.create_process_and_wait prog::prog args::args
Process.create_process_and_wait ::prog ::args
}
};

@ -10,6 +10,6 @@ open! IStd;
let () =
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 */
};

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

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

@ -18,5 +18,5 @@ SCRIPT_DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )"
base=`basename $0`
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}"

Loading…
Cancel
Save