From 4bd8fd2204e174b75703fb89226dbf880fcf0914 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Fri, 15 Dec 2023 09:44:49 +0100 Subject: [PATCH 01/18] Add (explain) field to (menhir) stanza MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/dune_rules/menhir/menhir_rules.ml | 13 +++ src/dune_rules/menhir/menhir_stanza.ml | 7 +- src/dune_rules/menhir/menhir_stanza.mli | 1 + .../test-cases/menhir/explain.t | 101 ++++++++++++++++++ 4 files changed, 120 insertions(+), 2 deletions(-) create mode 100644 test/blackbox-tests/test-cases/menhir/explain.t diff --git a/src/dune_rules/menhir/menhir_rules.ml b/src/dune_rules/menhir/menhir_rules.ml index b008bb279d8..e2d38817dd5 100644 --- a/src/dune_rules/menhir/menhir_rules.ml +++ b/src/dune_rules/menhir/menhir_rules.ml @@ -120,6 +120,15 @@ module Run (P : PARAMS) = struct Super_context.add_rule sctx ~dir ~mode ~loc:stanza.loc ;; + let explain_flags base explain = + if explain + then + [ Command.Args.A "--explain" + ; Hidden_targets [ Path.Build.relative dir (base ^ ".conflicts") ] + ] + else [] + ;; + let expand_flags flags = let standard = Action_builder.of_memo @@ Super_context.env_node sctx ~dir >>= Env_node.menhir_flags @@ -225,9 +234,11 @@ module Run (P : PARAMS) = struct let* () = Module_compilation.ocamlc_i ~deps cctx mock_module ~output:(inferred_mli base) in + let explain_flags = explain_flags base stanza.explain in (* 3. A second invocation of Menhir reads the inferred [.mli] file. *) menhir [ Command.Args.dyn expanded_flags + ; S explain_flags ; Deps (sources stanza.modules) ; A "--base" ; Path (Path.relative (Path.build dir) base) @@ -245,8 +256,10 @@ module Run (P : PARAMS) = struct let process1 base ~cmly (stanza : stanza) : unit Memo.t = let expanded_flags = expand_flags stanza.flags in + let explain_flags = explain_flags base stanza.explain in menhir [ Command.Args.dyn expanded_flags + ; S explain_flags ; Deps (sources stanza.modules) ; A "--base" ; Path (Path.relative (Path.build dir) base) diff --git a/src/dune_rules/menhir/menhir_stanza.ml b/src/dune_rules/menhir/menhir_stanza.ml index 48d908b7e71..cc28c8bf4a2 100644 --- a/src/dune_rules/menhir/menhir_stanza.ml +++ b/src/dune_rules/menhir/menhir_stanza.ml @@ -8,6 +8,7 @@ let syntax = ; (1, 1), `Since (1, 4) ; (2, 0), `Since (1, 4) ; (2, 1), `Since (2, 2) + ; (2, 2), `Since (3, 13) ] ;; @@ -21,6 +22,7 @@ type t = ; loc : Loc.t ; infer : bool ; enabled_if : Blang.t + ; explain : bool } let decode = @@ -32,13 +34,14 @@ let decode = and+ infer = field_o_b "infer" ~check:(Dune_lang.Syntax.since syntax (2, 0)) and+ menhir_syntax = Dune_lang.Syntax.get_exn syntax and+ enabled_if = Enabled_if.decode ~allowed_vars:Any ~since:(Some (1, 4)) () - and+ loc = loc in + and+ loc = loc + and+ explain = field_b ~check:(Dune_lang.Syntax.since syntax (2, 2)) "explain" in let infer = match infer with | Some infer -> infer | None -> menhir_syntax >= (2, 0) in - { merge_into; flags; modules; mode; loc; infer; enabled_if }) + { merge_into; flags; modules; mode; loc; infer; enabled_if; explain }) ;; include Stanza.Make (struct diff --git a/src/dune_rules/menhir/menhir_stanza.mli b/src/dune_rules/menhir/menhir_stanza.mli index ccc68291d00..9bb47a657a9 100644 --- a/src/dune_rules/menhir/menhir_stanza.mli +++ b/src/dune_rules/menhir/menhir_stanza.mli @@ -10,6 +10,7 @@ type t = ; loc : Loc.t ; infer : bool ; enabled_if : Blang.t + ; explain : bool } val modules : t -> string list diff --git a/test/blackbox-tests/test-cases/menhir/explain.t b/test/blackbox-tests/test-cases/menhir/explain.t new file mode 100644 index 00000000000..694db3203bf --- /dev/null +++ b/test/blackbox-tests/test-cases/menhir/explain.t @@ -0,0 +1,101 @@ +Support (explain) field in (menhir) stanza to produce .conflicts file: + + $ cat >parser.mly < %token START + > %start start + > %% + > start: START | START { 42 } + > EOF + + $ cat >dune < (menhir (modules parser) (explain)) + > (library (name lib)) + > EOF + +First we check the version guards: + + $ cat >dune-project < (lang dune 3.12) + > (using menhir 2.1) + > EOF + + $ dune build + File "dune", line 1, characters 25-34: + 1 | (menhir (modules parser) (explain)) + ^^^^^^^^^ + Error: 'explain' is only available since version 2.2 of the menhir extension. + Please update your dune-project file to have (using menhir 2.2). + [1] + + $ cat >dune-project < (lang dune 3.12) + > (using menhir 2.2) + > EOF + + $ dune build + File "dune-project", line 2, characters 14-17: + 2 | (using menhir 2.2) + ^^^ + Error: Version 2.2 of the menhir extension is not supported until version + 3.13 of the dune language. + Supported versions of this extension in version 3.12 of the dune language: + - 1.0 to 1.1 + - 2.0 to 2.1 + [1] + + $ cat >dune-project < (lang dune 3.13) + > (using menhir 2.2) + > EOF + + $ dune build + Warning: one state has reduce/reduce conflicts. + Warning: one reduce/reduce conflict was arbitrarily resolved. + File "parser.mly", line 4, characters 15-20: + Warning: production start -> START is never reduced. + Warning: in total, 1 production is never reduced. + +Let's check that the conflicts file has been generated successfully: + + $ cat _build/default/parser.conflicts + + ** Conflict (reduce/reduce) in state 1. + ** Token involved: # + ** This state is reached from start after reading: + + START + + ** The derivations that appear below have the following common factor: + ** (The question mark symbol (?) represents the spot where the derivations begin to differ.) + + start // lookahead token is inherited + (?) + + ** In state 1, looking ahead at #, reducing production + ** start -> START + ** is permitted because of the following sub-derivation: + + START . + + ** In state 1, looking ahead at #, reducing production + ** start -> START + ** is permitted because of the following sub-derivation: + + START . + + +Let's check that it stops being generated if we remove the (explain) field: + + $ cat >dune < (menhir (modules parser)) + > (library (name lib)) + > EOF + + $ dune build + Warning: one state has reduce/reduce conflicts. + Warning: one reduce/reduce conflict was arbitrarily resolved. + File "parser.mly", line 4, characters 15-20: + Warning: production start -> START is never reduced. + Warning: in total, 1 production is never reduced. + + $ ! test -f _build/default/parser.conflicts From 028cabc68ca994a7b4c7aaebdeec24982d65ad2c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Fri, 15 Dec 2023 10:19:52 +0100 Subject: [PATCH 02/18] Doc MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- doc/stanzas/menhir.rst | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/doc/stanzas/menhir.rst b/doc/stanzas/menhir.rst index 9f44f55e2ab..8a446764a78 100644 --- a/doc/stanzas/menhir.rst +++ b/doc/stanzas/menhir.rst @@ -40,4 +40,8 @@ Menhir supports writing the grammar and automation to the ``.cmly`` file. Therefore, if this is flag is passed to Menhir, Dune will know to introduce a ``.cmly`` target for the module. +- ``(explain)`` is used to generate a ``.conflicts`` file explaining any + conflicts found while generating the parser. This option is available since + version 2.2 of the Menhir extension. + .. _menhir-git: https://gitlab.inria.fr/fpottier/menhir From 0b46891d03ab6b3f23d79c81b4245daffeb90943 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Fri, 15 Dec 2023 10:20:00 +0100 Subject: [PATCH 03/18] Also detect --menhir flag MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/dune_rules/menhir/menhir_rules.ml | 23 +++++----- .../test-cases/menhir/explain.t | 44 +++++++++++++++++++ 2 files changed, 56 insertions(+), 11 deletions(-) diff --git a/src/dune_rules/menhir/menhir_rules.ml b/src/dune_rules/menhir/menhir_rules.ml index e2d38817dd5..13d769cb102 100644 --- a/src/dune_rules/menhir/menhir_rules.ml +++ b/src/dune_rules/menhir/menhir_rules.ml @@ -193,7 +193,7 @@ module Run (P : PARAMS) = struct is the three-step process where Menhir is invoked twice and OCaml type inference is performed in between. *) - let process3 base ~cmly (stanza : stanza) : unit Memo.t = + let process3 base ~cmly ~explain (stanza : stanza) : unit Memo.t = let open Memo.O in let expanded_flags = expand_flags stanza.flags in (* 1. A first invocation of Menhir creates a mock [.ml] file. *) @@ -234,7 +234,7 @@ module Run (P : PARAMS) = struct let* () = Module_compilation.ocamlc_i ~deps cctx mock_module ~output:(inferred_mli base) in - let explain_flags = explain_flags base stanza.explain in + let explain_flags = explain_flags base (stanza.explain || explain) in (* 3. A second invocation of Menhir reads the inferred [.mli] file. *) menhir [ Command.Args.dyn expanded_flags @@ -254,9 +254,9 @@ module Run (P : PARAMS) = struct (* [process3 stanza] converts a Menhir stanza into a set of build rules. This is a simpler one-step process where Menhir is invoked directly. *) - let process1 base ~cmly (stanza : stanza) : unit Memo.t = + let process1 base ~cmly ~explain (stanza : stanza) : unit Memo.t = let expanded_flags = expand_flags stanza.flags in - let explain_flags = explain_flags base stanza.explain in + let explain_flags = explain_flags base (stanza.explain || explain) in menhir [ Command.Args.dyn expanded_flags ; S explain_flags @@ -278,22 +278,23 @@ module Run (P : PARAMS) = struct let process (stanza : stanza) : unit Memo.t = let base = Option.value_exn stanza.merge_into in - let ocaml_type_inference_disabled, cmly = + let ocaml_type_inference_disabled, cmly, explain = Ordered_set_lang.Unexpanded.fold_strings stanza.flags - ~init:(false, false) - ~f:(fun pos sw ((only_tokens, cmly) as acc) -> + ~init:(false, false, false) + ~f:(fun pos sw ((only_tokens, cmly, explain) as acc) -> match pos with | Neg -> acc | Pos -> (match String_with_vars.text_only sw with - | Some "--only-tokens" -> true, cmly - | Some "--cmly" -> only_tokens, true + | Some "--only-tokens" -> true, cmly, explain + | Some "--cmly" -> only_tokens, true, explain + | Some "--explain" -> only_tokens, cmly, true | Some _ | None -> acc)) in if ocaml_type_inference_disabled || not stanza.infer - then process1 base stanza ~cmly - else process3 base stanza ~cmly + then process1 base stanza ~cmly ~explain + else process3 base stanza ~cmly ~explain ;; (* ------------------------------------------------------------------------ *) diff --git a/test/blackbox-tests/test-cases/menhir/explain.t b/test/blackbox-tests/test-cases/menhir/explain.t index 694db3203bf..52763a9010c 100644 --- a/test/blackbox-tests/test-cases/menhir/explain.t +++ b/test/blackbox-tests/test-cases/menhir/explain.t @@ -84,6 +84,9 @@ Let's check that the conflicts file has been generated successfully: START . + + + Let's check that it stops being generated if we remove the (explain) field: $ cat >dune <dune < (menhir (modules parser) (flags --explain)) + > (library (name lib)) + > EOF + + $ dune build + Warning: one state has reduce/reduce conflicts. + Warning: one reduce/reduce conflict was arbitrarily resolved. + File "parser.mly", line 4, characters 15-20: + Warning: production start -> START is never reduced. + Warning: in total, 1 production is never reduced. + + $ cat _build/default/parser.conflicts + + ** Conflict (reduce/reduce) in state 1. + ** Token involved: # + ** This state is reached from start after reading: + + START + + ** The derivations that appear below have the following common factor: + ** (The question mark symbol (?) represents the spot where the derivations begin to differ.) + + start // lookahead token is inherited + (?) + + ** In state 1, looking ahead at #, reducing production + ** start -> START + ** is permitted because of the following sub-derivation: + + START . + + ** In state 1, looking ahead at #, reducing production + ** start -> START + ** is permitted because of the following sub-derivation: + + START . + From 72de97e2bccd666b91bab4542f8bdb355559cbda Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Fri, 15 Dec 2023 13:33:25 +0100 Subject: [PATCH 04/18] Revert "Also detect --menhir flag" MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This reverts commit 0b46891d03ab6b3f23d79c81b4245daffeb90943. Signed-off-by: Nicolás Ojeda Bär --- src/dune_rules/menhir/menhir_rules.ml | 23 +++++----- .../test-cases/menhir/explain.t | 44 ------------------- 2 files changed, 11 insertions(+), 56 deletions(-) diff --git a/src/dune_rules/menhir/menhir_rules.ml b/src/dune_rules/menhir/menhir_rules.ml index 13d769cb102..e2d38817dd5 100644 --- a/src/dune_rules/menhir/menhir_rules.ml +++ b/src/dune_rules/menhir/menhir_rules.ml @@ -193,7 +193,7 @@ module Run (P : PARAMS) = struct is the three-step process where Menhir is invoked twice and OCaml type inference is performed in between. *) - let process3 base ~cmly ~explain (stanza : stanza) : unit Memo.t = + let process3 base ~cmly (stanza : stanza) : unit Memo.t = let open Memo.O in let expanded_flags = expand_flags stanza.flags in (* 1. A first invocation of Menhir creates a mock [.ml] file. *) @@ -234,7 +234,7 @@ module Run (P : PARAMS) = struct let* () = Module_compilation.ocamlc_i ~deps cctx mock_module ~output:(inferred_mli base) in - let explain_flags = explain_flags base (stanza.explain || explain) in + let explain_flags = explain_flags base stanza.explain in (* 3. A second invocation of Menhir reads the inferred [.mli] file. *) menhir [ Command.Args.dyn expanded_flags @@ -254,9 +254,9 @@ module Run (P : PARAMS) = struct (* [process3 stanza] converts a Menhir stanza into a set of build rules. This is a simpler one-step process where Menhir is invoked directly. *) - let process1 base ~cmly ~explain (stanza : stanza) : unit Memo.t = + let process1 base ~cmly (stanza : stanza) : unit Memo.t = let expanded_flags = expand_flags stanza.flags in - let explain_flags = explain_flags base (stanza.explain || explain) in + let explain_flags = explain_flags base stanza.explain in menhir [ Command.Args.dyn expanded_flags ; S explain_flags @@ -278,23 +278,22 @@ module Run (P : PARAMS) = struct let process (stanza : stanza) : unit Memo.t = let base = Option.value_exn stanza.merge_into in - let ocaml_type_inference_disabled, cmly, explain = + let ocaml_type_inference_disabled, cmly = Ordered_set_lang.Unexpanded.fold_strings stanza.flags - ~init:(false, false, false) - ~f:(fun pos sw ((only_tokens, cmly, explain) as acc) -> + ~init:(false, false) + ~f:(fun pos sw ((only_tokens, cmly) as acc) -> match pos with | Neg -> acc | Pos -> (match String_with_vars.text_only sw with - | Some "--only-tokens" -> true, cmly, explain - | Some "--cmly" -> only_tokens, true, explain - | Some "--explain" -> only_tokens, cmly, true + | Some "--only-tokens" -> true, cmly + | Some "--cmly" -> only_tokens, true | Some _ | None -> acc)) in if ocaml_type_inference_disabled || not stanza.infer - then process1 base stanza ~cmly ~explain - else process3 base stanza ~cmly ~explain + then process1 base stanza ~cmly + else process3 base stanza ~cmly ;; (* ------------------------------------------------------------------------ *) diff --git a/test/blackbox-tests/test-cases/menhir/explain.t b/test/blackbox-tests/test-cases/menhir/explain.t index 52763a9010c..694db3203bf 100644 --- a/test/blackbox-tests/test-cases/menhir/explain.t +++ b/test/blackbox-tests/test-cases/menhir/explain.t @@ -84,9 +84,6 @@ Let's check that the conflicts file has been generated successfully: START . - - - Let's check that it stops being generated if we remove the (explain) field: $ cat >dune <dune < (menhir (modules parser) (flags --explain)) - > (library (name lib)) - > EOF - - $ dune build - Warning: one state has reduce/reduce conflicts. - Warning: one reduce/reduce conflict was arbitrarily resolved. - File "parser.mly", line 4, characters 15-20: - Warning: production start -> START is never reduced. - Warning: in total, 1 production is never reduced. - - $ cat _build/default/parser.conflicts - - ** Conflict (reduce/reduce) in state 1. - ** Token involved: # - ** This state is reached from start after reading: - - START - - ** The derivations that appear below have the following common factor: - ** (The question mark symbol (?) represents the spot where the derivations begin to differ.) - - start // lookahead token is inherited - (?) - - ** In state 1, looking ahead at #, reducing production - ** start -> START - ** is permitted because of the following sub-derivation: - - START . - - ** In state 1, looking ahead at #, reducing production - ** start -> START - ** is permitted because of the following sub-derivation: - - START . - From 2626c7a6c45450b538cf367e7f8ae2e94fc5848e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Fri, 15 Dec 2023 13:39:33 +0100 Subject: [PATCH 05/18] Switch to (explain ) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- doc/stanzas/menhir.rst | 2 +- src/dune_rules/menhir/menhir_stanza.ml | 7 +++++- .../test-cases/menhir/explain.t | 22 +++++++++++++++---- 3 files changed, 25 insertions(+), 6 deletions(-) diff --git a/doc/stanzas/menhir.rst b/doc/stanzas/menhir.rst index 8a446764a78..f54bb56f069 100644 --- a/doc/stanzas/menhir.rst +++ b/doc/stanzas/menhir.rst @@ -40,7 +40,7 @@ Menhir supports writing the grammar and automation to the ``.cmly`` file. Therefore, if this is flag is passed to Menhir, Dune will know to introduce a ``.cmly`` target for the module. -- ``(explain)`` is used to generate a ``.conflicts`` file explaining any +- ``(explain )`` is used to generate a ``.conflicts`` file explaining any conflicts found while generating the parser. This option is available since version 2.2 of the Menhir extension. diff --git a/src/dune_rules/menhir/menhir_stanza.ml b/src/dune_rules/menhir/menhir_stanza.ml index cc28c8bf4a2..fd9ace0332b 100644 --- a/src/dune_rules/menhir/menhir_stanza.ml +++ b/src/dune_rules/menhir/menhir_stanza.ml @@ -35,12 +35,17 @@ let decode = and+ menhir_syntax = Dune_lang.Syntax.get_exn syntax and+ enabled_if = Enabled_if.decode ~allowed_vars:Any ~since:(Some (1, 4)) () and+ loc = loc - and+ explain = field_b ~check:(Dune_lang.Syntax.since syntax (2, 2)) "explain" in + and+ explain = field_o "explain" (Dune_lang.Syntax.since syntax (2, 2) >>> bool) in let infer = match infer with | Some infer -> infer | None -> menhir_syntax >= (2, 0) in + let explain = + match explain with + | None -> false + | Some explain -> explain + in { merge_into; flags; modules; mode; loc; infer; enabled_if; explain }) ;; diff --git a/test/blackbox-tests/test-cases/menhir/explain.t b/test/blackbox-tests/test-cases/menhir/explain.t index 694db3203bf..04f82fcbce8 100644 --- a/test/blackbox-tests/test-cases/menhir/explain.t +++ b/test/blackbox-tests/test-cases/menhir/explain.t @@ -8,7 +8,7 @@ Support (explain) field in (menhir) stanza to produce .conflicts file: > EOF $ cat >dune < (menhir (modules parser) (explain)) + > (menhir (modules parser) (explain true)) > (library (name lib)) > EOF @@ -20,9 +20,9 @@ First we check the version guards: > EOF $ dune build - File "dune", line 1, characters 25-34: - 1 | (menhir (modules parser) (explain)) - ^^^^^^^^^ + File "dune", line 1, characters 25-39: + 1 | (menhir (modules parser) (explain true)) + ^^^^^^^^^^^^^^ Error: 'explain' is only available since version 2.2 of the menhir extension. Please update your dune-project file to have (using menhir 2.2). [1] @@ -84,6 +84,9 @@ Let's check that the conflicts file has been generated successfully: START . + + + Let's check that it stops being generated if we remove the (explain) field: $ cat >dune <dune < (menhir (modules parser) (explain false)) + > (library (name lib)) + > EOF + + $ dune build + + $ ! test -f _build/default/parser.conflicts From 4a32150e1667df0641517b0fdc939fc1441f0c64 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Fri, 15 Dec 2023 13:55:50 +0100 Subject: [PATCH 06/18] Generate file by default MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- doc/stanzas/menhir.rst | 7 +-- src/dune_rules/menhir/menhir_stanza.ml | 3 +- .../test-cases/menhir/explain.t | 50 +++++++++++++++++-- 3 files changed, 52 insertions(+), 8 deletions(-) diff --git a/doc/stanzas/menhir.rst b/doc/stanzas/menhir.rst index f54bb56f069..83539c1b757 100644 --- a/doc/stanzas/menhir.rst +++ b/doc/stanzas/menhir.rst @@ -40,8 +40,9 @@ Menhir supports writing the grammar and automation to the ``.cmly`` file. Therefore, if this is flag is passed to Menhir, Dune will know to introduce a ``.cmly`` target for the module. -- ``(explain )`` is used to generate a ``.conflicts`` file explaining any - conflicts found while generating the parser. This option is available since - version 2.2 of the Menhir extension. +- ``(explain )`` is used to control the generation of the ``.conflicts`` + file explaining conflicts found while generating the parser. This option is + available since version 2.2 of the Menhir extension. This file is generated by + default starting at version 3.13 of the Dune language. .. _menhir-git: https://gitlab.inria.fr/fpottier/menhir diff --git a/src/dune_rules/menhir/menhir_stanza.ml b/src/dune_rules/menhir/menhir_stanza.ml index fd9ace0332b..6167cb5145a 100644 --- a/src/dune_rules/menhir/menhir_stanza.ml +++ b/src/dune_rules/menhir/menhir_stanza.ml @@ -33,6 +33,7 @@ let decode = and+ mode = Rule_mode_decoder.field and+ infer = field_o_b "infer" ~check:(Dune_lang.Syntax.since syntax (2, 0)) and+ menhir_syntax = Dune_lang.Syntax.get_exn syntax + and+ dune_syntax = Dune_lang.Syntax.get_exn Stanza.syntax and+ enabled_if = Enabled_if.decode ~allowed_vars:Any ~since:(Some (1, 4)) () and+ loc = loc and+ explain = field_o "explain" (Dune_lang.Syntax.since syntax (2, 2) >>> bool) in @@ -43,7 +44,7 @@ let decode = in let explain = match explain with - | None -> false + | None -> dune_syntax >= (3, 13) | Some explain -> explain in { merge_into; flags; modules; mode; loc; infer; enabled_if; explain }) diff --git a/test/blackbox-tests/test-cases/menhir/explain.t b/test/blackbox-tests/test-cases/menhir/explain.t index 04f82fcbce8..5adce8f87af 100644 --- a/test/blackbox-tests/test-cases/menhir/explain.t +++ b/test/blackbox-tests/test-cases/menhir/explain.t @@ -87,10 +87,11 @@ Let's check that the conflicts file has been generated successfully: -Let's check that it stops being generated if we remove the (explain) field: + +Let's check we can also pass `(explain false)`: $ cat >dune < (menhir (modules parser)) + > (menhir (modules parser) (explain false)) > (library (name lib)) > EOF @@ -103,13 +104,54 @@ Let's check that it stops being generated if we remove the (explain) field: $ ! test -f _build/default/parser.conflicts -Let's check we can also pass `(explain false)`: +Let's check that it is generated by default if we omit the (explain) field: $ cat >dune < (menhir (modules parser) (explain false)) + > (menhir (modules parser)) > (library (name lib)) > EOF + $ dune build + Warning: one state has reduce/reduce conflicts. + Warning: one reduce/reduce conflict was arbitrarily resolved. + File "parser.mly", line 4, characters 15-20: + Warning: production start -> START is never reduced. + Warning: in total, 1 production is never reduced. + + $ cat _build/default/parser.conflicts + + ** Conflict (reduce/reduce) in state 1. + ** Token involved: # + ** This state is reached from start after reading: + + START + + ** The derivations that appear below have the following common factor: + ** (The question mark symbol (?) represents the spot where the derivations begin to differ.) + + start // lookahead token is inherited + (?) + + ** In state 1, looking ahead at #, reducing production + ** start -> START + ** is permitted because of the following sub-derivation: + + START . + + ** In state 1, looking ahead at #, reducing production + ** start -> START + ** is permitted because of the following sub-derivation: + + START . + + +... but only if the Dune version is recent enough: + + $ cat >dune-project < (lang dune 3.12) + > (using menhir 2.1) + > EOF + $ dune build $ ! test -f _build/default/parser.conflicts From 922c58013301eee8bd20a2ecc327e59a40325bf8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Fri, 15 Dec 2023 21:43:52 +0100 Subject: [PATCH 07/18] Control the default with the version of the Menhir extension MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/dune_rules/menhir/menhir_stanza.ml | 3 +-- test/blackbox-tests/test-cases/menhir/explain.t | 4 +++- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/src/dune_rules/menhir/menhir_stanza.ml b/src/dune_rules/menhir/menhir_stanza.ml index 6167cb5145a..ffbe8ca747d 100644 --- a/src/dune_rules/menhir/menhir_stanza.ml +++ b/src/dune_rules/menhir/menhir_stanza.ml @@ -33,7 +33,6 @@ let decode = and+ mode = Rule_mode_decoder.field and+ infer = field_o_b "infer" ~check:(Dune_lang.Syntax.since syntax (2, 0)) and+ menhir_syntax = Dune_lang.Syntax.get_exn syntax - and+ dune_syntax = Dune_lang.Syntax.get_exn Stanza.syntax and+ enabled_if = Enabled_if.decode ~allowed_vars:Any ~since:(Some (1, 4)) () and+ loc = loc and+ explain = field_o "explain" (Dune_lang.Syntax.since syntax (2, 2) >>> bool) in @@ -44,7 +43,7 @@ let decode = in let explain = match explain with - | None -> dune_syntax >= (3, 13) + | None -> menhir_syntax >= (2, 2) | Some explain -> explain in { merge_into; flags; modules; mode; loc; infer; enabled_if; explain }) diff --git a/test/blackbox-tests/test-cases/menhir/explain.t b/test/blackbox-tests/test-cases/menhir/explain.t index 5adce8f87af..6db0eee26b1 100644 --- a/test/blackbox-tests/test-cases/menhir/explain.t +++ b/test/blackbox-tests/test-cases/menhir/explain.t @@ -88,6 +88,7 @@ Let's check that the conflicts file has been generated successfully: + Let's check we can also pass `(explain false)`: $ cat >dune <dune-project < (lang dune 3.12) + > (lang dune 3.13) > (using menhir 2.1) > EOF From 045407fd86139b5d0579c5bd2acc8c21062731bb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Fri, 15 Dec 2023 22:00:00 +0100 Subject: [PATCH 08/18] Allow (explain ) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/dune_rules/menhir/menhir_rules.ml | 8 ++++++-- src/dune_rules/menhir/menhir_stanza.ml | 8 +++++--- src/dune_rules/menhir/menhir_stanza.mli | 2 +- .../blackbox-tests/test-cases/menhir/explain.t | 18 ++++++++++++++++++ 4 files changed, 30 insertions(+), 6 deletions(-) diff --git a/src/dune_rules/menhir/menhir_rules.ml b/src/dune_rules/menhir/menhir_rules.ml index e2d38817dd5..0bd3b74a4e2 100644 --- a/src/dune_rules/menhir/menhir_rules.ml +++ b/src/dune_rules/menhir/menhir_rules.ml @@ -121,6 +121,9 @@ module Run (P : PARAMS) = struct ;; let explain_flags base explain = + let open Memo.O in + let* expander = expander in + let+ explain = Expander.eval_blang expander explain in if explain then [ Command.Args.A "--explain" @@ -234,7 +237,7 @@ module Run (P : PARAMS) = struct let* () = Module_compilation.ocamlc_i ~deps cctx mock_module ~output:(inferred_mli base) in - let explain_flags = explain_flags base stanza.explain in + let* explain_flags = explain_flags base stanza.explain in (* 3. A second invocation of Menhir reads the inferred [.mli] file. *) menhir [ Command.Args.dyn expanded_flags @@ -255,8 +258,9 @@ module Run (P : PARAMS) = struct is a simpler one-step process where Menhir is invoked directly. *) let process1 base ~cmly (stanza : stanza) : unit Memo.t = + let open Memo.O in let expanded_flags = expand_flags stanza.flags in - let explain_flags = explain_flags base stanza.explain in + let* explain_flags = explain_flags base stanza.explain in menhir [ Command.Args.dyn expanded_flags ; S explain_flags diff --git a/src/dune_rules/menhir/menhir_stanza.ml b/src/dune_rules/menhir/menhir_stanza.ml index ffbe8ca747d..94a1f61bff3 100644 --- a/src/dune_rules/menhir/menhir_stanza.ml +++ b/src/dune_rules/menhir/menhir_stanza.ml @@ -22,7 +22,7 @@ type t = ; loc : Loc.t ; infer : bool ; enabled_if : Blang.t - ; explain : bool + ; explain : Blang.t } let decode = @@ -35,7 +35,9 @@ let decode = and+ menhir_syntax = Dune_lang.Syntax.get_exn syntax and+ enabled_if = Enabled_if.decode ~allowed_vars:Any ~since:(Some (1, 4)) () and+ loc = loc - and+ explain = field_o "explain" (Dune_lang.Syntax.since syntax (2, 2) >>> bool) in + and+ explain = + field_o "explain" (Dune_lang.Syntax.since syntax (2, 2) >>> Blang.decode) + in let infer = match infer with | Some infer -> infer @@ -43,7 +45,7 @@ let decode = in let explain = match explain with - | None -> menhir_syntax >= (2, 2) + | None -> if menhir_syntax >= (2, 2) then Blang.true_ else Blang.false_ | Some explain -> explain in { merge_into; flags; modules; mode; loc; infer; enabled_if; explain }) diff --git a/src/dune_rules/menhir/menhir_stanza.mli b/src/dune_rules/menhir/menhir_stanza.mli index 9bb47a657a9..df42a1c5093 100644 --- a/src/dune_rules/menhir/menhir_stanza.mli +++ b/src/dune_rules/menhir/menhir_stanza.mli @@ -10,7 +10,7 @@ type t = ; loc : Loc.t ; infer : bool ; enabled_if : Blang.t - ; explain : bool + ; explain : Blang.t } val modules : t -> string list diff --git a/test/blackbox-tests/test-cases/menhir/explain.t b/test/blackbox-tests/test-cases/menhir/explain.t index 6db0eee26b1..71c9c08f5cd 100644 --- a/test/blackbox-tests/test-cases/menhir/explain.t +++ b/test/blackbox-tests/test-cases/menhir/explain.t @@ -89,6 +89,7 @@ Let's check that the conflicts file has been generated successfully: + Let's check we can also pass `(explain false)`: $ cat >dune <dune-project <dune-project < (lang dune 3.13) + > (using menhir 2.2) + > EOF + + $ cat >dune < (menhir (modules parser) (explain (= true false))) + > (library (name lib)) + > EOF + + $ dune build + + $ ! test -f _build/default/parser.conflicts From 3c42b015b13f093dd82c0988fcb05343fbeb419f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Fri, 15 Dec 2023 22:06:28 +0100 Subject: [PATCH 09/18] Doc MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- doc/stanzas/menhir.rst | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/doc/stanzas/menhir.rst b/doc/stanzas/menhir.rst index 83539c1b757..7d73057325c 100644 --- a/doc/stanzas/menhir.rst +++ b/doc/stanzas/menhir.rst @@ -40,9 +40,13 @@ Menhir supports writing the grammar and automation to the ``.cmly`` file. Therefore, if this is flag is passed to Menhir, Dune will know to introduce a ``.cmly`` target for the module. -- ``(explain )`` is used to control the generation of the ``.conflicts`` - file explaining conflicts found while generating the parser. This option is - available since version 2.2 of the Menhir extension. This file is generated by - default starting at version 3.13 of the Dune language. +- ``(explain )`` is used to control the generation of the + ``.conflicts`` file explaining conflicts found while generating the + parser. The condition is specified using the + :doc:`reference/boolean-language`. This option is available since version 2.2 + of the Menhir extension. + +Note that starting in version 2.2 of the Menhir extension, the ``.conflicts`` is +generated by default and needs to be disabled explicitly if this is not desired. .. _menhir-git: https://gitlab.inria.fr/fpottier/menhir From 560a1a9aecdd60e11d13012a6ee11d4aa720dd02 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Fri, 15 Dec 2023 22:22:17 +0100 Subject: [PATCH 10/18] Warn if passing --explain under the new mode MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/dune_rules/menhir/menhir_rules.ml | 10 ++++++++ src/dune_rules/menhir/menhir_stanza.ml | 7 ++++-- src/dune_rules/menhir/menhir_stanza.mli | 2 ++ .../test-cases/menhir/explain.t | 24 +++++++++++++++++++ 4 files changed, 41 insertions(+), 2 deletions(-) diff --git a/src/dune_rules/menhir/menhir_rules.ml b/src/dune_rules/menhir/menhir_rules.ml index 0bd3b74a4e2..da67bf31544 100644 --- a/src/dune_rules/menhir/menhir_rules.ml +++ b/src/dune_rules/menhir/menhir_rules.ml @@ -293,6 +293,16 @@ module Run (P : PARAMS) = struct (match String_with_vars.text_only sw with | Some "--only-tokens" -> true, cmly | Some "--cmly" -> only_tokens, true + | Some "--explain" -> + if stanza.menhir_syntax >= Menhir_stanza.explain_since + then + User_warning.emit + [ Pp.textf + "Note that the Menhir '.conflicts' file is generated by default, \ + so the '--explain' flag should not be explicitly added to the \ + list of Menhir flags." + ]; + acc | Some _ | None -> acc)) in if ocaml_type_inference_disabled || not stanza.infer diff --git a/src/dune_rules/menhir/menhir_stanza.ml b/src/dune_rules/menhir/menhir_stanza.ml index 94a1f61bff3..487f982ee8e 100644 --- a/src/dune_rules/menhir/menhir_stanza.ml +++ b/src/dune_rules/menhir/menhir_stanza.ml @@ -23,8 +23,11 @@ type t = ; infer : bool ; enabled_if : Blang.t ; explain : Blang.t + ; menhir_syntax : Syntax.Version.t } +let explain_since = 2, 2 + let decode = fields (let+ merge_into = field_o "merge_into" string @@ -36,7 +39,7 @@ let decode = and+ enabled_if = Enabled_if.decode ~allowed_vars:Any ~since:(Some (1, 4)) () and+ loc = loc and+ explain = - field_o "explain" (Dune_lang.Syntax.since syntax (2, 2) >>> Blang.decode) + field_o "explain" (Dune_lang.Syntax.since syntax explain_since >>> Blang.decode) in let infer = match infer with @@ -48,7 +51,7 @@ let decode = | None -> if menhir_syntax >= (2, 2) then Blang.true_ else Blang.false_ | Some explain -> explain in - { merge_into; flags; modules; mode; loc; infer; enabled_if; explain }) + { merge_into; flags; modules; mode; loc; infer; enabled_if; explain; menhir_syntax }) ;; include Stanza.Make (struct diff --git a/src/dune_rules/menhir/menhir_stanza.mli b/src/dune_rules/menhir/menhir_stanza.mli index df42a1c5093..82fd1b2c6cf 100644 --- a/src/dune_rules/menhir/menhir_stanza.mli +++ b/src/dune_rules/menhir/menhir_stanza.mli @@ -11,8 +11,10 @@ type t = ; infer : bool ; enabled_if : Blang.t ; explain : Blang.t + ; menhir_syntax : Syntax.Version.t } +val explain_since : Syntax.Version.t val modules : t -> string list (** Return the list of targets that are generated by this stanza. This list of diff --git a/test/blackbox-tests/test-cases/menhir/explain.t b/test/blackbox-tests/test-cases/menhir/explain.t index 71c9c08f5cd..e56e89bc121 100644 --- a/test/blackbox-tests/test-cases/menhir/explain.t +++ b/test/blackbox-tests/test-cases/menhir/explain.t @@ -90,6 +90,7 @@ Let's check that the conflicts file has been generated successfully: + Let's check we can also pass `(explain false)`: $ cat >dune <dune-project <dune-project < (lang dune 3.13) + > (using menhir 2.2) + > EOF + + $ cat >dune < (menhir (modules parser) (flags --explain)) + > (library (name lib)) + > EOF + + $ dune build + Warning: Note that the Menhir '.conflicts' file is generated by default, so + the '--explain' flag should not be explicitly added to the list of Menhir + flags. + Warning: one state has reduce/reduce conflicts. + Warning: one reduce/reduce conflict was arbitrarily resolved. + File "parser.mly", line 4, characters 15-20: + Warning: production start -> START is never reduced. + Warning: in total, 1 production is never reduced. From 683c645a5f325927a0fbcda97e6e3fc31763683b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Fri, 15 Dec 2023 22:25:47 +0100 Subject: [PATCH 11/18] Changes MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- doc/changes/9512.md | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 doc/changes/9512.md diff --git a/doc/changes/9512.md b/doc/changes/9512.md new file mode 100644 index 00000000000..736b18a3a3c --- /dev/null +++ b/doc/changes/9512.md @@ -0,0 +1,3 @@ +- Menhir: generate `.conflicts` file by default. Add new field to the `(menhir)` + stanza to control the generation of this file: `(explain )`. + (#9512, @nojb) From 571412f6ada02f15f756bb091dca21e821a3c8f6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Fri, 15 Dec 2023 22:28:03 +0100 Subject: [PATCH 12/18] Cleanup MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/dune_rules/menhir/menhir_stanza.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dune_rules/menhir/menhir_stanza.ml b/src/dune_rules/menhir/menhir_stanza.ml index 487f982ee8e..9774b4f6a73 100644 --- a/src/dune_rules/menhir/menhir_stanza.ml +++ b/src/dune_rules/menhir/menhir_stanza.ml @@ -48,7 +48,7 @@ let decode = in let explain = match explain with - | None -> if menhir_syntax >= (2, 2) then Blang.true_ else Blang.false_ + | None -> if menhir_syntax >= explain_since then Blang.true_ else Blang.false_ | Some explain -> explain in { merge_into; flags; modules; mode; loc; infer; enabled_if; explain; menhir_syntax }) From 67f006e5d5f3f3fac3abf03e83fa160db1e64bf7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Fri, 15 Dec 2023 22:31:19 +0100 Subject: [PATCH 13/18] Less verbose tests MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- .../test-cases/menhir/explain.t | 64 +------------------ 1 file changed, 2 insertions(+), 62 deletions(-) diff --git a/test/blackbox-tests/test-cases/menhir/explain.t b/test/blackbox-tests/test-cases/menhir/explain.t index e56e89bc121..e5be15bb48e 100644 --- a/test/blackbox-tests/test-cases/menhir/explain.t +++ b/test/blackbox-tests/test-cases/menhir/explain.t @@ -57,39 +57,7 @@ First we check the version guards: Let's check that the conflicts file has been generated successfully: - $ cat _build/default/parser.conflicts - - ** Conflict (reduce/reduce) in state 1. - ** Token involved: # - ** This state is reached from start after reading: - - START - - ** The derivations that appear below have the following common factor: - ** (The question mark symbol (?) represents the spot where the derivations begin to differ.) - - start // lookahead token is inherited - (?) - - ** In state 1, looking ahead at #, reducing production - ** start -> START - ** is permitted because of the following sub-derivation: - - START . - - ** In state 1, looking ahead at #, reducing production - ** start -> START - ** is permitted because of the following sub-derivation: - - START . - - - - - - - - + $ test -f _build/default/parser.conflicts Let's check we can also pass `(explain false)`: @@ -121,35 +89,7 @@ Let's check that it is generated by default if we omit the (explain) field: Warning: production start -> START is never reduced. Warning: in total, 1 production is never reduced. - $ cat _build/default/parser.conflicts - - ** Conflict (reduce/reduce) in state 1. - ** Token involved: # - ** This state is reached from start after reading: - - START - - ** The derivations that appear below have the following common factor: - ** (The question mark symbol (?) represents the spot where the derivations begin to differ.) - - start // lookahead token is inherited - (?) - - ** In state 1, looking ahead at #, reducing production - ** start -> START - ** is permitted because of the following sub-derivation: - - START . - - ** In state 1, looking ahead at #, reducing production - ** start -> START - ** is permitted because of the following sub-derivation: - - START . - - - - + $ test -f _build/default/parser.conflicts ... but only if the Dune version is recent enough: From 4aafa94148fb84f2e4f4daf1c6e0feb1a00168ad Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Sat, 16 Dec 2023 14:19:38 +0100 Subject: [PATCH 14/18] Introduce (menhir) field in (env) stanza MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- bin/printenv.ml | 7 +- doc/changes/9512.md | 3 + doc/stanzas/env.rst | 8 +- src/dune_lang/blang.ml | 15 +++ src/dune_lang/blang.mli | 1 + src/dune_rules/dune_env.ml | 38 ++++-- src/dune_rules/dune_env.mli | 2 +- src/dune_rules/dune_rules.ml | 1 + src/dune_rules/env_node.ml | 25 ++-- src/dune_rules/env_node.mli | 2 +- src/dune_rules/menhir/menhir_env.ml | 34 +++++ src/dune_rules/menhir/menhir_env.mli | 13 ++ src/dune_rules/menhir/menhir_rules.ml | 53 ++++---- src/dune_rules/menhir/menhir_stanza.ml | 7 +- src/dune_rules/menhir/menhir_stanza.mli | 2 +- .../test-cases/menhir/explain.t/parser.mly | 4 + .../menhir/{explain.t => explain.t/run.t} | 124 +++++++++++++----- 17 files changed, 251 insertions(+), 88 deletions(-) create mode 100644 src/dune_rules/menhir/menhir_env.ml create mode 100644 src/dune_rules/menhir/menhir_env.mli create mode 100644 test/blackbox-tests/test-cases/menhir/explain.t/parser.mly rename test/blackbox-tests/test-cases/menhir/{explain.t => explain.t/run.t} (53%) diff --git a/bin/printenv.ml b/bin/printenv.ml index fb32e79cc64..ea8ff12be24 100644 --- a/bin/printenv.ml +++ b/bin/printenv.ml @@ -7,12 +7,13 @@ let dump sctx ~dir = let module Link_flags = Dune_rules.Link_flags in let module Ocaml_flags = Dune_rules.Ocaml_flags in let module Js_of_ocaml = Dune_rules.Js_of_ocaml in + let module Menhir_env = Dune_rules.Menhir_env in let node = Super_context.env_node sctx ~dir in let open Memo.O in let ocaml_flags = node >>= Env_node.ocaml_flags in let foreign_flags = node >>| Env_node.foreign_flags in let link_flags = node >>= Env_node.link_flags in - let menhir_flags = node >>| Env_node.menhir_flags in + let menhir = node >>= Env_node.menhir in let coq_flags = node >>= Env_node.coq_flags in let js_of_ocaml = node >>= Env_node.js_of_ocaml in let open Action_builder.O in @@ -30,8 +31,8 @@ let dump sctx ~dir = let* link_flags = Action_builder.of_memo link_flags in Link_flags.dump link_flags and+ menhir_dump = - let+ flags = Action_builder.of_memo_join menhir_flags in - [ "menhir_flags", flags ] |> List.map ~f:Dune_lang.Encoder.(pair string (list string)) + let* env = Action_builder.of_memo menhir in + Menhir_env.dump env and+ coq_dump = Action_builder.of_memo_join coq_flags >>| Dune_rules.Coq.Coq_flags.dump and+ jsoo_dump = let* jsoo = Action_builder.of_memo js_of_ocaml in diff --git a/doc/changes/9512.md b/doc/changes/9512.md index 736b18a3a3c..0ea0c94f1df 100644 --- a/doc/changes/9512.md +++ b/doc/changes/9512.md @@ -1,3 +1,6 @@ - Menhir: generate `.conflicts` file by default. Add new field to the `(menhir)` stanza to control the generation of this file: `(explain )`. + Introduce `(menhir (flags ...) (explain ...))` field in the `(env)` stanza, + delete `(menhir_flags)` field. All changes are guarded under a new version of + the Menhir extension, 2.2. (#9512, @nojb) diff --git a/doc/stanzas/env.rst b/doc/stanzas/env.rst index 370ce3adbbb..1ae1c33e7e6 100644 --- a/doc/stanzas/env.rst +++ b/doc/stanzas/env.rst @@ -32,7 +32,13 @@ Fields supported in ```` are: variables to the environment where the build commands are executed and are used by ``dune exec``. -- ``(menhir_flags ))`` specifies flags for Menhir stanzas. +- ``(menhir_flags ))`` specifies flags for Menhir stanzas. This flag was + replaced by the ``(menhir)`` field (see below) starting in version 2.2 of the + Menhir extension. + +- ``(menhir (flags ))`` specifies the Menhir + settings. See `menhir`_ for more details. This field was introduced in version + 2.2 of the Menhir extension. - ``(js_of_ocaml (flags )(build_runtime )(link_flags ))`` specifies ``js_of_ocaml`` flags. See `jsoo-field`_ for more details. diff --git a/src/dune_lang/blang.ml b/src/dune_lang/blang.ml index a3cad320a2d..d9d9f7c7134 100644 --- a/src/dune_lang/blang.ml +++ b/src/dune_lang/blang.ml @@ -15,6 +15,20 @@ module Ast = struct let true_ = Const true let false_ = Const false + let rec equal f t1 t2 = + match t1, t2 with + | Const b1, Const b2 -> Bool.equal b1 b2 + | Not t1, Not t2 -> equal f t1 t2 + | Expr x1, Expr x2 -> f x1 x2 + | And tl1, And tl2 | Or tl1, Or tl2 -> + (match List.for_all2 ~f:(equal f) tl1 tl2 with + | Ok b -> b + | Error `Length_mismatch -> false) + | Compare (op1, x1, y1), Compare (op2, x2, y2) -> + Relop.equal op1 op2 && f x1 x2 && f y1 y2 + | (Const _ | Not _ | Expr _ | And _ | Or _ | Compare _), _ -> false + ;; + let rec to_dyn string_to_dyn = let open Dyn in function @@ -72,3 +86,4 @@ let false_ = Ast.false_ let to_dyn = Ast.to_dyn String_with_vars.to_dyn let decode = Ast.decode String_with_vars.decode let encode = Ast.encode String_with_vars.encode +let equal = Ast.equal String_with_vars.equal diff --git a/src/dune_lang/blang.mli b/src/dune_lang/blang.mli index e59d0c80c98..c4b560d8739 100644 --- a/src/dune_lang/blang.mli +++ b/src/dune_lang/blang.mli @@ -18,6 +18,7 @@ val false_ : t val to_dyn : t -> Dyn.t val decode : t Decoder.t val encode : t Encoder.t +val equal : t -> t -> bool module Ast : sig type 'string t = 'string ast diff --git a/src/dune_rules/dune_env.ml b/src/dune_rules/dune_env.ml index 0a219f9133e..1bfe8e48fcd 100644 --- a/src/dune_rules/dune_env.ml +++ b/src/dune_rules/dune_env.ml @@ -10,12 +10,14 @@ let foreign_flags ~since = Foreign_language.Dict.make ~c ~cxx ;; -let menhir_flags ~since = +let menhir_flags ~since ~deleted_in = let decode = - let decode = Ordered_set_lang.Unexpanded.decode in - match since with - | None -> decode - | Some since -> Dune_lang.Syntax.since Menhir_stanza.syntax since >>> decode + Dune_lang.Syntax.since Menhir_stanza.syntax since + >>> Dune_lang.Syntax.deleted_in + ~extra_info:"Use (menhir (flags ...)) instead." + Menhir_stanza.syntax + deleted_in + >>> Ordered_set_lang.Unexpanded.decode in field_o "menhir_flags" decode ;; @@ -75,7 +77,7 @@ type config = ; env_vars : Env.t ; binaries : File_binding.Unexpanded.t list option ; inline_tests : Inline_tests.t option - ; menhir_flags : Ordered_set_lang.Unexpanded.t option + ; menhir : Ordered_set_lang.Unexpanded.t Menhir_env.t ; odoc : Odoc.t ; js_of_ocaml : Ordered_set_lang.Unexpanded.t Js_of_ocaml.Env.t ; coq : Coq_env.t @@ -97,7 +99,7 @@ let equal_config ; env_vars ; binaries ; inline_tests - ; menhir_flags + ; menhir ; odoc ; js_of_ocaml ; coq @@ -117,7 +119,7 @@ let equal_config && Env.equal env_vars t.env_vars && Option.equal (List.equal File_binding.Unexpanded.equal) binaries t.binaries && Option.equal Inline_tests.equal inline_tests t.inline_tests - && Option.equal Ordered_set_lang.Unexpanded.equal menhir_flags t.menhir_flags + && Menhir_env.equal menhir t.menhir && Odoc.equal odoc t.odoc && Coq_env.equal coq t.coq && Option.equal Format_config.equal format_config t.format_config @@ -136,7 +138,7 @@ let empty_config = ; env_vars = Env.empty ; binaries = None ; inline_tests = None - ; menhir_flags = None + ; menhir = Menhir_env.empty ; odoc = Odoc.empty ; js_of_ocaml = Js_of_ocaml.Env.empty ; coq = Coq_env.default @@ -209,6 +211,12 @@ let odoc_field = (Dune_lang.Syntax.since Stanza.syntax (2, 4) >>> Odoc.decode) ;; +let menhir_field ~since = + field_o + "menhir" + (Dune_lang.Syntax.since Menhir_stanza.syntax since >>> Menhir_env.decode) +;; + let js_of_ocaml_field = field "js_of_ocaml" @@ -229,19 +237,27 @@ let config = "binaries" (Dune_lang.Syntax.since Stanza.syntax (1, 6) >>> File_binding.Unexpanded.L.decode) and+ inline_tests = inline_tests_field - and+ menhir_flags = menhir_flags ~since:(Some (2, 1)) + and+ menhir = menhir_field ~since:Menhir_stanza.explain_since + and+ menhir_flags = menhir_flags ~since:(2, 1) ~deleted_in:Menhir_stanza.explain_since and+ odoc = odoc_field and+ js_of_ocaml = js_of_ocaml_field and+ coq = Coq_env.decode and+ format_config = Format_config.field ~since:(2, 8) and+ bin_annot = bin_annot in + let menhir = + match menhir_flags, menhir with + | Some flags, None -> { Menhir_env.empty with flags } + | None, Some env -> env + | None, None -> Menhir_env.empty + | Some _, Some _ -> Code_error.raise "(menhir_flags) and (menhir) cannot both be present" [] + in { flags ; foreign_flags ; link_flags ; env_vars ; binaries ; inline_tests - ; menhir_flags + ; menhir ; odoc ; js_of_ocaml ; coq diff --git a/src/dune_rules/dune_env.mli b/src/dune_rules/dune_env.mli index bbe0aa39188..a1d46d8c330 100644 --- a/src/dune_rules/dune_env.mli +++ b/src/dune_rules/dune_env.mli @@ -27,7 +27,7 @@ type config = ; env_vars : Env.t ; binaries : File_binding.Unexpanded.t list option ; inline_tests : Inline_tests.t option - ; menhir_flags : Ordered_set_lang.Unexpanded.t option + ; menhir : Ordered_set_lang.Unexpanded.t Menhir_env.t ; odoc : Odoc.t ; js_of_ocaml : Ordered_set_lang.Unexpanded.t Js_of_ocaml.Env.t ; coq : Coq_env.t diff --git a/src/dune_rules/dune_rules.ml b/src/dune_rules/dune_rules.ml index 85517881e50..4d571e1b305 100644 --- a/src/dune_rules/dune_rules.ml +++ b/src/dune_rules/dune_rules.ml @@ -6,6 +6,7 @@ module Env_node = Env_node module Link_flags = Link_flags module Ocaml_flags = Ocaml_flags module Js_of_ocaml = Js_of_ocaml +module Menhir_env = Menhir_env module Super_context = Super_context module Compilation_context = Compilation_context module Colors = Colors diff --git a/src/dune_rules/env_node.ml b/src/dune_rules/env_node.ml index 5429d3415ef..830b62bfaf4 100644 --- a/src/dune_rules/env_node.ml +++ b/src/dune_rules/env_node.ml @@ -8,7 +8,7 @@ type t = ; link_flags : Link_flags.t Memo.Lazy.t ; external_env : Env.t Memo.Lazy.t ; artifacts : Artifacts.t Memo.Lazy.t - ; menhir_flags : string list Action_builder.t Memo.Lazy.t + ; menhir : string list Action_builder.t Menhir_env.t Memo.Lazy.t ; js_of_ocaml : string list Action_builder.t Js_of_ocaml.Env.t Memo.Lazy.t ; coq_flags : Coq_flags.t Action_builder.t Memo.Lazy.t } @@ -21,7 +21,7 @@ let link_flags t = Memo.Lazy.force t.link_flags let external_env t = Memo.Lazy.force t.external_env let artifacts t = Memo.Lazy.force t.artifacts let js_of_ocaml t = Memo.Lazy.force t.js_of_ocaml -let menhir_flags t = Memo.Lazy.force t.menhir_flags |> Action_builder.of_memo_join +let menhir t = Memo.Lazy.force t.menhir let coq_flags t = Memo.Lazy.force t.coq_flags let expand_str_lazy expander sw = @@ -139,16 +139,17 @@ let make ~default:link_flags ~eval:(Expander.expand_and_eval_set expander)) in - let menhir_flags = + let menhir = inherited - ~field:(fun t -> Memo.return (menhir_flags t)) - ~root:(Action_builder.return []) - (fun flags -> - match config.menhir_flags with - | None -> Memo.return flags - | Some menhir_flags -> - let+ expander = Memo.Lazy.force expander in - Expander.expand_and_eval_set expander menhir_flags ~standard:flags) + ~field:menhir + ~root:(Menhir_env.map ~f:Action_builder.return Menhir_env.default) + (fun (menhir : _ Action_builder.t Menhir_env.t) -> + let local = config.menhir in + let+ expander = Memo.Lazy.force expander in + let flags = + Expander.expand_and_eval_set expander local.flags ~standard:menhir.flags + in + { Menhir_env.flags; explain = Option.first_some local.explain menhir.explain }) in let coq_flags : Coq_flags.t Action_builder.t Memo.Lazy.t = inherited @@ -178,7 +179,7 @@ let make ; artifacts ; local_binaries ; js_of_ocaml - ; menhir_flags + ; menhir ; coq_flags } ;; diff --git a/src/dune_rules/env_node.mli b/src/dune_rules/env_node.mli index 7256d4cb36e..8b921053384 100644 --- a/src/dune_rules/env_node.mli +++ b/src/dune_rules/env_node.mli @@ -31,4 +31,4 @@ val local_binaries : t -> File_binding.Expanded.t list Memo.t val artifacts : t -> Artifacts.t Memo.t val coq_flags : t -> Coq_flags.t Action_builder.t Memo.t -val menhir_flags : t -> string list Action_builder.t +val menhir : t -> string list Action_builder.t Menhir_env.t Memo.t diff --git a/src/dune_rules/menhir/menhir_env.ml b/src/dune_rules/menhir/menhir_env.ml new file mode 100644 index 00000000000..23a83ee0ae2 --- /dev/null +++ b/src/dune_rules/menhir/menhir_env.ml @@ -0,0 +1,34 @@ +open Import + +type 'a t = + { flags : 'a + ; explain : Blang.t option + } + +let map ~f t = { t with flags = f t.flags } + +let equal { flags; explain } t = + Ordered_set_lang.Unexpanded.equal flags t.flags + && Option.equal Blang.equal explain t.explain +;; + +let decode = + let open Dune_lang.Decoder in + fields + @@ let+ flags = Ordered_set_lang.Unexpanded.field "flags" + and+ explain = field_o "explain" Blang.decode in + { flags; explain } +;; + +let empty = { flags = Ordered_set_lang.Unexpanded.standard; explain = None } +let default = { flags = []; explain = None } + +let dump t = + let open Action_builder.O in + let+ flags = t.flags in + List.map + ~f:Dune_lang.Encoder.(pair string Fun.id) + [ "menhir_flags", Dune_lang.Encoder.(list string) flags + ; "menhir_explain", Dune_lang.Encoder.option Blang.encode t.explain + ] +;; diff --git a/src/dune_rules/menhir/menhir_env.mli b/src/dune_rules/menhir/menhir_env.mli new file mode 100644 index 00000000000..f2f89a71693 --- /dev/null +++ b/src/dune_rules/menhir/menhir_env.mli @@ -0,0 +1,13 @@ +open Import + +type 'a t = + { flags : 'a + ; explain : Blang.t option + } + +val map : f:('a -> 'b) -> 'a t -> 'b t +val equal : Ordered_set_lang.Unexpanded.t t -> Ordered_set_lang.Unexpanded.t t -> bool +val decode : Ordered_set_lang.Unexpanded.t t Dune_lang.Decoder.t +val empty : Ordered_set_lang.Unexpanded.t t +val default : string list t +val dump : string list Action_builder.t t -> Dune_lang.t list Action_builder.t diff --git a/src/dune_rules/menhir/menhir_rules.ml b/src/dune_rules/menhir/menhir_rules.ml index da67bf31544..4ced175ab18 100644 --- a/src/dune_rules/menhir/menhir_rules.ml +++ b/src/dune_rules/menhir/menhir_rules.ml @@ -57,6 +57,12 @@ module Run (P : PARAMS) = struct let build_dir = Super_context.context sctx |> Context.build_dir let expander = Super_context.expander ~dir sctx + let env = + let open Memo.O in + let* env = Super_context.env_node ~dir sctx in + Env_node.menhir env + ;; + let sandbox = let scope = Compilation_context.scope cctx in let project = Scope.project scope in @@ -120,10 +126,15 @@ module Run (P : PARAMS) = struct Super_context.add_rule sctx ~dir ~mode ~loc:stanza.loc ;; - let explain_flags base explain = + let explain_flags base stanza = let open Memo.O in - let* expander = expander in - let+ explain = Expander.eval_blang expander explain in + let* expander = expander + and* env = env in + let+ explain = + match Option.first_some stanza.Menhir_stanza.explain env.Menhir_env.explain with + | None -> Memo.return (stanza.menhir_syntax >= Menhir_stanza.explain_since) + | Some explain -> Expander.eval_blang expander explain + in if explain then [ Command.Args.A "--explain" @@ -133,14 +144,13 @@ module Run (P : PARAMS) = struct ;; let expand_flags flags = - let standard = - Action_builder.of_memo @@ Super_context.env_node sctx ~dir >>= Env_node.menhir_flags - in + let open Memo.O in + let+ env = env + and+ expander = expander in Action_builder.memoize ~cutoff:(List.equal String.equal) "menhir flags" - (let* expander = Action_builder.of_memo expander in - Expander.expand_and_eval_set expander flags ~standard) + (Expander.expand_and_eval_set expander flags ~standard:env.Menhir_env.flags) ;; (* ------------------------------------------------------------------------ *) @@ -174,6 +184,15 @@ module Run (P : PARAMS) = struct Ordered_set_lang.Unexpanded.fold_strings stanza.flags ~init:() ~f:(fun _pos sw () -> match String_with_vars.text_only sw with | None -> () + | Some "--explain" -> + if stanza.menhir_syntax >= Menhir_stanza.explain_since + then + User_error.raise + ~loc:(String_with_vars.loc sw) + [ Pp.textf + "The Menhir '.conflicts' file is generated by default, so '--explain' \ + should not be explicitly added to the list of Menhir flags." + ] | Some text -> if List.mem ~equal:String.equal @@ -198,7 +217,7 @@ module Run (P : PARAMS) = struct let process3 base ~cmly (stanza : stanza) : unit Memo.t = let open Memo.O in - let expanded_flags = expand_flags stanza.flags in + let* expanded_flags = expand_flags stanza.flags in (* 1. A first invocation of Menhir creates a mock [.ml] file. *) let* () = menhir @@ -237,7 +256,7 @@ module Run (P : PARAMS) = struct let* () = Module_compilation.ocamlc_i ~deps cctx mock_module ~output:(inferred_mli base) in - let* explain_flags = explain_flags base stanza.explain in + let* explain_flags = explain_flags base stanza in (* 3. A second invocation of Menhir reads the inferred [.mli] file. *) menhir [ Command.Args.dyn expanded_flags @@ -259,8 +278,8 @@ module Run (P : PARAMS) = struct let process1 base ~cmly (stanza : stanza) : unit Memo.t = let open Memo.O in - let expanded_flags = expand_flags stanza.flags in - let* explain_flags = explain_flags base stanza.explain in + let* expanded_flags = expand_flags stanza.flags + and* explain_flags = explain_flags base stanza in menhir [ Command.Args.dyn expanded_flags ; S explain_flags @@ -293,16 +312,6 @@ module Run (P : PARAMS) = struct (match String_with_vars.text_only sw with | Some "--only-tokens" -> true, cmly | Some "--cmly" -> only_tokens, true - | Some "--explain" -> - if stanza.menhir_syntax >= Menhir_stanza.explain_since - then - User_warning.emit - [ Pp.textf - "Note that the Menhir '.conflicts' file is generated by default, \ - so the '--explain' flag should not be explicitly added to the \ - list of Menhir flags." - ]; - acc | Some _ | None -> acc)) in if ocaml_type_inference_disabled || not stanza.infer diff --git a/src/dune_rules/menhir/menhir_stanza.ml b/src/dune_rules/menhir/menhir_stanza.ml index 9774b4f6a73..1e284fa7ff4 100644 --- a/src/dune_rules/menhir/menhir_stanza.ml +++ b/src/dune_rules/menhir/menhir_stanza.ml @@ -22,7 +22,7 @@ type t = ; loc : Loc.t ; infer : bool ; enabled_if : Blang.t - ; explain : Blang.t + ; explain : Blang.t option ; menhir_syntax : Syntax.Version.t } @@ -46,11 +46,6 @@ let decode = | Some infer -> infer | None -> menhir_syntax >= (2, 0) in - let explain = - match explain with - | None -> if menhir_syntax >= explain_since then Blang.true_ else Blang.false_ - | Some explain -> explain - in { merge_into; flags; modules; mode; loc; infer; enabled_if; explain; menhir_syntax }) ;; diff --git a/src/dune_rules/menhir/menhir_stanza.mli b/src/dune_rules/menhir/menhir_stanza.mli index 82fd1b2c6cf..c836455e4be 100644 --- a/src/dune_rules/menhir/menhir_stanza.mli +++ b/src/dune_rules/menhir/menhir_stanza.mli @@ -10,7 +10,7 @@ type t = ; loc : Loc.t ; infer : bool ; enabled_if : Blang.t - ; explain : Blang.t + ; explain : Blang.t option ; menhir_syntax : Syntax.Version.t } diff --git a/test/blackbox-tests/test-cases/menhir/explain.t/parser.mly b/test/blackbox-tests/test-cases/menhir/explain.t/parser.mly new file mode 100644 index 00000000000..07e5ea5db3a --- /dev/null +++ b/test/blackbox-tests/test-cases/menhir/explain.t/parser.mly @@ -0,0 +1,4 @@ +%token START +%start start +%% +start: START { 42 } diff --git a/test/blackbox-tests/test-cases/menhir/explain.t b/test/blackbox-tests/test-cases/menhir/explain.t/run.t similarity index 53% rename from test/blackbox-tests/test-cases/menhir/explain.t rename to test/blackbox-tests/test-cases/menhir/explain.t/run.t index e5be15bb48e..e267fb1618c 100644 --- a/test/blackbox-tests/test-cases/menhir/explain.t +++ b/test/blackbox-tests/test-cases/menhir/explain.t/run.t @@ -1,12 +1,5 @@ Support (explain) field in (menhir) stanza to produce .conflicts file: - $ cat >parser.mly < %token START - > %start start - > %% - > start: START | START { 42 } - > EOF - $ cat >dune < (menhir (modules parser) (explain true)) > (library (name lib)) @@ -49,11 +42,6 @@ First we check the version guards: > EOF $ dune build - Warning: one state has reduce/reduce conflicts. - Warning: one reduce/reduce conflict was arbitrarily resolved. - File "parser.mly", line 4, characters 15-20: - Warning: production start -> START is never reduced. - Warning: in total, 1 production is never reduced. Let's check that the conflicts file has been generated successfully: @@ -67,11 +55,6 @@ Let's check we can also pass `(explain false)`: > EOF $ dune build - Warning: one state has reduce/reduce conflicts. - Warning: one reduce/reduce conflict was arbitrarily resolved. - File "parser.mly", line 4, characters 15-20: - Warning: production start -> START is never reduced. - Warning: in total, 1 production is never reduced. $ ! test -f _build/default/parser.conflicts @@ -83,11 +66,6 @@ Let's check that it is generated by default if we omit the (explain) field: > EOF $ dune build - Warning: one state has reduce/reduce conflicts. - Warning: one reduce/reduce conflict was arbitrarily resolved. - File "parser.mly", line 4, characters 15-20: - Warning: production start -> START is never reduced. - Warning: in total, 1 production is never reduced. $ test -f _build/default/parser.conflicts @@ -131,11 +109,97 @@ Let's check that we get a warning if we use --explain with the new mode > EOF $ dune build - Warning: Note that the Menhir '.conflicts' file is generated by default, so - the '--explain' flag should not be explicitly added to the list of Menhir - flags. - Warning: one state has reduce/reduce conflicts. - Warning: one reduce/reduce conflict was arbitrarily resolved. - File "parser.mly", line 4, characters 15-20: - Warning: production start -> START is never reduced. - Warning: in total, 1 production is never reduced. + File "dune", line 1, characters 32-41: + 1 | (menhir (modules parser) (flags --explain)) + ^^^^^^^^^ + Error: The Menhir '.conflicts' file is generated by default, so '--explain' + should not be explicitly added to the list of Menhir flags. + [1] + +Let's now test the new field of (env), (menhir): + + $ cat >dune-project < (lang dune 3.12) + > (using menhir 2.1) + > EOF + + $ cat >dune < (env (_ (menhir (explain false)))) + > (menhir (modules parser)) + > (library (name lib)) + > EOF + + $ dune build + File "dune", line 1, characters 8-32: + 1 | (env (_ (menhir (explain false)))) + ^^^^^^^^^^^^^^^^^^^^^^^^ + Error: 'menhir' is only available since version 2.2 of the menhir extension. + Please update your dune-project file to have (using menhir 2.2). + [1] + + $ cat >dune-project < (lang dune 3.13) + > (using menhir 2.2) + > EOF + + $ cat >dune < (env (_ (menhir_flags --explain))) + > (menhir (modules parser)) + > (library (name lib)) + > EOF + + $ dune build + File "dune", line 1, characters 8-32: + 1 | (env (_ (menhir_flags --explain))) + ^^^^^^^^^^^^^^^^^^^^^^^^ + Error: 'menhir_flags' was deleted in version 2.2 of the menhir extension. Use + (menhir (flags ...)) instead. + [1] + + $ cat >dune < (env (_ (menhir (explain false)))) + > (menhir (modules parser)) + > (library (name lib)) + > EOF + + $ dune build + + $ ! test -f _build/default/parser.conflicts + + $ cat >dune < (env (_ (menhir (explain false)))) + > (menhir (modules parser) (explain true)) + > (library (name lib)) + > EOF + + $ dune build + + $ test -f _build/default/parser.conflicts + +Also in subdirectories: + + $ mkdir -p sub + $ cp parser.mly sub/parser2.mly + + $ cat >sub/dune < (menhir (modules parser2)) + > (library (name lib2)) + > EOF + + $ dune printenv sub | grep menhir + (menhir_flags ()) + (menhir_explain (false)) + + $ dune build @sub/all + + $ ! test -f _build/default/sub/parser2.conflicts + + $ true >dune + + $ dune printenv sub | grep menhir + (menhir_flags ()) + (menhir_explain ()) + + $ dune build @sub/all + + $ test _build/default/sub/parser2.conflicts From d8127be088645714526d256cf528919bdb5e3363 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Sat, 16 Dec 2023 22:15:43 +0100 Subject: [PATCH 15/18] Use List.equal MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/dune_lang/blang.ml | 5 +---- src/dune_rules/dune_env.ml | 3 ++- 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/src/dune_lang/blang.ml b/src/dune_lang/blang.ml index d9d9f7c7134..90106a62792 100644 --- a/src/dune_lang/blang.ml +++ b/src/dune_lang/blang.ml @@ -20,10 +20,7 @@ module Ast = struct | Const b1, Const b2 -> Bool.equal b1 b2 | Not t1, Not t2 -> equal f t1 t2 | Expr x1, Expr x2 -> f x1 x2 - | And tl1, And tl2 | Or tl1, Or tl2 -> - (match List.for_all2 ~f:(equal f) tl1 tl2 with - | Ok b -> b - | Error `Length_mismatch -> false) + | And tl1, And tl2 | Or tl1, Or tl2 -> List.equal f tl1 tl2 | Compare (op1, x1, y1), Compare (op2, x2, y2) -> Relop.equal op1 op2 && f x1 x2 && f y1 y2 | (Const _ | Not _ | Expr _ | And _ | Or _ | Compare _), _ -> false diff --git a/src/dune_rules/dune_env.ml b/src/dune_rules/dune_env.ml index 1bfe8e48fcd..8b3a018b08a 100644 --- a/src/dune_rules/dune_env.ml +++ b/src/dune_rules/dune_env.ml @@ -249,7 +249,8 @@ let config = | Some flags, None -> { Menhir_env.empty with flags } | None, Some env -> env | None, None -> Menhir_env.empty - | Some _, Some _ -> Code_error.raise "(menhir_flags) and (menhir) cannot both be present" [] + | Some _, Some _ -> + Code_error.raise "(menhir_flags) and (menhir) cannot both be present" [] in { flags ; foreign_flags From 50ec8daf1750966343ca82b3396968d7c423a331 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Sat, 16 Dec 2023 22:22:00 +0100 Subject: [PATCH 16/18] Bump Menhir extension version to 3.0 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- doc/changes/9512.md | 2 +- doc/stanzas/menhir.rst | 9 +++---- src/dune_lang/blang.ml | 2 +- src/dune_rules/menhir/menhir_stanza.ml | 4 ++-- .../test-cases/menhir/explain.t/run.t | 24 +++++++++---------- 5 files changed, 21 insertions(+), 20 deletions(-) diff --git a/doc/changes/9512.md b/doc/changes/9512.md index 0ea0c94f1df..5e6adc1eb84 100644 --- a/doc/changes/9512.md +++ b/doc/changes/9512.md @@ -2,5 +2,5 @@ stanza to control the generation of this file: `(explain )`. Introduce `(menhir (flags ...) (explain ...))` field in the `(env)` stanza, delete `(menhir_flags)` field. All changes are guarded under a new version of - the Menhir extension, 2.2. + the Menhir extension, 3.0. (#9512, @nojb) diff --git a/doc/stanzas/menhir.rst b/doc/stanzas/menhir.rst index 7d73057325c..1c7e63e96c1 100644 --- a/doc/stanzas/menhir.rst +++ b/doc/stanzas/menhir.rst @@ -43,10 +43,11 @@ Therefore, if this is flag is passed to Menhir, Dune will know to introduce a - ``(explain )`` is used to control the generation of the ``.conflicts`` file explaining conflicts found while generating the parser. The condition is specified using the - :doc:`reference/boolean-language`. This option is available since version 2.2 - of the Menhir extension. + :doc:`reference/boolean-language`. This field was introduced in version 3.0 of + the Menhir extension. -Note that starting in version 2.2 of the Menhir extension, the ``.conflicts`` is -generated by default and needs to be disabled explicitly if this is not desired. +Note that starting in version 3.0 of the Menhir extension, the ``.conflicts`` +file is generated by default. If this is not desired, it needs to be disabled +explicitly by using the ``(explain)`` field. .. _menhir-git: https://gitlab.inria.fr/fpottier/menhir diff --git a/src/dune_lang/blang.ml b/src/dune_lang/blang.ml index 90106a62792..3eb02e0d88b 100644 --- a/src/dune_lang/blang.ml +++ b/src/dune_lang/blang.ml @@ -20,7 +20,7 @@ module Ast = struct | Const b1, Const b2 -> Bool.equal b1 b2 | Not t1, Not t2 -> equal f t1 t2 | Expr x1, Expr x2 -> f x1 x2 - | And tl1, And tl2 | Or tl1, Or tl2 -> List.equal f tl1 tl2 + | And tl1, And tl2 | Or tl1, Or tl2 -> List.equal (equal f) tl1 tl2 | Compare (op1, x1, y1), Compare (op2, x2, y2) -> Relop.equal op1 op2 && f x1 x2 && f y1 y2 | (Const _ | Not _ | Expr _ | And _ | Or _ | Compare _), _ -> false diff --git a/src/dune_rules/menhir/menhir_stanza.ml b/src/dune_rules/menhir/menhir_stanza.ml index 1e284fa7ff4..587cf7aa238 100644 --- a/src/dune_rules/menhir/menhir_stanza.ml +++ b/src/dune_rules/menhir/menhir_stanza.ml @@ -8,7 +8,7 @@ let syntax = ; (1, 1), `Since (1, 4) ; (2, 0), `Since (1, 4) ; (2, 1), `Since (2, 2) - ; (2, 2), `Since (3, 13) + ; (3, 0), `Since (3, 13) ] ;; @@ -26,7 +26,7 @@ type t = ; menhir_syntax : Syntax.Version.t } -let explain_since = 2, 2 +let explain_since = 3, 0 let decode = fields diff --git a/test/blackbox-tests/test-cases/menhir/explain.t/run.t b/test/blackbox-tests/test-cases/menhir/explain.t/run.t index e267fb1618c..ffd098ccc02 100644 --- a/test/blackbox-tests/test-cases/menhir/explain.t/run.t +++ b/test/blackbox-tests/test-cases/menhir/explain.t/run.t @@ -16,20 +16,20 @@ First we check the version guards: File "dune", line 1, characters 25-39: 1 | (menhir (modules parser) (explain true)) ^^^^^^^^^^^^^^ - Error: 'explain' is only available since version 2.2 of the menhir extension. - Please update your dune-project file to have (using menhir 2.2). + Error: 'explain' is only available since version 3.0 of the menhir extension. + Please update your dune-project file to have (using menhir 3.0). [1] $ cat >dune-project < (lang dune 3.12) - > (using menhir 2.2) + > (using menhir 3.0) > EOF $ dune build File "dune-project", line 2, characters 14-17: - 2 | (using menhir 2.2) + 2 | (using menhir 3.0) ^^^ - Error: Version 2.2 of the menhir extension is not supported until version + Error: Version 3.0 of the menhir extension is not supported until version 3.13 of the dune language. Supported versions of this extension in version 3.12 of the dune language: - 1.0 to 1.1 @@ -38,7 +38,7 @@ First we check the version guards: $ cat >dune-project < (lang dune 3.13) - > (using menhir 2.2) + > (using menhir 3.0) > EOF $ dune build @@ -84,7 +84,7 @@ Let's check that the argument to (explain) can be a blang: $ cat >dune-project < (lang dune 3.13) - > (using menhir 2.2) + > (using menhir 3.0) > EOF $ cat >dune <dune-project < (lang dune 3.13) - > (using menhir 2.2) + > (using menhir 3.0) > EOF $ cat >dune <dune-project < (lang dune 3.13) - > (using menhir 2.2) + > (using menhir 3.0) > EOF $ cat >dune < Date: Sat, 16 Dec 2023 22:22:42 +0100 Subject: [PATCH 17/18] Accept tests MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- test/blackbox-tests/test-cases/workspaces/workspace-env.t/run.t | 1 + 1 file changed, 1 insertion(+) diff --git a/test/blackbox-tests/test-cases/workspaces/workspace-env.t/run.t b/test/blackbox-tests/test-cases/workspaces/workspace-env.t/run.t index 44443030bdd..bd7c0a3cf09 100644 --- a/test/blackbox-tests/test-cases/workspaces/workspace-env.t/run.t +++ b/test/blackbox-tests/test-cases/workspaces/workspace-env.t/run.t @@ -11,6 +11,7 @@ Workspaces also allow you to set the env for a context: (cxx_flags ()) (link_flags ()) (menhir_flags ()) + (menhir_explain ()) (coq_flags (-q)) (coqdoc_flags (--toc)) (js_of_ocaml_flags ()) From 0546401bd183ed80bc9ffe61c40a3bd175f95e5b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Sat, 16 Dec 2023 22:25:01 +0100 Subject: [PATCH 18/18] Fix Doc MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- doc/stanzas/env.rst | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/stanzas/env.rst b/doc/stanzas/env.rst index 1ae1c33e7e6..774f36d17b2 100644 --- a/doc/stanzas/env.rst +++ b/doc/stanzas/env.rst @@ -33,12 +33,12 @@ Fields supported in ```` are: used by ``dune exec``. - ``(menhir_flags ))`` specifies flags for Menhir stanzas. This flag was - replaced by the ``(menhir)`` field (see below) starting in version 2.2 of the + replaced by the ``(menhir)`` field (see below) starting in version 3.0 of the Menhir extension. - ``(menhir (flags ))`` specifies the Menhir settings. See `menhir`_ for more details. This field was introduced in version - 2.2 of the Menhir extension. + 3.0 of the Menhir extension. - ``(js_of_ocaml (flags )(build_runtime )(link_flags ))`` specifies ``js_of_ocaml`` flags. See `jsoo-field`_ for more details.