-- | Context-free grammars.
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Data.Cfg.Cfg
  ( -- * Class
  Cfg(..)
    -- * Vocabulary
  , V(..)
  , Vs
  , isNT
  , isT
  , bimapV
  , bimapVs
  , vocabulary
  , usedVocabulary
  , undeclaredVocabulary
  , isFullyDeclared
    -- * Productions
  , Production
  , productions
    -- * Utility functions
  , eqCfg {- ,
    compareCfg -}
  ) where

import Control.Monad (liftM4)
import Control.Monad.Reader (ask)
import Data.Cfg.CPretty
import Data.Data (Data, Typeable)
import qualified Data.Set as S
import Text.PrettyPrint
import qualified Text.PrettyPrint as P

------------------------------------------------------------
-- | Represents a context-free grammar with its nonterminal and
-- terminal types.
class Cfg cfg t nt where
  nonterminals :: cfg t nt -> S.Set nt
    -- ^ the nonterminals of the grammar
  terminals :: cfg t nt -> S.Set t
    -- ^ the terminals of the grammar
  productionRules :: cfg t nt -> nt -> S.Set (Vs t nt)
    -- ^ the productions of the grammar
  startSymbol :: cfg t nt -> nt-- ^ the start symbol of the grammar; must be an element of
    -- 'nonterminals' 'cfg'

instance (Cfg cfg t nt) => CPretty (cfg t nt) (V t nt -> Doc) where
  cpretty :: cfg t nt -> m Doc
cpretty cfg t nt
cfg = (Doc -> Doc -> Doc -> Doc -> Doc)
-> m Doc -> m Doc -> m Doc -> m Doc -> m Doc
forall (m :: * -> *) a1 a2 a3 a4 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
liftM4 Doc -> Doc -> Doc -> Doc -> Doc
vcat' m Doc
ss m Doc
ts m Doc
nts m Doc
prods
    where
      vcat' :: Doc -> Doc -> Doc -> Doc -> Doc
vcat' Doc
a Doc
b Doc
c Doc
d = [Doc] -> Doc
vcat [Doc
a, Doc
b, Doc
c, Doc
d]
      ss :: m Doc
ss = do
        V t nt -> Doc
prettyV <- m (V t nt -> Doc)
forall r (m :: * -> *). MonadReader r m => m r
ask
        Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Doc
text String
"Start symbol:" Doc -> Doc -> Doc
<+> V t nt -> Doc
prettyV (nt -> V t nt
forall t nt. nt -> V t nt
NT (nt -> V t nt) -> nt -> V t nt
forall a b. (a -> b) -> a -> b
$ cfg t nt -> nt
forall (cfg :: * -> * -> *) t nt. Cfg cfg t nt => cfg t nt -> nt
startSymbol cfg t nt
cfg))
      ts :: m Doc
ts = do
        V t nt -> Doc
prettyV <- m (V t nt -> Doc)
forall r (m :: * -> *). MonadReader r m => m r
ask
        Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return
          (String -> Doc
text String
"Terminals:" Doc -> Doc -> Doc
<+>
           [Doc] -> Doc
fsep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (t -> Doc) -> [t] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (V t nt -> Doc
prettyV (V t nt -> Doc) -> (t -> V t nt) -> t -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> V t nt
forall t nt. t -> V t nt
T) (Set t -> [t]
forall a. Set a -> [a]
S.toList (Set t -> [t]) -> Set t -> [t]
forall a b. (a -> b) -> a -> b
$ cfg t nt -> Set t
forall (cfg :: * -> * -> *) t nt. Cfg cfg t nt => cfg t nt -> Set t
terminals cfg t nt
cfg)))
      nts :: m Doc
nts = do
        V t nt -> Doc
