From e397afa085b6aad24af43f434d105128603b5fd9 Mon Sep 17 00:00:00 2001
From: Josh Berdine <jjb@fb.com>
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