diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 82c12406..d90d26c8 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -610,7 +610,7 @@ module Gen(P : Install_rules.Params) = struct Lib.DB.get_compile_info (Scope.libs scope) lib.name ~allow_overlaps:lib.buildable.allow_overlapping_dependencies in - let requires, real_requires = + let requires = SC.Libs.requires sctx compile_info ~dir ~has_dot_merlin:true in @@ -795,7 +795,7 @@ module Gen(P : Install_rules.Params) = struct }; Merlin.make () - ~requires:real_requires + ~requires:(Lib.Compile.requires compile_info) ~flags ~preprocess:(Buildable.single_preprocess lib.buildable) ~libname:lib.name @@ -823,7 +823,8 @@ module Gen(P : Install_rules.Params) = struct SC.Deps.interpret sctx exes.buildable.preprocessor_deps ~scope ~dir in - Preprocessing.pp_and_lint_modules sctx ~dir ~dep_kind:Required ~modules ~scope + Preprocessing.pp_and_lint_modules sctx ~dir ~dep_kind:Required ~modules + ~scope ~preprocess:exes.buildable.preprocess ~preprocessor_deps ~lint:exes.buildable.lint @@ -880,7 +881,7 @@ module Gen(P : Install_rules.Params) = struct ~pps:(Jbuild.Preprocess_map.pps exes.buildable.preprocess) ~allow_overlaps:exes.buildable.allow_overlapping_dependencies in - let requires, real_requires = + let requires = SC.Libs.requires sctx ~dir ~has_dot_merlin:true compile_info @@ -905,7 +906,7 @@ module Gen(P : Install_rules.Params) = struct ~js_of_ocaml:exes.buildable.js_of_ocaml; Merlin.make () - ~requires:real_requires + ~requires:(Lib.Compile.requires compile_info) ~flags:(Ocaml_flags.common flags) ~preprocess:(Buildable.single_preprocess exes.buildable) ~objs_dirs:(Path.Set.singleton obj_dir) diff --git a/src/inline_tests.ml b/src/inline_tests.ml index ffb8473f..a4e75529 100644 --- a/src/inline_tests.ml +++ b/src/inline_tests.ml @@ -194,7 +194,7 @@ include Sub_system.Register_end_point( (Action.Var_expansion.Strings ([lib.name], Concat)) in - let runner_libs, _ = + let runner_libs = let open Result.O in Lib.Compile.make (Result.concat_map backends diff --git a/src/merlin.ml b/src/merlin.ml index a3d10e39..0089079e 100644 --- a/src/merlin.ml +++ b/src/merlin.ml @@ -32,7 +32,7 @@ module Preprocess = struct end type t = - { requires : (unit, Lib.t list) Build.t + { requires : Lib.Set.t ; flags : (unit, string list) Build.t ; preprocess : Preprocess.t ; libname : string option @@ -41,7 +41,7 @@ type t = } let make - ?(requires=Build.return []) + ?(requires=Ok []) ?(flags=Build.return []) ?(preprocess=Jbuild.Preprocess.No_preprocessing) ?libname @@ -49,7 +49,12 @@ let make ?(objs_dirs=Path.Set.empty) () = (* Merlin shouldn't cause the build to fail, so we just ignore errors *) - { requires = Build.catch requires ~on_error:(fun _ -> []) + let requires = + match requires with + | Ok l -> Lib.Set.of_list l + | Error _ -> Lib.Set.empty + in + { requires ; flags = Build.catch flags ~on_error:(fun _ -> []) ; preprocess = Preprocess.make preprocess ; libname @@ -92,11 +97,11 @@ let dot_merlin sctx ~dir ~scope ({ requires; flags; _ } as t) = >>> Build.create_file (Path.relative dir ".merlin-exists")); SC.add_rule sctx ~mode:Promote_but_delete_on_clean ( - requires &&& flags - >>^ (fun (libs, flags) -> + flags + >>^ (fun flags -> let ppx_flags = ppx_flags sctx ~dir ~scope ~src_dir:remaindir t in let libs = - List.fold_left ~f:(fun acc (lib : Lib.t) -> + Lib.Set.fold requires ~init:[] ~f:(fun (lib : Lib.t) acc -> let serialize_path = Path.reach ~from:remaindir in let bpath = serialize_path (Lib.obj_dir lib) in let spath = @@ -105,7 +110,7 @@ let dot_merlin sctx ~dir ~scope ({ requires; flags; _ } as t) = |> serialize_path in ("B " ^ bpath) :: ("S " ^ spath) :: acc - ) libs ~init:[] + ) in let source_dirs = Path.Set.fold t.source_dirs ~init:[] ~f:(fun path acc -> @@ -147,10 +152,7 @@ let dot_merlin sctx ~dir ~scope ({ requires; flags; _ } as t) = () let merge_two a b = - { requires = - (Build.fanout a.requires b.requires - >>^ fun (x, y) -> - Lib.L.remove_dups (x @ y)) + { requires = Lib.Set.union a.requires b.requires ; flags = a.flags &&& b.flags >>^ (fun (a, b) -> a @ b) ; preprocess = Preprocess.merge a.preprocess b.preprocess ; libname = diff --git a/src/merlin.mli b/src/merlin.mli index 9b552e26..1963cd93 100644 --- a/src/merlin.mli +++ b/src/merlin.mli @@ -1,9 +1,11 @@ (** Merlin rules *) +open Import + type t val make - : ?requires:(unit, Lib.t list) Build.t + : ?requires:(Lib.t list, exn) result -> ?flags:(unit, string list) Build.t -> ?preprocess:Jbuild.Preprocess.t -> ?libname:string diff --git a/src/super_context.ml b/src/super_context.ml index 1e31c7bb..752dae76 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -284,15 +284,12 @@ module Libs = struct Required) >>> requires in - let requires_with_merlin = - if t.context.merlin && has_dot_merlin then - Build.path (Path.relative dir ".merlin-exists") - >>> - requires - else - requires - in - (requires_with_merlin, requires) + if t.context.merlin && has_dot_merlin then + Build.path (Path.relative dir ".merlin-exists") + >>> + requires + else + requires let lib_files_alias ~dir ~name ~ext = Alias.make (sprintf "lib-%s%s-all" name ext) ~dir diff --git a/src/super_context.mli b/src/super_context.mli index dd6ded0f..5430a667 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -131,15 +131,13 @@ val resolve_program module Libs : sig (** Returns the closed list of dependencies for a dependency list in - a stanza. The second arrow is the same as the first one but with - an added dependency on the [.merlin] if [(context t).merlin && - has_dot_merlin] is [true]. *) + a stanza. *) val requires : t -> dir:Path.t -> has_dot_merlin:bool -> Lib.Compile.t - -> (unit, Lib.L.t) Build.t * (unit, Lib.L.t) Build.t + -> (unit, Lib.L.t) Build.t (** [file_deps ~ext] is an arrow that record dependencies on all the files with extension [ext] of the libraries given as input. *) diff --git a/src/utop.ml b/src/utop.ml index 99ba693a..e39f3193 100644 --- a/src/utop.ml +++ b/src/utop.ml @@ -62,7 +62,7 @@ let setup sctx ~dir ~(libs : Library.t list) ~scope = ; intf = None ; obj_name = "" } in let utop_exe_dir = utop_exe_dir ~dir in - let requires, _ = + let requires = Lib.DB.find_many (Scope.libs scope) ("utop" :: List.map libs ~f:(fun (lib : Library.t) -> lib.name)) |> Lib.Compile.make