From e2db096b3963579821d5395a01b8b801c547a998 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Pottier?= Date: Fri, 23 Nov 2018 16:19:04 +0100 Subject: [PATCH] Allow an empty point-free semantic action to contain whitespace. --- CHANGES.md | 4 ++++ src/fancy-parser.mly | 11 +++++++---- src/lexpointfree.mll | 16 +++++++++++++--- src/newRuleSyntax.ml | 21 ++++++++++----------- src/parserAux.ml | 2 +- src/parserAux.mli | 5 +++-- src/syntax.ml | 8 ++++---- 7 files changed, 42 insertions(+), 25 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index fac51a5d..b6fbdd38 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -2,6 +2,10 @@ ## 2018/11/XX +* Relax the syntax of point-free actions to allow `< >` (with arbitrary + whitespace inside the angle brackets) instead of just `<>`. + (Suggested by Lélio Brun.) + * When a cycle of `%inline` nonterminal symbols is encountered, the error message now shows the entire cycle, as opposed to just one symbol that participates in the cycle. diff --git a/src/fancy-parser.mly b/src/fancy-parser.mly index e7e8de1d..9fb2b049 100644 --- a/src/fancy-parser.mly +++ b/src/fancy-parser.mly @@ -69,6 +69,9 @@ let unparenthesize (s : string) : string = let unparenthesize (s : Stretch.t) : Stretch.t = { s with stretch_content = unparenthesize s.stretch_content } +let unparenthesize (o : Stretch.t option) : Stretch.t option = + Option.map unparenthesize o + %} /* ------------------------------------------------------------------------- */ @@ -623,12 +626,12 @@ action: { XATraditional action } | action = OCAMLTYPE { match ParserAux.validate_pointfree_action action with - | Some s -> - XAPointFree (unparenthesize s) - | None -> + | os -> + XAPointFree (unparenthesize os) + | exception Lexpointfree.InvalidPointFreeAction -> Error.error [Positions.import $loc] "A point-free semantic action must consist \ - of a single OCaml identifier." + of a single OCaml identifier." (* or whitespace *) } /* Patterns. */ diff --git a/src/lexpointfree.mll b/src/lexpointfree.mll index 34aed8d5..6fe0229a 100644 --- a/src/lexpointfree.mll +++ b/src/lexpointfree.mll @@ -11,6 +11,12 @@ (* *) (******************************************************************************) +{ + + exception InvalidPointFreeAction + +} + (* See [ParserAux.validate_pointfree_action]. *) let lowercase = ['a'-'z' '\223'-'\246' '\248'-'\255' '_'] @@ -28,13 +34,16 @@ let op = let whitespace = [ ' ' '\t' '\n' ] -rule valid_pointfree_action = parse +rule validate_pointfree_action = parse | whitespace* (lowercase | uppercase | '`') (identchar | '.')* whitespace* eof | whitespace* '(' op ')' whitespace* eof -| eof + (* We have got a nonempty point-free action: . *) { true } -| _ +| whitespace* eof + (* We have got an empty point-free action: <>. *) { false } +| _ + { raise InvalidPointFreeAction } (* See [ParserAux.valid_ocaml_identifier]. *) @@ -42,4 +51,5 @@ and valid_ocaml_identifier = parse | lowercase identchar* eof { true } | _ +| eof { false } diff --git a/src/newRuleSyntax.ml b/src/newRuleSyntax.ml index c0c6897b..d71a2306 100644 --- a/src/newRuleSyntax.ml +++ b/src/newRuleSyntax.ml @@ -11,7 +11,6 @@ (* *) (******************************************************************************) -open Stretch open Syntax (* Because the main function, [NewRuleSyntax.rule], is called by the stage 2 @@ -388,12 +387,15 @@ and production_aux pr_branch_production_level = level; } - | EAction (XAPointFree id, prec) -> - (* A point-free semantic action, containing the OCaml identifier [id] + | EAction (XAPointFree oid, prec) -> + (* A point-free semantic action, containing an OCaml identifier [id] between angle brackets. This is syntactic sugar for a traditional semantic action containing an application of [id] to a tuple of the semantic values that have been assigned a name by the user. *) + (* As a special case, if [oid] is [None], then we must not build + an application node -- we simply build a tuple. *) + (* [id] is actually a stretch, not just a string, and this matters when there is an OCaml error (e.g., [id] is undeclared, or ill-typed). The stretch contains source code location information which allows @@ -407,15 +409,12 @@ and production_aux (* We abuse the abstract syntax of IL and build an application node, regardless of whether [id] a (possibly qualified) value, a (possibly qualified) data constructor, a polymorphic variant constructor, etc. *) - (* As a special case, if [id] is the empty string, then we do not build - an application node. Although it would be correctly printed, doing - this would defeat some IL optimizations and produce redundant [let] - constructs. *) let e = - if String.length id.stretch_raw_content = 0 then - tuple - else - IL.EApp (IL.ETextual id, [tuple]) + match oid with + | Some id -> + IL.EApp (IL.ETextual id, [tuple]) + | None -> + tuple in (* Build a traditional semantic action. *) let action = Action.from_il_expr e in diff --git a/src/parserAux.ml b/src/parserAux.ml index 93c24631..5df7a670 100644 --- a/src/parserAux.ml +++ b/src/parserAux.ml @@ -127,7 +127,7 @@ let validate_pointfree_action (ty : ocamltype) : Stretch.t option = assert false | Declared stretch -> let s = stretch.stretch_raw_content in - if Lexpointfree.valid_pointfree_action (Lexing.from_string s) then + if Lexpointfree.validate_pointfree_action (Lexing.from_string s) then Some stretch else None diff --git a/src/parserAux.mli b/src/parserAux.mli index 9d83b2a2..cbe83de9 100644 --- a/src/parserAux.mli +++ b/src/parserAux.mli @@ -87,8 +87,9 @@ val override: Positions.t -> 'a option -> 'a option -> 'a option val producer_names: early_producers -> identifier option array -(* Check that a stretch contains an OCaml lowercase or uppercase identifier, - and convert this stretch to a string. The stretch may be empty, too. *) +(* Check that a stretch represents valid content for a point-free semantic + action, i.e., either just whitespace, or an OCaml lowercase or uppercase + identifier. May raise [Lexpointfree.InvalidPointFreeAction]. *) val validate_pointfree_action: ocamltype -> Stretch.t option diff --git a/src/syntax.ml b/src/syntax.ml index f0373fd1..ec85399a 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -262,10 +262,10 @@ and symbol_expression = and extended_action = | XATraditional of raw_action - | XAPointFree of Stretch.t - (* A semantic action is either traditional { ... } or point-free . - In the latter case, [id] is either the empty string or an OCaml - identifier. *) + | XAPointFree of Stretch.t option + (* A semantic action is either traditional { ... } or point-free. + There are two forms of point-free actions, <> and . + In the latter case, [id] is an OCaml identifier. *) type rule = { -- GitLab