From 8a03e7099a9c02924ebb3a3dcb53290b6c9cb860 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Fri, 27 Jul 2018 12:49:35 +0200 Subject: [PATCH 1/7] Hard code opaque mode Signed-off-by: Rudi Grinberg --- src/module_compilation.ml | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/src/module_compilation.ml b/src/module_compilation.ml index 90c46780261..c66f489c5b7 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 = ctx.version >= (4, 03, 0) 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 [] @@ -119,10 +120,13 @@ let build_cm cctx ?sandbox ?(dynlink=true) ~dep_graphs ~cm_kind (m : Module.t) = ; no_keep_locs ; cmt_args ; A "-I"; Path obj_dir - ; Cm_kind.Dict.get (CC.includes cctx) cm_kind + ; (if opaque then + Cm_kind.Dict.get (CC.includes cctx) Cmi + else + 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) -> From b394896c1f27c28d28adbbe4fbea74791c66e9c0 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 31 Jul 2018 22:18:10 +0200 Subject: [PATCH 2/7] Make opaque information available to compilation context Subsequently, use it as a flag when calculating rules and includes Signed-off-by: Rudi Grinberg --- src/compilation_context.ml | 25 ++++++++++++------- src/compilation_context.mli | 2 ++ src/gen_rules.ml | 3 +++ src/inline_tests.ml | 1 + src/lib.ml | 15 ++++++++--- src/lib.mli | 7 +++++- src/module_compilation.ml | 7 ++---- src/scope.ml | 4 +-- src/scope.mli | 1 + src/super_context.ml | 2 ++ src/utop.ml | 1 + .../blackbox-tests/test-cases/intf-only/run.t | 6 ++--- test/blackbox-tests/test-cases/menhir/run.t | 6 ++--- .../test-cases/package-dep/run.t | 4 +-- .../test-cases/reporting-of-cycles/run.t | 4 +-- .../blackbox-tests/test-cases/scope-bug/run.t | 12 ++++----- 16 files changed, 63 insertions(+), 37 deletions(-) diff --git a/src/compilation_context.ml b/src/compilation_context.ml index 8529e82a9e0..7916fc57ccf 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,18 @@ 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 = + if opaque then + cmi_includes + else + Arg_spec.S [ iflags + ; Hidden_deps + (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 +50,7 @@ type t = ; includes : Includes.t ; preprocessing : Preprocessing.t ; no_keep_locs : bool + ; opaque : bool } let super_context t = t.super_context @@ -62,12 +66,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 +84,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 ~requires ~opaque ; 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..70e5bbb8605 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -199,6 +199,7 @@ module Gen(P : Install_rules.Params) = struct ~requires ~preprocessing:pp ~no_keep_locs:lib.no_keep_locs + ~opaque:(Lib.Compile.opaque compile_info) in let dep_graphs = Ocamldep.rules cctx in @@ -520,6 +521,7 @@ module Gen(P : Install_rules.Params) = struct ~flags ~requires ~preprocessing:pp + ~opaque:(Lib.Compile.opaque compile_info) in Exe.build_and_link_many cctx @@ -543,6 +545,7 @@ module Gen(P : Install_rules.Params) = struct exes.buildable.libraries ~pps:(Jbuild.Preprocess_map.pps exes.buildable.preprocess) ~allow_overlaps:exes.buildable.allow_overlapping_dependencies + ~opaque:(ctx.profile = "dev") in SC.Libs.gen_select_rules sctx compile_info ~dir; SC.Libs.with_lib_deps sctx compile_info ~dir 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/lib.ml b/src/lib.ml index 0cf8c91adc1..1e046f65802 100644 --- a/src/lib.ml +++ b/src/lib.ml @@ -63,6 +63,7 @@ module Info = struct ; pps : (Loc.t * Jbuild.Pp.t) list ; optional : bool ; virtual_deps : (Loc.t * string) list + ; opaque : bool ; dune_version : Syntax.Version.t option ; sub_systems : Jbuild.Sub_system_info.t Sub_system_name.Map.t } @@ -72,7 +73,7 @@ module Info = struct ~init:(Deps.to_lib_deps t.requires) ~f:(fun acc s -> Jbuild.Lib_dep.Direct s :: acc) - let of_library_stanza ~dir (conf : Jbuild.Library.t) = + let of_library_stanza ~dir ~opaque (conf : Jbuild.Library.t) = let archive_file ext = Path.relative dir (conf.name ^ ext) in let archive_files ~f_ext = Mode.Dict.of_func (fun ~mode -> [archive_file (f_ext mode)]) @@ -116,6 +117,7 @@ module Info = struct ; pps = Jbuild.Preprocess_map.pps conf.buildable.preprocess ; sub_systems = conf.sub_systems ; dune_version = Some conf.dune_version + ; opaque } let of_findlib_package pkg = @@ -142,6 +144,7 @@ module Info = struct ; virtual_deps = [] ; optional = false ; status = Installed + ; opaque = false ; (* We don't know how these are named for external libraries *) foreign_archives = Mode.Dict.make_both [] ; sub_systems = sub_systems @@ -909,6 +912,7 @@ module Compile = struct ; pps : t list Or_exn.t ; resolved_selects : Resolved_select.t list ; optional : bool + ; opaque : bool ; user_written_deps : Jbuild.Lib_deps.t ; sub_systems : Sub_system0.Instance.t Lazy.t Sub_system_name.Map.t } @@ -921,6 +925,7 @@ module Compile = struct ; optional = t.info.optional ; user_written_deps = t.user_written_deps ; sub_systems = t.sub_systems + ; opaque = t.info.opaque } let direct_requires t = t.direct_requires @@ -929,6 +934,7 @@ module Compile = struct let pps t = t.pps let optional t = t.optional let user_written_deps t = t.user_written_deps + let opaque t = t.opaque let sub_systems t = Sub_system_name.Map.values t.sub_systems |> List.map ~f:(fun (lazy (Sub_system0.Instance.T ((module M), t))) -> @@ -957,10 +963,10 @@ module DB = struct ; all = Lazy.from_fun all } - let create_from_library_stanzas ?parent stanzas = + let create_from_library_stanzas ?parent ~opaque stanzas = let map = List.concat_map stanzas ~f:(fun (dir, (conf : Jbuild.Library.t)) -> - let info = Info.of_library_stanza ~dir conf in + let info = Info.of_library_stanza ~dir ~opaque conf in match conf.public with | None -> [(conf.name, Resolve_result.Found info)] @@ -1055,7 +1061,7 @@ module DB = struct let t = Option.some_if (not allow_overlaps) t in Compile.for_lib t lib - let resolve_user_written_deps t ?(allow_overlaps=false) deps ~pps = + let resolve_user_written_deps t ?(allow_overlaps=false) ~opaque deps ~pps = let res, pps, resolved_selects = resolve_user_deps t (Info.Deps.of_lib_deps deps) ~pps ~stack:Dep_stack.empty ~allow_private_deps:true @@ -1073,6 +1079,7 @@ module DB = struct ; optional = false ; user_written_deps = deps ; sub_systems = Sub_system_name.Map.empty + ; opaque } let resolve_pps t pps = diff --git a/src/lib.mli b/src/lib.mli index 8ae8df2f340..f9b68a7df70 100644 --- a/src/lib.mli +++ b/src/lib.mli @@ -105,11 +105,12 @@ module Info : sig ; pps : (Loc.t * Jbuild.Pp.t) list ; optional : bool ; virtual_deps : (Loc.t * string) list + ; opaque : bool ; dune_version : Syntax.Version.t option ; sub_systems : Jbuild.Sub_system_info.t Sub_system_name.Map.t } - val of_library_stanza : dir:Path.t -> Jbuild.Library.t -> t + val of_library_stanza : dir:Path.t -> opaque:bool -> Jbuild.Library.t -> t val of_findlib_package : Findlib.Package.t -> t end @@ -218,6 +219,8 @@ module Compile : sig val optional : t -> bool val user_written_deps : t -> Jbuild.Lib_deps.t + val opaque : t -> bool + (** Sub-systems used in this compilation context *) val sub_systems : t -> sub_system list end @@ -257,6 +260,7 @@ module DB : sig (** Create a database from a list of library stanzas *) val create_from_library_stanzas : ?parent:t + -> opaque:bool -> (Path.t * Jbuild.Library.t) list -> t @@ -289,6 +293,7 @@ module DB : sig val resolve_user_written_deps : t -> ?allow_overlaps:bool + -> opaque:bool -> Jbuild.Lib_dep.t list -> pps:(Loc.t * Jbuild.Pp.t) list -> Compile.t diff --git a/src/module_compilation.ml b/src/module_compilation.ml index c66f489c5b7..c2409190fc3 100644 --- a/src/module_compilation.ml +++ b/src/module_compilation.ml @@ -58,7 +58,7 @@ 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 = ctx.version >= (4, 03, 0) in + let opaque = CC.opaque cctx && ctx.version >= (4, 03, 0) in let other_cm_files = Build.dyn_paths (Ocamldep.Dep_graph.deps_of dep_graph m >>^ fun deps -> @@ -120,10 +120,7 @@ let build_cm cctx ?sandbox ?(dynlink=true) ~dep_graphs ~cm_kind (m : Module.t) = ; no_keep_locs ; cmt_args ; A "-I"; Path obj_dir - ; (if opaque then - Cm_kind.Dict.get (CC.includes cctx) Cmi - else - Cm_kind.Dict.get (CC.includes cctx) cm_kind) + ; 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_arg diff --git a/src/scope.ml b/src/scope.ml index 0da4f1e70e8..f4e9bf8f6e4 100644 --- a/src/scope.ml +++ b/src/scope.ml @@ -50,7 +50,7 @@ module DB = struct (Project_name_map.keys t.by_name) ] - let create ~projects ~context ~installed_libs internal_libs = + let create ~projects ~context ~opaque ~installed_libs internal_libs = let projects_by_name = List.map projects ~f:(fun (project : Dune_project.t) -> (project.name, project)) @@ -119,7 +119,7 @@ module DB = struct let project = Option.value_exn project in let libs = Option.value libs ~default:[] in let db = - Lib.DB.create_from_library_stanzas libs ~parent:public_libs + Lib.DB.create_from_library_stanzas libs ~parent:public_libs ~opaque in let root = Path.append_local build_context_dir project.root in Some { project; db; root }) diff --git a/src/scope.mli b/src/scope.mli index 4cd3153689b..e24aa7a9413 100644 --- a/src/scope.mli +++ b/src/scope.mli @@ -24,6 +24,7 @@ module DB : sig val create : projects:Dune_project.t list -> context:string + -> opaque:bool -> installed_libs:Lib.DB.t -> (Path.t * Jbuild.Library.t) list -> t * Lib.DB.t diff --git a/src/super_context.ml b/src/super_context.ml index c233bfb84b5..3e088c2cd43 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -506,9 +506,11 @@ let create | Library lib -> Some (ctx_dir, lib) | _ -> None)) in + let opaque = context.profile = "dev" in let scopes, public_libs = Scope.DB.create ~projects + ~opaque ~context:context.name ~installed_libs internal_libs 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 From e09bbfcd6ec01ebece0e2f39ba6b97ee979837f9 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 2 Aug 2018 09:15:01 +0200 Subject: [PATCH 3/7] Fix opaque calculation for includes Signed-off-by: Rudi Grinberg --- src/compilation_context.ml | 23 ++++++++++++++--------- src/lib.ml | 2 ++ src/lib.mli | 2 ++ src/super_context.ml | 9 +++++++++ src/super_context.mli | 2 ++ 5 files changed, 29 insertions(+), 9 deletions(-) diff --git a/src/compilation_context.ml b/src/compilation_context.ml index 7916fc57ccf..cba8669a02f 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 ~opaque ~requires : _ Cm_kind.Dict.t = + let make sctx ~requires : _ Cm_kind.Dict.t = match requires with | Error exn -> Cm_kind.Dict.make_all (Arg_spec.Dyn (fun _ -> raise exn)) | Ok libs -> @@ -19,13 +19,18 @@ module Includes = struct ] in let cmx_includes = - if opaque then - cmi_includes - else - Arg_spec.S [ iflags - ; Hidden_deps - (SC.Libs.file_deps sctx libs ~ext:".cmi-and-.cmx") - ] + Arg_spec.S + [ iflags + ; Hidden_deps + ( libs + |> List.map ~f:(fun lib -> + (lib, if Lib.opaque lib then + ".cmi" + else + ".cmi-and-.cmx")) + |> SC.Libs.file_deps_with_exts sctx + ) + ] in { cmi = cmi_includes ; cmo = cmi_includes @@ -84,7 +89,7 @@ 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 ~opaque + ; includes = Includes.make super_context ~requires ; preprocessing ; no_keep_locs ; opaque diff --git a/src/lib.ml b/src/lib.ml index 1e046f65802..c24c61637c7 100644 --- a/src/lib.ml +++ b/src/lib.ml @@ -338,6 +338,8 @@ let plugins t = t.info.plugins let jsoo_runtime t = t.info.jsoo_runtime let unique_id t = t.unique_id +let opaque t = t.info.opaque + let dune_version t = t.info.dune_version let src_dir t = t.info.src_dir diff --git a/src/lib.mli b/src/lib.mli index f9b68a7df70..401028f6453 100644 --- a/src/lib.mli +++ b/src/lib.mli @@ -26,6 +26,8 @@ val archives : t -> Path.t list Mode.Dict.t val plugins : t -> Path.t list Mode.Dict.t val jsoo_runtime : t -> Path.t list +val opaque : t -> bool + val dune_version : t -> Syntax.Version.t option (** A unique integer identifier. It is only unique for the duration of diff --git a/src/super_context.ml b/src/super_context.ml index 3e088c2cd43..bf67fadf230 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -708,6 +708,15 @@ module Libs = struct (lib_files_alias ~dir ~name:(Library.best_name lib) ~ext)) |> Path.Set.of_list) + let file_deps_with_exts t lib_exts = + List.rev_map lib_exts ~f:(fun ((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 t libs ~ext = List.rev_map libs ~f:(fun (lib : Lib.t) -> if Lib.is_local lib then 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 From 9f43a88950a1a875104d17e9f6af3f950e2a2e32 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 2 Aug 2018 13:26:15 +0200 Subject: [PATCH 4/7] Remove opaque from Lib.t Only use Compilation_context.t for controlling this Signed-off-by: Rudi Grinberg --- src/compilation_context.ml | 20 +++++++++++--------- src/gen_rules.ml | 7 ++++--- src/lib.ml | 17 ++++------------- src/lib.mli | 9 +-------- src/scope.ml | 4 ++-- src/scope.mli | 1 - src/super_context.ml | 2 -- 7 files changed, 22 insertions(+), 38 deletions(-) diff --git a/src/compilation_context.ml b/src/compilation_context.ml index cba8669a02f..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 -> @@ -22,13 +22,15 @@ module Includes = struct Arg_spec.S [ iflags ; Hidden_deps - ( libs - |> List.map ~f:(fun lib -> - (lib, if Lib.opaque lib then - ".cmi" - else - ".cmi-and-.cmx")) - |> SC.Libs.file_deps_with_exts sctx + ( 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 @@ -89,7 +91,7 @@ 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 diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 70e5bbb8605..43fe88a8cf1 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" + (* +-----------------------------------------------------------------+ | Library stuff | +-----------------------------------------------------------------+ *) @@ -199,7 +201,7 @@ module Gen(P : Install_rules.Params) = struct ~requires ~preprocessing:pp ~no_keep_locs:lib.no_keep_locs - ~opaque:(Lib.Compile.opaque compile_info) + ~opaque in let dep_graphs = Ocamldep.rules cctx in @@ -521,7 +523,7 @@ module Gen(P : Install_rules.Params) = struct ~flags ~requires ~preprocessing:pp - ~opaque:(Lib.Compile.opaque compile_info) + ~opaque in Exe.build_and_link_many cctx @@ -545,7 +547,6 @@ module Gen(P : Install_rules.Params) = struct exes.buildable.libraries ~pps:(Jbuild.Preprocess_map.pps exes.buildable.preprocess) ~allow_overlaps:exes.buildable.allow_overlapping_dependencies - ~opaque:(ctx.profile = "dev") in SC.Libs.gen_select_rules sctx compile_info ~dir; SC.Libs.with_lib_deps sctx compile_info ~dir diff --git a/src/lib.ml b/src/lib.ml index c24c61637c7..0cf8c91adc1 100644 --- a/src/lib.ml +++ b/src/lib.ml @@ -63,7 +63,6 @@ module Info = struct ; pps : (Loc.t * Jbuild.Pp.t) list ; optional : bool ; virtual_deps : (Loc.t * string) list - ; opaque : bool ; dune_version : Syntax.Version.t option ; sub_systems : Jbuild.Sub_system_info.t Sub_system_name.Map.t } @@ -73,7 +72,7 @@ module Info = struct ~init:(Deps.to_lib_deps t.requires) ~f:(fun acc s -> Jbuild.Lib_dep.Direct s :: acc) - let of_library_stanza ~dir ~opaque (conf : Jbuild.Library.t) = + let of_library_stanza ~dir (conf : Jbuild.Library.t) = let archive_file ext = Path.relative dir (conf.name ^ ext) in let archive_files ~f_ext = Mode.Dict.of_func (fun ~mode -> [archive_file (f_ext mode)]) @@ -117,7 +116,6 @@ module Info = struct ; pps = Jbuild.Preprocess_map.pps conf.buildable.preprocess ; sub_systems = conf.sub_systems ; dune_version = Some conf.dune_version - ; opaque } let of_findlib_package pkg = @@ -144,7 +142,6 @@ module Info = struct ; virtual_deps = [] ; optional = false ; status = Installed - ; opaque = false ; (* We don't know how these are named for external libraries *) foreign_archives = Mode.Dict.make_both [] ; sub_systems = sub_systems @@ -338,8 +335,6 @@ let plugins t = t.info.plugins let jsoo_runtime t = t.info.jsoo_runtime let unique_id t = t.unique_id -let opaque t = t.info.opaque - let dune_version t = t.info.dune_version let src_dir t = t.info.src_dir @@ -914,7 +909,6 @@ module Compile = struct ; pps : t list Or_exn.t ; resolved_selects : Resolved_select.t list ; optional : bool - ; opaque : bool ; user_written_deps : Jbuild.Lib_deps.t ; sub_systems : Sub_system0.Instance.t Lazy.t Sub_system_name.Map.t } @@ -927,7 +921,6 @@ module Compile = struct ; optional = t.info.optional ; user_written_deps = t.user_written_deps ; sub_systems = t.sub_systems - ; opaque = t.info.opaque } let direct_requires t = t.direct_requires @@ -936,7 +929,6 @@ module Compile = struct let pps t = t.pps let optional t = t.optional let user_written_deps t = t.user_written_deps - let opaque t = t.opaque let sub_systems t = Sub_system_name.Map.values t.sub_systems |> List.map ~f:(fun (lazy (Sub_system0.Instance.T ((module M), t))) -> @@ -965,10 +957,10 @@ module DB = struct ; all = Lazy.from_fun all } - let create_from_library_stanzas ?parent ~opaque stanzas = + let create_from_library_stanzas ?parent stanzas = let map = List.concat_map stanzas ~f:(fun (dir, (conf : Jbuild.Library.t)) -> - let info = Info.of_library_stanza ~dir ~opaque conf in + let info = Info.of_library_stanza ~dir conf in match conf.public with | None -> [(conf.name, Resolve_result.Found info)] @@ -1063,7 +1055,7 @@ module DB = struct let t = Option.some_if (not allow_overlaps) t in Compile.for_lib t lib - let resolve_user_written_deps t ?(allow_overlaps=false) ~opaque deps ~pps = + let resolve_user_written_deps t ?(allow_overlaps=false) deps ~pps = let res, pps, resolved_selects = resolve_user_deps t (Info.Deps.of_lib_deps deps) ~pps ~stack:Dep_stack.empty ~allow_private_deps:true @@ -1081,7 +1073,6 @@ module DB = struct ; optional = false ; user_written_deps = deps ; sub_systems = Sub_system_name.Map.empty - ; opaque } let resolve_pps t pps = diff --git a/src/lib.mli b/src/lib.mli index 401028f6453..8ae8df2f340 100644 --- a/src/lib.mli +++ b/src/lib.mli @@ -26,8 +26,6 @@ val archives : t -> Path.t list Mode.Dict.t val plugins : t -> Path.t list Mode.Dict.t val jsoo_runtime : t -> Path.t list -val opaque : t -> bool - val dune_version : t -> Syntax.Version.t option (** A unique integer identifier. It is only unique for the duration of @@ -107,12 +105,11 @@ module Info : sig ; pps : (Loc.t * Jbuild.Pp.t) list ; optional : bool ; virtual_deps : (Loc.t * string) list - ; opaque : bool ; dune_version : Syntax.Version.t option ; sub_systems : Jbuild.Sub_system_info.t Sub_system_name.Map.t } - val of_library_stanza : dir:Path.t -> opaque:bool -> Jbuild.Library.t -> t + val of_library_stanza : dir:Path.t -> Jbuild.Library.t -> t val of_findlib_package : Findlib.Package.t -> t end @@ -221,8 +218,6 @@ module Compile : sig val optional : t -> bool val user_written_deps : t -> Jbuild.Lib_deps.t - val opaque : t -> bool - (** Sub-systems used in this compilation context *) val sub_systems : t -> sub_system list end @@ -262,7 +257,6 @@ module DB : sig (** Create a database from a list of library stanzas *) val create_from_library_stanzas : ?parent:t - -> opaque:bool -> (Path.t * Jbuild.Library.t) list -> t @@ -295,7 +289,6 @@ module DB : sig val resolve_user_written_deps : t -> ?allow_overlaps:bool - -> opaque:bool -> Jbuild.Lib_dep.t list -> pps:(Loc.t * Jbuild.Pp.t) list -> Compile.t diff --git a/src/scope.ml b/src/scope.ml index f4e9bf8f6e4..0da4f1e70e8 100644 --- a/src/scope.ml +++ b/src/scope.ml @@ -50,7 +50,7 @@ module DB = struct (Project_name_map.keys t.by_name) ] - let create ~projects ~context ~opaque ~installed_libs internal_libs = + let create ~projects ~context ~installed_libs internal_libs = let projects_by_name = List.map projects ~f:(fun (project : Dune_project.t) -> (project.name, project)) @@ -119,7 +119,7 @@ module DB = struct let project = Option.value_exn project in let libs = Option.value libs ~default:[] in let db = - Lib.DB.create_from_library_stanzas libs ~parent:public_libs ~opaque + Lib.DB.create_from_library_stanzas libs ~parent:public_libs in let root = Path.append_local build_context_dir project.root in Some { project; db; root }) diff --git a/src/scope.mli b/src/scope.mli index e24aa7a9413..4cd3153689b 100644 --- a/src/scope.mli +++ b/src/scope.mli @@ -24,7 +24,6 @@ module DB : sig val create : projects:Dune_project.t list -> context:string - -> opaque:bool -> installed_libs:Lib.DB.t -> (Path.t * Jbuild.Library.t) list -> t * Lib.DB.t diff --git a/src/super_context.ml b/src/super_context.ml index bf67fadf230..c4f72212f13 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -506,11 +506,9 @@ let create | Library lib -> Some (ctx_dir, lib) | _ -> None)) in - let opaque = context.profile = "dev" in let scopes, public_libs = Scope.DB.create ~projects - ~opaque ~context:context.name ~installed_libs internal_libs From bde49436928962ee8223530d4b97927819c9f455 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 2 Aug 2018 15:21:59 +0200 Subject: [PATCH 5/7] Make file_deps and file_deps_with_exts share code Signed-off-by: Rudi Grinberg --- src/super_context.ml | 24 ++++++++++-------------- 1 file changed, 10 insertions(+), 14 deletions(-) diff --git a/src/super_context.ml b/src/super_context.ml index c4f72212f13..de47e8cf759 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -706,23 +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 : 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) + 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 From 1597b61df946ffd9ebe57ca63e3424aee499ae6c Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 2 Aug 2018 15:28:47 +0200 Subject: [PATCH 6/7] Move 4.03 minium version check for opaque to top level Signed-off-by: Rudi Grinberg --- src/gen_rules.ml | 2 +- src/module_compilation.ml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 43fe88a8cf1..b5478a472b6 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -17,7 +17,7 @@ module Gen(P : Install_rules.Params) = struct let sctx = P.sctx let ctx = SC.context sctx - let opaque = ctx.profile = "dev" + let opaque = ctx.profile = "dev" && ctx.version >= (4, 03, 0) (* +-----------------------------------------------------------------+ | Library stuff | diff --git a/src/module_compilation.ml b/src/module_compilation.ml index c2409190fc3..6d6e2b0f302 100644 --- a/src/module_compilation.ml +++ b/src/module_compilation.ml @@ -58,7 +58,7 @@ 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 && ctx.version >= (4, 03, 0) in + let opaque = CC.opaque cctx in let other_cm_files = Build.dyn_paths (Ocamldep.Dep_graph.deps_of dep_graph m >>^ fun deps -> From 4cbd698527801a9fca494d7a24f7e513b5fa711f Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 2 Aug 2018 16:23:07 +0200 Subject: [PATCH 7/7] Update CHANGELOG for -opaque by in dev Signed-off-by: Rudi Grinberg --- CHANGES.md | 3 +++ 1 file changed, 3 insertions(+) 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) ------------------