> module First ( mkFirst ) where > import GenUtils > import NameSet ( NameSet ) > import qualified NameSet as Set > import Grammar > import Data.IntSet (IntSet) > joinSymSets :: (a -> NameSet) -> [a] -> NameSet > joinSymSets :: forall a. (a -> NameSet) -> [a] -> NameSet joinSymSets a -> NameSet f = forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b foldr > (\ a h NameSet b -> let > h' :: NameSet h' = a -> NameSet f a h > in > if NameSet -> Bool incEmpty NameSet h' > then (Name -> Bool) -> NameSet -> NameSet Set.filter (Bool -> Bool notforall b c a. (b -> c) -> (a -> b) -> a -> c . Name -> Bool isEmpty) NameSet h' NameSet -> NameSet -> NameSet `Set.union` NameSet b > else NameSet h') > (Name -> NameSet Set.singleton Name epsilonTok) > incEmpty :: NameSet -> Bool > incEmpty :: NameSet -> Bool incEmpty NameSet set = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any Name -> Bool isEmpty (NameSet -> [Name] Set.toAscList NameSet set) > mkFirst :: Grammar -> [Name] -> NameSet > mkFirst :: Grammar -> [Name] -> NameSet mkFirst (Grammar { first_term :: Grammar -> Name first_term = Name fst_term > , lookupProdNo :: Grammar -> Name -> Production lookupProdNo = Name -> Production prodNo > , lookupProdsOfName :: Grammar -> Name -> [Name] lookupProdsOfName = Name -> [Name] prodsOfName > , non_terminals :: Grammar -> [Name] non_terminals = [Name] nts > }) > = forall a. (a -> NameSet) -> [a] -> NameSet joinSymSets (\ Name h -> case forall a b. Eq a => a -> [(a, b)] -> Maybe b lookup Name h [(Name, NameSet)] env of > Maybe NameSet Nothing -> Name -> NameSet Set.singleton Name h > Just NameSet ix -> NameSet ix) > where > env :: [(Name, NameSet)] env = forall a. (a -> a -> Bool) -> (a -> a) -> a -> a mkClosure forall a. Eq a => a -> a -> Bool (==) (forall a b c d. Name -> (a -> (b, [Name], c, d)) -> (Name -> [a]) -> [(Name, NameSet)] -> [(Name, NameSet)] getNext Name fst_term Name -> Production prodNo Name -> [Name] prodsOfName) > [ (Name name,NameSet Set.empty) | Name name <- [Name] nts ] > getNext :: Name -> (a -> (b, [Name], c, d)) -> (Name -> [a]) > -> [(Name, IntSet)] -> [(Name, NameSet)] > getNext :: forall a b c d. Name -> (a -> (b, [Name], c, d)) -> (Name -> [a]) -> [(Name, NameSet)] -> [(Name, NameSet)] getNext Name fst_term a -> (b, [Name], c, d) prodNo Name -> [a] prodsOfName [(Name, NameSet)] env = > [ (Name nm, Name -> NameSet next Name nm) | (Name nm,NameSet _) <- [(Name, NameSet)] env ] > where > fn :: Name -> NameSet fn Name t | Name t forall a. Eq a => a -> a -> Bool == Name errorTok Bool -> Bool -> Bool || Name t forall a. Ord a => a -> a -> Bool >= Name fst_term = Name -> NameSet Set.singleton Name t > fn Name x = case forall a b. Eq a => a -> [(a, b)] -> Maybe b lookup Name x [(Name, NameSet)] env of > Just NameSet t -> NameSet t > Maybe NameSet Nothing -> forall a. HasCallStack => [Char] -> a error [Char] "attempted FIRST(e) :-(" > next :: Name -> NameSet > next :: Name -> NameSet next Name t | Name t forall a. Ord a => a -> a -> Bool >= Name fst_term = Name -> NameSet Set.singleton Name t > next Name n = > forall a. (a -> a -> a) -> [a] -> a foldb NameSet -> NameSet -> NameSet Set.union > [ forall a. (a -> NameSet) -> [a] -> NameSet joinSymSets Name -> NameSet fn (forall a b c d. (a, b, c, d) -> b snd4 (a -> (b, [Name], c, d) prodNo a rl)) | > a rl <- Name -> [a] prodsOfName Name n ] > snd4 :: (a, b, c, d) -> b > snd4 :: forall a b c d. (a, b, c, d) -> b snd4 (a _,b b,c _,d _) = b b