prettyV <- m (V t nt -> Doc)
forall r (m :: * -> *). MonadReader r m => m r
ask
        Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return
          (String -> Doc
text String
"Nonterminals:" Doc -> Doc -> Doc
<+>
           [Doc] -> Doc
fsep
             (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (nt -> Doc) -> [nt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (V t nt -> Doc
prettyV (V t nt -> Doc) -> (nt -> V t nt) -> nt -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. nt -> V t nt
forall t nt. nt -> V t 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)))
      prods :: m Doc
prods = do
        V t nt -> Doc
prettyV <- m (V t nt -> Doc)
forall r (m :: * -> *). MonadReader r m => m r
ask
        Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return
          (String -> Doc
text String
"Productions:" Doc -> Doc -> Doc
$$
           Int -> Doc -> Doc
nest
             Int
4
             ([Doc] -> Doc
vcat (((Int, (nt, [V t nt])) -> Doc) -> [(Int, (nt, [V t nt]))] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((V t nt -> Doc) -> (Int, (nt, [V t nt])) -> Doc
forall t nt. (V t nt -> Doc) -> (Int, (nt, [V t nt])) -> Doc
prettyProd V t nt -> Doc
prettyV) ([Int] -> [(nt, [V t nt])] -> [(Int, (nt, [V t nt]))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] ([(nt, [V t nt])] -> [(Int, (nt, [V t nt]))])
-> [(nt, [V t nt])] -> [(Int, (nt, [V t nt]))]
forall a b. (a -> b) -> a -> b
$ cfg t nt -> [(nt, [V t nt])]
forall (cfg :: * -> * -> *) t nt.
Cfg cfg t nt =>
cfg t nt -> [Production t nt]
productions cfg t nt
cfg))))
        where
          prettyProd :: (V t nt -> Doc) -> (Int, (nt, [V t nt])) -> Doc
prettyProd V t nt -> Doc
pv (Int
n, (nt
hd, [V t nt]
rhs)) =
            [Doc] -> Doc
hsep [Doc -> Doc
parens (Int -> Doc
int Int
n), V t nt -> Doc
pv (nt -> V t nt
forall t nt. nt -> V t nt
NT nt
hd), String -> Doc
text String
"::=", Doc
rhs' Doc -> Doc -> Doc
P.<> String -> Doc
text String
"."]
            where
              rhs' :: Doc
rhs' = [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (V t nt -> Doc) -> [V t nt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map V t nt -> Doc
pv [V t nt]
rhs

------------------------------------------------------------
------------------------------------------------------------
-- | Vocabulary symbols of the grammar.
data V t nt
  = T t -- ^ a terminal
  | NT nt -- ^ a nonterminal
  deriving (V t nt -> V t nt -> Bool
(V t nt -> V t nt -> Bool)
-> (V t nt -> V t nt -> Bool) -> Eq (V t nt)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall t nt. (Eq t, Eq nt) => V t nt -> V t nt -> Bool
/= :: V t nt -> V t nt -> Bool
$c/= :: forall t nt. (Eq t, Eq nt) => V t nt -> V t nt -> Bool
== :: V t nt -> V t nt -> Bool
$c== :: forall t nt. (Eq t, Eq nt) => V t nt -> V t nt -> Bool
Eq, Eq (V t nt)
Eq (V t nt)
-> (V t nt -> V t nt -> Ordering)
-> (V t nt -> V t nt -> Bool)
-> (V t nt -> V t nt -> Bool)
-> (V t nt -> V t nt -> Bool)
-> (V t nt -> V t nt -> Bool)
-> (V t nt -> V t nt -> V t nt)
-> (V t nt -> V t nt -> V t nt)
-> Ord (V t nt)
V t nt -> V t nt -> Bool
V t nt -> V t nt -> Ordering
V t nt -> V t nt -> V t nt
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall t nt. (Ord t, Ord nt) => Eq (V t nt)
forall t nt. (Ord t, Ord nt) => V t nt -> V t nt -> Bool
forall t nt. (Ord t, Ord nt) => V t nt -> V t nt -> Ordering
forall t nt. (Ord t, Ord nt) => V t nt -> V t nt -> V t nt
min :: V t nt -> V t nt -> V t nt
$cmin :: forall t nt. (Ord t, Ord nt) => V t nt -> V t nt -> V t nt
max :: V t nt -> V t nt -> V t nt
$cmax :: forall t nt. (Ord t, Ord nt) => V t nt -> V t nt -> V t nt
>= :: V t nt -> V t nt -> Bool
$c>= :: forall t nt. (Ord t, Ord nt) => V t nt -> V t nt -> Bool
> :: V t nt -> V t nt -> Bool
$c> :: forall t nt. (Ord t, Ord nt) => V t nt -> V t nt -> Bool
<= :: V t nt -> V t nt -> Bool
$c<= :: forall t nt. (Ord t, Ord nt) => V t nt -> V t nt -> Bool
< :: V t nt -> V t nt -> Bool
$c< :: forall t nt. (Ord t, Ord nt) => V t nt -> V t nt -> Bool
compare :: V t nt -> V t nt -> Ordering
$ccompare :: forall t nt. (Ord t, Ord nt) => V t nt -> V t nt -> Ordering
$cp1Ord :: forall t nt. (Ord t, Ord nt) => Eq (V t nt)
Ord, Int -> V t nt -> ShowS
[V t nt] -> ShowS
V t nt -> String
(Int -> V t nt -> ShowS)
-> (V t nt -> String) -> ([V t nt] -> ShowS) -> Show (V t nt)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t nt. (Show t, Show nt) => Int -> V t nt -> ShowS
forall t nt. (Show t, Show nt) => [V t nt] -> ShowS
forall t nt. (Show t, Show nt) => V t nt -> String
showList :: [V t nt] -> ShowS
$cshowList :: forall t nt. (Show t, Show nt) => [V t nt] -> ShowS
show :: V t nt -> String
$cshow :: forall t nt. (Show t, Show nt) => V t nt -> String
showsPrec :: Int -> V t nt -> ShowS
$cshowsPrec :: forall t nt. (Show t, Show nt) => Int -> V t nt -> ShowS
Show, Typeable (V t nt)
DataType
Constr
Typeable (V t nt)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> V t nt -> c (V t nt))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (V t nt))
-> (V t nt -> Constr)
-> (V t nt -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (V t nt)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (V t nt)))
-> ((forall b. Data b => b -> b) -> V t nt -> V t nt)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> V t nt -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> V t nt -> r)
-> (forall u. (forall d. Data d => d -> u) -> V t nt -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> V t nt -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> V t nt -> m (V t nt))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> V t nt -> m (V t nt))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> V t nt -> m (V t nt))
-> Data (V t nt)
V t nt -> DataType
V t nt -> Constr
(forall b. Data b => b -> b) -> V t nt -> V t nt
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> V t nt -> c (V t nt)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (V t nt)
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (V t nt))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> V t nt -> u
forall u. (forall d. Data d => d -> u) -> V t nt -> [u]
forall t nt. (Data t, Data nt) => Typeable (V t nt)
forall t nt. (Data t, Data nt) => V t nt -> DataType
forall t nt. (Data t, Data nt) => V t nt -> Constr
forall t nt.
(Data t, Data nt) =>
(forall b. Data b => b -> b) -> V t nt -> V t nt
forall t nt u.
(Data t, Data nt) =>
Int -> (forall d. Data d => d -> u) -> V t nt -> u
forall t nt u.
(Data t, Data nt) =>
(forall d. Data d => d -> u) -> V t nt -> [u]
forall t nt r r'.
(Data t, Data nt) =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> V t nt -> r
forall t nt r r'.
(Data t, Data nt) =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> V t nt -> r
forall t nt (m :: * -> *).
(Data t, Data nt, Monad m) =>
(forall d. Data d => d -> m d) -> V t nt -> m (V t nt)
forall t nt (m :: * -> *).
(Data t, Data nt, MonadPlus m) =>
(forall d. Data d => d -> m d) -> V t nt -> m (V t nt)
forall t nt (c :: * -> *).
(Data t, Data nt) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (V t nt)
forall t nt (c :: * -> *).
(Data t, Data nt) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> V t nt -> c (V t nt)
forall t nt (t :: * -> *) (c :: * -> *).
(Data t, Data nt, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (V t nt))
forall t nt (t :: * -> * -> *) (c :: * -> *).
(Data t, Data nt, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (V t nt))
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> V t nt -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> V t nt -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> V t nt -> m (V t nt)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> V t nt -> m (V t nt)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (V t nt)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> V t nt -> c (V t nt)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (V t nt))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (V t nt))
$cNT :: Constr
$cT :: Constr
$tV :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> V t nt -> m (V t nt)
$cgmapMo :: forall t nt (m :: * -> *).
(Data t, Data nt, MonadPlus m) =>
(forall d. Data d => d -> m d) -> V t nt -> m (V t nt)
gmapMp :: (forall d. Data d => d -> m d) -> V t nt -> m (V t nt)
$cgmapMp :: forall t nt (m :: * -> *).
(Data t, Data nt, MonadPlus m) =>
(forall d. Data d => d -> m d) -> V t nt -> m (V t nt)
gmapM :: (forall d. Data d => d -> m d) -> V t nt -> m (V t nt)
$cgmapM :: forall t nt (m :: * -> *).
(Data t, Data nt, Monad m) =>
(forall d. Data d => d -> m d) -> V t nt -> m (V t nt)
gmapQi :: Int -> (forall d. Data d => d -> u) -> V t nt -> u
$cgmapQi :: forall t nt u.
(Data t, Data nt) =>
Int -> (forall d. Data d => d -> u) -> V t nt -> u
gmapQ :: (forall d. Data d => d -> u) -> V t nt -> [u]
$cgmapQ :: forall t nt u.
(Data t, Data nt) =>
(forall d. Data d => d -> u) -> V t nt -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> V t nt -> r
$cgmapQr :: forall t nt r r'.
(Data t, Data nt) =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> V t nt -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> V t nt -> r
$cgmapQl :: forall t nt r r'.
(Data t, Data nt) =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> V t nt -> r
gmapT :: (forall b. Data b => b -> b) -> V t nt -> V t nt
$cgmapT :: forall t nt.
(Data t, Data nt) =>
(forall b. Data b => b -> b) -> V t nt -> V t nt
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (V t nt))
$cdataCast2 :: forall t nt (t :: * -> * -> *) (c :: * -> *).
(Data t, Data nt, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (V t nt))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (V t nt))
$cdataCast1 :: forall t nt (t :: * -> *) (c :: * -> *).
(Data t, Data nt, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (V t nt))
dataTypeOf :: V t nt -> DataType
$cdataTypeOf :: forall t nt. (Data t, Data nt) => V t nt -> DataType
toConstr :: V t nt -> Constr
$ctoConstr :: forall t nt. (Data t, Data nt) => V t nt -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (V t nt)
$cgunfold :: forall t nt (c :: * -> *).
(Data t, Data nt) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (V t nt)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> V t nt -> c (V t nt)
$cgfoldl :: forall t nt (c :: * -> *).
(Data t, Data nt) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> V t nt -> c (V t nt)
$cp1Data :: forall t nt. (Data t, Data nt) => Typeable (V t nt)
Data, Typeable)

