Restore old ppx behavior for directories with jbuild files

Signed-off-by: Jeremie Dimino <jdimino@janestreet.com>

CHANGES.md

@@ -57,7 +57,7 @@ next
   format blocks of texts (#837, @diml)
 
 - Remove hard-coded knowledge of ppx_driver and
-  ocaml-migrate-parsetree (#576, @diml)
+  ocaml-migrate-parsetree when using a `dune` file (#576, @diml)
 
 1.0+beta20 (10/04/2018)
 -----------------------

dune.opam

@@ -14,6 +14,4 @@ build: [
 available: [ ocaml-version >= "4.02.3" ]
 conflicts: [
   "jbuilder" {!= "transition"}
-  "ppx_driver" {< "v0.10.3"}
-  "ocaml-migrate-parsetree" {< "1.0.8"}
 ]

src/file_tree.ml

@@ -1,6 +1,19 @@
 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
@@ -8,12 +21,20 @@ module Dune_file = struct
       }
   end
 
-  type t =
+  module Contents = struct
-    | Plain of Plain.t
+    type t =
-    | Ocaml_script of Path.t
+      | Plain of Plain.t
+      | Ocaml_script of Path.t
+  end
 
-  let path = function
+  type t =
-    | Plain x -> x.path
+    { contents : Contents.t
+    ; kind     : Kind.t
+    }
+
+  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
+      let contents, ignored_subdirs =
-        (Ocaml_script file, String.Set.empty)
+        if Dune_lexer.is_script lb then
-      else
+          (Contents.Ocaml_script file, String.Set.empty)
-        let sexps = Usexp.Parser.parse lb ?lexer ~mode:Many in
+        else
-        let ignored_subdirs, sexps = extract_ignored_subdirs sexps in
+          let sexps =
-        (Plain { path = file; sexps }, ignored_subdirs))
+            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
+                  ~kind:(Dune_file.Kind.of_basename fn)
-                    | "jbuild" -> Sexp.Lexer.jbuild_token
-                    | _        -> Sexp.Lexer.token)
               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
+    { contents : Contents.t
-    | Ocaml_script of Path.t
+    ; kind     : Kind.t
+    }
 
   val path : t -> Path.t
 end

src/gen_rules.ml

@@ -532,7 +532,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
@@ -549,6 +549,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
 
@@ -779,7 +780,8 @@ 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
@@ -787,13 +789,14 @@ module Gen(P : Install_rules.Params) = struct
     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
@@ -812,6 +815,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 ->
@@ -896,7 +900,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
@@ -907,7 +912,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                                                         |
@@ -950,7 +955,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
@@ -960,10 +965,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
@@ -979,7 +985,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
@@ -1078,17 +1084,18 @@ let gen ~contexts ~build_system
       match only_packages with
       | None -> stanzas
       | Some pkgs ->
-        List.map stanzas ~f:(fun (dir, pkgs_ctx, stanzas) ->
+        List.map stanzas ~f:(fun (dir_conf : Jbuild_load.Jbuild.t) ->
-          (dir,
+          let stanzas =
-           pkgs_ctx,
+            List.filter dir_conf.stanzas ~f:(fun stanza ->
-           List.filter stanzas ~f:(fun stanza ->
+              match (stanza : Stanza.t) with
-             match (stanza : Stanza.t) with
+              | Library { public = Some { package; _ }; _ }
-             | Library { public = Some { package; _ }; _ }
+              | Alias { package = Some package ;  _ }
-             | Alias { package = Some package ;  _ }
+              | Install { package; _ }
-             | Install { package; _ }
+              | Documentation { package; _ } ->
-             | Documentation { package; _ } ->
+                Package.Name.Set.mem pkgs package.name
-               Package.Name.Set.mem pkgs package.name
+              | _ -> true)
-             | _ -> true)))
+          in
+          { dir_conf with stanzas })
     in
     Fiber.fork_and_join host stanzas >>= fun (host, stanzas) ->
     let sctx =

src/install_rules.ml

@@ -130,7 +130,7 @@ module Gen(P : Install_params) = struct
            >>>
            Build.write_file_dyn meta)))
 
-  let lib_install_files ~dir ~sub_dir ~name (lib : Library.t) =
+  let lib_install_files ~dir ~sub_dir ~name ~scope ~dir_kind (lib : Library.t) =
     let obj_dir = Utils.library_object_directory ~dir lib.name in
     let make_entry section ?dst fn =
       Install.Entry.make section fn
@@ -184,7 +184,30 @@ module Gen(P : Install_params) = struct
       match lib.kind with
       | Normal | Ppx_deriver -> []
       | Ppx_rewriter ->
