From e397afa085b6aad24af43f434d105128603b5fd9 Mon Sep 17 00:00:00 2001 From: Josh Berdine Date: Tue, 29 Nov 2016 16:41:25 -0800 Subject: [PATCH] ppx_compare CContext Reviewed By: cristianoc Differential Revision: D4232410 fbshipit-source-id: 449f7a8 --- infer/src/clang/cContext.ml | 39 +++++++++++++----------------------- infer/src/clang/cContext.mli | 9 ++++----- 2 files changed, 18 insertions(+), 30 deletions(-) diff --git a/infer/src/clang/cContext.ml b/infer/src/clang/cContext.ml index a9f33d01f..e12ce6d14 100644 --- a/infer/src/clang/cContext.ml +++ b/infer/src/clang/cContext.ml @@ -14,13 +14,25 @@ open! Utils module L = Logging +type pointer (* = Clang_ast_t.pointer *) = int [@@deriving compare] + +type _super = string option +let compare__super _ _ = 0 + +type _protos = string list +let compare__protos _ _ = 0 + type curr_class = - | ContextCls of string * string option * string list + | ContextCls of string * _super * _protos (*class name and name of (optional) super class , and a list of protocols *) | ContextCategory of string * string (* category name and corresponding class *) | ContextProtocol of string (* category name and corresponding class *) - | ContextClsDeclPtr of Clang_ast_t.pointer + | ContextClsDeclPtr of pointer | ContextNoCls +[@@deriving compare] + +let equal_curr_class curr_class1 curr_class2 = + compare_curr_class curr_class1 curr_class2 == 0 type str_node_map = (string, Procdesc.Node.t) Hashtbl.t @@ -97,29 +109,6 @@ let curr_class_to_string curr_class = | ContextClsDeclPtr ptr -> ("decl_ptr: " ^ string_of_int ptr) | ContextNoCls -> "no class" -let curr_class_compare curr_class1 curr_class2 = - match curr_class1, curr_class2 with - | ContextCls (name1, _, _), ContextCls (name2, _, _) -> - String.compare name1 name2 - | ContextCls (_, _, _), _ -> -1 - | _, ContextCls (_, _, _) -> 1 - | ContextCategory (name1, cls1), ContextCategory (name2, cls2) -> - pair_compare String.compare String.compare (name1, cls1) (name2, cls2) - | ContextCategory (_, _), _ -> -1 - | _, ContextCategory (_, _) -> 1 - | ContextProtocol name1, ContextProtocol name2 -> - String.compare name1 name2 - | ContextProtocol _, _ -> -1 - | _, ContextProtocol _ -> 1 - | ContextClsDeclPtr ptr1, ContextClsDeclPtr ptr2 -> - ptr1 - ptr2 - | ContextClsDeclPtr _, _ -> -1 - | _, ContextClsDeclPtr _ -> 1 - | ContextNoCls, ContextNoCls -> 0 - -let curr_class_equal curr_class1 curr_class2 = - curr_class_compare curr_class1 curr_class2 == 0 - let create_curr_class tenv class_name ck = let class_tn_name = Typename.TN_csu (Csu.Class ck, (Mangled.from_string class_name)) in match Tenv.lookup tenv class_tn_name with diff --git a/infer/src/clang/cContext.mli b/infer/src/clang/cContext.mli index 61b65f5fb..16c2ee4d3 100644 --- a/infer/src/clang/cContext.mli +++ b/infer/src/clang/cContext.mli @@ -17,8 +17,11 @@ type curr_class = (*class name and name of (optional) super class , and a list of protocols *) | ContextCategory of string * string (* category name and corresponding class *) | ContextProtocol of string (* category name and corresponding class *) - | ContextClsDeclPtr of Clang_ast_t.pointer + | ContextClsDeclPtr of int | ContextNoCls +[@@deriving compare] + +val equal_curr_class : curr_class -> curr_class -> bool type str_node_map = (string, Procdesc.Node.t) Hashtbl.t @@ -52,10 +55,6 @@ val get_curr_class_decl_ptr : curr_class -> Clang_ast_t.pointer val curr_class_to_string : curr_class -> string -val curr_class_compare : curr_class -> curr_class -> int - -val curr_class_equal : curr_class -> curr_class -> bool - val is_objc_method : t -> bool val get_tenv : t -> Tenv.t