Move the From logic to Loadpath.expand_path.

3 files changed, 13 insertions, 22 deletions

diff --git a/library/library.ml b/library/library.ml
index 734a50fe3..4f964a051 100644
--- a/library/library.ml
+++ b/library/library.ml
@@ -297,17 +297,7 @@ let locate_absolute_library dir =
 let locate_qualified_library ?root ?(warn = true) qid =
   (* Search library in loadpath *)
   let dir, base = repr_qualid qid in
-  let loadpath = match root with
-  | None -> Loadpath.expand_path dir
-  | Some root ->
-    let filter path =
-      if is_dirpath_prefix_of root path then
-        let path = drop_dirpath_prefix root path in
-        is_dirpath_suffix_of dir path
-      else false
-    in
-    Loadpath.filter_path filter
-  in
+  let loadpath = Loadpath.expand_path ?root dir in
   let () = match loadpath with [] -> raise LibUnmappedDir | _ -> () in
   let find ext =
     try
diff --git a/library/loadpath.ml b/library/loadpath.ml
index 622d390a2..16b419454 100644
--- a/library/loadpath.ml
+++ b/library/loadpath.ml
@@ -97,18 +97,19 @@ let filter_path f =
   in
   aux !load_paths
 
-let expand_path dir =
+let expand_path ?root dir =
   let rec aux = function
   | [] -> []
-  | { path_physical = ph; path_logical = lg; path_implicit = implicit }  :: l ->
-    match implicit with
-    | true ->
-      (** The path is implicit, so that we only want match the logical suffix *)
-      if is_dirpath_suffix_of dir lg then (ph, lg) :: aux l else aux l
-    | false ->
-      (** Otherwise we must match exactly *)
-      if DirPath.equal dir lg then (ph, lg) :: aux l else aux l
-  in
+  | { path_physical = ph; path_logical = lg; path_implicit = implicit } :: l ->
+    let success =
+      match root with
+      | None ->
+        if implicit then is_dirpath_suffix_of dir lg
+        else DirPath.equal dir lg
+      | Some root ->
+        is_dirpath_prefix_of root lg &&
+          is_dirpath_suffix_of dir (drop_dirpath_prefix root lg) in
+    if success then (ph, lg) :: aux l else aux l in
   aux !load_paths
 
 let locate_file fname =
diff --git a/library/loadpath.mli b/library/loadpath.mli
index 269e28e0b..732f6349f 100644
--- a/library/loadpath.mli
+++ b/library/loadpath.mli
@@ -42,7 +42,7 @@ val find_load_path : CUnix.physical_path -> t
 val is_in_load_paths : CUnix.physical_path -> bool
 (** Whether a physical path is currently bound. *)
 
-val expand_path : DirPath.t -> (CUnix.physical_path * DirPath.t) list
+val expand_path : ?root:DirPath.t -> DirPath.t -> (CUnix.physical_path * DirPath.t) list
 (** Given a relative logical path, associate the list of absolute physical and
     logical paths which are possible matches of it. *)