Merge pull request #577 from rgrinberg/menhir-own-module

Move menhir rules to own module

src/arg_spec.mli

@@ -1,5 +1,33 @@
+(** Command line arguments specification *)
+
+(** This module implements a small DSL to specify the command line
+    argument of a program as well as the dependencies and targets of
+    the program at the same time.
+
+    For instance to represent the argument of [ocamlc -o src/foo.exe
+    src/foo.ml], one might write:
+
+    {[
+      [ A "-o"
+      ; Target (Path.relatie  dir "foo.exe")
+      ; Dep    (Path.relative dir "foo.ml")
+      ]
+    ]}
+
+    This DSL was inspired from the ocamlbuild API.  *)
+
 open! Import
 
+(** [A] stands for "atom", it is for command line arguments that are
+    neither dependencies nor targets.
+
+    [Path] is similar to [A] in the sense that it defines a command
+    line argument that is neither a dependency or target. However, the
+    difference between the two is that [A s] produces exactly the
+    argument [s], while [Path p] produces a string that depends on
+    where the command is executed. For instance [Path (Path.of_string
+    "src/foo.ml")] will translate to "../src/foo.ml" if the command is
+    started from the "test" directory.  *)
 type 'a t =
   | A        of string
   | As       of string list

src/gen_rules.ml

@@ -1,4 +1,5 @@
 open Import
+module Menhir_rules = Menhir
 open Jbuild
 open Build.O
 open! No_io
@@ -223,6 +224,9 @@ module Gen(P : Install_rules.Params) = struct
           let generated_files =
             List.concat_map stanzas ~f:(fun stanza ->
               match (stanza : Stanza.t) with
+              | Menhir menhir ->
+                Menhir_rules.gen_rules sctx ~dir ~scope menhir
+                |> List.map ~f:Path.basename
               | Rule rule ->
                 List.map (user_rule rule  ~dir ~scope) ~f:Path.basename
               | Copy_files def ->

src/jbuild.ml

@@ -942,64 +942,26 @@ end
 module Menhir = struct
   type t =
     { merge_into : string option
-    ; flags      : String_with_vars.t list
+    ; flags      : Ordered_set_lang.Unexpanded.t
     ; modules    : string list
     ; mode       : Rule.Mode.t
+    ; loc        :  Loc.t
     }
 
   let v1 =
     record
       (field_o "merge_into" string >>= fun merge_into ->
-       field "flags" (list String_with_vars.t) ~default:[] >>= fun flags ->
+       field_oslu "flags" >>= fun flags ->
        field "modules" (list string) >>= fun modules ->
        Rule.Mode.field >>= fun mode ->
        return
          { merge_into
          ; flags
          ; modules
          ; mode
+         ; loc = Loc.none
          }
       )
-
-  let v1_to_rule loc t =
-    let module S = String_with_vars in
-    let targets n = [n ^ ".ml"; n ^ ".mli"] in
-    match t.merge_into with
-    | None ->
-      List.map t.modules ~f:(fun name ->
-        let src = name ^ ".mly" in
-        { Rule.
-          targets = Static (targets name)
-        ; deps    = [Dep_conf.File (S.virt_text __POS__ src)]
-        ; action  =
-            Chdir
-              (S.virt_var __POS__ "ROOT",
-               Run (S.virt_text __POS__ "menhir",
-                    t.flags @ [S.virt_var __POS__ "<"]))
-        ; mode  = t.mode
-        ; locks = []
-       ; loc
-       })
-    | Some merge_into ->
-      let mly m = S.virt_text __POS__ (m ^ ".mly") in
-      [{ Rule.
-         targets = Static (targets merge_into)
-       ; deps    = List.map ~f:(fun m -> Dep_conf.File (mly m)) t.modules
-       ; action  =
-           Chdir
-             (S.virt_var __POS__ "ROOT",
-              Run (S.virt_text __POS__ "menhir",
-                   List.concat
-                     [ [ S.virt_text __POS__ "--base"
-                       ; S.virt_var __POS__ ("path-no-dep:" ^ merge_into)
-                       ]
-                     ; t.flags
-                     ; [ S.virt_var __POS__ "^" ]
-                     ]))
-       ; mode  = t.mode
-       ; locks = []
-       ; loc
-       }]
 end
 
 module Provides = struct
@@ -1067,6 +1029,7 @@ module Stanza = struct
     | Install     of Install_conf.t
     | Alias       of Alias_conf.t
     | Copy_files  of Copy_files.t
+    | Menhir      of Menhir.t
 end
 
 module Stanzas = struct
@@ -1096,7 +1059,7 @@ module Stanzas = struct
       ; cstr_loc "ocamlyacc" (Rule.ocamlyacc_v1 @> nil)
           (fun loc x -> rules (Rule.ocamlyacc_to_rule loc x))
       ; cstr_loc "menhir" (Menhir.v1 @> nil)
-          (fun loc x -> rules (Menhir.v1_to_rule loc x))
+          (fun loc x -> [Menhir { x with loc }])
       ; cstr "install"     (Install_conf.v1 pkgs @> nil) (fun x -> [Install     x])
       ; cstr "alias"       (Alias_conf.v1 pkgs @> nil)   (fun x -> [Alias       x])
       ; cstr "copy_files" (Copy_files.v1 @> nil)

src/jbuild.mli

@@ -284,6 +284,16 @@ module Rule : sig
     }
 end
 
