Summary: There is no reason for this to be in Typ. Reviewed By: ezgicicek Differential Revision: D19161751 fbshipit-source-id: de33f5fa1master
Nikos Gorogiannis
5 years ago
committed by
Facebook Github Bot
parent
c1d4e57561
commit
cef051dd1a
@ -0,0 +1,146 @@
|
||||
(*
|
||||
* Copyright (c) Facebook, Inc. and its affiliates.
|
||||
*
|
||||
* This source code is licensed under the MIT license found in the
|
||||
* LICENSE file in the root directory of this source tree.
|
||||
*)
|
||||
|
||||
open! IStd
|
||||
module F = Format
|
||||
|
||||
type field = Typ.Fieldname.t * Typ.t * Annot.Item.t [@@deriving compare]
|
||||
|
||||
type fields = field list
|
||||
|
||||
(** Type for a structured value. *)
|
||||
type t =
|
||||
{ fields: fields (** non-static fields *)
|
||||
; statics: fields (** static fields *)
|
||||
; supers: Typ.Name.t list (** superclasses *)
|
||||
; methods: Typ.Procname.t list (** methods defined *)
|
||||
; exported_objc_methods: Typ.Procname.t list
|
||||
(** methods in ObjC interface, subset of [methods] *)
|
||||
; annots: Annot.Item.t (** annotations *)
|
||||
; dummy: bool (** dummy struct for class including static method *) }
|
||||
|
||||
type lookup = Typ.Name.t -> t option
|
||||
|
||||
let pp_field pe f (field_name, typ, ann) =
|
||||
F.fprintf f "@\n\t\t%a %a %a" (Typ.pp_full pe) typ Typ.Fieldname.pp field_name Annot.Item.pp ann
|
||||
|
||||
|
||||
let pp pe name f {fields; supers; methods; exported_objc_methods; annots} =
|
||||
if Config.debug_mode then
|
||||
(* change false to true to print the details of struct *)
|
||||
F.fprintf f
|
||||
"%a @\n\
|
||||
\tfields: {%a@\n\
|
||||
\t}@\n\
|
||||
\tsupers: {%a@\n\
|
||||
\t}@\n\
|
||||
\tmethods: {%a@\n\
|
||||
\t}@\n\
|
||||
\texported_obj_methods: {%a@\n\
|
||||
\t}@\n\
|
||||
\tannots: {%a@\n\
|
||||
\t}"
|
||||
Typ.Name.pp name
|
||||
(Pp.seq (pp_field pe))
|
||||
fields
|
||||
(Pp.seq (fun f n -> F.fprintf f "@\n\t\t%a" Typ.Name.pp n))
|
||||
supers
|
||||
(Pp.seq (fun f m -> F.fprintf f "@\n\t\t%a" Typ.Procname.pp m))
|
||||
methods
|
||||
(Pp.seq (fun f m -> F.fprintf f "@\n\t\t%a" Typ.Procname.pp m))
|
||||
exported_objc_methods Annot.Item.pp annots
|
||||
else Typ.Name.pp f name
|
||||
|
||||
|
||||
let internal_mk_struct ?default ?fields ?statics ?methods ?exported_objc_methods ?supers ?annots
|
||||
?dummy () =
|
||||
let default_ =
|
||||
{ fields= []
|
||||
; statics= []
|
||||
; methods= []
|
||||
; exported_objc_methods= []
|
||||
; supers= []
|
||||
; annots= Annot.Item.empty
|
||||
; dummy= false }
|
||||
in
|
||||
let mk_struct_ ?(default = default_) ?(fields = default.fields) ?(statics = default.statics)
|
||||
?(methods = default.methods) ?(exported_objc_methods = default.exported_objc_methods)
|
||||
?(supers = default.supers) ?(annots = default.annots) ?(dummy = default.dummy) () =
|
||||
{fields; statics; methods; exported_objc_methods; supers; annots; dummy}
|
||||
in
|
||||
mk_struct_ ?default ?fields ?statics ?methods ?exported_objc_methods ?supers ?annots ?dummy ()
|
||||
|
||||
|
||||
(** the element typ of the final extensible array in the given typ, if any *)
|
||||
let rec get_extensible_array_element_typ ~lookup (typ : Typ.t) =
|
||||
match typ.desc with
|
||||
| Tarray {elt} ->
|
||||
Some elt
|
||||
| Tstruct name -> (
|
||||
match lookup name with
|
||||
| Some {fields} -> (
|
||||
match List.last fields with
|
||||
| Some (_, fld_typ, _) ->
|
||||
get_extensible_array_element_typ ~lookup fld_typ
|
||||
| None ->
|
||||
None )
|
||||
| None ->
|
||||
None )
|
||||
| _ ->
|
||||
None
|
||||
|
||||
|
||||
(** If a struct type with field f, return the type of f. If not, return the default *)
|
||||
let fld_typ ~lookup ~default fn (typ : Typ.t) =
|
||||
(* Note: would be nice migrate it to get_field_info
|
||||
(for that one needs to ensure adding Tptr to pattern match does not break thing) *)
|
||||
match typ.desc with
|
||||
| Tstruct name -> (
|
||||
match lookup name with
|
||||
| Some {fields} ->
|
||||
List.find ~f:(fun (f, _, _) -> Typ.Fieldname.equal f fn) fields
|
||||
|> Option.value_map ~f:snd3 ~default
|
||||
| None ->
|
||||
default )
|
||||
| _ ->
|
||||
default
|
||||
|
||||
|
||||
type field_info = {typ: Typ.t; annotations: Annot.Item.t; is_static: bool}
|
||||
|
||||
let find_field field_list field_name_to_lookup =
|
||||
List.find_map
|
||||
~f:(fun (field_name, typ, annotations) ->
|
||||
if Typ.Fieldname.equal field_name field_name_to_lookup then Some (typ, annotations) else None
|
||||
)
|
||||
field_list
|
||||
|
||||
|
||||
let get_field_info ~lookup field_name_to_lookup (typ : Typ.t) =
|
||||
let find_field_info field_list ~is_static =
|
||||
find_field field_list field_name_to_lookup
|
||||
|> Option.map ~f:(fun (typ, annotations) -> {typ; annotations; is_static})
|
||||
in
|
||||
match typ.desc with
|
||||
| Tstruct name | Tptr ({desc= Tstruct name}, _) -> (
|
||||
match lookup name with
|
||||
| Some {fields= non_statics; statics} ->
|
||||
(* Search in both lists and return the first found *)
|
||||
find_field_info statics ~is_static:true
|
||||
|> IOption.if_none_evalopt ~f:(fun () -> find_field_info non_statics ~is_static:false)
|
||||
| None ->
|
||||
None )
|
||||
| _ ->
|
||||
None
|
||||
|
||||
|
||||
let get_field_type_and_annotation ~lookup field_name_to_lookup typ =
|
||||
get_field_info ~lookup field_name_to_lookup typ
|
||||
|> Option.map ~f:(fun {typ; annotations} -> (typ, annotations))
|
||||
|
||||
|
||||
let is_dummy {dummy} = dummy
|
||||
@ -0,0 +1,63 @@
|
||||
(*
|
||||
* Copyright (c) 2009-2013, Monoidics ltd.
|
||||
* Copyright (c) Facebook, Inc. and its affiliates.
|
||||
*
|
||||
* This source code is licensed under the MIT license found in the
|
||||
* LICENSE file in the root directory of this source tree.
|
||||
*)
|
||||
|
||||
open! IStd
|
||||
module F = Format
|
||||
|
||||
type field = Typ.Fieldname.t * Typ.t * Annot.Item.t [@@deriving compare]
|
||||
|
||||
type fields = field list
|
||||
|
||||
(** Type for a structured value. *)
|
||||
type t = private
|
||||
{ fields: fields (** non-static fields *)
|
||||
; statics: fields (** static fields *)
|
||||
; supers: Typ.Name.t list (** supers *)
|
||||
; methods: Typ.Procname.t list (** methods defined *)
|
||||
; exported_objc_methods: Typ.Procname.t list
|
||||
(** methods in ObjC interface, subset of [methods] *)
|
||||
; annots: Annot.Item.t (** annotations *)
|
||||
; dummy: bool (** dummy struct for class including static method *) }
|
||||
|
||||
type lookup = Typ.Name.t -> t option
|
||||
|
||||
val pp_field : Pp.env -> F.formatter -> field -> unit
|
||||
|
||||
val pp : Pp.env -> Typ.Name.t -> F.formatter -> t -> unit
|
||||
(** Pretty print a struct type. *)
|
||||
|
||||
val internal_mk_struct :
|
||||
?default:t
|
||||
-> ?fields:fields
|
||||
-> ?statics:fields
|
||||
-> ?methods:Typ.Procname.t list
|
||||
-> ?exported_objc_methods:Typ.Procname.t list
|
||||
-> ?supers:Typ.Name.t list
|
||||
-> ?annots:Annot.Item.t
|
||||
-> ?dummy:bool
|
||||
-> unit
|
||||
-> t
|
||||
(** Construct a struct_typ, normalizing field types *)
|
||||
|
||||
val get_extensible_array_element_typ : lookup:lookup -> Typ.t -> Typ.t option
|
||||
(** the element typ of the final extensible array in the given typ, if any *)
|
||||
|
||||
type field_info = {typ: Typ.t; annotations: Annot.Item.t; is_static: bool}
|
||||
|
||||
val get_field_info : lookup:lookup -> Typ.Fieldname.t -> Typ.t -> field_info option
|
||||
(** Lookup for info associated with the field [fn]. None if [typ] has no field named [fn] *)
|
||||
|
||||
val fld_typ : lookup:lookup -> default:Typ.t -> Typ.Fieldname.t -> Typ.t -> Typ.t
|
||||
(** If a struct type with field f, return the type of f. If not, return the default type if given,
|
||||
otherwise raise an exception *)
|
||||
|
||||
val get_field_type_and_annotation :
|
||||
lookup:lookup -> Typ.Fieldname.t -> Typ.t -> (Typ.t * Annot.Item.t) option
|
||||
(** Return the type of the field [fn] and its annotation, None if [typ] has no field named [fn] *)
|
||||
|
||||
val is_dummy : t -> bool
|
||||
Loading…
Reference in new issue