Allow an empty point-free semantic action to contain whitespace.

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.

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. */

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: <id>. *)
     { 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 }

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

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

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
 

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 <id>.
-     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 <id>.
+     In the latter case, [id] is an OCaml identifier. *)
 
 type rule =
   {