From d444aeefea38489078dec5cc04ecf9485ce2dc13 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Pottier?= Date: Mon, 14 May 2018 14:07:48 +0200 Subject: [PATCH] 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. --- src/menhir.ml | 189 ++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 137 insertions(+), 52 deletions(-) diff --git a/src/menhir.ml b/src/menhir.ml index 570aba84..5c3e6146 100644 --- a/src/menhir.ml +++ b/src/menhir.ml @@ -4,63 +4,148 @@ open! No_io module SC = Super_context -(* - [sctx]: super context. Stores all the informations about the - current build context. The current compiler can be obtained via: +(* -------------------------------------------------------------------------- *) - {[ - (SC.context sctx).ocamlc - ]} +(* This signature describes the input of the functor [Run], which follows. *) - - [dir]: directory inside [_build//...] where the build happens. - If the [(menhir ...)] appears in [src/jbuild], then [dir] is of the form - [_build//src], for instance [_build/default/src]. +type stanza = + Jbuild.Menhir.t - - [scope]: represent the scope this stanza is part of. Jbuilder allows to - build multiple projects at once and splits the source tree into one - scope per project +module type PARAMS = sig + + (* [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//...] where the build + happens. If the [(menhir ...)] stanza appears in [src/jbuild], then [dir] + is of the form [_build//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 = - SC.expand_and_eval_set sctx ~scope ~dir t.flags - ~standard:(Build.return []) - in + SC.expand_and_eval_set + sctx ~scope ~dir stanza.flags ~standard:(Build.return []) + + (* Find the menhir binary. *) + let menhir_binary = SC.resolve_program sctx "menhir" ~hint:"opam install menhir" - in - (* [hidden_targets] is to tell Jbuilder about generated files that - do not appear in the menhir command line. *) - let menhir args = - flags - >>> - Build.run - menhir_binary - ~dir - ~context:(SC.context sctx) - args - in - let add_rule_get_targets = - SC.add_rule_get_targets sctx ~mode:t.mode ~loc:t.loc - in - let mly name = Path.relative dir (name ^ ".mly") in - match t.merge_into with - | None -> - List.concat_map t.modules ~f:(fun name -> - add_rule_get_targets ( - menhir - [ Dyn (fun x -> As x) - ; Dep (mly name) - ; Hidden_targets (targets name) - ])) - | Some merge_into -> - add_rule_get_targets ( - menhir - [ A "--base" ; A merge_into - ; Dyn (fun x -> As x) - ; Deps (List.map ~f:mly t.modules) - ; Hidden_targets (targets merge_into) + + (* [menhir args] generates a Menhir command line (a build action). *) + + type args = + string list Arg_spec.t list + + let menhir (args : args) = + flags >>> Build.run menhir_binary ~dir ~context args + + (* The function [rule] adds a rule and returns the list of its targets. *) + + let rule : (unit, Action.t) Build.t -> Path.t list = + SC.add_rule_get_targets sctx ~mode:stanza.mode ~loc:stanza.loc + + (* If there is no [base] clause, then a stanza that mentions several modules + is equivalent to a list of stanzas, each of which mentions one module, so + Menhir must be invoked once per module, separately. If there is a [base] + clause, then the stanza describes a multi-module parser, so Menhir must + be invoked once. In either case, we are able to reformulate the input in + the form of a list of stanzas, each of which has a [base] clause. *) + + (* The current concrete name for [base] clauses is [merge_into], but I would + like to change it in the future. *) + + let stanzas : stanza list = + match stanza.merge_into with + | None -> + List.map ~f:(fun m -> + { stanza with modules = [ m ]; merge_into = Some m } + ) stanza.modules + | Some _ -> + [ 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