From 064be83a050015ec3897867ca307ef494de30e67 Mon Sep 17 00:00:00 2001 From: Pierre-Marie Pédrot Date: Sun, 11 May 2014 16:07:45 +0200 Subject: Eliminating a potentially quadratic behaviour in Require, by using maps instead of lists to test if a library has already been encountered. --- library/library.ml | 33 +++++++++++++++++++-------------- 1 file changed, 19 insertions(+), 14 deletions(-) (limited to 'library/library.ml') 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 -- cgit v1.2.3