{-
    BNF Converter: TreeSitter Grammar Generator
    Copyright (C) 2004  Author:  Markus Forsberg, Michael Pellauer,
                                 Bjorn Bringert

    Author        : Kangjing Huang (huangkangjing@gmail.com)
    Created       : 23 Nov, 2023

-}

{-# LANGUAGE LambdaCase #-}

{-|
Description: Identifies and transforms rules which match the empty string,
             as required by Treesitter.
Maintainer: Kait Lam

This module identifies and transforms rules which match the empty string,
as required by constraints of Treesitter.

Treesitter requires that rules do /not/ match the empty string.
Although this is not made explicit in [their documentation](https://tree-sitter.github.io/tree-sitter/creating-parsers/3-writing-the-grammar.html),
rules which match empty will be thoroughly rejected by the tree-sitter
compiler.

For example, this Treesitter grammar is not allowed because @$.listItem@ could match
the empty string.

> list: $ => seq("[", $.listItem, "]"),
> listItem: $ => choice(
>   seq(),
>   "item"
> ),

Instead, Treesitter wants empty matches to be moved to /use-sites/ of that
rule. The above grammar would be rewritten as:

> list: $ => seq("[", optional($.listItem), "]"),
> listItem: $ => choice(
>   choice(),
>   "item"
> ),

Unfortunately, the style Treesitter needs is quite incompatible with LBNF. LBNF
has no way to express "choice" occuring within the right hand side of a rule,
which forces any choice (including potential optionality) to happen at the
top-level of a rule. This is in direct conflict with what Treesitter expects.

This modules bridges the gap by transforming LBNF's rules using process
outlined above. This happens in two steps: first, we compute which rules could
match empty by using a fixpoint algorithm, then, we transform the rules by
eliminating empty matches from all rules and wrapping non-terminals in
@optional@ if their rule could match empty. BNFC's "BNFC.CF" types have no
notion of "optional" within the RHS, so this module also introduces 'OptSym' to
represent this.

Of course, this transformation affects the parse tree for certain strings.
Users of BNFC who want to generate Treesitter grammars should be aware of this
change.

For users of this library, the main functions of interest are in the [Fixpoint
and transformations]("BNFC.Backend.TreeSitter.MatchesEmpty#g:fixpoint")
section.
-}
module BNFC.Backend.TreeSitter.MatchesEmpty where

import BNFC.Utils((>.>))
import BNFC.CF(SentForm, Cat, Rule, rhsRule)

import qualified Data.Maybe as Maybe
import qualified Data.List as List
import qualified Data.Set as Set

-- * Basic types

-- | A symbol which is either a non-terminal ('Cat') or terminal token name ('String').
-- A list of these 'Sym's is a sentential form, 'SentForm'.
type Sym = Either Cat String

-- | Set of 'Sym' which are known to match the empty string.
newtype KnownEmpty = KnownEmpty (Set.Set Sym) deriving (KnownEmpty -> KnownEmpty -> Bool
(KnownEmpty -> KnownEmpty -> Bool)
-> (KnownEmpty -> KnownEmpty -> Bool) -> Eq KnownEmpty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KnownEmpty -> KnownEmpty -> Bool
== :: KnownEmpty -> KnownEmpty -> Bool
$c/= :: KnownEmpty -> KnownEmpty -> Bool
/= :: KnownEmpty -> KnownEmpty -> Bool
Eq, Int -> KnownEmpty -> ShowS
[KnownEmpty] -> ShowS
KnownEmpty -> [Char]
(Int -> KnownEmpty -> ShowS)
-> (KnownEmpty -> [Char])
-> ([KnownEmpty] -> ShowS)
-> Show KnownEmpty
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KnownEmpty -> ShowS
showsPrec :: Int -> KnownEmpty -> ShowS
$cshow :: KnownEmpty -> [Char]
show :: KnownEmpty -> [Char]
$cshowList :: [KnownEmpty] -> ShowS
showList :: [KnownEmpty] -> ShowS
Show)

-- | Returns whether the given symbol matches the empty string, according
-- to the given known empty set.
isKnownEmpty :: Sym -> KnownEmpty -> Bool
isKnownEmpty :: Sym -> KnownEmpty -> Bool
isKnownEmpty Sym
x KnownEmpty
ks = Sym
x Sym -> Set Sym -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` (KnownEmpty -> Set Sym
knownEmptySet KnownEmpty
ks)

knownEmptySet :: KnownEmpty -> Set.Set Sym
knownEmptySet :: KnownEmpty -> Set Sym
knownEmptySet (KnownEmpty Set Sym
x) = Set Sym
x

-- | Represents a 'Sym' which might be wrapped in a @optional(...)@ function
-- in the produced Treesitter grammar.
data OptSym =
  -- | A 'Sym' which is wrapped in @optional([SYM])@, indicating that
  -- it should match @[SYM]@ /or/ the empty string.
  Optional Sym |
  -- | A plain 'Sym' which matches only the 'Sym' itself.
  NonOptional Sym deriving (OptSym -> OptSym -> Bool
(OptSym -> OptSym -> Bool)
-> (OptSym -> OptSym -> Bool) -> Eq OptSym
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OptSym -> OptSym -> Bool
== :: OptSym -> OptSym -> Bool
$c/= :: OptSym -> OptSym -> Bool
/= :: OptSym -> OptSym -> Bool
Eq, Int -> OptSym -> ShowS
[OptSym] -> ShowS
OptSym -> [Char]
(Int -> OptSym -> ShowS)
-> (OptSym -> [Char]) -> ([OptSym] -> ShowS) -> Show OptSym
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OptSym -> ShowS
showsPrec :: Int -> OptSym -> ShowS
$cshow :: OptSym -> [Char]
show :: OptSym -> [Char]
$cshowList :: [OptSym] -> ShowS
showList :: [OptSym] -> ShowS
Show)

-- | A sentential form where each symbol may be wrapped in an optional function.
-- Analagous to 'SentForm', but containing 'OptSym' instead of 'Sym'.
type OptSentForm = [OptSym]

-- * "Matches empty" type

-- | Represents whether the wrapped value matches the empty string, or whether
-- it is known to be non-empty.
--
-- Because this analysis is done on context-free grammars, the analysis is
-- precise. A value of 'MatchesEmpty' /will/ accept the empty string, and a
-- value of 'NonEmpty' will not. There is no uncertainty in this analysis.
data MatchesEmpty a =
  -- | The contained value /accepts/ the empty string.
  MatchesEmpty a |
  -- | The contained value /does not/ accept the empty string.
  NonEmpty a deriving (MatchesEmpty a -> MatchesEmpty a -> Bool
(MatchesEmpty a -> MatchesEmpty a -> Bool)
-> (MatchesEmpty a -> MatchesEmpty a -> Bool)
-> Eq (MatchesEmpty a)
forall a. Eq a => MatchesEmpty a -> MatchesEmpty a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => MatchesEmpty a -> MatchesEmpty a -> Bool
== :: MatchesEmpty a -> MatchesEmpty a -> Bool
$c/= :: forall a. Eq a => MatchesEmpty a -> MatchesEmpty a -> Bool
/= :: MatchesEmpty a -> MatchesEmpty a -> Bool
Eq, Int -> MatchesEmpty a -> ShowS
[MatchesEmpty a] -> ShowS
MatchesEmpty a -> [Char]
(Int -> MatchesEmpty a -> ShowS)
-> (MatchesEmpty a -> [Char])
-> ([MatchesEmpty a] -> ShowS)
-> Show (MatchesEmpty a)
forall a. Show a => Int -> MatchesEmpty a -> ShowS
forall a. Show a => [MatchesEmpty a] -> ShowS
forall a. Show a => MatchesEmpty a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> MatchesEmpty a -> ShowS
showsPrec :: Int -> MatchesEmpty a -> ShowS
$cshow :: forall a. Show a => MatchesEmpty a -> [Char]
show :: MatchesEmpty a -> [Char]
$cshowList :: forall a. Show a => [MatchesEmpty a] -> ShowS
showList :: [MatchesEmpty a] -> ShowS
Show)

matchesEmpty :: MatchesEmpty a -> Bool
matchesEmpty :: forall a. MatchesEmpty a -> Bool
matchesEmpty (MatchesEmpty a
_) = Bool
True
matchesEmpty (NonEmpty a
_) = Bool
False

unMatchesEmpty :: MatchesEmpty a -> a
unMatchesEmpty :: forall a. MatchesEmpty a -> a
unMatchesEmpty (MatchesEmpty a
x) = a
x
unMatchesEmpty (NonEmpty a
x) = a
x

-- ** Sequential operators

-- | Combines the two values /in sequence/. Returns v'MatchesEmpty' if both values
-- are v'MatchesEmpty', otherwise returns v'NonEmpty'. In all cases, the inner
-- values are joined using the semigroup operation.
seqMatchesEmpty :: Semigroup a => MatchesEmpty a -> MatchesEmpty a -> MatchesEmpty a
seqMatchesEmpty :: forall a.
Semigroup a =>
MatchesEmpty a -> MatchesEmpty a -> MatchesEmpty a
seqMatchesEmpty (MatchesEmpty a
x) (MatchesEmpty a
y) = a -> MatchesEmpty a
forall a. a -> MatchesEmpty a
MatchesEmpty (a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
y)
seqMatchesEmpty               MatchesEmpty a
x                MatchesEmpty a
y  = a -> MatchesEmpty a
forall a. a -> MatchesEmpty a
NonEmpty (MatchesEmpty a -> a
forall a. MatchesEmpty a -> a
unMatchesEmpty MatchesEmpty a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> MatchesEmpty a -> a
forall a. MatchesEmpty a -> a
unMatchesEmpty MatchesEmpty a
y)

-- | Combines the list of values /in sequence/ (i.e., @seq(x1, ..., xn)@), returning
-- v'MatchesEmpty' if all are v'MatchesEmpty', otherwise v'NonEmpty'. Inner values
-- are joined using the semigroup operation.
seqListMatchesEmpty :: Monoid a => [MatchesEmpty a] -> MatchesEmpty a
seqListMatchesEmpty :: forall a. Monoid a => [MatchesEmpty a] -> MatchesEmpty a
seqListMatchesEmpty = (MatchesEmpty a -> MatchesEmpty a -> MatchesEmpty a)
-> MatchesEmpty a -> [MatchesEmpty a] -> MatchesEmpty a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr MatchesEmpty a -> MatchesEmpty a -> MatchesEmpty a
forall a.
Semigroup a =>
MatchesEmpty a -> MatchesEmpty a -> MatchesEmpty a
seqMatchesEmpty (a -> MatchesEmpty a
forall a. a -> MatchesEmpty a
MatchesEmpty a
forall a. Monoid a => a
mempty)


-- ** Alternation operators

-- | Combines the two values as a /parallel choice/. Returns v'NonEmpty' if
-- both values are v'NonEmpty', otherwise returns v'MatchesEmpty'. In all
-- cases, the inner values are joined using the semigroup operation.
choiceMatchesEmpty :: Semigroup a => MatchesEmpty a -> MatchesEmpty a -> MatchesEmpty a
choiceMatchesEmpty :: forall a.
Semigroup a =>
MatchesEmpty a -> MatchesEmpty a -> MatchesEmpty a
choiceMatchesEmpty (NonEmpty a
x) (NonEmpty a
y) = a -> MatchesEmpty a
forall a. a -> MatchesEmpty a
NonEmpty (a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
y)
choiceMatchesEmpty           MatchesEmpty a
x            MatchesEmpty a
y  = a -> MatchesEmpty a
forall a. a -> MatchesEmpty a
MatchesEmpty (MatchesEmpty a -> a
forall a. MatchesEmpty a -> a
unMatchesEmpty MatchesEmpty a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> MatchesEmpty a -> a
forall a. MatchesEmpty a -> a
unMatchesEmpty MatchesEmpty a
y)

-- | Combines the list of values /in choice/ (i.e., @choice(x1, ..., xn)@), returning
-- v'NonEmpty' if all are v'NonEmpty', otherwise v'MatchesEmpty'. Inner values
-- are joined using the semigroup operation.
choiceListMatchesEmpty :: Monoid a => [MatchesEmpty a] -> MatchesEmpty a
choiceListMatchesEmpty :: forall a. Monoid a => [MatchesEmpty a] -> MatchesEmpty a
choiceListMatchesEmpty = (MatchesEmpty a -> MatchesEmpty a -> MatchesEmpty a)
-> MatchesEmpty a -> [MatchesEmpty a] -> MatchesEmpty a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr MatchesEmpty a -> MatchesEmpty a -> MatchesEmpty a
forall a.
Semigroup a =>
MatchesEmpty a -> MatchesEmpty a -> MatchesEmpty a
choiceMatchesEmpty (a -> MatchesEmpty a
forall a. a -> MatchesEmpty a
NonEmpty a
forall a. Monoid a => a
mempty)

-- * Analysis of non-terminals

-- | Determines whether the given symbol can match empty, according to the
-- given known empty set. If it /can/ match empty, the symbol is returned as
-- v'Optional' to indicate that uses of the symbol should match empty.
--
-- TODO: This does not yet handle /tokens/ (terminals) which might be empty.
-- At the moment, all terminals are assumed to be non-empty.
possiblyEmptySym :: KnownEmpty -> Sym -> OptSym
possiblyEmptySym :: KnownEmpty -> Sym -> OptSym
possiblyEmptySym KnownEmpty
knownEmpty Sym
sym =
  if Sym
sym Sym -> KnownEmpty -> Bool
`isKnownEmpty` KnownEmpty
knownEmpty then
    Sym -> OptSym
Optional Sym
sym
  else
    Sym -> OptSym
NonOptional Sym
sym

-- | Determines whether the given sentential form could match empty.
--
-- The returned list is a /choice/ list of 'OptSentForm', with v'Optional'
-- applied to symbols which are within the known empty set. When combined using
-- choice, the returned list is equivalent to the original rule, /except/ that
-- the returned list has empty matches removed. If the rule previously matched
-- empty, this is encoded as the v'MatchesEmpty' variant.
--
-- __Implementation Detail__: blah
possiblyEmptyRule :: KnownEmpty -> SentForm -> MatchesEmpty [OptSentForm]
possiblyEmptyRule :: KnownEmpty -> SentForm -> MatchesEmpty [[OptSym]]
possiblyEmptyRule KnownEmpty
knownEmpty =
  (Sym -> OptSym) -> SentForm -> [OptSym]
forall a b. (a -> b) -> [a] -> [b]
map (KnownEmpty -> Sym -> OptSym
possiblyEmptySym KnownEmpty
knownEmpty)
  (SentForm -> [OptSym])
-> ([OptSym] -> MatchesEmpty [[OptSym]])
-> SentForm
-> MatchesEmpty [[OptSym]]
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> (OptSym -> MatchesEmpty [OptSym])
-> [OptSym] -> [MatchesEmpty [OptSym]]
forall a b. (a -> b) -> [a] -> [b]
map OptSym -> MatchesEmpty [OptSym]
fromOpt
  ([OptSym] -> [MatchesEmpty [OptSym]])
-> ([MatchesEmpty [OptSym]] -> MatchesEmpty [[OptSym]])
-> [OptSym]
-> MatchesEmpty [[OptSym]]
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> [MatchesEmpty [OptSym]] -> MatchesEmpty [OptSym]
forall a. Monoid a => [MatchesEmpty a] -> MatchesEmpty a
seqListMatchesEmpty
  ([MatchesEmpty [OptSym]] -> MatchesEmpty [OptSym])
-> (MatchesEmpty [OptSym] -> MatchesEmpty [[OptSym]])
-> [MatchesEmpty [OptSym]]
-> MatchesEmpty [[OptSym]]
forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> \case
    MatchesEmpty [OptSym]
sent -> [[OptSym]] -> MatchesEmpty [[OptSym]]
forall a. a -> MatchesEmpty a
MatchesEmpty ([OptSym] -> [[OptSym]]
subtractEmptyString [OptSym]
sent)
    NonEmpty [OptSym]
sent -> [[OptSym]] -> MatchesEmpty [[OptSym]]
forall a. a -> MatchesEmpty a
NonEmpty [[OptSym]
sent]
  where
    fromOpt :: OptSym -> MatchesEmpty [OptSym]
fromOpt (Optional Sym
x) = [OptSym] -> MatchesEmpty [OptSym]
forall a. a -> MatchesEmpty a
MatchesEmpty [Sym -> OptSym
Optional Sym
x]
    fromOpt (NonOptional Sym
x) = [OptSym] -> MatchesEmpty [OptSym]
forall a. a -> MatchesEmpty a
NonEmpty [Sym -> OptSym
NonOptional Sym
x]

    subtractEmptyString :: [OptSym] -> [[OptSym]]
subtractEmptyString = ([OptSym] -> Maybe [OptSym]) -> [[OptSym]] -> [[OptSym]]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe [OptSym] -> Maybe [OptSym]
headNonOptional ([[OptSym]] -> [[OptSym]])
-> ([OptSym] -> [[OptSym]]) -> [OptSym] -> [[OptSym]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OptSym] -> [[OptSym]]
forall a. [a] -> [[a]]
List.tails

    headNonOptional :: [OptSym] -> Maybe [OptSym]
headNonOptional (Optional Sym
x : [OptSym]
xs) = [OptSym] -> Maybe [OptSym]
forall a. a -> Maybe a
Just (Sym -> OptSym
NonOptional Sym
x OptSym -> [OptSym] -> [OptSym]
forall a. a -> [a] -> [a]
: [OptSym]
xs)
    headNonOptional (NonOptional Sym
_ : [OptSym]
_) = [Char] -> Maybe [OptSym]
forall a. HasCallStack => [Char] -> a
error [Char]
"headNonOptional: unexpected that head is already NonOptional"
    headNonOptional [] = Maybe [OptSym]
forall a. Maybe a
Nothing

-- | Determines whether the given non-terminal category with the given
-- production rules could match empty.
--
-- The returned list is a /choice/ list of 'OptSentForm', with v'Optional'
-- applied to symbols which are within the known empty set. When combined using
-- choice, the returned list is equivalent to the original rules, /except/ that
-- the returned list has empty matches removed. If the category previously
-- matched empty, this is encoded as the v'MatchesEmpty' variant.
possiblyEmptyCat :: KnownEmpty -> (Cat, [Rule]) -> MatchesEmpty [OptSentForm]
possiblyEmptyCat :: KnownEmpty -> (Cat, [Rule]) -> MatchesEmpty [[OptSym]]
possiblyEmptyCat KnownEmpty
knownEmpty (Cat
_, [Rule]
rules) =
  [MatchesEmpty [[OptSym]]] -> MatchesEmpty [[OptSym]]
forall a. Monoid a => [MatchesEmpty a] -> MatchesEmpty a
choiceListMatchesEmpty ([MatchesEmpty [[OptSym]]] -> MatchesEmpty [[OptSym]])
-> [MatchesEmpty [[OptSym]]] -> MatchesEmpty [[OptSym]]
forall a b. (a -> b) -> a -> b
$ (Rule -> MatchesEmpty [[OptSym]])
-> [Rule] -> [MatchesEmpty [[OptSym]]]
forall a b. (a -> b) -> [a] -> [b]
map (KnownEmpty -> SentForm -> MatchesEmpty [[OptSym]]
possiblyEmptyRule KnownEmpty
knownEmpty (SentForm -> MatchesEmpty [[OptSym]])
-> (Rule -> SentForm) -> Rule -> MatchesEmpty [[OptSym]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rule -> SentForm
forall function. Rul function -> SentForm
rhsRule) [Rule]
rules

-- | Updates the set of known empty symbols according to the given grammar.
-- Returns the new set, which is made up of the previous set unioned with any
-- newly-discovered empty matching symbols.
--
-- This is one step of the fixpoint computation in 'fixPointKnownEmpty'.
possiblyEmptyCats :: [(Cat, [Rule])] -> KnownEmpty -> KnownEmpty
possiblyEmptyCats :: [(Cat, [Rule])] -> KnownEmpty -> KnownEmpty
possiblyEmptyCats [(Cat, [Rule])]
cats KnownEmpty
knownEmpty =
  Set Sym -> KnownEmpty
KnownEmpty (Set Sym -> KnownEmpty) -> Set Sym -> KnownEmpty
forall a b. (a -> b) -> a -> b
$
    SentForm -> Set Sym
forall a. Ord a => [a] -> Set a
Set.fromList (((Cat, [Rule]) -> Sym) -> [(Cat, [Rule])] -> SentForm
forall a b. (a -> b) -> [a] -> [b]
map (Cat -> Sym
forall a b. a -> Either a b
Left (Cat -> Sym) -> ((Cat, [Rule]) -> Cat) -> (Cat, [Rule]) -> Sym
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cat, [Rule]) -> Cat
forall a b. (a, b) -> a
fst) [(Cat, [Rule])]
newEmptyCats)
      Set Sym -> Set Sym -> Set Sym
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` KnownEmpty -> Set Sym
knownEmptySet KnownEmpty
knownEmpty
  where
    newEmptyCats :: [(Cat, [Rule])]
newEmptyCats = ((Cat, [Rule]) -> Bool) -> [(Cat, [Rule])] -> [(Cat, [Rule])]
forall a. (a -> Bool) -> [a] -> [a]
filter (MatchesEmpty [[OptSym]] -> Bool
forall a. MatchesEmpty a -> Bool
matchesEmpty (MatchesEmpty [[OptSym]] -> Bool)
-> ((Cat, [Rule]) -> MatchesEmpty [[OptSym]])
-> (Cat, [Rule])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KnownEmpty -> (Cat, [Rule]) -> MatchesEmpty [[OptSym]]
possiblyEmptyCat KnownEmpty
knownEmpty) [(Cat, [Rule])]
cats

-- * Fixpoint and transformations #fixpoint#
--
-- $fixpoint
-- For users of this module, these are the main functions of interest.

-- | Computes the complete set of symbols which are known to match empty,
-- using the given non-terminal production rules.
--
-- This should be given the list of parsable grammar rules, e.g., from
-- 'BNFC.CF.ruleGroups.
fixPointKnownEmpty :: [(Cat, [Rule])] -> KnownEmpty
fixPointKnownEmpty :: [(Cat, [Rule])] -> KnownEmpty
fixPointKnownEmpty [(Cat, [Rule])]
cats = KnownEmpty -> KnownEmpty
go (Set Sym -> KnownEmpty
KnownEmpty Set Sym
forall a. Set a
Set.empty)
  where
    step :: KnownEmpty -> KnownEmpty
step = [(Cat, [Rule])] -> KnownEmpty -> KnownEmpty
possiblyEmptyCats [(Cat, [Rule])]
cats

    go :: KnownEmpty -> KnownEmpty
go KnownEmpty
x = if KnownEmpty
x KnownEmpty -> KnownEmpty -> Bool
forall a. Eq a => a -> a -> Bool
== KnownEmpty
x' then KnownEmpty
x else KnownEmpty -> KnownEmpty
go KnownEmpty
x'
      where x' :: KnownEmpty
x' = KnownEmpty -> KnownEmpty
step KnownEmpty
x

-- | Transforms the given sentence such that the returned sentential form does
-- not match the empty string, and contains v'Optional' terms where needed.
--
-- The returned list is a /choice/ list which is equivalent to the given
-- sentential form, but for the (potential) subtraction of empty matches.
--
-- v'Optional' is inserted around symbols which previously matched the empty
-- string (according to the given 'KnownEmpty'). This compensates for
-- v'transformEmptyMatches' being applied to /other/ rules of the grammar.
--
-- After this transformation is applied to all rules of the grammar, the
-- grammar should accept an identical language. However, the exact nodes which
-- match certain strings might change.
transformEmptyMatches :: KnownEmpty -> SentForm -> [OptSentForm]
transformEmptyMatches :: KnownEmpty -> SentForm -> [[OptSym]]
transformEmptyMatches KnownEmpty
knownEmpty = MatchesEmpty [[OptSym]] -> [[OptSym]]
forall a. MatchesEmpty a -> a
unMatchesEmpty (MatchesEmpty [[OptSym]] -> [[OptSym]])
-> (SentForm -> MatchesEmpty [[OptSym]]) -> SentForm -> [[OptSym]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KnownEmpty -> SentForm -> MatchesEmpty [[OptSym]]
possiblyEmptyRule KnownEmpty
knownEmpty