Revert deforestation that might affect error messages

Signed-off-by: Rudi Grinberg <[email protected]>
ocaml · Sep 29, 2021 · f3564db · f3564db
1 parent 070c7aa
commit f3564db
Show file tree

Hide file tree

Showing 4 changed files with 32 additions and 49 deletions.
diff --git a/otherlibs/stdune-unstable/list.ml b/otherlibs/stdune-unstable/list.ml
@@ -46,26 +46,6 @@ let concat_map t ~f =
   in
   aux f [] t
 
-let unordered_concat =
-  let rec outer acc = function
-    | [] -> acc
-    | x :: xs -> inner acc xs x
-  and inner acc ys = function
-    | [] -> outer acc ys
-    | x :: xs -> inner (x :: acc) ys xs
-  in
-  fun l -> outer [] l
-
-let unordered_concat_map =
-  let rec outer ~f acc = function
-    | [] -> acc
-    | x :: xs -> inner ~f acc xs (f x)
-  and inner ~f acc ys = function
-    | [] -> outer ~f acc ys
-    | x :: xs -> inner ~f (x :: acc) ys xs
-  in
-  fun l ~f -> outer ~f [] l
-
 let rec rev_map_append l1 l2 ~f =
   match l1 with
   | [] -> l2

diff --git a/otherlibs/stdune-unstable/list.mli b/otherlibs/stdune-unstable/list.mli
@@ -18,10 +18,6 @@ val filteri : 'a t -> f:(int -> 'a -> bool) -> 'a t
 
 val concat_map : 'a t -> f:('a -> 'b t) -> 'b t
 
-val unordered_concat : 'a t t -> 'a t
-
-val unordered_concat_map : 'a t -> f:('a -> 'b t) -> 'b t
-
 val partition_map : 'a t -> f:('a -> ('b, 'c) Either.t) -> 'b t * 'c t
 
 val rev_map_append : 'a t -> 'b t -> f:('a -> 'b) -> 'b t

diff --git a/src/dune_rules/foreign_sources.ml b/src/dune_rules/foreign_sources.ml
@@ -125,32 +125,39 @@ let check_no_qualified (loc, include_subdirs) =
 let make (d : _ Dir_with_dune.t) ~(sources : Foreign.Sources.Unresolved.t)
     ~(lib_config : Lib_config.t) =
   let libs, foreign_libs, exes =
-    List.fold_left d.data ~init:([], [], [])
-      ~f:(fun ((libs, foreign_libs, exes) as acc) stanza ->
-        match (stanza : Stanza.t) with
-        | Library lib ->
-          let all = eval_foreign_stubs d lib.buildable.foreign_stubs ~sources in
-          ((lib, all) :: libs, foreign_libs, exes)
-        | Foreign_library library ->
-          let all = eval_foreign_stubs d [ library.stubs ] ~sources in
-          ( libs
-          , (library.archive_name, (library.archive_name_loc, all))
-            :: foreign_libs
-          , exes )
-        | Executables exe
-        | Tests { exes = exe; _ } ->
-          let all = eval_foreign_stubs d exe.buildable.foreign_stubs ~sources in
-          (libs, foreign_libs, (exe, all) :: exes)
-        | _ -> acc)
+    let libs, foreign_libs, exes =
+      List.fold_left d.data ~init:([], [], [])
+        ~f:(fun ((libs, foreign_libs, exes) as acc) stanza ->
+          match (stanza : Stanza.t) with
+          | Library lib ->
+            let all =
+              eval_foreign_stubs d lib.buildable.foreign_stubs ~sources
+            in
+            ((lib, all) :: libs, foreign_libs, exes)
+          | Foreign_library library ->
+            let all = eval_foreign_stubs d [ library.stubs ] ~sources in
+            ( libs
+            , (library.archive_name, (library.archive_name_loc, all))
+              :: foreign_libs
+            , exes )
+          | Executables exe
+          | Tests { exes = exe; _ } ->
+            let all =
+              eval_foreign_stubs d exe.buildable.foreign_stubs ~sources
+            in
+            (libs, foreign_libs, (exe, all) :: exes)
+          | _ -> acc)
+    in
+    List.(rev libs, rev foreign_libs, rev exes)
   in
   let () =
     let objects =
-      List.unordered_concat
-        [ List.rev_map libs ~f:snd
-        ; List.rev_map foreign_libs ~f:(fun (_, (_, sources)) -> sources)
-        ; List.rev_map exes ~f:snd
+      List.concat
+        [ List.map libs ~f:snd
+        ; List.map foreign_libs ~f:(fun (_, (_, sources)) -> sources)
+        ; List.map exes ~f:snd
         ]
-      |> List.unordered_concat_map ~f:(fun sources ->
+      |> List.concat_map ~f:(fun sources ->
              String.Map.to_list_map sources ~f:(fun _ (loc, source) ->
                  (Foreign.Source.object_name source ^ lib_config.ext_obj, loc)))
     in

diff --git a/test/blackbox-tests/test-cases/foreign-library.t/run.t b/test/blackbox-tests/test-cases/foreign-library.t/run.t
@@ -310,11 +310,11 @@ Testsuite for the (foreign_library ...) stanza.
   > EOF
 
   $ ./sdune build
-  File "lib/dune", line 2, characters 1-22:
-  2 |  (archive_name addmul)
+  File "lib/dune", line 6, characters 1-22:
+  6 |  (archive_name addmul)
        ^^^^^^^^^^^^^^^^^^^^^
   Error: Multiple foreign libraries with the same archive name "addmul"; the
-  name has already been taken in lib/dune:6.
+  name has already been taken in lib/dune:2.
   [1]
 
 ----------------------------------------------------------------------------------