-        [Preprocessing.get_ppx_driver_for_public_lib sctx ~name]
+        match (dir_kind : File_tree.Dune_file.Kind.t) with
+        | Dune ->
+          [Preprocessing.get_ppx_driver_for_public_lib sctx ~name ~dir_kind]
+        | Jbuild ->
+          let pps = [(lib.buildable.loc, Pp.of_string lib.name)] in
+          let pps =
+            let deps =
+              List.concat_map lib.buildable.libraries ~f:Lib_dep.to_lib_names
+            in
+            if List.exists deps ~f:(function
+              | "ppx_driver" | "ppx_type_conv" -> true
+              | _ -> false) then
+              pps @ [match Scope.name scope with
+                | Named "ppxlib" ->
+                  Loc.none, Pp.of_string "ppxlib.runner"
+                | _ ->
+                  Loc.none, Pp.of_string "ppx_driver.runner"]
+            else
+              pps
+          in
+          match Preprocessing.get_ppx_driver sctx ~scope ~dir_kind pps with
+          | Ok    x -> [x]
+          | Error _ ->
+            [Preprocessing.get_ppx_driver_for_public_lib sctx ~name ~dir_kind]
     in
     List.concat
       [ List.map files ~f:(make_entry Lib    )
@@ -274,10 +297,12 @@ module Gen(P : Install_params) = struct
   let init_install () =
     let entries_per_package =
       List.concat_map (SC.stanzas_to_consider_for_install sctx)
-        ~f:(fun (dir, _scope, stanza) ->
+        ~f:(fun { SC.Installable. dir; stanza; kind = dir_kind; scope; _ } ->
           match stanza with
-          | Library ({ public = Some { package; sub_dir; name; _ }; _ } as lib) ->
+          | Library ({ public = Some { package; sub_dir; name; _ }
-            List.map (lib_install_files ~dir ~sub_dir ~name lib)
+                     ; _ } as lib) ->
+            List.map (lib_install_files ~dir ~sub_dir ~name lib ~scope
+                        ~dir_kind)
               ~f:(fun x -> package.name, x)
           | Install { section; files; package}->
             List.map files ~f:(fun { Install_conf. src; dst } ->

src/jbuild.ml

@@ -262,19 +262,6 @@ module Preprocess = struct
           Action (loc, x))
       ; cstr "pps" (cstr_loc (list Pp_or_flags.t @> nil)) (fun loc l ->
           let pps, flags = Pp_or_flags.split l in
-          let pps =
-            (* Compatibility hacks. We can remove them when switching
-               to Dune and make these cases errors. *)
-            match pps with
-            | [] ->
-              [(loc, Pp.of_string "ocaml-migrate-parsetree")]
-            | _ ->
-              List.map pps ~f:(fun ((loc, pp) as x) ->
-                match Pp.to_string pp with
-                | "ppx_driver.runner" -> (loc, Pp.of_string "ppx_driver")
-                | "ppxlib.runner" -> (loc, Pp.of_string "ppxlib")
-                | _ -> x)
-          in
           Pps { loc; pps; flags })
       ]
 

src/jbuild_load.ml

@@ -9,16 +9,26 @@ let filter_stanzas ~ignore_promoted_rules stanzas =
   else
     stanzas
 
+module Jbuild = struct
+  type t =
+    { dir     : Path.t
+    ; project : Dune_project.t
+    ; stanzas : Stanzas.t
+    ; kind    : File_tree.Dune_file.Kind.t
+    }
+end
+
 module Jbuilds = struct
   type script =
     { dir     : Path.t
     ; file    : Path.t
     ; project : Dune_project.t
+    ; kind    : File_tree.Dune_file.Kind.t
     }
 
   type one =
-    | Literal of (Path.t * Dune_project.t * Stanza.t list)
+    | Literal of Jbuild.t
-    | Script of script
+    | Script  of script
 
   type t =
     { jbuilds               : one list
@@ -114,7 +124,7 @@ end
         | Literal x -> Left  x
         | Script  x -> Right x)
     in
-    Fiber.parallel_map dynamic ~f:(fun { dir; file; project } ->
+    Fiber.parallel_map dynamic ~f:(fun { dir; file; project; kind } ->
       let generated_jbuild =
         Path.append (Path.relative generated_jbuilds_dir context.name) file
       in
@@ -153,10 +163,19 @@ end
         die "@{<error>Error:@} %s failed to produce a valid jbuild file.\n\
              Did you forgot to call [Jbuild_plugin.V*.send]?"
           (Path.to_string file);
-      let sexps = Io.Sexp.load generated_jbuild ~mode:Many in
+      let stanzas =
-      Fiber.return (dir, project,
+        Io.Sexp.load generated_jbuild ~mode:Many
-                    Stanzas.parse project sexps ~file:generated_jbuild
+          ~lexer:(File_tree.Dune_file.Kind.lexer kind)
-                    |> filter_stanzas ~ignore_promoted_rules))
+        |> Stanzas.parse project ~file:generated_jbuild
+        |> filter_stanzas ~ignore_promoted_rules
+      in
+      Fiber.return
+        { Jbuild.
+          dir
+        ; project
+        ; kind
+        ; stanzas
+        })
     >>| fun dynamic ->
     static @ dynamic
 end
@@ -170,17 +189,24 @@ type conf =
 
 let interpret ~dir ~project ~ignore_promoted_rules
       ~(dune_file:File_tree.Dune_file.t) =
-  match dune_file with
+  match dune_file.contents with
   | Plain p ->
+    let stanzas =
+      Stanzas.parse project p.sexps ~file:p.path
+      |> filter_stanzas ~ignore_promoted_rules
+    in
     let jbuild =
-      Jbuilds.Literal (dir, project,
+      Jbuilds.Literal
-                       Stanzas.parse project p.sexps ~file:p.path
+        { dir
-                       |> filter_stanzas ~ignore_promoted_rules)
+        ; project
+        ; stanzas
+        ; kind = dune_file.kind
+        }
     in
     p.sexps <- [];
     jbuild
   | Ocaml_script file ->
-    Script { dir; project; file }
+    Script { dir; project; file; kind = dune_file.kind }
 
 let load ?extra_ignored_subtrees ?(ignore_promoted_rules=false) () =
   let ftree = File_tree.load Path.root ?extra_ignored_subtrees in

src/jbuild_load.mli

@@ -1,12 +1,21 @@
 open Stdune
 
+module Jbuild : sig
+  type t =
+    { dir     : Path.t
+    ; project : Dune_project.t
+    ; stanzas : Jbuild.Stanzas.t
+    ; kind    : File_tree.Dune_file.Kind.t
+    }
+end
+
 module Jbuilds : sig
   type t
 
   val eval
     :  t
     -> context:Context.t
-    -> (Path.t * Dune_project.t * Jbuild.Stanzas.t) list Fiber.t
+    -> Jbuild.t list Fiber.t
 end
 
 type conf =

src/merlin.ml

@@ -96,10 +96,10 @@ let make
 let add_source_dir t dir =
   { t with source_dirs = Path.Set.add t.source_dirs dir }
 
-let ppx_flags sctx ~dir:_ ~scope ~src_dir:_ { preprocess; libname; _ } =
+let ppx_flags sctx ~dir:_ ~scope ~dir_kind { preprocess; libname; _ } =
   match preprocess with
   | Pps { loc = _; pps; flags } -> begin
-    match Preprocessing.get_ppx_driver sctx ~scope pps with
+    match Preprocessing.get_ppx_driver sctx ~scope ~dir_kind pps with
     | Ok exe ->
       (Path.to_absolute_filename exe
        :: "--as-ppx"
@@ -109,7 +109,7 @@ let ppx_flags sctx ~dir:_ ~scope ~src_dir:_ { preprocess; libname; _ } =
   end
   | Other -> []
 
-let dot_merlin sctx ~dir ~scope ({ requires; flags; _ } as t) =
+let dot_merlin sctx ~dir ~scope ~dir_kind ({ requires; flags; _ } as t) =
   match Path.drop_build_context dir with
   | None -> ()
   | Some remaindir ->
@@ -139,7 +139,7 @@ let dot_merlin sctx ~dir ~scope ({ requires; flags; _ } as t) =
         in
         Dot_file.to_string
           ~remaindir
-          ~ppx:(ppx_flags sctx ~dir ~scope ~src_dir:remaindir t)
+          ~ppx:(ppx_flags sctx ~dir ~scope ~dir_kind t)
           ~flags
           ~src_dirs
           ~obj_dirs)
@@ -162,6 +162,6 @@ let merge_all = function
   | [] -> None
   | init::ts -> Some (List.fold_left ~init ~f:merge_two ts)
 
-let add_rules sctx ~dir ~scope merlin =
+let add_rules sctx ~dir ~scope ~dir_kind merlin =
   if (SC.context sctx).merlin then
-    dot_merlin sctx ~dir ~scope merlin
+    dot_merlin sctx ~dir ~scope ~dir_kind merlin

src/merlin.mli

@@ -23,5 +23,6 @@ val add_rules
   : Super_context.t
   -> dir:Path.t
   -> scope:Scope.t
+  -> dir_kind:File_tree.Dune_file.Kind.t
   -> t
   -> unit

src/preprocessing.ml

@@ -61,21 +61,26 @@ module Driver = struct
           ]
     end
 
+    (* The [lib] field is lazy so that we don't need to fill it for
+       hardcoded [t] values used to implement the jbuild style
+       handling of drivers.
+
+       See [Jbuild_driver] below for details. *)
     type t =
       { info     : Info.t
-      ; lib      : Lib.t
+      ; lib      : Lib.t Lazy.t
       ; replaces : t list Or_exn.t
       }
 
     let desc ~plural = "ppx driver" ^ if plural then "s" else ""
     let desc_article = "a"
 
-    let lib      t = t.lib
+    let lib      t = Lazy.force t.lib
     let replaces t = t.replaces
 
     let instantiate ~resolve ~get lib (info : Info.t) =
       { info
-      ; lib
+      ; lib = lazy lib
       ; replaces =
           let open Result.O in
           Result.all
@@ -91,7 +96,7 @@ module Driver = struct
 
     let to_sexp t =
       let open Sexp.To_sexp in
-      let f x = string (Lib.name x.lib) in
+      let f x = string (Lib.name (Lazy.force x.lib)) in
       ((1, 0),
        record
          [ "flags"            , Ordered_set_lang.Unexpanded.sexp_of_t
@@ -106,8 +111,78 @@ module Driver = struct
   include Sub_system.Register_backend(M)
 end
 
-let ppx_exe sctx ~key =
+module Jbuild_driver = struct
-  Path.relative (SC.build_dir sctx) (".ppx/" ^ key ^ "/ppx.exe")
+  (* This module is used to implement the jbuild handling of ppx
+     drivers.  It doesn't implement exactly the same algorithm, but it
+     should be enough for all jbuilder packages out there.
+
+     It works as follow: given the list of ppx rewriters specified by
+     the user, check whether the last one is named [ppxlib.runner] or
+     [ppx_driver.runner]. If it isn't, assume the driver is
+     ocaml-migrate-parsetree and use some hard-coded driver
+     information. If it is, use the corresponding hardcoded driver
+     information. *)
+
+  let make name info : (Pp.t * Driver.t) Lazy.t = lazy (
+    let info =
+      Sexp.parse_string ~mode:Single ~fname:"<internal>" info
+      |> Driver.Info.parse
+    in
+    (Pp.of_string name,
+     { info
+     ; lib = lazy (assert false)
+     ; replaces = Ok []
+     }))
+  let omp = make "ocaml-migrate-parsetree" {|
+    ((main       Migrate_parsetree.Driver.run_main)
+     (flags      (--dump-ast))
+     (lint_flags (--null)))
+  |}
+  let ppxlib = make "ppxlib" {|
+    ((main       Ppxlib.Driver.standalone)
+     (flags      (-diff-cmd - -dump-ast))
+     (lint_flags (-diff-cmd - -null    )))
+  |}
+  let ppx_driver = make "ppx_driver" {|
+    ((main       Ppx_driver.standalone)
+     (flags      (-diff-cmd - -dump-ast))
+     (lint_flags (-diff-cmd - -null    )))
+  |}
+
+  let drivers =
+    [ Pp.of_string "ocaml-migrate-parsetree.driver-main" , omp
+    ; Pp.of_string "ppxlib.runner"                       , ppxlib
+    ; Pp.of_string "ppx_driver.runner"                   , ppx_driver
+    ]
+
+  let get_driver pps =
+    let driver =
+      match List.last pps with
+      | None -> omp
+      | Some (_, pp) -> Option.value (List.assoc drivers pp) ~default:omp
+    in
+    snd (Lazy.force driver)
+
+  (* For building the driver *)
+  let analyse_pps pps =
+    let driver, rev_others =
+      match List.rev pps with
+      | [] -> (omp, [])
+      | pp :: rev_rest as rev_pps ->
+        match List.assoc drivers pp with
+        | None        -> (omp   , rev_pps )
+        | Some driver -> (driver, rev_rest)
+    in
+    let driver_pp, driver = Lazy.force driver in
+    (driver, List.rev (driver_pp :: rev_others))
+end
+
+let ppx_exe sctx ~key ~dir_kind =
+  match (dir_kind : File_tree.Dune_file.Kind.t) with
+  | Dune ->
+    Path.relative (SC.build_dir sctx) (".ppx/" ^ key ^ "/ppx.exe")
+  | Jbuild ->
+    Path.relative (SC.build_dir sctx) (".ppx/jbuild/" ^ key ^ "/ppx.exe")
 
 let no_driver_error pps =
   let has name =
@@ -125,10 +200,17 @@ let no_driver_error pps =
       "No ppx driver found.\n\
        It seems that these ppx rewriters are not compatible with jbuilder."
 
-let build_ppx_driver sctx ~lib_db ~dep_kind ~target pps =
+let build_ppx_driver sctx ~lib_db ~dep_kind ~target ~dir_kind pps =
   let ctx = SC.context sctx in
   let mode = Context.best_mode ctx in
   let compiler = Option.value_exn (Context.compiler ctx mode) in
+  let jbuild_driver, pps =
+    match (dir_kind : File_tree.Dune_file.Kind.t) with
+    | Dune -> (None, pps)
+    | Jbuild ->
+      let driver, pps = Jbuild_driver.analyse_pps pps in
+      (Some driver, pps)
+  in
   let driver_and_libs =
     let open Result.O in
     Result.map_error ~f:(fun e ->
@@ -140,11 +222,15 @@ let build_ppx_driver sctx ~lib_db ~dep_kind ~target pps =
          (List.map pps ~f:(fun x -> (Loc.none, x)))
        >>= Lib.closure
        >>= fun resolved_pps ->
-       Driver.select_replaceable_backend resolved_pps ~loc:Loc.none
+       match jbuild_driver with
-         ~replaces:Driver.replaces
+       | None ->
-         ~no_backend_error:no_driver_error
+         Driver.select_replaceable_backend resolved_pps ~loc:Loc.none
-       >>| fun driver ->
+           ~replaces:Driver.replaces
-       (driver, resolved_pps))
+           ~no_backend_error:no_driver_error
+         >>| fun driver ->
+         (driver, resolved_pps)
+       | Some driver ->
+         Ok (driver, resolved_pps))
   in
   (* CR-someday diml: what we should do is build the .cmx/.cmo once
      and for all at the point where the driver is defined. *)
@@ -170,26 +256,29 @@ let build_ppx_driver sctx ~lib_db ~dep_kind ~target pps =
        ; Dep ml
        ])
 
+let get_rules sctx key ~dir_kind =
+  let exe = ppx_exe sctx ~key ~dir_kind in
+  let (key, lib_db) = SC.Scope_key.of_string sctx key in
+  let names =
+    match key with
+    | "+none+" -> []
+    | _ -> String.split key ~on:'+'
+  in
+  let names =
+    match List.rev names with
+    | [] -> []
+    | driver :: rest -> List.sort rest ~compare:String.compare @ [driver]
+  in
+  let pps = List.map names ~f:Jbuild.Pp.of_string in
+  build_ppx_driver sctx pps ~lib_db ~dep_kind:Required ~target:exe ~dir_kind
+
 let gen_rules sctx components =
   match components with
-  | [key] ->
+  | [key] -> get_rules sctx key ~dir_kind:Dune
-    let exe = ppx_exe sctx ~key in
+  | ["jbuild"; key] -> get_rules sctx key ~dir_kind:Jbuild
-    let (key, lib_db) = SC.Scope_key.of_string sctx key in
-    let names =
-      match key with
-      | "+none+" -> []
-      | _ -> String.split key ~on:'+'
-    in
-    let names =
-      match List.rev names with
-      | [] -> []
-      | driver :: rest -> List.sort rest ~compare:String.compare @ [driver]
-    in
-    let pps = List.map names ~f:Jbuild.Pp.of_string in
-    build_ppx_driver sctx pps ~lib_db ~dep_kind:Required ~target:exe
   | _ -> ()
 
-let ppx_driver_exe sctx libs =
+let ppx_driver_exe sctx libs ~dir_kind =
   let names =
     List.rev_map libs ~f:Lib.name
     |> List.sort ~compare:String.compare
@@ -217,22 +306,29 @@ let ppx_driver_exe sctx libs =
     | None            -> key
     | Some scope_name -> SC.Scope_key.to_string key scope_name
   in
-  ppx_exe sctx ~key
+  ppx_exe sctx ~key ~dir_kind
 
-let get_ppx_driver_for_public_lib sctx ~name =
+let get_ppx_driver_for_public_lib sctx ~name ~dir_kind =
-  ppx_exe sctx ~key:name
+  ppx_exe sctx ~key:name ~dir_kind
 
-let get_ppx_driver sctx ~loc ~scope pps =
+let get_ppx_driver sctx ~loc ~scope ~dir_kind pps =
   let sctx = SC.host sctx in
   let open Result.O in
-  Lib.DB.resolve_pps (Scope.libs scope) pps
+  match (dir_kind : File_tree.Dune_file.Kind.t) with
-  >>= fun libs ->
+  | Dune ->
-  Lib.closure libs
+    Lib.DB.resolve_pps (Scope.libs scope) pps
-  >>=
+    >>= fun libs ->
-  Driver.select_replaceable_backend ~loc ~replaces:Driver.replaces
+    Lib.closure libs
-    ~no_backend_error:no_driver_error
+    >>=
-  >>= fun driver ->
+    Driver.select_replaceable_backend ~loc ~replaces:Driver.replaces
-  Ok (ppx_driver_exe sctx libs, driver)
+      ~no_backend_error:no_driver_error
+    >>= fun driver ->
+    Ok (ppx_driver_exe sctx libs ~dir_kind, driver)
+  | Jbuild ->
+    let driver = Jbuild_driver.get_driver pps in
+    Lib.DB.resolve_pps (Scope.libs scope) pps
+    >>= fun libs ->
+    Ok (ppx_driver_exe sctx libs ~dir_kind, driver)
 
 let target_var = String_with_vars.virt_var __POS__ "@"
 let root_var   = String_with_vars.virt_var __POS__ "ROOT"
@@ -272,85 +368,88 @@ let promote_correction fn build ~suffix =
            (Path.extend_basename fn ~suffix))
     ]
 
