Restore old ppx behavior for directories with jbuild files
Signed-off-by: Jeremie Dimino <jdimino@janestreet.com>
This commit is contained in:
parent
ed583b7651
commit
b5dfb826ef
|
@ -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)
|
||||
-----------------------
|
||||
|
|
|
@ -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"}
|
||||
]
|
||||
|
|
|
@ -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,11 +21,19 @@ module Dune_file = struct
|
|||
}
|
||||
end
|
||||
|
||||
module Contents = struct
|
||||
type t =
|
||||
| Plain of Plain.t
|
||||
| Ocaml_script of Path.t
|
||||
end
|
||||
|
||||
let path = function
|
||||
type t =
|
||||
{ contents : Contents.t
|
||||
; kind : Kind.t
|
||||
}
|
||||
|
||||
let path t =
|
||||
match t.contents with
|
||||
| Plain x -> x.path
|
||||
| Ocaml_script p -> p
|
||||
|
||||
|
@ -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 ->
|
||||
let contents, ignored_subdirs =
|
||||
if Dune_lexer.is_script lb then
|
||||
(Ocaml_script file, String.Set.empty)
|
||||
(Contents.Ocaml_script file, String.Set.empty)
|
||||
else
|
||||
let sexps = Usexp.Parser.parse lb ?lexer ~mode:Many in
|
||||
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))
|
||||
(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)
|
||||
| _ ->
|
||||
|
|
|
@ -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 =
|
||||
{ contents : Contents.t
|
||||
; kind : Kind.t
|
||||
}
|
||||
|
||||
val path : t -> Path.t
|
||||
end
|
||||
|
|
|
@ -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) ->
|
||||
(dir,
|
||||
pkgs_ctx,
|
||||
List.filter stanzas ~f:(fun stanza ->
|
||||
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)))
|
||||
| _ -> true)
|
||||
in
|
||||
{ dir_conf with stanzas })
|
||||
in
|
||||
Fiber.fork_and_join host stanzas >>= fun (host, stanzas) ->
|
||||
let sctx =
|
||||
|
|
|
@ -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) ->
|
||||
List.map (lib_install_files ~dir ~sub_dir ~name lib)
|
||||
| Library ({ public = Some { package; sub_dir; name; _ }
|
||||
; _ } 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 } ->
|
||||
|
|
|
@ -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 })
|
||||
]
|
||||
|
||||
|
|
|
@ -9,15 +9,25 @@ 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
|
||||
|
||||
type t =
|
||||
|
@ -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
|
||||
Fiber.return (dir, project,
|
||||
Stanzas.parse project sexps ~file:generated_jbuild
|
||||
|> filter_stanzas ~ignore_promoted_rules))
|
||||
let stanzas =
|
||||
Io.Sexp.load generated_jbuild ~mode:Many
|
||||
~lexer:(File_tree.Dune_file.Kind.lexer kind)
|
||||
|> 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 jbuild =
|
||||
Jbuilds.Literal (dir, project,
|
||||
let stanzas =
|
||||
Stanzas.parse project p.sexps ~file:p.path
|
||||
|> filter_stanzas ~ignore_promoted_rules)
|
||||
|> filter_stanzas ~ignore_promoted_rules
|
||||
in
|
||||
let jbuild =
|
||||
Jbuilds.Literal
|
||||
{ dir
|
||||
; 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
|
||||
|
|
|
@ -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 =
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
(* 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 ->
|
||||
match jbuild_driver with
|
||||
| None ->
|
||||
Driver.select_replaceable_backend resolved_pps ~loc:Loc.none
|
||||
~replaces:Driver.replaces
|
||||
~no_backend_error:no_driver_error
|
||||
>>| fun driver ->
|
||||
(driver, resolved_pps))
|
||||
(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,10 +256,8 @@ let build_ppx_driver sctx ~lib_db ~dep_kind ~target pps =
|
|||
; Dep ml
|
||||
])
|
||||
|
||||
let gen_rules sctx components =
|
||||
match components with
|
||||
| [key] ->
|
||||
let exe = ppx_exe sctx ~key in
|
||||
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
|
||||
|
@ -186,10 +270,15 @@ let gen_rules sctx components =
|
|||
| 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
|
||||
build_ppx_driver sctx pps ~lib_db ~dep_kind:Required ~target:exe ~dir_kind
|
||||
|
||||
let gen_rules sctx components =
|
||||
match components with
|
||||
| [key] -> get_rules sctx key ~dir_kind:Dune
|
||||
| ["jbuild"; key] -> get_rules sctx key ~dir_kind:Jbuild
|
||||
| _ -> ()
|
||||
|
||||
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,14 +306,16 @@ 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 =
|
||||
ppx_exe sctx ~key:name
|
||||
let get_ppx_driver_for_public_lib sctx ~name ~dir_kind =
|
||||
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
|
||||
match (dir_kind : File_tree.Dune_file.Kind.t) with
|
||||
| Dune ->
|
||||
Lib.DB.resolve_pps (Scope.libs scope) pps
|
||||
>>= fun libs ->
|
||||
Lib.closure libs
|
||||
|
@ -232,7 +323,12 @@ let get_ppx_driver sctx ~loc ~scope pps =
|
|||
Driver.select_replaceable_backend ~loc ~replaces:Driver.replaces
|
||||
~no_backend_error:no_driver_error
|
||||
>>= fun driver ->
|
||||
Ok (ppx_driver_exe sctx libs, 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,7 +368,8 @@ 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 =
|
||||
Staged.stage (
|
||||
let alias = Build_system.Alias.lint ~dir in
|
||||
let add_alias fn build =
|
||||
SC.add_alias_action sctx alias build
|
||||
|
@ -309,7 +406,8 @@ let lint_module sctx ~dir ~dep_kind ~lint ~lib_name ~scope = Staged.stage (
|
|||
let corrected_suffix = ".lint-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"
|
||||
|
@ -345,12 +443,13 @@ 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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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.map stanzas ~f:(fun s -> (ctx_dir, scope, s)))
|
||||
List.concat_map stanzas ~f:(fun { ctx_dir; stanzas; scope; kind; _ } ->
|
||||
List.map stanzas ~f:(fun stanza ->
|
||||
{ Installable.
|
||||
dir = ctx_dir
|
||||
; scope
|
||||
; stanza
|
||||
; kind
|
||||
}))
|
||||
in
|
||||
let artifacts =
|
||||
Artifacts.create context ~public_libs stanzas
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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}
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -3,5 +3,4 @@
|
|||
(library
|
||||
((name a_kernel)
|
||||
(public_name a.kernel)
|
||||
(libraries (ocaml-migrate-parsetree))
|
||||
(kind ppx_rewriter)))
|
|
@ -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/a/ppx.exe
|
||||
ocamlopt .ppx/jbuild/a.kernel/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}
|
||||
|
|
Loading…
Reference in New Issue