odoc_cross.ml: use hash tables modified on the fly to resolve

    (module | module type | exception) name aliases
- odoc_html: replace some calls to Str. by specific functions on strings


git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@6157 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

5 files changed, 144 insertions, 102 deletions

diff --git a/ocamldoc/Changes.txt b/ocamldoc/Changes.txt
index f1ba418fcb..27de36da3b 100644
--- a/ocamldoc/Changes.txt
+++ b/ocamldoc/Changes.txt
@@ -29,8 +29,9 @@ OK - new module odoc_print, will work when Format.pp_print_flush is fixed
   - odoc_html: use buffers instead of string concatenation
 OK - odoc_man: use buffers instead of string concatenation
   - odoc_latex: use buffers instead of string concatenation
-
-
+OK - odoc_cross.ml: use hash tables modified on the fly to resolve 
+    (module | module type | exception) name aliases
+OK - odoc_html: replace some calls to Str. by specific functions on strings
 ======
 
 Release 3.05 :
diff --git a/ocamldoc/odoc_cross.ml b/ocamldoc/odoc_cross.ml
index 4134ea84b8..a4d954f82f 100644
--- a/ocamldoc/odoc_cross.ml
+++ b/ocamldoc/odoc_cross.ml
@@ -68,67 +68,104 @@ module P_alias =
 (** The module used to get the aliased elements. *)
 module Search_alias = Odoc_search.Search (P_alias)
 
-let rec build_alias_list (acc_m, acc_mt, acc_ex) = function
-    [] ->
-      (acc_m, acc_mt, acc_ex)
-  | (Odoc_search.Res_module m) :: q ->
-      let new_acc_m = 
-        match m.m_kind with
-          Module_alias ma -> (m.m_name, ma.ma_name) :: acc_m
-        | _ -> acc_m
-      in
-      build_alias_list (new_acc_m, acc_mt, acc_ex) q
-  | (Odoc_search.Res_module_type mt) :: q ->
-      let new_acc_mt = 
-        match mt.mt_kind with
-          Some (Module_type_alias mta) -> (mt.mt_name, mta.mta_name) :: acc_mt
-        | _ -> acc_mt
-      in
-      build_alias_list (acc_m, new_acc_mt, acc_ex) q
-  | (Odoc_search.Res_exception e) :: q ->
-      let new_acc_ex = 
-        match e.ex_alias with
-          None -> acc_ex
-        | Some ea -> (e.ex_name, ea.ea_name) :: acc_ex
-      in
-      build_alias_list (acc_m, acc_mt, new_acc_ex) q
-  | _ :: q ->
-      build_alias_list (acc_m, acc_mt, acc_ex) q
-
-
+type alias_state =
+    Alias_resolved
+  | Alias_to_resolve
 
 (** Couples of module name aliases. *)
-let module_aliases = ref [] ;;
+let (module_aliases : (Name.t, Name.t * alias_state) Hashtbl.t) = Hashtbl.create 13 ;;
 
-(** Couples of module type name aliases. *)
-let module_type_aliases = ref [] ;;
+(** Couples of module or module type name aliases. *)
+let module_and_modtype_aliases = Hashtbl.create 13;;
 
 (** Couples of exception name aliases. *)
-let exception_aliases = ref [] ;;
+let exception_aliases = Hashtbl.create 13;;
 
-(** Retrieve the aliases for modules, module types and exceptions and put them in global variables. *)
+let rec build_alias_list = function
+    [] -> ()
+  | (Odoc_search.Res_module m) :: q ->
+      (
+       match m.m_kind with
+         Module_alias ma -> 
+	   Hashtbl.add module_aliases m.m_name (ma.ma_name, Alias_to_resolve);
+	   Hashtbl.add module_and_modtype_aliases m.m_name (ma.ma_name, Alias_to_resolve)
+       | _ -> ()
+      );
+      build_alias_list q
+  | (Odoc_search.Res_module_type mt) :: q ->
+      (
+       match mt.mt_kind with
+         Some (Module_type_alias mta) -> 
+	   Hashtbl.add module_and_modtype_aliases 
+	     mt.mt_name (mta.mta_name, Alias_to_resolve)
+       | _ -> ()
+      );
+      build_alias_list q
+  | (Odoc_search.Res_exception e) :: q ->
+      (
+       match e.ex_alias with
+         None -> ()
+       | Some ea -> 
+	   Hashtbl.add exception_aliases 
+	     e.ex_name (ea.ea_name,Alias_to_resolve)
+      );
+      build_alias_list q
+  | _ :: q ->
+      build_alias_list q
+
+(** Retrieve the aliases for modules, module types and exceptions 
+   and put them in global hash tables. *)
 let get_alias_names module_list =