+module Menhir : sig
+  type t =
+    { merge_into : string option
+    ; flags      : Ordered_set_lang.Unexpanded.t
+    ; modules    : string list
+    ; mode       : Rule.Mode.t
+    ; loc        : Loc.t
+    }
+end
+
 module Provides : sig
   type t =
     { name : string
@@ -317,6 +327,7 @@ module Stanza : sig
     | Install     of Install_conf.t
     | Alias       of Alias_conf.t
     | Copy_files  of Copy_files.t
+    | Menhir      of Menhir.t
 end
 
 module Stanzas : sig

src/menhir.ml

@@ -0,0 +1,63 @@
+open Import
+open Build.O
+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
+   ]}
+
+   - [dir]: directory inside [_build/<context>/...] where the build happens.
+   If the [(menhir ...)] appears in [src/jbuild], then [dir] is of the form
+   [_build/<context>/src], for instance [_build/default/src].
+
+   - [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
+
+   - [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:[] in
+  let menhir_binary =
+    SC.resolve_program sctx "menhir" ~hint:"opam install menhir"
+  in
+  (* [extra_targets] is to tell Jbuilder about generated files that do
+     not appear in the menhir command line. *)
+  let menhir ~extra_targets args =
+    flags
+    >>>
+    Build.run ~extra_targets
+      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
+          ~extra_targets:(targets name)
+          [ Dyn (fun x -> As x)
+          ; Dep (mly name)
+          ]))
+  | Some merge_into ->
+    add_rule_get_targets (
+      menhir
+        ~extra_targets:(targets merge_into)
+        [ A "--base" ; A merge_into
+        ; Dyn (fun x -> As x)
+        ; Deps (List.map ~f:mly t.modules)
+        ]
+    )

src/menhir.mli

@@ -0,0 +1,12 @@
+(** Menhir rules *)
+
+(** Generate the rules for a [(menhir ...)] stanza. Return the list of
+    targets that are generated by these rules. This list of targets is
+    used by the code that computes the list of modules in the
+    directory. *)
+val gen_rules
+  :  Super_context.t
+  -> dir:Path.t
+  -> scope:Scope.t
+  -> Jbuild.Menhir.t
+  -> Path.t list

test/blackbox-tests/test-cases/menhir/src/jbuild

@@ -3,7 +3,8 @@
 (ocamllex (lexer1 lexer2))
 
 (menhir
- ((modules (test_menhir1))))
+ ((modules (test_menhir1))
+  (flags (:standard --unused-tokens))))
 
 (menhir
  ((merge_into test_base)