l4/pkg/ocaml/ocaml/contrib/ocamldoc/odoc_value.ml

   1 (***********************************************************************)
   2 (*                             OCamldoc                                *)
   3 (*                                                                     *)
   4 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
   5 (*                                                                     *)
   6 (*  Copyright 2001 Institut National de Recherche en Informatique et   *)
   7 (*  en Automatique.  All rights reserved.  This file is distributed    *)
   8 (*  under the terms of the Q Public License version 1.0.               *)
   9 (*                                                                     *)
  10 (***********************************************************************)
  11
  12 (* $Id: odoc_value.ml 8927 2008-07-23 08:55:36Z guesdon $ *)
  13
  14 (** Representation and manipulation of values, class attributes and class methods. *)
  15
  16 module Name = Odoc_name
  17
  18 (** Types *)
  19
  20 (** Representation of a value. *)
  21 type t_value = {
  22     val_name : Name.t ;
  23     mutable val_info : Odoc_types.info option ;
  24     val_type : Types.type_expr ;
  25     val_recursive : bool ;
  26     mutable val_parameters : Odoc_parameter.parameter list ;
  27     mutable val_code : string option ;
  28     mutable val_loc : Odoc_types.location ;
  29   }
  30
  31 (** Representation of a class attribute. *)
  32 type t_attribute = {
  33     att_value : t_value ; (** an attribute has almost all the same information
  34                              as a value *)
  35     att_mutable : bool ;
  36     att_virtual : bool ;
  37   }
  38
  39 (** Representation of a class method. *)
  40 type t_method = {
  41     met_value : t_value ; (** a method has almost all the same information
  42                              as a value *)
  43     met_private : bool ;
  44     met_virtual : bool ;
  45   }
  46
  47 (** Functions *)
  48
  49 (** Returns the text associated to the given parameter name
  50    in the given value, or None. *)
  51 let value_parameter_text_by_name v name =
  52   match v.val_info with
  53     None -> None
  54   | Some i ->
  55       try
  56         let t = List.assoc name i.Odoc_types.i_params in
  57         Some t
  58       with
  59         Not_found ->
  60           None
  61
  62 (** Update the parameters text of a t_value, according to the val_info field. *)
  63 let update_value_parameters_text v =
  64   let f p =
  65     Odoc_parameter.update_parameter_text (value_parameter_text_by_name v) p
  66   in
  67   List.iter f v.val_parameters
  68
  69 (** Create a list of (parameter name, typ) from a type, according to the arrows.
  70    [parameter_list_from_arrows t = [ a ; b ]] if t = a -> b -> c.*)
  71 let parameter_list_from_arrows typ =
  72   let rec iter t =
  73     match t.Types.desc with
  74       Types.Tarrow (l, t1, t2, _) ->
  75         (l, t1) :: (iter t2)
  76     | Types.Tlink texp
  77     | Types.Tsubst texp ->
  78         iter texp
  79     | Types.Tpoly (texp, _) -> iter texp
  80     | Types.Tvar
  81     | Types.Ttuple _
  82     | Types.Tconstr _
  83     | Types.Tobject _
  84     | Types.Tfield _
  85     | Types.Tnil
  86     | Types.Tunivar
  87     | Types.Tvariant _ ->
  88         []
  89   in
  90   iter typ
  91
  92 (** Create a list of parameters with dummy names "??" from a type list.
  93    Used when we want to merge the parameters of a value, from the .ml
  94    and the .mli file. In the .mli file we don't have parameter names
  95    so there is nothing to merge. With this dummy list we can merge the
  96    parameter names from the .ml and the type from the .mli file. *)
  97 let dummy_parameter_list typ =
  98   let normal_name s =
  99     match s with
 100       "" -> s
 101     | _ ->
 102         match s.[0] with
 103           '?' -> String.sub s 1 ((String.length s) - 1)
 104         | _ -> s
 105   in
 106   Printtyp.mark_loops typ;
 107   let liste_param = parameter_list_from_arrows typ in
 108   let rec iter (label, t) =
 109     match t.Types.desc with
 110     | Types.Ttuple l ->
 111         if label = "" then
 112           Odoc_parameter.Tuple
 113             (List.map (fun t2 -> iter ("", t2)) l, t)
 114         else
 115           (* if there is a label, then we don't want to decompose the tuple *)
 116           Odoc_parameter.Simple_name
 117             { Odoc_parameter.sn_name = normal_name label ;
 118               Odoc_parameter.sn_type = t ;
 119               Odoc_parameter.sn_text = None }
 120     | Types.Tlink t2
 121     | Types.Tsubst t2 ->
 122         (iter (label, t2))
 123
 124     | _ ->
 125         Odoc_parameter.Simple_name
 126           { Odoc_parameter.sn_name = normal_name label ;
 127              Odoc_parameter.sn_type = t ;
 128             Odoc_parameter.sn_text = None }
 129   in
 130   List.map iter liste_param
 131
 132 (** Return true if the value is a function, i.e. has a functional type.*)
 133 let is_function v =
 134   let rec f t =
 135     match t.Types.desc with
 136       Types.Tarrow _ ->
 137         true
 138     | Types.Tlink t ->
 139         f t
 140         | _ ->
 141             false
 142       in
 143   f v.val_type
 144
 145