Better support for mli/rei only modules (#489)
This commit is contained in:
parent
f083b6a2cd
commit
b3838284c6
|
@ -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)
|
||||
-----------------------
|
||||
|
||||
|
|
|
@ -167,6 +167,16 @@ modules you want.
|
|||
build system. It is not for casual uses, see the `re2 library
|
||||
<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
|
||||
tools such as ``pkg-config``, however it integrates easily with `configurator
|
||||
<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
|
||||
specifying `OCaml flags`_
|
||||
|
||||
- ``(modules_without_implementation <modules>)`` is the same as the
|
||||
corresponding field of `library`_
|
||||
|
||||
executables
|
||||
-----------
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
272
src/gen_rules.ml
272
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>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:"<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 ->
|
||||
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 ]
|
||||
|
|
|
@ -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 }])
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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) ->
|
||||
|
|
|
@ -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 }
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 =
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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 *)
|
||||
|
|
15
src/utop.ml
15
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
|
||||
|
|
|
@ -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)))))))
|
||||
|
|
|
@ -0,0 +1,2 @@
|
|||
(library
|
||||
((name foo)))
|
|
@ -0,0 +1 @@
|
|||
type t = int
|
|
@ -0,0 +1 @@
|
|||
type t = int
|
|
@ -0,0 +1,3 @@
|
|||
(library
|
||||
((name foo)
|
||||
(modules_without_implementation (x))))
|
|
@ -0,0 +1,2 @@
|
|||
type t = int
|
||||
|
|
@ -0,0 +1 @@
|
|||
type t = int
|
|
@ -0,0 +1,3 @@
|
|||
(library
|
||||
((name foo)
|
||||
(modules_without_implementation (x))))
|
|
@ -0,0 +1,3 @@
|
|||
(library
|
||||
((name foo)
|
||||
(modules_without_implementation (x))))
|
|
@ -0,0 +1 @@
|
|||
let x = 42
|
|
@ -0,0 +1 @@
|
|||
val x : int
|
|
@ -0,0 +1 @@
|
|||
module T = Intf
|
|
@ -0,0 +1 @@
|
|||
type t = A | B | C
|
|
@ -0,0 +1,4 @@
|
|||
(library
|
||||
((name foo)
|
||||
(public_name foo)
|
||||
(modules_without_implementation (intf))))
|
|
@ -0,0 +1,5 @@
|
|||
module X = Foo.T
|
||||
|
||||
let x = X.A
|
||||
|
||||
include Foo.T
|
|
@ -0,0 +1,4 @@
|
|||
(library
|
||||
((name bar)
|
||||
(public_name foo.bar)
|
||||
(libraries (foo))))
|
|
@ -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
|
|
@ -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
|
||||
|
|
|
@ -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}
|
||||
|
|
Loading…
Reference in New Issue