diff options
Diffstat (limited to 'ocamldoc/odoc_class.ml')
| -rw-r--r-- | ocamldoc/odoc_class.ml | 250 |
1 files changed, 250 insertions, 0 deletions
diff --git a/ocamldoc/odoc_class.ml b/ocamldoc/odoc_class.ml new file mode 100644 index 000000000..1826eaddb --- /dev/null +++ b/ocamldoc/odoc_class.ml @@ -0,0 +1,250 @@ +(***********************************************************************) +(* OCamldoc *) +(* *) +(* 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 Q Public License version 1.0. *) +(* *) +(***********************************************************************) + + +(** 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 exprssions *) + } + +and class_constr = { + cco_name : Name.t ; (** The complete name of the applied class *) + mutable cco_class : t_class option; (** The associated t_class 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 to 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 ; + } + + +(** {2 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 + (* A VOIR : utiliser le c_kind ou le ct_kind ? + Pour l'instant, comme le ct_kind n'est pas analysé, + on cherche dans le 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 c when trans -> class_elements ~trans: trans c + | _ -> [] + ) + 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 + + |