Remove hard-coded knowledge of a a few specific ppx rewriters
This commit is contained in:
parent
238c22f3b8
commit
de0f65b4f4
|
@ -3,6 +3,9 @@
|
||||||
- Added =${lib-available:<library-name>}= which expands to =true= or
|
- Added =${lib-available:<library-name>}= which expands to =true= or
|
||||||
=false= with the same semantic as literals in =(select ...)= stanzas
|
=false= with the same semantic as literals in =(select ...)= stanzas
|
||||||
|
|
||||||
|
- Remove hard-coded knowledge of a few specific ppx rewriters to ease
|
||||||
|
maintenance moving forward
|
||||||
|
|
||||||
- Fix: make sure the action working directory exist before running it
|
- Fix: make sure the action working directory exist before running it
|
||||||
|
|
||||||
* 1.0+beta7 (12/04/2017)
|
* 1.0+beta7 (12/04/2017)
|
||||||
|
|
162
src/gen_rules.ml
162
src/gen_rules.ml
|
@ -675,119 +675,6 @@ module Gen(P : Params) = struct
|
||||||
; mli_fname = mli_pp_fname
|
; mli_fname = mli_pp_fname
|
||||||
}
|
}
|
||||||
|
|
||||||
module Ppx_info : sig
|
|
||||||
type t =
|
|
||||||
{ uses_inline_test : bool
|
|
||||||
; uses_inline_bench : bool
|
|
||||||
; uses_here : bool
|
|
||||||
; uses_libname : bool
|
|
||||||
; uses_ppx_driver : bool
|
|
||||||
}
|
|
||||||
|
|
||||||
val make_info_file
|
|
||||||
: ppx_dir:Path.t
|
|
||||||
-> libs:(unit, Lib.t list) Build.t
|
|
||||||
-> (unit, t) Build.t
|
|
||||||
|
|
||||||
|
|
||||||
val specific_args_for_ppx_rewriters
|
|
||||||
: t
|
|
||||||
-> dir:Path.t
|
|
||||||
-> lib_name:string option
|
|
||||||
-> for_merlin:bool
|
|
||||||
-> _ Arg_spec.t
|
|
||||||
end = struct
|
|
||||||
type t =
|
|
||||||
{ uses_inline_test : bool
|
|
||||||
; uses_inline_bench : bool
|
|
||||||
; uses_here : bool
|
|
||||||
; uses_libname : bool
|
|
||||||
; uses_ppx_driver : bool
|
|
||||||
}
|
|
||||||
|
|
||||||
module Vfile =
|
|
||||||
Vfile_kind.Make_full
|
|
||||||
(struct type nonrec t = t end)
|
|
||||||
(struct
|
|
||||||
open Sexp.To_sexp
|
|
||||||
let t _dir t =
|
|
||||||
record
|
|
||||||
[ "uses_inline_test" , bool t.uses_inline_test
|
|
||||||
; "uses_inline_bench", bool t.uses_inline_bench
|
|
||||||
; "uses_here" , bool t.uses_here
|
|
||||||
; "uses_libname" , bool t.uses_libname
|
|
||||||
; "uses_ppx_driver" , bool t.uses_ppx_driver
|
|
||||||
]
|
|
||||||
end)
|
|
||||||
(struct
|
|
||||||
open Sexp.Of_sexp
|
|
||||||
let t _dir sexp =
|
|
||||||
record
|
|
||||||
(field "uses_inline_test" bool >>= fun uses_inline_test ->
|
|
||||||
field "uses_inline_bench" bool >>= fun uses_inline_bench ->
|
|
||||||
field "uses_here" bool >>= fun uses_here ->
|
|
||||||
field "uses_libname" bool >>= fun uses_libname ->
|
|
||||||
field "uses_ppx_driver" bool >>= fun uses_ppx_driver ->
|
|
||||||
return
|
|
||||||
{ uses_inline_test
|
|
||||||
; uses_inline_bench
|
|
||||||
; uses_here
|
|
||||||
; uses_libname
|
|
||||||
; uses_ppx_driver
|
|
||||||
})
|
|
||||||
sexp
|
|
||||||
end)
|
|
||||||
|
|
||||||
let info_file ~ppx_dir =
|
|
||||||
Build.Vspec.T (Path.relative ppx_dir "info.sexp",
|
|
||||||
(module Vfile))
|
|
||||||
|
|
||||||
let make_info_file ~ppx_dir ~libs =
|
|
||||||
let file = info_file ~ppx_dir in
|
|
||||||
add_rule
|
|
||||||
(libs >>^ (fun libs ->
|
|
||||||
let uses_inline_test = ref false in
|
|
||||||
let uses_inline_bench = ref false in
|
|
||||||
let uses_here = ref false in
|
|
||||||
let uses_libname = ref false in
|
|
||||||
let uses_ppx_driver = ref false in
|
|
||||||
List.iter libs ~f:(fun lib ->
|
|
||||||
match Lib.best_name lib with
|
|
||||||
| "ppx_here.expander" -> uses_here := true
|
|
||||||
| "ppx_inline_test.libname" -> uses_libname := true
|
|
||||||
| "ppx_expect" -> uses_inline_test := true
|
|
||||||
| "ppx_inline_test" -> uses_inline_test := true
|
|
||||||
| "ppx_bench" -> uses_inline_bench := true
|
|
||||||
| "ppx_driver.runner" -> uses_ppx_driver := true
|
|
||||||
| _ -> ());
|
|
||||||
{ uses_inline_test = !uses_inline_test
|
|
||||||
; uses_inline_bench = !uses_inline_bench
|
|
||||||
; uses_here = !uses_here
|
|
||||||
; uses_libname = !uses_libname
|
|
||||||
; uses_ppx_driver = !uses_ppx_driver
|
|
||||||
})
|
|
||||||
>>>
|
|
||||||
Build.store_vfile file);
|
|
||||||
Build.vpath file
|
|
||||||
|
|
||||||
let specific_args_for_ppx_rewriters t ~dir ~lib_name ~for_merlin =
|
|
||||||
if t.uses_ppx_driver then
|
|
||||||
Arg_spec.S
|
|
||||||
[ S (if t.uses_here
|
|
||||||
then [A "-dirname"; Path dir]
|
|
||||||
else [])
|
|
||||||
; S (match lib_name with
|
|
||||||
| Some name when t.uses_libname ->
|
|
||||||
[ A "-inline-test-lib"; A name ]
|
|
||||||
| _ -> [])
|
|
||||||
; S (if not for_merlin
|
|
||||||
then [ A "-embed-errors"; A "false" ]
|
|
||||||
else [])
|
|
||||||
]
|
|
||||||
else
|
|
||||||
Arg_spec.S []
|
|
||||||
end
|
|
||||||
|
|
||||||
let ppx_drivers = Hashtbl.create 32
|
let ppx_drivers = Hashtbl.create 32
|
||||||
|
|
||||||
let migrate_driver_main = "ocaml-migrate-parsetree.driver-main"
|
let migrate_driver_main = "ocaml-migrate-parsetree.driver-main"
|
||||||
|
@ -854,8 +741,7 @@ module Gen(P : Params) = struct
|
||||||
Build.run (Dep compiler)
|
Build.run (Dep compiler)
|
||||||
[ A "-o" ; Target target
|
[ A "-o" ; Target target
|
||||||
; Dyn (Lib.link_flags ~mode)
|
; Dyn (Lib.link_flags ~mode)
|
||||||
]);
|
])
|
||||||
libs
|
|
||||||
|
|
||||||
let ppx_dir = Path.of_string (sprintf "_build/.ppx/%s" ctx.name)
|
let ppx_dir = Path.of_string (sprintf "_build/.ppx/%s" ctx.name)
|
||||||
|
|
||||||
|
@ -876,16 +762,18 @@ module Gen(P : Params) = struct
|
||||||
| None ->
|
| None ->
|
||||||
let ppx_dir = Path.relative ppx_dir key in
|
let ppx_dir = Path.relative ppx_dir key in
|
||||||
let exe = Path.relative ppx_dir "ppx.exe" in
|
let exe = Path.relative ppx_dir "ppx.exe" in
|
||||||
let libs =
|
build_ppx_driver names ~dir ~dep_kind ~target:exe ~driver;
|
||||||
build_ppx_driver names ~dir ~dep_kind ~target:exe ~driver
|
Hashtbl.add ppx_drivers ~key ~data:exe;
|
||||||
in
|
exe
|
||||||
let info = Ppx_info.make_info_file ~ppx_dir ~libs in
|
|
||||||
Hashtbl.add ppx_drivers ~key ~data:(exe, libs, info);
|
|
||||||
(exe, libs, info)
|
|
||||||
|
|
||||||
let target_var = String_with_vars.of_string "${@}"
|
let target_var = String_with_vars.of_string "${@}"
|
||||||
let root_var = String_with_vars.of_string "${ROOT}"
|
let root_var = String_with_vars.of_string "${ROOT}"
|
||||||
|
|
||||||
|
let cookie_library_name lib_name =
|
||||||
|
match lib_name with
|
||||||
|
| None -> []
|
||||||
|
| Some name -> ["--cookie"; sprintf "library-name=%S" name]
|
||||||
|
|
||||||
(* Generate rules to build the .pp files and return a new module map where all filenames
|
(* Generate rules to build the .pp files and return a new module map where all filenames
|
||||||
point to the .pp files *)
|
point to the .pp files *)
|
||||||
let pped_modules ~dir ~dep_kind ~modules ~preprocess ~preprocessor_deps ~lib_name =
|
let pped_modules ~dir ~dep_kind ~modules ~preprocess ~preprocessor_deps ~lib_name =
|
||||||
|
@ -911,19 +799,16 @@ module Gen(P : Params) = struct
|
||||||
~targets:[dst]
|
~targets:[dst]
|
||||||
~deps:[Some src]))
|
~deps:[Some src]))
|
||||||
| Pps { pps; flags } ->
|
| Pps { pps; flags } ->
|
||||||
let ppx_exe, _, info = get_ppx_driver pps ~dir ~dep_kind in
|
let ppx_exe = get_ppx_driver pps ~dir ~dep_kind in
|
||||||
pped_module m ~dir ~f:(fun kind src dst ->
|
pped_module m ~dir ~f:(fun kind src dst ->
|
||||||
add_rule
|
add_rule
|
||||||
(preprocessor_deps
|
(preprocessor_deps
|
||||||
>>>
|
|
||||||
info
|
|
||||||
>>>
|
>>>
|
||||||
Build.run
|
Build.run
|
||||||
(Dep ppx_exe)
|
(Dep ppx_exe)
|
||||||
[ Dyn (Ppx_info.specific_args_for_ppx_rewriters ~dir ~lib_name
|
[ As flags
|
||||||
~for_merlin:false)
|
|
||||||
; As flags
|
|
||||||
; A "--dump-ast"
|
; A "--dump-ast"
|
||||||
|
; As (cookie_library_name lib_name)
|
||||||
; A "-o"; Target dst
|
; A "-o"; Target dst
|
||||||
; Ml_kind.ppx_driver_flag kind; Dep src
|
; Ml_kind.ppx_driver_flag kind; Dep src
|
||||||
])
|
])
|
||||||
|
@ -982,21 +867,17 @@ module Gen(P : Params) = struct
|
||||||
let ppx_flags ~dir ~src_dir { preprocess; libname; _ } =
|
let ppx_flags ~dir ~src_dir { preprocess; libname; _ } =
|
||||||
match preprocess with
|
match preprocess with
|
||||||
| Pps { pps; flags } ->
|
| Pps { pps; flags } ->
|
||||||
let exe, _, info = get_ppx_driver pps ~dir ~dep_kind:Optional in
|
let exe = get_ppx_driver pps ~dir ~dep_kind:Optional in
|
||||||
info >>^ fun info ->
|
|
||||||
let specific_flags, _ =
|
|
||||||
Arg_spec.expand ~dir:src_dir
|
|
||||||
[Ppx_info.specific_args_for_ppx_rewriters info ~dir ~lib_name:libname
|
|
||||||
~for_merlin:true]
|
|
||||||
()
|
|
||||||
in
|
|
||||||
let command =
|
let command =
|
||||||
List.map (Path.reach exe ~from:src_dir :: "--as-ppx" :: specific_flags @ flags)
|
List.map (Path.reach exe ~from:src_dir
|
||||||
|
:: "--as-ppx"
|
||||||
|
:: cookie_library_name libname
|
||||||
|
@ flags)
|
||||||
~f:quote_for_shell
|
~f:quote_for_shell
|
||||||
|> String.concat ~sep:" "
|
|> String.concat ~sep:" "
|
||||||
in
|
in
|
||||||
[sprintf "FLG -ppx \"%s\"" command]
|
[sprintf "FLG -ppx \"%s\"" command]
|
||||||
| _ -> Build.return []
|
| _ -> []
|
||||||
|
|
||||||
let dot_merlin ~dir ({ requires; flags; _ } as t) =
|
let dot_merlin ~dir ({ requires; flags; _ } as t) =
|
||||||
if ctx.merlin then
|
if ctx.merlin then
|
||||||
|
@ -1008,8 +889,9 @@ module Gen(P : Params) = struct
|
||||||
>>>
|
>>>
|
||||||
Build.update_file (Path.relative dir ".merlin-exists") "");
|
Build.update_file (Path.relative dir ".merlin-exists") "");
|
||||||
add_rule (
|
add_rule (
|
||||||
Build.fanout requires (ppx_flags ~dir ~src_dir:remaindir t)
|
requires
|
||||||
>>^ (fun (libs, ppx_flags) ->
|
>>^ (fun libs ->
|
||||||
|
let ppx_flags = ppx_flags ~dir ~src_dir:remaindir t in
|
||||||
let internals, externals =
|
let internals, externals =
|
||||||
List.partition_map libs ~f:(function
|
List.partition_map libs ~f:(function
|
||||||
| Lib.Internal (path, _) ->
|
| Lib.Internal (path, _) ->
|
||||||
|
@ -1976,7 +1858,7 @@ module Gen(P : Params) = struct
|
||||||
else
|
else
|
||||||
pps
|
pps
|
||||||
in
|
in
|
||||||
let ppx_exe, _, _ =
|
let ppx_exe =
|
||||||
get_ppx_driver pps
|
get_ppx_driver pps
|
||||||
~dir ~dep_kind:(if lib.optional then Build.Optional else Required)
|
~dir ~dep_kind:(if lib.optional then Build.Optional else Required)
|
||||||
in
|
in
|
||||||
|
|
Loading…
Reference in New Issue