From 288de19920f07a65be0c65029e8f1ed8cb6aaddc Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 3 Mar 2018 23:12:55 +0700 Subject: [PATCH 1/6] Move menhir rules to own module --- src/gen_rules.ml | 5 +++++ src/jbuild.ml | 45 ++++----------------------------------------- src/jbuild.mli | 11 +++++++++++ src/menhir.ml | 42 ++++++++++++++++++++++++++++++++++++++++++ src/menhir.mli | 2 ++ 5 files changed, 64 insertions(+), 41 deletions(-) create mode 100644 src/menhir.ml create mode 100644 src/menhir.mli diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 968f5147..6394161f 100644 --- a/src/gen_rules.ml +++ b/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,10 @@ 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.to_rules menhir + |> List.concat_map ~f:(user_rule ~dir ~scope) + |> List.map ~f:Path.basename | Rule rule -> List.map (user_rule rule ~dir ~scope) ~f:Path.basename | Copy_files def -> diff --git a/src/jbuild.ml b/src/jbuild.ml index 4d13b680..4ab84962 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -945,6 +945,7 @@ module Menhir = struct ; flags : String_with_vars.t list ; modules : string list ; mode : Rule.Mode.t + ; loc : Loc.t } let v1 = @@ -958,48 +959,9 @@ module Menhir = struct ; 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) diff --git a/src/jbuild.mli b/src/jbuild.mli index a2d84fd4..e994d553 100644 --- a/src/jbuild.mli +++ b/src/jbuild.mli @@ -284,6 +284,16 @@ module Rule : sig } end +module Menhir : sig + type t = + { merge_into : string option + ; flags : String_with_vars.t list + ; 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 diff --git a/src/menhir.ml b/src/menhir.ml new file mode 100644 index 00000000..b857568c --- /dev/null +++ b/src/menhir.ml @@ -0,0 +1,42 @@ +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 + 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 + }) + | 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 + }] diff --git a/src/menhir.mli b/src/menhir.mli new file mode 100644 index 00000000..e57e35d0 --- /dev/null +++ b/src/menhir.mli @@ -0,0 +1,2 @@ + +val to_rules : Jbuild.Menhir.t -> Jbuild.Rule.t list From f06519e231ba28b918ce84b50c9565a4de62397b Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Mon, 5 Mar 2018 19:29:12 +0700 Subject: [PATCH 2/6] 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 From 6d5c2de689369499af9df3756f01eaf5d8df45bd Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Mon, 5 Mar 2018 20:03:16 +0700 Subject: [PATCH 3/6] Change menhir flags to use ordered set language Consistent with how flags are handled elsewhere in jbuilder --- src/jbuild.ml | 4 ++-- src/jbuild.mli | 2 +- src/menhir.ml | 21 +++++++++++++-------- 3 files changed, 16 insertions(+), 11 deletions(-) diff --git a/src/jbuild.ml b/src/jbuild.ml index 4ab84962..ffab7cf7 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -942,7 +942,7 @@ 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 @@ -951,7 +951,7 @@ module Menhir = struct 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 diff --git a/src/jbuild.mli b/src/jbuild.mli index e994d553..1ee4aba3 100644 --- a/src/jbuild.mli +++ b/src/jbuild.mli @@ -287,7 +287,7 @@ end module Menhir : sig 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 diff --git a/src/menhir.ml b/src/menhir.ml index fced8e68..66d31eb1 100644 --- a/src/menhir.ml +++ b/src/menhir.ml @@ -1,17 +1,22 @@ open Import +open Build.O +open! No_io 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 + Super_context.expand_and_eval_set sctx ~scope ~dir t.flags + ~standard:[] 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 + fun ~extra_targets args-> + flags + >>> (Build.run ~extra_targets + menhir + ~dir + ~context:(Super_context.context sctx) + args) 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 @@ -21,7 +26,7 @@ let gen_rules sctx ~dir ~scope (t : Jbuild.Menhir.t) = add_rule_get_targets ( menhir ~extra_targets:(targets name) - [ As flags + [ Dyn (fun x -> As x) ; Dep (mly name)] )) t.modules | Some merge_into -> @@ -29,7 +34,7 @@ let gen_rules sctx ~dir ~scope (t : Jbuild.Menhir.t) = menhir ~extra_targets:(targets merge_into) [ A "--base" ; A merge_into - ; As flags + ; Dyn (fun x -> As x) ; Deps (List.map ~f:mly t.modules) ] ) From dcbfc3766604de6fd1b89c3a139ab43bba99f5bc Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Mon, 5 Mar 2018 20:03:36 +0700 Subject: [PATCH 4/6] Add flags field to menhir test --- test/blackbox-tests/test-cases/menhir/src/jbuild | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/test/blackbox-tests/test-cases/menhir/src/jbuild b/test/blackbox-tests/test-cases/menhir/src/jbuild index 26b07102..2077bb7d 100644 --- a/test/blackbox-tests/test-cases/menhir/src/jbuild +++ b/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) From 4c2768e8056603eff41229374d90d6cc530e067c Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Mon, 5 Mar 2018 14:00:21 +0000 Subject: [PATCH 5/6] style + doc --- src/menhir.ml | 57 +++++++++++++++++++++++++++++++++++--------------- src/menhir.mli | 5 +++++ 2 files changed, 45 insertions(+), 17 deletions(-) diff --git a/src/menhir.ml b/src/menhir.ml index 66d31eb1..710111bf 100644 --- a/src/menhir.ml +++ b/src/menhir.ml @@ -2,33 +2,56 @@ 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//...] where the build happens. + If the [(menhir ...)] appears in [src/jbuild], then [dir] is of the form + [_build//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 - let flags = - Super_context.expand_and_eval_set sctx ~scope ~dir t.flags - ~standard:[] in - let menhir = - let menhir = - Super_context.resolve_program sctx ~hint:"opam install menhir" "menhir" in - fun ~extra_targets args-> - flags - >>> (Build.run ~extra_targets - menhir - ~dir - ~context:(Super_context.context sctx) - args) 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 = - Super_context.add_rule_get_targets sctx ~mode:t.mode ~loc:t.loc in + 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 ~f:(fun name -> + 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)] - )) t.modules + ; Dep (mly name) + ])) | Some merge_into -> add_rule_get_targets ( menhir diff --git a/src/menhir.mli b/src/menhir.mli index 8ad2f850..0699ed1d 100644 --- a/src/menhir.mli +++ b/src/menhir.mli @@ -1,4 +1,9 @@ +(** 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 From 1a4362b0b18363108a91a25c509a78335ed8c3d4 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Mon, 5 Mar 2018 14:00:29 +0000 Subject: [PATCH 6/6] Document Arg_spec a bit more --- src/arg_spec.mli | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/src/arg_spec.mli b/src/arg_spec.mli index 4c6b3fa8..120ed502 100644 --- a/src/arg_spec.mli +++ b/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