diff --git a/src/gen_rules.ml b/src/gen_rules.ml index adf618ea..2659fccf 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -684,6 +684,116 @@ module Gen(P : Params) = struct ; 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 migrate_driver_main = "ocaml-migrate-parsetree.driver-main" @@ -775,42 +885,9 @@ module Gen(P : Params) = struct let libs = build_ppx_driver names ~dir ~dep_kind ~target:exe ~driver in - Hashtbl.add ppx_drivers ~key ~data:(exe, libs); - (exe, libs) - - 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 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 root_var = String_with_vars.of_string "${ROOT}" @@ -840,16 +917,17 @@ module Gen(P : Params) = struct ~targets:[dst] ~deps:[Some src])) | 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 -> add_rule (preprocessor_deps >>> - libs + info >>> Build.run (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 ; A "--dump-ast" ; A "-o"; Target dst @@ -910,11 +988,12 @@ module Gen(P : Params) = struct let ppx_flags ~dir ~src_dir { preprocess; libname; _ } = match preprocess with | Pps { pps; flags } -> - let exe, libs = get_ppx_driver pps ~dir ~dep_kind:Optional in - libs >>^ fun libs -> + let exe, _, info = get_ppx_driver pps ~dir ~dep_kind:Optional in + info >>^ fun info -> let specific_flags, _ = 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 let command = @@ -1873,7 +1952,7 @@ module Gen(P : Params) = struct else pps in - let ppx_exe, _ = + let ppx_exe, _, _ = get_ppx_driver pps ~dir ~dep_kind:(if lib.optional then Build.Optional else Required) in