253 lines
8.3 KiB
OCaml
253 lines
8.3 KiB
OCaml
(**************************************************************************)
|
|
(* *)
|
|
(* OCaml *)
|
|
(* *)
|
|
(* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *)
|
|
(* *)
|
|
(* Copyright 2001 Institut National de Recherche en Informatique et *)
|
|
(* en Automatique. *)
|
|
(* *)
|
|
(* All rights reserved. This file is distributed under the terms of *)
|
|
(* the GNU Lesser General Public License version 2.1, with the *)
|
|
(* special exception on linking described in the file LICENSE. *)
|
|
(* *)
|
|
(**************************************************************************)
|
|
|
|
(** Representation and manipulation of classes and class types.*)
|
|
|
|
module Name = Odoc_name
|
|
|
|
(** To keep the order of elements in a class *)
|
|
type class_element =
|
|
Class_attribute of Odoc_value.t_attribute
|
|
| Class_method of Odoc_value.t_method
|
|
| Class_comment of Odoc_types.text
|
|
|
|
(** Used when we can reference t_class or t_class_type. *)
|
|
type cct =
|
|
Cl of t_class
|
|
| Cltype of t_class_type * Types.type_expr list (** class type and type parameters *)
|
|
|
|
and inherited_class = {
|
|
ic_name : Name.t ; (** Complete name of the inherited class *)
|
|
mutable ic_class : cct option ; (** The associated t_class or t_class_type *)
|
|
ic_text : Odoc_types.text option ; (** The inheritance comment, if any *)
|
|
}
|
|
|
|
and class_apply = {
|
|
capp_name : Name.t ; (** The complete name of the applied class *)
|
|
mutable capp_class : t_class option; (** The associated t_class if we found it *)
|
|
capp_params : Types.type_expr list; (** The type of expressions the class is applied to *)
|
|
capp_params_code : string list ; (** The code of these expressions *)
|
|
}
|
|
|
|
and class_constr = {
|
|
cco_name : Name.t ; (** The complete name of the applied class *)
|
|
mutable cco_class : cct option; (** The associated class of the class type if we found it *)
|
|
cco_type_parameters : Types.type_expr list; (** The type parameters of the class, if needed *)
|
|
}
|
|
|
|
|
|
and class_kind =
|
|
Class_structure of inherited_class list * class_element list
|
|
(** an explicit class structure, used in implementation and interface *)
|
|
| Class_apply of class_apply (** application/alias of a class, used in implementation only *)
|
|
| Class_constr of class_constr (** a class used to give the type of the defined class,
|
|
instead of a structure, used in interface only.
|
|
For example, it will be used with the name "M1.M2....tutu"
|
|
when the class toto is defined like this :
|
|
class toto : int -> tutu *)
|
|
| Class_constraint of class_kind * class_type_kind
|
|
(** A class definition with a constraint. *)
|
|
|
|
(** Representation of a class. *)
|
|
and t_class = {
|
|
cl_name : Name.t ; (** Name of the class *)
|
|
mutable cl_info : Odoc_types.info option ; (** The optional associated user information *)
|
|
cl_type : Types.class_type ;
|
|
cl_type_parameters : Types.type_expr list ; (** Type parameters *)
|
|
cl_virtual : bool ; (** true = virtual *)
|
|
mutable cl_kind : class_kind ;
|
|
mutable cl_parameters : Odoc_parameter.parameter list ;
|
|
mutable cl_loc : Odoc_types.location ;
|
|
}
|
|
|
|
and class_type_alias = {
|
|
cta_name : Name.t ;
|
|
mutable cta_class : cct option ; (** we can have a t_class or a t_class_type *)
|
|
cta_type_parameters : Types.type_expr list ; (** the type parameters *)
|
|
}
|
|
|
|
and class_type_kind =
|
|
Class_signature of inherited_class list * class_element list
|
|
| Class_type of class_type_alias (** a class type eventually applied to type args *)
|
|
|
|
(** Representation of a class type. *)
|
|
and t_class_type = {
|
|
clt_name : Name.t ;
|
|
mutable clt_info : Odoc_types.info option ; (** The optional associated user information *)
|
|
clt_type : Types.class_type ;
|
|
clt_type_parameters : Types.type_expr list ; (** type parameters *)
|
|
clt_virtual : bool ; (** true = virtual *)
|
|
mutable clt_kind : class_type_kind ;
|
|
mutable clt_loc : Odoc_types.location ;
|
|
}
|
|
|
|
|
|
(** {1 Functions} *)
|
|
|
|
(** Returns the text associated to the given parameter label
|
|
in the given class, or None. *)
|
|
let class_parameter_text_by_name cl label =
|
|
match cl.cl_info with
|
|
None -> None
|
|
| Some i ->
|
|
try
|
|
let t = List.assoc label i.Odoc_types.i_params in
|
|
Some t
|
|
with
|
|
Not_found ->
|
|
None
|
|
|
|
(** Returns the list of elements of a t_class. *)
|
|
let rec class_elements ?(trans=true) cl =
|
|
let rec iter_kind k =
|
|
match k with
|
|
Class_structure (_, elements) -> elements
|
|
| Class_constraint (c_kind, _ct_kind) ->
|
|
iter_kind c_kind
|
|
(* FIXME : use c_kind or ct_kind ?
|
|
For now, as ct_kind is not analyzed,
|
|
we search inside c_kind
|
|
class_type_elements ~trans: trans
|
|
{ clt_name = "" ; clt_info = None ;
|
|
clt_type_parameters = [] ;
|
|
clt_virtual = false ;
|
|
clt_kind = ct_kind }
|
|
*)
|
|
| Class_apply capp ->
|
|
(
|
|
match capp.capp_class with
|
|
Some c when trans -> class_elements ~trans: trans c
|
|
| _ -> []
|
|
)
|
|
| Class_constr cco ->
|
|
(
|
|
match cco.cco_class with
|
|
Some (Cl c) when trans -> class_elements ~trans: trans c
|
|
| Some (Cltype (ct,_)) when trans -> class_type_elements ~trans: trans ct
|
|
| _ -> []
|
|
)
|
|
in
|
|
iter_kind cl.cl_kind
|
|
|
|
(** Returns the list of elements of a t_class_type. *)
|
|
and class_type_elements ?(trans=true) clt =
|
|
match clt.clt_kind with
|
|
Class_signature (_, elements) -> elements
|
|
| Class_type { cta_class = Some (Cltype (ct, _)) } when trans ->
|
|
class_type_elements ~trans ct
|
|
| Class_type { cta_class = Some (Cl c) } when trans ->
|
|
class_elements ~trans c
|
|
| Class_type _ ->
|
|
[]
|
|
|
|
(** Returns the attributes of a t_class. *)
|
|
let class_attributes ?(trans=true) cl =
|
|
List.fold_left
|
|
(fun acc -> fun ele ->
|
|
match ele with
|
|
Class_attribute a ->
|
|
acc @ [ a ]
|
|
| _ ->
|
|
acc
|
|
)
|
|
[]
|
|
(class_elements ~trans cl)
|
|
|
|
(** Returns the methods of a t_class. *)
|
|
let class_methods ?(trans=true) cl =
|
|
List.fold_left
|
|
(fun acc -> fun ele ->
|
|
match ele with
|
|
Class_method m ->
|
|
acc @ [ m ]
|
|
| _ ->
|
|
acc
|
|
)
|
|
[]
|
|
(class_elements ~trans cl)
|
|
|
|
(** Returns the comments in a t_class. *)
|
|
let class_comments ?(trans=true) cl =
|
|
List.fold_left
|
|
(fun acc -> fun ele ->
|
|
match ele with
|
|
Class_comment t ->
|
|
acc @ [ t ]
|
|
| _ ->
|
|
acc
|
|
)
|
|
[]
|
|
(class_elements ~trans cl)
|
|
|
|
|
|
(** Update the parameters text of a t_class, according to the cl_info field. *)
|
|
let class_update_parameters_text cl =
|
|
let f p =
|
|
Odoc_parameter.update_parameter_text (class_parameter_text_by_name cl) p
|
|
in
|
|
List.iter f cl.cl_parameters
|
|
|
|
(** Returns the attributes of a t_class_type. *)
|
|
let class_type_attributes ?(trans=true) clt =
|
|
List.fold_left
|
|
(fun acc -> fun ele ->
|
|
match ele with
|
|
Class_attribute a ->
|
|
acc @ [ a ]
|
|
| _ ->
|
|
acc
|
|
)
|
|
[]
|
|
(class_type_elements ~trans clt)
|
|
|
|
(** Returns the methods of a t_class_type. *)
|
|
let class_type_methods ?(trans=true) clt =
|
|
List.fold_left
|
|
(fun acc -> fun ele ->
|
|
match ele with
|
|
Class_method m ->
|
|
acc @ [ m ]
|
|
| _ ->
|
|
acc
|
|
)
|
|
[]
|
|
(class_type_elements ~trans clt)
|
|
|
|
(** Returns the comments in a t_class_type. *)
|
|
let class_type_comments ?(trans=true) clt =
|
|
List.fold_left
|
|
(fun acc -> fun ele ->
|
|
match ele with
|
|
Class_comment m ->
|
|
acc @ [ m ]
|
|
| _ ->
|
|
acc
|
|
)
|
|
[]
|
|
(class_type_elements ~trans clt)
|
|
|
|
(** Returns the text associated to the given parameter label
|
|
in the given class type, or None. *)
|
|
let class_type_parameter_text_by_name clt label =
|
|
match clt.clt_info with
|
|
None -> None
|
|
| Some i ->
|
|
try
|
|
let t = List.assoc label i.Odoc_types.i_params in
|
|
Some t
|
|
with
|
|
Not_found ->
|
|
None
|