I found myself wanting to brush up on some notions about parsers and grammars and, at the same time, to exercise my Haskell - I am a Haskell newbie; moreover, I haven't touched the language at all in a couple months.You can find the complete result here, and, separated by hrs and without the module boilerplate, pasted below.I'm not exactly happy with it.It seems somewhat dirty and convoluted for something that is stated so simply in a few lines of English in the reference textbook - (meaning, the (Purple) Dragon Book).I am also noticing a complete lack of typically functional constructs - function composition, curried functions, etc - which might be a code smell.On the other hand, after spending a couple nights on it, I can't seem to find any more opportunity for improvement: I'm stuck.Any suggestions both in the small and in the large scale are appreciated.----------------------------------- Datatypes and utilities---------------------------------data Terminal = T String | Dollar | Epsilon deriving (Show, Eq, Ord)data Nonterminal = NT String | Start String deriving (Show, Eq, Ord)type Symbol = (Either Nonterminal Terminal)data Production = Prod {left_hand :: Nonterminal, right_hand :: [Symbol]} deriving (Show, Eq)data Grammar = Grammar [Production] deriving (Show)allTerminalsInGrammar :: Grammar -> Set TerminalallTerminalsInGrammar (Grammar []) = Data.Set.emptyallTerminalsInGrammar (Grammar (prod:prods)) =  (    Data.Set.union    (allTerminalsInGrammar (Grammar prods))    (Data.Set.fromList $ onlyTerminals (right_hand prod))    )  where onlyTerminals a = rights aallNonterminalsInGrammar :: Grammar -> Set NonterminalallNonterminalsInGrammar (Grammar []) = Data.Set.emptyallNonterminalsInGrammar (Grammar (prod:prods)) =  (    Data.Set.union    (allNonterminalsInGrammar (Grammar prods))    (Data.Set.singleton (left_hand prod))    )type FirstSet = (Set Terminal)type FollowSet = (Set Terminal)data FirstMap = FirstMap (Data.Map.Map Nonterminal (Set Terminal)) deriving (Show, Eq)-- A FirstMap maps a symbol to its FirstSetdata FollowMap = FollowMap (Data.Map.Map Nonterminal (Set Terminal)) deriving (Show, Eq)-- A FollowMap maps a symbol to its FollowSetgetFirstSetFor :: Nonterminal -> FirstMap -> FirstSetgetFirstSetFor nonterminal (FirstMap firstmap) =  f $ Data.Map.lookup nonterminal firstmap  where    f Nothing = Data.Set.empty    f (Just set) = setgetFollowSetFor :: Nonterminal -> FollowMap -> FollowSetgetFollowSetFor nonterminal (FollowMap firstmap) =  f $ Data.Map.lookup nonterminal firstmap  where    f Nothing = Data.Set.empty    f (Just set) = setmergeSetIntoFirstMap :: FirstMap -> Nonterminal -> Set Terminal -> FirstMapmergeSetIntoFirstMap (FirstMap map) nt t = FirstMap (insertWith (Data.Set.union) nt t map)mergeSetIntoFollowMap :: FollowMap -> Nonterminal -> Set Terminal -> FollowMapmergeSetIntoFollowMap (FollowMap map) nt t = FollowMap (insertWith (Data.Set.union) nt t map)---------------------------------------------------------fixpoint :: Eq a => (a -> a) -> a -> afixpoint f x = let x' = f x in if x == x' then x else fixpoint f x'------------------------------------------------------ FIRST gives  to each nonterminal;---- Then repeat:---- If X is a terminal then FIRST(X) = {X}-- If X is a nonterminal--   If X ->  is a production then add  to FIRST(X)--   If X->Y Y ... Yk for some k >= 1--     If  is in FIRST(Y) for ALL j= 1...k add --     If  is in FIRST(Y) for ALL i= 1...l < k--                   then add FIRST(Y1)---- Stop when nothing can be added (i.e.: find a fixpoint)first :: Grammar -> FirstMapfirst grammar = (fixpoint  (firsti grammar) (first0 grammar))  where    --------------------------------------------------------    first0 :: Grammar -> FirstMap    first0 grammar = FirstMap $      (Data.Map.fromList $ (fmap defaults) $ Data.Set.toList (allNonterminalsInGrammar grammar))      where        defaults nt = (nt, (Data.Set.empty))    --------------------------------------------------------    firsti :: Grammar -> FirstMap -> FirstMap    firsti (Grammar []) fMinus1 = fMinus1    firsti (Grammar (prod:prods)) fMinus1 =      (        mergeSetIntoFirstMap                  -- Add to the FIRST_(i-1) set,        (firsti (Grammar prods) fMinus1)      -- (computed from the remaining productions)        (left_hand prod)                      -- for the symbol on the LHS of the current production prod,        (terminalsForRHS prod)                -- the terminals obtained by applying the rules on the current production prod      )      where           --        terminalsForRHS :: Production -> Set Terminal        terminalsForRHS (Prod _ []) = (Data.Set.singleton Epsilon)        --   If X ->  is a production then add  to FIRST(X)                terminalsForRHS (Prod _ [(Right Epsilon)]) = (Data.Set.singleton Epsilon)        terminalsForRHS (Prod x (yj:ys)) =          case yj of            -- If X is a terminal then FIRST(X) = {X}                 Right terminal    -> Data.Set.singleton terminal            -- Otherwise...            Left  nonterminal -> if   (Data.Set.member Epsilon first_iminus1)                                 then (Data.Set.union                                       (terminalsForYj)                                       (terminalsForRHS (Prod x ys)))                                 else  (terminalsForYj)                where                first_iminus1 = getFirstSetFor nonterminal fMinus1                terminalsForYj = (Data.Set.delete Epsilon first_iminus1)            --     If  is in FIRST(Y) for ALL i= 1...l < k            --                   then add FIRST(Y1)            --     --> guaranteed because we add FIRST(Y1) and we            --         continue adding terminalsRHS for the            --         remainder of the production only if  is in FIRST            --     If  is in FIRST(Y) for ALL j= 1...k add             --     --> guaranteed because we continue adding terminalsRHS for the            --         remainder of the production only if  is in FIRST            --         eventually adding terminalsForRHS (Prod _ []) = (Data.Set.singleton Epsilon)            --------------------------------------------------------------------------- We can compute FIRST for any string XX...X as follows.-- Add to FIRST(XX... X) all non- symbols of FIRST(X).-- Also add the non- symbols of FIRST(X), if  is in FIRST(X);-- and so on.-- Finally, add  to FIRST(XX . . X) if, for all i,  is in FIRST(X)-------------------------------------------------------------------------firstForWord :: [Symbol] -> FirstMap -> FirstSetfirstForWord [(Left nt)] first = getFirstSetFor nt first -- If Epsilon in first don't removefirstForWord [(Right t)] first = (Data.Set.singleton t)firstForWord ((Left nt):ss) first =  if (Data.Set.member      Epsilon      (getFirstSetFor nt first)     )  then (Data.Set.union        firstMinusEpsilon        (firstForWord ss first)       )  else firstMinusEpsilon       where firstMinusEpsilon = (Data.Set.delete                                  Epsilon                                  (getFirstSetFor nt first)                                 )------------------------------------------------------ FOLLOW gives $ to FOLLOW(S) and {} to everything else;---- Then repeat:---- If there is a production A -> wBw ,--   then everything in FIRST(w) except  is in FOLLOW(B)--   If where FIRST(w) contains Epsilon,--   then everything in FOLLOW (A) is also in FOLLOW (B).-- If there is a production A -> wB,--   then everything in FOLLOW (A) is in FOLLOW (B).---- Stop when nothing can be added (i.e. find a fixpoint)-----------------------------------------------------follow :: Grammar -> FollowMapfollow grammar = (fixpoint (followi grammar (first grammar)) (follow0 grammar))  where    --------------------------------------------------------    follow0 :: Grammar -> FollowMap    follow0 grammar = FollowMap $      (Data.Map.fromList $ (fmap defaults) $ Data.Set.toList (allNonterminalsInGrammar grammar))      where        defaults nt@(NT _) = (nt, (Data.Set.empty))        defaults nt@(Start _) = (nt, (Data.Set.singleton Dollar))    --------------------------------------------------------    followi :: Grammar -> FirstMap -> FollowMap -> FollowMap    followi (Grammar [])  _ fMinus1 = fMinus1    followi (Grammar (prod:prods)) firstMapForG fMinus1 =      (mergeTerminalsFromProd   -- Add the terminals obtained by applying the rules on the current production       prod       (followi            --         (Grammar prods)    --        firstMapForG       -- to the FOLLOW sets obtained from the remaining productions        fMinus1            --       )      )      where        mergeTerminalsFromProd :: Production -> FollowMap -> FollowMap        mergeTerminalsFromProd (Prod l (s:ss)) = (mergeTerminalsFromProd' l [] s ss)        mergeTerminalsFromProd' :: Nonterminal -> [Symbol] -> Symbol -> [Symbol] -> FollowMap -> FollowMap        -- If there is a production A -> wBw ,        mergeTerminalsFromProd' a w1 nt@(Left b) w2@(w21:w2s) fMinus1 = (mergeSetIntoFollowMap                                                                         (mergeTerminalsFromProd' a (w1 ++ [nt]) w21 w2s fMinus1)                                                                         b                                                                         newTerminals                                                                        )          where              --  everything in FIRST(w) except  is in FOLLOW(B)              firstW2MinusEpsilon = (Data.Set.delete Epsilon (firstForWord w2 firstMapForG))              newTerminals = if (Data.Set.member Epsilon (firstForWord w2 firstMapForG))                                --   If where FIRST(w) contains Epsilon,                                --   then everything in FOLLOW (A) is also in FOLLOW (B).                             then (Data.Set.union (getFollowSetFor a fMinus1) firstW2MinusEpsilon)                             else (firstForWord w2 firstMapForG)        -- If there is a production A -> wB, then everything in FOLLOW (A) is in FOLLOW (B).        mergeTerminalsFromProd' a w1 (Left b) [] fMinus1 = (mergeSetIntoFollowMap                                                            fMinus1                                                            b                                                            (getFollowSetFor a fMinus1)                                                           )        -- We don't have to insert anything for terminals; i.e. there are no rules        -- for A -> wTw where T is terminal; if we are at the end of the production we're done        mergeTerminalsFromProd' a _ (Right _) [] fMinus1 = fMinus1        -- Otherwise just recurse        mergeTerminalsFromProd' a w1 (Right t) (w2:w2s) fMinus1 = (mergeTerminalsFromProd' a (w1 ++ [(Right t)]) w2 w2s fMinus1)        main = let  -- Example from dragon book  dragon_gram = Grammar [p1, p2, p3, p4, p5, p6, p7, p8] where    p1 = Prod {left_hand = (Start E),   right_hand = [Left  (NT T),   Left (NT E')]}    p2 = Prod {left_hand = (NT E'),  right_hand = [Right (T +),    Left (NT T),    Left (NT E')]}    p3 = Prod {left_hand = (NT E'),  right_hand = [Right Epsilon]}    p4 = Prod {left_hand = (NT T),   right_hand = [Left  (NT F),   Left (NT T')]}    p5 = Prod {left_hand = (NT T'),  right_hand = [Right (T *),    Left (NT F),    Left (NT T')]}    p6 = Prod {left_hand = (NT T'),  right_hand = [Right Epsilon]}    p7 = Prod {left_hand = (NT F),   right_hand = [Right (T (),    Left (Start E),    Right (T ))]}    p8 = Prod {left_hand = (NT F),   right_hand = [Right (T id)]}  in do  putStrLn EXAMPLE GRAMMAR:   print (dragon_gram)  putStrLn FIRST(G) =   print (first dragon_gram)  putStrLn FOLLOW(G) =   print (follow dragon_gram)
FIRST and FOLLOW sets calculator in Haskell
beginner;parsing;haskell;grammar