Generic ppx driver

CHANGES.md

@@ -56,6 +56,9 @@ next
 - In dune files, add support for block strings, allowing to nicely
   format blocks of texts (#837, @diml)
 
+- Remove hard-coded knowledge of ppx_driver and
+  ocaml-migrate-parsetree when using a `dune` file (#576, @diml)
+
 1.0+beta20 (10/04/2018)
 -----------------------
 
@@ -176,7 +179,6 @@ next
 - Add a hack to be able to build ppxlib, until beta20 which will have
   generic support for ppx drivers
 
-
 1.0+beta18 (25/02/2018)
 -----------------------
 

doc/advanced-topics.rst

@@ -30,44 +30,6 @@ Jbuilder you can write the folliwing ``META.foo.template`` file:
    # JBUILDER_GEN
    blah = "..."
 
-.. _custom-driver:
-
-Using a custom ppx driver
-=========================
-
-You can use a custom ppx driver by putting it as the last library in ``(pps
-...)`` forms. An example of alternative driver is `ppx_driver
-<https://github.com/janestreet/ppx_driver>`__. To use it instead of
-``ocaml-migrate-parsetree.driver-main``, simply write ``ppx_driver.runner`` as
-the last library:
-
-.. code:: scheme
-
-    (preprocess (pps (ppx_sexp_conv ppx_bin_prot ppx_driver.runner)))
-
-Driver expectation
-------------------
-
-Jbuilder will invoke the executable resulting from linking the libraries
-given in the ``(pps ...)`` form as follows:
-
-.. code:: bash
-
-    ppx.exe <flags-written-by-user> --dump-ast -o <output-file> \
-      [--cookie library-name="<name>"] [--impl|--intf] <source-file>
-
-Where ``<source-file>`` is either an implementation (``.ml``) or
-interface (``.mli``) OCaml source file. The command is expected to write
-a binary OCaml AST in ``<output-file>``.
-
-Additionally, it is expected that if the executable is invoked with
-``--as-ppx`` as its first argument, then it will behave as a standard
-ppx rewriter as passed to ``-ppx`` option of OCaml. This is for two
-reasons:
-
--  to improve interoperability with build systems other than Jbuilder
--  so that it can be used with merlin
-
 Findlib integration and limitations
 ===================================
 

doc/jbuild.rst

@@ -1045,11 +1045,6 @@ dependencies. Note that it is important that all these libraries are linked with
 ``-linkall``. Jbuilder automatically uses ``-linkall`` when the ``(kind ...)``
 field is set to ``ppx_rewriter`` or ``ppx_deriver``.
 
-It is guaranteed that the last library in the list will be linked last. You can
-use this feature to use a custom ppx driver. By default Jbuilder will use
-``ocaml-migrate-parsetree.driver-main``. See the section about
-:ref:`custom-driver` for more details.
-
 Per module preprocessing specification
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 

dune.opam

@@ -12,4 +12,6 @@ build: [
   ["./boot.exe" "-j" jobs]
 ]
 available: [ ocaml-version >= "4.02.3" ]
-conflicts: [ "jbuilder" {!= "transition"} ]
+conflicts: [
+  "jbuilder" {!= "transition"}
+]

src/file_tree.ml

@@ -1,19 +1,40 @@
 open! Import
 
 module Dune_file = struct
+  module Kind = struct
+    type t = Dune | Jbuild
+
+    let of_basename = function
+      | "dune"   -> Dune
+      | "jbuild" -> Jbuild
+      | _ -> assert false
+
+    let lexer = function
+      | Dune   -> Sexp.Lexer.token
+      | Jbuild -> Sexp.Lexer.jbuild_token
+  end
+
   module Plain = struct
     type t =
       { path          : Path.t
       ; mutable sexps : Sexp.Ast.t list
       }
   end
 
+  module Contents = struct
+    type t =
+      | Plain of Plain.t
+      | Ocaml_script of Path.t
+  end
+
   type t =
-    | Plain of Plain.t
-    | Ocaml_script of Path.t
+    { contents : Contents.t
+    ; kind     : Kind.t
+    }
 
-  let path = function
-    | Plain x -> x.path
+  let path t =
+    match t.contents with
+    | Plain         x -> x.path
     | Ocaml_script  p -> p
 
   let extract_ignored_subdirs =
@@ -47,14 +68,19 @@ module Dune_file = struct
       in
       (ignored_subdirs, sexps)
 
-  let load ?lexer file =
+  let load file ~kind =
     Io.with_lexbuf_from_file file ~f:(fun lb ->
-      if Dune_lexer.is_script lb then
-        (Ocaml_script file, String.Set.empty)
-      else
-        let sexps = Usexp.Parser.parse lb ?lexer ~mode:Many in
-        let ignored_subdirs, sexps = extract_ignored_subdirs sexps in
-        (Plain { path = file; sexps }, ignored_subdirs))
+      let contents, ignored_subdirs =
+        if Dune_lexer.is_script lb then
+          (Contents.Ocaml_script file, String.Set.empty)
+        else
+          let sexps =
+            Usexp.Parser.parse lb ~lexer:(Kind.lexer kind) ~mode:Many
+          in
+          let ignored_subdirs, sexps = extract_ignored_subdirs sexps in
+          (Plain { path = file; sexps }, ignored_subdirs)
+      in
+      ({ contents; kind }, ignored_subdirs))
 end
 
 let load_jbuild_ignore path =
@@ -195,9 +221,7 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) path =
             | [fn] ->
               let dune_file, ignored_subdirs =
                 Dune_file.load (Path.relative path fn)
