Cleanup of [src/menhir.ml]. (#770)
This is purely for the sake of readability; there should be no change in functionality. Code is now shared between the case where [--base] is used and the case where it isn't.
This commit is contained in:
parent
76ab05d620
commit
d444aeefea
189
src/menhir.ml
189
src/menhir.ml
|
@ -4,63 +4,148 @@ open! No_io
|
||||||
|
|
||||||
module SC = Super_context
|
module SC = Super_context
|
||||||
|
|
||||||
(* - [sctx]: super context. Stores all the informations about the
|
(* -------------------------------------------------------------------------- *)
|
||||||
current build context. The current compiler can be obtained via:
|
|
||||||
|
|
||||||
{[
|
(* This signature describes the input of the functor [Run], which follows. *)
|
||||||
(SC.context sctx).ocamlc
|
|
||||||
]}
|
|
||||||
|
|
||||||
- [dir]: directory inside [_build/<context>/...] where the build happens.
|
type stanza =
|
||||||
If the [(menhir ...)] appears in [src/jbuild], then [dir] is of the form
|
Jbuild.Menhir.t
|
||||||
[_build/<context>/src], for instance [_build/default/src].
|
|
||||||
|
|
||||||
- [scope]: represent the scope this stanza is part of. Jbuilder allows to
|
module type PARAMS = sig
|
||||||
build multiple projects at once and splits the source tree into one
|
|
||||||
scope per project
|
(* [sctx] is the super context. It stores all the informations about the
|
||||||
|
current build context. The current compiler can be obtained via
|
||||||
|
[(SC.context sctx).ocamlc]. *)
|
||||||
|
|
||||||
|
val sctx: SC.t
|
||||||
|
|
||||||
|
(* [dir] is the directory inside [_build/<context>/...] where the build
|
||||||
|
happens. If the [(menhir ...)] stanza appears in [src/jbuild], then [dir]
|
||||||
|
is of the form [_build/<context>/src], e.g., [_build/default/src]. *)
|
||||||
|
|
||||||
|
val dir: Path.t
|
||||||
|
|
||||||
|
(* [scope] represents the scope this stanza is part of. Dune allows building
|
||||||
|
multiple projects at once and splits the source tree into one scope per
|
||||||
|
project. *)
|
||||||
|
|
||||||
|
val scope: Scope.t
|
||||||
|
|
||||||
|
(* [stanza] is the [(menhir ...)] stanza, as found in the [jbuild] file. *)
|
||||||
|
|
||||||
|
val stanza: stanza
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
(* -------------------------------------------------------------------------- *)
|
||||||
|
|
||||||
|
(* This functor is where [(menhir ...)] stanzas are desugared. *)
|
||||||
|
|
||||||
|
module Run (P : PARAMS) = struct
|
||||||
|
|
||||||
|
open P
|
||||||
|
|
||||||
|
let context =
|
||||||
|
SC.context sctx
|
||||||
|
|
||||||
|
(* If [m] is a (short) module name, such as "myparser", then [source dir m]
|
||||||
|
is the corresponding source file, and [targets dir m] is the list of
|
||||||
|
targets that Menhir must build. *)
|
||||||
|
|
||||||
|
let source m =
|
||||||
|
Path.relative dir (m ^ ".mly")
|
||||||
|
|
||||||
|
let targets m =
|
||||||
|
List.map ~f:(Path.relative dir) [m ^ ".ml"; m ^ ".mli"]
|
||||||
|
|
||||||
|
let sources ms =
|
||||||
|
List.map ~f:source ms
|
||||||
|
|
||||||
|
(* Expand special variables, such as ${ROOT}, in the stanza's flags. *)
|
||||||
|
|
||||||
- [t]: the parsed [(menhir ...)] stanza
|
|
||||||
*)
|
|
||||||
let gen_rules sctx ~dir ~scope (t : Jbuild.Menhir.t) =
|
|
||||||
let targets n = List.map ~f:(Path.relative dir) [n ^ ".ml"; n ^ ".mli"] in
|
|
||||||
(* This expands special variables such as ${ROOT} in the flags *)
|
|
||||||
let flags =
|
let flags =
|
||||||
SC.expand_and_eval_set sctx ~scope ~dir t.flags
|
SC.expand_and_eval_set
|
||||||
~standard:(Build.return [])
|
sctx ~scope ~dir stanza.flags ~standard:(Build.return [])
|
||||||
in
|
|
||||||
|
(* Find the menhir binary. *)
|
||||||
|
|
||||||
let menhir_binary =
|
let menhir_binary =
|
||||||
SC.resolve_program sctx "menhir" ~hint:"opam install menhir"
|
SC.resolve_program sctx "menhir" ~hint:"opam install menhir"
|
||||||
in
|
|
||||||
(* [hidden_targets] is to tell Jbuilder about generated files that
|
(* [menhir args] generates a Menhir command line (a build action). *)
|
||||||
do not appear in the menhir command line. *)
|
|
||||||
let menhir args =
|
type args =
|
||||||
flags
|
string list Arg_spec.t list
|
||||||
>>>
|
|
||||||
Build.run
|
let menhir (args : args) =
|
||||||
menhir_binary
|
flags >>> Build.run menhir_binary ~dir ~context args
|
||||||
~dir
|
|
||||||
~context:(SC.context sctx)
|
(* The function [rule] adds a rule and returns the list of its targets. *)
|
||||||
args
|
|
||||||
in
|
let rule : (unit, Action.t) Build.t -> Path.t list =
|
||||||
let add_rule_get_targets =
|
SC.add_rule_get_targets sctx ~mode:stanza.mode ~loc:stanza.loc
|
||||||
SC.add_rule_get_targets sctx ~mode:t.mode ~loc:t.loc
|
|
||||||
in
|
(* If there is no [base] clause, then a stanza that mentions several modules
|
||||||
let mly name = Path.relative dir (name ^ ".mly") in
|
is equivalent to a list of stanzas, each of which mentions one module, so
|
||||||
match t.merge_into with
|
Menhir must be invoked once per module, separately. If there is a [base]
|
||||||
| None ->
|
clause, then the stanza describes a multi-module parser, so Menhir must
|
||||||
List.concat_map t.modules ~f:(fun name ->
|
be invoked once. In either case, we are able to reformulate the input in
|
||||||
add_rule_get_targets (
|
the form of a list of stanzas, each of which has a [base] clause. *)
|
||||||
menhir
|
|
||||||
[ Dyn (fun x -> As x)
|
(* The current concrete name for [base] clauses is [merge_into], but I would
|
||||||
; Dep (mly name)
|
like to change it in the future. *)
|
||||||
; Hidden_targets (targets name)
|
|
||||||
]))
|
let stanzas : stanza list =
|
||||||
| Some merge_into ->
|
match stanza.merge_into with
|
||||||
add_rule_get_targets (
|
| None ->
|
||||||
menhir
|
List.map ~f:(fun m ->
|
||||||
[ A "--base" ; A merge_into
|
{ stanza with modules = [ m ]; merge_into = Some m }
|
||||||
; Dyn (fun x -> As x)
|
) stanza.modules
|
||||||
; Deps (List.map ~f:mly t.modules)
|
| Some _ ->
|
||||||
; Hidden_targets (targets merge_into)
|
[ stanza ]
|
||||||
|
|
||||||
|
(* [process stanza] converts a Menhir stanza into a rule, which it installs. *)
|
||||||
|
|
||||||
|
(* Reminder (from arg_spec.mli):
|
||||||
|
|
||||||
|
[Deps] is for command line arguments that are dependencies.
|
||||||
|
[As] is for command line arguments
|
||||||
|
that are neither dependencies nor targets.
|
||||||
|
[Hidden_targets] is for targets that are *not* command line arguments.
|
||||||
|
|
||||||
|
[Dyn (fun flags -> As flags)]
|
||||||
|
indicates that any flags that appear in the stanza
|
||||||
|
must be transmitted to Menhir.
|
||||||
|
|
||||||
|
*)
|
||||||
|
|
||||||
|
let process (stanza : stanza) : Path.t list =
|
||||||
|
let base : string = Option.value_exn stanza.merge_into in
|
||||||
|
let args : args =
|
||||||
|
[ Dyn (fun flags -> As flags)
|
||||||
|
; Deps (sources stanza.modules)
|
||||||
|
; As [ "--base" ; base ]
|
||||||
|
; Hidden_targets (targets base)
|
||||||
]
|
]
|
||||||
)
|
in
|
||||||
|
rule (menhir args)
|
||||||
|
|
||||||
|
(* The main side effect. *)
|
||||||
|
|
||||||
|
let targets =
|
||||||
|
List.concat_map ~f:process stanzas
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
(* -------------------------------------------------------------------------- *)
|
||||||
|
|
||||||
|
(* The final glue. *)
|
||||||
|
|
||||||
|
let gen_rules sctx ~dir ~scope stanza =
|
||||||
|
let module R = Run(struct
|
||||||
|
let sctx = sctx
|
||||||
|
let dir = dir
|
||||||
|
let scope = scope
|
||||||
|
let stanza = stanza
|
||||||
|
end) in
|
||||||
|
R.targets
|
||||||
|
|
Loading…
Reference in New Issue