infer_clone/infer/src/clang/cFrontend_utils.ml

(*
 * Copyright (c) 2013 - 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! Utils

(** Module for utility functions for the whole frontend. Includes functions for printing,  *)
(** for transformations of ast nodes and general utility functions such as  functions on lists *)

module L = Logging
module F = Format

module Printing =
struct
  let log_out fmt =
    let pp = if Config.debug_mode then Format.fprintf else Format.ifprintf in
    pp Format.std_formatter fmt

  let log_err fmt =
    let pp = if Config.debug_mode then Format.fprintf else Format.ifprintf in
    pp Format.err_formatter fmt


  let annotation_to_string (annotation, _) =
    "< " ^ annotation.Typ.class_name ^ " : " ^
    (IList.to_string (fun x -> x) annotation.Typ.parameters) ^ " >"

  let field_to_string (fieldname, typ, annotation) =
    (Ident.fieldname_to_string fieldname) ^ " " ^
    (Typ.to_string typ) ^  (IList.to_string annotation_to_string annotation)

  let log_stats fmt =
    let pp =
      if Config.stats_mode || Config.debug_mode
      then Format.fprintf else Format.ifprintf in
    pp Format.std_formatter fmt

  let print_tenv tenv =
    Tenv.iter (fun typname struct_t ->
        match typname with
        | Typename.TN_csu (Csu.Class _, _) | Typename.TN_csu (Csu.Protocol, _) ->
            print_endline (
              (Typename.to_string typname) ^ " " ^
              (Typ.item_annotation_to_string struct_t.struct_annotations) ^ "\n" ^
              "---> superclass and protocols " ^ (IList.to_string (fun tn ->
                  "\t" ^ (Typename.to_string tn) ^ "\n") struct_t.superclasses) ^
              "---> methods " ^
              (IList.to_string (fun x ->"\t" ^ (Procname.to_string x) ^ "\n") struct_t.def_methods)
              ^ "  " ^
              "\t---> fields " ^ (IList.to_string field_to_string struct_t.instance_fields) ^ "\n")
        | _ -> ()
      ) tenv

  let print_tenv_struct_unions tenv =
    Tenv.iter (fun typname struct_t ->
        match typname with
        | Typename.TN_csu (Csu.Struct, _) | Typename.TN_csu (Csu.Union, _) ->
            print_endline (
              (Typename.to_string typname)^"\n"^
              "\t---> fields "^(IList.to_string (fun (fieldname, typ, _) ->
                  match typ with
                  | Typ.Tvar tname -> "tvar"^(Typename.to_string tname)
                  | Typ.Tstruct _ | _ ->
                      "\t struct "^(Ident.fieldname_to_string fieldname)^" "^
                      (Typ.to_string typ)^"\n") struct_t.instance_fields
                )
            )
        | Typename.TN_typedef typname ->
            print_endline
              ((Mangled.to_string typname)^"-->"^(Typ.to_string (Typ.Tstruct struct_t)))
        | _ -> ()
      ) tenv

  let print_procedures cfg =
    let procs = Cfg.get_all_procs cfg in
    print_endline
      (IList.to_string (fun pdesc ->
           let pname = Cfg.Procdesc.get_proc_name pdesc in
           "name> "^
           (Procname.to_string pname) ^
           " defined? " ^ (string_of_bool (Cfg.Procdesc.is_defined pdesc)) ^ "\n")
          procs)

  let print_failure_info pointer =
    L.err "AST Element> %s IN FILE> %s @.@." pointer !CFrontend_config.json

  let print_nodes nodes =
    IList.iter (fun node -> print_endline (Cfg.Node.get_description pe_text node)) nodes

  let instrs_to_string instrs =
    let pp fmt () = Format.fprintf fmt "%a" (Sil.pp_instr_list pe_text) instrs in
    pp_to_string pp ()

end

module Ast_utils =
struct
  type type_ptr_to_sil_type = Tenv.t -> Clang_ast_t.type_ptr -> Typ.t

  let string_of_decl decl =
    let name = Clang_ast_proj.get_decl_kind_string decl in
    let info = Clang_ast_proj.get_decl_tuple decl in
    Printf.sprintf "<\"%s\"> '%d'" name info.Clang_ast_t.di_pointer

  let string_of_unary_operator_kind = function
    | `PostInc -> "PostInc"
    | `PostDec -> "PostDec"
    | `PreInc -> "PreInc"
    | `PreDec -> "PreDec"
    | `AddrOf -> "AddrOf"
    | `Deref -> "Deref"
    | `Plus -> "Plus"
    | `Minus -> "Minus"
    | `Not -> "Not"
    | `LNot -> "LNot"
    | `Real -> "Real"
    | `Imag -> "Imag"
    | `Extension -> "Extension"
    | `Coawait -> "Coawait"

  let string_of_stmt stmt =
    let name = Clang_ast_proj.get_stmt_kind_string stmt in
    let info, _ = Clang_ast_proj.get_stmt_tuple stmt in
    Printf.sprintf "<\"%s\"> '%d'" name info.Clang_ast_t.si_pointer

  let get_stmts_from_stmt stmt =
    let open Clang_ast_t in
    match stmt with
    | OpaqueValueExpr (_, lstmt, _, opaque_value_expr_info) ->
        (match opaque_value_expr_info.Clang_ast_t.ovei_source_expr with
         | Some stmt -> lstmt @ [stmt]
         | _ -> lstmt)
    (* given that this has not been translated, looking up for variables *)
    (* inside leads to inconsistencies *)
    | ObjCAtCatchStmt _ ->
        []
    | _ -> snd (Clang_ast_proj.get_stmt_tuple stmt)

  let fold_qual_name qual_name_list =
    match qual_name_list with
    | [] -> ""
    | name :: quals ->
        let s = (IList.fold_right (fun el res -> res ^ el ^ "::") quals "") ^ name in
        let no_slash = Str.global_replace (Str.regexp "/") "_" s in
        no_slash

  let get_qualified_name name_info =
    fold_qual_name name_info.Clang_ast_t.ni_qual_name

  let get_unqualified_name name_info =
    let name = match name_info.Clang_ast_t.ni_qual_name with
      | name :: _ -> name
      | [] -> name_info.Clang_ast_t.ni_name in
    fold_qual_name [name]

  let get_class_name_from_member member_name_info =
    match member_name_info.Clang_ast_t.ni_qual_name with
    | _ :: class_qual_list -> fold_qual_name class_qual_list
    | [] -> assert false

  let make_name_decl name = {
    Clang_ast_t.ni_name = name;
    ni_qual_name = [name];
  }

  let make_qual_name_decl class_name_quals name = {
    Clang_ast_t.ni_name = name;
    ni_qual_name = name :: class_name_quals;
  }

  let property_name property_impl_decl_info =
    let no_property_name = make_name_decl "WARNING_NO_PROPERTY_NAME" in
    match property_impl_decl_info.Clang_ast_t.opidi_property_decl with
    | Some decl_ref ->
        (match decl_ref.Clang_ast_t.dr_name with
         | Some n -> n
         | _ -> no_property_name)
    | None -> no_property_name

  let generated_ivar_name property_name =
    match property_name.Clang_ast_t.ni_qual_name with
    | [name; class_name] ->
        let ivar_name = "_" ^ name in
        { Clang_ast_t.ni_name = ivar_name;
          ni_qual_name = [ivar_name; class_name]
        }
    | _ -> make_name_decl property_name.Clang_ast_t.ni_name

  let property_attribute_compare att1 att2 =
    match att1, att2 with
      `Readonly, `Readonly -> 0
    | `Readonly, _ -> -1
    | _, `Readonly -> 1
    | `Assign, `Assign -> 0
    | `Assign, _ -> -1
    | _, `Assign -> 1
    | `Readwrite, `Readwrite -> 0
    | `Readwrite, _ -> -1
    | _, `Readwrite -> 1
    | `Retain, `Retain -> 0
    | `Retain, _ -> -1
    | _, `Retain -> 1
    | `Copy, `Copy -> 0
    | `Copy, _ -> -1
    | _, `Copy -> 1
    | `Nonatomic, `Nonatomic -> 0
    | `Nonatomic, _ -> -1
    | _, `Nonatomic -> 1
    | `Atomic, `Atomic -> 0
    | `Atomic, _ -> 1
    | _, `Atomic -> 1
    | `Weak, `Weak -> 0
    | `Weak, _ -> -1
    | _, `Weak -> 1
    | `Strong, `Strong -> 0
    | `Strong, _ -> -1
    | _, `Strong -> 1
    | `Unsafe_unretained, `Unsafe_unretained -> 0
    | `Unsafe_unretained, _ -> -1
    | _, `Unsafe_unretained -> 1
    | `ExplicitGetter, `ExplicitGetter -> 0
    | `ExplicitGetter, _ -> -1
    | _, `ExplicitGetter -> 1
    | `ExplicitSetter, `ExplicitSetter -> 0

  let property_attribute_eq att1 att2 =
    property_attribute_compare att1 att2 = 0

  let get_memory_management_attributes () =
    [`Assign; `Retain; `Copy; `Weak; `Strong; `Unsafe_unretained]

  let is_retain attribute_opt =
    match attribute_opt with
    | Some attribute ->
        attribute = `Retain || attribute = `Strong
    | _ -> false

  let is_copy attribute_opt =
    match attribute_opt with
    | Some attribute ->
        attribute = `Copy
    | _ -> false

  let name_opt_of_name_info_opt name_info_opt =
    match name_info_opt with
    | Some name_info -> Some (get_qualified_name name_info)
    | None -> None

  let pointer_counter = ref 0

  let get_fresh_pointer () =
    pointer_counter := !pointer_counter + 1;
    let internal_pointer = -(!pointer_counter) in
    internal_pointer

  let get_invalid_pointer () =
    CFrontend_config.invalid_pointer

  let type_from_unary_expr_or_type_trait_expr_info info =
    match info.Clang_ast_t.uttei_type_ptr with
    | Some tp -> Some tp
    | None -> None

  let get_decl decl_ptr =
    try
      Some (Clang_ast_main.PointerMap.find decl_ptr !CFrontend_config.pointer_decl_index)
    with Not_found -> Printing.log_stats "decl with pointer %d not found\n" decl_ptr; None

  let get_decl_opt decl_ptr_opt =
    match decl_ptr_opt with
    | Some decl_ptr -> get_decl decl_ptr
    | None -> None

  let get_stmt stmt_ptr =
    try
      Some (Clang_ast_main.PointerMap.find stmt_ptr !CFrontend_config.pointer_stmt_index)
    with Not_found -> Printing.log_stats "stmt with pointer %d not found\n" stmt_ptr; None

  let get_stmt_opt stmt_ptr_opt =
    match stmt_ptr_opt with
    | Some stmt_ptr -> get_stmt stmt_ptr
    | None -> None

  let get_decl_opt_with_decl_ref decl_ref_opt =
    match decl_ref_opt with
    | Some decl_ref -> get_decl decl_ref.Clang_ast_t.dr_decl_pointer
    | None -> None

  let update_sil_types_map type_ptr sil_type =
    CFrontend_config.sil_types_map :=
      Clang_ast_types.TypePointerMap.add type_ptr sil_type !CFrontend_config.sil_types_map

  let update_enum_map enum_constant_pointer sil_exp =
    let open Clang_ast_main in
    let (predecessor_pointer_opt, _) =
      try PointerMap.find enum_constant_pointer !CFrontend_config.enum_map
      with Not_found -> assert false in
    let enum_map_value = (predecessor_pointer_opt, Some sil_exp) in
    CFrontend_config.enum_map :=
      PointerMap.add enum_constant_pointer enum_map_value !CFrontend_config.enum_map

  let add_enum_constant enum_constant_pointer predecessor_pointer_opt =
    let enum_map_value = (predecessor_pointer_opt, None) in
    CFrontend_config.enum_map :=
      Clang_ast_main.PointerMap.add enum_constant_pointer enum_map_value !CFrontend_config.enum_map

  let get_enum_constant_exp enum_constant_pointer =
    Clang_ast_main.PointerMap.find enum_constant_pointer !CFrontend_config.enum_map

  let get_type type_ptr =
    try
      (* There is chance for success only if type_ptr is in fact clang pointer *)
      (let raw_ptr = Clang_ast_types.type_ptr_to_clang_pointer type_ptr in
       try
         Some (Clang_ast_main.PointerMap.find raw_ptr !CFrontend_config.pointer_type_index)
       with Not_found -> Printing.log_stats "type with pointer %d not found\n" raw_ptr; None)
    with Clang_ast_types.Not_Clang_Pointer ->
      (* otherwise, function fails *)
      let type_str = Clang_ast_types.type_ptr_to_string type_ptr in
      Printing.log_stats "type %s is not clang pointer\n" type_str;
      None

  let get_desugared_type type_ptr =
    let typ_opt = get_type type_ptr in
    match typ_opt with
    | Some typ ->
        let type_info = Clang_ast_proj.get_type_tuple typ in
        (match type_info.Clang_ast_t.ti_desugared_type with
         | Some ptr -> get_type ptr
         | _ -> typ_opt)
    | _ -> typ_opt

  let get_decl_from_typ_ptr typ_ptr =
    let typ_opt = get_desugared_type typ_ptr in
    let typ = match typ_opt with Some t -> t | _ -> assert false in
    (* it needs extending to handle objC types *)
    match typ with
    | Clang_ast_t.RecordType (_, decl_ptr) -> get_decl decl_ptr
    | _ -> None

  (*TODO take the attributes into account too. To be done after we get the attribute's arguments. *)
  let is_type_nonnull type_ptr =
    let open Clang_ast_t in
    match get_type type_ptr with
    | Some AttributedType (_, attr_info) -> attr_info.ati_attr_kind = `Nonnull
    | _ -> false

  let is_type_nullable type_ptr =
    let open Clang_ast_t in
    match get_type type_ptr with
    | Some AttributedType (_, attr_info) -> attr_info.ati_attr_kind = `Nullable
    | _ -> false

  let string_of_type_ptr type_ptr =
    match get_desugared_type type_ptr with
    | Some typ -> (Clang_ast_proj.get_type_tuple typ).Clang_ast_t.ti_raw
    | None -> ""

  let add_type_from_decl_ref type_ptr_to_sil_type tenv decl_ref_opt fail_if_not_found =
    match decl_ref_opt with (* translate interface first if found *)
    | Some dr ->
        ignore (type_ptr_to_sil_type tenv (`DeclPtr dr.Clang_ast_t.dr_decl_pointer));
    | _ -> if fail_if_not_found then assert false else ()

  let add_type_from_decl_ref_list type_ptr_to_sil_type tenv decl_ref_list =
    let add_elem dr =
      ignore (type_ptr_to_sil_type tenv (`DeclPtr dr.Clang_ast_t.dr_decl_pointer)) in
    IList.iter add_elem decl_ref_list

  let get_function_decl_with_body decl_ptr =
    let open Clang_ast_t in
    let decl_opt = get_decl decl_ptr in
    let decl_ptr' = match decl_opt with
      | Some (FunctionDecl (_, _, _, fdecl_info))
      | Some (CXXMethodDecl (_, _, _, fdecl_info, _))
      | Some (CXXConstructorDecl (_, _, _, fdecl_info, _))
      | Some (CXXConversionDecl (_, _, _, fdecl_info, _))
      | Some (CXXDestructorDecl (_, _, _, fdecl_info, _)) ->
          fdecl_info.Clang_ast_t.fdi_decl_ptr_with_body
      | _ -> Some decl_ptr in
    if decl_ptr' = (Some decl_ptr) then decl_opt
    else get_decl_opt decl_ptr'

  let get_info_from_decl_ref decl_ref =
    let name_info = match decl_ref.Clang_ast_t.dr_name with Some ni -> ni | _ -> assert false in
    let decl_ptr = decl_ref.Clang_ast_t.dr_decl_pointer in
    let type_ptr = match decl_ref.Clang_ast_t.dr_type_ptr with Some tp -> tp | _ -> assert false in
    name_info, decl_ptr, type_ptr

  (* st |= EF (atomic_pred param) *)
  let rec exists_eventually_st atomic_pred param  st =
    if atomic_pred param st then true
    else
      let _, st_list = Clang_ast_proj.get_stmt_tuple st in
      IList.exists (exists_eventually_st atomic_pred param) st_list

  let is_global_var decl =
    match decl with
    | Clang_ast_t.VarDecl (_, _ ,_, vdi) -> vdi.vdi_is_global
    | _ -> false

  let is_const_expr_var decl =
    match decl with
    | Clang_ast_t.VarDecl (_, _ ,_, vdi) -> vdi.vdi_is_const_expr
    | _ -> false

  let is_objc () =
    match Config.clang_lang with
    | Config.OBJC -> true
    | _ -> false

  let is_objcpp () =
    match Config.clang_lang with
    | Config.OBJCPP -> true
    | _ -> false

(*
  let rec getter_attribute_opt attributes =
    match attributes with
    | [] -> None
    | attr:: rest ->
        match attr with
        | `Getter getter -> getter.Clang_ast_t.dr_name
        | _ -> (getter_attribute_opt rest)

  let rec setter_attribute_opt attributes =
    match attributes with
    | [] -> None
    | attr:: rest ->
        match attr with
        | `Setter setter -> setter.Clang_ast_t.dr_name
        | _ -> (setter_attribute_opt rest)
*)
end

(* Global counter for anonymous block*)
let block_counter = ref 0

(* Returns a fresh index for a new anonymous block *)
let get_fresh_block_index () =
  block_counter := !block_counter +1;
  !block_counter

module General_utils =
struct

  type var_info = Clang_ast_t.decl_info * Clang_ast_t.type_ptr * Clang_ast_t.var_decl_info * bool

  let rec swap_elements_list l =
    match l with
    | el1:: el2:: rest ->
        el2:: el1:: (swap_elements_list rest)
    | [] -> []
    | _ -> assert false

  let rec string_from_list l =
    match l with
    | [] -> ""
    | [item] -> item
    | item:: l' -> item^" "^(string_from_list l')

  let rec append_no_duplicates eq list1 list2 =
    match list2 with
    | el:: rest2 ->
        if (IList.mem eq el list1) then
          (append_no_duplicates eq list1 rest2)
        else (append_no_duplicates eq list1 rest2)@[el]
    | [] -> list1

  let append_no_duplicates_csu list1 list2 =
    append_no_duplicates Typename.equal list1 list2

  let append_no_duplicates_methods list1 list2 =
    append_no_duplicates Procname.equal list1 list2

  let append_no_duplicated_vars list1 list2 =
    let eq (m1, t1) (m2, t2) = (Mangled.equal m1 m2) && (Typ.equal t1 t2) in
    append_no_duplicates eq list1 list2

  let append_no_duplicateds list1 list2 =
    let eq (e1, t1) (e2, t2) = (Sil.exp_equal e1 e2) && (Typ.equal t1 t2) in
    append_no_duplicates eq list1 list2


  let append_no_duplicates_annotations list1 list2 =
    let eq (annot1, _) (annot2, _) = annot1.Typ.class_name = annot2.Typ.class_name in
    append_no_duplicates eq list1 list2

  let add_no_duplicates_fields field_tuple l =
    let rec replace_field field_tuple l found =
      match field_tuple, l with
      | (field, typ, annot), ((old_field, old_typ, old_annot) as old_field_tuple :: rest) ->
          let ret_list, ret_found = replace_field field_tuple rest found in
          if Ident.fieldname_equal field old_field && Typ.equal typ old_typ then
            let annotations = append_no_duplicates_annotations annot old_annot in
            (field, typ, annotations) :: ret_list, true
          else old_field_tuple :: ret_list, ret_found
      | _, [] -> [], found in
    let new_list, found = replace_field field_tuple l false in
    if found then new_list
    else field_tuple :: l

  let rec append_no_duplicates_fields list1 list2 =
    match list1 with
    | field_tuple :: rest ->
        let updated_list2 = append_no_duplicates_fields rest list2 in
        add_no_duplicates_fields field_tuple updated_list2
    | [] -> list2

  let sort_fields fields =
    let compare (name1, _, _) (name2, _, _) =
      Ident.fieldname_compare name1 name2 in
    IList.sort compare fields


  let sort_fields_tenv tenv =
    let sort_fields_struct typname st =
      let st' = { st with Typ.instance_fields = (sort_fields st.Typ.instance_fields) } in
      Tenv.add tenv typname st' in
    Tenv.iter sort_fields_struct tenv

  let rec collect_list_tuples l (a, a1, b, c, d) =
    match l with
    | [] -> (a, a1, b, c, d)
    | (a', a1', b', c', d'):: l' -> collect_list_tuples l' (a@a', a1@a1', b@b', c@c', d@d')

  let is_static_var var_decl_info =
    match var_decl_info.Clang_ast_t.vdi_storage_class with
    | Some sc -> sc = CFrontend_config.static
    | _ -> false

  let block_procname_with_index defining_proc i =
    Config.anonymous_block_prefix^(Procname.to_string defining_proc)^Config.anonymous_block_num_sep^(string_of_int i)

  (* Makes a fresh name for a block defined inside the defining procedure.*)
  (* It updates the global block_counter *)
  let mk_fresh_block_procname defining_proc =
    let name = block_procname_with_index defining_proc (get_fresh_block_index ()) in
    Procname.mangled_objc_block name

  (* Returns the next fresh name for a block defined inside the defining procedure *)
  (* It does not update the global block_counter *)
  let get_next_block_pvar defining_proc =
    let name = block_procname_with_index defining_proc (!block_counter +1) in
    Pvar.mk (Mangled.from_string (CFrontend_config.temp_var^"_"^name)) defining_proc

  (* Reset  block counter *)
  let reset_block_counter () =
    block_counter := 0

  let rec zip xs ys =
    match xs, ys with
    | [], _
    | _, [] -> []
    | x :: xs, y :: ys -> (x, y) :: zip xs ys

  let list_range i j =
    let rec aux n acc =
      if n < i then acc else aux (n -1) (n :: acc)
    in aux j [] ;;

  let replicate n el = IList.map (fun _ -> el) (list_range 0 (n -1))

  let mk_class_field_name field_qual_name =
    let field_name = field_qual_name.Clang_ast_t.ni_name in
    let class_name = Ast_utils.get_class_name_from_member field_qual_name in
    Ident.create_fieldname (Mangled.mangled field_name class_name) 0

  let get_rel_file_path file_opt =
    match file_opt with
    | Some file ->
        (match Config.project_root with
         | Some root ->
             DB.source_file_to_rel_path (DB.rel_source_file_from_abs_path root file)
         | None -> file)
    | None -> ""

  let mk_procname_from_function name function_decl_info_opt tp language =
    let file =
      match function_decl_info_opt with
      | Some (decl_info, function_decl_info) ->
          (match function_decl_info.Clang_ast_t.fdi_storage_class with
           | Some "static" ->
               let file_opt = (fst decl_info.Clang_ast_t.di_source_range).Clang_ast_t.sl_file in
               get_rel_file_path file_opt
           | _ -> "")
      | None -> "" in
    let type_string =
      match language with
      | Config.CPP
      | Config.OBJCPP -> Ast_utils.string_of_type_ptr tp
      | _ -> "" in
    (* remove __restrict from type name to avoid mismatches. Clang allows to declare function*)
    (* with __restrict parameters and then define it without (it mostly applies to models).*)
    (* We are not using this information right now so we can remove it to avoid dealing with*)
    (* corner cases on different systems *)
    let type_string_no_restrict = Str.global_replace (Str.regexp "__restrict") "" type_string in
    let mangled = file ^ type_string_no_restrict in
    if String.length mangled == 0 then
      Procname.from_string_c_fun name
    else
      let crc = string_crc_hex32 mangled in
      Procname.C (Procname.c name crc)

  let mk_procname_from_objc_method class_name method_name method_kind =
    let mangled = Procname.mangled_of_objc_method_kind method_kind in
    Procname.ObjC_Cpp
      (Procname.objc_cpp class_name method_name mangled)

  let mk_procname_from_cpp_method class_name method_name tp =
    let type_name = Ast_utils.string_of_type_ptr tp in
    let type_name_crc = Some (string_crc_hex32 type_name) in
    Procname.ObjC_Cpp
      (Procname.objc_cpp class_name method_name type_name_crc)

  let get_var_name_mangled name_info var_decl_info =
    let clang_name = Ast_utils.get_qualified_name name_info in
    let param_idx_opt = var_decl_info.Clang_ast_t.vdi_parm_index_in_function in
    let name_string =
      match clang_name, param_idx_opt with
      | "", Some index -> "__param_" ^ string_of_int index
      | "", None -> assert false
      | _ -> clang_name in
    let mangled = match param_idx_opt with
      | Some index -> Mangled.mangled name_string (string_of_int index)
      | None -> Mangled.from_string name_string in
    name_string, mangled

  let mk_sil_var name decl_info_type_ptr_opt procname outer_procname =
    let name_string = Ast_utils.get_qualified_name name in
    match decl_info_type_ptr_opt with
    | Some (decl_info, type_ptr, var_decl_info, should_be_mangled) ->
        let name_string, simple_name = get_var_name_mangled name var_decl_info in
        if var_decl_info.Clang_ast_t.vdi_is_global then
          let global_mangled_name =
            if var_decl_info.Clang_ast_t.vdi_is_static_local then
              Mangled.from_string ((Procname.to_string outer_procname) ^ "_" ^ name_string)
            else simple_name in
          Pvar.mk_global global_mangled_name
        else if not should_be_mangled then Pvar.mk simple_name procname
        else
          let type_name = Ast_utils.string_of_type_ptr type_ptr in
          let start_location = fst decl_info.Clang_ast_t.di_source_range in
          let line_opt = start_location.Clang_ast_t.sl_line in
          let line_str = match line_opt with | Some line -> string_of_int line | None -> "" in
          let mangled = string_crc_hex32 (type_name ^ line_str) in
          let mangled_name = Mangled.mangled name_string mangled in
          Pvar.mk mangled_name procname
    | None -> Pvar.mk (Mangled.from_string name_string) procname

  let is_cpp_translation language =
    language = Config.CPP || language = Config.OBJCPP

end