-let lint_module sctx ~dir ~dep_kind ~lint ~lib_name ~scope = Staged.stage (
+let lint_module sctx ~dir ~dep_kind ~lint ~lib_name ~scope ~dir_kind =
-  let alias = Build_system.Alias.lint ~dir in
+  Staged.stage (
-  let add_alias fn build =
+    let alias = Build_system.Alias.lint ~dir in
-    SC.add_alias_action sctx alias build
+    let add_alias fn build =
-      ~stamp:(List [ Sexp.unsafe_atom_of_string "lint"
+      SC.add_alias_action sctx alias build
-                   ; Sexp.To_sexp.(option string) lib_name
+        ~stamp:(List [ Sexp.unsafe_atom_of_string "lint"
-                   ; Sexp.atom fn
+                     ; Sexp.To_sexp.(option string) lib_name
-                   ])
+                     ; Sexp.atom fn
-  in
+                     ])
-  let lint =
+    in
-    Per_module.map lint ~f:(function
+    let lint =
-      | Preprocess.No_preprocessing ->
+      Per_module.map lint ~f:(function
-        (fun ~source:_ ~ast:_ -> ())
+        | Preprocess.No_preprocessing ->
-      | Action (loc, action) ->
+          (fun ~source:_ ~ast:_ -> ())
-        (fun ~source ~ast:_ ->
+        | Action (loc, action) ->
-           let action = Action.Unexpanded.Chdir (root_var, action) in
+          (fun ~source ~ast:_ ->
-           Module.iter source ~f:(fun _ (src : Module.File.t) ->
+             let action = Action.Unexpanded.Chdir (root_var, action) in
-             let src_path = Path.relative dir src.name in
+             Module.iter source ~f:(fun _ (src : Module.File.t) ->
-             add_alias src.name
+               let src_path = Path.relative dir src.name in
-               (Build.path src_path
+               add_alias src.name
-                >>^ (fun _ -> [src_path])
+                 (Build.path src_path
-                >>> SC.Action.run sctx
+                  >>^ (fun _ -> [src_path])
-                      action
+                  >>> SC.Action.run sctx
-                      ~loc
+                        action
-                      ~dir
+                        ~loc
-                      ~dep_kind
+                        ~dir
-                      ~targets:(Static [])
+                        ~dep_kind
-                      ~scope)))
+                        ~targets:(Static [])
-      | Pps { loc; pps; flags } ->
+                        ~scope)))
-        let args : _ Arg_spec.t =
+        | Pps { loc; pps; flags } ->
-          S [ As flags
+          let args : _ Arg_spec.t =
-            ; As (cookie_library_name lib_name)
+            S [ As flags
-            ]
+              ; As (cookie_library_name lib_name)
-        in
+              ]
-        let corrected_suffix = ".lint-corrected" in
+          in
-        let driver_and_flags =
+          let corrected_suffix = ".lint-corrected" in
-          let open Result.O in
+          let driver_and_flags =
-          get_ppx_driver sctx ~loc ~scope pps >>| fun (exe, driver) ->
+            let open Result.O in
-          (exe,
+            get_ppx_driver sctx ~loc ~scope ~dir_kind pps
-           let extra_vars =
+            >>| fun (exe, driver) ->
-             String_map.singleton "corrected-suffix"
+            (exe,
-               (Action.Var_expansion.Strings ([corrected_suffix], Split))
+             let extra_vars =
-           in
+               String_map.singleton "corrected-suffix"
-           Build.memoize "ppx flags"
+                 (Action.Var_expansion.Strings ([corrected_suffix], Split))
-             (SC.expand_and_eval_set sctx driver.info.lint_flags
+             in
-                ~scope
+             Build.memoize "ppx flags"
-                ~dir
+               (SC.expand_and_eval_set sctx driver.info.lint_flags
-                ~extra_vars
+                  ~scope
-                ~standard:(Build.return [])))
+                  ~dir
-        in
+                  ~extra_vars
-        (fun ~source ~ast ->
+                  ~standard:(Build.return [])))
-           Module.iter ast ~f:(fun kind src ->
+          in
-             add_alias src.name
+          (fun ~source ~ast ->
-               (promote_correction ~suffix:corrected_suffix
+             Module.iter ast ~f:(fun kind src ->
-                  (Option.value_exn (Module.file ~dir source kind))
+               add_alias src.name
-                  (Build.of_result_map driver_and_flags ~f:(fun (exe, flags) ->
+                 (promote_correction ~suffix:corrected_suffix
-                     flags >>>
+                    (Option.value_exn (Module.file ~dir source kind))
-                     Build.run ~context:(SC.context sctx)
+                    (Build.of_result_map driver_and_flags ~f:(fun (exe, flags) ->
-                       (Ok exe)
+                       flags >>>
-                       [ args
+                       Build.run ~context:(SC.context sctx)
-                       ; Ml_kind.ppx_driver_flag kind
+                         (Ok exe)
-                       ; Dep (Path.relative dir src.name)
+                         [ args
-                       ; Dyn (fun x -> As x)
+                         ; Ml_kind.ppx_driver_flag kind
-                       ]))))))
+                         ; Dep (Path.relative dir src.name)
-  in
+                         ; Dyn (fun x -> As x)
-  fun ~(source : Module.t) ~ast ->
+                         ]))))))
-    Per_module.get lint source.name ~source ~ast)
+    in
+    fun ~(source : Module.t) ~ast ->
+      Per_module.get lint source.name ~source ~ast)
 
 type t = (Module.t -> lint:bool -> Module.t) Per_module.t
 
 let dummy = Per_module.for_all (fun m ~lint:_ -> m)
 
 let make sctx ~dir ~dep_kind ~lint ~preprocess
