2 files changed, 30 insertions, 17 deletions
diff --git a/utils/build_path_prefix_map.ml b/utils/build_path_prefix_map.ml
index 65d951f1c3..17cfac82e2 100644
--- a/utils/build_path_prefix_map.ml
+++ b/utils/build_path_prefix_map.ml
@@ -95,25 +95,24 @@ let decode_map str =
   | exception (Shortcut err) -> Error err
   | map -> Ok map
 
-let rewrite_opt prefix_map path =
-  let is_prefix = function
-    | None -> false
-    | Some { target = _; source } ->
-      String.length source <= String.length path
-      && String.equal source (String.sub path 0 (String.length source))
-  in
-  match
-    List.find is_prefix
-      (* read key/value pairs from right to left, as the spec demands *)
-      (List.rev prefix_map)
-  with
-  | exception Not_found -> None
+let make_target path : pair option -> path option = function
   | None -> None
-  | Some { source; target } ->
+  | Some { target; source } ->
+    let is_prefix =
+      String.length source <= String.length path
+        && String.equal source (String.sub path 0 (String.length source)) in
+    if is_prefix then
       Some (target ^ (String.sub path (String.length source)
                        (String.length path - String.length source)))
+    else None
+
+let rewrite_first prefix_map path =
+  List.find_map (make_target path) (List.rev prefix_map)
+
+let rewrite_all prefix_map path =
+  List.filter_map (make_target path) (List.rev prefix_map)
 
 let rewrite prefix_map path =
-  match rewrite_opt prefix_map path with
+  match rewrite_first prefix_map path with
   | None -> path
   | Some path -> path
diff --git a/utils/build_path_prefix_map.mli b/utils/build_path_prefix_map.mli
index dbcc8dc16f..d8ec9caf4d 100644
--- a/utils/build_path_prefix_map.mli
+++ b/utils/build_path_prefix_map.mli
@@ -18,6 +18,9 @@
   {b Warning:} this module is unstable and part of
   {{!Compiler_libs}compiler-libs}.
 
+  See
+  {{: https://reproducible-builds.org/specs/build-path-prefix-map/ }
+  the BUILD_PATH_PREFIX_MAP spec}
 *)
 
 
@@ -38,10 +41,21 @@ type map = pair option list
 val encode_map : map -> string
 val decode_map : string -> (map, error_message) result
 
-val rewrite_opt : map -> path -> path option
-(** [rewrite_opt map path] tries to find a source in [map]
+val rewrite_first : map -> path -> path option
+(** [rewrite_first map path] tries to find a source in [map]
     that is a prefix of the input [path]. If it succeeds,
     it replaces this prefix with the corresponding target.
     If it fails, it just returns [None]. *)
 
+val rewrite_all : map -> path -> path list
+(** [rewrite_all map path] finds all sources in [map]
+    that are a prefix of the input [path]. For each matching
+    source, in priority order, it replaces this prefix with
+    the corresponding target and adds the result to
+    the returned list.
+    If there are no matches, it just returns [[]]. *)
+
 val rewrite : map -> path -> path
+(** [rewrite path] uses [rewrite_first] to try to find a
+    mapping for path. If found, it returns that, otherwise
+    it just returns [path]. *)