1(**************************************************************************)
2(*                                                                        *)
3(*                                 OCaml                                  *)
4(*                                                                        *)
5(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
6(*                                                                        *)
7(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
8(*     en Automatique.                                                    *)
9(*                                                                        *)
10(*   All rights reserved.  This file is distributed under the terms of    *)
11(*   the GNU Lesser General Public License version 2.1, with the          *)
12(*   special exception on linking described in the file LICENSE.          *)
13(*                                                                        *)
14(**************************************************************************)
15
16(** Analysis of comments. *)
17
18open Odoc_types
19
20let print_DEBUG s = print_string s ; print_newline ();;
21
22(** This variable contains the regular expression representing a blank but not a '\n'.*)
23let simple_blank = "[ \013\009\012]"
24
25module type Texter =
26    sig
27      (** Return a text structure from a string. *)
28      val text_of_string : string -> text
29    end
30
31module Info_retriever =
32  functor (MyTexter : Texter) ->
33  struct
34    let create_see _file s =
35      try
36        let lexbuf = Lexing.from_string s in
37        let (see_ref, s) = Odoc_parser.see_info Odoc_see_lexer.main lexbuf in
38        (see_ref, MyTexter.text_of_string s)
39      with
40      | Odoc_text.Text_syntax (l, c, s) ->
41          raise (Failure (Odoc_messages.text_parse_error l c s))
42      | _ ->
43          raise (Failure ("Unknown error while parsing @see tag: "^s))
44
45    let retrieve_info fun_lex file (s : string) =
46      try
47        Odoc_comments_global.init ();
48        Odoc_lexer.comments_level := 0;
49        let lexbuf = Lexing.from_string s in
50        match Odoc_parser.main fun_lex lexbuf with
51          None ->
52            (0, None)
53        | Some (desc, remain_opt) ->
54            let mem_nb_chars = !Odoc_comments_global.nb_chars in
55            begin match remain_opt with
56                None ->
57                  ()
58              | Some s ->
59                  (*DEBUG*)print_string ("remain: "^s); print_newline();
60                  let lexbuf2 = Lexing.from_string s in
61                  Odoc_parser.info_part2 Odoc_lexer.elements lexbuf2
62            end;
63            (mem_nb_chars,
64             Some
65               {
66                 i_desc = (match desc with "" -> None | _ -> Some (MyTexter.text_of_string desc));
67                 i_authors = !Odoc_comments_global.authors;
68                 i_version = !Odoc_comments_global.version;
69                 i_sees = (List.map (create_see file) !Odoc_comments_global.sees) ;
70                 i_since = !Odoc_comments_global.since;
71                 i_before = Odoc_merge.merge_before_tags
72                     (List.map (fun (n, s) ->
73                         (n, MyTexter.text_of_string s)) !Odoc_comments_global.before)
74                   ;
75                 i_deprecated =
76                 (match !Odoc_comments_global.deprecated with
77                   None -> None | Some s -> Some (MyTexter.text_of_string s));
78                 i_params =
79                 (List.map (fun (n, s) ->
80                   (n, MyTexter.text_of_string s)) !Odoc_comments_global.params);
81                 i_raised_exceptions =
82                 (List.map (fun (n, s) ->
83                   (n, MyTexter.text_of_string s)) !Odoc_comments_global.raised_exceptions);
84                 i_return_value =
85                 (match !Odoc_comments_global.return_value with
86                   None -> None | Some s -> Some (MyTexter.text_of_string s)) ;
87                 i_custom = (List.map
88                               (fun (tag, s) -> (tag, MyTexter.text_of_string s))
89                               !Odoc_comments_global.customs)
90               }
91            )
92      with e ->
93        let (l, c, message) = match e with
94          | Failure s -> (!Odoc_lexer.line_number + 1, 0, s)
95          | Odoc_text.Text_syntax (l, c, s) -> (l, c, Odoc_messages.text_parse_error l c s)
96          | _other -> (0, 0, Odoc_messages.parse_error)
97        in begin
98          incr Odoc_global.errors;
99          prerr_endline (Odoc_messages.error_location file l c ^ message);
100          (0, None)
101        end
102
103
104    (** Return true if the given string contains a blank line. *)
105    let blank_line s =
106      try
107        let _ = Str.search_forward (Str.regexp ("['\n']"^simple_blank^"*['\n']")) s 0 in
108        (* a blank line was before the comment *)
109        true
110      with
111        Not_found ->
112          false
113
114    let retrieve_info_special file (s : string) =
115      retrieve_info Odoc_lexer.main file s
116
117    let retrieve_info_simple _file (s : string) =
118      Odoc_comments_global.init ();
119      Odoc_lexer.comments_level := 0;
120      let lexbuf = Lexing.from_string s in
121      match Odoc_parser.main Odoc_lexer.simple lexbuf with
122        None ->
123          (0, None)
124      | Some _ ->
125          (!Odoc_comments_global.nb_chars, Some Odoc_types.dummy_info)
126
127    (** Return true if the given string contains a blank line outside a simple comment. *)
128    let blank_line_outside_simple file s =
129      let rec iter s2 =
130        match retrieve_info_simple file s2 with
131          (_, None) ->
132            blank_line s2
133        | (len, Some _) ->
134            try
135              let pos = Str.search_forward (Str.regexp_string "(*") s2 0 in
136              let s_before = String.sub s2 0 pos in
137              let s_after = String.sub s2 len ((String.length s2) - len) in
138              (blank_line s_before) || (iter s_after)
139            with
140              Not_found ->
141                (* we shouldn't get here *)
142                false
143      in
144      iter s
145
146    let all_special file s =
147      print_DEBUG ("all_special: "^s);
148      let rec iter acc n s2 =
149        match retrieve_info_special file s2 with
150          (_, None) ->
151            (n, acc)
152        | (n2, Some i) ->
153            print_DEBUG ("all_special: avant String.sub new_s="^s2);
154            print_DEBUG ("n2="^(string_of_int n2)) ;
155            print_DEBUG ("len(s2)="^(string_of_int (String.length s2))) ;
156            let new_s = String.sub s2 n2 ((String.length s2) - n2) in
157            print_DEBUG ("all_special: apres String.sub new_s="^new_s);
158            iter (acc @ [i]) (n + n2) new_s
159      in
160      let res = iter [] 0 s in
161      print_DEBUG ("all_special: end");
162      res
163
164    let just_after_special file s =
165      print_DEBUG ("just_after_special: "^s);
166      let res = match retrieve_info_special file s with
167        (_, None) ->
168          (0, None)
169      | (len, Some d) ->
170          (* we must not have a simple comment or a blank line before. *)
171          match retrieve_info_simple file (String.sub s 0 len) with
172            (_, None) ->
173              (
174               try
175                 (* if the special comment is the stop comment (**/**),
176                    then we must not associate it. *)
177                 let pos = Str.search_forward (Str.regexp_string "(**") s 0 in
178                 if blank_line (String.sub s 0 pos) ||
179                   d.Odoc_types.i_desc = Some [Odoc_types.Raw "/*"]
180                 then
181                   (0, None)
182                 else
183                   (len, Some d)
184               with
185                 Not_found ->
186                   (* should not occur *)
187                   (0, None)
188              )
189          | (_, Some _) ->
190              (0, None)
191      in
192      print_DEBUG ("just_after_special:end");
193      res
194
195    let first_special file s =
196      retrieve_info_special file s
197
198    let get_comments f_create_ele file s =
199      let (assoc_com, ele_coms) =
200        (* get the comments *)
201        let (len, special_coms) =  all_special file s in
202        (* if there is no blank line after the special comments, and
203           if the last special comment is not the stop special comment, then the
204           last special comments must be associated to the element. *)
205        match List.rev special_coms with
206          [] ->
207            (None, [])
208        |  h :: q ->
209            if (blank_line_outside_simple file
210                  (String.sub s len ((String.length s) - len)) )
211                || h.Odoc_types.i_desc = Some [Odoc_types.Raw "/*"]
212            then
213              (None, special_coms)
214            else
215              (Some h, List.rev q)
216      in
217      let ele_comments =
218        List.fold_left
219          (fun acc -> fun sc ->
220            match sc.Odoc_types.i_desc with
221              None ->
222                acc
223            | Some t ->
224                acc @ [f_create_ele t])
225          []
226          ele_coms
227      in
228      (assoc_com, ele_comments)
229  end
230
231module Basic_info_retriever = Info_retriever (Odoc_text.Texter)
232
233let info_of_string s =
234  let dummy =
235    {
236      i_desc = None ;
237      i_authors = [] ;
238      i_version = None ;
239      i_sees = [] ;
240      i_since = None ;
241      i_before = [] ;
242      i_deprecated = None ;
243      i_params = [] ;
244      i_raised_exceptions = [] ;
245      i_return_value = None ;
246      i_custom = [] ;
247    }
248  in
249  let s2 = Printf.sprintf "(** %s *)" s in
250  let (_, i_opt) = Basic_info_retriever.first_special "-" s2 in
251  match i_opt with
252    None -> dummy
253  | Some i -> i
254
255let info_of_comment_file modlist f =
256  try
257    let s = Odoc_misc.input_file_as_string f in
258    let i = info_of_string s in
259    Odoc_cross.assoc_comments_info "" modlist i
260  with
261    Sys_error s ->
262      failwith s
263