Eliminating a potentially quadratic behaviour in Require, by using maps

instead of lists to test if a library has already been encountered.

1 files changed, 19 insertions, 14 deletions

diff --git a/library/library.ml b/library/library.ml
index d48f3b525..d2d2d72e4 100644
--- a/library/library.ml
+++ b/library/library.ml
@@ -474,12 +474,14 @@ let intern_from_file f =
       add_univ_table lmd.md_name (Fetched utab);
       mk_library lmd (Dvo_or_vi digest_lmd) Univ.ContextSet.empty
 
-let rec intern_library needed (dir, f) =
+module DPMap = Map.Make(DirPath)
+
+let rec intern_library (needed, contents) (dir, f) =
   (* Look if in the current logical environment *)
-  try find_library dir, needed
+  try find_library dir, (needed, contents)
   with Not_found ->
   (* Look if already listed and consequently its dependencies too *)
-  try List.assoc_f DirPath.equal dir needed, needed
+  try DPMap.find dir contents, (needed, contents)
   with Not_found ->
   (* [dir] is an absolute name which matches [f] which must be in loadpath *)
   let m = intern_from_file f in
@@ -488,21 +490,23 @@ let rec intern_library needed (dir, f) =
       (str ("The file " ^ f ^ " contains library") ++ spc () ++
        pr_dirpath m.library_name ++ spc () ++ str "and not library" ++
        spc() ++ pr_dirpath dir);
-  m, intern_library_deps needed dir m
+  m, intern_library_deps (needed, contents) dir m
 
-and intern_library_deps needed dir m =
-  (dir,m)::Array.fold_left (intern_mandatory_library dir) needed m.library_deps
+and intern_library_deps libs dir m =
+  let needed, contents = Array.fold_left (intern_mandatory_library dir) libs m.library_deps in
+  (dir :: needed, DPMap.add dir m contents )
 
-and intern_mandatory_library caller needed (dir,d) =
-  let m,needed = intern_library needed (try_locate_absolute_library dir) in
+and intern_mandatory_library caller libs (dir,d) =
+  let m, libs = intern_library libs (try_locate_absolute_library dir) in
   if not (Safe_typing.digest_match ~actual:m.library_digests ~required:d) then
     errorlabstrm "" (strbrk ("Compiled library "^ DirPath.to_string caller ^
       ".vo makes inconsistent assumptions over library " ^
       DirPath.to_string dir));
-  needed
+  libs
 
-let rec_intern_library needed mref =
-  let _,needed = intern_library needed mref in needed
+let rec_intern_library libs mref =
+  let _, libs = intern_library libs mref in
+  libs
 
 let check_library_short_name f dir = function
   | Some id when not (Id.equal id (snd (split_dirpath dir))) ->
@@ -527,7 +531,8 @@ let rec_intern_by_filename_only id f =
       m.library_name, []
     end
  else
-    let needed = intern_library_deps [] m.library_name m in
+    let needed, contents = intern_library_deps ([], DPMap.empty) m.library_name m in
+    let needed = List.map (fun dir -> dir, DPMap.find dir contents) needed in
     m.library_name, needed
 
 let rec_intern_library_from_file idopt f =
@@ -599,8 +604,8 @@ let in_require : require_obj -> obj =
 let (f_xml_require, xml_require) = Hook.make ~default:ignore ()
 
 let require_library_from_dirpath modrefl export =
-  let needed = List.fold_left rec_intern_library [] modrefl in
-  let needed = List.rev_map snd needed in
+  let needed, contents = List.fold_left rec_intern_library ([], DPMap.empty) modrefl in
+  let needed = List.rev_map (fun dir -> DPMap.find dir contents) needed in
   let modrefl = List.map fst modrefl in
     if Lib.is_module_or_modtype () then
       begin