From b3838284c6f28aaa0afabf865ce126c20e2f3616 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Dimino?= Date: Thu, 8 Feb 2018 10:12:46 +0000 Subject: [PATCH] Better support for mli/rei only modules (#489) --- CHANGES.md | 2 + doc/jbuild.rst | 13 + src/context.ml | 12 +- src/context.mli | 3 +- src/gen_rules.ml | 272 ++++++++++-------- src/jbuild.ml | 27 +- src/jbuild.mli | 6 +- src/jbuild_load.ml | 2 +- src/module.ml | 41 ++- src/module.mli | 17 +- src/module_compilation.ml | 40 ++- src/ocamldep.ml | 8 +- src/ocamldep.mli | 5 +- src/ordered_set_lang.ml | 202 ++++++++----- src/ordered_set_lang.mli | 39 ++- src/sexp.ml | 3 + src/sexp.mli | 3 + src/super_context.ml | 53 ++-- src/utils.ml | 5 - src/utils.mli | 7 - src/utop.ml | 15 +- test/blackbox-tests/jbuild | 10 + .../test-cases/intf-only/a/jbuild | 2 + .../test-cases/intf-only/a/x.mli | 1 + .../test-cases/intf-only/a/y.mli | 1 + .../test-cases/intf-only/b/jbuild | 3 + .../test-cases/intf-only/b/x.mli | 2 + .../test-cases/intf-only/b/y.mli | 1 + .../test-cases/intf-only/c/jbuild | 3 + .../test-cases/intf-only/d/jbuild | 3 + .../test-cases/intf-only/d/x.ml | 1 + .../test-cases/intf-only/d/x.mli | 1 + .../test-cases/intf-only/foo/foo.ml | 1 + .../test-cases/intf-only/foo/foo.opam | 0 .../test-cases/intf-only/foo/intf.mli | 1 + .../test-cases/intf-only/foo/jbuild | 4 + .../test-cases/intf-only/foo/test/bar.ml | 5 + .../test-cases/intf-only/foo/test/jbuild | 4 + .../blackbox-tests/test-cases/intf-only/run.t | 44 +++ .../test-cases/js_of_ocaml/run.t | 6 +- .../blackbox-tests/test-cases/scope-bug/run.t | 3 +- 41 files changed, 581 insertions(+), 290 deletions(-) create mode 100644 test/blackbox-tests/test-cases/intf-only/a/jbuild create mode 100644 test/blackbox-tests/test-cases/intf-only/a/x.mli create mode 100644 test/blackbox-tests/test-cases/intf-only/a/y.mli create mode 100644 test/blackbox-tests/test-cases/intf-only/b/jbuild create mode 100644 test/blackbox-tests/test-cases/intf-only/b/x.mli create mode 100644 test/blackbox-tests/test-cases/intf-only/b/y.mli create mode 100644 test/blackbox-tests/test-cases/intf-only/c/jbuild create mode 100644 test/blackbox-tests/test-cases/intf-only/d/jbuild create mode 100644 test/blackbox-tests/test-cases/intf-only/d/x.ml create mode 100644 test/blackbox-tests/test-cases/intf-only/d/x.mli create mode 100644 test/blackbox-tests/test-cases/intf-only/foo/foo.ml create mode 100644 test/blackbox-tests/test-cases/intf-only/foo/foo.opam create mode 100644 test/blackbox-tests/test-cases/intf-only/foo/intf.mli create mode 100644 test/blackbox-tests/test-cases/intf-only/foo/jbuild create mode 100644 test/blackbox-tests/test-cases/intf-only/foo/test/bar.ml create mode 100644 test/blackbox-tests/test-cases/intf-only/foo/test/jbuild create mode 100644 test/blackbox-tests/test-cases/intf-only/run.t diff --git a/CHANGES.md b/CHANGES.md index cdace746..24b2b82f 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -26,6 +26,8 @@ next directory can't see each other unless one of them depend on the other (#472) +- Better support for mli/rei only modules (#490) + 1.0+beta17 (01/02/2018) ----------------------- diff --git a/doc/jbuild.rst b/doc/jbuild.rst index 1b3b161a..2059b887 100644 --- a/doc/jbuild.rst +++ b/doc/jbuild.rst @@ -167,6 +167,16 @@ modules you want. build system. It is not for casual uses, see the `re2 library `__ for an example of use +- ``(modules_without_implementation )`` specifies a list of + modules that have only a ``.mli`` or ``.rei`` but no ``.ml`` or + ``.re`` file. Such modules are usually referred as *mli only + modules*. They are not officially supported by the OCaml compiler, + however they are commonly used. Such modules must only define + types. Since it is not reasonably possible for Jbuilder to check + that this is the case, Jbuilder requires the user to explicitly list + such modules to avoid surprises. ```` must be a subset of + the modules listed in the ``(modules ...)`` field. + Note that when binding C libraries, Jbuilder doesn't provide special support for tools such as ``pkg-config``, however it integrates easily with `configurator `__ by using ``(c_flags (:include @@ -250,6 +260,9 @@ binary at the same place as where ``ocamlc`` was found, or when there is a - ``flags``, ``ocamlc_flags`` and ``ocamlopt_flags``. See the section about specifying `OCaml flags`_ +- ``(modules_without_implementation )`` is the same as the + corresponding field of `library`_ + executables ----------- diff --git a/src/context.ml b/src/context.ml index 7889eee7..afba65c6 100644 --- a/src/context.ml +++ b/src/context.ml @@ -52,7 +52,8 @@ type t = ; opam_var_cache : (string, string) Hashtbl.t ; natdynlink_supported : bool ; ocamlc_config : (string * string) list - ; version : string + ; version_string : string + ; version : int * int * int ; stdlib_dir : Path.t ; ccomp_type : string ; c_compiler : string @@ -318,16 +319,16 @@ let create ~(kind : Kind.t) ~path ~base_env ~env_extra ~name ~merlin let get_path var = Path.absolute (get var) in let stdlib_dir = get_path "standard_library" in let natdynlink_supported = Path.exists (Path.relative stdlib_dir "dynlink.cmxa") in - let version = get "version" in + let version_string = get "version" in + let version = Scanf.sscanf version_string "%u.%u.%u" (fun a b c -> a, b, c) in let env, env_extra = (* See comment in ansi_color.ml for setup_env_for_colors. For OCaml < 4.05, OCAML_COLOR is not supported so we use OCAMLPARAM. OCaml 4.02 doesn't support 'color' in OCAMLPARAM, so we just don't force colors with 4.02. *) - let ocaml_version = Scanf.sscanf version "%u.%u" (fun a b -> a, b) in if !Clflags.capture_outputs && Lazy.force Ansi_color.stderr_supports_colors - && ocaml_version > (4, 02) - && ocaml_version < (4, 05) then + && version >= (4, 03, 0) + && version < (4, 05, 0) then let value = match get_env env "OCAMLPARAM" with | None -> "color=always,_" @@ -401,6 +402,7 @@ let create ~(kind : Kind.t) ~path ~base_env ~env_extra ~name ~merlin ; stdlib_dir ; ocamlc_config = String_map.bindings ocamlc_config + ; version_string ; version ; ccomp_type = get "ccomp_type" ; c_compiler diff --git a/src/context.mli b/src/context.mli index 6e325a24..8a00dde7 100644 --- a/src/context.mli +++ b/src/context.mli @@ -88,7 +88,8 @@ type t = ; (** Output of [ocamlc -config] *) ocamlc_config : (string * string) list - ; version : string + ; version_string : string + ; version : int * int * int ; stdlib_dir : Path.t ; ccomp_type : string ; c_compiler : string diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 8c8fd6ed..8ccb6aa6 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -27,21 +27,97 @@ module Gen(P : Params) = struct | Interpretation of [modules] fields | +-----------------------------------------------------------------+ *) - let parse_modules ~dir ~all_modules ~modules_written_by_user = - if Ordered_set_lang.is_standard modules_written_by_user then - all_modules + module Eval_modules = Ordered_set_lang.Make(struct + type t = Module.t + let name = Module.name + end) + + let parse_modules ~all_modules ~buildable = + let conf : Buildable.t = buildable in + let parse ~loc s = + let s = String.capitalize_ascii s in + match String_map.find s all_modules with + | Some m -> m + | None -> Loc.fail loc "Module %s doesn't exist." s + in + let modules = + Eval_modules.eval_unordered + conf.modules + ~parse + ~standard:all_modules + in + let intf_only = + Eval_modules.eval_unordered + conf.modules_without_implementation + ~parse + ~standard:String_map.empty + in + let real_intf_only = + String_map.filter modules + ~f:(fun _ (m : Module.t) -> Option.is_none m.impl) + in + if String_map.equal intf_only real_intf_only + ~cmp:(fun a b -> Module.name a = Module.name b) then + modules else begin - let units = - Ordered_set_lang.eval_with_standard - modules_written_by_user - ~standard:(String_map.keys all_modules) + let should_be_listed, shouldn't_be_listed = + String_map.merge intf_only real_intf_only ~f:(fun name x y -> + match x, y with + | Some _, Some _ -> None + | None , Some _ -> Some (Inl (String.uncapitalize_ascii name)) + | Some _, None -> Some (Inr (String.uncapitalize_ascii name)) + | None , None -> assert false) + |> String_map.values + |> List.partition_map ~f:(fun x -> x) in - List.iter units ~f:(fun unit -> - if not (String_map.mem unit all_modules) then - die "no implementation for module %s in %s" - unit (Path.to_string dir)); - let units = String_set.of_list units in - String_map.filter all_modules ~f:(fun unit _ -> String_set.mem unit units) + let list_modules l = + String.concat ~sep:"\n" (List.map l ~f:(sprintf "- %s")) + in + if should_be_listed <> [] then begin + match Ordered_set_lang.loc conf.modules_without_implementation with + | None -> + Loc.warn conf.loc + "Some modules don't have an implementation.\ + \nYou need to add the following field to this stanza:\ + \n\ + \n %s\ + \n\ + \nThis will become an error in the future." + (Sexp.to_string (List [ Atom "modules_without_implementation" + ; Sexp.To_sexp.(list string) should_be_listed + ])) + | Some loc -> + Loc.warn loc + "The following modules must be listed here as they don't \ + have an implementation:\n\ + %s\n\ + This will become an error in the future." + (list_modules should_be_listed) + end; + if shouldn't_be_listed <> [] then begin + (* Re-evaluate conf.modules_without_implementation but this time keep locations *) + let module Eval = + Ordered_set_lang.Make(struct + type t = Loc.t * Module.t + let name (_, m) = Module.name m + end) + in + let parse ~loc s = (loc, parse ~loc s) in + let shouldn't_be_listed = + Eval.eval_unordered conf.modules_without_implementation + ~parse + ~standard:(String_map.map all_modules ~f:(fun m -> (Loc.none, m))) + |> String_map.values + |> List.filter ~f:(fun (_, (m : Module.t)) -> + Option.is_some m.impl) + in + (* CR-soon jdimino for jdimino: report all errors *) + let loc, m = List.hd shouldn't_be_listed in + Loc.fail loc + "Module %s has an implementation, it cannot be listed here" + m.name + end; + modules end (* +-----------------------------------------------------------------+ @@ -148,35 +224,7 @@ module Gen(P : Params) = struct | Modules listing | +-----------------------------------------------------------------+ *) - let ml_of_mli : _ format = -{|(with-stdout-to %s - (progn - (echo "[@@@warning \"-a\"]\nmodule rec HACK : sig\n") - (cat %s) - (echo "\nend = HACK\ninclude HACK\n")))|} - - let re_of_rei : _ format = -{|(with-stdout-to %s - (progn - (echo "[@@@warning \"-a\"];\nmodule type HACK = {\n") - (cat %s) - (echo "\n};\nmodule rec HACK : HACK = HACK;\ninclude HACK;\n")))|} - - let no_impl_warning : _ format = - {|@{Warning@}: Module %s in %s doesn't have a corresponding .%s file. -Modules without an implementation are not recommended, see this discussion: - - https://github.com/ocaml/dune/issues/9 - -In the meantime I'm implicitely adding this rule: - -(rule %s) - -Add it to your jbuild file to remove this warning. -|} - let guess_modules ~dir ~files = - let src_dir = Path.drop_build_context_exn dir in let impl_files, intf_files = String_set.elements files |> List.filter_map ~f:(fun fn -> @@ -196,54 +244,19 @@ Add it to your jbuild file to remove this warning. |> function | Ok x -> x | Error (name, f1, f2) -> + let src_dir = Path.drop_build_context_exn dir in die "too many files for module %s in %s: %s and %s" - name (Path.to_string dir) f1.name f2.name + name (Path.to_string src_dir) f1.name f2.name in let impls = parse_one_set impl_files in let intfs = parse_one_set intf_files in - let setup_intf_only name (intf : Module.File.t) = - let impl_fname = String.sub intf.name ~pos:0 ~len:(String.length intf.name - 1) in - let action_str = - sprintf - (match intf.syntax with - | OCaml -> ml_of_mli - | Reason -> re_of_rei) - impl_fname intf.name - in - Format.eprintf no_impl_warning - name (Path.to_string src_dir) - (match intf.syntax with - | OCaml -> "ml" - | Reason -> "re") - action_str; - let action = - Usexp.parse_string action_str - ~fname:"" - ~mode:Single - |> Action.Unexpanded.t - in - SC.add_rule sctx - (Build.return [] - >>> - SC.Action.run sctx action - ~dir - ~dep_kind:Required - ~targets:Infer - ~scope:( - Lib_db.Scope.required_in_jbuild (SC.Libs.anonymous_scope sctx) - ~jbuild_dir:src_dir - )); - { intf with name = impl_fname } in String_map.merge impls intfs ~f:(fun name impl intf -> - let impl = - match impl with - | None -> setup_intf_only name (Option.value_exn intf) - | Some i -> i in Some { Module.name ; impl ; intf - ; obj_name = "" } + ; obj_name = "" + } ) let modules_by_dir = @@ -265,33 +278,41 @@ Add it to your jbuild file to remove this warning. Hashtbl.find_or_add cache (dir, lib.name) ~f:(fun _ -> let all_modules = modules_by_dir ~dir in let modules = - parse_modules ~dir ~all_modules ~modules_written_by_user:lib.buildable.modules + parse_modules ~all_modules ~buildable:lib.buildable in let main_module_name = String.capitalize_ascii lib.name in let modules = String_map.map modules ~f:(fun (m : Module.t) -> - if not lib.wrapped || m.name = main_module_name then - { m with obj_name = Utils.obj_name_of_basename m.impl.name } - else - { m with obj_name = sprintf "%s__%s" lib.name m.name }) + let wrapper = + if not lib.wrapped || m.name = main_module_name then + None + else + Some lib.name + in + Module.set_obj_name m ~wrapper) in let alias_module = if not lib.wrapped || (String_map.cardinal modules = 1 && String_map.mem main_module_name modules) then None - else - let suf = - if String_map.mem main_module_name modules then - "__" - else - "" - in + else if String_map.mem main_module_name modules then Some - { Module.name = main_module_name ^ suf - ; impl = { name = lib.name ^ suf ^ ".ml-gen" ; syntax = OCaml } + { Module.name = main_module_name ^ "__" + ; impl = None + ; intf = Some { name = lib.name ^ "__.mli-gen" + ; syntax = OCaml + } + ; obj_name = lib.name ^ "__" + } + else + Some + { Module.name = main_module_name + ; impl = Some { name = lib.name ^ ".ml-gen" + ; syntax = OCaml + } ; intf = None - ; obj_name = lib.name ^ suf + ; obj_name = lib.name } in { modules; alias_module; main_module_name }) @@ -447,8 +468,7 @@ Add it to your jbuild file to remove this warning. (* In 4.02, the compiler reads the cmi for module alias even with [-w -49 -no-alias-deps], so we must sandbox the build of the alias module since the modules it references are built after. *) - let alias_module_build_sandbox = Scanf.sscanf ctx.version "%u.%u" - (fun a b -> a, b) <= (4, 02) + let alias_module_build_sandbox = ctx.version < (4, 03, 0) let library_rules (lib : Library.t) ~dir ~files ~(scope : Lib_db.Scope.t With_required_by.t) = @@ -462,7 +482,8 @@ Add it to your jbuild file to remove this warning. ~preprocess:lib.buildable.preprocess ~preprocessor_deps:lib.buildable.preprocessor_deps ~lint:lib.buildable.lint - ~lib_name:(Some lib.name) in + ~lib_name:(Some lib.name) + in let modules = match alias_module with @@ -479,6 +500,11 @@ Add it to your jbuild file to remove this warning. in Option.iter alias_module ~f:(fun m -> + let file = + match m.impl with + | Some f -> f + | None -> Option.value_exn m.intf + in SC.add_rule sctx (Build.return (String_map.values (String_map.remove m.name modules) @@ -488,7 +514,7 @@ Add it to your jbuild file to remove this warning. main_module_name m.name m.name (Module.real_unit_name m)) |> String.concat ~sep:"\n") - >>> Build.write_file_dyn (Path.relative dir m.impl.name))); + >>> Build.write_file_dyn (Path.relative dir file.name))); let requires, real_requires = SC.Libs.requires sctx ~dir ~scope ~dep_kind ~item:lib.name @@ -596,7 +622,9 @@ Add it to your jbuild file to remove this warning. List.iter Cm_kind.all ~f:(fun cm_kind -> let files = String_map.fold modules ~init:[] ~f:(fun ~key:_ ~data:m acc -> - Module.cm_file m ~obj_dir cm_kind :: acc) + match Module.cm_file m ~obj_dir cm_kind with + | None -> acc + | Some fn -> fn :: acc) in SC.Libs.setup_file_deps_alias sctx (dir, lib) ~ext:(Cm_kind.ext cm_kind) files); @@ -606,8 +634,8 @@ Add it to your jbuild file to remove this warning. Path.relative dir (header ^ ".h"))); let top_sorted_modules = - Build.memoize "top sorted modules" ( - Ocamldep.Dep_graph.top_closed dep_graphs.impl (String_map.values modules)) + Ocamldep.Dep_graph.top_closed_implementations dep_graphs.impl + (String_map.values modules) in List.iter Mode.all ~f:(fun mode -> build_lib lib ~scope:scope.data ~flags ~dir ~obj_dir ~mode ~top_sorted_modules); @@ -732,26 +760,28 @@ Add it to your jbuild file to remove this warning. let executables_rules (exes : Executables.t) ~dir ~all_modules ~(scope : Lib_db.Scope.t With_required_by.t) = - let item = List.hd exes.names in + let item = snd (List.hd exes.names) in (* Use "eobjs" rather than "objs" to avoid a potential conflict with a library of the same name *) let obj_dir = Path.relative dir ("." ^ item ^ ".eobjs") in let dep_kind = Build.Required in let flags = Ocaml_flags.make exes.buildable sctx ~scope:scope.data ~dir in let modules = - parse_modules ~dir ~all_modules ~modules_written_by_user:exes.buildable.modules + parse_modules ~all_modules ~buildable:exes.buildable in let modules = - String_map.map modules ~f:(fun (m : Module.t) -> - { m with obj_name = Utils.obj_name_of_basename m.impl.name }) + String_map.map modules ~f:(Module.set_obj_name ~wrapper:None) in let programs = - List.map exes.names ~f:(fun name -> - match String_map.find (String.capitalize_ascii name) modules with - | Some m -> (name, m) - | None -> - die "executable %s in %s doesn't have a corresponding .ml file" - name (Path.to_string dir)) + List.map exes.names ~f:(fun (loc, name) -> + let mod_name = String.capitalize_ascii name in + match String_map.find mod_name modules with + | Some m -> + if not (Module.has_impl m) then + Loc.fail loc "Module %s has no implementation." mod_name + else + (name, m) + | None -> Loc.fail loc "Module %s doesn't exist." mod_name) in let modules = @@ -785,8 +815,8 @@ Add it to your jbuild file to remove this warning. List.iter programs ~f:(fun (name, unit) -> let top_sorted_modules = - Build.memoize "top sorted modules" - (Ocamldep.Dep_graph.top_closed dep_graphs.impl [unit]) + Ocamldep.Dep_graph.top_closed_implementations dep_graphs.impl + [unit] in List.iter Mode.all ~f:(fun mode -> build_exe ~js_of_ocaml:exes.buildable.js_of_ocaml ~flags ~scope:scope.data @@ -974,12 +1004,16 @@ Add it to your jbuild file to remove this warning. List.concat [ List.concat_map modules ~f:(fun m -> List.concat - [ [ Module.cm_file m ~obj_dir Cmi ] - ; if_ native [ Module.cm_file m ~obj_dir Cmx ] + [ [ Module.cm_file_unsafe m ~obj_dir Cmi ] + ; if_ (native && Module.has_impl m) + [ Module.cm_file_unsafe m ~obj_dir Cmx ] ; List.filter_map Ml_kind.all ~f:(Module.cmt_file m ~obj_dir) - ; [ match Module.file m ~dir Intf with - | Some fn -> fn - | None -> Path.relative dir m.impl.name ] + ; [ let file = + match m.intf with + | Some f -> f + | None -> Option.value_exn m.impl + in + Path.relative dir file.name ] ]) ; if_ byte [ lib_archive ~dir lib ~ext:".cma" ] ; if_ (Library.has_stubs lib) [ stubs_archive ~dir lib ] diff --git a/src/jbuild.ml b/src/jbuild.ml index 79c0cbf5..819cbc52 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -444,7 +444,9 @@ end module Buildable = struct type t = - { modules : Ordered_set_lang.t + { loc : Loc.t + ; modules : Ordered_set_lang.t + ; modules_without_implementation : Ordered_set_lang.t ; libraries : Lib_dep.t list ; preprocess : Preprocess_map.t ; preprocessor_deps : Dep_conf.t list @@ -456,7 +458,11 @@ module Buildable = struct ; gen_dot_merlin : bool } + let modules_field name = + field name Ordered_set_lang.t ~default:Ordered_set_lang.standard + let v1 = + record_loc >>= fun loc -> field "preprocess" Preprocess_map.t ~default:Preprocess_map.default >>= fun preprocess -> field "preprocessor_deps" (list Dep_conf.t) ~default:[] @@ -465,9 +471,10 @@ module Buildable = struct this *) field "lint" Lint.t ~default:Lint.default >>= fun lint -> - field "modules" (fun s -> Ordered_set_lang.(map (t s)) ~f:String.capitalize_ascii) - ~default:Ordered_set_lang.standard + modules_field "modules" >>= fun modules -> + modules_field "modules_without_implementation" + >>= fun modules_without_implementation -> field "libraries" Lib_deps.t ~default:[] >>= fun libraries -> field_oslu "flags" >>= fun flags -> @@ -475,10 +482,12 @@ module Buildable = struct field_oslu "ocamlopt_flags" >>= fun ocamlopt_flags -> field "js_of_ocaml" (Js_of_ocaml.t) ~default:Js_of_ocaml.default >>= fun js_of_ocaml -> return - { preprocess + { loc + ; preprocess ; preprocessor_deps ; lint ; modules + ; modules_without_implementation ; libraries ; flags ; ocamlc_flags @@ -649,7 +658,7 @@ end module Executables = struct type t = - { names : string list + { names : (Loc.t * string) list ; link_executables : bool ; link_flags : Ordered_set_lang.Unexpanded.t ; modes : Mode.Dict.Set.t @@ -678,7 +687,7 @@ module Executables = struct let to_install = let ext = if modes.native then ".exe" else ".bc" in List.map2 names public_names - ~f:(fun name pub -> + ~f:(fun (_, name) pub -> match pub with | None -> None | Some pub -> Some ({ Install_conf. src = name ^ ext; dst = Some pub })) @@ -703,7 +712,7 @@ module Executables = struct let v1_multi pkgs = record - (field "names" (list string) >>= fun names -> + (field "names" (list (located string)) >>= fun names -> map_validate (field_o "public_names" (list public_name)) ~f:(function | None -> Ok (List.map names ~f:(fun _ -> None)) | Some public_names -> @@ -717,7 +726,7 @@ module Executables = struct let v1_single pkgs = record - (field "name" string >>= fun name -> + (field "name" (located string) >>= fun name -> field_o "public_name" string >>= fun public_name -> common_v1 pkgs [name] [public_name] ~multi:false) end @@ -1003,7 +1012,7 @@ module Stanzas = struct let rec v1 pkgs ~file ~include_stack : Stanza.t list Sexp.Of_sexp.t = sum - [ cstr "library" (Library.v1 pkgs @> nil) (fun x -> [Library x]) + [ cstr "library" (Library.v1 pkgs @> nil) (fun x -> [Library x]) ; cstr "executable" (Executables.v1_single pkgs @> nil) execs ; cstr "executables" (Executables.v1_multi pkgs @> nil) execs ; cstr_loc "rule" (Rule.v1 @> nil) (fun loc x -> [Rule { x with loc }]) diff --git a/src/jbuild.mli b/src/jbuild.mli index fe1ab2da..671f6a2f 100644 --- a/src/jbuild.mli +++ b/src/jbuild.mli @@ -112,7 +112,9 @@ end module Buildable : sig type t = - { modules : Ordered_set_lang.t + { loc : Loc.t + ; modules : Ordered_set_lang.t + ; modules_without_implementation : Ordered_set_lang.t ; libraries : Lib_dep.t list ; preprocess : Preprocess_map.t ; preprocessor_deps : Dep_conf.t list @@ -189,7 +191,7 @@ end module Executables : sig type t = - { names : string list + { names : (Loc.t * string) list ; link_executables : bool ; link_flags : Ordered_set_lang.Unexpanded.t ; modes : Mode.Dict.Set.t diff --git a/src/jbuild_load.ml b/src/jbuild_load.ml index 9a5b47b5..3629df8a 100644 --- a/src/jbuild_load.ml +++ b/src/jbuild_load.ml @@ -91,7 +91,7 @@ end # 1 %S %s|} context.name - context.version + context.version_string (String.concat ~sep:"\n ; " (let longest = List.longest_map context.ocamlc_config ~f:fst in List.map context.ocamlc_config ~f:(fun (k, v) -> diff --git a/src/module.ml b/src/module.ml index cc293818..50df47ac 100644 --- a/src/module.ml +++ b/src/module.ml @@ -27,7 +27,7 @@ end type t = { name : string - ; impl : File.t + ; impl : File.t option ; intf : File.t option ; obj_name : string } @@ -36,20 +36,31 @@ let name t = t.name let real_unit_name t = String.capitalize_ascii (Filename.basename t.obj_name) +let has_impl t = Option.is_some t.impl + let file t ~dir (kind : Ml_kind.t) = - match kind with - | Impl -> Some (Path.relative dir t.impl.name) - | Intf -> Option.map t.intf ~f:(fun f -> Path.relative dir f.name) + let file = + match kind with + | Impl -> t.impl + | Intf -> t.intf + in + Option.map file ~f:(fun f -> Path.relative dir f.name) let obj_file t ~obj_dir ~ext = Path.relative obj_dir (t.obj_name ^ ext) let cm_source t ~dir kind = file t ~dir (Cm_kind.source kind) -let cm_file t ~obj_dir kind = obj_file t ~obj_dir ~ext:(Cm_kind.ext kind) +let cm_file_unsafe t ~obj_dir kind = + obj_file t ~obj_dir ~ext:(Cm_kind.ext kind) + +let cm_file t ~obj_dir (kind : Cm_kind.t) = + match kind with + | (Cmx | Cmo) when not (has_impl t) -> None + | _ -> Some (cm_file_unsafe t ~obj_dir kind) let cmt_file t ~obj_dir (kind : Ml_kind.t) = match kind with - | Impl -> Some ( obj_file t ~obj_dir ~ext:".cmt" ) + | Impl -> Option.map t.impl ~f:(fun _ -> obj_file t ~obj_dir ~ext:".cmt" ) | Intf -> Option.map t.intf ~f:(fun _ -> obj_file t ~obj_dir ~ext:".cmti") let odoc_file t ~doc_dir = obj_file t ~obj_dir:doc_dir~ext:".odoc" @@ -60,5 +71,21 @@ let cmti_file t ~obj_dir = | Some _ -> obj_file t ~obj_dir ~ext:".cmti" let iter t ~f = - f Ml_kind.Impl t.impl; + Option.iter t.impl ~f:(f Ml_kind.Impl); Option.iter t.intf ~f:(f Ml_kind.Intf) + +let set_obj_name t ~wrapper = + match wrapper with + | Some s -> { t with obj_name = sprintf "%s__%s" s t.name } + | None -> + let fn = + match t.impl with + | Some f -> f.name + | None -> (Option.value_exn t.intf).name + in + let obj_name = + match String.index fn '.' with + | None -> fn + | Some i -> String.sub fn ~pos:0 ~len:i + in + { t with obj_name } diff --git a/src/module.mli b/src/module.mli index aac69341..6ddceb62 100644 --- a/src/module.mli +++ b/src/module.mli @@ -16,7 +16,7 @@ end type t = { name : string (** Name of the module. This is always the basename of the filename without the extension. *) - ; impl : File.t + ; impl : File.t option ; intf : File.t option ; obj_name : string (** Object name. It is different from [name] for wrapped @@ -28,16 +28,25 @@ val name : t -> string (** Real unit name once wrapped. This is always a valid module name. *) val real_unit_name : t -> string -val file : t -> dir:Path.t -> Ml_kind.t -> Path.t option -val cm_source : t -> dir:Path.t -> Cm_kind.t -> Path.t option -val cm_file : t -> obj_dir:Path.t -> Cm_kind.t -> Path.t +val file : t -> dir: Path.t -> Ml_kind.t -> Path.t option +val cm_source : t -> dir: Path.t -> Cm_kind.t -> Path.t option +val cm_file : t -> obj_dir:Path.t -> Cm_kind.t -> Path.t option val cmt_file : t -> obj_dir:Path.t -> Ml_kind.t -> Path.t option val obj_file : t -> obj_dir:Path.t -> ext:string -> Path.t +(** Same as [cm_file] but doesn't raise if [cm_kind] is [Cmo] or [Cmx] + and the module has no implementation. *) +val cm_file_unsafe : t -> obj_dir:Path.t -> Cm_kind.t -> Path.t + val odoc_file : t -> doc_dir:Path.t -> Path.t (** Either the .cmti, or .cmt if the module has no interface *) val cmti_file : t -> obj_dir:Path.t -> Path.t val iter : t -> f:(Ml_kind.t -> File.t -> unit) -> unit + +val has_impl : t -> bool + +(** Set the [obj_name] field of the module. [wrapper] might be a library name. *) +val set_obj_name : t -> wrapper:string option -> t diff --git a/src/module_compilation.ml b/src/module_compilation.ml index ac998d2e..b5be1610 100644 --- a/src/module_compilation.ml +++ b/src/module_compilation.ml @@ -12,7 +12,7 @@ module Target : sig val file : Path.t -> t -> Path.t end = struct type t = Path.t - let cm m cm_kind = Module.cm_file m ~obj_dir:Path.root cm_kind + let cm m cm_kind = Module.cm_file_unsafe m ~obj_dir:Path.root cm_kind let obj m ~ext = Module.obj_file m ~obj_dir:Path.root ~ext let cmt m ml_kind = Module.cmt_file m ~obj_dir:Path.root ml_kind let file dir t = Path.append dir t @@ -24,7 +24,7 @@ let build_cm sctx ?sandbox ~dynlink ~flags ~cm_kind ~dep_graphs Option.iter (Mode.of_cm_kind cm_kind |> Context.compiler ctx) ~f:(fun compiler -> Option.iter (Module.cm_source ~dir m cm_kind) ~f:(fun src -> let ml_kind = Cm_kind.source cm_kind in - let dst = Module.cm_file m ~obj_dir cm_kind in + let dst = Module.cm_file_unsafe m ~obj_dir cm_kind in let extra_args, extra_deps, other_targets = match cm_kind, m.intf with (* If there is no mli, [ocamlY -c file.ml] produces both the @@ -37,14 +37,14 @@ let build_cm sctx ?sandbox ~dynlink ~flags ~cm_kind ~dep_graphs cmi exists and reads it instead of re-creating it, which could create a race condition. *) [ "-intf-suffix" - ; Filename.extension m.impl.name + ; Filename.extension (Option.value_exn m.impl).name ], - [Module.cm_file m ~obj_dir Cmi], + [Module.cm_file_unsafe m ~obj_dir Cmi], [] | Cmi, None -> assert false | Cmi, Some _ -> [], [], [] (* We need the .cmi to build either the .cmo or .cmx *) - | (Cmo | Cmx), Some _ -> [], [Module.cm_file m ~obj_dir Cmi], [] + | (Cmo | Cmx), Some _ -> [], [Module.cm_file_unsafe m ~obj_dir Cmi], [] in let other_targets = match cm_kind with @@ -57,11 +57,11 @@ let build_cm sctx ?sandbox ~dynlink ~flags ~cm_kind ~dep_graphs (Ocamldep.Dep_graph.deps_of dep_graph m >>^ fun deps -> List.concat_map deps ~f:(fun m -> - match cm_kind with - | Cmi | Cmo -> [Module.cm_file m ~obj_dir Cmi] - | Cmx -> [ Module.cm_file m ~obj_dir Cmi - ; Module.cm_file m ~obj_dir Cmx - ])) + let deps = [Module.cm_file_unsafe m ~obj_dir Cmi] in + if Module.has_impl m && cm_kind = Cmx then + Module.cm_file_unsafe m ~obj_dir Cmx :: deps + else + deps)) in let other_targets, cmt_args = match cm_kind with @@ -74,12 +74,18 @@ let build_cm sctx ?sandbox ~dynlink ~flags ~cm_kind ~dep_graphs if obj_dir <> dir then begin (* Symlink the object files in the original directory for backward compatibility *) - let old_dst = Module.cm_file m ~obj_dir:dir cm_kind in + let old_dst = Module.cm_file_unsafe m ~obj_dir:dir cm_kind in SC.add_rule sctx (Build.symlink ~src:dst ~dst:old_dst) ; List.iter2 extra_targets other_targets ~f:(fun in_obj_dir target -> let in_dir = Target.file dir target in SC.add_rule sctx (Build.symlink ~src:in_obj_dir ~dst:in_dir)) end; + let opaque = + if cm_kind = Cmi && not (Module.has_impl m) && ctx.version >= (4, 03, 0) then + Arg_spec.A "-opaque" + else + As [] + in SC.add_rule sctx ?sandbox (Build.paths extra_deps >>> other_cm_files >>> @@ -92,7 +98,7 @@ let build_cm sctx ?sandbox ~dynlink ~flags ~cm_kind ~dep_graphs ; Dyn (fun (libs, _) -> Lib.include_flags libs ~stdlib_dir:ctx.stdlib_dir) ; As extra_args ; if dynlink || cm_kind <> Cmx then As [] else A "-nodynlink" - ; A "-no-alias-deps" + ; A "-no-alias-deps"; opaque ; A "-I"; Path obj_dir ; (match alias_module with | None -> S [] @@ -108,9 +114,13 @@ let build_module sctx ?sandbox ~dynlink ~js_of_ocaml ~flags m ~scope ~dir build_cm sctx ?sandbox ~dynlink ~flags ~dir ~obj_dir ~dep_graphs m ~cm_kind ~requires ~alias_module); (* Build *.cmo.js *) - let src = Module.cm_file m ~obj_dir Cm_kind.Cmo in - let target = Path.extend_basename (Module.cm_file m ~obj_dir:dir Cm_kind.Cmo) ~suffix:".js" in - SC.add_rules sctx (Js_of_ocaml_rules.build_cm sctx ~scope ~dir ~js_of_ocaml ~src ~target) + let src = Module.cm_file_unsafe m ~obj_dir Cm_kind.Cmo in + let target = + Path.extend_basename (Module.cm_file_unsafe m ~obj_dir:dir Cm_kind.Cmo) + ~suffix:".js" + in + SC.add_rules sctx + (Js_of_ocaml_rules.build_cm sctx ~scope ~dir ~js_of_ocaml ~src ~target) let build_modules sctx ~dynlink ~js_of_ocaml ~flags ~scope ~dir ~obj_dir ~dep_graphs ~modules ~requires ~alias_module = diff --git a/src/ocamldep.ml b/src/ocamldep.ml index 38794dd5..84ba559b 100644 --- a/src/ocamldep.ml +++ b/src/ocamldep.ml @@ -40,6 +40,12 @@ module Dep_graph = struct (String.concat ~sep:"\n-> " (List.map cycle ~f:Module.name)) + let top_closed_implementations t modules = + Build.memoize "top sorted implementations" ( + let filter_out_intf_only = List.filter ~f:Module.has_impl in + top_closed t (filter_out_intf_only modules) + >>^ filter_out_intf_only) + let dummy (m : Module.t) = { dir = Path.root ; per_module = String_map.singleton m.name (Build.return []) @@ -106,7 +112,7 @@ let parse_deps ~dir ~file ~(unit : Module.t) in deps -let rules sctx ~ml_kind ~dir ~modules ~alias_module ~lib_interface_module = +let rules sctx ~(ml_kind:Ml_kind.t) ~dir ~modules ~alias_module ~lib_interface_module = let per_module = String_map.map modules ~f:(fun unit -> match Module.file ~dir unit ml_kind with diff --git a/src/ocamldep.mli b/src/ocamldep.mli index aa0d733e..38beb707 100644 --- a/src/ocamldep.mli +++ b/src/ocamldep.mli @@ -10,7 +10,10 @@ module Dep_graph : sig -> Module.t -> (unit, Module.t list) Build.t - val top_closed : t -> Module.t list -> (unit, Module.t list) Build.t + val top_closed_implementations + : t + -> Module.t list + -> (unit, Module.t list) Build.t end module Dep_graphs : sig diff --git a/src/ordered_set_lang.ml b/src/ordered_set_lang.ml index 3e8574bd..e2e88ed2 100644 --- a/src/ordered_set_lang.ml +++ b/src/ordered_set_lang.ml @@ -12,9 +12,17 @@ module Ast = struct | Include : String_with_vars.t -> ('a, unexpanded) t end -type t = (string, Ast.expanded) Ast.t +type 'ast generic = + { ast : 'ast + ; loc : Loc.t option + } -let parse_general t ~f = +type ast_expanded = (Loc.t * string, Ast.expanded) Ast.t +type t = ast_expanded generic + +let loc t = t.loc + +let parse_general sexp ~f = let rec of_sexp : Sexp.Ast.t -> _ = function | Atom (loc, "\\") -> Loc.fail loc "unexpected \\" | Atom (_, "") as t -> Ast.Element (f t) @@ -30,58 +38,116 @@ let parse_general t ~f = of_sexps (of_sexp elt :: acc) sexps | [] -> Union (List.rev acc) in - of_sexp t + of_sexp sexp -let t t : t = parse_general t ~f:(function Atom (_, s) -> s | List _ -> assert false) - -let eval t ~special_values = - let rec of_ast (t : t) = - let open Ast in - match t with - | Element s -> [s] - | Special (loc, name) -> - begin - match List.assoc name special_values with - | l -> l - | exception Not_found -> Loc.fail loc "undefined symbol %s" name; - end - | Union elts -> List.flatten (List.map elts ~f:of_ast) - | Diff (left, right) -> - let left = of_ast left in - let right = of_ast right in - List.filter left ~f:(fun acc_elt -> not (List.mem acc_elt ~set:right)) +let t sexp : t = + let ast = + parse_general sexp ~f:(function + | Atom (loc, s) -> (loc, s) + | List _ -> assert false) in - of_ast t + { ast + ; loc = Some (Sexp.Ast.loc sexp) + } -let is_standard : t -> bool = function +let is_standard t = + match (t.ast : ast_expanded) with | Ast.Special (_, "standard") -> true | _ -> false -let eval_with_standard t ~standard = - if is_standard t then - standard (* inline common case *) - else - eval t ~special_values:[("standard", standard)] +module type Value = sig + type t + val name : t -> string +end -let rec map (t : t) ~f : t = - let open Ast in - match t with - | Element s -> Element (f s) - | Special _ -> t - | Union l -> Union (List.map l ~f:(map ~f)) - | Diff (l, r) -> Diff (map l ~f, map r ~f) +module Make(Value : Value) = struct + module type Named_values = sig + type t -let standard = Ast.Special (Loc.none, "standard") + val singleton : Value.t -> t + val union : t list -> t + val diff : t -> t -> t + end -let append a b = Ast.Union [a; b] + module Make(M : Named_values) = struct + let eval t ~parse ~special_values = + let rec of_ast (t : ast_expanded) = + let open Ast in + match t with + | Element (loc, s) -> + let x = parse ~loc s in + M.singleton x + | Special (loc, name) -> begin + match String_map.find name special_values with + | Some x -> x + | None -> Loc.fail loc "undefined symbol %s" name + end + | Union elts -> M.union (List.map elts ~f:of_ast) + | Diff (left, right) -> + let left = of_ast left in + let right = of_ast right in + M.diff left right + in + of_ast t.ast + end + + module Ordered = Make(struct + type t = Value.t list + + let singleton x = [x] + let union = List.flatten + let diff a b = + List.filter a ~f:(fun x -> + List.for_all b ~f:(fun y -> Value.name x <> Value.name y)) + end) + + module Unordered = Make(struct + type t = Value.t String_map.t + + let singleton x = String_map.singleton (Value.name x) x + + let union l = + List.fold_left l ~init:String_map.empty ~f:(fun acc t -> + String_map.merge acc t ~f:(fun _name x y -> + match x, y with + | Some x, _ | _, Some x -> Some x + | _ -> None)) + + let diff a b = + String_map.merge a b ~f:(fun _name x y -> + match x, y with + | Some _, None -> x + | _ -> None) + end) + + let eval t ~parse ~standard = + if is_standard t then + standard (* inline common case *) + else + Ordered.eval t ~parse + ~special_values:(String_map.singleton "standard" standard) + + let eval_unordered t ~parse ~standard = + if is_standard t then + standard (* inline common case *) + else + Unordered.eval t ~parse + ~special_values:(String_map.singleton "standard" standard) +end + +let standard = + { ast = Ast.Special (Loc.none, "standard") + ; loc = None + } module Unexpanded = struct - type t = (Sexp.Ast.t, Ast.unexpanded) Ast.t - let t t = + type ast = (Sexp.Ast.t, Ast.unexpanded) Ast.t + type t = ast generic + let t sexp = let rec map (t : (Sexp.Ast.t, Ast.expanded) Ast.t) = let open Ast in match t with - | Element s -> Element s + | Element x -> Element x | Union [Special (_, "include"); Element fn] -> Include (String_with_vars.t fn) | Union [Special (loc, "include"); _] @@ -93,14 +159,14 @@ module Unexpanded = struct | Diff (l, r) -> Diff (map l, map r) in - parse_general t ~f:(fun x -> x) |> map + { ast = map (parse_general sexp ~f:(fun x -> x)) + ; loc = Some (Sexp.Ast.loc sexp) + } let standard = standard - let append = append - let files t ~f = - let rec loop acc (t : t) = + let rec loop acc (t : ast) = let open Ast in match t with | Element _ @@ -112,27 +178,31 @@ module Unexpanded = struct | Diff (l, r) -> loop (loop acc l) r in - loop String_set.empty t + loop String_set.empty t.ast - let rec expand (t : t) ~files_contents ~f : (string, Ast.expanded) Ast.t = - let open Ast in - match t with - | Element s -> Element (f (String_with_vars.t s)) - | Special (l, s) -> Special (l, s) - | Include fn -> - parse_general - (let fn = f fn in - match String_map.find fn files_contents with - | Some x -> x - | None -> - Sexp.code_error - "Ordered_set_lang.Unexpanded.expand" - [ "included-file", Atom fn - ; "files", Sexp.To_sexp.(list string) (String_map.keys files_contents) - ]) - ~f:(fun s -> f (String_with_vars.t s)) - | Union l -> - Union (List.map l ~f:(expand ~files_contents ~f)) - | Diff (l, r) -> - Diff (expand l ~files_contents ~f, expand r ~files_contents ~f) + let expand t ~files_contents ~f = + let rec expand (t : ast) : ast_expanded = + let open Ast in + match t with + | Element s -> Element (Sexp.Ast.loc s, f (String_with_vars.t s)) + | Special (l, s) -> Special (l, s) + | Include fn -> + let sexp = + let fn = f fn in + match String_map.find fn files_contents with + | Some x -> x + | None -> + Sexp.code_error + "Ordered_set_lang.Unexpanded.expand" + [ "included-file", Atom fn + ; "files", Sexp.To_sexp.(list string) (String_map.keys files_contents) + ] + in + parse_general sexp ~f:(fun sexp -> + (Sexp.Ast.loc sexp, f (String_with_vars.t sexp))) + | Union l -> Union (List.map l ~f:expand) + | Diff (l, r) -> + Diff (expand l, expand r) + in + { t with ast = expand t.ast } end diff --git a/src/ordered_set_lang.mli b/src/ordered_set_lang.mli index f4e95c00..e451aa09 100644 --- a/src/ordered_set_lang.mli +++ b/src/ordered_set_lang.mli @@ -6,13 +6,34 @@ open Import type t val t : t Sexp.Of_sexp.t -val eval_with_standard : t -> standard:string list -> string list +(** Return the location of the set. [loc standard] returns [None] *) +val loc : t -> Loc.t option + +(** Value parsed from elements in the DSL *) +module type Value = sig + type t + val name : t -> string +end + +module Make(Value : Value) : sig + (** Evaluate an ordered set. [standard] is the interpretation of [:standard] inside the + DSL. *) + val eval + : t + -> parse:(loc:Loc.t -> string -> Value.t) + -> standard:Value.t list + -> Value.t list + + (** Same as [eval] but the result is unordered *) + val eval_unordered + : t + -> parse:(loc:Loc.t -> string -> Value.t) + -> standard:Value.t String_map.t + -> Value.t String_map.t +end + val standard : t val is_standard : t -> bool -val append : t -> t -> t - -(** Map non-variable atoms *) -val map : t -> f:(string -> string) -> t module Unexpanded : sig type expanded = t @@ -20,13 +41,15 @@ module Unexpanded : sig val t : t Sexp.Of_sexp.t val standard : t - val append : t -> t -> t - (** List of files needed to expand this set *) val files : t -> f:(String_with_vars.t -> string) -> String_set.t (** Expand [t] using with the given file contents. [file_contents] is a map from filenames to their parsed contents. Every [(:include fn)] in [t] is replaced by [Map.find files_contents fn]. Every element is converted to a string using [f]. *) - val expand : t -> files_contents:Sexp.Ast.t String_map.t -> f:(String_with_vars.t -> string) -> expanded + val expand + : t + -> files_contents:Sexp.Ast.t String_map.t + -> f:(String_with_vars.t -> string) + -> expanded end with type expanded := t diff --git a/src/sexp.ml b/src/sexp.ml index 1daba8db..1a2e51a1 100644 --- a/src/sexp.ml +++ b/src/sexp.ml @@ -212,6 +212,9 @@ module Of_sexp = struct let x, state = m state in f x state + let record_loc state = + (state.loc, state) + let consume name state = { state with unparsed = Name_map.remove name state.unparsed diff --git a/src/sexp.mli b/src/sexp.mli index 3cfa2b2d..98f87307 100644 --- a/src/sexp.mli +++ b/src/sexp.mli @@ -54,6 +54,9 @@ module Of_sexp : sig val return : 'a -> 'a record_parser val ( >>= ) : 'a record_parser -> ('a -> 'b record_parser) -> 'b record_parser + (** Return the location of the record being parsed *) + val record_loc : Loc.t record_parser + val field : string -> ?default:'a -> 'a t -> 'a record_parser val field_o : string -> 'a t -> 'a option record_parser val field_b : string -> bool record_parser diff --git a/src/super_context.ml b/src/super_context.ml index 9b58b385..bbdb8688 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -157,7 +157,7 @@ let create ; "OCAML" , Paths ([context.ocaml], Split) ; "OCAMLC" , Paths ([context.ocamlc], Split) ; "OCAMLOPT" , Paths ([ocamlopt], Split) - ; "ocaml_version" , Strings ([context.version], Concat) + ; "ocaml_version" , Strings ([context.version_string], Concat) ; "ocaml_where" , Paths ([context.stdlib_dir], Concat) ; "ARCH_SIXTYFOUR" , Strings ([string_of_bool context.arch_sixtyfour], Concat) @@ -762,17 +762,14 @@ module PP = struct fn ^ ".pp" ^ ext let pped_module ~dir (m : Module.t) ~f = - let ml_pp_fname = pp_fname m.impl.name in - f Ml_kind.Impl (Path.relative dir m.impl.name) (Path.relative dir ml_pp_fname); - let intf = - Option.map m.intf ~f:(fun intf -> - let pp_fname = pp_fname intf.name in - f Intf (Path.relative dir intf.name) (Path.relative dir pp_fname); - {intf with name = pp_fname}) + let pped_file (kind : Ml_kind.t) (file : Module.File.t) = + let pp_fname = pp_fname file.name in + f kind (Path.relative dir file.name) (Path.relative dir pp_fname); + {file with name = pp_fname} in { m with - impl = { m.impl with name = ml_pp_fname } - ; intf + impl = Option.map m.impl ~f:(pped_file Impl) + ; intf = Option.map m.intf ~f:(pped_file Intf) } let migrate_driver_main = "ocaml-migrate-parsetree.driver-main" @@ -941,22 +938,18 @@ module PP = struct ; A "binary" ; Dep src_path ] ~stdout_to:(Path.relative dir target) in - let impl = - match m.impl.syntax with - | OCaml -> m.impl + let to_ml (f : Module.File.t) = + match f.syntax with + | OCaml -> f | Reason -> - let ml = Module.File.to_ocaml m.impl in - add_rule sctx (rule m.impl.name ml.name); - ml in - let intf = - Option.map m.intf ~f:(fun f -> - match f.syntax with - | OCaml -> f - | Reason -> - let mli = Module.File.to_ocaml f in - add_rule sctx (rule f.name mli.name); - mli) in - { m with impl ; intf } + let ml = Module.File.to_ocaml f in + add_rule sctx (rule f.name ml.name); + ml + in + { m with + impl = Option.map m.impl ~f:to_ml + ; intf = Option.map m.intf ~f:to_ml + } let uses_ppx_driver ~pps = match Option.map ~f:Pp.to_string (List.last pps) with @@ -1088,17 +1081,23 @@ module PP = struct ) end +module Eval_strings = Ordered_set_lang.Make(struct + type t = string + let name t = t + end) + let expand_and_eval_set t ~scope ~dir set ~standard = let open Build.O in let f = expand_vars t ~scope ~dir in + let parse ~loc:_ s = s in match Ordered_set_lang.Unexpanded.files set ~f |> String_set.elements with | [] -> let set = Ordered_set_lang.Unexpanded.expand set ~files_contents:String_map.empty ~f in - Build.return (Ordered_set_lang.eval_with_standard set ~standard) + Build.return (Eval_strings.eval set ~standard ~parse) | files -> let paths = List.map files ~f:(Path.relative dir) in Build.all (List.map paths ~f:Build.read_sexp) >>^ fun sexps -> let files_contents = List.combine files sexps |> String_map.of_alist_exn in let set = Ordered_set_lang.Unexpanded.expand set ~files_contents ~f in - Ordered_set_lang.eval_with_standard set ~standard + Eval_strings.eval set ~standard ~parse diff --git a/src/utils.ml b/src/utils.ml index a58a40d6..c559429b 100644 --- a/src/utils.ml +++ b/src/utils.ml @@ -133,11 +133,6 @@ let g () = else [] -let obj_name_of_basename fn = - match String.index fn '.' with - | None -> fn - | Some i -> String.sub fn ~pos:0 ~len:i - let install_file ~package ~findlib_toolchain = match findlib_toolchain with | None -> package ^ ".install" diff --git a/src/utils.mli b/src/utils.mli index 12fd461a..6126bf15 100644 --- a/src/utils.mli +++ b/src/utils.mli @@ -39,13 +39,6 @@ val library_not_found : ?context:string -> ?hint:string -> string -> _ (** [\["-g"\]] if [!Clflags.g] and [\[\]] otherwise *) val g : unit -> string list -(** Base name of the object file (.o) for a given source file basename: - - - [obj_name_of_basename "toto.ml" = "toto"] - - [obj_name_of_basename "toto.pp.ml" = "toto"] -*) -val obj_name_of_basename : string -> string - val install_file : package:string -> findlib_toolchain:string option -> string (** Digest files with caching *) diff --git a/src/utop.ml b/src/utop.ml index 3d603507..4a87a33b 100644 --- a/src/utop.ml +++ b/src/utop.ml @@ -37,7 +37,7 @@ let add_module_rules sctx ~dir lib_requires = Super_context.add_rule sctx utop_ml let utop_of_libs (libs : Library.t list) = - { Executables.names = [exe_name] + { Executables.names = [(Loc.none, exe_name)] ; link_executables = true ; link_flags = Ordered_set_lang.Unexpanded.t ( Sexp.add_loc ~loc:Loc.none @@ -47,8 +47,11 @@ let utop_of_libs (libs : Library.t list) = ) ; modes = Mode.Dict.Set.of_list [Mode.Byte] ; buildable = - { Buildable.modules = + { Buildable. + loc = Loc.none + ; modules = Ordered_set_lang.t (List (Loc.none, [Atom (Loc.none, module_name)])) + ; modules_without_implementation = Ordered_set_lang.standard ; libraries = (Lib_dep.direct "utop") :: (List.map libs ~f:(fun lib -> Lib_dep.direct lib.Library.name)) @@ -77,10 +80,10 @@ let exe_stanzas stanzas = [ module_name , { Module. name = module_name - ; impl = { Module.File. - name = module_filename - ; syntax = Module.Syntax.OCaml - } + ; impl = Some { Module.File. + name = module_filename + ; syntax = Module.Syntax.OCaml + } ; intf = None ; obj_name = "" } ] in diff --git a/test/blackbox-tests/jbuild b/test/blackbox-tests/jbuild index bad8f780..9604516e 100644 --- a/test/blackbox-tests/jbuild +++ b/test/blackbox-tests/jbuild @@ -287,3 +287,13 @@ (progn (run ${exe:cram.exe} run.t) (diff? run.t run.t.corrected))))))) + +(alias + ((name runtest) + (deps ((files_recursively_in test-cases/intf-only))) + (action + (chdir test-cases/intf-only + (setenv JBUILDER ${bin:jbuilder} + (progn + (run ${exe:cram.exe} run.t) + (diff? run.t run.t.corrected))))))) diff --git a/test/blackbox-tests/test-cases/intf-only/a/jbuild b/test/blackbox-tests/test-cases/intf-only/a/jbuild new file mode 100644 index 00000000..58e64b7f --- /dev/null +++ b/test/blackbox-tests/test-cases/intf-only/a/jbuild @@ -0,0 +1,2 @@ +(library + ((name foo))) diff --git a/test/blackbox-tests/test-cases/intf-only/a/x.mli b/test/blackbox-tests/test-cases/intf-only/a/x.mli new file mode 100644 index 00000000..975adb53 --- /dev/null +++ b/test/blackbox-tests/test-cases/intf-only/a/x.mli @@ -0,0 +1 @@ +type t = int diff --git a/test/blackbox-tests/test-cases/intf-only/a/y.mli b/test/blackbox-tests/test-cases/intf-only/a/y.mli new file mode 100644 index 00000000..975adb53 --- /dev/null +++ b/test/blackbox-tests/test-cases/intf-only/a/y.mli @@ -0,0 +1 @@ +type t = int diff --git a/test/blackbox-tests/test-cases/intf-only/b/jbuild b/test/blackbox-tests/test-cases/intf-only/b/jbuild new file mode 100644 index 00000000..3b7aebe8 --- /dev/null +++ b/test/blackbox-tests/test-cases/intf-only/b/jbuild @@ -0,0 +1,3 @@ +(library + ((name foo) + (modules_without_implementation (x)))) diff --git a/test/blackbox-tests/test-cases/intf-only/b/x.mli b/test/blackbox-tests/test-cases/intf-only/b/x.mli new file mode 100644 index 00000000..5626a7d5 --- /dev/null +++ b/test/blackbox-tests/test-cases/intf-only/b/x.mli @@ -0,0 +1,2 @@ +type t = int + diff --git a/test/blackbox-tests/test-cases/intf-only/b/y.mli b/test/blackbox-tests/test-cases/intf-only/b/y.mli new file mode 100644 index 00000000..975adb53 --- /dev/null +++ b/test/blackbox-tests/test-cases/intf-only/b/y.mli @@ -0,0 +1 @@ +type t = int diff --git a/test/blackbox-tests/test-cases/intf-only/c/jbuild b/test/blackbox-tests/test-cases/intf-only/c/jbuild new file mode 100644 index 00000000..3b7aebe8 --- /dev/null +++ b/test/blackbox-tests/test-cases/intf-only/c/jbuild @@ -0,0 +1,3 @@ +(library + ((name foo) + (modules_without_implementation (x)))) diff --git a/test/blackbox-tests/test-cases/intf-only/d/jbuild b/test/blackbox-tests/test-cases/intf-only/d/jbuild new file mode 100644 index 00000000..3b7aebe8 --- /dev/null +++ b/test/blackbox-tests/test-cases/intf-only/d/jbuild @@ -0,0 +1,3 @@ +(library + ((name foo) + (modules_without_implementation (x)))) diff --git a/test/blackbox-tests/test-cases/intf-only/d/x.ml b/test/blackbox-tests/test-cases/intf-only/d/x.ml new file mode 100644 index 00000000..7fecab12 --- /dev/null +++ b/test/blackbox-tests/test-cases/intf-only/d/x.ml @@ -0,0 +1 @@ +let x = 42 diff --git a/test/blackbox-tests/test-cases/intf-only/d/x.mli b/test/blackbox-tests/test-cases/intf-only/d/x.mli new file mode 100644 index 00000000..48451390 --- /dev/null +++ b/test/blackbox-tests/test-cases/intf-only/d/x.mli @@ -0,0 +1 @@ +val x : int diff --git a/test/blackbox-tests/test-cases/intf-only/foo/foo.ml b/test/blackbox-tests/test-cases/intf-only/foo/foo.ml new file mode 100644 index 00000000..e0ba3908 --- /dev/null +++ b/test/blackbox-tests/test-cases/intf-only/foo/foo.ml @@ -0,0 +1 @@ +module T = Intf diff --git a/test/blackbox-tests/test-cases/intf-only/foo/foo.opam b/test/blackbox-tests/test-cases/intf-only/foo/foo.opam new file mode 100644 index 00000000..e69de29b diff --git a/test/blackbox-tests/test-cases/intf-only/foo/intf.mli b/test/blackbox-tests/test-cases/intf-only/foo/intf.mli new file mode 100644 index 00000000..b24f39fe --- /dev/null +++ b/test/blackbox-tests/test-cases/intf-only/foo/intf.mli @@ -0,0 +1 @@ +type t = A | B | C diff --git a/test/blackbox-tests/test-cases/intf-only/foo/jbuild b/test/blackbox-tests/test-cases/intf-only/foo/jbuild new file mode 100644 index 00000000..1bb66992 --- /dev/null +++ b/test/blackbox-tests/test-cases/intf-only/foo/jbuild @@ -0,0 +1,4 @@ +(library + ((name foo) + (public_name foo) + (modules_without_implementation (intf)))) diff --git a/test/blackbox-tests/test-cases/intf-only/foo/test/bar.ml b/test/blackbox-tests/test-cases/intf-only/foo/test/bar.ml new file mode 100644 index 00000000..c37a1be7 --- /dev/null +++ b/test/blackbox-tests/test-cases/intf-only/foo/test/bar.ml @@ -0,0 +1,5 @@ +module X = Foo.T + +let x = X.A + +include Foo.T diff --git a/test/blackbox-tests/test-cases/intf-only/foo/test/jbuild b/test/blackbox-tests/test-cases/intf-only/foo/test/jbuild new file mode 100644 index 00000000..08fa1a94 --- /dev/null +++ b/test/blackbox-tests/test-cases/intf-only/foo/test/jbuild @@ -0,0 +1,4 @@ +(library + ((name bar) + (public_name foo.bar) + (libraries (foo)))) diff --git a/test/blackbox-tests/test-cases/intf-only/run.t b/test/blackbox-tests/test-cases/intf-only/run.t new file mode 100644 index 00000000..66cc0d06 --- /dev/null +++ b/test/blackbox-tests/test-cases/intf-only/run.t @@ -0,0 +1,44 @@ +Successes: + + $ $JBUILDER build --display short --root foo -j1 --debug-dep 2>&1 | grep -v Entering + ocamldep test/bar.ml.d + ocamldep foo.ml.d + ocamlc .foo.objs/foo__.{cmi,cmti} + ocamldep intf.mli.d + ocamlc .foo.objs/foo__Intf.{cmi,cmti} + ocamlc .foo.objs/foo.{cmi,cmo,cmt} + ocamlopt .foo.objs/foo.{cmx,o} + ocamlc test/.bar.objs/bar.{cmi,cmo,cmt} + ocamlc foo.cma + ocamlopt foo.{a,cmxa} + ocamlopt test/.bar.objs/bar.{cmx,o} + ocamlc test/bar.cma + ocamlopt foo.cmxs + ocamlopt test/bar.{a,cmxa} + ocamlopt test/bar.cmxs + +Errors: + + $ $JBUILDER build --display short --root a -j1 foo.cma 2>&1 | grep -v Entering + File "jbuild", line 2, characters 1-13: + Warning: Some modules don't have an implementation. + You need to add the following field to this stanza: + + (modules_without_implementation (x y)) + + This will become an error in the future. + ocamlc .foo.objs/foo.{cmi,cmo,cmt} + ocamlc foo.cma + $ $JBUILDER build --display short --root b -j1 foo.cma 2>&1 | grep -v Entering + File "jbuild", line 3, characters 34-37: + Warning: The following modules must be listed here as they don't have an implementation: + - y + This will become an error in the future. + ocamlc .foo.objs/foo.{cmi,cmo,cmt} + ocamlc foo.cma + $ $JBUILDER build --display short --root c -j1 foo.cma 2>&1 | grep -v Entering + File "jbuild", line 1, characters 0-58: + Error: Module X doesn't exist. + $ $JBUILDER build --display short --root d -j1 foo.cma 2>&1 | grep -v Entering + File "jbuild", line 1, characters 0-58: + Error: Module X has an implementation, it cannot be listed here diff --git a/test/blackbox-tests/test-cases/js_of_ocaml/run.t b/test/blackbox-tests/test-cases/js_of_ocaml/run.t index 96c4b40a..2109d024 100644 --- a/test/blackbox-tests/test-cases/js_of_ocaml/run.t +++ b/test/blackbox-tests/test-cases/js_of_ocaml/run.t @@ -1,13 +1,12 @@ $ $JBUILDER build -j1 --display short --root . --dev bin/technologic.bc.js @install lib/x.cma.js lib/x__Y.cmo.js bin/z.cmo.js ocamlc lib/stubs.o ocamlopt .ppx/js_of_ocaml-ppx/ppx.exe - ocamlc lib/.x.objs/x__.{cmi,cmo,cmt} + ocamlc lib/.x.objs/x__.{cmi,cmti} ocamlmklib lib/dllx_stubs.so,lib/libx_stubs.a ppx lib/x.pp.ml ppx lib/y.pp.ml ppx bin/technologic.pp.ml ppx bin/z.pp.ml - ocamlopt lib/.x.objs/x__.{cmx,o} ocamldep lib/x.pp.ml.d ocamldep lib/y.pp.ml.d ocamldep bin/technologic.pp.ml.d @@ -35,9 +34,8 @@ break it fix it $ $JBUILDER build -j1 --display short --root . bin/technologic.bc.js @install - ocamlc lib/.x.objs/x__.{cmi,cmo,cmt} + ocamlc lib/.x.objs/x__.{cmi,cmti} ocamlc lib/.x.objs/x__Y.{cmi,cmo,cmt} - ocamlopt lib/.x.objs/x__.{cmx,o} ocamlc lib/.x.objs/x.{cmi,cmo,cmt} ocamlopt lib/.x.objs/x__Y.{cmx,o} ocamlc lib/x.cma diff --git a/test/blackbox-tests/test-cases/scope-bug/run.t b/test/blackbox-tests/test-cases/scope-bug/run.t index 66b3b909..426eda0c 100644 --- a/test/blackbox-tests/test-cases/scope-bug/run.t +++ b/test/blackbox-tests/test-cases/scope-bug/run.t @@ -1,10 +1,9 @@ $ $JBUILDER build -j1 --display short --root . @install ocamldep alib/alib.ml.d ocamldep alib/main.ml.d - ocamlc alib/.alib.objs/alib__.{cmi,cmo,cmt} + ocamlc alib/.alib.objs/alib__.{cmi,cmti} ocamldep blib/blib.ml.d ocamldep blib/sub/sub.ml.d - ocamlopt alib/.alib.objs/alib__.{cmx,o} ocamlc blib/sub/.sub.objs/sub.{cmi,cmo,cmt} ocamlopt blib/sub/.sub.objs/sub.{cmx,o} ocamlc blib/.blib.objs/blib.{cmi,cmo,cmt}