-                  ~lexer:(match fn with
-                    | "jbuild" -> Sexp.Lexer.jbuild_token
-                    | _        -> Sexp.Lexer.token)
+                  ~kind:(Dune_file.Kind.of_basename fn)
               in
               (Some dune_file, ignored_subdirs)
             | _ ->

src/file_tree.mli

@@ -3,6 +3,12 @@
 open! Import
 
 module Dune_file : sig
+  module Kind : sig
+    type t = Dune | Jbuild
+
+    val lexer : t -> Sexp.Lexer.t
+  end
+
   module Plain : sig
     (** [sexps] is mutable as we get rid of the S-expressions once
         they have been parsed, in order to release the memory as soon
@@ -13,9 +19,16 @@ module Dune_file : sig
       }
   end
 
+  module Contents : sig
+    type t =
+      | Plain of Plain.t
+      | Ocaml_script of Path.t
+  end
+
   type t =
-    | Plain of Plain.t
-    | Ocaml_script of Path.t
+    { contents : Contents.t
+    ; kind     : Kind.t
+    }
 
   val path : t -> Path.t
 end

src/gen_rules.ml

@@ -542,7 +542,7 @@ module Gen(P : Install_rules.Params) = struct
   let alias_module_build_sandbox = ctx.version < (4, 03, 0)
 
   let library_rules (lib : Library.t) ~modules_partitioner ~dir ~files ~scope
-        ~compile_info =
+        ~compile_info ~dir_kind =
     let obj_dir = Utils.library_object_directory ~dir lib.name in
     let requires = Lib.Compile.requires compile_info in
     let dep_kind = if lib.optional then Build.Optional else Required in
@@ -559,6 +559,7 @@ module Gen(P : Install_rules.Params) = struct
              lib.buildable.preprocessor_deps)
         ~lint:lib.buildable.lint
         ~lib_name:(Some lib.name)
+        ~dir_kind
     in
     let modules = Preprocessing.pp_modules pp modules in
 
@@ -789,21 +790,23 @@ module Gen(P : Install_rules.Params) = struct
       ~libname:lib.name
       ~objs_dirs:(Path.Set.singleton obj_dir)
 
-  let library_rules (lib : Library.t) ~modules_partitioner ~dir ~files ~scope =
+  let library_rules (lib : Library.t) ~modules_partitioner ~dir ~files ~scope
+        ~dir_kind : Merlin.t =
     let compile_info =
       Lib.DB.get_compile_info (Scope.libs scope) lib.name
         ~allow_overlaps:lib.buildable.allow_overlapping_dependencies
     in
     SC.Libs.gen_select_rules sctx compile_info ~dir;
     SC.Libs.with_lib_deps sctx compile_info ~dir
       ~f:(fun () ->
-        library_rules lib ~modules_partitioner ~dir ~files ~scope ~compile_info)
+        library_rules lib ~modules_partitioner ~dir ~files ~scope ~compile_info
+          ~dir_kind)
 
   (* +-----------------------------------------------------------------+
      | Executables stuff                                               |
      +-----------------------------------------------------------------+ *)
 
-  let executables_rules ~dir ~all_modules
+  let executables_rules ~dir ~all_modules ~dir_kind
         ~modules_partitioner ~scope ~compile_info
         (exes : Executables.t) =
     let requires = Lib.Compile.requires compile_info in
@@ -822,6 +825,7 @@ module Gen(P : Install_rules.Params) = struct
         ~preprocessor_deps
         ~lint:exes.buildable.lint
         ~lib_name:None
