    -----------------------------------------------------------------------------
    Implementation of FIRST

    (c) 1993-2001 Andy Gill, Simon Marlow
    -----------------------------------------------------------------------------

    > module Happy.Tabular.First ( mkFirst, mkClosure ) where

    > import Happy.Tabular.NameSet ( NameSet )
    > import qualified Happy.Tabular.NameSet as Set
    > import Happy.Grammar
    > import Data.Maybe (fromMaybe)

    \subsection{Utilities}

    > joinSymSets :: (a -> NameSet) -> [a] -> NameSet
    > joinSymSets :: forall a. (a -> NameSet) -> [a] -> NameSet
    joinSymSets a -> NameSet
    f = (NameSet -> NameSet -> NameSet) -> NameSet -> [NameSet] -> NameSet
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr NameSet -> NameSet -> NameSet
    go (Name -> NameSet
    Set.singleton Name
    epsilonTok) ([NameSet] -> NameSet) -> ([a] -> [NameSet]) -> [a] -> NameSet
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> NameSet) -> [a] -> [NameSet]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> NameSet
    f
    >    where
    >       go :: NameSet -> NameSet -> NameSet
    go NameSet
    h NameSet
    b
    >           | Name -> NameSet -> Bool
    Set.member Name
    epsilonTok NameSet
    h = Name -> NameSet -> NameSet
    Set.delete Name
    epsilonTok NameSet
    h NameSet -> NameSet -> NameSet
    `Set.union` NameSet
    b
    >           | Bool
    otherwise = NameSet
    h

    @mkClosure@ makes a closure, when given a comparison and iteration loop.
    It's a fixed point computation, we keep applying the function over the
    input until it does not change.
    Be careful, because if the functional always makes the object different,
    This will never terminate.

    > mkClosure :: (a -> a -> Bool) -> (a -> a) -> a -> a
    > mkClosure :: forall a. (a -> a -> Bool) -> (a -> a) -> a -> a
    mkClosure a -> a -> Bool
    eq a -> a
    f = (a -> Bool) -> (a -> a) -> a -> a
    forall a. (a -> Bool) -> (a -> a) -> a -> a
    until (\a
    x -> a -> a -> Bool
    eq a
    x (a -> a
    f a
    x)) a -> a
    f

    \subsection{Implementation of FIRST}

    > mkFirst :: Grammar e -> [Name] -> NameSet
    > mkFirst :: forall e. Grammar e -> [Name] -> NameSet
    mkFirst (Grammar { first_term :: forall eliminator. Grammar eliminator -> Name
    first_term = Name
    fst_term
    >                  , lookupProdNo :: forall eliminator.
    Grammar eliminator -> Int -> Production eliminator
    lookupProdNo = Int -> Production e
    prodNo
    >                  , lookupProdsOfName :: forall eliminator. Grammar eliminator -> Name -> [Int]
    lookupProdsOfName = Name -> [Int]
    prodsOfName
    >                  , non_terminals :: forall eliminator. Grammar eliminator -> [Name]
    non_terminals = [Name]
    nts
    >                  })
    >       = (Name -> NameSet) -> [Name] -> NameSet
    forall a. (a -> NameSet) -> [a] -> NameSet
    joinSymSets (\Name
    h -> NameSet -> Maybe NameSet -> NameSet
    forall a. a -> Maybe a -> a
    fromMaybe (Name -> NameSet
    Set.singleton Name
    h) (Name -> [(Name, NameSet)] -> Maybe NameSet
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Name
    h [(Name, NameSet)]
    env))
    >   where
    >       env :: [(Name, NameSet)]
    env = ([(Name, NameSet)] -> [(Name, NameSet)] -> Bool)
    -> ([(Name, NameSet)] -> [(Name, NameSet)])
    -> [(Name, NameSet)]
    -> [(Name, NameSet)]
    forall a. (a -> a -> Bool) -> (a -> a) -> a -> a
    mkClosure [(Name, NameSet)] -> [(Name, NameSet)] -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) (Name
    -> (Int -> Production e)
    -> (Name -> [Int])
    -> [(Name, NameSet)]
    -> [(Name, NameSet)]
    forall a e.
    Name
    -> (a -> Production e)
    -> (Name -> [a])
    -> [(Name, NameSet)]
    -> [(Name, NameSet)]
    updateFirstSets Name
    fst_term Int -> Production e
    prodNo Name -> [Int]
    prodsOfName) [(Name
    name,NameSet
    Set.empty) | Name
    name <- [Name]
    nts]

    > updateFirstSets :: Name -> (a -> Production e) -> (Name -> [a]) -> [(Name, NameSet)]
    >                 -> [(Name, NameSet)]
    > updateFirstSets :: forall a e.
    Name
    -> (a -> Production e)
    -> (Name -> [a])
    -> [(Name, NameSet)]
    -> [(Name, NameSet)]
    updateFirstSets Name
    fst_term a -> Production e
    prodNo Name -> [a]
    prodsOfName [(Name, NameSet)]
    env = [ (Name
    nm, Name -> NameSet
    nextFstSet Name
    nm)
    >                                                   | (Name
    nm,NameSet
    _) <- [(Name, NameSet)]
    env ]
    >    where
    >       terminalP :: Name -> Bool
    >       terminalP :: Name -> Bool
    terminalP Name
    s = Name
    s Name -> Name -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Name
    fst_term

    >       currFstSet :: Name -> NameSet
    >       currFstSet :: Name -> NameSet
    currFstSet Name
    s | Name
    s Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    errorTok Bool -> Bool -> Bool
    || Name
    s Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    catchTok Bool -> Bool -> Bool
    || Name -> Bool
    terminalP Name
    s = Name -> NameSet
    Set.singleton Name
    s
    >                    | Bool
    otherwise = NameSet -> (NameSet -> NameSet) -> Maybe NameSet -> NameSet
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ([Char] -> NameSet
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "attempted FIRST(e) :-(")
    >                                    NameSet -> NameSet
    forall a. a -> a
    id (Name -> [(Name, NameSet)] -> Maybe NameSet
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Name
    s [(Name, NameSet)]
    env)

    >       nextFstSet :: Name -> NameSet
    >       nextFstSet :: Name -> NameSet
    nextFstSet Name
    s | Name -> Bool
    terminalP Name
    s = Name -> NameSet
    Set.singleton Name
    s
    >                    | Bool
    otherwise   = [NameSet] -> NameSet
    Set.unions [ (Name -> NameSet) -> [Name] -> NameSet
    forall a. (a -> NameSet) -> [a] -> NameSet
    joinSymSets Name -> NameSet
    currFstSet [Name]
    rhs
    >                                               | a
    rl <- Name -> [a]
    prodsOfName Name
    s
    >                                               , let Production Name
    _ [Name]
    rhs (e, [Int])
    _ Priority
    _ = a -> Production e
    prodNo a
    rl ]