diff --git a/src/dune_rules/dialect.ml b/src/dune_rules/dialect.ml index 667fa64fec2..e2040fa789a 100644 --- a/src/dune_rules/dialect.ml +++ b/src/dune_rules/dialect.ml @@ -45,7 +45,7 @@ end type t = { name : string - ; file_kinds : File_kind.t Ml_kind.Dict.t + ; file_kinds : File_kind.t option Ml_kind.Dict.t } let name t = t.name @@ -54,15 +54,17 @@ let to_dyn { name; file_kinds } = let open Dyn in record [ ("name", string name) - ; ("file_kinds", Ml_kind.Dict.to_dyn File_kind.to_dyn file_kinds) + ; ( "file_kinds" + , Ml_kind.Dict.to_dyn (Dyn.option File_kind.to_dyn) file_kinds ) ] let encode { name; file_kinds } = let open Dune_lang.Encoder in + let open Option.O in let file_kind_stanzas = - let open Ml_kind in - List.map ~f:File_kind.encode - [ Dict.get file_kinds Intf; Dict.get file_kinds Impl ] + List.filter_map Ml_kind.all ~f:(fun kind -> + let+ file_kind = Ml_kind.Dict.get file_kinds kind in + File_kind.encode file_kind) in let fields = record_fields [ field "name" string name ] @ file_kind_stanzas in list sexp (string "dialect" :: fields) @@ -87,18 +89,34 @@ let decode = in fields (let+ name = field "name" string - and+ impl = field "implementation" (fields (kind Ml_kind.Impl)) - and+ intf = field "interface" (fields (kind Ml_kind.Intf)) in + and+ loc = loc + and+ impl = field_o "implementation" (fields (kind Ml_kind.Impl)) + and+ intf = field_o "interface" (fields (kind Ml_kind.Intf)) + and+ version = Dune_lang.Syntax.get_exn Stanza.syntax in + let dialect_kind_optional_since = (3, 9) in + if version < dialect_kind_optional_since then ( + if Option.is_none impl then + Syntax.Error.since loc Stanza.syntax dialect_kind_optional_since + ~what:"omitting (implementation) in dialects"; + if Option.is_none intf then + Syntax.Error.since loc Stanza.syntax dialect_kind_optional_since + ~what:"omitting (interface) in dialects"); { name; file_kinds = Ml_kind.Dict.make ~intf ~impl }) let extension { file_kinds; _ } ml_kind = - (Ml_kind.Dict.get file_kinds ml_kind).extension + let open Option.O in + let+ x = Ml_kind.Dict.get file_kinds ml_kind in + x.extension let preprocess { file_kinds; _ } ml_kind = - (Ml_kind.Dict.get file_kinds ml_kind).preprocess + let open Option.O in + let* x = Ml_kind.Dict.get file_kinds ml_kind in + x.preprocess let format { file_kinds; _ } ml_kind = - (Ml_kind.Dict.get file_kinds ml_kind).format + let open Option.O in + let* x = Ml_kind.Dict.get file_kinds ml_kind in + x.format let ocaml = let format kind = @@ -126,8 +144,8 @@ let ocaml = , [ ".ocamlformat"; ".ocamlformat-ignore"; ".ocamlformat-enable" ] ) } in - let intf = file_kind Ml_kind.Intf ".mli" in - let impl = file_kind Ml_kind.Impl ".ml" in + let intf = Some (file_kind Ml_kind.Intf ".mli") in + let impl = Some (file_kind Ml_kind.Impl ".ml") in { name = "ocaml"; file_kinds = Ml_kind.Dict.make ~intf ~impl } let reason = @@ -152,8 +170,8 @@ let reason = ; format = Some (Loc.none, format, []) } in - let intf = file_kind Ml_kind.Intf ".rei" in - let impl = file_kind Ml_kind.Impl ".re" in + let intf = Some (file_kind Ml_kind.Intf ".rei") in + let impl = Some (file_kind Ml_kind.Impl ".re") in { name = "reason"; file_kinds = Ml_kind.Dict.make ~intf ~impl } let rescript = @@ -179,14 +197,15 @@ let rescript = ; format = Some (Loc.none, format, []) } in - let intf = file_kind Ml_kind.Intf ".resi" in - let impl = file_kind Ml_kind.Impl ".res" in + let intf = Some (file_kind Ml_kind.Intf ".resi") in + let impl = Some (file_kind Ml_kind.Impl ".res") in { name = "rescript"; file_kinds = Ml_kind.Dict.make ~intf ~impl } -let ml_suffix { file_kinds = { Ml_kind.Dict.intf; impl }; _ } ml_kind = - match (ml_kind, intf.preprocess, impl.preprocess) with - | Ml_kind.Intf, None, _ | Impl, _, None -> None - | _ -> Some (extension ocaml ml_kind) +let ml_suffix { file_kinds = { intf; impl }; _ } ml_kind = + match (ml_kind, intf, impl) with + | Ml_kind.Intf, (None | Some { preprocess = None; _ }), _ + | Impl, _, (None | Some { preprocess = None; _ }) -> None + | _ -> extension ocaml ml_kind module DB = struct type dialect = t @@ -194,7 +213,7 @@ module DB = struct type t = { by_name : dialect String.Map.t ; by_extension : dialect String.Map.t - ; mutable extensions_for_merlin : string Ml_kind.Dict.t list option + ; mutable extensions_for_merlin : string option Ml_kind.Dict.t list option } let fold { by_name; _ } = String.Map.fold by_name @@ -219,7 +238,8 @@ module DB = struct && intf = extension ocaml Ml_kind.Intf then s else { Ml_kind.Dict.impl; intf } :: s) - |> List.sort ~compare:(Ml_kind.Dict.compare String.compare) + |> List.sort + ~compare:(Ml_kind.Dict.compare (Option.compare String.compare)) in t.extensions_for_merlin <- Some v; v @@ -237,19 +257,21 @@ module DB = struct User_error.raise ~loc [ Pp.textf "dialect %S is already defined" dialect.name ] in - let add_ext map ext = - match String.Map.add map ext dialect with - | Ok map -> map - | Error dialect -> - User_error.raise ~loc - [ Pp.textf "extension %S is already registered by dialect %S" - (String.drop ext 1) dialect.name - ] + let add_ext map = function + | Some { File_kind.extension = ext; _ } -> ( + match String.Map.add map ext dialect with + | Ok map -> map + | Error dialect -> + User_error.raise ~loc + [ Pp.textf "extension %S is already registered by dialect %S" + (String.drop ext 1) dialect.name + ]) + | None -> map in let by_extension = add_ext - (add_ext by_extension dialect.file_kinds.intf.extension) - dialect.file_kinds.impl.extension + (add_ext by_extension dialect.file_kinds.intf) + dialect.file_kinds.impl in { by_name; by_extension; extensions_for_merlin = None } @@ -262,8 +284,9 @@ module DB = struct Option.map ~f:(fun dialect -> let kind = - if dialect.file_kinds.intf.extension = extension then Ml_kind.Intf - else Ml_kind.Impl + match dialect.file_kinds.intf with + | Some intf when intf.extension = extension -> Ml_kind.Intf + | _ -> Ml_kind.Impl in (dialect, kind)) (String.Map.find by_extension extension) diff --git a/src/dune_rules/dialect.mli b/src/dune_rules/dialect.mli index ee68798cad3..4e994702011 100644 --- a/src/dune_rules/dialect.mli +++ b/src/dune_rules/dialect.mli @@ -29,7 +29,7 @@ val encode : t Dune_lang.Encoder.t val decode : t Dune_lang.Decoder.t -val extension : t -> Ml_kind.t -> string +val extension : t -> Ml_kind.t -> string option val preprocess : t -> Ml_kind.t -> (Loc.t * Dune_lang.Action.t) option @@ -58,7 +58,7 @@ module DB : sig val fold : t -> init:'a -> f:(dialect -> 'a -> 'a) -> 'a - val extensions_for_merlin : t -> string Ml_kind.Dict.t list + val extensions_for_merlin : t -> string option Ml_kind.Dict.t list val to_dyn : t -> Dyn.t diff --git a/src/dune_rules/merlin/merlin.ml b/src/dune_rules/merlin/merlin.ml index 4f7771ac7bf..47ce13009a2 100644 --- a/src/dune_rules/merlin/merlin.ml +++ b/src/dune_rules/merlin/merlin.ml @@ -47,7 +47,7 @@ module Processed = struct ; obj_dirs : Path.Set.t ; src_dirs : Path.Set.t ; flags : string list - ; extensions : string Ml_kind.Dict.t list + ; extensions : string option Ml_kind.Dict.t list ; melc_flags : string list } @@ -59,7 +59,7 @@ module Processed = struct ; ("obj_dirs", Path.Set.to_dyn obj_dirs) ; ("src_dirs", Path.Set.to_dyn src_dirs) ; ("flags", list string flags) - ; ("extensions", list (Ml_kind.Dict.to_dyn string) extensions) + ; ("extensions", list (Ml_kind.Dict.to_dyn (Dyn.option string)) extensions) ; ("melc_flags", list string melc_flags) ] @@ -118,6 +118,13 @@ module Processed = struct let serialize_path = Path.to_absolute_filename + let get_ext { Ml_kind.Dict.impl; intf } = + match (impl, intf) with + | Some impl, Some intf -> Some (impl, intf) + | Some impl, None -> Some (impl, impl) + | None, Some intf -> Some (intf, intf) + | None, None -> None + let to_sexp ~opens ~pp { stdlib_dir; obj_dirs; src_dirs; flags; extensions; melc_flags } = let make_directive tag value = Sexp.List [ Atom tag; value ] in @@ -171,7 +178,9 @@ module Processed = struct :: flags in let suffixes = - List.map extensions ~f:(fun { Ml_kind.Dict.impl; intf } -> + List.filter_map extensions ~f:(fun x -> + let open Option.O in + let+ impl, intf = get_ext x in make_directive "SUFFIX" (Sexp.Atom (Printf.sprintf "%s %s" impl intf))) in Sexp.List @@ -198,8 +207,9 @@ module Processed = struct printf "STDLIB %s\n" (serialize_path stdlib_dir)); Path.Set.iter obj_dirs ~f:(fun p -> printf "B %s\n" (serialize_path p)); Path.Set.iter src_dirs ~f:(fun p -> printf "S %s\n" (serialize_path p)); - List.iter extensions ~f:(fun { Ml_kind.Dict.impl; intf } -> - printf "SUFFIX %s" (Printf.sprintf "%s %s" impl intf)); + List.iter extensions ~f:(fun x -> + Option.iter (get_ext x) ~f:(fun (impl, intf) -> + printf "SUFFIX %s" (Printf.sprintf "%s %s" impl intf))); (* We print all FLG directives as comments *) List.iter pp_configs ~f: @@ -322,7 +332,7 @@ module Unprocessed = struct ; libname : Lib_name.Local.t option ; source_dirs : Path.Source.Set.t ; objs_dirs : Path.Set.t - ; extensions : string Ml_kind.Dict.t list + ; extensions : string option Ml_kind.Dict.t list ; mode : Lib_mode.t } diff --git a/src/dune_rules/module.ml b/src/dune_rules/module.ml index cbf1d7f6c0b..0c18b2c4159 100644 --- a/src/dune_rules/module.ml +++ b/src/dune_rules/module.ml @@ -374,13 +374,15 @@ let decode_old ~src_dir = ] in let file exists ml_kind = + let open Option.O in if exists then let module_basename n ~(ml_kind : Ml_kind.t) ~(dialect : Dialect.t) = let n = Module_name.to_string n in - String.lowercase n ^ Dialect.extension dialect ml_kind + let+ ext = Dialect.extension dialect ml_kind in + String.lowercase n ^ ext in - let basename = module_basename name ~ml_kind ~dialect:Dialect.ocaml in - Some (File.make Dialect.ocaml (Path.relative src_dir basename)) + let+ basename = module_basename name ~ml_kind ~dialect:Dialect.ocaml in + File.make Dialect.ocaml (Path.relative src_dir basename) else None in let kind = diff --git a/test/blackbox-tests/test-cases/dialects/no_impl.t/.ocamlformat b/test/blackbox-tests/test-cases/dialects/no_impl.t/.ocamlformat new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/dialects/no_impl.t/dune b/test/blackbox-tests/test-cases/dialects/no_impl.t/dune new file mode 100644 index 00000000000..bd4d0d55a2b --- /dev/null +++ b/test/blackbox-tests/test-cases/dialects/no_impl.t/dune @@ -0,0 +1,9 @@ +(executable + (name main) + (public_name main) + (modules main)) + +(executable + (name fmt) + (public_name fmt) + (modules fmt)) diff --git a/test/blackbox-tests/test-cases/dialects/no_impl.t/dune-project b/test/blackbox-tests/test-cases/dialects/no_impl.t/dune-project new file mode 100644 index 00000000000..5bb08f22e80 --- /dev/null +++ b/test/blackbox-tests/test-cases/dialects/no_impl.t/dune-project @@ -0,0 +1,7 @@ +(lang dune 3.9) + +(dialect + (name mlfi) + (interface + (extension mfi) + (format (run fmt %{input-file})))) diff --git a/test/blackbox-tests/test-cases/dialects/no_impl.t/fmt.ml b/test/blackbox-tests/test-cases/dialects/no_impl.t/fmt.ml new file mode 100644 index 00000000000..7ff80db14f4 --- /dev/null +++ b/test/blackbox-tests/test-cases/dialects/no_impl.t/fmt.ml @@ -0,0 +1 @@ +prerr_endline ("Formatting " ^ Sys.argv.(1)) diff --git a/test/blackbox-tests/test-cases/dialects/no_impl.t/main.mfi b/test/blackbox-tests/test-cases/dialects/no_impl.t/main.mfi new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/dialects/no_impl.t/main.ml b/test/blackbox-tests/test-cases/dialects/no_impl.t/main.ml new file mode 100644 index 00000000000..306831a004a --- /dev/null +++ b/test/blackbox-tests/test-cases/dialects/no_impl.t/main.ml @@ -0,0 +1 @@ +let () = () diff --git a/test/blackbox-tests/test-cases/dialects/no_impl.t/main.opam b/test/blackbox-tests/test-cases/dialects/no_impl.t/main.opam new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/dialects/no_impl.t/run.t b/test/blackbox-tests/test-cases/dialects/no_impl.t/run.t new file mode 100644 index 00000000000..f4974a6ef96 --- /dev/null +++ b/test/blackbox-tests/test-cases/dialects/no_impl.t/run.t @@ -0,0 +1,6 @@ +Test the (dialect ...) stanza inside the dune-project file. + + $ dune exec ./main.exe + + $ dune build @fmt + Formatting main.mfi diff --git a/test/blackbox-tests/test-cases/dialects/no_intf_bad.t/.ocamlformat b/test/blackbox-tests/test-cases/dialects/no_intf_bad.t/.ocamlformat new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/dialects/no_intf_bad.t/dune b/test/blackbox-tests/test-cases/dialects/no_intf_bad.t/dune new file mode 100644 index 00000000000..bd4d0d55a2b --- /dev/null +++ b/test/blackbox-tests/test-cases/dialects/no_intf_bad.t/dune @@ -0,0 +1,9 @@ +(executable + (name main) + (public_name main) + (modules main)) + +(executable + (name fmt) + (public_name fmt) + (modules fmt)) diff --git a/test/blackbox-tests/test-cases/dialects/no_intf_bad.t/dune-project b/test/blackbox-tests/test-cases/dialects/no_intf_bad.t/dune-project new file mode 100644 index 00000000000..fd52abed9d0 --- /dev/null +++ b/test/blackbox-tests/test-cases/dialects/no_intf_bad.t/dune-project @@ -0,0 +1,7 @@ +(lang dune 3.8) + +(dialect + (name mlfi) + (implementation + (extension mf) + (format (run fmt %{input-file})))) diff --git a/test/blackbox-tests/test-cases/dialects/no_intf_bad.t/fmt.ml b/test/blackbox-tests/test-cases/dialects/no_intf_bad.t/fmt.ml new file mode 100644 index 00000000000..7ff80db14f4 --- /dev/null +++ b/test/blackbox-tests/test-cases/dialects/no_intf_bad.t/fmt.ml @@ -0,0 +1 @@ +prerr_endline ("Formatting " ^ Sys.argv.(1)) diff --git a/test/blackbox-tests/test-cases/dialects/no_intf_bad.t/main.mf b/test/blackbox-tests/test-cases/dialects/no_intf_bad.t/main.mf new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/dialects/no_intf_bad.t/main.opam b/test/blackbox-tests/test-cases/dialects/no_intf_bad.t/main.opam new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/dialects/no_intf_bad.t/run.t b/test/blackbox-tests/test-cases/dialects/no_intf_bad.t/run.t new file mode 100644 index 00000000000..480a87db7e7 --- /dev/null +++ b/test/blackbox-tests/test-cases/dialects/no_intf_bad.t/run.t @@ -0,0 +1,25 @@ +Test the (dialect ...) stanza inside the dune-project file. + + $ dune exec ./main.exe + File "dune-project", line 3, characters 0-92: + 3 | (dialect + 4 | (name mlfi) + 5 | (implementation + 6 | (extension mf) + 7 | (format (run fmt %{input-file})))) + Error: omitting (interface) in dialects is only available since version 3.9 + of the dune language. Please update your dune-project file to have (lang dune + 3.9). + [1] + + $ dune build @fmt + File "dune-project", line 3, characters 0-92: + 3 | (dialect + 4 | (name mlfi) + 5 | (implementation + 6 | (extension mf) + 7 | (format (run fmt %{input-file})))) + Error: omitting (interface) in dialects is only available since version 3.9 + of the dune language. Please update your dune-project file to have (lang dune + 3.9). + [1] diff --git a/test/blackbox-tests/test-cases/dialects/no_intf_good.t/.ocamlformat b/test/blackbox-tests/test-cases/dialects/no_intf_good.t/.ocamlformat new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/dialects/no_intf_good.t/dune b/test/blackbox-tests/test-cases/dialects/no_intf_good.t/dune new file mode 100644 index 00000000000..bd4d0d55a2b --- /dev/null +++ b/test/blackbox-tests/test-cases/dialects/no_intf_good.t/dune @@ -0,0 +1,9 @@ +(executable + (name main) + (public_name main) + (modules main)) + +(executable + (name fmt) + (public_name fmt) + (modules fmt)) diff --git a/test/blackbox-tests/test-cases/dialects/no_intf_good.t/dune-project b/test/blackbox-tests/test-cases/dialects/no_intf_good.t/dune-project new file mode 100644 index 00000000000..d297ce439ab --- /dev/null +++ b/test/blackbox-tests/test-cases/dialects/no_intf_good.t/dune-project @@ -0,0 +1,7 @@ +(lang dune 3.9) + +(dialect + (name mlfi) + (implementation + (extension mf) + (format (run fmt %{input-file})))) diff --git a/test/blackbox-tests/test-cases/dialects/no_intf_good.t/fmt.ml b/test/blackbox-tests/test-cases/dialects/no_intf_good.t/fmt.ml new file mode 100644 index 00000000000..7ff80db14f4 --- /dev/null +++ b/test/blackbox-tests/test-cases/dialects/no_intf_good.t/fmt.ml @@ -0,0 +1 @@ +prerr_endline ("Formatting " ^ Sys.argv.(1)) diff --git a/test/blackbox-tests/test-cases/dialects/no_intf_good.t/main.mf b/test/blackbox-tests/test-cases/dialects/no_intf_good.t/main.mf new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/dialects/no_intf_good.t/main.opam b/test/blackbox-tests/test-cases/dialects/no_intf_good.t/main.opam new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/dialects/no_intf_good.t/run.t b/test/blackbox-tests/test-cases/dialects/no_intf_good.t/run.t new file mode 100644 index 00000000000..7ca3ddc88e8 --- /dev/null +++ b/test/blackbox-tests/test-cases/dialects/no_intf_good.t/run.t @@ -0,0 +1,6 @@ +Test the (dialect ...) stanza inside the dune-project file. + + $ dune exec ./main.exe + + $ dune build @fmt + Formatting main.mf