-- | Returns 'True' iff the vocabularly symbols is a terminal.
isT :: V t nt -> Bool
isT :: V t nt -> Bool
isT (T t
_) = Bool
True
isT V t nt
_ = Bool
False

-- | Returns 'True' iff the vocabularly symbols is a nonterminal.
isNT :: V t nt -> Bool
isNT :: V t nt -> Bool
isNT (NT nt
_) = Bool
True
isNT V t nt
_ = Bool
False

instance Functor (V t) where
  fmap :: (a -> b) -> V t a -> V t b
fmap a -> b
_f (T t
t) = t -> V t b
forall t nt. t -> V t nt
T t
t
  fmap a -> b
f (NT a
nt) = b -> V t b
forall t nt. nt -> V t nt
NT (b -> V t b) -> b -> V t b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
nt

-- | Maps over the terminal and nonterminal symbols in a 'V'.
bimapV :: (t -> t') -> (nt -> nt') -> V t nt -> V t' nt'
bimapV :: (t -> t') -> (nt -> nt') -> V t nt -> V t' nt'
bimapV t -> t'
f nt -> nt'
_g (T t
t) = t' -> V t' nt'
forall t nt. t -> V t nt
T (t' -> V t' nt') -> t' -> V t' nt'
forall a b. (a -> b) -> a -> b
$ t -> t'
f t
t
bimapV t -> t'
_f nt -> nt'
g (NT nt
nt) = nt' -> V t' nt'
forall t nt. nt -> V t nt
NT (nt' -> V t' nt') -> nt' -> V t' nt'
forall a b. (a -> b) -> a -> b
$ nt -> nt'
g nt
nt

-- | Returns the vocabulary symbols of the grammar: elements of
-- 'terminals' and 'nonterminals'.
vocabulary :: (Cfg cfg t nt, Ord nt, Ord t) => cfg t nt -> S.Set (V t nt)
vocabulary :: cfg t nt -> Set (V t nt)
vocabulary cfg t nt
cfg = (t -> V t nt) -> Set t -> Set (V t nt)
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map t -> V t nt
forall t nt. t -> V t nt
T (cfg t nt -> Set t
forall (cfg :: * -> * -> *) t nt. Cfg cfg t nt => cfg t nt -> Set t
terminals cfg t nt
cfg) Set (V t nt) -> Set (V t nt) -> Set (V t nt)
forall a. Ord a => Set a -> Set a -> Set a
`S.union` (nt -> V t nt) -> Set nt -> Set (V t nt)
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map nt -> V t nt
forall t nt. nt -> V t nt
NT (cfg t nt -> Set nt
forall (cfg :: * -> * -> *) t nt.
Cfg cfg t nt =>
cfg t nt -> Set nt
nonterminals cfg t nt
cfg)

-- | Synonym for lists of vocabulary symbols.
type Vs t nt = [V t nt]

-- | Maps over the terminal and nonterminal symbols in a list of 'V's.
bimapVs :: (t -> t') -> (nt -> nt') -> Vs t nt -> Vs t' nt'
bimapVs :: (t -> t') -> (nt -> nt') -> Vs t nt -> Vs t' nt'
bimapVs t -> t'
f nt -> nt'
g = (V t nt -> V t' nt') -> Vs t nt -> Vs t' nt'
forall a b. (a -> b) -> [a] -> [b]
map ((t -> t') -> (nt -> nt') -> V t nt -> V t' nt'
forall t t' nt nt'. (t -> t') -> (nt -> nt') -> V t nt -> V t' nt'
bimapV t -> t'
f nt -> nt'
g)

-- | Productions over vocabulary symbols
type Production t nt = (nt, Vs t nt)

-- | Returns the productions of the grammar.
productions :: (Cfg cfg t nt) => cfg t nt -> [Production t nt]
productions :: cfg t nt -> [Production t nt]
productions cfg t nt
cfg = 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
  Vs t nt
vs <- 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
  Production t nt -> [Production t nt]
forall (m :: * -> *) a. Monad m => a -> m a
return (nt
nt, Vs t nt
vs)

-- | Returns 'True' iff the two inhabitants of 'Cfg' are equal.
eqCfg ::
     forall cfg cfg' t nt. (Cfg cfg t nt, Cfg cfg' t nt, Eq nt, Eq t)
  => cfg t nt
  -> cfg' t nt
  -> Bool
eqCfg :: cfg t nt -> cfg' t nt -> Bool
eqCfg cfg t nt
cfg cfg' t nt
cfg' = cfg t nt -> (nt, Set nt, Set t, [Production t nt])
forall (cfg :: * -> * -> *) t nt.
Cfg cfg t nt =>
cfg t nt -> (nt, Set nt, Set t, [Production t nt])
to4Tuple cfg t nt
cfg (nt, Set nt, Set t, [Production t nt])
-> (nt, Set nt, Set t, [Production t nt]) -> Bool
forall a. Eq a => a -> a -> Bool
== cfg' t nt -> (nt, Set nt, Set t, [Production t nt])
forall (cfg :: * -> * -> *) t nt.
Cfg cfg t nt =>
cfg t nt -> (nt, Set nt, Set t, [Production t nt])
to4Tuple cfg' t nt
cfg'

{------------------------------------------------------------

-- | Compares the two inhabitants of 'Cfg'.
compareCfg :: forall cfg cfg' t nt
       . (Cfg cfg t nt, Cfg cfg' t nt, Ord nt, Ord t)
       => cfg t nt -> cfg' t nt -> Ordering
compareCfg cfg cfg' = compare (to4Tuple cfg) (to4Tuple cfg')

------------------------------------------------------------}
-- | Converts the 'Cfg' to a 4-tuple that inhabits both 'Eq' and 'Ord'
-- if 't' and 'nt' do.
to4Tuple ::
     forall cfg t nt. (Cfg cfg t nt)
  => cfg t nt
  -> (nt, S.Set nt, S.Set t, [Production t nt])-- We move the start symbol first to optimize the operations
    -- since it's most likely to differ.
to4Tuple :: cfg t nt -> (nt, Set nt, Set t, [Production t nt])
to4Tuple cfg t nt
cfg =
  (cfg t nt -> nt
forall (cfg :: * -> * -> *) t nt. Cfg cfg t nt => cfg t nt -> nt
startSymbol 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, cfg t nt -> Set t
forall (cfg :: * -> * -> *) t nt. Cfg cfg t nt => cfg t nt -> Set t
terminals cfg t nt
cfg, cfg t nt -> [Production t nt]
forall (cfg :: * -> * -> *) t nt.
Cfg cfg t nt =>
cfg t nt -> [Production t nt]
productions cfg t nt
cfg)

-- | Returns all vocabulary used in the productions plus the start
-- symbol.
usedVocabulary :: (Cfg cfg t nt, Ord nt, Ord t) => cfg t nt -> S.Set (V t nt)
usedVocabulary :: cfg t nt -> Set (V t nt)
usedVocabulary cfg t nt
cfg =
  [V t nt] -> Set (V t nt)
forall a. Ord a => [a] -> Set a
S.fromList ([V t nt] -> Set (V t nt)) -> [V t nt] -> Set (V t nt)
forall a b. (a -> b) -> a -> b
$
  nt -> V t nt
forall t nt. nt -> V t nt
NT (cfg t nt -> nt
forall (cfg :: * -> * -> *) t nt. Cfg cfg t nt => cfg t nt -> nt
startSymbol cfg t nt
cfg) V t nt -> [V t nt] -> [V t nt]
forall a. a -> [a] -> [a]
: [[V t nt]] -> [V t nt]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [nt -> V t nt
forall t nt. nt -> V t nt
NT nt
nt V t nt -> [V t nt] -> [V t nt]
forall a. a -> [a] -> [a]
: [V t nt]
vs | (nt
nt, [V t nt]
vs) <- cfg t nt -> [(nt, [V t nt])]
forall (cfg :: * -> * -> *) t nt.
Cfg cfg t nt =>
cfg t nt -> [Production t nt]
productions cfg t nt
cfg]

-- | Returns all vocabulary used in the productions plus the start
-- symbol but not declared in 'nonterminals' or 'terminals'.
undeclaredVocabulary ::
     (Cfg cfg t nt, Ord nt, Ord t) => cfg t nt -> S.Set (V t nt)
undeclaredVocabulary :: cfg t nt -> Set (V t nt)
undeclaredVocabulary cfg t nt
cfg = cfg t nt -> Set (V t nt)
forall (cfg :: * -> * -> *) t nt.
(Cfg cfg t nt, Ord nt, Ord t) =>
cfg t nt -> Set (V t nt)
usedVocabulary cfg t nt
cfg Set (V t nt) -> Set (V t nt) -> Set (V t nt)
forall a. Ord a => Set a -> Set a -> Set a
S.\\ cfg t nt -> Set (V t nt)
forall (cfg :: * -> * -> *) t nt.
(Cfg cfg t nt, Ord nt, Ord t) =>
cfg t nt -> Set (V t nt)
vocabulary cfg t nt
cfg

------------------------------------------------------------
-- | Returns 'True' all the vocabulary used in the grammar is
-- declared.
isFullyDeclared :: (Cfg cfg t nt, Ord nt, Ord t) => cfg t nt -> Bool
isFullyDeclared :: cfg t nt -> Bool
isFullyDeclared = Set (V t nt) -> Bool
forall a. Set a -> Bool
S.null (Set (V t nt) -> Bool)
-> (cfg t nt -> Set (V t nt)) -> cfg t nt -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. cfg t nt -> Set (V t nt)
forall (cfg :: * -> * -> *) t nt.
(Cfg cfg t nt, Ord nt, Ord t) =>
cfg t nt -> Set (V t nt)
undeclaredVocabulary