{-# LANGUAGE Haskell2010 #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
module CheckCFGAmbiguity (TerminalOrNonterminal(..), checkAmbiguity, Result(..)) where
import qualified Data.Map
import qualified Data.Set
import Control.Monad.ST(runST)
import Data.STRef(newSTRef, readSTRef, writeSTRef)
import Data.Foldable(for_)
import Data.Maybe(fromJust, catMaybes)
import Data.List(find)
infixl 1 <&>
(<&>) :: (Functor f) => f a -> (a -> b) -> f b
f a
a <&> :: f a -> (a -> b) -> f b
<&> a -> b
b = (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
b f a
a
data TerminalOrNonterminal t n = T t | N n deriving (TerminalOrNonterminal t n -> TerminalOrNonterminal t n -> Bool
(TerminalOrNonterminal t n -> TerminalOrNonterminal t n -> Bool)
-> (TerminalOrNonterminal t n -> TerminalOrNonterminal t n -> Bool)
-> Eq (TerminalOrNonterminal t n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall t n.
(Eq t, Eq n) =>
TerminalOrNonterminal t n -> TerminalOrNonterminal t n -> Bool
/= :: TerminalOrNonterminal t n -> TerminalOrNonterminal t n -> Bool
$c/= :: forall t n.
(Eq t, Eq n) =>
TerminalOrNonterminal t n -> TerminalOrNonterminal t n -> Bool
== :: TerminalOrNonterminal t n -> TerminalOrNonterminal t n -> Bool
$c== :: forall t n.
(Eq t, Eq n) =>
TerminalOrNonterminal t n -> TerminalOrNonterminal t n -> Bool
Eq, Eq (TerminalOrNonterminal t n)
Eq (TerminalOrNonterminal t n)
-> (TerminalOrNonterminal t n
-> TerminalOrNonterminal t n -> Ordering)
-> (TerminalOrNonterminal t n -> TerminalOrNonterminal t n -> Bool)
-> (TerminalOrNonterminal t n -> TerminalOrNonterminal t n -> Bool)
-> (TerminalOrNonterminal t n -> TerminalOrNonterminal t n -> Bool)
-> (TerminalOrNonterminal t n -> TerminalOrNonterminal t n -> Bool)
-> (TerminalOrNonterminal t n
-> TerminalOrNonterminal t n -> TerminalOrNonterminal t n)
-> (TerminalOrNonterminal t n
-> TerminalOrNonterminal t n -> TerminalOrNonterminal t n)
-> Ord (TerminalOrNonterminal t n)
TerminalOrNonterminal t n -> TerminalOrNonterminal t n -> Bool
TerminalOrNonterminal t n -> TerminalOrNonterminal t n -> Ordering
TerminalOrNonterminal t n
-> TerminalOrNonterminal t n -> TerminalOrNonterminal t n
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 n. (Ord t, Ord n) => Eq (TerminalOrNonterminal t n)
forall t n.
(Ord t, Ord n) =>
TerminalOrNonterminal t n -> TerminalOrNonterminal t n -> Bool
forall t n.
(Ord t, Ord n) =>
TerminalOrNonterminal t n -> TerminalOrNonterminal t n -> Ordering
forall t n.
(Ord t, Ord n) =>
TerminalOrNonterminal t n
-> TerminalOrNonterminal t n -> TerminalOrNonterminal t n
min :: TerminalOrNonterminal t n
-> TerminalOrNonterminal t n -> TerminalOrNonterminal t n
$cmin :: forall t n.
(Ord t, Ord n) =>
TerminalOrNonterminal t n
-> TerminalOrNonterminal t n -> TerminalOrNonterminal t n
max :: TerminalOrNonterminal t n
-> TerminalOrNonterminal t n -> TerminalOrNonterminal t n
$cmax :: forall t n.
(Ord t, Ord n) =>
TerminalOrNonterminal t n
-> TerminalOrNonterminal t n -> TerminalOrNonterminal t n
>= :: TerminalOrNonterminal t n -> TerminalOrNonterminal t n -> Bool
$c>= :: forall t n.
(Ord t, Ord n) =>
TerminalOrNonterminal t n -> TerminalOrNonterminal t n -> Bool
> :: TerminalOrNonterminal t n -> TerminalOrNonterminal t n -> Bool
$c> :: forall t n.
(Ord t, Ord n) =>
TerminalOrNonterminal t n -> TerminalOrNonterminal t n -> Bool
<= :: TerminalOrNonterminal t n -> TerminalOrNonterminal t n -> Bool
$c<= :: forall t n.
(Ord t, Ord n) =>
TerminalOrNonterminal t n -> TerminalOrNonterminal t n -> Bool
< :: TerminalOrNonterminal t n -> TerminalOrNonterminal t n -> Bool
$c< :: forall t n.
(Ord t, Ord n) =>
TerminalOrNonterminal t n -> TerminalOrNonterminal t n -> Bool
compare :: TerminalOrNonterminal t n -> TerminalOrNonterminal t n -> Ordering
$ccompare :: forall t n.
(Ord t, Ord n) =>
TerminalOrNonterminal t n -> TerminalOrNonterminal t n -> Ordering
$cp1Ord :: forall t n. (Ord t, Ord n) => Eq (TerminalOrNonterminal t n)
Ord, Int -> TerminalOrNonterminal t n -> ShowS
[TerminalOrNonterminal t n] -> ShowS
TerminalOrNonterminal t n -> String
(Int -> TerminalOrNonterminal t n -> ShowS)
-> (TerminalOrNonterminal t n -> String)
-> ([TerminalOrNonterminal t n] -> ShowS)
-> Show (TerminalOrNonterminal t n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t n.
(Show t, Show n) =>
Int -> TerminalOrNonterminal t n -> ShowS
forall t n.
(Show t, Show n) =>
[TerminalOrNonterminal t n] -> ShowS
forall t n. (Show t, Show n) => TerminalOrNonterminal t n -> String
showList :: [TerminalOrNonterminal t n] -> ShowS
$cshowList :: forall t n.
(Show t, Show n) =>
[TerminalOrNonterminal t n] -> ShowS
show :: TerminalOrNonterminal t n -> String
$cshow :: forall t n. (Show t, Show n) => TerminalOrNonterminal t n -> String
showsPrec :: Int -> TerminalOrNonterminal t n -> ShowS
$cshowsPrec :: forall t n.
(Show t, Show n) =>
Int -> TerminalOrNonterminal t n -> ShowS
Show)
data Grammar t n = Grammar (Data.Map.Map n [[TerminalOrNonterminal t n]]) deriving (Grammar t n -> Grammar t n -> Bool
(Grammar t n -> Grammar t n -> Bool)
-> (Grammar t n -> Grammar t n -> Bool) -> Eq (Grammar t n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall t n. (Eq n, Eq t) => Grammar t n -> Grammar t n -> Bool
/= :: Grammar t n -> Grammar t n -> Bool
$c/= :: forall t n. (Eq n, Eq t) => Grammar t n -> Grammar t n -> Bool
== :: Grammar t n -> Grammar t n -> Bool
$c== :: forall t n. (Eq n, Eq t) => Grammar t n -> Grammar t n -> Bool
Eq, Eq (Grammar t n)
Eq (Grammar t n)
-> (Grammar t n -> Grammar t n -> Ordering)
-> (Grammar t n -> Grammar t n -> Bool)
-> (Grammar t n -> Grammar t n -> Bool)
-> (Grammar t n -> Grammar t n -> Bool)
-> (Grammar t n -> Grammar t n -> Bool)
-> (Grammar t n -> Grammar t n -> Grammar t n)
-> (Grammar t n -> Grammar t n -> Grammar t n)
-> Ord (Grammar t n)
Grammar t n -> Grammar t n -> Bool
Grammar t n -> Grammar t n -> Ordering
Grammar t n -> Grammar t n -> Grammar t n
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 n. (Ord n, Ord t) => Eq (Grammar t n)
forall t n. (Ord n, Ord t) => Grammar t n -> Grammar t n -> Bool
forall t n.
(Ord n, Ord t) =>
Grammar t n -> Grammar t n -> Ordering
forall t n.
(Ord n, Ord t) =>
Grammar t n -> Grammar t n -> Grammar t n
min :: Grammar t n -> Grammar t n -> Grammar t n
$cmin :: forall t n.
(Ord n, Ord t) =>
Grammar t n -> Grammar t n -> Grammar t n
max :: Grammar t n -> Grammar t n -> Grammar t n
$cmax :: forall t n.
(Ord n, Ord t) =>
Grammar t n -> Grammar t n -> Grammar t n
>= :: Grammar t n -> Grammar t n -> Bool
$c>= :: forall t n. (Ord n, Ord t) => Grammar t n -> Grammar t n -> Bool
> :: Grammar t n -> Grammar t n -> Bool
$c> :: forall t n. (Ord n, Ord t) => Grammar t n -> Grammar t n -> Bool
<= :: Grammar t n -> Grammar t n -> Bool
$c<= :: forall t n. (Ord n, Ord t) => Grammar t n -> Grammar t n -> Bool
< :: Grammar t n -> Grammar t n -> Bool
$c< :: forall t n. (Ord n, Ord t) => Grammar t n -> Grammar t n -> Bool
compare :: Grammar t n -> Grammar t n -> Ordering
$ccompare :: forall t n.
(Ord n, Ord t) =>
Grammar t n -> Grammar t n -> Ordering
$cp1Ord :: forall t n. (Ord n, Ord t) => Eq (Grammar t n)
Ord, Int -> Grammar t n -> ShowS
[Grammar t n] -> ShowS
Grammar t n -> String
(Int -> Grammar t n -> ShowS)
-> (Grammar t n -> String)
-> ([Grammar t n] -> ShowS)
-> Show (Grammar t n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t n. (Show n, Show t) => Int -> Grammar t n -> ShowS
forall t n. (Show n, Show t) => [Grammar t n] -> ShowS
forall t n. (Show n, Show t) => Grammar t n -> String
showList :: [Grammar t n] -> ShowS
$cshowList :: forall t n. (Show n, Show t) => [Grammar t n] -> ShowS
show :: Grammar t n -> String
$cshow :: forall t n. (Show n, Show t) => Grammar t n -> String
showsPrec :: Int -> Grammar t n -> ShowS
$cshowsPrec :: forall t n. (Show n, Show t) => Int -> Grammar t n -> ShowS
Show)
toGrammar :: (Ord n) => Data.Map.Map n [[TerminalOrNonterminal t n]] -> Maybe (Grammar t n)
toGrammar :: Map n [[TerminalOrNonterminal t n]] -> Maybe (Grammar t n)
toGrammar Map n [[TerminalOrNonterminal t n]]
g = if ([[TerminalOrNonterminal t n]] -> Bool)
-> Map n [[TerminalOrNonterminal t n]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\[[TerminalOrNonterminal t n]]
prods -> ([TerminalOrNonterminal t n] -> Bool)
-> [[TerminalOrNonterminal t n]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\[TerminalOrNonterminal t n]
prod -> (TerminalOrNonterminal t n -> Bool)
-> [TerminalOrNonterminal t n] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\case {
T t
_ -> Bool
True;
N n
nn -> n -> Map n [[TerminalOrNonterminal t n]] -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Data.Map.member n
nn Map n [[TerminalOrNonterminal t n]]
g;
}) [TerminalOrNonterminal t n]
prod) [[TerminalOrNonterminal t n]]
prods) Map n [[TerminalOrNonterminal t n]]
g
then Grammar t n -> Maybe (Grammar t n)
forall a. a -> Maybe a
Just (Map n [[TerminalOrNonterminal t n]] -> Grammar t n
forall t n. Map n [[TerminalOrNonterminal t n]] -> Grammar t n
Grammar Map n [[TerminalOrNonterminal t n]]
g)
else Maybe (Grammar t n)
forall a. Maybe a
Nothing
while :: (Monad m) => m Bool -> m ()
while :: m Bool -> m ()
while m Bool
body = do {
Bool
continue <- m Bool
body;
if Bool
continue
then m Bool -> m ()
forall (m :: * -> *). Monad m => m Bool -> m ()
while m Bool
body
else () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ();
}
data LowLevelTestAmbiguityResult = LLNoStart | LLAmbiguous | LLUnambiguous deriving (LowLevelTestAmbiguityResult -> LowLevelTestAmbiguityResult -> Bool
(LowLevelTestAmbiguityResult
-> LowLevelTestAmbiguityResult -> Bool)
-> (LowLevelTestAmbiguityResult
-> LowLevelTestAmbiguityResult -> Bool)
-> Eq LowLevelTestAmbiguityResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LowLevelTestAmbiguityResult -> LowLevelTestAmbiguityResult -> Bool
$c/= :: LowLevelTestAmbiguityResult -> LowLevelTestAmbiguityResult -> Bool
== :: LowLevelTestAmbiguityResult -> LowLevelTestAmbiguityResult -> Bool
$c== :: LowLevelTestAmbiguityResult -> LowLevelTestAmbiguityResult -> Bool
Eq, Eq LowLevelTestAmbiguityResult
Eq LowLevelTestAmbiguityResult
-> (LowLevelTestAmbiguityResult
-> LowLevelTestAmbiguityResult -> Ordering)
-> (LowLevelTestAmbiguityResult
-> LowLevelTestAmbiguityResult -> Bool)
-> (LowLevelTestAmbiguityResult
-> LowLevelTestAmbiguityResult -> Bool)
-> (LowLevelTestAmbiguityResult
-> LowLevelTestAmbiguityResult -> Bool)
-> (LowLevelTestAmbiguityResult
-> LowLevelTestAmbiguityResult -> Bool)
-> (LowLevelTestAmbiguityResult
-> LowLevelTestAmbiguityResult -> LowLevelTestAmbiguityResult)
-> (LowLevelTestAmbiguityResult
-> LowLevelTestAmbiguityResult -> LowLevelTestAmbiguityResult)
-> Ord LowLevelTestAmbiguityResult
LowLevelTestAmbiguityResult -> LowLevelTestAmbiguityResult -> Bool
LowLevelTestAmbiguityResult
-> LowLevelTestAmbiguityResult -> Ordering
LowLevelTestAmbiguityResult
-> LowLevelTestAmbiguityResult -> LowLevelTestAmbiguityResult
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
min :: LowLevelTestAmbiguityResult
-> LowLevelTestAmbiguityResult -> LowLevelTestAmbiguityResult
$cmin :: LowLevelTestAmbiguityResult
-> LowLevelTestAmbiguityResult -> LowLevelTestAmbiguityResult
max :: LowLevelTestAmbiguityResult
-> LowLevelTestAmbiguityResult -> LowLevelTestAmbiguityResult
$cmax :: LowLevelTestAmbiguityResult
-> LowLevelTestAmbiguityResult -> LowLevelTestAmbiguityResult
>= :: LowLevelTestAmbiguityResult -> LowLevelTestAmbiguityResult -> Bool
$c>= :: LowLevelTestAmbiguityResult -> LowLevelTestAmbiguityResult -> Bool
> :: LowLevelTestAmbiguityResult -> LowLevelTestAmbiguityResult -> Bool
$c> :: LowLevelTestAmbiguityResult -> LowLevelTestAmbiguityResult -> Bool
<= :: LowLevelTestAmbiguityResult -> LowLevelTestAmbiguityResult -> Bool
$c<= :: LowLevelTestAmbiguityResult -> LowLevelTestAmbiguityResult -> Bool
< :: LowLevelTestAmbiguityResult -> LowLevelTestAmbiguityResult -> Bool
$c< :: LowLevelTestAmbiguityResult -> LowLevelTestAmbiguityResult -> Bool
compare :: LowLevelTestAmbiguityResult
-> LowLevelTestAmbiguityResult -> Ordering
$ccompare :: LowLevelTestAmbiguityResult
-> LowLevelTestAmbiguityResult -> Ordering
$cp1Ord :: Eq LowLevelTestAmbiguityResult
Ord, Int -> LowLevelTestAmbiguityResult -> ShowS
[LowLevelTestAmbiguityResult] -> ShowS
LowLevelTestAmbiguityResult -> String
(Int -> LowLevelTestAmbiguityResult -> ShowS)
-> (LowLevelTestAmbiguityResult -> String)
-> ([LowLevelTestAmbiguityResult] -> ShowS)
-> Show LowLevelTestAmbiguityResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LowLevelTestAmbiguityResult] -> ShowS
$cshowList :: [LowLevelTestAmbiguityResult] -> ShowS
show :: LowLevelTestAmbiguityResult -> String
$cshow :: LowLevelTestAmbiguityResult -> String
showsPrec :: Int -> LowLevelTestAmbiguityResult -> ShowS
$cshowsPrec :: Int -> LowLevelTestAmbiguityResult -> ShowS
Show)
lowLevelTestAmbiguity :: (Ord n, Ord t) => Grammar t n -> n -> Int -> LowLevelTestAmbiguityResult
lowLevelTestAmbiguity :: Grammar t n -> n -> Int -> LowLevelTestAmbiguityResult
lowLevelTestAmbiguity (Grammar Map n [[TerminalOrNonterminal t n]]
g) n
start Int
count = case n -> Map n [[TerminalOrNonterminal t n]] -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Data.Map.member n
start Map n [[TerminalOrNonterminal t n]]
g of {
Bool
False -> LowLevelTestAmbiguityResult
LLNoStart;
Bool
True -> (forall s. ST s LowLevelTestAmbiguityResult)
-> LowLevelTestAmbiguityResult
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s LowLevelTestAmbiguityResult)
-> LowLevelTestAmbiguityResult)
-> (forall s. ST s LowLevelTestAmbiguityResult)
-> LowLevelTestAmbiguityResult
forall a b. (a -> b) -> a -> b
$ do {
STRef s (Set [TerminalOrNonterminal t n])
allWords <- Set [TerminalOrNonterminal t n]
-> ST s (STRef s (Set [TerminalOrNonterminal t n]))
forall a s. a -> ST s (STRef s a)
newSTRef (Set [TerminalOrNonterminal t n]
-> ST s (STRef s (Set [TerminalOrNonterminal t n])))
-> Set [TerminalOrNonterminal t n]
-> ST s (STRef s (Set [TerminalOrNonterminal t n]))
forall a b. (a -> b) -> a -> b
$ [TerminalOrNonterminal t n] -> Set [TerminalOrNonterminal t n]
forall a. a -> Set a
Data.Set.singleton [n -> TerminalOrNonterminal t n
forall t n. n -> TerminalOrNonterminal t n
N n
start];
STRef s [[TerminalOrNonterminal t n]]
currWords <- [[TerminalOrNonterminal t n]]
-> ST s (STRef s [[TerminalOrNonterminal t n]])
forall a s. a -> ST s (STRef s a)
newSTRef [[n -> TerminalOrNonterminal t n
forall t n. n -> TerminalOrNonterminal t n
N n
start]];
STRef s Int
i <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
0;
STRef s Bool
collision <- Bool -> ST s (STRef s Bool)
forall a s. a -> ST s (STRef s a)
newSTRef Bool
False;
ST s Bool -> ST s ()
forall (m :: * -> *). Monad m => m Bool -> m ()
while (ST s Bool -> ST s ()) -> ST s Bool -> ST s ()
forall a b. (a -> b) -> a -> b
$ do {
do {
[[TerminalOrNonterminal t n]]
currWordsV <- STRef s [[TerminalOrNonterminal t n]]
-> ST s [[TerminalOrNonterminal t n]]
forall s a. STRef s a -> ST s a
readSTRef STRef s [[TerminalOrNonterminal t n]]
currWords;
STRef s [[TerminalOrNonterminal t n]]
-> [[TerminalOrNonterminal t n]] -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s [[TerminalOrNonterminal t n]]
currWords [];
[[TerminalOrNonterminal t n]]
-> ([TerminalOrNonterminal t n] -> ST s ()) -> ST s ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [[TerminalOrNonterminal t n]]
currWordsV (([TerminalOrNonterminal t n] -> ST s ()) -> ST s ())
-> ([TerminalOrNonterminal t n] -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \[TerminalOrNonterminal t n]
word -> do {
let { ([TerminalOrNonterminal t n]
before, [TerminalOrNonterminal t n]
after) = (TerminalOrNonterminal t n -> Bool)
-> [TerminalOrNonterminal t n]
-> ([TerminalOrNonterminal t n], [TerminalOrNonterminal t n])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\case { N n
_ -> Bool
True; T t
_ -> Bool
False; }) [TerminalOrNonterminal t n]
word };
case [TerminalOrNonterminal t n]
after of {
[] -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ();
(N n
nn):[TerminalOrNonterminal t n]
rest -> [[TerminalOrNonterminal t n]]
-> ([TerminalOrNonterminal t n] -> ST s ()) -> ST s ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Maybe [[TerminalOrNonterminal t n]]
-> [[TerminalOrNonterminal t n]]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [[TerminalOrNonterminal t n]]
-> [[TerminalOrNonterminal t n]])
-> Maybe [[TerminalOrNonterminal t n]]
-> [[TerminalOrNonterminal t n]]
forall a b. (a -> b) -> a -> b
$ n
-> Map n [[TerminalOrNonterminal t n]]
-> Maybe [[TerminalOrNonterminal t n]]
forall k a. Ord k => k -> Map k a -> Maybe a
Data.Map.lookup n
nn Map n [[TerminalOrNonterminal t n]]
g) (([TerminalOrNonterminal t n] -> ST s ()) -> ST s ())
-> ([TerminalOrNonterminal t n] -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \[TerminalOrNonterminal t n]
prod -> do {
let { newWord :: [TerminalOrNonterminal t n]
newWord = [TerminalOrNonterminal t n]
before [TerminalOrNonterminal t n]
-> [TerminalOrNonterminal t n] -> [TerminalOrNonterminal t n]
forall a. [a] -> [a] -> [a]
++ [TerminalOrNonterminal t n]
prod [TerminalOrNonterminal t n]
-> [TerminalOrNonterminal t n] -> [TerminalOrNonterminal t n]
forall a. [a] -> [a] -> [a]
++ [TerminalOrNonterminal t n]
rest };
do {
Set [TerminalOrNonterminal t n]
allWordsV <- STRef s (Set [TerminalOrNonterminal t n])
-> ST s (Set [TerminalOrNonterminal t n])
forall s a. STRef s a -> ST s a
readSTRef STRef s (Set [TerminalOrNonterminal t n])
allWords;
if [TerminalOrNonterminal t n]
-> Set [TerminalOrNonterminal t n] -> Bool
forall a. Ord a => a -> Set a -> Bool
Data.Set.member [TerminalOrNonterminal t n]
newWord Set [TerminalOrNonterminal t n]
allWordsV
then STRef s Bool -> Bool -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Bool
collision Bool
True
else () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ();
STRef s (Set [TerminalOrNonterminal t n])
-> Set [TerminalOrNonterminal t n] -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (Set [TerminalOrNonterminal t n])
allWords (Set [TerminalOrNonterminal t n] -> ST s ())
-> Set [TerminalOrNonterminal t n] -> ST s ()
forall a b. (a -> b) -> a -> b
$ [TerminalOrNonterminal t n]
-> Set [TerminalOrNonterminal t n]
-> Set [TerminalOrNonterminal t n]
forall a. Ord a => a -> Set a -> Set a
Data.Set.insert [TerminalOrNonterminal t n]
newWord Set [TerminalOrNonterminal t n]
allWordsV;
};
[[TerminalOrNonterminal t n]]
currWordsV2 <- STRef s [[TerminalOrNonterminal t n]]
-> ST s [[TerminalOrNonterminal t n]]
forall s a. STRef s a -> ST s a
readSTRef STRef s [[TerminalOrNonterminal t n]]
currWords;
STRef s [[TerminalOrNonterminal t n]]
-> [[TerminalOrNonterminal t n]] -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s [[TerminalOrNonterminal t n]]
currWords ([[TerminalOrNonterminal t n]] -> ST s ())
-> [[TerminalOrNonterminal t n]] -> ST s ()
forall a b. (a -> b) -> a -> b
$ [TerminalOrNonterminal t n]
newWord[TerminalOrNonterminal t n]
-> [[TerminalOrNonterminal t n]] -> [[TerminalOrNonterminal t n]]
forall a. a -> [a] -> [a]
:[[TerminalOrNonterminal t n]]
currWordsV2;
};
[TerminalOrNonterminal t n]
_ -> String -> ST s ()
forall a. HasCallStack => String -> a
error String
"Impossible";
};
};
};
Int
iV <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
i;
STRef s Int -> Int -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Int
i (Int
iV Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1);
Bool
collisionV <- STRef s Bool -> ST s Bool
forall s a. STRef s a -> ST s a
readSTRef STRef s Bool
collision;
Bool -> ST s Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Bool
not Bool
collisionV Bool -> Bool -> Bool
&& Int
iV Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
count);
};
Bool
collisionV <- STRef s Bool -> ST s Bool
forall s a. STRef s a -> ST s a
readSTRef STRef s Bool
collision;
if Bool
collisionV
then LowLevelTestAmbiguityResult -> ST s LowLevelTestAmbiguityResult
forall (m :: * -> *) a. Monad m => a -> m a
return LowLevelTestAmbiguityResult
LLAmbiguous
else LowLevelTestAmbiguityResult -> ST s LowLevelTestAmbiguityResult
forall (m :: * -> *) a. Monad m => a -> m a
return LowLevelTestAmbiguityResult
LLUnambiguous;
};
}
ntsProduceNonEmptyLang :: (Ord n) => Grammar t n -> Bool
ntsProduceNonEmptyLang :: Grammar t n -> Bool
ntsProduceNonEmptyLang (Grammar Map n [[TerminalOrNonterminal t n]]
g) = let {
g2 :: Map n [[n]]
g2 = Map n [[TerminalOrNonterminal t n]]
g Map n [[TerminalOrNonterminal t n]]
-> ([[TerminalOrNonterminal t n]] -> [[n]]) -> Map n [[n]]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\[[TerminalOrNonterminal t n]]
prods -> [[TerminalOrNonterminal t n]]
prods [[TerminalOrNonterminal t n]]
-> ([TerminalOrNonterminal t n] -> [n]) -> [[n]]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\[TerminalOrNonterminal t n]
prod -> [Maybe n] -> [n]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe n] -> [n]) -> [Maybe n] -> [n]
forall a b. (a -> b) -> a -> b
$ [TerminalOrNonterminal t n]
prod [TerminalOrNonterminal t n]
-> (TerminalOrNonterminal t n -> Maybe n) -> [Maybe n]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\case {
N n
a -> n -> Maybe n
forall a. a -> Maybe a
Just n
a;
T t
_ -> Maybe n
forall a. Maybe a
Nothing;
})));
rec :: Map k [[k]] -> Bool
rec Map k [[k]]
g3 = case Map k [[k]] -> Bool
forall k a. Map k a -> Bool
Data.Map.null Map k [[k]]
g3 of {
Bool
True -> Bool
True;
Bool
False -> case ((k, [[k]]) -> Bool) -> [(k, [[k]])] -> Maybe (k, [[k]])
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (([k] -> Bool) -> [[k]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [k] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([[k]] -> Bool) -> ((k, [[k]]) -> [[k]]) -> (k, [[k]]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k, [[k]]) -> [[k]]
forall a b. (a, b) -> b
snd) (Map k [[k]] -> [(k, [[k]])]
forall k a. Map k a -> [(k, a)]
Data.Map.toList Map k [[k]]
g3) of {
Just (k
x, [[k]]
_) -> Map k [[k]] -> Bool
rec (Map k [[k]] -> Bool) -> Map k [[k]] -> Bool
forall a b. (a -> b) -> a -> b
$ ([[k]] -> [[k]]) -> Map k [[k]] -> Map k [[k]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([k] -> [k]) -> [[k]] -> [[k]]
forall a b. (a -> b) -> [a] -> [b]
map ((k -> Bool) -> [k] -> [k]
forall a. (a -> Bool) -> [a] -> [a]
filter (k -> k -> Bool
forall a. Eq a => a -> a -> Bool
/= k
x))) (k -> Map k [[k]] -> Map k [[k]]
forall k a. Ord k => k -> Map k a -> Map k a
Data.Map.delete k
x Map k [[k]]
g3);
Maybe (k, [[k]])
Nothing -> Bool
False;
};
};
} in Map n [[n]] -> Bool
forall k. Ord k => Map k [[k]] -> Bool
rec Map n [[n]]
g2
data Result
= WrongCount
| NTNotFound
| NoStart
| EmptyLang
| Ambiguous
| SeemsUnambiguous deriving (Result -> Result -> Bool
(Result -> Result -> Bool)
-> (Result -> Result -> Bool) -> Eq Result
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result -> Result -> Bool
$c/= :: Result -> Result -> Bool
== :: Result -> Result -> Bool
$c== :: Result -> Result -> Bool
Eq, Eq Result
Eq Result
-> (Result -> Result -> Ordering)
-> (Result -> Result -> Bool)
-> (Result -> Result -> Bool)
-> (Result -> Result -> Bool)
-> (Result -> Result -> Bool)
-> (Result -> Result -> Result)
-> (Result -> Result -> Result)
-> Ord Result
Result -> Result -> Bool
Result -> Result -> Ordering
Result -> Result -> Result
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
min :: Result -> Result -> Result
$cmin :: Result -> Result -> Result
max :: Result -> Result -> Result
$cmax :: Result -> Result -> Result
>= :: Result -> Result -> Bool
$c>= :: Result -> Result -> Bool
> :: Result -> Result -> Bool
$c> :: Result -> Result -> Bool
<= :: Result -> Result -> Bool
$c<= :: Result -> Result -> Bool
< :: Result -> Result -> Bool
$c< :: Result -> Result -> Bool
compare :: Result -> Result -> Ordering
$ccompare :: Result -> Result -> Ordering
$cp1Ord :: Eq Result
Ord, Int -> Result -> ShowS
[Result] -> ShowS
Result -> String
(Int -> Result -> ShowS)
-> (Result -> String) -> ([Result] -> ShowS) -> Show Result
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Result] -> ShowS
$cshowList :: [Result] -> ShowS
show :: Result -> String
$cshow :: Result -> String
showsPrec :: Int -> Result -> ShowS
$cshowsPrec :: Int -> Result -> ShowS
Show)
checkAmbiguity :: (Ord n, Ord t) => Data.Map.Map n [[TerminalOrNonterminal t n]]
-> n
-> Int
-> Result
checkAmbiguity :: Map n [[TerminalOrNonterminal t n]] -> n -> Int -> Result
checkAmbiguity Map n [[TerminalOrNonterminal t n]]
g n
start Int
count = case Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 of {
Bool
False -> Result
WrongCount;
Bool
True -> case Map n [[TerminalOrNonterminal t n]] -> Maybe (Grammar t n)
forall n t.
Ord n =>
Map n [[TerminalOrNonterminal t n]] -> Maybe (Grammar t n)
toGrammar Map n [[TerminalOrNonterminal t n]]
g of {
Maybe (Grammar t n)
Nothing -> Result
NTNotFound;
Just Grammar t n
gg -> case n -> Map n [[TerminalOrNonterminal t n]] -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Data.Map.member n
start Map n [[TerminalOrNonterminal t n]]
g of {
Bool
False -> Result
NoStart;
Bool
True -> case Grammar t n -> Bool
forall n t. Ord n => Grammar t n -> Bool
ntsProduceNonEmptyLang Grammar t n
gg of {
Bool
False -> Result
EmptyLang;
Bool
True -> case Grammar t n -> n -> Int -> LowLevelTestAmbiguityResult
forall n t.
(Ord n, Ord t) =>
Grammar t n -> n -> Int -> LowLevelTestAmbiguityResult
lowLevelTestAmbiguity Grammar t n
gg n
start Int
count of {
LowLevelTestAmbiguityResult
LLNoStart -> String -> Result
forall a. HasCallStack => String -> a
error String
"Impossible";
LowLevelTestAmbiguityResult
LLAmbiguous -> Result
Ambiguous;
LowLevelTestAmbiguityResult
LLUnambiguous -> Result
SeemsUnambiguous;
};
};
};
};
}