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