-- | Nullable nonterminals
{-# LANGUAGE ScopedTypeVariables #-}

module Data.Cfg.Internal.Nullable
  ( nullables
  ) where

import Control.Monad (guard)
import Data.Cfg.Cfg
import Data.Cfg.FixedPoint (fixedPoint)
import qualified Data.Set as S

-- | Returns the nonterminals in the grammar that can produce the
-- empty string.
nullables ::
     forall cfg t nt. (Cfg cfg t nt, Ord nt)
  => cfg t nt
  -> S.Set nt
nullables :: cfg t nt -> Set nt
nullables cfg t nt
cfg = (Set nt -> Set nt) -> Set nt -> Set nt
forall a. Eq a => (a -> a) -> a -> a
fixedPoint Set nt -> Set nt
go Set nt
forall a. Set a
S.empty
  where
    go :: S.Set nt -> S.Set nt
    go :: Set nt -> Set nt
go Set nt
knownNullables = Set nt
calculatedNullables
      where
        isKnownNullable :: V t nt -> Bool
        isKnownNullable :: V t nt -> Bool
isKnownNullable (NT nt
nm) = nt
nm nt -> Set nt -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set nt
knownNullables
        isKnownNullable V t nt
_ = Bool
False
        calculatedNullables :: S.Set nt
        calculatedNullables :: Set nt
calculatedNullables =
          [nt] -> Set nt
forall a. Ord a => [a] -> Set a
S.fromList ([nt] -> Set nt) -> [nt] -> Set nt
forall a b. (a -> b) -> a -> b
$ do
            nt
nt <- Set nt -> [nt]
forall a. Set a -> [a]
S.toList (Set nt -> [nt]) -> Set nt -> [nt]
forall a b. (a -> b) -> a -> b
$ cfg t nt -> Set nt
forall (cfg :: * -> * -> *) t nt.
Cfg cfg t nt =>
cfg t nt -> Set nt
nonterminals cfg t nt
cfg
            let rhss :: [Vs t nt]
rhss = Set (Vs t nt) -> [Vs t nt]
forall a. Set a -> [a]
S.toList (Set (Vs t nt) -> [Vs t nt]) -> Set (Vs t nt) -> [Vs t nt]
forall a b. (a -> b) -> a -> b
$ cfg t nt -> nt -> Set (Vs t nt)
forall (cfg :: * -> * -> *) t nt.
Cfg cfg t nt =>
cfg t nt -> nt -> Set (Vs t nt)
productionRules cfg t nt
cfg nt
nt
            Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ (Vs t nt -> Bool) -> [Vs t nt] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((V t nt -> Bool) -> Vs t nt -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all V t nt -> Bool
isKnownNullable) [Vs t nt]
rhss
            nt -> [nt]
forall (m :: * -> *) a. Monad m => a -> m a
return nt
nt