diff --git a/CHANGES.md b/CHANGES.md index 190edd4292c..3ab965665ee 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -24,6 +24,9 @@ next - Add `(staged_pps ...)` to support staged ppx rewriters such as ones using the OCaml typer like `ppx_import` (#1080, fix #193, @diml) +- Use `-opaque` in the `dev` profile. This option trades off binary quality for + compilation speed when compiling .cmx files. (#1079, fix #1058, @rgrinberg) + 1.0.1 (19/07/2018) ------------------ diff --git a/src/compilation_context.ml b/src/compilation_context.ml index 8529e82a9e0..16ba5627d44 100644 --- a/src/compilation_context.ml +++ b/src/compilation_context.ml @@ -5,7 +5,7 @@ module SC = Super_context module Includes = struct type t = string list Arg_spec.t Cm_kind.Dict.t - let make sctx ~requires : _ Cm_kind.Dict.t = + let make sctx ~opaque ~requires : _ Cm_kind.Dict.t = match requires with | Error exn -> Cm_kind.Dict.make_all (Arg_spec.Dyn (fun _ -> raise exn)) | Ok libs -> @@ -18,15 +18,25 @@ module Includes = struct (SC.Libs.file_deps sctx libs ~ext:".cmi") ] in - let cmi_and_cmx_includes = - Arg_spec.S [ iflags - ; Hidden_deps - (SC.Libs.file_deps sctx libs ~ext:".cmi-and-.cmx") - ] + let cmx_includes = + Arg_spec.S + [ iflags + ; Hidden_deps + ( if opaque then + List.map libs ~f:(fun lib -> + (lib, if Lib.is_local lib then + ".cmi" + else + ".cmi-and-.cmx")) + |> SC.Libs.file_deps_with_exts sctx + else + SC.Libs.file_deps sctx libs ~ext:".cmi-and-.cmx" + ) + ] in { cmi = cmi_includes ; cmo = cmi_includes - ; cmx = cmi_and_cmx_includes + ; cmx = cmx_includes } let empty = @@ -47,6 +57,7 @@ type t = ; includes : Includes.t ; preprocessing : Preprocessing.t ; no_keep_locs : bool + ; opaque : bool } let super_context t = t.super_context @@ -62,12 +73,14 @@ let requires t = t.requires let includes t = t.includes let preprocessing t = t.preprocessing let no_keep_locs t = t.no_keep_locs +let opaque t = t.opaque let context t = Super_context.context t.super_context let create ~super_context ~scope ~dir ?(dir_kind=File_tree.Dune_file.Kind.Dune) ?(obj_dir=dir) ~modules ?alias_module ?lib_interface_module ~flags - ~requires ?(preprocessing=Preprocessing.dummy) ?(no_keep_locs=false) () = + ~requires ?(preprocessing=Preprocessing.dummy) ?(no_keep_locs=false) + ~opaque () = { super_context ; scope ; dir @@ -78,9 +91,10 @@ let create ~super_context ~scope ~dir ?(dir_kind=File_tree.Dune_file.Kind.Dune) ; lib_interface_module ; flags ; requires - ; includes = Includes.make super_context ~requires + ; includes = Includes.make super_context ~opaque ~requires ; preprocessing ; no_keep_locs + ; opaque } let for_alias_module t = diff --git a/src/compilation_context.mli b/src/compilation_context.mli index 48456cc9d4e..388a812be9d 100644 --- a/src/compilation_context.mli +++ b/src/compilation_context.mli @@ -25,6 +25,7 @@ val create -> requires : Lib.t list Or_exn.t -> ?preprocessing : Preprocessing.t -> ?no_keep_locs : bool + -> opaque : bool -> unit -> t @@ -45,3 +46,4 @@ val requires : t -> Lib.t list Or_exn.t val includes : t -> string list Arg_spec.t Cm_kind.Dict.t val preprocessing : t -> Preprocessing.t val no_keep_locs : t -> bool +val opaque : t -> bool diff --git a/src/gen_rules.ml b/src/gen_rules.ml index fb0bfa5174c..b5478a472b6 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -17,6 +17,8 @@ module Gen(P : Install_rules.Params) = struct let sctx = P.sctx let ctx = SC.context sctx + let opaque = ctx.profile = "dev" && ctx.version >= (4, 03, 0) + (* +-----------------------------------------------------------------+ | Library stuff | +-----------------------------------------------------------------+ *) @@ -199,6 +201,7 @@ module Gen(P : Install_rules.Params) = struct ~requires ~preprocessing:pp ~no_keep_locs:lib.no_keep_locs + ~opaque in let dep_graphs = Ocamldep.rules cctx in @@ -520,6 +523,7 @@ module Gen(P : Install_rules.Params) = struct ~flags ~requires ~preprocessing:pp + ~opaque in Exe.build_and_link_many cctx diff --git a/src/inline_tests.ml b/src/inline_tests.ml index fa6c64f4ae6..115da9ac4ac 100644 --- a/src/inline_tests.ml +++ b/src/inline_tests.ml @@ -233,6 +233,7 @@ include Sub_system.Register_end_point( ~scope ~dir:inline_test_dir ~modules + ~opaque:false ~requires:runner_libs ~flags:(Ocaml_flags.of_list ["-w"; "-24"]); in diff --git a/src/module_compilation.ml b/src/module_compilation.ml index 90c46780261..6d6e2b0f302 100644 --- a/src/module_compilation.ml +++ b/src/module_compilation.ml @@ -58,13 +58,14 @@ let build_cm cctx ?sandbox ?(dynlink=true) ~dep_graphs ~cm_kind (m : Module.t) = | Cmi | Cmo -> other_targets in let dep_graph = Ml_kind.Dict.get dep_graphs ml_kind in + let opaque = CC.opaque cctx in let other_cm_files = Build.dyn_paths (Ocamldep.Dep_graph.deps_of dep_graph m >>^ fun deps -> List.concat_map deps ~f:(fun m -> let deps = [Module.cm_file_unsafe m ~obj_dir Cmi] in - if Module.has_impl m && cm_kind = Cmx then + if Module.has_impl m && cm_kind = Cmx && not opaque then Module.cm_file_unsafe m ~obj_dir Cmx :: deps else deps)) @@ -86,8 +87,8 @@ let build_cm cctx ?sandbox ?(dynlink=true) ~dep_graphs ~cm_kind (m : Module.t) = 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 + let opaque_arg = + if opaque && cm_kind = Cmi then Arg_spec.A "-opaque" else As [] @@ -122,7 +123,7 @@ let build_cm cctx ?sandbox ?(dynlink=true) ~dep_graphs ~cm_kind (m : Module.t) = ; Cm_kind.Dict.get (CC.includes cctx) cm_kind ; As extra_args ; if dynlink || cm_kind <> Cmx then As [] else A "-nodynlink" - ; A "-no-alias-deps"; opaque + ; A "-no-alias-deps"; opaque_arg ; (match CC.alias_module cctx with | None -> S [] | Some (m : Module.t) -> diff --git a/src/super_context.ml b/src/super_context.ml index c233bfb84b5..de47e8cf759 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -706,14 +706,19 @@ module Libs = struct (lib_files_alias ~dir ~name:(Library.best_name lib) ~ext)) |> Path.Set.of_list) + let file_deps_of_lib t (lib : Lib.t) ~ext = + if Lib.is_local lib then + Alias.stamp_file + (lib_files_alias ~dir:(Lib.src_dir lib) ~name:(Lib.name lib) ~ext) + else + Build_system.stamp_file_for_files_of t.build_system + ~dir:(Lib.obj_dir lib) ~ext + + let file_deps_with_exts t lib_exts = + List.rev_map lib_exts ~f:(fun (lib, ext) -> file_deps_of_lib t lib ~ext) + let file_deps t libs ~ext = - List.rev_map libs ~f:(fun (lib : Lib.t) -> - if Lib.is_local lib then - Alias.stamp_file - (lib_files_alias ~dir:(Lib.src_dir lib) ~name:(Lib.name lib) ~ext) - else - Build_system.stamp_file_for_files_of t.build_system - ~dir:(Lib.obj_dir lib) ~ext) + List.rev_map libs ~f:(file_deps_of_lib t ~ext) end module Deps = struct diff --git a/src/super_context.mli b/src/super_context.mli index cc6a85e4901..2cd05396643 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -197,6 +197,8 @@ module Libs : sig all the files with extension [ext] of libraries [libs]. *) val file_deps : t -> Lib.L.t -> ext:string -> Path.t list + val file_deps_with_exts : t -> (Lib.t * string) list -> Path.t list + (** Setup the alias that depends on all files with a given extension for a library *) val setup_file_deps_alias diff --git a/src/utop.ml b/src/utop.ml index 1f83de66549..4b83784f34b 100644 --- a/src/utop.ml +++ b/src/utop.ml @@ -73,6 +73,7 @@ let setup sctx ~dir ~(libs : Library.t list) ~scope = ~scope ~dir:utop_exe_dir ~modules + ~opaque:false ~requires ~flags:(Ocaml_flags.append_common (Ocaml_flags.default ~profile:(Super_context.profile sctx)) diff --git a/test/blackbox-tests/test-cases/intf-only/run.t b/test/blackbox-tests/test-cases/intf-only/run.t index f1e40162c8d..8a66b0bf421 100644 --- a/test/blackbox-tests/test-cases/intf-only/run.t +++ b/test/blackbox-tests/test-cases/intf-only/run.t @@ -10,14 +10,14 @@ Successes: ocamlc .foo.objs/foo__Intf.{cmi,cmti} ocamlc .foo.objs/foo.{cmi,cmo,cmt} ocamlc test/.bar.objs/bar.{cmi,cmo,cmt} - ocamlc test/bar.cma - ocamlopt .foo.objs/foo.{cmx,o} ocamlopt test/.bar.objs/bar.{cmx,o} ocamlopt test/bar.{a,cmxa} ocamlopt test/bar.cmxs - ocamlc foo.cma + ocamlopt .foo.objs/foo.{cmx,o} ocamlopt foo.{a,cmxa} ocamlopt foo.cmxs + ocamlc foo.cma + ocamlc test/bar.cma Errors: diff --git a/test/blackbox-tests/test-cases/menhir/run.t b/test/blackbox-tests/test-cases/menhir/run.t index f93bd942b57..6be9857a65c 100644 --- a/test/blackbox-tests/test-cases/menhir/run.t +++ b/test/blackbox-tests/test-cases/menhir/run.t @@ -12,12 +12,12 @@ ocamldep src/.test.eobjs/test_menhir1.mli.d ocamlc src/.test.eobjs/test_menhir1.{cmi,cmti} ocamlc src/.test.eobjs/lexer1.{cmi,cmo,cmt} + ocamlopt src/.test.eobjs/lexer1.{cmx,o} ocamlc src/.test.eobjs/test_base.{cmi,cmti} ocamlc src/.test.eobjs/lexer2.{cmi,cmo,cmt} - ocamlc src/.test.eobjs/test.{cmi,cmo,cmt} + ocamlopt src/.test.eobjs/lexer2.{cmx,o} ocamlopt src/.test.eobjs/test_menhir1.{cmx,o} - ocamlopt src/.test.eobjs/lexer1.{cmx,o} ocamlopt src/.test.eobjs/test_base.{cmx,o} - ocamlopt src/.test.eobjs/lexer2.{cmx,o} + ocamlc src/.test.eobjs/test.{cmi,cmo,cmt} ocamlopt src/.test.eobjs/test.{cmx,o} ocamlopt src/test.exe diff --git a/test/blackbox-tests/test-cases/package-dep/run.t b/test/blackbox-tests/test-cases/package-dep/run.t index a2d8c7d8e5a..dc3dcad478c 100644 --- a/test/blackbox-tests/test-cases/package-dep/run.t +++ b/test/blackbox-tests/test-cases/package-dep/run.t @@ -3,11 +3,11 @@ ocamldep .foo.objs/foo.ml.d ocamlc .foo.objs/foo.{cmi,cmo,cmt} ocamlc .bar.objs/bar.{cmi,cmo,cmt} - ocamlc bar.cma - ocamlopt .foo.objs/foo.{cmx,o} ocamlopt .bar.objs/bar.{cmx,o} ocamlopt bar.{a,cmxa} ocamlopt bar.cmxs + ocamlc bar.cma + ocamlopt .foo.objs/foo.{cmx,o} ocamlopt foo.{a,cmxa} ocamlopt foo.cmxs ocamlc foo.cma diff --git a/test/blackbox-tests/test-cases/reporting-of-cycles/run.t b/test/blackbox-tests/test-cases/reporting-of-cycles/run.t index 95dbf29c809..d64db7ccabb 100644 --- a/test/blackbox-tests/test-cases/reporting-of-cycles/run.t +++ b/test/blackbox-tests/test-cases/reporting-of-cycles/run.t @@ -6,9 +6,9 @@ the second run of dune. $ dune build @package-cycle Dependency cycle between the following files: - _build/.aliases/default/.a-files-00000000000000000000000000000000 - --> _build/.aliases/default/.b-files-00000000000000000000000000000000 + _build/.aliases/default/.b-files-00000000000000000000000000000000 --> _build/.aliases/default/.a-files-00000000000000000000000000000000 + --> _build/.aliases/default/.b-files-00000000000000000000000000000000 [1] $ dune build @simple-repro-case diff --git a/test/blackbox-tests/test-cases/scope-bug/run.t b/test/blackbox-tests/test-cases/scope-bug/run.t index 48801dcfe4f..fd31ad0c9b0 100644 --- a/test/blackbox-tests/test-cases/scope-bug/run.t +++ b/test/blackbox-tests/test-cases/scope-bug/run.t @@ -5,20 +5,20 @@ ocamldep blib/sub/.sub.objs/sub.ml.d ocamlc blib/sub/.sub.objs/sub.{cmi,cmo,cmt} ocamlc blib/.blib.objs/blib.{cmi,cmo,cmt} - ocamlc blib/blib.cma - ocamlc alib/.alib.objs/alib__.{cmi,cmo,cmt} - ocamlopt alib/.alib.objs/alib__.{cmx,o} - ocamlopt blib/sub/.sub.objs/sub.{cmx,o} ocamlopt blib/.blib.objs/blib.{cmx,o} ocamlopt blib/blib.{a,cmxa} ocamlopt blib/blib.cmxs + ocamlc alib/.alib.objs/alib__.{cmi,cmo,cmt} + ocamlopt alib/.alib.objs/alib__.{cmx,o} + ocamlopt blib/sub/.sub.objs/sub.{cmx,o} + ocamlopt blib/sub/sub.{a,cmxa} + ocamlopt blib/sub/sub.cmxs ocamlc blib/sub/sub.cma + ocamlc blib/blib.cma ocamlc alib/.alib.objs/alib.{cmi,cmo,cmt} ocamlopt alib/.alib.objs/alib.{cmx,o} ocamlc alib/.alib.objs/alib__Main.{cmi,cmo,cmt} ocamlopt alib/.alib.objs/alib__Main.{cmx,o} ocamlopt alib/alib.{a,cmxa} ocamlopt alib/alib.cmxs - ocamlopt blib/sub/sub.{a,cmxa} - ocamlopt blib/sub/sub.cmxs ocamlc alib/alib.cma