ocamldoc/odoc_str.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$ *)
  13
  14 (** The functions to get a string from different kinds of elements (types, modules, ...). *)
  15
  16 module Name = Odoc_name
  17
  18 let string_of_variance t (co,cn) =
  19   if t.Odoc_type.ty_kind = Odoc_type.Type_abstract &&
  20     t.Odoc_type.ty_manifest = None
  21   then
  22     match (co, cn) with
  23       (true, false) -> "+"
  24     | (false, true) -> "-"
  25     | _ -> ""
  26   else
  27     ""
  28 let rec is_arrow_type t =
  29   match t.Types.desc with
  30     Types.Tarrow _ -> true
  31   | Types.Tlink t2 | Types.Tsubst t2 -> is_arrow_type t2
  32   | Types.Ttuple _
  33   | Types.Tconstr _
  34   | Types.Tvar | Types.Tunivar | Types.Tobject _ | Types.Tpoly _
  35   | Types.Tfield _ | Types.Tnil | Types.Tvariant _ -> false
  36
  37 let raw_string_of_type_list sep type_list =
  38   let buf = Buffer.create 256 in
  39   let fmt = Format.formatter_of_buffer buf in
  40   let rec need_parent t =
  41     match t.Types.desc with
  42       Types.Tarrow _ | Types.Ttuple _ -> true
  43     | Types.Tlink t2 | Types.Tsubst t2 -> need_parent t2
  44     | Types.Tconstr _ ->
  45         false
  46     | Types.Tvar | Types.Tunivar | Types.Tobject _ | Types.Tpoly _
  47     | Types.Tfield _ | Types.Tnil | Types.Tvariant _ -> false
  48   in
  49   let print_one_type variance t =
  50     Printtyp.mark_loops t;
  51     if need_parent t then
  52       (
  53        Format.fprintf fmt "(%s" variance;
  54        Printtyp.type_scheme_max ~b_reset_names: false fmt t;
  55        Format.fprintf fmt ")"
  56       )
  57     else
  58       (
  59        Format.fprintf fmt "%s" variance;
  60        Printtyp.type_scheme_max ~b_reset_names: false fmt t
  61       )
  62   in
  63   begin match type_list with
  64     [] -> ()
  65   | [(variance, ty)] -> print_one_type variance ty
  66   | (variance, ty) :: tyl ->
  67       Format.fprintf fmt "@[<hov 2>";
  68       print_one_type variance ty;
  69       List.iter
  70         (fun (variance, t) ->
  71           Format.fprintf fmt "@,%s" sep;
  72           print_one_type variance t
  73         )
  74         tyl;
  75       Format.fprintf fmt "@]"
  76   end;
  77   Format.pp_print_flush fmt ();
  78   Buffer.contents buf
  79
  80 let string_of_type_list ?par sep type_list =
  81   let par =
  82     match par with
  83     | Some b -> b
  84     | None ->
  85         match type_list with
  86           [] | [_] -> false
  87         | _ -> true
  88   in
  89   Printf.sprintf "%s%s%s"
  90     (if par then "(" else "")
  91     (raw_string_of_type_list sep (List.map (fun t -> ("", t)) type_list))
  92     (if par then ")" else "")
  93
  94 let string_of_type_param_list t =
  95   let par =
  96     match t.Odoc_type.ty_parameters with
  97       [] | [_] -> false
  98     | _ -> true
  99   in
 100   Printf.sprintf "%s%s%s"
 101     (if par then "(" else "")
 102     (raw_string_of_type_list ", "
 103        (List.map
 104           (fun (typ, co, cn) -> (string_of_variance t (co, cn), typ))
 105           t.Odoc_type.ty_parameters
 106        )
 107     )
 108     (if par then ")" else "")
 109
 110 let string_of_class_type_param_list l =
 111   let par =
 112     match l with
 113       [] | [_] -> false
 114     | _ -> true
 115   in
 116   Printf.sprintf "%s%s%s"
 117     (if par then "[" else "")
 118     (raw_string_of_type_list ", "
 119        (List.map
 120           (fun typ -> ("", typ))
 121           l
 122        )
 123     )
 124     (if par then "]" else "")
 125
 126 let string_of_class_params c =
 127   let b = Buffer.create 256 in
 128   let rec iter = function
 129       Types.Tcty_fun (label, t, ctype) ->
 130         let parent = is_arrow_type t in
 131         Printf.bprintf b "%s%s%s%s -> "
 132           (
 133            match label with
 134              "" -> ""
 135            | s -> s^":"
 136           )
 137           (if parent then "(" else "")
 138           (Odoc_print.string_of_type_expr
 139              (if Odoc_misc.is_optional label then
 140                Odoc_misc.remove_option t
 141              else
 142                t
 143              )
 144           )
 145           (if parent then ")" else "");
 146         iter ctype
 147     | Types.Tcty_signature _
 148     | Types.Tcty_constr _ -> ()
 149   in
 150   iter c.Odoc_class.cl_type;
 151   Buffer.contents b
 152
 153 let string_of_type t =
 154   let module M = Odoc_type in
 155   "type "^
 156   (String.concat ""
 157      (List.map
 158         (fun (p, co, cn) ->
 159           (string_of_variance t (co, cn))^
 160           (Odoc_print.string_of_type_expr p)^" "
 161         )
 162         t.M.ty_parameters
 163      )
 164   )^
 165   (Name.simple t.M.ty_name)^" "^
 166   (match t.M.ty_manifest with
 167     None -> ""
 168   | Some typ -> "= "^(Odoc_print.string_of_type_expr typ)^" "
 169   )^
 170   (match t.M.ty_kind with
 171     M.Type_abstract ->
 172       ""
 173   | M.Type_variant (l, priv) ->
 174       "="^(if priv then " private" else "")^"\n"^
 175       (String.concat ""
 176          (List.map
 177             (fun cons ->
 178               "  | "^cons.M.vc_name^
 179               (match cons.M.vc_args with
 180                 [] -> ""
 181               | l ->
 182                   " of "^(String.concat " * "
 183                             (List.map (fun t -> "("^(Odoc_print.string_of_type_expr t)^")") l))
 184               )^
 185               (match cons.M.vc_text with
 186                 None ->
 187                   ""
 188               | Some t ->
 189                   "(* "^(Odoc_misc.string_of_text t)^" *)"
 190               )^"\n"
 191             )
 192             l
 193          )
 194       )
 195   | M.Type_record (l, priv) ->
 196       "= "^(if priv then "private " else "")^"{\n"^
 197       (String.concat ""
 198          (List.map
 199             (fun record ->
 200               "   "^(if record.M.rf_mutable then "mutable " else "")^
 201               record.M.rf_name^" : "^(Odoc_print.string_of_type_expr record.M.rf_type)^";"^
 202               (match record.M.rf_text with
 203                 None ->
 204                   ""
 205               | Some t ->
 206                   "(* "^(Odoc_misc.string_of_text t)^" *)"
 207               )^"\n"
 208             )
 209             l
 210          )
 211       )^
 212       "}\n"
 213   )^
 214   (match t.M.ty_info with
 215     None -> ""
 216   | Some info -> Odoc_misc.string_of_info info)
 217
 218 let string_of_exception e =
 219   let module M = Odoc_exception in
 220   "exception "^(Name.simple e.M.ex_name)^
 221   (match e.M.ex_args with
 222     [] -> ""
 223   | _ ->" : "^
 224       (String.concat " -> "
 225          (List.map (fun t -> "("^(Odoc_print.string_of_type_expr t)^")") e.M.ex_args)
 226       )
 227   )^
 228   (match e.M.ex_alias with
 229     None -> ""
 230   | Some ea ->
 231       " = "^
 232       (match ea.M.ea_ex with
 233         None -> ea.M.ea_name
 234       | Some e2 -> e2.M.ex_name
 235       )
 236   )^"\n"^
 237   (match e.M.ex_info with
 238     None -> ""
 239   | Some i -> Odoc_misc.string_of_info i)
 240
 241 let string_of_value v =
 242   let module M = Odoc_value in
 243   "val "^(Name.simple v.M.val_name)^" : "^
 244   (Odoc_print.string_of_type_expr v.M.val_type)^"\n"^
 245   (match v.M.val_info with
 246     None -> ""
 247   | Some i -> Odoc_misc.string_of_info i)
 248
 249 let string_of_attribute a =
 250   let module M = Odoc_value in
 251   "val "^
 252   (if a.M.att_mutable then Odoc_messages.mutab^" " else "")^
 253   (Name.simple a.M.att_value.M.val_name)^" : "^
 254   (Odoc_print.string_of_type_expr a.M.att_value.M.val_type)^"\n"^
 255   (match a.M.att_value.M.val_info with
 256     None -> ""
 257   | Some i -> Odoc_misc.string_of_info i)
 258
 259 let string_of_method m =
 260   let module M = Odoc_value in
 261   "method "^
 262   (if m.M.met_private then Odoc_messages.privat^" " else "")^
 263   (Name.simple m.M.met_value.M.val_name)^" : "^
 264   (Odoc_print.string_of_type_expr m.M.met_value.M.val_type)^"\n"^
 265   (match m.M.met_value.M.val_info with
 266     None -> ""
 267   | Some i -> Odoc_misc.string_of_info i)
 268
 269 (* eof $Id$ *)