-      ~preprocessor_deps ~lib_name ~scope =
+      ~preprocessor_deps ~lib_name ~scope ~dir_kind =
   let preprocessor_deps =
     Build.memoize "preprocessor deps" preprocessor_deps
   in
   let lint_module =
-    Staged.unstage (lint_module sctx ~dir ~dep_kind ~lint ~lib_name ~scope)
+    Staged.unstage (lint_module sctx ~dir ~dep_kind ~lint ~lib_name ~scope
+                      ~dir_kind)
   in
   Per_module.map preprocess ~f:(function
     | Preprocess.No_preprocessing ->
@@ -391,7 +490,7 @@ let make sctx ~dir ~dep_kind ~lint ~preprocess
       let corrected_suffix = ".ppx-corrected" in
       let driver_and_flags =
         let open Result.O in
-        get_ppx_driver sctx ~loc ~scope pps >>| fun (exe, driver) ->
+        get_ppx_driver sctx ~loc ~scope ~dir_kind pps >>| fun (exe, driver) ->
         (exe,
          let extra_vars =
            String_map.singleton "corrected-suffix"
@@ -433,9 +532,9 @@ let pp_modules t ?(lint=true) modules =
 let pp_module_as t ?(lint=true) name m =
   Per_module.get t name m ~lint
 
-let get_ppx_driver sctx ~scope pps =
+let get_ppx_driver sctx ~scope ~dir_kind pps =
   let sctx = SC.host sctx in
   let open Result.O in
   Lib.DB.resolve_pps (Scope.libs scope) pps
   >>| fun libs ->
-  ppx_driver_exe sctx libs
+  ppx_driver_exe sctx libs ~dir_kind

src/preprocessing.mli

@@ -16,6 +16,7 @@ val make
   -> preprocessor_deps:(unit, Path.t list) Build.t
   -> lib_name:string option
   -> scope:Scope.t
+  -> dir_kind:File_tree.Dune_file.Kind.t
   -> t
 
 (** Setup the preprocessing rules for the following modules and
@@ -39,12 +40,14 @@ val pp_module_as
 val get_ppx_driver
   :  Super_context.t
   -> scope:Scope.t
+  -> dir_kind:File_tree.Dune_file.Kind.t
   -> (Loc.t * Jbuild.Pp.t) list
   -> Path.t Or_exn.t
 
 val get_ppx_driver_for_public_lib
   :  Super_context.t
   -> name:string
+  -> dir_kind:File_tree.Dune_file.Kind.t
   -> Path.t
 
 (** [cookie_library_name lib_name] is ["--cookie"; lib_name] if [lib_name] is not

src/super_context.ml

@@ -10,6 +10,16 @@ module Dir_with_jbuild = struct
     ; ctx_dir : Path.t
     ; stanzas : Stanzas.t
     ; scope   : Scope.t
+    ; kind    : File_tree.Dune_file.Kind.t
+    }
+end
+
+module Installable = struct
+  type t =
+    { dir    : Path.t
+    ; scope  : Scope.t
+    ; stanza : Stanza.t
+    ; kind   : File_tree.Dune_file.Kind.t
     }
 end
 
@@ -33,7 +43,7 @@ type t =
   ; packages                         : Package.t Package.Name.Map.t
   ; file_tree                        : File_tree.t
   ; artifacts                        : Artifacts.t
-  ; stanzas_to_consider_for_install  : (Path.t * Scope.t * Stanza.t) list
+  ; stanzas_to_consider_for_install  : Installable.t list
   ; cxx_flags                        : string list
   ; vars                             : Action.Var_expansion.t String.Map.t
   ; chdir                            : (Action.t, Action.t) Build.t
@@ -189,7 +199,7 @@ let create
     Lib.DB.create_from_findlib context.findlib ~external_lib_deps_mode
   in
   let internal_libs =
-    List.concat_map stanzas ~f:(fun (dir, _, stanzas) ->
+    List.concat_map stanzas ~f:(fun { Jbuild_load.Jbuild. dir; stanzas; _ } ->
       let ctx_dir = Path.append context.build_dir dir in
       List.filter_map stanzas ~f:(fun stanza ->
         match (stanza : Stanza.t) with
@@ -209,18 +219,19 @@ let create
   in
   let stanzas =
     List.map stanzas
-      ~f:(fun (dir, project, stanzas) ->
+      ~f:(fun { Jbuild_load.Jbuild. dir; project; stanzas; kind } ->
         let ctx_dir = Path.append context.build_dir dir in
         { Dir_with_jbuild.
           src_dir = dir
         ; ctx_dir
         ; stanzas
         ; scope = Scope.DB.find_by_name scopes project.Dune_project.name
+        ; kind
         })
   in
   let stanzas_to_consider_for_install =
     if not external_lib_deps_mode then
-      List.concat_map stanzas ~f:(fun { ctx_dir; stanzas; scope; _ } ->
+      List.concat_map stanzas ~f:(fun { ctx_dir; stanzas; scope; kind; _ } ->
         List.filter_map stanzas ~f:(fun stanza ->
           let keep =
             match (stanza : Stanza.t) with
@@ -229,10 +240,21 @@ let create
             | Install _   -> true
             | _           -> false
           in
-          Option.some_if keep (ctx_dir, scope, stanza)))
+          Option.some_if keep { Installable.
+                                dir = ctx_dir
+                              ; scope
+                              ; stanza
+                              ; kind
+                              }))
     else
-      List.concat_map stanzas ~f:(fun { ctx_dir; stanzas; scope; _ } ->
+      List.concat_map stanzas ~f:(fun { ctx_dir; stanzas; scope; kind; _ } ->
-        List.map stanzas ~f:(fun s -> (ctx_dir, scope, s)))
+        List.map stanzas ~f:(fun stanza ->
+          { Installable.
+            dir = ctx_dir
+          ; scope
+          ; stanza
+          ; kind
+          }))
   in
   let artifacts =
     Artifacts.create context ~public_libs stanzas

src/super_context.mli

@@ -15,6 +15,16 @@ module Dir_with_jbuild : sig
     ; ctx_dir : Path.t (** [_build/context-name/src_dir] *)
     ; stanzas : Stanzas.t
     ; scope   : Scope.t
+    ; kind    : File_tree.Dune_file.Kind.t
+    }
+end
+
+module Installable : sig
+  type t =
+    { dir    : Path.t
+    ; scope  : Scope.t
+    ; stanza : Stanza.t
+    ; kind   : File_tree.Dune_file.Kind.t
     }
 end
 
@@ -26,7 +36,7 @@ val create
   -> projects:Dune_project.t list
   -> file_tree:File_tree.t
   -> packages:Package.t Package.Name.Map.t
-  -> stanzas:(Path.t * Dune_project.t * Stanzas.t) list
+  -> stanzas:Jbuild_load.Jbuild.t list
   -> external_lib_deps_mode:bool
   -> build_system:Build_system.t
   -> t
@@ -37,7 +47,7 @@ val packages  : t -> Package.t Package.Name.Map.t
 val libs_by_package : t -> (Package.t * Lib.Set.t) Package.Name.Map.t
 val file_tree : t -> File_tree.t
 val artifacts : t -> Artifacts.t
-val stanzas_to_consider_for_install : t -> (Path.t * Scope.t * Stanza.t) list
+val stanzas_to_consider_for_install : t -> Installable.t list
 val cxx_flags : t -> string list
 val build_dir : t -> Path.t
 val profile   : t -> string

test/blackbox-tests/test-cases/github644/run.t

@@ -1,5 +1,5 @@
   $ dune runtest
-  File "dune", line 4, characters 20-42:
+  File "jbuild", line 4, characters 20-42:
   Error: Library "ppx_that_doesn't_exist" not found.
   Hint: try: dune external-lib-deps --missing @runtest
   [1]
@@ -8,7 +8,7 @@ These should print something:
 
   $ dune external-lib-deps --display quiet @runtest
   These are the external library dependencies in the default context:
-  - ocaml-migrate-parsetree.driver-main
+  - ocaml-migrate-parsetree
   - ppx_that_doesn't_exist
 
   $ dune external-lib-deps --display quiet --missing @runtest

test/blackbox-tests/test-cases/ppx-rewriter/run.t

@@ -3,14 +3,14 @@
         ocamlc ppx/.fooppx.objs/fooppx.{cmi,cmo,cmt}
       ocamlopt ppx/.fooppx.objs/fooppx.{cmx,o}
       ocamlopt ppx/fooppx.{a,cmxa}
-      ocamlopt .ppx/fooppx/ppx.exe
+      ocamlopt .ppx/jbuild/fooppx/ppx.exe
            ppx w_omp_driver.pp.ml
       ocamldep w_omp_driver.pp.ml.d
         ocamlc .w_omp_driver.eobjs/w_omp_driver.{cmi,cmo,cmt}
       ocamlopt .w_omp_driver.eobjs/w_omp_driver.{cmx,o}
       ocamlopt w_omp_driver.exe
   $ dune build ./w_ppx_driver.exe --display short
-      ocamlopt .ppx/ppx_driver/ppx.exe
+      ocamlopt .ppx/jbuild/ppx_driver.runner/ppx.exe
            ppx w_ppx_driver.pp.ml
       ocamldep w_ppx_driver.pp.ml.d
         ocamlc .w_ppx_driver.eobjs/w_ppx_driver.{cmi,cmo,cmt}

test/blackbox-tests/test-cases/private-public-overlap/run.t

@@ -11,7 +11,7 @@ On the other hand, public libraries may have private preprocessors
         ocamlc .ppx_internal.objs/ppx_internal.{cmi,cmo,cmt}
       ocamlopt .ppx_internal.objs/ppx_internal.{cmx,o}
       ocamlopt ppx_internal.{a,cmxa}
-      ocamlopt .ppx/ppx_internal@mylib/ppx.exe
+      ocamlopt .ppx/jbuild/ppx_internal@mylib/ppx.exe
            ppx mylib.pp.ml
       ocamldep mylib.pp.ml.d
         ocamlc .mylib.objs/mylib.{cmi,cmo,cmt}
@@ -22,13 +22,13 @@ On the other hand, public libraries may have private preprocessors
 
 Unless they introduce private runtime dependencies:
   $ dune build --display short --root private-runtime-deps 2>&1 | grep -v Entering
-  File "dune", line 16, characters 20-31:
+  File "jbuild", line 16, characters 20-31:
   Error: Library "private_runtime_dep" is private, it cannot be a dependency of a public library.
   You need to give "private_runtime_dep" a public name.
         ocamlc .private_ppx.objs/private_ppx.{cmi,cmo,cmt}
       ocamlopt .private_ppx.objs/private_ppx.{cmx,o}
       ocamlopt private_ppx.{a,cmxa}
-      ocamlopt .ppx/private_ppx@mylib/ppx.exe
+      ocamlopt .ppx/jbuild/private_ppx@mylib/ppx.exe
            ppx mylib.pp.ml
       ocamldep mylib.pp.ml.d
 

test/blackbox-tests/test-cases/scope-ppx-bug/a/kernel/jbuild

@@ -3,5 +3,4 @@
 (library
  ((name a_kernel)
   (public_name a.kernel)
-  (libraries (ocaml-migrate-parsetree))
   (kind ppx_rewriter)))

test/blackbox-tests/test-cases/scope-ppx-bug/run.t

@@ -9,8 +9,8 @@
       ocamlopt a/kernel/a_kernel.cmxs
         ocamlc a/ppx/a.cma
         ocamlc a/kernel/a_kernel.cma
-      ocamlopt .ppx/a.kernel/ppx.exe
+      ocamlopt .ppx/jbuild/a.kernel/ppx.exe
-      ocamlopt .ppx/a/ppx.exe
+      ocamlopt .ppx/jbuild/a/ppx.exe
            ppx b/b.pp.ml
       ocamldep b/b.pp.ml.d
         ocamlc b/.b.objs/b.{cmi,cmo,cmt}