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