matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Better support for mli/rei only modules (#489)

This commit is contained in:
Jérémie Dimino 2018-02-08 10:12:46 +00:00 committed by GitHub
parent f083b6a2cd
commit b3838284c6
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
41 changed files with 581 additions and 290 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
CHANGES.md
View File

@ -26,6 +26,8 @@ next
directory can't see each other unless one of them depend on the directory can't see each other unless one of them depend on the
other (#472) other (#472)
- Better support for mli/rei only modules (#490)
1.0+beta17 (01/02/2018) 1.0+beta17 (01/02/2018)
----------------------- -----------------------

13
doc/jbuild.rst
View File

@ -167,6 +167,16 @@ modules you want.
build system. It is not for casual uses, see the `re2 library build system. It is not for casual uses, see the `re2 library
<https://github.com/janestreet/re2>`__ for an example of use <https://github.com/janestreet/re2>`__ for an example of use
- ``(modules_without_implementation <modules>)`` 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. ``<modules>`` 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 Note that when binding C libraries, Jbuilder doesn't provide special support for
tools such as ``pkg-config``, however it integrates easily with `configurator tools such as ``pkg-config``, however it integrates easily with `configurator
<https://github.com/janestreet/configurator>`__ by using ``(c_flags (:include <https://github.com/janestreet/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 - ``flags``, ``ocamlc_flags`` and ``ocamlopt_flags``. See the section about
specifying `OCaml flags`_ specifying `OCaml flags`_
- ``(modules_without_implementation <modules>)`` is the same as the
corresponding field of `library`_
executables executables
----------- -----------

12
src/context.ml
View File

@ -52,7 +52,8 @@ type t =
; opam_var_cache : (string, string) Hashtbl.t ; opam_var_cache : (string, string) Hashtbl.t
; natdynlink_supported : bool ; natdynlink_supported : bool
; ocamlc_config : (string * string) list ; ocamlc_config : (string * string) list
; version : string ; version_string : string
; version : int * int * int
; stdlib_dir : Path.t ; stdlib_dir : Path.t
; ccomp_type : string ; ccomp_type : string
; c_compiler : 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 get_path var = Path.absolute (get var) in
let stdlib_dir = get_path "standard_library" in let stdlib_dir = get_path "standard_library" in
let natdynlink_supported = Path.exists (Path.relative stdlib_dir "dynlink.cmxa") 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 = let env, env_extra =
(* See comment in ansi_color.ml for setup_env_for_colors. For OCaml < 4.05, (* 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 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. *) '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 if !Clflags.capture_outputs
&& Lazy.force Ansi_color.stderr_supports_colors && Lazy.force Ansi_color.stderr_supports_colors
&& ocaml_version > (4, 02) && version >= (4, 03, 0)
&& ocaml_version < (4, 05) then && version < (4, 05, 0) then
let value = let value =
match get_env env "OCAMLPARAM" with match get_env env "OCAMLPARAM" with
| None -> "color=always,_" | None -> "color=always,_"
@ -401,6 +402,7 @@ let create ~(kind : Kind.t) ~path ~base_env ~env_extra ~name ~merlin
; stdlib_dir ; stdlib_dir
; ocamlc_config = String_map.bindings ocamlc_config ; ocamlc_config = String_map.bindings ocamlc_config
; version_string
; version ; version
; ccomp_type = get "ccomp_type" ; ccomp_type = get "ccomp_type"
; c_compiler ; c_compiler

3
src/context.mli
View File

@ -88,7 +88,8 @@ type t =
; (** Output of [ocamlc -config] *) ; (** Output of [ocamlc -config] *)
ocamlc_config : (string * string) list ocamlc_config : (string * string) list
; version : string ; version_string : string
; version : int * int * int
; stdlib_dir : Path.t ; stdlib_dir : Path.t
; ccomp_type : string ; ccomp_type : string
; c_compiler : string ; c_compiler : string

272
src/gen_rules.ml
View File

@ -27,21 +27,97 @@ module Gen(P : Params) = struct
| Interpretation of [modules] fields | | Interpretation of [modules] fields |
+-----------------------------------------------------------------+ *) +-----------------------------------------------------------------+ *)
let parse_modules ~dir ~all_modules ~modules_written_by_user = module Eval_modules = Ordered_set_lang.Make(struct
if Ordered_set_lang.is_standard modules_written_by_user then type t = Module.t
all_modules 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 else begin
let units = let should_be_listed, shouldn't_be_listed =
Ordered_set_lang.eval_with_standard String_map.merge intf_only real_intf_only ~f:(fun name x y ->
modules_written_by_user match x, y with
~standard:(String_map.keys all_modules) | 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 in
List.iter units ~f:(fun unit -> let list_modules l =
if not (String_map.mem unit all_modules) then String.concat ~sep:"\n" (List.map l ~f:(sprintf "- %s"))
die "no implementation for module %s in %s" in
unit (Path.to_string dir)); if should_be_listed <> [] then begin
let units = String_set.of_list units in match Ordered_set_lang.loc conf.modules_without_implementation with
String_map.filter all_modules ~f:(fun unit _ -> String_set.mem unit units) | 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 end
(* +-----------------------------------------------------------------+ (* +-----------------------------------------------------------------+
@ -148,35 +224,7 @@ module Gen(P : Params) = struct
| Modules listing | | 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>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 guess_modules ~dir ~files =
let src_dir = Path.drop_build_context_exn dir in
let impl_files, intf_files = let impl_files, intf_files =
String_set.elements files String_set.elements files
|> List.filter_map ~f:(fun fn -> |> List.filter_map ~f:(fun fn ->
@ -196,54 +244,19 @@ Add it to your jbuild file to remove this warning.
|> function |> function
| Ok x -> x | Ok x -> x
| Error (name, f1, f2) -> | 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" 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 in
let impls = parse_one_set impl_files in let impls = parse_one_set impl_files in
let intfs = parse_one_set intf_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:"<internal action for mli to ml>"
~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 -> 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 Some
{ Module.name { Module.name
; impl ; impl
; intf ; intf
; obj_name = "" } ; obj_name = ""
}
) )
let modules_by_dir = 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 _ -> Hashtbl.find_or_add cache (dir, lib.name) ~f:(fun _ ->
let all_modules = modules_by_dir ~dir in let all_modules = modules_by_dir ~dir in
let modules = let modules =
parse_modules ~dir ~all_modules ~modules_written_by_user:lib.buildable.modules parse_modules ~all_modules ~buildable:lib.buildable
in in
let main_module_name = String.capitalize_ascii lib.name in let main_module_name = String.capitalize_ascii lib.name in
let modules = let modules =
String_map.map modules ~f:(fun (m : Module.t) -> String_map.map modules ~f:(fun (m : Module.t) ->
if not lib.wrapped || m.name = main_module_name then let wrapper =
{ m with obj_name = Utils.obj_name_of_basename m.impl.name } if not lib.wrapped || m.name = main_module_name then
else None
{ m with obj_name = sprintf "%s__%s" lib.name m.name }) else
Some lib.name
in
Module.set_obj_name m ~wrapper)
in in
let alias_module = let alias_module =
if not lib.wrapped || if not lib.wrapped ||
(String_map.cardinal modules = 1 && (String_map.cardinal modules = 1 &&
String_map.mem main_module_name modules) then String_map.mem main_module_name modules) then
None None
else else if String_map.mem main_module_name modules then
let suf =
if String_map.mem main_module_name modules then
"__"
else
""
in
Some Some
{ Module.name = main_module_name ^ suf { Module.name = main_module_name ^ "__"
; impl = { name = lib.name ^ suf ^ ".ml-gen" ; syntax = OCaml } ; 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 ; intf = None
; obj_name = lib.name ^ suf ; obj_name = lib.name
} }
in in
{ modules; alias_module; main_module_name }) { 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 (* 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 -no-alias-deps], so we must sandbox the build of the alias module since the modules
it references are built after. *) it references are built after. *)
let alias_module_build_sandbox = Scanf.sscanf ctx.version "%u.%u" let alias_module_build_sandbox = ctx.version < (4, 03, 0)
(fun a b -> a, b) <= (4, 02)
let library_rules (lib : Library.t) ~dir ~files let library_rules (lib : Library.t) ~dir ~files
~(scope : Lib_db.Scope.t With_required_by.t) = ~(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 ~preprocess:lib.buildable.preprocess
~preprocessor_deps:lib.buildable.preprocessor_deps ~preprocessor_deps:lib.buildable.preprocessor_deps
~lint:lib.buildable.lint ~lint:lib.buildable.lint
~lib_name:(Some lib.name) in ~lib_name:(Some lib.name)
in
let modules = let modules =
match alias_module with match alias_module with
@ -479,6 +500,11 @@ Add it to your jbuild file to remove this warning.
in in
Option.iter alias_module ~f:(fun m -> 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 SC.add_rule sctx
(Build.return (Build.return
(String_map.values (String_map.remove m.name modules) (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 main_module_name m.name
m.name (Module.real_unit_name m)) m.name (Module.real_unit_name m))
|> String.concat ~sep:"\n") |> 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 = let requires, real_requires =
SC.Libs.requires sctx ~dir ~scope ~dep_kind ~item:lib.name 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 -> List.iter Cm_kind.all ~f:(fun cm_kind ->
let files = let files =
String_map.fold modules ~init:[] ~f:(fun ~key:_ ~data:m acc -> 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 in
SC.Libs.setup_file_deps_alias sctx (dir, lib) ~ext:(Cm_kind.ext cm_kind) SC.Libs.setup_file_deps_alias sctx (dir, lib) ~ext:(Cm_kind.ext cm_kind)
files); files);
@ -606,8 +634,8 @@ Add it to your jbuild file to remove this warning.
Path.relative dir (header ^ ".h"))); Path.relative dir (header ^ ".h")));
let top_sorted_modules = let top_sorted_modules =
Build.memoize "top sorted modules" ( Ocamldep.Dep_graph.top_closed_implementations dep_graphs.impl
Ocamldep.Dep_graph.top_closed dep_graphs.impl (String_map.values modules)) (String_map.values modules)
in in
List.iter Mode.all ~f:(fun mode -> List.iter Mode.all ~f:(fun mode ->
build_lib lib ~scope:scope.data ~flags ~dir ~obj_dir ~mode ~top_sorted_modules); 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 let executables_rules (exes : Executables.t) ~dir ~all_modules
~(scope : Lib_db.Scope.t With_required_by.t) = ~(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 (* Use "eobjs" rather than "objs" to avoid a potential conflict with a library of the
same name *) same name *)
let obj_dir = Path.relative dir ("." ^ item ^ ".eobjs") in let obj_dir = Path.relative dir ("." ^ item ^ ".eobjs") in
let dep_kind = Build.Required in let dep_kind = Build.Required in
let flags = Ocaml_flags.make exes.buildable sctx ~scope:scope.data ~dir in let flags = Ocaml_flags.make exes.buildable sctx ~scope:scope.data ~dir in
let modules = let modules =
parse_modules ~dir ~all_modules ~modules_written_by_user:exes.buildable.modules parse_modules ~all_modules ~buildable:exes.buildable
in in
let modules = let modules =
String_map.map modules ~f:(fun (m : Module.t) -> String_map.map modules ~f:(Module.set_obj_name ~wrapper:None)
{ m with obj_name = Utils.obj_name_of_basename m.impl.name })
in in
let programs = let programs =
List.map exes.names ~f:(fun name -> List.map exes.names ~f:(fun (loc, name) ->
match String_map.find (String.capitalize_ascii name) modules with let mod_name = String.capitalize_ascii name in
| Some m -> (name, m) match String_map.find mod_name modules with
| None -> | Some m ->
die "executable %s in %s doesn't have a corresponding .ml file" if not (Module.has_impl m) then
name (Path.to_string dir)) 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 in
let modules = let modules =
@ -785,8 +815,8 @@ Add it to your jbuild file to remove this warning.
List.iter programs ~f:(fun (name, unit) -> List.iter programs ~f:(fun (name, unit) ->
let top_sorted_modules = let top_sorted_modules =
Build.memoize "top sorted modules" Ocamldep.Dep_graph.top_closed_implementations dep_graphs.impl
(Ocamldep.Dep_graph.top_closed dep_graphs.impl [unit]) [unit]
in in
List.iter Mode.all ~f:(fun mode -> List.iter Mode.all ~f:(fun mode ->
build_exe ~js_of_ocaml:exes.buildable.js_of_ocaml ~flags ~scope:scope.data 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
[ List.concat_map modules ~f:(fun m -> [ List.concat_map modules ~f:(fun m ->
List.concat List.concat
[ [ Module.cm_file m ~obj_dir Cmi ] [ [ Module.cm_file_unsafe m ~obj_dir Cmi ]
; if_ native [ Module.cm_file m ~obj_dir Cmx ] ; 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) ; List.filter_map Ml_kind.all ~f:(Module.cmt_file m ~obj_dir)
; [ match Module.file m ~dir Intf with ; [ let file =
| Some fn -> fn match m.intf with
| None -> Path.relative dir m.impl.name ] | Some f -> f
| None -> Option.value_exn m.impl
in
Path.relative dir file.name ]
]) ])
; if_ byte [ lib_archive ~dir lib ~ext:".cma" ] ; if_ byte [ lib_archive ~dir lib ~ext:".cma" ]
; if_ (Library.has_stubs lib) [ stubs_archive ~dir lib ] ; if_ (Library.has_stubs lib) [ stubs_archive ~dir lib ]

27
src/jbuild.ml
View File

@ -444,7 +444,9 @@ end
module Buildable = struct module Buildable = struct
type t = 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 ; libraries : Lib_dep.t list
; preprocess : Preprocess_map.t ; preprocess : Preprocess_map.t
; preprocessor_deps : Dep_conf.t list ; preprocessor_deps : Dep_conf.t list
@ -456,7 +458,11 @@ module Buildable = struct
; gen_dot_merlin : bool ; gen_dot_merlin : bool
} }
let modules_field name =
field name Ordered_set_lang.t ~default:Ordered_set_lang.standard
let v1 = let v1 =
record_loc >>= fun loc ->
field "preprocess" Preprocess_map.t ~default:Preprocess_map.default field "preprocess" Preprocess_map.t ~default:Preprocess_map.default
>>= fun preprocess -> >>= fun preprocess ->
field "preprocessor_deps" (list Dep_conf.t) ~default:[] field "preprocessor_deps" (list Dep_conf.t) ~default:[]
@ -465,9 +471,10 @@ module Buildable = struct
this *) this *)
field "lint" Lint.t ~default:Lint.default field "lint" Lint.t ~default:Lint.default
>>= fun lint -> >>= fun lint ->
field "modules" (fun s -> Ordered_set_lang.(map (t s)) ~f:String.capitalize_ascii) modules_field "modules"
~default:Ordered_set_lang.standard
>>= fun modules -> >>= fun modules ->
modules_field "modules_without_implementation"
>>= fun modules_without_implementation ->
field "libraries" Lib_deps.t ~default:[] field "libraries" Lib_deps.t ~default:[]
>>= fun libraries -> >>= fun libraries ->
field_oslu "flags" >>= fun flags -> field_oslu "flags" >>= fun flags ->
@ -475,10 +482,12 @@ module Buildable = struct
field_oslu "ocamlopt_flags" >>= fun ocamlopt_flags -> field_oslu "ocamlopt_flags" >>= fun ocamlopt_flags ->
field "js_of_ocaml" (Js_of_ocaml.t) ~default:Js_of_ocaml.default >>= fun js_of_ocaml -> field "js_of_ocaml" (Js_of_ocaml.t) ~default:Js_of_ocaml.default >>= fun js_of_ocaml ->
return return
{ preprocess { loc
; preprocess
; preprocessor_deps ; preprocessor_deps
; lint ; lint
; modules ; modules
; modules_without_implementation
; libraries ; libraries
; flags ; flags
; ocamlc_flags ; ocamlc_flags
@ -649,7 +658,7 @@ end
module Executables = struct module Executables = struct
type t = type t =
{ names : string list { names : (Loc.t * string) list
; link_executables : bool ; link_executables : bool
; link_flags : Ordered_set_lang.Unexpanded.t ; link_flags : Ordered_set_lang.Unexpanded.t
; modes : Mode.Dict.Set.t ; modes : Mode.Dict.Set.t
@ -678,7 +687,7 @@ module Executables = struct
let to_install = let to_install =
let ext = if modes.native then ".exe" else ".bc" in let ext = if modes.native then ".exe" else ".bc" in
List.map2 names public_names List.map2 names public_names
~f:(fun name pub -> ~f:(fun (_, name) pub ->
match pub with match pub with
| None -> None | None -> None
| Some pub -> Some ({ Install_conf. src = name ^ ext; dst = Some pub })) | Some pub -> Some ({ Install_conf. src = name ^ ext; dst = Some pub }))
@ -703,7 +712,7 @@ module Executables = struct
let v1_multi pkgs = let v1_multi pkgs =
record 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 map_validate (field_o "public_names" (list public_name)) ~f:(function
| None -> Ok (List.map names ~f:(fun _ -> None)) | None -> Ok (List.map names ~f:(fun _ -> None))
| Some public_names -> | Some public_names ->
@ -717,7 +726,7 @@ module Executables = struct
let v1_single pkgs = let v1_single pkgs =
record record
(field "name" string >>= fun name -> (field "name" (located string) >>= fun name ->
field_o "public_name" string >>= fun public_name -> field_o "public_name" string >>= fun public_name ->
common_v1 pkgs [name] [public_name] ~multi:false) common_v1 pkgs [name] [public_name] ~multi:false)
end end
@ -1003,7 +1012,7 @@ module Stanzas = struct
let rec v1 pkgs ~file ~include_stack : Stanza.t list Sexp.Of_sexp.t = let rec v1 pkgs ~file ~include_stack : Stanza.t list Sexp.Of_sexp.t =
sum 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 "executable" (Executables.v1_single pkgs @> nil) execs
; cstr "executables" (Executables.v1_multi pkgs @> nil) execs ; cstr "executables" (Executables.v1_multi pkgs @> nil) execs
; cstr_loc "rule" (Rule.v1 @> nil) (fun loc x -> [Rule { x with loc }]) ; cstr_loc "rule" (Rule.v1 @> nil) (fun loc x -> [Rule { x with loc }])

6
src/jbuild.mli
View File

@ -112,7 +112,9 @@ end
module Buildable : sig module Buildable : sig
type t = 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 ; libraries : Lib_dep.t list
; preprocess : Preprocess_map.t ; preprocess : Preprocess_map.t
; preprocessor_deps : Dep_conf.t list ; preprocessor_deps : Dep_conf.t list
@ -189,7 +191,7 @@ end
module Executables : sig module Executables : sig
type t = type t =
{ names : string list { names : (Loc.t * string) list
; link_executables : bool ; link_executables : bool
; link_flags : Ordered_set_lang.Unexpanded.t ; link_flags : Ordered_set_lang.Unexpanded.t
; modes : Mode.Dict.Set.t ; modes : Mode.Dict.Set.t

2
src/jbuild_load.ml
View File

@ -91,7 +91,7 @@ end
# 1 %S # 1 %S
%s|} %s|}
context.name context.name
context.version context.version_string
(String.concat ~sep:"\n ; " (String.concat ~sep:"\n ; "
(let longest = List.longest_map context.ocamlc_config ~f:fst in (let longest = List.longest_map context.ocamlc_config ~f:fst in
List.map context.ocamlc_config ~f:(fun (k, v) -> List.map context.ocamlc_config ~f:(fun (k, v) ->

41
src/module.ml
View File

@ -27,7 +27,7 @@ end
type t = type t =
{ name : string { name : string
; impl : File.t ; impl : File.t option
; intf : File.t option ; intf : File.t option
; obj_name : string ; 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 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) = let file t ~dir (kind : Ml_kind.t) =
match kind with let file =
| Impl -> Some (Path.relative dir t.impl.name) match kind with
| Intf -> Option.map t.intf ~f:(fun f -> Path.relative dir f.name) | 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 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_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) = let cmt_file t ~obj_dir (kind : Ml_kind.t) =
match kind with 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") | 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" 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" | Some _ -> obj_file t ~obj_dir ~ext:".cmti"
let iter t ~f = 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) 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 }

17
src/module.mli
View File

@ -16,7 +16,7 @@ end
type t = type t =
{ name : string (** Name of the module. This is always the basename of the filename { name : string (** Name of the module. This is always the basename of the filename
without the extension. *) without the extension. *)
; impl : File.t ; impl : File.t option
; intf : File.t option ; intf : File.t option
; obj_name : string (** Object name. It is different from [name] for wrapped ; 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. *) (** Real unit name once wrapped. This is always a valid module name. *)
val real_unit_name : t -> string val real_unit_name : t -> string
val file : t -> dir:Path.t -> Ml_kind.t -> Path.t option 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_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 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 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 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 val odoc_file : t -> doc_dir:Path.t -> Path.t
(** Either the .cmti, or .cmt if the module has no interface *) (** Either the .cmti, or .cmt if the module has no interface *)
val cmti_file : t -> obj_dir:Path.t -> Path.t val cmti_file : t -> obj_dir:Path.t -> Path.t
val iter : t -> f:(Ml_kind.t -> File.t -> unit) -> unit 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

40
src/module_compilation.ml
View File

@ -12,7 +12,7 @@ module Target : sig
val file : Path.t -> t -> Path.t val file : Path.t -> t -> Path.t
end = struct end = struct
type t = Path.t 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 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 cmt m ml_kind = Module.cmt_file m ~obj_dir:Path.root ml_kind
let file dir t = Path.append dir t 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 (Mode.of_cm_kind cm_kind |> Context.compiler ctx) ~f:(fun compiler ->
Option.iter (Module.cm_source ~dir m cm_kind) ~f:(fun src -> Option.iter (Module.cm_source ~dir m cm_kind) ~f:(fun src ->
let ml_kind = Cm_kind.source cm_kind in 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 = let extra_args, extra_deps, other_targets =
match cm_kind, m.intf with match cm_kind, m.intf with
(* If there is no mli, [ocamlY -c file.ml] produces both the (* 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 cmi exists and reads it instead of re-creating it, which
could create a race condition. *) could create a race condition. *)
[ "-intf-suffix" [ "-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, None -> assert false
| Cmi, Some _ -> [], [], [] | Cmi, Some _ -> [], [], []
(* We need the .cmi to build either the .cmo or .cmx *) (* 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 in
let other_targets = let other_targets =
match cm_kind with 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 -> (Ocamldep.Dep_graph.deps_of dep_graph m >>^ fun deps ->
List.concat_map deps List.concat_map deps
~f:(fun m -> ~f:(fun m ->
match cm_kind with let deps = [Module.cm_file_unsafe m ~obj_dir Cmi] in
| Cmi | Cmo -> [Module.cm_file m ~obj_dir Cmi] if Module.has_impl m && cm_kind = Cmx then
| Cmx -> [ Module.cm_file m ~obj_dir Cmi Module.cm_file_unsafe m ~obj_dir Cmx :: deps
; Module.cm_file m ~obj_dir Cmx else
])) deps))
in in
let other_targets, cmt_args = let other_targets, cmt_args =
match cm_kind with 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 if obj_dir <> dir then begin
(* Symlink the object files in the original directory for (* Symlink the object files in the original directory for
backward compatibility *) 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) ; SC.add_rule sctx (Build.symlink ~src:dst ~dst:old_dst) ;
List.iter2 extra_targets other_targets ~f:(fun in_obj_dir target -> List.iter2 extra_targets other_targets ~f:(fun in_obj_dir target ->
let in_dir = Target.file dir target in let in_dir = Target.file dir target in
SC.add_rule sctx (Build.symlink ~src:in_obj_dir ~dst:in_dir)) SC.add_rule sctx (Build.symlink ~src:in_obj_dir ~dst:in_dir))
end; 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 SC.add_rule sctx ?sandbox
(Build.paths extra_deps >>> (Build.paths extra_deps >>>
other_cm_files >>> 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) ; Dyn (fun (libs, _) -> Lib.include_flags libs ~stdlib_dir:ctx.stdlib_dir)
; As extra_args ; As extra_args
; if dynlink || cm_kind <> Cmx then As [] else A "-nodynlink" ; if dynlink || cm_kind <> Cmx then As [] else A "-nodynlink"
; A "-no-alias-deps" ; A "-no-alias-deps"; opaque
; A "-I"; Path obj_dir ; A "-I"; Path obj_dir
; (match alias_module with ; (match alias_module with
| None -> S [] | 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 build_cm sctx ?sandbox ~dynlink ~flags ~dir ~obj_dir ~dep_graphs m ~cm_kind
~requires ~alias_module); ~requires ~alias_module);
(* Build *.cmo.js *) (* Build *.cmo.js *)
let src = Module.cm_file m ~obj_dir Cm_kind.Cmo in let src = Module.cm_file_unsafe 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 let target =
SC.add_rules sctx (Js_of_ocaml_rules.build_cm sctx ~scope ~dir ~js_of_ocaml ~src ~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 let build_modules sctx ~dynlink ~js_of_ocaml ~flags ~scope ~dir ~obj_dir
~dep_graphs ~modules ~requires ~alias_module = ~dep_graphs ~modules ~requires ~alias_module =

8
src/ocamldep.ml
View File

@ -40,6 +40,12 @@ module Dep_graph = struct
(String.concat ~sep:"\n-> " (String.concat ~sep:"\n-> "
(List.map cycle ~f:Module.name)) (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) = let dummy (m : Module.t) =
{ dir = Path.root { dir = Path.root
; per_module = String_map.singleton m.name (Build.return []) ; per_module = String_map.singleton m.name (Build.return [])
@ -106,7 +112,7 @@ let parse_deps ~dir ~file ~(unit : Module.t)
in in
deps 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 = let per_module =
String_map.map modules ~f:(fun unit -> String_map.map modules ~f:(fun unit ->
match Module.file ~dir unit ml_kind with match Module.file ~dir unit ml_kind with

5
src/ocamldep.mli
View File

@ -10,7 +10,10 @@ module Dep_graph : sig
-> Module.t -> Module.t
-> (unit, Module.t list) Build.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 end
module Dep_graphs : sig module Dep_graphs : sig

202
src/ordered_set_lang.ml
View File

@ -12,9 +12,17 @@ module Ast = struct
| Include : String_with_vars.t -> ('a, unexpanded) t | Include : String_with_vars.t -> ('a, unexpanded) t
end 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 let rec of_sexp : Sexp.Ast.t -> _ = function
| Atom (loc, "\\") -> Loc.fail loc "unexpected \\" | Atom (loc, "\\") -> Loc.fail loc "unexpected \\"
| Atom (_, "") as t -> Ast.Element (f t) | Atom (_, "") as t -> Ast.Element (f t)
@ -30,58 +38,116 @@ let parse_general t ~f =
of_sexps (of_sexp elt :: acc) sexps of_sexps (of_sexp elt :: acc) sexps
| [] -> Union (List.rev acc) | [] -> Union (List.rev acc)
in in
of_sexp t of_sexp sexp
let t t : t = parse_general t ~f:(function Atom (_, s) -> s | List _ -> assert false) let t sexp : t =
let ast =
let eval t ~special_values = parse_general sexp ~f:(function
let rec of_ast (t : t) = | Atom (loc, s) -> (loc, s)
let open Ast in | List _ -> assert false)
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))
in 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 | Ast.Special (_, "standard") -> true
| _ -> false | _ -> false
let eval_with_standard t ~standard = module type Value = sig
if is_standard t then type t
standard (* inline common case *) val name : t -> string
else end
eval t ~special_values:[("standard", standard)]
let rec map (t : t) ~f : t = module Make(Value : Value) = struct
let open Ast in module type Named_values = sig
match t with type t
| 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)
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 module Unexpanded = struct
type t = (Sexp.Ast.t, Ast.unexpanded) Ast.t type ast = (Sexp.Ast.t, Ast.unexpanded) Ast.t
let t t = type t = ast generic
let t sexp =
let rec map (t : (Sexp.Ast.t, Ast.expanded) Ast.t) = let rec map (t : (Sexp.Ast.t, Ast.expanded) Ast.t) =
let open Ast in let open Ast in
match t with match t with
| Element s -> Element s | Element x -> Element x
| Union [Special (_, "include"); Element fn] -> | Union [Special (_, "include"); Element fn] ->
Include (String_with_vars.t fn) Include (String_with_vars.t fn)
| Union [Special (loc, "include"); _] | Union [Special (loc, "include"); _]
@ -93,14 +159,14 @@ module Unexpanded = struct
| Diff (l, r) -> | Diff (l, r) ->
Diff (map l, map r) Diff (map l, map r)
in 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 standard = standard
let append = append
let files t ~f = let files t ~f =
let rec loop acc (t : t) = let rec loop acc (t : ast) =
let open Ast in let open Ast in
match t with match t with
| Element _ | Element _
@ -112,27 +178,31 @@ module Unexpanded = struct
| Diff (l, r) -> | Diff (l, r) ->
loop (loop acc l) r loop (loop acc l) r
in 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 expand t ~files_contents ~f =
let open Ast in let rec expand (t : ast) : ast_expanded =
match t with let open Ast in
| Element s -> Element (f (String_with_vars.t s)) match t with
| Special (l, s) -> Special (l, s) | Element s -> Element (Sexp.Ast.loc s, f (String_with_vars.t s))
| Include fn -> | Special (l, s) -> Special (l, s)
parse_general | Include fn ->
(let fn = f fn in let sexp =
match String_map.find fn files_contents with let fn = f fn in
| Some x -> x match String_map.find fn files_contents with
| None -> | Some x -> x
Sexp.code_error | None ->
"Ordered_set_lang.Unexpanded.expand" Sexp.code_error
[ "included-file", Atom fn "Ordered_set_lang.Unexpanded.expand"
; "files", Sexp.To_sexp.(list string) (String_map.keys files_contents) [ "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 -> in
Union (List.map l ~f:(expand ~files_contents ~f)) parse_general sexp ~f:(fun sexp ->
| Diff (l, r) -> (Sexp.Ast.loc sexp, f (String_with_vars.t sexp)))
Diff (expand l ~files_contents ~f, expand r ~files_contents ~f) | Union l -> Union (List.map l ~f:expand)
| Diff (l, r) ->
Diff (expand l, expand r)
in
{ t with ast = expand t.ast }
end end

39
src/ordered_set_lang.mli
View File

@ -6,13 +6,34 @@ open Import
type t type t
val t : t Sexp.Of_sexp.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 standard : t
val is_standard : t -> bool val is_standard : t -> bool
val append : t -> t -> t
(** Map non-variable atoms *)
val map : t -> f:(string -> string) -> t
module Unexpanded : sig module Unexpanded : sig
type expanded = t type expanded = t
@ -20,13 +41,15 @@ module Unexpanded : sig
val t : t Sexp.Of_sexp.t val t : t Sexp.Of_sexp.t
val standard : t val standard : t
val append : t -> t -> t
(** List of files needed to expand this set *) (** List of files needed to expand this set *)
val files : t -> f:(String_with_vars.t -> string) -> String_set.t 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 (** 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 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]. *) [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 end with type expanded := t

3
src/sexp.ml
View File

@ -212,6 +212,9 @@ module Of_sexp = struct
let x, state = m state in let x, state = m state in
f x state f x state
let record_loc state =
(state.loc, state)
let consume name state = let consume name state =
{ state with { state with
unparsed = Name_map.remove name state.unparsed unparsed = Name_map.remove name state.unparsed

3
src/sexp.mli
View File

@ -54,6 +54,9 @@ module Of_sexp : sig
val return : 'a -> 'a record_parser val return : 'a -> 'a record_parser
val ( >>= ) : 'a record_parser -> ('a -> 'b record_parser) -> 'b 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 : string -> ?default:'a -> 'a t -> 'a record_parser
val field_o : string -> 'a t -> 'a option record_parser val field_o : string -> 'a t -> 'a option record_parser
val field_b : string -> bool record_parser val field_b : string -> bool record_parser

53
src/super_context.ml
View File

@ -157,7 +157,7 @@ let create
; "OCAML" , Paths ([context.ocaml], Split) ; "OCAML" , Paths ([context.ocaml], Split)
; "OCAMLC" , Paths ([context.ocamlc], Split) ; "OCAMLC" , Paths ([context.ocamlc], Split)
; "OCAMLOPT" , Paths ([ocamlopt], 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) ; "ocaml_where" , Paths ([context.stdlib_dir], Concat)
; "ARCH_SIXTYFOUR" , Strings ([string_of_bool context.arch_sixtyfour], ; "ARCH_SIXTYFOUR" , Strings ([string_of_bool context.arch_sixtyfour],
Concat) Concat)
@ -762,17 +762,14 @@ module PP = struct
fn ^ ".pp" ^ ext fn ^ ".pp" ^ ext
let pped_module ~dir (m : Module.t) ~f = let pped_module ~dir (m : Module.t) ~f =
let ml_pp_fname = pp_fname m.impl.name in let pped_file (kind : Ml_kind.t) (file : Module.File.t) =
f Ml_kind.Impl (Path.relative dir m.impl.name) (Path.relative dir ml_pp_fname); let pp_fname = pp_fname file.name in
let intf = f kind (Path.relative dir file.name) (Path.relative dir pp_fname);
Option.map m.intf ~f:(fun intf -> {file with name = pp_fname}
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})
in in
{ m with { m with
impl = { m.impl with name = ml_pp_fname } impl = Option.map m.impl ~f:(pped_file Impl)
; intf ; intf = Option.map m.intf ~f:(pped_file Intf)
} }
let migrate_driver_main = "ocaml-migrate-parsetree.driver-main" let migrate_driver_main = "ocaml-migrate-parsetree.driver-main"
@ -941,22 +938,18 @@ module PP = struct
; A "binary" ; A "binary"
; Dep src_path ] ; Dep src_path ]
~stdout_to:(Path.relative dir target) in ~stdout_to:(Path.relative dir target) in
let impl = let to_ml (f : Module.File.t) =
match m.impl.syntax with match f.syntax with
| OCaml -> m.impl | OCaml -> f
| Reason -> | Reason ->
let ml = Module.File.to_ocaml m.impl in let ml = Module.File.to_ocaml f in
add_rule sctx (rule m.impl.name ml.name); add_rule sctx (rule f.name ml.name);
ml in ml
let intf = in
Option.map m.intf ~f:(fun f -> { m with
match f.syntax with impl = Option.map m.impl ~f:to_ml
| OCaml -> f ; intf = Option.map m.intf ~f:to_ml
| Reason -> }
let mli = Module.File.to_ocaml f in
add_rule sctx (rule f.name mli.name);
mli) in
{ m with impl ; intf }
let uses_ppx_driver ~pps = let uses_ppx_driver ~pps =
match Option.map ~f:Pp.to_string (List.last pps) with match Option.map ~f:Pp.to_string (List.last pps) with
@ -1088,17 +1081,23 @@ module PP = struct
) )
end 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 expand_and_eval_set t ~scope ~dir set ~standard =
let open Build.O in let open Build.O in
let f = expand_vars t ~scope ~dir 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 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 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 -> | files ->
let paths = List.map files ~f:(Path.relative dir) in let paths = List.map files ~f:(Path.relative dir) in
Build.all (List.map paths ~f:Build.read_sexp) Build.all (List.map paths ~f:Build.read_sexp)
>>^ fun sexps -> >>^ fun sexps ->
let files_contents = List.combine files sexps |> String_map.of_alist_exn in 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 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

5
src/utils.ml
View File

@ -133,11 +133,6 @@ let g () =
else 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 = let install_file ~package ~findlib_toolchain =
match findlib_toolchain with match findlib_toolchain with
| None -> package ^ ".install" | None -> package ^ ".install"

7
src/utils.mli
View File

@ -39,13 +39,6 @@ val library_not_found : ?context:string -> ?hint:string -> string -> _
(** [\["-g"\]] if [!Clflags.g] and [\[\]] otherwise *) (** [\["-g"\]] if [!Clflags.g] and [\[\]] otherwise *)
val g : unit -> string list 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 val install_file : package:string -> findlib_toolchain:string option -> string
(** Digest files with caching *) (** Digest files with caching *)

15
src/utop.ml
View File

@ -37,7 +37,7 @@ let add_module_rules sctx ~dir lib_requires =
Super_context.add_rule sctx utop_ml Super_context.add_rule sctx utop_ml
let utop_of_libs (libs : Library.t list) = let utop_of_libs (libs : Library.t list) =
{ Executables.names = [exe_name] { Executables.names = [(Loc.none, exe_name)]
; link_executables = true ; link_executables = true
; link_flags = Ordered_set_lang.Unexpanded.t ( ; link_flags = Ordered_set_lang.Unexpanded.t (
Sexp.add_loc ~loc:Loc.none 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] ; modes = Mode.Dict.Set.of_list [Mode.Byte]
; buildable = ; buildable =
{ Buildable.modules = { Buildable.
loc = Loc.none
; modules =
Ordered_set_lang.t (List (Loc.none, [Atom (Loc.none, module_name)])) Ordered_set_lang.t (List (Loc.none, [Atom (Loc.none, module_name)]))
; modules_without_implementation = Ordered_set_lang.standard
; libraries = ; libraries =
(Lib_dep.direct "utop") :: (List.map libs ~f:(fun lib -> (Lib_dep.direct "utop") :: (List.map libs ~f:(fun lib ->
Lib_dep.direct lib.Library.name)) Lib_dep.direct lib.Library.name))
@ -77,10 +80,10 @@ let exe_stanzas stanzas =
[ module_name [ module_name
, { Module. , { Module.
name = module_name name = module_name
; impl = { Module.File. ; impl = Some { Module.File.
name = module_filename name = module_filename
; syntax = Module.Syntax.OCaml ; syntax = Module.Syntax.OCaml
} }
; intf = None ; intf = None
; obj_name = "" } ; obj_name = "" }
] in ] in

10
test/blackbox-tests/jbuild
View File

@ -287,3 +287,13 @@
(progn (progn
(run ${exe:cram.exe} run.t) (run ${exe:cram.exe} run.t)
(diff? run.t run.t.corrected))))))) (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)))))))

2
test/blackbox-tests/test-cases/intf-only/a/jbuild Normal file
View File

@ -0,0 +1,2 @@
(library
((name foo)))

1
test/blackbox-tests/test-cases/intf-only/a/x.mli Normal file
View File

@ -0,0 +1 @@
type t = int

1
test/blackbox-tests/test-cases/intf-only/a/y.mli Normal file
View File

@ -0,0 +1 @@
type t = int

3
test/blackbox-tests/test-cases/intf-only/b/jbuild Normal file
View File

@ -0,0 +1,3 @@
(library
((name foo)
(modules_without_implementation (x))))

2
test/blackbox-tests/test-cases/intf-only/b/x.mli Normal file
View File

@ -0,0 +1,2 @@
type t = int

1
test/blackbox-tests/test-cases/intf-only/b/y.mli Normal file
View File

@ -0,0 +1 @@
type t = int

3
test/blackbox-tests/test-cases/intf-only/c/jbuild Normal file
View File

@ -0,0 +1,3 @@
(library
((name foo)
(modules_without_implementation (x))))

3
test/blackbox-tests/test-cases/intf-only/d/jbuild Normal file
View File

@ -0,0 +1,3 @@
(library
((name foo)
(modules_without_implementation (x))))

1
test/blackbox-tests/test-cases/intf-only/d/x.ml Normal file
View File

@ -0,0 +1 @@
let x = 42

1
test/blackbox-tests/test-cases/intf-only/d/x.mli Normal file
View File

@ -0,0 +1 @@
val x : int

1
test/blackbox-tests/test-cases/intf-only/foo/foo.ml Normal file
View File

@ -0,0 +1 @@
module T = Intf

0
test/blackbox-tests/test-cases/intf-only/foo/foo.opam Normal file
View File

1
test/blackbox-tests/test-cases/intf-only/foo/intf.mli Normal file
View File

@ -0,0 +1 @@
type t = A | B | C

4
test/blackbox-tests/test-cases/intf-only/foo/jbuild Normal file
View File

@ -0,0 +1,4 @@
(library
((name foo)
(public_name foo)
(modules_without_implementation (intf))))

5
test/blackbox-tests/test-cases/intf-only/foo/test/bar.ml Normal file
View File

@ -0,0 +1,5 @@
module X = Foo.T
let x = X.A
include Foo.T

4
test/blackbox-tests/test-cases/intf-only/foo/test/jbuild Normal file
View File

@ -0,0 +1,4 @@
(library
((name bar)
(public_name foo.bar)
(libraries (foo))))

44
test/blackbox-tests/test-cases/intf-only/run.t Normal file
View File

@ -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

6
test/blackbox-tests/test-cases/js_of_ocaml/run.t
View File

@ -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 $ $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 ocamlc lib/stubs.o
ocamlopt .ppx/js_of_ocaml-ppx/ppx.exe 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 ocamlmklib lib/dllx_stubs.so,lib/libx_stubs.a
ppx lib/x.pp.ml ppx lib/x.pp.ml
ppx lib/y.pp.ml ppx lib/y.pp.ml
ppx bin/technologic.pp.ml ppx bin/technologic.pp.ml
ppx bin/z.pp.ml ppx bin/z.pp.ml
ocamlopt lib/.x.objs/x__.{cmx,o}
ocamldep lib/x.pp.ml.d ocamldep lib/x.pp.ml.d
ocamldep lib/y.pp.ml.d ocamldep lib/y.pp.ml.d
ocamldep bin/technologic.pp.ml.d ocamldep bin/technologic.pp.ml.d
@ -35,9 +34,8 @@
break it break it
fix it fix it
$ $JBUILDER build -j1 --display short --root . bin/technologic.bc.js @install $ $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} ocamlc lib/.x.objs/x__Y.{cmi,cmo,cmt}
ocamlopt lib/.x.objs/x__.{cmx,o}
ocamlc lib/.x.objs/x.{cmi,cmo,cmt} ocamlc lib/.x.objs/x.{cmi,cmo,cmt}
ocamlopt lib/.x.objs/x__Y.{cmx,o} ocamlopt lib/.x.objs/x__Y.{cmx,o}
ocamlc lib/x.cma ocamlc lib/x.cma

3
test/blackbox-tests/test-cases/scope-bug/run.t
View File

@ -1,10 +1,9 @@
$ $JBUILDER build -j1 --display short --root . @install $ $JBUILDER build -j1 --display short --root . @install
ocamldep alib/alib.ml.d ocamldep alib/alib.ml.d
ocamldep alib/main.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/blib.ml.d
ocamldep blib/sub/sub.ml.d ocamldep blib/sub/sub.ml.d
ocamlopt alib/.alib.objs/alib__.{cmx,o}
ocamlc blib/sub/.sub.objs/sub.{cmi,cmo,cmt} ocamlc blib/sub/.sub.objs/sub.{cmi,cmo,cmt}
ocamlopt blib/sub/.sub.objs/sub.{cmx,o} ocamlopt blib/sub/.sub.objs/sub.{cmx,o}
ocamlc blib/.blib.objs/blib.{cmi,cmo,cmt} ocamlc blib/.blib.objs/blib.{cmi,cmo,cmt}