From d429530c59f13ffdee023bc78ee607ac9850ce96 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Wed, 8 Mar 2023 17:06:25 -0800 Subject: [PATCH] feat(melange): support `(select ...)` in `melange.emit` (#7239) * feat(melange): support `(select ...)` in `melange.emit` Signed-off-by: Antonio Nuno Monteiro --- src/dune_rules/cinaps.ml | 2 +- src/dune_rules/dir_contents.ml | 20 +++--- src/dune_rules/dune_file.ml | 68 ++----------------- src/dune_rules/dune_file.mli | 8 --- src/dune_rules/lib_dep.ml | 51 ++++++++++++++ src/dune_rules/lib_dep.mli | 10 ++- src/dune_rules/mdx.ml | 2 +- src/dune_rules/melange/melange_rules.ml | 3 +- src/dune_rules/melange/melange_stanzas.ml | 33 +-------- .../test-cases/melange/emit-select.t | 40 +++++++++++ 10 files changed, 125 insertions(+), 112 deletions(-) create mode 100644 test/blackbox-tests/test-cases/melange/emit-select.t diff --git a/src/dune_rules/cinaps.ml b/src/dune_rules/cinaps.ml index 657ef911afe..17e32e837bc 100644 --- a/src/dune_rules/cinaps.ml +++ b/src/dune_rules/cinaps.ml @@ -32,7 +32,7 @@ let decode = field "files" Predicate_lang.Glob.decode ~default:Predicate_lang.any and+ preprocess, preprocessor_deps = Stanza_common.preprocess_fields and+ libraries = - field "libraries" (Dune_file.Lib_deps.decode Executable) ~default:[] + field "libraries" (Lib_dep.L.decode ~allow_re_export:false) ~default:[] and+ runtime_deps = field ~default:[] "runtime_deps" (Dune_lang.Syntax.since syntax (1, 1) >>> repeat Dep_conf.decode) diff --git a/src/dune_rules/dir_contents.ml b/src/dune_rules/dir_contents.ml index ac4b2829c22..21ee535ea42 100644 --- a/src/dune_rules/dir_contents.ml +++ b/src/dune_rules/dir_contents.ml @@ -132,6 +132,14 @@ end = struct (* As a side-effect, setup user rules and copy_files rules. *) let load_text_files sctx st_dir stanzas ~dir ~src_dir = + let select_deps_files libraries = + (* Manually add files generated by the (select ...) + dependencies *) + List.filter_map libraries ~f:(fun dep -> + match (dep : Lib_dep.t) with + | Re_export _ | Direct _ -> None + | Select s -> Some s.result_fn) + in (* Interpret a few stanzas in order to determine the list of files generated by the user. *) let* expander = @@ -163,14 +171,7 @@ end = struct let+ res = Generate_sites_module_rules.setup_rules sctx ~dir def in [ res ] | Library { buildable; _ } | Executables { buildable; _ } -> - let select_deps_files = - (* Manually add files generated by the (select ...) - dependencies *) - List.filter_map buildable.libraries ~f:(fun dep -> - match (dep : Lib_dep.t) with - | Re_export _ | Direct _ -> None - | Select s -> Some s.result_fn) - in + let select_deps_files = select_deps_files buildable.libraries in let ctypes_files = (* Also manually add files generated by ctypes rules. *) match buildable.ctypes with @@ -178,6 +179,9 @@ end = struct | Some ctypes -> Ctypes_field.generated_ml_and_c_files ctypes in Memo.return (select_deps_files @ ctypes_files) + | Melange_stanzas.Emit.T { libraries; _ } -> + let select_deps_files = select_deps_files libraries in + Memo.return select_deps_files | _ -> Memo.return []) >>| fun l -> String.Set.of_list (List.concat l) in diff --git a/src/dune_rules/dune_file.ml b/src/dune_rules/dune_file.ml index b9a57e7a4c3..ca436f013b3 100644 --- a/src/dune_rules/dune_file.ml +++ b/src/dune_rules/dune_file.ml @@ -29,66 +29,6 @@ type for_ = | Executable | Library of Wrapped.t option -module Lib_deps = struct - type t = Lib_dep.t list - - type kind = - | Required - | Optional - | Forbidden - - let decode for_ = - let+ loc = loc - and+ t = - let allow_re_export = - match for_ with - | Library _ -> true - | Executable -> false - in - repeat (Lib_dep.decode ~allow_re_export) - in - let add kind name acc = - match Lib_name.Map.find acc name with - | None -> Lib_name.Map.set acc name kind - | Some kind' -> ( - match (kind, kind') with - | Required, Required -> - User_error.raise ~loc - [ Pp.textf "library %S is present twice" (Lib_name.to_string name) ] - | (Optional | Forbidden), (Optional | Forbidden) -> acc - | Optional, Required | Required, Optional -> - User_error.raise ~loc - [ Pp.textf - "library %S is present both as an optional and required \ - dependency" - (Lib_name.to_string name) - ] - | Forbidden, Required | Required, Forbidden -> - User_error.raise ~loc - [ Pp.textf - "library %S is present both as a forbidden and required \ - dependency" - (Lib_name.to_string name) - ]) - in - ignore - (List.fold_left t ~init:Lib_name.Map.empty ~f:(fun acc x -> - match x with - | Lib_dep.Re_export (_, s) | Lib_dep.Direct (_, s) -> - add Required s acc - | Select { choices; _ } -> - List.fold_left choices ~init:acc - ~f:(fun acc (c : Lib_dep.Select.Choice.t) -> - let acc = - Lib_name.Set.fold c.required ~init:acc ~f:(add Optional) - in - Lib_name.Set.fold c.forbidden ~init:acc ~f:(add Forbidden))) - : kind Lib_name.Map.t); - t - - let of_pps pps = List.map pps ~f:(fun pp -> Lib_dep.direct (Loc.none, pp)) -end - module Buildable = struct type t = { loc : Loc.t @@ -165,7 +105,13 @@ module Buildable = struct (Dune_lang.Syntax.deleted_in Stanza.syntax (2, 0) ~extra_info:"Use the (foreign_archives ...) field instead." >>> enter (maybe string)))) - and+ libraries = field "libraries" (Lib_deps.decode for_) ~default:[] + and+ libraries = + let allow_re_export = + match for_ with + | Library _ -> true + | Executable -> false + in + field "libraries" (Lib_dep.L.decode ~allow_re_export) ~default:[] and+ flags = Ocaml_flags.Spec.decode and+ js_of_ocaml = field "js_of_ocaml" Js_of_ocaml.In_buildable.decode diff --git a/src/dune_rules/dune_file.mli b/src/dune_rules/dune_file.mli index f8a04d4f32d..14f0d67f7b4 100644 --- a/src/dune_rules/dune_file.mli +++ b/src/dune_rules/dune_file.mli @@ -12,14 +12,6 @@ type for_ = | Executable | Library of Wrapped.t option -module Lib_deps : sig - type nonrec t = Lib_dep.t list - - val of_pps : Lib_name.t list -> t - - val decode : for_ -> t Dune_lang.Decoder.t -end - module Buildable : sig type t = { loc : Loc.t diff --git a/src/dune_rules/lib_dep.ml b/src/dune_rules/lib_dep.ml index 7d18ec5a8d0..73896e11f0e 100644 --- a/src/dune_rules/lib_dep.ml +++ b/src/dune_rules/lib_dep.ml @@ -143,7 +143,58 @@ let encode = [ ("select", Select.to_dyn select) ] module L = struct + type kind = + | Required + | Optional + | Forbidden + + type nonrec t = t list + let field_encode t ~name = let open Dune_lang.Encoder in field_l name encode t + + let decode ~allow_re_export = + let open Dune_lang.Decoder in + let+ loc = loc + and+ t = repeat (decode ~allow_re_export) in + let add kind name acc = + match Lib_name.Map.find acc name with + | None -> Lib_name.Map.set acc name kind + | Some kind' -> ( + match (kind, kind') with + | Required, Required -> + User_error.raise ~loc + [ Pp.textf "library %S is present twice" (Lib_name.to_string name) ] + | (Optional | Forbidden), (Optional | Forbidden) -> acc + | Optional, Required | Required, Optional -> + User_error.raise ~loc + [ Pp.textf + "library %S is present both as an optional and required \ + dependency" + (Lib_name.to_string name) + ] + | Forbidden, Required | Required, Forbidden -> + User_error.raise ~loc + [ Pp.textf + "library %S is present both as a forbidden and required \ + dependency" + (Lib_name.to_string name) + ]) + in + ignore + (List.fold_left t ~init:Lib_name.Map.empty ~f:(fun acc x -> + match x with + | Re_export (_, s) | Direct (_, s) -> add Required s acc + | Select { choices; _ } -> + List.fold_left choices ~init:acc + ~f:(fun acc (c : Select.Choice.t) -> + let acc = + Lib_name.Set.fold c.required ~init:acc ~f:(add Optional) + in + Lib_name.Set.fold c.forbidden ~init:acc ~f:(add Forbidden))) + : _ Lib_name.Map.t); + t + + let of_pps pps = List.map pps ~f:(fun pp -> direct (Loc.none, pp)) end diff --git a/src/dune_rules/lib_dep.mli b/src/dune_rules/lib_dep.mli index e19c619b954..be9c2c5ce5f 100644 --- a/src/dune_rules/lib_dep.mli +++ b/src/dune_rules/lib_dep.mli @@ -34,5 +34,13 @@ val re_export : Loc.t * Lib_name.t -> t val decode : allow_re_export:bool -> t Dune_lang.Decoder.t module L : sig - val field_encode : t list -> name:string -> Dune_lang.Encoder.field + type nonrec t = t list + + val field_encode : t -> name:string -> Dune_lang.Encoder.field + + val decode : + allow_re_export:bool + -> (t, Dune_lang.Decoder.values) Dune_lang.Decoder.parser + + val of_pps : Lib_name.t list -> t end diff --git a/src/dune_rules/mdx.ml b/src/dune_rules/mdx.ml index efc8f6f33e5..7b375f5ab54 100644 --- a/src/dune_rules/mdx.ml +++ b/src/dune_rules/mdx.ml @@ -215,7 +215,7 @@ let decode = and+ libraries = field "libraries" ~default:[] (Dune_lang.Syntax.since syntax (0, 2) - >>> Dune_file.Lib_deps.decode Executable) + >>> Lib_dep.L.decode ~allow_re_export:false) and+ locks = Locks.field ~check:(Dune_lang.Syntax.since syntax (0, 3)) () in diff --git a/src/dune_rules/melange/melange_rules.ml b/src/dune_rules/melange/melange_rules.ml index 662555681cb..913f6878a6c 100644 --- a/src/dune_rules/melange/melange_rules.ml +++ b/src/dune_rules/melange/melange_rules.ml @@ -203,7 +203,7 @@ let setup_emit_cmj_rules ~sctx ~dir ~scope ~expander ~dir_contents ~opaque:Inherit_from_settings ~package:mel.package ~modes: { ocaml = { byte = None; native = None } - ; melange = Some (Requested Loc.none) + ; melange = Some (Requested mel.loc) } in let* () = Module_compilation.build_all cctx in @@ -245,6 +245,7 @@ let setup_emit_cmj_rules ~sctx ~dir ~scope ~expander ~dir_contents ~dialects:(Dune_project.dialects (Scope.project scope)) ~modes:`Melange_emit ) in + let* () = Buildable_rules.gen_select_rules sctx compile_info ~dir in Buildable_rules.with_lib_deps ctx compile_info ~dir ~f module Runtime_deps = struct diff --git a/src/dune_rules/melange/melange_stanzas.ml b/src/dune_rules/melange/melange_stanzas.ml index 33b9ce14e35..d9f561db7cd 100644 --- a/src/dune_rules/melange/melange_stanzas.ml +++ b/src/dune_rules/melange/melange_stanzas.ml @@ -20,36 +20,6 @@ module Emit = struct type Stanza.t += T of t - let decode_lib = - let+ loc = loc - and+ t = - let allow_re_export = false in - repeat (Lib_dep.decode ~allow_re_export) - in - let add kind name acc = - match Lib_name.Map.find acc name with - | None -> Lib_name.Map.set acc name kind - | Some _present -> - User_error.raise ~loc - [ Pp.textf "library %S is present twice" (Lib_name.to_string name) ] - in - ignore - (List.fold_left t ~init:Lib_name.Map.empty ~f:(fun acc x -> - match x with - | Lib_dep.Direct (_, s) -> add true s acc - | Lib_dep.Re_export (_, name) -> - User_error.raise ~loc - [ Pp.textf - "library %S is using re_export, which is not supported for \ - melange libraries" - (Lib_name.to_string name) - ] - | Select _ -> - User_error.raise ~loc - [ Pp.textf "select is not supported for melange libraries" ]) - : bool Lib_name.Map.t); - t - let decode = let extension_field = let+ loc, extension = located string in @@ -126,7 +96,8 @@ module Emit = struct and+ module_systems = field "module_systems" module_systems ~default:[ Melange.Module_system.default ] - and+ libraries = field "libraries" decode_lib ~default:[] + and+ libraries = + field "libraries" (Lib_dep.L.decode ~allow_re_export:false) ~default:[] and+ package = field_o "package" Stanza_common.Pkg.decode and+ runtime_deps = field "runtime_deps" (repeat Dep_conf.decode) ~default:[] diff --git a/test/blackbox-tests/test-cases/melange/emit-select.t b/test/blackbox-tests/test-cases/melange/emit-select.t new file mode 100644 index 00000000000..416238372bf --- /dev/null +++ b/test/blackbox-tests/test-cases/melange/emit-select.t @@ -0,0 +1,40 @@ +using `(select ...)` in melange.emit + + $ cat > dune-project < (lang dune 3.7) + > (using melange 0.1) + > EOF + $ cat >bar.melange.ml < let message = "hello from melange" + > EOF + $ cat >bar.native.ml < let message = print_endline "hello from native" + > EOF + $ cat >foo.fake.ml < let message = "foo has fake " ^^ Fakefoobar.fake + > EOF + $ cat >foo.no_fake.ml < let message = "foo has no fake" + > EOF + $ cat >main.ml < let () = Js.log Bar.message + > let () = Js.log Foo.message + > EOF + $ cat >dune < (melange.emit + > (target output) + > (alias melange) + > (libraries + > (select bar.ml from + > (melange -> bar.melange.ml) + > (!melange -> bar.native.ml)) + > (select foo.ml from + > (fakefoobar -> foo.fake.ml) + > (!fakefoobar -> foo.no_fake.ml)))) + > EOF + + $ dune build @melange + $ node ./_build/default/output/main.js + hello from melange + foo has no fake +