ocamldoc/odoc_comments.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 (** Analysis of comments. *)
  15
  16 open Odoc_types
  17
  18 let print_DEBUG s = print_string s ; print_newline ();;
  19
  20 (** This variable contains the regular expression representing a blank but not a '\n'.*)
  21 let simple_blank = "[ \013\009\012]"
  22
  23 module type Texter =
  24     sig
  25       (** Return a text structure from a string. *)
  26       val text_of_string : string -> text
  27     end
  28
  29 module Info_retriever =
  30   functor (MyTexter : Texter) ->
  31   struct
  32     let create_see s =
  33       try
  34         let lexbuf = Lexing.from_string s in
  35         let (see_ref, s) = Odoc_parser.see_info Odoc_see_lexer.main lexbuf in
  36         (see_ref, MyTexter.text_of_string s)
  37       with
  38       | Odoc_text.Text_syntax (l, c, s) ->
  39           raise (Failure (Odoc_messages.text_parse_error l c s))
  40       | _ ->
  41           raise (Failure ("Erreur inconnue lors du parse de see : "^s))
  42
  43     let retrieve_info fun_lex file (s : string) =
  44       try
  45         let _ = Odoc_comments_global.init () in
  46         Odoc_lexer.comments_level := 0;
  47         let lexbuf = Lexing.from_string s in
  48         match Odoc_parser.main fun_lex lexbuf with
  49           None ->
  50             (0, None)
  51         | Some (desc, remain_opt) ->
  52             let mem_nb_chars = !Odoc_comments_global.nb_chars in
  53             let _ =
  54               match remain_opt with
  55                 None ->
  56                   ()
  57               | Some s ->
  58                   (*DEBUG*)print_string ("remain: "^s); print_newline();
  59                   let lexbuf2 = Lexing.from_string s in
  60                   Odoc_parser.info_part2 Odoc_lexer.elements lexbuf2
  61             in
  62             (mem_nb_chars,
  63              Some
  64                {
  65                  i_desc = (match desc with "" -> None | _ -> Some (MyTexter.text_of_string desc));
  66                  i_authors = !Odoc_comments_global.authors;
  67                  i_version = !Odoc_comments_global.version;
  68                  i_sees = (List.map create_see !Odoc_comments_global.sees) ;
  69                  i_since = !Odoc_comments_global.since;
  70                  i_deprecated =
  71                  (match !Odoc_comments_global.deprecated with
  72                    None -> None | Some s -> Some (MyTexter.text_of_string s));
  73                  i_params =
  74                  (List.map (fun (n, s) ->
  75                    (n, MyTexter.text_of_string s)) !Odoc_comments_global.params);
  76                  i_raised_exceptions =
  77                  (List.map (fun (n, s) ->
  78                    (n, MyTexter.text_of_string s)) !Odoc_comments_global.raised_exceptions);
  79                  i_return_value =
  80                  (match !Odoc_comments_global.return_value with
  81                    None -> None | Some s -> Some (MyTexter.text_of_string s)) ;
  82                  i_custom = (List.map
  83                                (fun (tag, s) -> (tag, MyTexter.text_of_string s))
  84                                !Odoc_comments_global.customs)
  85                }
  86             )
  87                with
  88                  Failure s ->
  89                    incr Odoc_global.errors ;
  90                    prerr_endline (file^" : "^s^"\n");
  91                    (0, None)
  92                | Odoc_text.Text_syntax (l, c, s) ->
  93                    incr Odoc_global.errors ;
  94                    prerr_endline (file^" : "^(Odoc_messages.text_parse_error l c s));
  95                    (0, None)
  96                | _ ->
  97                    incr Odoc_global.errors ;
  98                    prerr_endline (file^" : "^Odoc_messages.parse_error^"\n");
  99                    (0, None)
 100
 101     (** This function takes a string where a simple comment may has been found. It returns
 102        false if there is a blank line or the first comment is a special one, or if there is
 103        no comment if the string.*)
 104     let nothing_before_simple_comment s =
 105       (* get the position of the first "(*" *)
 106       try
 107         print_DEBUG ("comment_is_attached: "^s);
 108         let pos = Str.search_forward (Str.regexp "(\\*") s 0 in
 109         let next_char = if (String.length s) >= (pos + 1) then s.[pos + 2] else '_' in
 110         (next_char <> '*') &&
 111         (
 112          (* there is no special comment between the constructor and the coment we got *)
 113          let s2 = String.sub s 0 pos in
 114          print_DEBUG ("s2="^s2);
 115          try
 116            let _ = Str.search_forward (Str.regexp ("['\n']"^simple_blank^"*['\n']")) s2 0 in
 117            (* a blank line was before the comment *)
 118            false
 119          with
 120            Not_found ->
 121              true
 122         )
 123       with
 124         Not_found ->
 125           false
 126
 127     (** Return true if the given string contains a blank line. *)
 128     let blank_line s =
 129       try
 130         let _ = Str.search_forward (Str.regexp ("['\n']"^simple_blank^"*['\n']")) s 0 in
 131         (* a blank line was before the comment *)
 132         true
 133       with
 134         Not_found ->
 135           false
 136
 137     let retrieve_info_special file (s : string) =
 138       retrieve_info Odoc_lexer.main file s
 139
 140     let retrieve_info_simple file (s : string) =
 141       let _ = Odoc_comments_global.init () in
 142       Odoc_lexer.comments_level := 0;
 143       let lexbuf = Lexing.from_string s in
 144       match Odoc_parser.main Odoc_lexer.simple lexbuf with
 145         None ->
 146           (0, None)
 147       | Some (desc, remain_opt) ->
 148           (!Odoc_comments_global.nb_chars, Some Odoc_types.dummy_info)
 149
 150     (** Return true if the given string contains a blank line outside a simple comment. *)
 151     let blank_line_outside_simple file s =
 152       let rec iter s2 =
 153         match retrieve_info_simple file s2 with
 154           (_, None) ->
 155             blank_line s2
 156         | (len, Some _) ->
 157             try
 158               let pos = Str.search_forward (Str.regexp_string "(*") s2 0 in
 159               let s_before = String.sub s2 0 pos in
 160               let s_after = String.sub s2 len ((String.length s2) - len) in
 161               (blank_line s_before) || (iter s_after)
 162             with
 163               Not_found ->
 164                 (* we shouldn't get here *)
 165                 false
 166       in
 167       iter s
 168
 169     (** This function returns the first simple comment in
 170        the given string. If strict is [true] then no
 171        comment is returned if a blank line or a special
 172        comment is found before the simple comment. *)
 173     let retrieve_first_info_simple ?(strict=true) file (s : string) =
 174       match retrieve_info_simple file s with
 175         (_, None) ->
 176           (0, None)
 177       | (len, Some d) ->
 178           (* we check if the comment we got was really attached to the constructor,
 179              i.e. that there was no blank line or any special comment "(**" before *)
 180           if (not strict) or (nothing_before_simple_comment s) then
 181             (* ok, we attach the comment to the constructor *)
 182             (len, Some d)
 183           else
 184             (* a blank line or special comment was before the comment,
 185                so we must not attach this comment to the constructor. *)
 186             (0, None)
 187
 188     let retrieve_last_info_simple file (s : string) =
 189       print_DEBUG ("retrieve_last_info_simple:"^s);
 190       let rec f cur_len cur_d =
 191         try
 192           let s2 = String.sub s cur_len ((String.length s) - cur_len) in
 193           print_DEBUG ("retrieve_last_info_simple.f:"^s2);
 194           match retrieve_info_simple file s2 with
 195             (len, None) ->
 196               print_DEBUG "retrieve_last_info_simple: None";
 197               (cur_len + len, cur_d)
 198           | (len, Some d) ->
 199               print_DEBUG "retrieve_last_info_simple: Some";
 200               f (len + cur_len) (Some d)
 201         with
 202           _ ->
 203             print_DEBUG "retrieve_last_info_simple : Erreur String.sub";
 204             (cur_len, cur_d)
 205       in
 206       f 0 None
 207
 208     let retrieve_last_special_no_blank_after file (s : string) =
 209       print_DEBUG ("retrieve_last_special_no_blank_after:"^s);
 210       let rec f cur_len cur_d =
 211         try
 212           let s2 = String.sub s cur_len ((String.length s) - cur_len) in
 213           print_DEBUG ("retrieve_last_special_no_blank_after.f:"^s2);
 214           match retrieve_info_special file s2 with
 215             (len, None) ->
 216               print_DEBUG "retrieve_last_special_no_blank_after: None";
 217               (cur_len + len, cur_d)
 218           | (len, Some d) ->
 219               print_DEBUG "retrieve_last_special_no_blank_after: Some";
 220               f (len + cur_len) (Some d)
 221         with
 222           _ ->
 223             print_DEBUG "retrieve_last_special_no_blank_after : Erreur String.sub";
 224             (cur_len, cur_d)
 225       in
 226       f 0 None
 227
 228     let all_special file s =
 229       print_DEBUG ("all_special: "^s);
 230       let rec iter acc n s2 =
 231         match retrieve_info_special file s2 with
 232           (_, None) ->
 233             (n, acc)
 234         | (n2, Some i) ->
 235             print_DEBUG ("all_special: avant String.sub new_s="^s2);
 236             print_DEBUG ("n2="^(string_of_int n2)) ;
 237             print_DEBUG ("len(s2)="^(string_of_int (String.length s2))) ;
 238             let new_s = String.sub s2 n2 ((String.length s2) - n2) in
 239             print_DEBUG ("all_special: apres String.sub new_s="^new_s);
 240             iter (acc @ [i]) (n + n2) new_s
 241       in
 242       let res = iter [] 0 s in
 243       print_DEBUG ("all_special: end");
 244       res
 245
 246     let just_after_special file s =
 247       print_DEBUG ("just_after_special: "^s);
 248       let res = match retrieve_info_special file s with
 249         (_, None) ->
 250           (0, None)
 251       | (len, Some d) ->
 252           (* we must not have a simple comment or a blank line before. *)
 253           match retrieve_info_simple file (String.sub s 0 len) with
 254             (_, None) ->
 255               (
 256                try
 257                  (* if the special comment is the stop comment (**/**),
 258                     then we must not associate it. *)
 259                  let pos = Str.search_forward (Str.regexp_string "(**") s 0 in
 260                  if blank_line (String.sub s 0 pos) or
 261                    d.Odoc_types.i_desc = Some [Odoc_types.Raw "/*"]
 262                  then
 263                    (0, None)
 264                  else
 265                    (len, Some d)
 266                with
 267                  Not_found ->
 268                    (* should not occur *)
 269                    (0, None)
 270               )
 271           | (len2, Some d2) ->
 272               (0, None)
 273       in
 274       print_DEBUG ("just_after_special:end");
 275       res
 276
 277     let first_special file s =
 278       retrieve_info_special file s
 279
 280     let get_comments f_create_ele file s =
 281       let (assoc_com, ele_coms) =
 282         (* get the comments *)
 283         let (len, special_coms) =  all_special file s in
 284         (* if there is no blank line after the special comments, and
 285            if the last special comment is not the stop special comment, then the
 286            last special comments must be associated to the element. *)
 287         match List.rev special_coms with
 288           [] ->
 289             (None, [])
 290         |  h :: q ->
 291             if (blank_line_outside_simple file
 292                   (String.sub s len ((String.length s) - len)) )
 293                 or h.Odoc_types.i_desc = Some [Odoc_types.Raw "/*"]
 294             then
 295               (None, special_coms)
 296             else
 297               (Some h, List.rev q)
 298       in
 299       let ele_comments =
 300         List.fold_left
 301           (fun acc -> fun sc ->
 302             match sc.Odoc_types.i_desc with
 303               None ->
 304                 acc
 305             | Some t ->
 306                 acc @ [f_create_ele t])
 307           []
 308           ele_coms
 309       in
 310       (assoc_com, ele_comments)
 311   end
 312
 313 module Basic_info_retriever = Info_retriever (Odoc_text.Texter)
 314
 315 let info_of_string s =
 316   let dummy =
 317     {
 318       i_desc = None ;
 319       i_authors = [] ;
 320       i_version = None ;
 321       i_sees = [] ;
 322       i_since = None ;
 323       i_deprecated = None ;
 324       i_params = [] ;
 325       i_raised_exceptions = [] ;
 326       i_return_value = None ;
 327       i_custom = [] ;
 328     }
 329   in
 330   let s2 = Printf.sprintf "(** %s *)" s in
 331   let (_, i_opt) = Basic_info_retriever.first_special "-" s2 in
 332   match i_opt with
 333     None -> dummy
 334   | Some i -> i
 335
 336 let info_of_comment_file modlist f =
 337   try
 338     let s = Odoc_misc.input_file_as_string f in
 339     let i = info_of_string s in
 340     Odoc_cross.assoc_comments_info "" modlist i
 341   with
 342     Sys_error s ->
 343       failwith s