Merge pull request #577 from rgrinberg/menhir-own-module
Move menhir rules to own module
This commit is contained in:
commit
75fe147da9
|
@ -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
|
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 =
|
type 'a t =
|
||||||
| A of string
|
| A of string
|
||||||
| As of string list
|
| As of string list
|
||||||
|
|
|
@ -1,4 +1,5 @@
|
||||||
open Import
|
open Import
|
||||||
|
module Menhir_rules = Menhir
|
||||||
open Jbuild
|
open Jbuild
|
||||||
open Build.O
|
open Build.O
|
||||||
open! No_io
|
open! No_io
|
||||||
|
@ -223,6 +224,9 @@ module Gen(P : Install_rules.Params) = struct
|
||||||
let generated_files =
|
let generated_files =
|
||||||
List.concat_map stanzas ~f:(fun stanza ->
|
List.concat_map stanzas ~f:(fun stanza ->
|
||||||
match (stanza : Stanza.t) with
|
match (stanza : Stanza.t) with
|
||||||
|
| Menhir menhir ->
|
||||||
|
Menhir_rules.gen_rules sctx ~dir ~scope menhir
|
||||||
|
|> List.map ~f:Path.basename
|
||||||
| Rule rule ->
|
| Rule rule ->
|
||||||
List.map (user_rule rule ~dir ~scope) ~f:Path.basename
|
List.map (user_rule rule ~dir ~scope) ~f:Path.basename
|
||||||
| Copy_files def ->
|
| Copy_files def ->
|
||||||
|
|
|
@ -942,15 +942,16 @@ end
|
||||||
module Menhir = struct
|
module Menhir = struct
|
||||||
type t =
|
type t =
|
||||||
{ merge_into : string option
|
{ merge_into : string option
|
||||||
; flags : String_with_vars.t list
|
; flags : Ordered_set_lang.Unexpanded.t
|
||||||
; modules : string list
|
; modules : string list
|
||||||
; mode : Rule.Mode.t
|
; mode : Rule.Mode.t
|
||||||
|
; loc : Loc.t
|
||||||
}
|
}
|
||||||
|
|
||||||
let v1 =
|
let v1 =
|
||||||
record
|
record
|
||||||
(field_o "merge_into" string >>= fun merge_into ->
|
(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 ->
|
field "modules" (list string) >>= fun modules ->
|
||||||
Rule.Mode.field >>= fun mode ->
|
Rule.Mode.field >>= fun mode ->
|
||||||
return
|
return
|
||||||
|
@ -958,48 +959,9 @@ module Menhir = struct
|
||||||
; flags
|
; flags
|
||||||
; modules
|
; modules
|
||||||
; mode
|
; 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
|
end
|
||||||
|
|
||||||
module Provides = struct
|
module Provides = struct
|
||||||
|
@ -1067,6 +1029,7 @@ module Stanza = struct
|
||||||
| Install of Install_conf.t
|
| Install of Install_conf.t
|
||||||
| Alias of Alias_conf.t
|
| Alias of Alias_conf.t
|
||||||
| Copy_files of Copy_files.t
|
| Copy_files of Copy_files.t
|
||||||
|
| Menhir of Menhir.t
|
||||||
end
|
end
|
||||||
|
|
||||||
module Stanzas = struct
|
module Stanzas = struct
|
||||||
|
@ -1096,7 +1059,7 @@ module Stanzas = struct
|
||||||
; cstr_loc "ocamlyacc" (Rule.ocamlyacc_v1 @> nil)
|
; cstr_loc "ocamlyacc" (Rule.ocamlyacc_v1 @> nil)
|
||||||
(fun loc x -> rules (Rule.ocamlyacc_to_rule loc x))
|
(fun loc x -> rules (Rule.ocamlyacc_to_rule loc x))
|
||||||
; cstr_loc "menhir" (Menhir.v1 @> nil)
|
; 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 "install" (Install_conf.v1 pkgs @> nil) (fun x -> [Install x])
|
||||||
; cstr "alias" (Alias_conf.v1 pkgs @> nil) (fun x -> [Alias x])
|
; cstr "alias" (Alias_conf.v1 pkgs @> nil) (fun x -> [Alias x])
|
||||||
; cstr "copy_files" (Copy_files.v1 @> nil)
|
; cstr "copy_files" (Copy_files.v1 @> nil)
|
||||||
|
|
|
@ -284,6 +284,16 @@ module Rule : sig
|
||||||
}
|
}
|
||||||
end
|
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
|
module Provides : sig
|
||||||
type t =
|
type t =
|
||||||
{ name : string
|
{ name : string
|
||||||
|
@ -317,6 +327,7 @@ module Stanza : sig
|
||||||
| Install of Install_conf.t
|
| Install of Install_conf.t
|
||||||
| Alias of Alias_conf.t
|
| Alias of Alias_conf.t
|
||||||
| Copy_files of Copy_files.t
|
| Copy_files of Copy_files.t
|
||||||
|
| Menhir of Menhir.t
|
||||||
end
|
end
|
||||||
|
|
||||||
module Stanzas : sig
|
module Stanzas : sig
|
||||||
|
|
|
@ -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)
|
||||||
|
]
|
||||||
|
)
|
|
@ -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
|
|
@ -3,7 +3,8 @@
|
||||||
(ocamllex (lexer1 lexer2))
|
(ocamllex (lexer1 lexer2))
|
||||||
|
|
||||||
(menhir
|
(menhir
|
||||||
((modules (test_menhir1))))
|
((modules (test_menhir1))
|
||||||
|
(flags (:standard --unused-tokens))))
|
||||||
|
|
||||||
(menhir
|
(menhir
|
||||||
((merge_into test_base)
|
((merge_into test_base)
|
||||||
|
|
Loading…
Reference in New Issue