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