(*
 * Copyright (c) 2015 - present Facebook, Inc.
 * All rights reserved.
 *
 * This source code is licensed under the BSD style license found in the
 * LICENSE file in the root directory of this source tree. An additional grant
 * of patent rights can be found in the PATENTS file in the same directory.
 *)

open! IStd

(* This module adds more variants to some types in AST *)
(* The implementation extends default one from *)
(* facebook-clang-plugins repository *)


(* Type pointers *)
type Clang_ast_types.TypePtr.t +=
  | Builtin of Clang_ast_t.builtin_type_kind
  | PointerOf of Clang_ast_t.qual_type
  | ReferenceOf of Clang_ast_t.qual_type
  | ClassType of Typ.Name.t
  | DeclPtr of int
  | ErrorType

module TypePointerOrd = struct
  type t = Clang_ast_types.TypePtr.t
  let rec compare a1 a2 = match a1, a2 with
    | _ when phys_equal a1 a2 -> 0
    | Clang_ast_types.TypePtr.Ptr a, Clang_ast_types.TypePtr.Ptr b -> Int.compare a b
    | Clang_ast_types.TypePtr.Ptr _, _ -> 1
    | _, Clang_ast_types.TypePtr.Ptr _ -> -1
    | Builtin a, Builtin b -> Polymorphic_compare.compare a b
    | Builtin _, _ -> 1
    | _, Builtin _ -> -1
    | PointerOf a, PointerOf b -> compare_qual_type a b
    | PointerOf _, _ -> 1
    | _, PointerOf _ -> -1
    | ReferenceOf a, ReferenceOf b -> compare_qual_type a b
    | ReferenceOf _, _ -> 1
    | _, ReferenceOf _ -> -1
    | ClassType a, ClassType b -> Typ.Name.compare a b
    | ClassType _, _ -> 1
    | _, ClassType _ -> -1
    | DeclPtr a, DeclPtr b -> Int.compare a b
    | DeclPtr _, _ -> 1
    | _, DeclPtr _ -> -1
    | ErrorType, ErrorType -> 0
    | _ -> raise (invalid_arg ("unexpected type_ptr variants: "))
  and compare_qual_type (qt1 : Clang_ast_t.qual_type) (qt2 : Clang_ast_t.qual_type) =
    if phys_equal qt1 qt2 then 0 else
      (* enable warning here to warn and update comparison funtion when new field is added *)
      let [@warning "+9"] {
          Clang_ast_t.qt_type_ptr = t1;
          qt_is_const = c1;
          qt_is_restrict = r1;
          qt_is_volatile = v1} = qt1 in
      let [@warning "+9"] {
          Clang_ast_t.qt_type_ptr = t2;
          qt_is_const = c2;
          qt_is_restrict = r2;
          qt_is_volatile = v2} = qt2 in
      let qt_cmp = compare t1 t2 in
      if qt_cmp <> 0 then qt_cmp else
        let const_cmp = Bool.compare c1 c2 in
        if const_cmp <> 0 then const_cmp else
          let restrict_cmp = Bool.compare r1 r2 in
          if restrict_cmp <> 0 then restrict_cmp else
            Bool.compare v1 v2
end

module TypePointerMap = Caml.Map.Make(TypePointerOrd)


let rec type_ptr_to_string = function
  | Clang_ast_types.TypePtr.Ptr raw -> "clang_ptr_" ^ (string_of_int raw)
  | Builtin t -> "sil_" ^ (Clang_ast_j.string_of_builtin_type_kind t)
  | PointerOf typ ->  "pointer_of_" ^ type_ptr_to_string typ.Clang_ast_t.qt_type_ptr
  | ReferenceOf typ -> "reference_of_" ^ type_ptr_to_string typ.Clang_ast_t.qt_type_ptr
  | ClassType name -> "class_name_" ^ Typ.Name.name name
  | DeclPtr raw -> "decl_ptr_" ^ (string_of_int raw)
  | ErrorType -> "error_type"
  | _ -> "unknown"