From f06519e231ba28b918ce84b50c9565a4de62397b Mon Sep 17 00:00:00 2001
From: Rudi Grinberg <rudi.grinberg@gmail.com>
Date: Mon, 5 Mar 2018 19:29:12 +0700
Subject: [PATCH] Implement menhir rules from scrath

Rather than changing them to user_rules and then compiling those.
---
 src/gen_rules.ml |  3 +--
 src/menhir.ml    | 67 ++++++++++++++++++++++--------------------------
 src/menhir.mli   |  7 ++++-
 3 files changed, 37 insertions(+), 40 deletions(-)

diff --git a/src/gen_rules.ml b/src/gen_rules.ml
index 6394161f..13212444 100644
--- a/src/gen_rules.ml
+++ b/src/gen_rules.ml
@@ -225,8 +225,7 @@ module Gen(P : Install_rules.Params) = struct
             List.concat_map stanzas ~f:(fun stanza ->
               match (stanza : Stanza.t) with
               | Menhir menhir ->
-                Menhir_rules.to_rules menhir
-                |> List.concat_map ~f:(user_rule ~dir ~scope)
+                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
diff --git a/src/menhir.ml b/src/menhir.ml
index b857568c..fced8e68 100644
--- a/src/menhir.ml
+++ b/src/menhir.ml
@@ -1,42 +1,35 @@
 open Import
-open Jbuild
 
-let to_rules (t : Jbuild.Menhir.t) =
-  let module S = String_with_vars in
-  let targets n = [n ^ ".ml"; n ^ ".mli"] in
+let gen_rules sctx ~dir ~scope (t : Jbuild.Menhir.t) =
+  let targets n = List.map ~f:(Path.relative dir) [n ^ ".ml"; n ^ ".mli"] in
+  let flags =
+    List.map ~f:(Super_context.expand_vars sctx ~scope ~dir) t.flags in
+  let menhir =
+    let menhir =
+      Super_context.resolve_program sctx ~hint:"opam install menhir" "menhir" in
+    fun ~extra_targets ->
+      Build.run ~extra_targets
+        menhir
+        ~dir
+        ~context:(Super_context.context sctx) in
+  let add_rule_get_targets =
+    Super_context.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.map t.modules ~f:(fun name ->
-      let src = name ^ ".mly" in
-      { Jbuild.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 = t.loc
-      })
+    List.concat_map ~f:(fun name ->
+      add_rule_get_targets (
+        menhir
+          ~extra_targets:(targets name)
+          [ As flags
+          ; Dep (mly name)]
+      )) t.modules
   | 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 = t.loc
-     }]
+    add_rule_get_targets (
+      menhir
+        ~extra_targets:(targets merge_into)
+        [ A "--base" ; A merge_into
+        ; As flags
+        ; Deps (List.map ~f:mly t.modules)
+        ]
+    )
diff --git a/src/menhir.mli b/src/menhir.mli
index e57e35d0..8ad2f850 100644
--- a/src/menhir.mli
+++ b/src/menhir.mli
@@ -1,2 +1,7 @@
 
-val to_rules : Jbuild.Menhir.t -> Jbuild.Rule.t list
+val gen_rules
+  :  Super_context.t
+  -> dir:Path.t
+  -> scope:Scope.t
+  -> Jbuild.Menhir.t
+  -> Path.t list