+        ~dir_kind
     in
     let modules =
       Module.Name.Map.map modules ~f:(fun m ->
@@ -907,7 +911,8 @@ module Gen(P : Install_rules.Params) = struct
       ~objs_dirs:(Path.Set.singleton obj_dir)
 
   let executables_rules ~dir ~all_modules
-        ~modules_partitioner ~scope (exes : Executables.t) =
+        ~modules_partitioner ~scope ~dir_kind
+        (exes : Executables.t) : Merlin.t =
     let compile_info =
       Lib.DB.resolve_user_written_deps (Scope.libs scope)
         exes.buildable.libraries
@@ -918,7 +923,7 @@ module Gen(P : Install_rules.Params) = struct
     SC.Libs.with_lib_deps sctx compile_info ~dir
       ~f:(fun () ->
         executables_rules exes ~dir ~all_modules
-          ~modules_partitioner ~scope ~compile_info)
+          ~modules_partitioner ~scope ~compile_info ~dir_kind)
 
   (* +-----------------------------------------------------------------+
      | Aliases                                                         |
@@ -961,7 +966,7 @@ module Gen(P : Install_rules.Params) = struct
      | Stanza                                                          |
      +-----------------------------------------------------------------+ *)
 
-  let gen_rules { SC.Dir_with_jbuild. src_dir; ctx_dir; stanzas; scope } =
+  let gen_rules { SC.Dir_with_jbuild. src_dir; ctx_dir; stanzas; scope; kind } =
     (* This interprets "rule" and "copy_files" stanzas. *)
     let files = text_files ~dir:ctx_dir in
     let all_modules = modules_by_dir ~dir:ctx_dir in
@@ -971,10 +976,11 @@ module Gen(P : Install_rules.Params) = struct
         let dir = ctx_dir in
         match (stanza : Stanza.t) with
         | Library lib ->
-          Some (library_rules lib ~dir ~files ~scope ~modules_partitioner)
+          Some (library_rules lib ~dir ~files ~scope ~modules_partitioner
+                  ~dir_kind:kind)
         | Executables exes ->
           Some (executables_rules exes ~dir ~all_modules ~scope
-                  ~modules_partitioner)
+                  ~modules_partitioner ~dir_kind:kind)
         | Alias alias ->
           alias_rules alias ~dir ~scope;
           None
@@ -990,7 +996,7 @@ module Gen(P : Install_rules.Params) = struct
         | _ -> None)
     in
     Option.iter (Merlin.merge_all merlins) ~f:(fun m ->
-      Merlin.add_rules sctx ~dir:ctx_dir ~scope
+      Merlin.add_rules sctx ~dir:ctx_dir ~scope ~dir_kind:kind
         (Merlin.add_source_dir m src_dir));
     Utop.setup sctx ~dir:ctx_dir ~scope ~libs:(
       List.filter_map stanzas ~f:(function
@@ -1089,17 +1095,18 @@ let gen ~contexts ~build_system
       match only_packages with
       | None -> stanzas
       | Some pkgs ->
-        List.map stanzas ~f:(fun (dir, pkgs_ctx, stanzas) ->
-          (dir,
-           pkgs_ctx,
-           List.filter stanzas ~f:(fun stanza ->
-             match (stanza : Stanza.t) with
-             | Library { public = Some { package; _ }; _ }
-             | Alias { package = Some package ;  _ }
-             | Install { package; _ }
-             | Documentation { package; _ } ->
-               Package.Name.Set.mem pkgs package.name
-             | _ -> true)))
+        List.map stanzas ~f:(fun (dir_conf : Jbuild_load.Jbuild.t) ->
+          let stanzas =
+            List.filter dir_conf.stanzas ~f:(fun stanza ->
+              match (stanza : Stanza.t) with
+              | Library { public = Some { package; _ }; _ }
+              | Alias { package = Some package ;  _ }
+              | Install { package; _ }
+              | Documentation { package; _ } ->
+                Package.Name.Set.mem pkgs package.name
+              | _ -> true)
+          in
+          { dir_conf with stanzas })
     in
     Fiber.fork_and_join host stanzas >>= fun (host, stanzas) ->
     let sctx =

src/inline_tests.ml

@@ -77,7 +77,7 @@ module Backend = struct
             (List.map info.extends
                ~f:(fun ((loc, name) as x) ->
                  resolve x >>= fun lib ->
-                 match get lib with
+                 match get ~loc lib with
                  | None ->
                    Error (Loc.exnf loc "%S is not an %s" name
                             (desc ~plural:false))