-  let (alias_m, alias_mt, alias_ex) = 
-    build_alias_list
-      ([], [], []) 
-      (Search_alias.search module_list 0)
-  in
-  module_aliases := alias_m ;
-  module_type_aliases := alias_mt ;
-  exception_aliases := alias_ex 
+  Hashtbl.clear module_aliases;
+  Hashtbl.clear module_and_modtype_aliases;
+  Hashtbl.clear exception_aliases;
+  build_alias_list (Search_alias.search module_list 0)
   
+exception Found of string
+let name_alias =
+  let rec f t name =
+    try
+      match Hashtbl.find t name with
+	(s, Alias_resolved) -> s
+      |	(s, Alias_to_resolve) -> f t s
+    with
+      Not_found ->
+	try
+	  Hashtbl.iter
+	    (fun n2 (n3, _) ->
+	      if Name.prefix n2 name then
+		let ln2 = String.length n2 in
+		let s = n3^(String.sub name ln2 ((String.length name) - ln2)) in
+		raise (Found s)
+	    )
+	    t ;
+	  Hashtbl.replace t name (name, Alias_resolved);
+	  name
+	with
+	  Found s ->
+	    let s2 = f t s in
+	    Hashtbl.replace t s2 (s2, Alias_resolved);
+	    s2
+  in
+  fun name alias_tbl ->
+    f alias_tbl name
+
 
 (** The module with lookup predicates. *)
 module P_lookup = 
   struct
     type t = Name.t
-    let p_module m name = (Name.prefix m.m_name name, m.m_name = (Name.name_alias name !module_aliases))
-    let p_module_type mt name = (Name.prefix mt.mt_name name, mt.mt_name = (Name.name_alias name (!module_aliases @ !module_type_aliases)))
-    let p_class c name = (false, c.cl_name = (Name.name_alias name (!module_aliases @ !module_type_aliases)))
-    let p_class_type ct name = (false, ct.clt_name = (Name.name_alias name (!module_aliases @ !module_type_aliases)))
+    let p_module m name = 
+      (Name.prefix m.m_name name, m.m_name = (name_alias name module_aliases))
+    let p_module_type mt name = 
+      (Name.prefix mt.mt_name name, 
+       mt.mt_name = (name_alias name module_and_modtype_aliases))
+    let p_class c name = (false, c.cl_name = (name_alias name module_and_modtype_aliases))
+    let p_class_type ct name = 
+      (false, ct.clt_name = (name_alias name module_and_modtype_aliases))
     let p_value v name = false
     let p_type t name = false
-    let p_exception e name = e.ex_name = (Name.name_alias name !exception_aliases)
+    let p_exception e name = e.ex_name = (name_alias name exception_aliases)
     let p_attribute a name = false
     let p_method m name = false
     let p_section s name = false
diff --git a/ocamldoc/odoc_html.ml b/ocamldoc/odoc_html.ml
index ffaf4cf2de..dcc3ccd802 100644
--- a/ocamldoc/odoc_html.ml
+++ b/ocamldoc/odoc_html.ml
@@ -169,6 +169,8 @@ module Naming =
       f
   end
 
+module StringSet = Set.Make (struct type t = string let compare = compare end)
+
 (** A class with a method to colorize a string which represents OCaml code. *)
 class ocaml_code =
   object(self)
@@ -577,6 +579,25 @@ let print_concat b sep f =
   in
   iter
 
+let newline_to_indented_br s =
+  let len = String.length s in
+  let b = Buffer.create len in
+  for i = 0 to len - 1 do
+    match s.[i] with
+      '\n' -> Buffer.add_string b "<br>     "
+    | c -> Buffer.add_char b c
+  done;
+  Buffer.contents b
+
+let remove_last_newline s =
+  let len = String.length s in
+  if len <= 0 then
+    s
+  else
+    match s.[len-1] with
+      '\n' -> String.sub s 0 (len-1)
+    | _ -> s
+
 (** This class is used to create objects which can generate a simple html documentation. *)
 class html =
   object (self)
@@ -660,17 +681,17 @@ class html =
     (** The known types names. 
        Used to know if we must create a link to a type
        when printing a type. *)
