refactoring
This commit is contained in:
parent
0f5635068f
commit
d2b8acc3b7
165
src/gen_rules.ml
165
src/gen_rules.ml
|
@ -684,6 +684,116 @@ 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" | "ppx_assert" -> uses_here := true
|
||||||
|
| "ppx_inline_test.libname" -> uses_libname := true
|
||||||
|
| "ppx_expect" -> uses_inline_test := true; uses_here := 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 =
|
||||||
|
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 t.uses_ppx_driver && not for_merlin
|
||||||
|
then [ A "-embed-errors"; A "false" ]
|
||||||
|
else [])
|
||||||
|
]
|
||||||
|
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"
|
||||||
|
@ -775,42 +885,9 @@ module Gen(P : Params) = struct
|
||||||
let libs =
|
let libs =
|
||||||
build_ppx_driver names ~dir ~dep_kind ~target:exe ~driver
|
build_ppx_driver names ~dir ~dep_kind ~target:exe ~driver
|
||||||
in
|
in
|
||||||
Hashtbl.add ppx_drivers ~key ~data:(exe, libs);
|
let info = Ppx_info.make_info_file ~ppx_dir ~libs in
|
||||||
(exe, libs)
|
Hashtbl.add ppx_drivers ~key ~data:(exe, libs, info);
|
||||||
|
(exe, libs, info)
|
||||||
let specific_args_for_ppx_rewriters ~dir ~lib_name ~for_merlin (libs : Lib.t list) =
|
|
||||||
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" | "ppx_assert" -> uses_here := true
|
|
||||||
| "ppx_inline_test.libname" -> uses_libname := true
|
|
||||||
| "ppx_expect" -> uses_inline_test := true; uses_here := true
|
|
||||||
| "ppx_inline_test" -> uses_inline_test := true
|
|
||||||
| "ppx_bench" -> uses_inline_bench := true
|
|
||||||
| "ppx_driver.runner" -> uses_ppx_driver := true
|
|
||||||
| _ -> ());
|
|
||||||
Arg_spec.S
|
|
||||||
[ S (if !uses_here
|
|
||||||
then [A "-dirname"; Path dir]
|
|
||||||
else [])
|
|
||||||
; S (match lib_name with
|
|
||||||
| Some name when !uses_libname ->
|
|
||||||
[ A "-inline-test-lib"; A name ]
|
|
||||||
| _ -> [])
|
|
||||||
; S (if !uses_inline_test(* && drop_test*)
|
|
||||||
then [ A "-inline-test-drop-with-deadcode" ]
|
|
||||||
else [])
|
|
||||||
; S (if !uses_inline_bench (*&& drop_bench*)
|
|
||||||
then [ A "-bench-drop-with-deadcode" ]
|
|
||||||
else [])
|
|
||||||
; S (if !uses_ppx_driver && not for_merlin
|
|
||||||
then [ A "-embed-errors"; A "false" ]
|
|
||||||
else [])
|
|
||||||
]
|
|
||||||
|
|
||||||
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}"
|
||||||
|
@ -840,16 +917,17 @@ module Gen(P : Params) = struct
|
||||||
~targets:[dst]
|
~targets:[dst]
|
||||||
~deps:[Some src]))
|
~deps:[Some src]))
|
||||||
| Pps { pps; flags } ->
|
| Pps { pps; flags } ->
|
||||||
let ppx_exe, libs = get_ppx_driver pps ~dir ~dep_kind in
|
let ppx_exe, _, info = 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
|
||||||
>>>
|
>>>
|
||||||
libs
|
info
|
||||||
>>>
|
>>>
|
||||||
Build.run
|
Build.run
|
||||||
(Dep ppx_exe)
|
(Dep ppx_exe)
|
||||||
[ Dyn (specific_args_for_ppx_rewriters ~dir ~lib_name ~for_merlin:false)
|
[ Dyn (Ppx_info.specific_args_for_ppx_rewriters ~dir ~lib_name
|
||||||
|
~for_merlin:false)
|
||||||
; As flags
|
; As flags
|
||||||
; A "--dump-ast"
|
; A "--dump-ast"
|
||||||
; A "-o"; Target dst
|
; A "-o"; Target dst
|
||||||
|
@ -910,11 +988,12 @@ 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, libs = get_ppx_driver pps ~dir ~dep_kind:Optional in
|
let exe, _, info = get_ppx_driver pps ~dir ~dep_kind:Optional in
|
||||||
libs >>^ fun libs ->
|
info >>^ fun info ->
|
||||||
let specific_flags, _ =
|
let specific_flags, _ =
|
||||||
Arg_spec.expand ~dir:src_dir
|
Arg_spec.expand ~dir:src_dir
|
||||||
[specific_args_for_ppx_rewriters ~dir ~lib_name:libname libs ~for_merlin:true]
|
[Ppx_info.specific_args_for_ppx_rewriters info ~dir ~lib_name:libname
|
||||||
|
~for_merlin:true]
|
||||||
()
|
()
|
||||||
in
|
in
|
||||||
let command =
|
let command =
|
||||||
|
@ -1873,7 +1952,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