diff --git a/src/dune_rules/artifacts_obj.ml b/src/dune_rules/artifacts_obj.ml index 51798f860488..f2903d743040 100644 --- a/src/dune_rules/artifacts_obj.ml +++ b/src/dune_rules/artifacts_obj.ml @@ -10,12 +10,12 @@ let empty = { libraries = Lib_name.Map.empty; modules = Module_name.Map.empty } let lookup_module { modules; libraries = _ } = Module_name.Map.find modules let lookup_library { libraries; modules = _ } = Lib_name.Map.find libraries -let make ~dir ~lib_config ~libs ~exes = +let make ~dir ~expander ~lib_config ~libs ~exes = let+ libraries = Memo.List.map libs ~f:(fun ((lib : Library.t), _, _, _) -> let+ lib_config = lib_config in let name = Lib_name.of_local lib.name in - let info = Library.to_lib_info lib ~dir ~lib_config in + let info = Library.to_lib_info lib ~expander ~dir ~lib_config in name, info) >>| Lib_name.Map.of_list_exn in diff --git a/src/dune_rules/artifacts_obj.mli b/src/dune_rules/artifacts_obj.mli index d09a956155d9..93e6404e3e0d 100644 --- a/src/dune_rules/artifacts_obj.mli +++ b/src/dune_rules/artifacts_obj.mli @@ -6,6 +6,7 @@ val empty : t val make : dir:Path.Build.t + -> expander:Expander0.t -> lib_config:Lib_config.t Memo.t -> libs:(Library.t * _ * Modules.t * Path.Build.t Obj_dir.t) list -> exes:(_ * _ * Modules.t * Path.Build.t Obj_dir.t) list diff --git a/src/dune_rules/expander.ml b/src/dune_rules/expander.ml index 375c613611e9..41707b9b55e8 100644 --- a/src/dune_rules/expander.ml +++ b/src/dune_rules/expander.ml @@ -63,6 +63,7 @@ type t = let artifacts t = t.artifacts_host let dir t = t.dir +let project t = t.project let context t = Context.name t.context let set_local_env_var t ~var ~value = @@ -909,3 +910,12 @@ let expand_locks t (locks : Locks.t) = Memo.List.map locks ~f:(fun (Lock x) -> No_deps.expand_path t x) |> Action_builder.of_memo ;; + +module M = struct + type nonrec t = t + + let project = project + let eval_blang = eval_blang +end + +let to_expander0 t = Expander0.create (Memo.return t) (module M) diff --git a/src/dune_rules/expander.mli b/src/dune_rules/expander.mli index a4a74787e5c5..e7424e458aeb 100644 --- a/src/dune_rules/expander.mli +++ b/src/dune_rules/expander.mli @@ -6,6 +6,7 @@ type t val dir : t -> Path.Build.t val context : t -> Context_name.t +val project : t -> Dune_project.t val make_root : project:Dune_project.t @@ -123,3 +124,4 @@ val foreign_flags Fdecl.t val lookup_artifacts : (dir:Path.Build.t -> Artifacts_obj.t Memo.t) Fdecl.t +val to_expander0 : t -> Expander0.t diff --git a/src/dune_rules/expander0.ml b/src/dune_rules/expander0.ml index 13f583d045fa..dcb1f6eef0ea 100644 --- a/src/dune_rules/expander0.ml +++ b/src/dune_rules/expander0.ml @@ -24,3 +24,26 @@ let as_in_build_dir ~what ~loc p = (Path.to_string_maybe_quoted p) ] ;; + +module type S = sig + type t + + val project : t -> Dune_project.t + val eval_blang : t -> Blang.t -> bool Memo.t +end + +open Memo.O + +type t = E : 'a Memo.t * (module S with type t = 'a) -> t + +let db = Fdecl.create Dyn.opaque +let set_db = Fdecl.set db +let create e m = E (e, m) +let project (E (e, (module E))) = Memo.map e ~f:E.project + +let eval_blang (E (e, (module E))) blang = + let* e = e in + E.eval_blang e blang +;; + +let get ~dir = (Fdecl.get db) ~dir diff --git a/src/dune_rules/expander0.mli b/src/dune_rules/expander0.mli index 82dd79699b85..99d666753408 100644 --- a/src/dune_rules/expander0.mli +++ b/src/dune_rules/expander0.mli @@ -2,3 +2,17 @@ open Import val isn't_allowed_in_this_position : source:Dune_lang.Template.Pform.t -> 'a val as_in_build_dir : what:string -> loc:Loc.t -> Path.t -> Path.Build.t + +module type S = sig + type t + + val project : t -> Dune_project.t + val eval_blang : t -> Blang.t -> bool Memo.t +end + +include S + +val set_db : (dir:Path.Build.t -> t Memo.t) -> unit +val get : dir:Path.Build.t -> t Memo.t +val project : t -> Dune_project.t Memo.t +val create : 'a Memo.t -> (module S with type t = 'a) -> t diff --git a/src/dune_rules/install_rules.ml b/src/dune_rules/install_rules.ml index d88092b77b54..39d6db486d11 100644 --- a/src/dune_rules/install_rules.ml +++ b/src/dune_rules/install_rules.ml @@ -170,7 +170,10 @@ end = struct ocaml.lib_config in let make_entry ?(loc = loc) = make_entry lib_subdir ~loc in - let info = Library.to_lib_info lib ~dir ~lib_config in + let* expander = Super_context.expander sctx ~dir in + let info = + Library.to_lib_info lib ~expander:(Expander.to_expander0 expander) ~dir ~lib_config + in let lib_name = Library.best_name lib in let* installable_modules = let+ modules = @@ -210,26 +213,24 @@ end = struct in make_entry ?sub_dir Lib source ?dst)) in - let* additional_deps = - let+ expander = Super_context.expander sctx ~dir:lib_src_dir in - fun (loc, deps) -> - Lib_file_deps.eval deps ~expander ~loc ~paths:(Disallow_external lib_name) - >>| Path.Set.to_list_map ~f:(fun path -> - let path = - let path = path |> Path.as_in_build_dir_exn in - check_runtime_deps_relative_path ~lib_info:info ~loc (Path.Build.local path); - path - in - let sub_dir = - let src_dir = Path.Build.parent_exn path in - match Path.Build.equal lib_src_dir src_dir with - | true -> None - | false -> - Path.Build.local src_dir - |> Path.Local.descendant ~of_:(Path.Build.local lib_src_dir) - |> Option.map ~f:Path.Local.to_string - in - make_entry ?sub_dir Lib path) + let additional_deps (loc, deps) = + Lib_file_deps.eval deps ~expander ~loc ~paths:(Disallow_external lib_name) + >>| Path.Set.to_list_map ~f:(fun path -> + let path = + let path = path |> Path.as_in_build_dir_exn in + check_runtime_deps_relative_path ~lib_info:info ~loc (Path.Build.local path); + path + in + let sub_dir = + let src_dir = Path.Build.parent_exn path in + match Path.Build.equal lib_src_dir src_dir with + | true -> None + | false -> + Path.Build.local src_dir + |> Path.Local.descendant ~of_:(Path.Build.local lib_src_dir) + |> Option.map ~f:Path.Local.to_string + in + make_entry ?sub_dir Lib path) in let { Lib_config.has_native; ext_obj; _ } = lib_config in let { Lib_mode.Map.ocaml = { Mode.Dict.byte; native } as ocaml; melange } = diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index 048bd5829762..faadb051fd6c 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -580,13 +580,15 @@ let library_rules let* () = Memo.Option.iter vimpl ~f:(Virtual_rules.setup_copy_rules_for_impl ~sctx ~dir) in + let* expander = Super_context.expander sctx ~dir in let* () = Check_rules.add_cycle_check sctx ~dir top_sorted_modules in let* () = gen_wrapped_compat_modules lib cctx and* () = Module_compilation.build_all cctx - and* expander = Super_context.expander sctx ~dir and* lib_info = let lib_config = ocaml.lib_config in - let info = Library.to_lib_info lib ~dir ~lib_config in + let info = + Library.to_lib_info lib ~expander:(Expander.to_expander0 expander) ~dir ~lib_config + in let mode = Lib_mode.Map.Set.for_merlin (Lib_info.modes info) in let+ () = Check_rules.add_obj_dir sctx ~obj_dir mode in info diff --git a/src/dune_rules/ml_sources.ml b/src/dune_rules/ml_sources.ml index e348a6a6bfd0..0490be5d42a5 100644 --- a/src/dune_rules/ml_sources.ml +++ b/src/dune_rules/ml_sources.ml @@ -547,6 +547,7 @@ let make Memo.lazy_ (fun () -> Artifacts_obj.make ~dir + ~expander:(Expander.to_expander0 expander) ~lib_config ~libs:modules_of_stanzas.libraries ~exes:modules_of_stanzas.executables) diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index f64880ec70cb..47fe6626cb1f 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -52,59 +52,64 @@ module DB = struct end let create_db_from_stanzas ~instrument_with ~parent ~lib_config stanzas = - let (map : Found_or_redirect.t Lib_name.Map.t) = - List.map stanzas ~f:(fun stanza -> - match (stanza : Library_related_stanza.t) with - | Library_redirect s -> - let old_public_name = Lib_name.of_local s.old_name in - Found_or_redirect.redirect old_public_name s.new_public_name - | Deprecated_library_name s -> - let old_public_name = Deprecated_library_name.old_public_name s in - Found_or_redirect.redirect old_public_name s.new_public_name - | Library (dir, (conf : Library.t)) -> - let info = Library.to_lib_info conf ~dir ~lib_config |> Lib_info.of_local in - Library.best_name conf, Found_or_redirect.found info) - |> Lib_name.Map.of_list_reducei ~f:(fun name (v1 : Found_or_redirect.t) v2 -> - let res = - match v1, v2 with - | Found info1, Found info2 -> Error (Lib_info.loc info1, Lib_info.loc info2) - | Found info, Redirect (loc, _) | Redirect (loc, _), Found info -> - Error (loc, Lib_info.loc info) - | Redirect (loc1, lib1), Redirect (loc2, lib2) -> - if Lib_name.equal lib1 lib2 then Ok v1 else Error (loc1, loc2) - in - match res with - | Ok x -> x - | Error (loc1, loc2) -> - let main_message = - Pp.textf "Library %s is defined twice:" (Lib_name.to_string name) - in - let annots = - let main = User_message.make ~loc:loc2 [ main_message ] in - let related = - [ User_message.make ~loc:loc1 [ Pp.text "Already defined here" ] ] + let open Memo.O in + let map = + Memo.lazy_ (fun () -> + Memo.List.map stanzas ~f:(fun stanza -> + match (stanza : Library_related_stanza.t) with + | Library_redirect s -> + let old_public_name = Lib_name.of_local s.old_name in + Found_or_redirect.redirect old_public_name s.new_public_name |> Memo.return + | Deprecated_library_name s -> + let old_public_name = Deprecated_library_name.old_public_name s in + Found_or_redirect.redirect old_public_name s.new_public_name |> Memo.return + | Library (dir, (conf : Library.t)) -> + let+ expander = Expander0.get ~dir in + let info = + Library.to_lib_info conf ~expander ~dir ~lib_config |> Lib_info.of_local in - User_message.Annots.singleton - Compound_user_error.annot - [ Compound_user_error.make ~main ~related ] + Library.best_name conf, Found_or_redirect.found info) + >>| Lib_name.Map.of_list_reducei ~f:(fun name (v1 : Found_or_redirect.t) v2 -> + let res = + match v1, v2 with + | Found info1, Found info2 -> Error (Lib_info.loc info1, Lib_info.loc info2) + | Found info, Redirect (loc, _) | Redirect (loc, _), Found info -> + Error (loc, Lib_info.loc info) + | Redirect (loc1, lib1), Redirect (loc2, lib2) -> + if Lib_name.equal lib1 lib2 then Ok v1 else Error (loc1, loc2) in - User_error.raise - ~annots - [ main_message - ; Pp.textf "- %s" (Loc.to_file_colon_line loc1) - ; Pp.textf "- %s" (Loc.to_file_colon_line loc2) - ]) + match res with + | Ok x -> x + | Error (loc1, loc2) -> + let main_message = + Pp.textf "Library %s is defined twice:" (Lib_name.to_string name) + in + let annots = + let main = User_message.make ~loc:loc2 [ main_message ] in + let related = + [ User_message.make ~loc:loc1 [ Pp.text "Already defined here" ] ] + in + User_message.Annots.singleton + Compound_user_error.annot + [ Compound_user_error.make ~main ~related ] + in + User_error.raise + ~annots + [ main_message + ; Pp.textf "- %s" (Loc.to_file_colon_line loc1) + ; Pp.textf "- %s" (Loc.to_file_colon_line loc2) + ])) in Lib.DB.create () ~parent:(Some parent) ~resolve:(fun name -> - Memo.return - (match Lib_name.Map.find map name with - | None -> Lib.DB.Resolve_result.not_found - | Some (Redirect lib) -> Lib.DB.Resolve_result.redirect_in_the_same_db lib - | Some (Found lib) -> Lib.DB.Resolve_result.found lib)) - ~all:(fun () -> Lib_name.Map.keys map |> Memo.return) + let+ map = Memo.Lazy.force map in + match Lib_name.Map.find map name with + | None -> Lib.DB.Resolve_result.not_found + | Some (Redirect lib) -> Lib.DB.Resolve_result.redirect_in_the_same_db lib + | Some (Found lib) -> Lib.DB.Resolve_result.found lib) + ~all:(fun () -> Memo.Lazy.force map >>| Lib_name.Map.keys) ~lib_config ~instrument_with ;; diff --git a/src/dune_rules/stanzas/library.ml b/src/dune_rules/stanzas/library.ml index 7410ce896a28..216522546230 100644 --- a/src/dune_rules/stanzas/library.ml +++ b/src/dune_rules/stanzas/library.ml @@ -166,10 +166,13 @@ let decode = and+ enabled_if = let open Enabled_if in let allowed_vars = - Only - (("context_name", (2, 8)) - :: ("profile", (2, 5)) - :: Lib_config.allowed_in_enabled_if) + if Dune_project.dune_version project >= (3, 15) + then Any + else + Only + (("context_name", (2, 8)) + :: ("profile", (2, 5)) + :: Lib_config.allowed_in_enabled_if) in decode ~allowed_vars ~since:(Some (1, 10)) () and+ instrumentation_backend = @@ -402,6 +405,7 @@ let main_module_name t : Lib_info.Main_module_name.t = let to_lib_info conf + ~expander ~dir ~lib_config: ({ Lib_config.has_native; ext_lib; ext_dll; natdynlink_supported; _ } as lib_config) @@ -474,19 +478,23 @@ let to_lib_info let name = best_name conf in let enabled = let+ enabled_if_result = - Blang_expand.eval conf.enabled_if ~dir:(Path.build dir) ~f:(fun ~source:_ pform -> - let+ value = - match pform with - | Var Context_name -> - let context, _ = Path.Build.extract_build_context_exn dir in - Memo.return context - | Var Profile -> - let context, _ = Path.Build.extract_build_context_exn dir in - let+ profile = Per_context.profile (Context_name.of_string context) in - Profile.to_string profile - | _ -> Memo.return @@ Lib_config.get_for_enabled_if lib_config pform - in - [ Value.String value ]) + let* project = Expander0.project expander in + if Dune_project.dune_version project >= (3, 15) + then Expander0.eval_blang expander conf.enabled_if + else + Blang_expand.eval conf.enabled_if ~dir:(Path.build dir) ~f:(fun ~source:_ pform -> + let+ value = + match pform with + | Var Context_name -> + let context, _ = Path.Build.extract_build_context_exn dir in + Memo.return context + | Var Profile -> + let context, _ = Path.Build.extract_build_context_exn dir in + let+ profile = Per_context.profile (Context_name.of_string context) in + Profile.to_string profile + | _ -> Memo.return @@ Lib_config.get_for_enabled_if lib_config pform + in + [ Value.String value ]) in if not enabled_if_result then Lib_info.Enabled_status.Disabled_because_of_enabled_if diff --git a/src/dune_rules/stanzas/library.mli b/src/dune_rules/stanzas/library.mli index b5f2ba5a63d5..bc90b8b58806 100644 --- a/src/dune_rules/stanzas/library.mli +++ b/src/dune_rules/stanzas/library.mli @@ -76,4 +76,10 @@ val is_virtual : t -> bool val is_impl : t -> bool val obj_dir : dir:Path.Build.t -> t -> Path.Build.t Obj_dir.t val main_module_name : t -> Lib_info.Main_module_name.t -val to_lib_info : t -> dir:Path.Build.t -> lib_config:Lib_config.t -> Lib_info.local + +val to_lib_info + : t + -> expander:Expander0.t + -> dir:Path.Build.t + -> lib_config:Lib_config.t + -> Lib_info.local diff --git a/src/dune_rules/super_context.ml b/src/dune_rules/super_context.ml index b7d9f5ae84e9..d9988cc4fcfe 100644 --- a/src/dune_rules/super_context.ml +++ b/src/dune_rules/super_context.ml @@ -382,7 +382,13 @@ let () = let* ctx = Context.DB.by_dir dir in let* t = find_exn (Context.name ctx) in let* expander = expander t ~dir in - Expander.expand_str expander sw |> Action_builder.evaluate_and_collect_facts >>| fst) + Expander.expand_str expander sw |> Action_builder.evaluate_and_collect_facts >>| fst); + Expander0.set_db (fun ~dir -> + Context.DB.by_dir dir + >>| Context.name + >>= find_exn + >>= expander ~dir + >>| Expander.to_expander0) ;; let context t = t.context diff --git a/test/blackbox-tests/test-cases/enabled_if/enabled-if-lib-other-vars.t b/test/blackbox-tests/test-cases/enabled_if/enabled-if-lib-other-vars.t new file mode 100644 index 000000000000..74bb9019d8db --- /dev/null +++ b/test/blackbox-tests/test-cases/enabled_if/enabled-if-lib-other-vars.t @@ -0,0 +1,16 @@ +Here we demonstrate that we expand any variable in enabled_if on libraries + + $ cat >dune-project < (lang dune 3.15) + > EOF + + $ cat >dune < (library + > (name foo) + > (enabled_if %{env:FOO=false})) + > EOF + $ dune build %{cma:./foo} + Error: No rule found for foo.cma + -> required by %{cma:./foo} at command line:1 + [1] + $ FOO=true dune build %{cma:./foo}