Split Preproressing.pp_and... in two functions
Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
This commit is contained in:
Jeremie Dimino
Jérémie Dimino
parent
5c4027aff8
commit
ac1c407cab
|
|
@ -555,8 +555,8 @@ module Gen(P : Install_rules.Params) = struct
|
|||
in
|
||||
(* Preprocess before adding the alias module as it doesn't need
|
||||
preprocessing *)
|
||||
let modules =
|
||||
Preprocessing.pp_and_lint_modules sctx ~dir ~dep_kind ~modules ~scope
|
||||
let pp =
|
||||
Preprocessing.make sctx ~dir ~dep_kind ~scope
|
||||
~preprocess:lib.buildable.preprocess
|
||||
~preprocessor_deps:
|
||||
(SC.Deps.interpret sctx ~scope ~dir
|
||||
|
|
@ -564,6 +564,7 @@ module Gen(P : Install_rules.Params) = struct
|
|||
~lint:lib.buildable.lint
|
||||
~lib_name:(Some lib.name)
|
||||
in
|
||||
let modules = Preprocessing.pp_modules pp modules in
|
||||
|
||||
let modules =
|
||||
match alias_module with
|
||||
|
|
@ -817,12 +818,15 @@ module Gen(P : Install_rules.Params) = struct
|
|||
SC.Deps.interpret sctx exes.buildable.preprocessor_deps
|
||||
~scope ~dir
|
||||
in
|
||||
Preprocessing.pp_and_lint_modules sctx ~dir ~dep_kind:Required ~modules
|
||||
~scope
|
||||
~preprocess:exes.buildable.preprocess
|
||||
~preprocessor_deps
|
||||
~lint:exes.buildable.lint
|
||||
~lib_name:None
|
||||
let pp =
|
||||
Preprocessing.make sctx ~dir ~dep_kind:Required
|
||||
~scope
|
||||
~preprocess:exes.buildable.preprocess
|
||||
~preprocessor_deps
|
||||
~lint:exes.buildable.lint
|
||||
~lib_name:None
|
||||
in
|
||||
Preprocessing.pp_modules pp modules
|
||||
in
|
||||
|
||||
let programs =
|
||||
|
|
|
|||
|
|
@ -293,9 +293,9 @@ let lint_module sctx ~dir ~dep_kind ~lint ~lib_name ~scope = Staged.stage (
|
|||
fun ~(source : Module.t) ~ast ->
|
||||
Per_module.get lint source.name ~source ~ast)
|
||||
|
||||
(* Generate rules to build the .pp files and return a new module map
|
||||
where all filenames point to the .pp files *)
|
||||
let pp_and_lint_modules sctx ~dir ~dep_kind ~modules ~lint ~preprocess
|
||||
type t = (Module.t -> Module.t) Per_module.t
|
||||
|
||||
let make sctx ~dir ~dep_kind ~lint ~preprocess
|
||||
~preprocessor_deps ~lib_name ~scope =
|
||||
let preprocessor_deps =
|
||||
Build.memoize "preprocessor deps" preprocessor_deps
|
||||
|
|
@ -303,62 +303,62 @@ let pp_and_lint_modules sctx ~dir ~dep_kind ~modules ~lint ~preprocess
|
|||
let lint_module =
|
||||
Staged.unstage (lint_module sctx ~dir ~dep_kind ~lint ~lib_name ~scope)
|
||||
in
|
||||
let preprocess =
|
||||
Per_module.map preprocess ~f:(function
|
||||
| Preprocess.No_preprocessing ->
|
||||
(fun m ->
|
||||
let ast = setup_reason_rules sctx ~dir m in
|
||||
lint_module ~ast ~source:m;
|
||||
ast)
|
||||
| Action (loc, action) ->
|
||||
(fun m ->
|
||||
let ast =
|
||||
pped_module m ~dir ~f:(fun _kind src dst ->
|
||||
SC.add_rule sctx
|
||||
(preprocessor_deps
|
||||
>>>
|
||||
Build.path src
|
||||
>>^ (fun _ -> [src])
|
||||
>>>
|
||||
SC.Action.run sctx
|
||||
(Redirect
|
||||
(Stdout,
|
||||
target_var,
|
||||
Chdir (root_var,
|
||||
action)))
|
||||
~loc
|
||||
~dir
|
||||
~dep_kind
|
||||
~targets:(Static [dst])
|
||||
~scope))
|
||||
|> setup_reason_rules sctx ~dir in
|
||||
lint_module ~ast ~source:m;
|
||||
ast)
|
||||
| Pps { pps; flags } ->
|
||||
let ppx_exe = get_ppx_driver sctx ~scope pps in
|
||||
let uses_ppx_driver = uses_ppx_driver ~pps in
|
||||
let args : _ Arg_spec.t =
|
||||
S [ As flags
|
||||
; A "--dump-ast"
|
||||
; As (cookie_library_name lib_name)
|
||||
; As (if uses_ppx_driver then ["-diff-cmd"; "-"] else [])
|
||||
]
|
||||
in
|
||||
(fun m ->
|
||||
let ast = setup_reason_rules sctx ~dir m in
|
||||
lint_module ~ast ~source:m;
|
||||
pped_module ast ~dir ~f:(fun kind src dst ->
|
||||
Per_module.map preprocess ~f:(function
|
||||
| Preprocess.No_preprocessing ->
|
||||
(fun m ->
|
||||
let ast = setup_reason_rules sctx ~dir m in
|
||||
lint_module ~ast ~source:m;
|
||||
ast)
|
||||
| Action (loc, action) ->
|
||||
(fun m ->
|
||||
let ast =
|
||||
pped_module m ~dir ~f:(fun _kind src dst ->
|
||||
SC.add_rule sctx
|
||||
(promote_correction ~uses_ppx_driver
|
||||
(Option.value_exn (Module.file m ~dir kind))
|
||||
(preprocessor_deps
|
||||
>>>
|
||||
Build.run ~context:(SC.context sctx)
|
||||
(Ok ppx_exe)
|
||||
[ args
|
||||
; A "-o"; Target dst
|
||||
; Ml_kind.ppx_driver_flag kind; Dep src
|
||||
])))))
|
||||
in
|
||||
Module.Name.Map.map modules ~f:(fun (m : Module.t) ->
|
||||
Per_module.get preprocess m.name m)
|
||||
(preprocessor_deps
|
||||
>>>
|
||||
Build.path src
|
||||
>>^ (fun _ -> [src])
|
||||
>>>
|
||||
SC.Action.run sctx
|
||||
(Redirect
|
||||
(Stdout,
|
||||
target_var,
|
||||
Chdir (root_var,
|
||||
action)))
|
||||
~loc
|
||||
~dir
|
||||
~dep_kind
|
||||
~targets:(Static [dst])
|
||||
~scope))
|
||||
|> setup_reason_rules sctx ~dir in
|
||||
lint_module ~ast ~source:m;
|
||||
ast)
|
||||
| Pps { pps; flags } ->
|
||||
let ppx_exe = get_ppx_driver sctx ~scope pps in
|
||||
let uses_ppx_driver = uses_ppx_driver ~pps in
|
||||
let args : _ Arg_spec.t =
|
||||
S [ As flags
|
||||
; A "--dump-ast"
|
||||
; As (cookie_library_name lib_name)
|
||||
; As (if uses_ppx_driver then ["-diff-cmd"; "-"] else [])
|
||||
]
|
||||
in
|
||||
(fun m ->
|
||||
let ast = setup_reason_rules sctx ~dir m in
|
||||
lint_module ~ast ~source:m;
|
||||
pped_module ast ~dir ~f:(fun kind src dst ->
|
||||
SC.add_rule sctx
|
||||
(promote_correction ~uses_ppx_driver
|
||||
(Option.value_exn (Module.file m ~dir kind))
|
||||
(preprocessor_deps
|
||||
>>>
|
||||
Build.run ~context:(SC.context sctx)
|
||||
(Ok ppx_exe)
|
||||
[ args
|
||||
; A "-o"; Target dst
|
||||
; Ml_kind.ppx_driver_flag kind; Dep src
|
||||
])))))
|
||||
|
||||
let pp_modules t modules =
|
||||
Module.Name.Map.map modules ~f:(fun (m : Module.t) ->
|
||||
Per_module.get t m.name m)
|
||||
|
|
|
|||
|
|
@ -2,19 +2,26 @@
|
|||
|
||||
open! Import
|
||||
|
||||
(** Setup pre-processing and linting rules and return the list of
|
||||
pre-processed modules *)
|
||||
val pp_and_lint_modules
|
||||
(** Preprocessing object *)
|
||||
type t
|
||||
|
||||
val make
|
||||
: Super_context.t
|
||||
-> dir:Path.t
|
||||
-> dep_kind:Build.lib_dep_kind
|
||||
-> modules:Module.t Module.Name.Map.t
|
||||
-> lint:Jbuild.Preprocess_map.t
|
||||
-> preprocess:Jbuild.Preprocess_map.t
|
||||
-> preprocessor_deps:(unit, Path.t list) Build.t
|
||||
-> lib_name:string option
|
||||
-> scope:Scope.t
|
||||
-> Module.t Module.Name.Map.t
|
||||
-> t
|
||||
|
||||
(** Setup the preprocessing rules for the following modules and
|
||||
returns the translated modules *)
|
||||
val pp_modules
|
||||
: t
|
||||
-> Module.t Module.Name.Map.t
|
||||
-> Module.t Module.Name.Map.t
|
||||
|
||||
(** Get a path to a cached ppx driver *)
|
||||
val get_ppx_driver
|
||||
|
|
|
|||
Loading…
Reference in New Issue