-    val mutable known_types_names = []
+    val mutable known_types_names = StringSet.empty
 
     (** The known class and class type names. 
        Used to know if we must create a link to a class 
        or class type or not when printing a type. *)
-    val mutable known_classes_names = []
+    val mutable known_classes_names = StringSet.empty
 
     (** The known modules and module types names. 
        Used to know if we must create a link to a type or not
        when printing a module type. *)
-    val mutable known_modules_names = []
+    val mutable known_modules_names = StringSet.empty
 
     (** The main file. *)
     val mutable index = "index.html"
@@ -854,6 +875,7 @@ class html =
       print_lines "Section" section_titles ;
       print_lines "Subsection" subsection_titles 
 
+
     (** Html code for navigation bar. 
        @param pre optional name for optional previous module/class 
        @param post optional name for optional next module/class
@@ -919,12 +941,12 @@ class html =
             match_s
             rel
         in
-        if List.mem match_s known_types_names then
+        if StringSet.mem match_s known_types_names then
            "<a href=\""^(Naming.complete_target Naming.mark_type match_s)^"\">"^
            s_final^
            "</a>"
         else
-          if List.mem match_s known_classes_names then
+          if StringSet.mem match_s known_classes_names then
             let (html_file, _) = Naming.html_files match_s in
             "<a href=\""^html_file^"\">"^s_final^"</a>"
           else
@@ -942,7 +964,7 @@ class html =
     method create_fully_qualified_module_idents_links m_name s =
       let f str_t = 
         let match_s = Str.matched_string str_t in
-        if List.mem match_s known_modules_names then
+        if StringSet.mem match_s known_modules_names then
           let (html_file, _) = Naming.html_files match_s in
           "<a href=\""^html_file^"\">"^(Name.get_relative m_name match_s)^"</a>"
         else
@@ -957,20 +979,16 @@ class html =
 
     (** Print html code to display a [Types.type_expr]. *)
     method html_of_type_expr b m_name t =
-      let s = String.concat "\n"
-          (Str.split (Str.regexp "\n") (Odoc_info.string_of_type_expr t))
-      in
-      let s2 = Str.global_replace (Str.regexp "\n") "<br>     " s in
+      let s = remove_last_newline (Odoc_info.string_of_type_expr t) in
+      let s2 = newline_to_indented_br s in
       bs b "<code class=\"type\">";
       bs b (self#create_fully_qualified_idents_links m_name s2);
       bs b "</code>"
 
     (** Print html code to display a [Types.class_type].*)
     method html_of_class_type_expr b m_name t =
-      let s = String.concat "\n"
-          (Str.split (Str.regexp "\n") (Odoc_info.string_of_class_type t))
-      in
-      let s2 = Str.global_replace (Str.regexp "\n") "<br>     " s in
+      let s = remove_last_newline (Odoc_info.string_of_class_type t) in
+      let s2 = newline_to_indented_br s in
       bs b "<code class=\"type\">";
       bs b (self#create_fully_qualified_idents_links m_name s2);
       bs b "</code>"
@@ -980,7 +998,7 @@ class html =
       print_DEBUG "html#html_of_type_expr_list";
       let s = Odoc_info.string_of_type_list sep l in
       print_DEBUG "html#html_of_type_expr_list: 1";
-      let s2 = Str.global_replace (Str.regexp "\n") "<br>     " s in
+      let s2 = newline_to_indented_br s in
       print_DEBUG "html#html_of_type_expr_list: 2";
       bs b "<code class=\"type\">";
       bs b (self#create_fully_qualified_idents_links m_name s2);
@@ -990,7 +1008,7 @@ class html =
        of a class of class type. *)
     method html_of_class_type_param_expr_list b m_name l =
       let s = Odoc_info.string_of_class_type_param_list l in
-      let s2 = Str.global_replace (Str.regexp "\n") "<br>       " s in
+      let s2 = newline_to_indented_br s in
       bs b "<code class=\"type\">";
       bs b (self#create_fully_qualified_idents_links m_name s2);
       bs b "</code>"
@@ -998,32 +1016,26 @@ class html =
     (** Print html code to display a list of type parameters for the given type.*)
     method html_of_type_expr_param_list b m_name t =
       let s = Odoc_info.string_of_type_param_list t in
-      let s2 = Str.global_replace (Str.regexp "\n") "<br>     " s in
+      let s2 = newline_to_indented_br s in
       bs b "<code class=\"type\">";
       bs b (self#create_fully_qualified_idents_links m_name s2);
       bs b "</code>"
 
     (** Print html code to display a [Types.module_type]. *)
     method html_of_module_type b m_name t =
-      let s = String.concat "\n"
-          (Str.split (Str.regexp "\n") (Odoc_info.string_of_module_type t))
-      in
+      let s = remove_last_newline (Odoc_info.string_of_module_type t) in
       bs b "<code class=\"type\">";
       bs b (self#create_fully_qualified_module_idents_links m_name s);
       bs b "</code>"
         
     (** Generate a file containing the module type in the given file name. *)
     method output_module_type in_title file mtyp =
-      let s = String.concat "\n"
-          (Str.split (Str.regexp "\n") (Odoc_info.string_of_module_type ~complete: true mtyp))
-      in
+      let s = remove_last_newline (Odoc_info.string_of_module_type ~complete: true mtyp) in
       self#output_code in_title file s
 
     (** Generate a file containing the class type in the given file name. *)
     method output_class_type in_title file ctyp =
-      let s = String.concat "\n"
-          (Str.split (Str.regexp "\n") (Odoc_info.string_of_class_type ~complete: true ctyp))
-      in
+      let s = remove_last_newline(Odoc_info.string_of_class_type ~complete: true ctyp) in
       self#output_code in_title file s
 
 
@@ -2158,20 +2170,33 @@ class html =
       self#prepare_header module_list ;
       (* Get the names of all known types. *)
       let types = Odoc_info.Search.types module_list in
-      let type_names = List.map (fun t -> t.ty_name) types in
-      known_types_names <- type_names ;
+      known_types_names <- 
+	List.fold_left 
+	  (fun acc t -> StringSet.add t.ty_name acc) 
+	  known_types_names
+	  types ;
       (* Get the names of all class and class types. *)
       let classes = Odoc_info.Search.classes module_list in
       let class_types = Odoc_info.Search.class_types module_list in
-      let class_names = List.map (fun c -> c.cl_name) classes in
-      let class_type_names = List.map (fun ct -> ct.clt_name) class_types in
-      known_classes_names <- class_names @ class_type_names ;
+      known_classes_names <- 
+	List.fold_left
+	  (fun acc c -> StringSet.add c.cl_name acc) 
+	  known_classes_names 
+	  classes ;
+      known_classes_names <-  
+	List.fold_left
+	  (fun acc ct -> StringSet.add ct.clt_name acc) 
+	  known_classes_names
+	  class_types ;
       (* Get the names of all known modules and module types. *)
       let module_types = Odoc_info.Search.module_types module_list in
       let modules = Odoc_info.Search.modules module_list in
       let module_type_names = List.map (fun mt -> mt.mt_name) module_types in
-      let module_names = List.map (fun m -> m.m_name) modules in
-      known_modules_names <- module_type_names @ module_names ;
+      known_modules_names <-
+	List.fold_left 
+	  (fun acc m -> StringSet.add m.m_name acc) 
+	  known_modules_names 
+	  modules ;
       (* generate html for each module *)
       if not !Args.index_only then 
         self#generate_elements self#generate_for_module module_list ;
diff --git a/ocamldoc/odoc_name.ml b/ocamldoc/odoc_name.ml
index ef01ec4a3f..da7fb84002 100644
--- a/ocamldoc/odoc_name.ml
+++ b/ocamldoc/odoc_name.ml
@@ -142,21 +142,3 @@ let to_path n =
 
 let from_longident longident = String.concat "." (Longident.flatten longident)
 
-let name_alias name cpl_aliases =
-  let rec f n1 = function
-      [] -> raise Not_found
-    | (n2, n3) :: q ->
-        if n2 = n1 then 
-          n3
-        else
-          if prefix n2 n1 then
-            let ln2 = String.length n2 in
-            n3^(String.sub n1 ln2 ((String.length n1) - ln2))
-          else
-            f n1 q
-  in
-  let rec iter n =
-    try iter (f n cpl_aliases)
-    with Not_found -> n
-  in
-  iter name
diff --git a/ocamldoc/odoc_name.mli b/ocamldoc/odoc_name.mli
index b0a5d55440..b67947fd16 100644
--- a/ocamldoc/odoc_name.mli
+++ b/ocamldoc/odoc_name.mli
@@ -61,6 +61,3 @@ val to_path : t -> Path.t
 (** Get a name from a [Longident.t].*)
 val from_longident : Longident.t -> t
 
-(** This function takes a name and a list of name aliases and returns the name
-   after substitution using the aliases. *)
-val name_alias : t -> (t * t) list -> t