Merge pull request #1079 from rgrinberg/opaque

Opaque Mode

Author: rgrinberg

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

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 =

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

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

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

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

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

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

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

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: