-- | Reachability of nonterminals in the grammar.
{-# LANGUAGE ScopedTypeVariables #-}

module Data.Cfg.Reachable
  ( reachables
  , unreachables
  , removeUnreachables
  ) where

import Data.Cfg.Cfg (Cfg(..), V(..), Vs)
import Data.Cfg.FreeCfg (FreeCfg(..))
import qualified Data.Set as S

-- | Returns the nonterminals of this grammar reachable from the start
-- symbol.
reachables ::
     forall cfg t nt. (Cfg cfg t nt, Ord nt)
  => cfg t nt
  -> S.Set nt
reachables :: cfg t nt -> Set nt
reachables cfg t nt
cfg = [nt] -> Set nt -> Set nt
go [cfg t nt -> nt
forall (cfg :: * -> * -> *) t nt. Cfg cfg t nt => cfg t nt -> nt
startSymbol cfg t nt
cfg] Set nt
forall a. Set a
S.empty
  where
    go :: [nt] -> S.Set nt -> S.Set nt
    go :: [nt] -> Set nt -> Set nt
go [] Set nt
seen = Set nt
seen
    go (nt
nt:[nt]
nts) Set nt
seen =
      if nt
nt nt -> Set nt -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set nt
seen
        then [nt] -> Set nt -> Set nt
go [nt]
nts Set nt
seen
        else do
          let seen' :: Set nt
seen' = nt -> Set nt -> Set nt
forall a. Ord a => a -> Set a -> Set a
S.insert nt
nt Set nt
seen
          let vs :: [V t nt]
vs = [[V t nt]] -> [V t nt]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[V t nt]] -> [V t nt]) -> [[V t nt]] -> [V t nt]
forall a b. (a -> b) -> a -> b
$ Set [V t nt] -> [[V t nt]]
forall a. Set a -> [a]
S.toList (Set [V t nt] -> [[V t nt]]) -> Set [V t nt] -> [[V t nt]]
forall a b. (a -> b) -> a -> b
$ cfg t nt -> nt -> Set [V 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
          [nt] -> Set nt -> Set nt
go ([nt]
nts [nt] -> [nt] -> [nt]
forall a. [a] -> [a] -> [a]
++ [nt
nt' | NT nt
nt' <- [V t nt]
vs]) Set nt
seen'

-- | Returns the nonterminals of this grammar unreachable from the
-- start symbol.
unreachables ::
     forall cfg t nt. (Cfg cfg t nt, Ord nt)
  => cfg t nt
  -> S.Set nt
unreachables :: cfg t nt -> Set nt
unreachables cfg t nt
cfg = cfg t nt -> Set nt
forall (cfg :: * -> * -> *) t nt.
Cfg cfg t nt =>
cfg t nt -> Set nt
nonterminals cfg t nt
cfg Set nt -> Set nt -> Set nt
forall a. Ord a => Set a -> Set a -> Set a
S.\\ cfg t nt -> Set nt
forall (cfg :: * -> * -> *) t nt.
(Cfg cfg t nt, Ord nt) =>
cfg t nt -> Set nt
reachables cfg t nt
cfg

-- | Returns an equivalent grammar not including unreachable
-- nonterminals.
removeUnreachables ::
     forall cfg t nt. (Cfg cfg t nt, Ord nt)
  => cfg t nt
  -> FreeCfg t nt
removeUnreachables :: cfg t nt -> FreeCfg t nt
removeUnreachables cfg t nt
cfg =
  FreeCfg :: forall t nt.
Set nt -> Set t -> (nt -> Set (Vs t nt)) -> nt -> FreeCfg t nt
FreeCfg
    { nonterminals' :: Set nt
nonterminals' = Set nt
res
    , terminals' :: Set t
terminals' = cfg t nt -> Set t
forall (cfg :: * -> * -> *) t nt. Cfg cfg t nt => cfg t nt -> Set t
terminals cfg t nt
cfg
    , productionRules' :: nt -> Set (Vs t nt)
productionRules' = nt -> Set (Vs t nt)
pr
    , startSymbol' :: nt
startSymbol' = cfg t nt -> nt
forall (cfg :: * -> * -> *) t nt. Cfg cfg t nt => cfg t nt -> nt
startSymbol cfg t nt
cfg
    }
  where
    res :: S.Set nt
    res :: Set nt
res = cfg t nt -> Set nt
forall (cfg :: * -> * -> *) t nt.
(Cfg cfg t nt, Ord nt) =>
cfg t nt -> Set nt
reachables cfg t nt
cfg
    pr :: nt -> S.Set (Vs t nt)
    pr :: nt -> Set (Vs t nt)
pr nt
nt =
      if nt
nt nt -> Set nt -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set nt
res
        then 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
        else Set (Vs t nt)
forall a. Set a
S.empty