From 1e085187ba3bf936f8b64ba92e4f01159b125fd9 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Tue, 23 May 2023 17:08:16 -0700 Subject: [PATCH] fix: merge for Module_trie Signed-off-by: Antonio Nuno Monteiro --- src/dune_rules/module_trie.ml | 24 +++- .../include-qualified/merge.t/run.t | 110 ++++-------------- 2 files changed, 41 insertions(+), 93 deletions(-) diff --git a/src/dune_rules/module_trie.ml b/src/dune_rules/module_trie.ml index 396d4943a808..bf124d455d04 100644 --- a/src/dune_rules/module_trie.ml +++ b/src/dune_rules/module_trie.ml @@ -103,14 +103,24 @@ let rec to_dyn f t = t let merge x y ~f = - let base _path _ = (* TODO *) assert false in + let rec base ~path ~f t = + Map.foldi t ~init:empty ~f:(fun k v acc -> + let path = k :: path in + let rev_path = List.rev path in + match v with + | Leaf leaf -> ( + match f rev_path leaf with + | None -> acc + | Some leaf -> Map.add_exn acc k (Leaf leaf)) + | Map m -> Map.add_exn acc k (Map (base ~path ~f m))) + in let rec loop path x y = match (x, y) with | None, None -> assert false - | Some x, None -> base path x - | None, Some x -> base path x + | Some x, None -> base x ~path ~f:(fun path x -> f path (Some x) None) + | None, Some y -> base y ~path ~f:(fun path x -> f path None (Some x)) | Some x, Some y -> - Map.merge x y ~f:(fun name x y -> + Map.merge x y ~f:(fun (name : Module_name.t) x y -> let path = name :: path in let rev_path = List.rev path in let leaf l r = @@ -125,8 +135,10 @@ let merge x y ~f = | Some (Leaf x), None -> leaf (Some x) None | Some (Leaf x), Some (Leaf y) -> leaf (Some x) (Some y) (* maps *) - | None, Some (Map v) -> non_empty_map (base path v) - | Some (Map v), None -> non_empty_map (base path v) + | None, Some (Map v) -> + non_empty_map (base v ~path ~f:(fun path x -> f path None (Some x))) + | Some (Map v), None -> + non_empty_map (base v ~path ~f:(fun path x -> f path (Some x) None)) | Some (Map x), Some (Map y) -> non_empty_map (loop path (Some x) (Some y)) (* mixed *) diff --git a/test/blackbox-tests/test-cases/include-qualified/merge.t/run.t b/test/blackbox-tests/test-cases/include-qualified/merge.t/run.t index c9d50d3ff64e..c2c669e3e160 100644 --- a/test/blackbox-tests/test-cases/include-qualified/merge.t/run.t +++ b/test/blackbox-tests/test-cases/include-qualified/merge.t/run.t @@ -2,92 +2,28 @@ Demonstrate building a `include_subdirs qualified` project with `(modules :standard \ exclusion)` $ dune build - File "src/dune_rules/module_trie.ml", line 106, characters 32-38: - File "src/dune_rules/module_trie.ml", line 106, characters 32-38: Assertion - failed - Raised at Dune_rules__Module_trie.merge.base in file - "src/dune_rules/module_trie.ml", line 106, characters 32-44 - Called from Dune_rules__Module_trie.merge.loop.(fun) in file - "src/dune_rules/module_trie.ml", line 128, characters 48-61 - Called from Stdlib__Map.Make.merge in file "map.ml", line 398, characters - 44-63 - Called from Stdlib__Map.Make.merge in file "map.ml", line 398, characters - 64-79 - Called from Stdlib__List.fold_left in file "list.ml", line 121, characters - 24-34 - Called from Dune_lang__Ordered_set_lang.Eval.of_ast.loop in file - "src/dune_lang/ordered_set_lang.ml", line 139, characters 19-28 - Called from Dune_rules__Modules_field_evaluator.eval.(fun) in file - "src/dune_rules/modules_field_evaluator.ml", line 44, characters 18-62 - Called from Dune_rules__Modules_field_evaluator.eval0 in file - "src/dune_rules/modules_field_evaluator.ml" (inlined), line 289, characters - 13-60 - Called from Dune_rules__Modules_field_evaluator.eval0 in file - "src/dune_rules/modules_field_evaluator.ml", line 290, characters 16-56 - Called from Dune_rules__Modules_field_evaluator.eval in file - "src/dune_rules/modules_field_evaluator.ml", line 360, characters 4-105 - Called from Dune_rules__Ml_sources.make_lib_modules in file - "src/dune_rules/ml_sources.ml", line 342, characters 4-197 - Called from Fiber__Scheduler.exec in file "otherlibs/fiber/src/scheduler.ml", - line 73, characters 8-11 - Re-raised at Stdune__Exn.raise_with_backtrace in file - "otherlibs/stdune/src/exn.ml", line 36, characters 27-56 - Called from Fiber__Scheduler.exec in file "otherlibs/fiber/src/scheduler.ml", - line 73, characters 8-11 - Re-raised at Stdune__Exn.raise_with_backtrace in file - "otherlibs/stdune/src/exn.ml", line 36, characters 27-56 - Called from Fiber__Scheduler.exec in file "otherlibs/fiber/src/scheduler.ml", - line 73, characters 8-11 - Re-raised at Stdune__Exn.raise_with_backtrace in file - "otherlibs/stdune/src/exn.ml", line 36, characters 27-56 - Called from Fiber__Scheduler.exec in file "otherlibs/fiber/src/scheduler.ml", - line 73, characters 8-11 - Re-raised at Stdune__Exn.raise_with_backtrace in file - "otherlibs/stdune/src/exn.ml", line 36, characters 27-56 - Called from Fiber__Scheduler.exec in file "otherlibs/fiber/src/scheduler.ml", - line 73, characters 8-11 - Re-raised at Stdune__Exn.raise_with_backtrace in file - "otherlibs/stdune/src/exn.ml", line 36, characters 27-56 - Called from Fiber__Scheduler.exec in file "otherlibs/fiber/src/scheduler.ml", - line 73, characters 8-11 - Re-raised at Stdune__Exn.raise_with_backtrace in file - "otherlibs/stdune/src/exn.ml", line 36, characters 27-56 - Called from Fiber__Scheduler.exec in file "otherlibs/fiber/src/scheduler.ml", - line 73, characters 8-11 - Re-raised at Stdune__Exn.raise_with_backtrace in file - "otherlibs/stdune/src/exn.ml", line 36, characters 27-56 - Called from Fiber__Scheduler.exec in file "otherlibs/fiber/src/scheduler.ml", - line 73, characters 8-11 - Re-raised at Stdune__Exn.raise_with_backtrace in file - "otherlibs/stdune/src/exn.ml", line 36, characters 27-56 - Called from Fiber__Scheduler.exec in file "otherlibs/fiber/src/scheduler.ml", - line 73, characters 8-11 - Re-raised at Stdune__Exn.raise_with_backtrace in file - "otherlibs/stdune/src/exn.ml", line 36, characters 27-56 - Called from Fiber__Scheduler.exec in file "otherlibs/fiber/src/scheduler.ml", - line 73, characters 8-11 - Re-raised at Stdune__Exn.raise_with_backtrace in file - "otherlibs/stdune/src/exn.ml", line 36, characters 27-56 - Called from Fiber__Scheduler.exec in file "otherlibs/fiber/src/scheduler.ml", - line 73, characters 8-11 - Re-raised at Stdune__Exn.raise_with_backtrace in file - "otherlibs/stdune/src/exn.ml", line 36, characters 27-56 - Called from Fiber__Scheduler.exec in file "otherlibs/fiber/src/scheduler.ml", - line 73, characters 8-11 - Re-raised at Stdune__Exn.raise_with_backtrace in file - "otherlibs/stdune/src/exn.ml", line 36, characters 27-56 - Called from Fiber__Scheduler.exec in file "otherlibs/fiber/src/scheduler.ml", - line 73, characters 8-11 - Re-raised at Stdune__Exn.raise_with_backtrace in file - "otherlibs/stdune/src/exn.ml", line 36, characters 27-56 - Called from Fiber__Scheduler.exec in file "otherlibs/fiber/src/scheduler.ml", - line 73, characters 8-11 - - I must not crash. Uncertainty is the mind-killer. Exceptions are the - little-death that brings total obliteration. I will fully express my cases. - Execution will pass over me and through me. And when it has gone past, I - will unwind the stack along its path. Where the cases are handled there will - be nothing. Only I will remain. - [1] + hello from nested module bar + hello from nested module B $ find _build -iname "*.ml-gen" | sort | while read file; do echo "contents of $file"; cat $file; echo "--------"; done; + contents of _build/default/lib/foolib.ml-gen + (* generated by dune *) + + (** @canonical Foolib.Foo *) + module Foo = Foolib__Foo + -------- + contents of _build/default/lib/foolib__Foo.ml-gen + (* generated by dune *) + + (** @canonical Foolib.Foo.A *) + module A = Foolib__Foo__A + + (** @canonical Foolib.Foo.Bar *) + module Bar = Foolib__Foo__Bar + -------- + contents of _build/default/lib/foolib__Foo__A.ml-gen + (* generated by dune *) + + (** @canonical Foolib.Foo.A.B *) + module B = Foolib__Foo__A__B + --------