Commit e2db096b authored by POTTIER Francois's avatar POTTIER Francois

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

parent 904c82cc
...@@ -2,6 +2,10 @@ ...@@ -2,6 +2,10 @@
## 2018/11/XX ## 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, * When a cycle of `%inline` nonterminal symbols is encountered,
the error message now shows the entire cycle, the error message now shows the entire cycle,
as opposed to just one symbol that participates in the cycle. as opposed to just one symbol that participates in the cycle.
......
...@@ -69,6 +69,9 @@ let unparenthesize (s : string) : string = ...@@ -69,6 +69,9 @@ let unparenthesize (s : string) : string =
let unparenthesize (s : Stretch.t) : Stretch.t = let unparenthesize (s : Stretch.t) : Stretch.t =
{ s with stretch_content = unparenthesize s.stretch_content } { 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: ...@@ -623,12 +626,12 @@ action:
{ XATraditional action } { XATraditional action }
| action = OCAMLTYPE | action = OCAMLTYPE
{ match ParserAux.validate_pointfree_action action with { match ParserAux.validate_pointfree_action action with
| Some s -> | os ->
XAPointFree (unparenthesize s) XAPointFree (unparenthesize os)
| None -> | exception Lexpointfree.InvalidPointFreeAction ->
Error.error [Positions.import $loc] Error.error [Positions.import $loc]
"A point-free semantic action must consist \ "A point-free semantic action must consist \
of a single OCaml identifier." of a single OCaml identifier." (* or whitespace *)
} }
/* Patterns. */ /* Patterns. */
......
...@@ -11,6 +11,12 @@ ...@@ -11,6 +11,12 @@
(* *) (* *)
(******************************************************************************) (******************************************************************************)
{
exception InvalidPointFreeAction
}
(* See [ParserAux.validate_pointfree_action]. *) (* See [ParserAux.validate_pointfree_action]. *)
let lowercase = ['a'-'z' '\223'-'\246' '\248'-'\255' '_'] let lowercase = ['a'-'z' '\223'-'\246' '\248'-'\255' '_']
...@@ -28,13 +34,16 @@ let op = ...@@ -28,13 +34,16 @@ let op =
let whitespace = [ ' ' '\t' '\n' ] let whitespace = [ ' ' '\t' '\n' ]
rule valid_pointfree_action = parse rule validate_pointfree_action = parse
| whitespace* (lowercase | uppercase | '`') (identchar | '.')* whitespace* eof | whitespace* (lowercase | uppercase | '`') (identchar | '.')* whitespace* eof
| whitespace* '(' op ')' whitespace* eof | whitespace* '(' op ')' whitespace* eof
| eof (* We have got a nonempty point-free action: <id>. *)
{ true } { true }
| _ | whitespace* eof
(* We have got an empty point-free action: <>. *)
{ false } { false }
| _
{ raise InvalidPointFreeAction }
(* See [ParserAux.valid_ocaml_identifier]. *) (* See [ParserAux.valid_ocaml_identifier]. *)
...@@ -42,4 +51,5 @@ and valid_ocaml_identifier = parse ...@@ -42,4 +51,5 @@ and valid_ocaml_identifier = parse
| lowercase identchar* eof | lowercase identchar* eof
{ true } { true }
| _ | _
| eof
{ false } { false }
...@@ -11,7 +11,6 @@ ...@@ -11,7 +11,6 @@
(* *) (* *)
(******************************************************************************) (******************************************************************************)
open Stretch
open Syntax open Syntax
(* Because the main function, [NewRuleSyntax.rule], is called by the stage 2 (* Because the main function, [NewRuleSyntax.rule], is called by the stage 2
...@@ -388,12 +387,15 @@ and production_aux ...@@ -388,12 +387,15 @@ and production_aux
pr_branch_production_level = level; pr_branch_production_level = level;
} }
| EAction (XAPointFree id, prec) -> | EAction (XAPointFree oid, prec) ->
(* A point-free semantic action, containing the OCaml identifier [id] (* A point-free semantic action, containing an OCaml identifier [id]
between angle brackets. This is syntactic sugar for a traditional between angle brackets. This is syntactic sugar for a traditional
semantic action containing an application of [id] to a tuple of the semantic action containing an application of [id] to a tuple of the
semantic values that have been assigned a name by the user. *) 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 (* [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). there is an OCaml error (e.g., [id] is undeclared, or ill-typed).
The stretch contains source code location information which allows The stretch contains source code location information which allows
...@@ -407,15 +409,12 @@ and production_aux ...@@ -407,15 +409,12 @@ and production_aux
(* We abuse the abstract syntax of IL and build an application node, (* We abuse the abstract syntax of IL and build an application node,
regardless of whether [id] a (possibly qualified) value, a (possibly regardless of whether [id] a (possibly qualified) value, a (possibly
qualified) data constructor, a polymorphic variant constructor, etc. *) 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 = let e =
if String.length id.stretch_raw_content = 0 then match oid with
tuple | Some id ->
else IL.EApp (IL.ETextual id, [tuple])
IL.EApp (IL.ETextual id, [tuple]) | None ->
tuple
in in
(* Build a traditional semantic action. *) (* Build a traditional semantic action. *)
let action = Action.from_il_expr e in let action = Action.from_il_expr e in
......
...@@ -127,7 +127,7 @@ let validate_pointfree_action (ty : ocamltype) : Stretch.t option = ...@@ -127,7 +127,7 @@ let validate_pointfree_action (ty : ocamltype) : Stretch.t option =
assert false assert false
| Declared stretch -> | Declared stretch ->
let s = stretch.stretch_raw_content in 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 Some stretch
else else
None None
......
...@@ -87,8 +87,9 @@ val override: Positions.t -> 'a option -> 'a option -> 'a option ...@@ -87,8 +87,9 @@ val override: Positions.t -> 'a option -> 'a option -> 'a option
val producer_names: early_producers -> identifier option array val producer_names: early_producers -> identifier option array
(* Check that a stretch contains an OCaml lowercase or uppercase identifier, (* Check that a stretch represents valid content for a point-free semantic
and convert this stretch to a string. The stretch may be empty, too. *) 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 val validate_pointfree_action: ocamltype -> Stretch.t option
......
...@@ -262,10 +262,10 @@ and symbol_expression = ...@@ -262,10 +262,10 @@ and symbol_expression =
and extended_action = and extended_action =
| XATraditional of raw_action | XATraditional of raw_action
| XAPointFree of Stretch.t | XAPointFree of Stretch.t option
(* A semantic action is either traditional { ... } or point-free <id>. (* A semantic action is either traditional { ... } or point-free.
In the latter case, [id] is either the empty string or an OCaml There are two forms of point-free actions, <> and <id>.
identifier. *) In the latter case, [id] is an OCaml identifier. *)
type rule = type rule =
{ {
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment