context-free-grammar 0.0.1 → 0.1.0

raw patch · 18 files changed

+356/−321 lines, 18 filesdep ~QuickCheckdep ~arraydep ~containersPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: QuickCheck, array, containers, control-monad-omega, dlist, mtl, pretty, quickcheck-properties, test-framework-quickcheck2

API changes (from Hackage documentation)

Files

• Makefile +0/−9
• changelog +5/−0
• context-free-grammar.cabal +18/−17
• src/Data/Cfg.hs +2/−8
• src/Data/Cfg/Analysis.hs +71/−0
• src/Data/Cfg/FirstSet.hs +0/−57
• src/Data/Cfg/FixedPoint.hs +6/−11
• src/Data/Cfg/FollowSet.hs +0/−94
• src/Data/Cfg/Internal/FirstSet.hs +50/−0
• src/Data/Cfg/Internal/FollowSet.hs +81/−0
• src/Data/Cfg/Internal/Nullable.hs +29/−0
• src/Data/Cfg/Internal/PredictSet.hs +67/−0
• src/Data/Cfg/Nullable.hs +0/−29
• src/Data/Cfg/PredictSet.hs +0/−76
• src/Data/Cfg/RuleApplication.hs +2/−2
• tests/Data/Cfg/FirstSetTests.hs +3/−3
• tests/Data/Cfg/FollowSetTests.hs +3/−10
• tests/Data/Cfg/TestGrammars.hs +19/−5

@@ -1,8 +1,6 @@ .PHONY : all clean configure dist dist-test docs docs-open lint \ 	maintainer-clean test -GEN_CODE = dist/build/generate-code/generate-code- all : configure 	cabal build @@ -66,13 +64,6 @@  docs-open : docs 	open dist/doc/html/context-free-grammar/index.html--################################-# generate-code-################################--$(GEN_CODE) : configure-	cabal build generate-code  ################################ # de-linting

@@ -0,0 +1,5 @@+0.1.0 (2015-04-02):+    - Restructured API so default is to keep partial analysis results;+      old way was too error-prone.+0.0.1 (2015-03-14):+    - Initial version.

@@ -1,5 +1,5 @@ Name:                   context-free-grammar-Version:                0.0.1+Version:                0.1.0 Author:                 Eric Nedervold<nedervoldsoftware@gmail.com> Maintainer:             Eric Nedervold<nedervoldsoftware@gmail.com> License:                BSD3@@ -39,22 +39,19 @@ Cabal-Version:          >= 1.10 Build-Type:             Simple Extra-Source-Files:     Makefile-+                      , changelog Library   Default-Language:     Haskell2010   HS-Source-Dirs:       src   GHC-Options:          -Wall   Exposed-Modules:      Data.Cfg+                      , Data.Cfg.Analysis                       , Data.Cfg.Augment                       , Data.Cfg.Bnf                       , Data.Cfg.Cfg                       , Data.Cfg.CPretty-                      , Data.Cfg.FirstSet-                      , Data.Cfg.FollowSet                       , Data.Cfg.FreeCfg                       , Data.Cfg.LookaheadSet-                      , Data.Cfg.Nullable-                      , Data.Cfg.PredictSet                       , Data.Cfg.Productive                       , Data.Cfg.Reachable                       , Data.Cfg.RuleApplication@@ -65,13 +62,17 @@                       , Data.Cfg.Bnf.Token                       , Data.Cfg.Collect                       , Data.Cfg.FixedPoint+                      , Data.Cfg.Internal.FirstSet+                      , Data.Cfg.Internal.FollowSet+                      , Data.Cfg.Internal.Nullable+                      , Data.Cfg.Internal.PredictSet   Build-Depends:        base >= 4 && < 5-                      , array >= 0.5 && < 0.6-                      , containers >= 0.5 && < 0.6-                      , control-monad-omega >= 0.3 && < 0.4-                      , dlist >= 0.7 && < 0.8-                      , mtl >= 2.1 && < 2.2-                      , pretty >= 1.1 && < 1.2+                      , array >= 0.5+                      , containers >= 0.5+                      , control-monad-omega >= 0.3+                      , dlist >= 0.7+                      , mtl >= 2.1+                      , pretty >= 1.1                       , template-haskell  Test-Suite test@@ -89,16 +90,16 @@                       , Data.Cfg.ReachableTests                       , Data.Cfg.TestGrammars   Build-Depends:        base-                      , containers >= 0.5 && < 0.6+                      , containers >= 0.5                       , context-free-grammar                       , HUnit-                      , pretty >= 1.1 && < 1.2-                      , QuickCheck >= 2.6 && < 2.7-                      , quickcheck-properties == 0.1+                      , pretty >= 1.1+                      , QuickCheck >= 2.6+                      , quickcheck-properties >= 0.1                       , template-haskell                       , test-framework                       , test-framework-hunit-                      , test-framework-quickcheck2 >= 0.3 && < 0.4+                      , test-framework-quickcheck2 >= 0.3  Source-Repository head   Type:                 git

@@ -1,28 +1,22 @@ -- | Context-free grammars. module Data.Cfg(+    module Data.Cfg.Analysis,     module Data.Cfg.Augment,     module Data.Cfg.Cfg,     module Data.Cfg.CPretty,-    module Data.Cfg.FirstSet,-    module Data.Cfg.FollowSet,     module Data.Cfg.FreeCfg,     module Data.Cfg.LookaheadSet,-    module Data.Cfg.Nullable,-    module Data.Cfg.PredictSet,     module Data.Cfg.Productive,     module Data.Cfg.Reachable,     module Data.Cfg.RuleApplication     ) where +import Data.Cfg.Analysis import Data.Cfg.Augment import Data.Cfg.Cfg import Data.Cfg.CPretty-import Data.Cfg.FirstSet-import Data.Cfg.FollowSet import Data.Cfg.FreeCfg import Data.Cfg.LookaheadSet-import Data.Cfg.Nullable-import Data.Cfg.PredictSet import Data.Cfg.Productive import Data.Cfg.Reachable import Data.Cfg.RuleApplication

@@ -0,0 +1,71 @@+-- | Analysis of a context-free grammar+{-# LANGUAGE ScopedTypeVariables #-}+module Data.Cfg.Analysis (+    Analysis(..),+    mkAnalysis,+    Prediction,+    Predictions+    ) where++import Data.Cfg.Augment+import qualified Data.Cfg.Cfg as Cfg+import Data.Cfg.FreeCfg+import qualified Data.Cfg.Internal.FirstSet as I+import qualified Data.Cfg.Internal.FollowSet as I+import qualified Data.Cfg.Internal.Nullable as I+import qualified Data.Cfg.Internal.PredictSet as I+import Data.Cfg.Internal.PredictSet(Prediction, Predictions)+import Data.Cfg.LookaheadSet+import qualified Data.Map.Strict as M+import qualified Data.Set as S++-- | Analysis of a context-free grammar+data Analysis t nt = Analysis {+    baseCfg :: FreeCfg t nt,+	-- ^ (a 'FreeCfg' equivalent to) the source grammar+    augmentedCfg :: FreeCfg (AugT t) (AugNT nt),+	-- ^ the augmented grammar+    nullables :: S.Set (AugNT nt),+	-- ^ the nonterminals in the grammar that can produce the+	-- empty string+    firstSet :: AugNT nt -> LookaheadSet t,+	-- ^ the first set of the nonterminal for the grammar+    firstsOfVs :: AugVs t nt -> LookaheadSet t,+	-- ^ the first set of a list of symbols+    followSet :: AugNT nt -> LookaheadSet t,+	-- ^ the follow set of the nonterminal for the grammar+    predictSet :: AugProduction t nt -> LookaheadSet t,+	-- ^ the predict set of the production+    isLL1 :: Bool,+	-- ^ 'True' iff the grammar is LL(1)+    ll1Info :: AugNT nt -> Predictions t nt+	-- ^ the productions for this nonterminal and the lookaheads+	-- that predict them+    }++-- | Analyzes a context-free grammar+mkAnalysis :: forall cfg t nt+	   . (Cfg.Cfg cfg t nt, Ord nt, Ord t)+	   => cfg t nt -> Analysis t nt+mkAnalysis cfg = Analysis {+    baseCfg = bcfg,+    augmentedCfg = cfg',+    nullables = ns,+    firstSet = fs,+    firstsOfVs = I.firstsOfVs fs,+    followSet = fols,+    predictSet = predict,+    isLL1 = isLL1',+    ll1Info = (ll1InfoMap M.!)+    }+    where+    bcfg = toFreeCfg cfg+    cfg' = augmentCfg bcfg+    ns = I.nullables cfg'+    fsm = I.firstSetMap cfg'+    fs nt = fsm M.! nt+    folm = I.followSetMap cfg' fs+    fols nt = folm M.! nt+    predict = I.predictSet fs fols+    ll1InfoMap = I.ll1InfoMap cfg' predict+    isLL1' = I.isLL1 ll1InfoMap

@@ -1,57 +0,0 @@--- | First sets of a context-free grammar.-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-module Data.Cfg.FirstSet(firstSet, firstSetMap, firstsOfVs) where--import Data.Cfg.Augment-import Data.Cfg.Cfg-import Data.Cfg.FixedPoint(fixedPoint)-import Data.Cfg.LookaheadSet hiding(unions)-import qualified Data.Cfg.LookaheadSet as LA-import qualified Data.Map as M-import Data.Maybe(fromMaybe)-import Data.Monoid(Monoid(mconcat))-import qualified Data.Set as S---- | Returns the first set of the nonterminal for the grammar as a--- map.-firstSetMap :: forall cfg t nt-	    . (Cfg cfg (AugT t) (AugNT nt), Ord nt, Ord t, Show nt)-	    => cfg (AugT t) (AugNT nt) -> M.Map (AugNT nt) (LookaheadSet t)-firstSetMap cfg = fixedPoint go M.empty-    where-    go :: M.Map (AugNT nt) (LookaheadSet t)-       -> M.Map (AugNT nt) (LookaheadSet t)-    go knownFirsts-	= M.fromList [(nt, firstAlts rhss)-	      | nt <- S.toList $ nonterminals cfg,-		let rhss = S.toList $ productionRules cfg nt,-		not $ null rhss ]-	where-	firstAlts :: [Vs (AugT t) (AugNT nt)] -> LookaheadSet t-	firstAlts = LA.unions . map (mconcat . map (firstsV knownFirsts))---- | Returns the first set of the nonterminal for the grammar.	To--- avoid recalculations, hold a copy of @firstSet cfg@.-firstSet :: forall cfg t nt-	 . (Cfg cfg (AugT t) (AugNT nt), Ord nt, Ord t, Show nt)-	 => cfg (AugT t) (AugNT nt) -> AugNT nt -> LookaheadSet t-firstSet cfg nt = firstSetMap cfg M.! nt--firstsV :: Ord nt-	=> M.Map (AugNT nt) (LookaheadSet t) -> V (AugT t) (AugNT nt)-					     -> LookaheadSet t-firstsV _ (T t) = LA.singleton t-firstsV fs (NT nt) = fromMaybe LA.empty (M.lookup nt fs)--    -- TODO I need a consistent story here of what I define and-    -- export.	FollowSet needs this one below, but you can see the-    -- code duplication with firstsV.  Resolve.---- | Given a firsts function, find the first set of a list of symbols.-firstsOfVs :: Ord t-	   => (AugNT nt -> LookaheadSet t) -> AugVs t nt -> LookaheadSet t-firstsOfVs firsts vs = mconcat $ map firstsV' vs-    where-    firstsV' (T t) = LA.singleton t-    firstsV' (NT nt) = firsts nt

@@ -1,17 +1,12 @@ -- | The iterative fixed-point function.-module Data.Cfg.FixedPoint (-    fixedPoint-    ) where+module Data.Cfg.FixedPoint(fixedPoint) where  -- | Given a function and an initial value, find the fixed point of -- the function. fixedPoint :: Eq a => (a -> a) -> a -> a-fixedPoint f = go+fixedPoint f a = go $ iterate f a     where-    go s = if s == s'-	       then s-	       else go s'-	where-	s' = f s---- TODO When I can use fix instead?+    go as@(a' : a'' : _) = if a' == a''+			       then a'+			       else go $ tail as+    go _ = error "fixedPoint: impossible"

@@ -1,94 +0,0 @@--- | Follow sets of a context-free grammar.-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-module Data.Cfg.FollowSet (-    followSet, followSetMap-    ) where--import Control.Monad(guard)-import Data.Cfg.Augment-import Data.Cfg.Cfg-import Data.Cfg.Collect(collectOnFirst)-import Data.Cfg.FirstSet(firstsOfVs)-import Data.Cfg.FixedPoint(fixedPoint)-import Data.List(tails)-import Data.Cfg.LookaheadSet hiding(unions)-import qualified Data.Cfg.LookaheadSet as LA-import qualified Data.Map as M-import qualified Data.Set as S---- | Represents the environment following a nonterminal symbol.	 A--- production @foo ::= <vs> bar <vs'>@ will contribute a 'FollowSite' record--- with @ntTail == <vs'>@ and @prodHead == foo@, where @<vs>@ is a--- (possibly empty) list of vocabulary symbols.-data FollowSite t nt = FollowSite {-    ntTail :: AugVs t nt,-    prodHead :: AugNT nt-    }---- | Calculates a map that gives all the follow sites in the grammar--- for the given nonterminal.-followSitesMap :: (Cfg cfg (AugT t) (AugNT nt), Ord nt)-      => cfg (AugT t) (AugNT nt)-      -> M.Map (AugNT nt) [FollowSite t nt]-followSitesMap cfg = M.fromList . collectOnFirst $ do-    prodHd <- S.toList $ nonterminals cfg-    let rhss = S.toList $ productionRules cfg prodHd-    guard (not $ null rhss)-    rhs <- rhss-    NT nt : tl <- tails rhs-    return (nt, FollowSite { ntTail = tl, prodHead = prodHd })---- | Given what we know of firsts and follows, find the first set of a--- follow site.-firstsOfFollowSite :: forall t nt . (Ord t, Ord nt)-		   => (AugNT nt -> LookaheadSet t)-		   -> M.Map (AugNT nt) (LookaheadSet t)-		   -> FollowSite t nt-		   -> LookaheadSet t-firstsOfFollowSite firsts knownFollows followSite-    = firstsOfNTTail <> firstsOfProdHead-    where-    firstsOfNTTail, firstsOfProdHead  :: LookaheadSet t-    firstsOfNTTail = firstsOfVs firsts (ntTail followSite)-    firstsOfProdHead = knownFollows M.! prodHead followSite---- | Returns the follow sets for the grammar as a--- map.-followSetMap :: forall cfg t nt-	     . (Cfg cfg (AugT t) (AugNT nt), Ord nt, Ord t, Show nt)-	     => cfg (AugT t) (AugNT nt)-		     -- ^ the grammar-	     -> (AugNT nt -> LookaheadSet t)-		     -- ^ 'firstSet' for the grammar-	     -> M.Map (AugNT nt) (LookaheadSet t)-followSetMap cfg fs = fixedPoint go initMap-    where-    go :: M.Map (AugNT nt) (LookaheadSet t)-       -> M.Map (AugNT nt) (LookaheadSet t)-    go oldFols = M.mapWithKey (\ k v -> LA.unions $ f k v) oldFols-	where-	f :: AugNT nt -> LookaheadSet t -> [LookaheadSet t]-	f nt oldFollows = oldFollows : map (firstsOfFollowSite fs oldFols) folSites-	    where-	    folSites = M.findWithDefault [] nt followSitesMap'--    initMap :: M.Map (AugNT nt) (LookaheadSet t)-    initMap = M.fromList [(nt, case nt of-				   StartSymbol -> singleton EOF-				   _ -> empty) | nt <- nts]-	where-	nts = S.toList $ nonterminals cfg--    followSitesMap' :: M.Map (AugNT nt) [FollowSite t nt]-    followSitesMap' = followSitesMap cfg---- | Returns the follow set of the nonterminal for the grammar. To--- avoid recalculations, hold a copy of @followSet cfg@.-followSet :: forall cfg t nt-	  . (Cfg cfg (AugT t) (AugNT nt), Ord nt, Ord t, Show nt)-	  => cfg (AugT t) (AugNT nt)          -- ^ the grammar-          -> (AugNT nt -> LookaheadSet t)     -- ^ 'firstSet' for the grammar-          -> AugNT nt                         -- ^ the nonterminal-          -> LookaheadSet t-followSet cfg fs nt = followSetMap cfg fs M.! nt

@@ -0,0 +1,50 @@+-- | First sets of a context-free grammar.+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Data.Cfg.Internal.FirstSet(firstSetMap, firstsOfVs) where++import Data.Cfg.Augment+import Data.Cfg.Cfg+import Data.Cfg.FixedPoint(fixedPoint)+import Data.Cfg.LookaheadSet hiding(unions)+import qualified Data.Cfg.LookaheadSet as LA+import qualified Data.Map.Strict as M+import Data.Maybe(fromMaybe)+import Data.Monoid(Monoid(mconcat))+import qualified Data.Set as S++-- | Returns the first set of the nonterminal for the grammar as a+-- map.+firstSetMap :: forall cfg t nt+	    . (Cfg cfg (AugT t) (AugNT nt), Ord nt, Ord t)+	    => cfg (AugT t) (AugNT nt) -> M.Map (AugNT nt) (LookaheadSet t)+firstSetMap cfg = fixedPoint go M.empty+    where+    go :: M.Map (AugNT nt) (LookaheadSet t)+       -> M.Map (AugNT nt) (LookaheadSet t)+    go knownFirsts+	= M.fromList [(nt, firstAlts rhss)+	      | nt <- S.toList $ nonterminals cfg,+		let rhss = S.toList $ productionRules cfg nt,+		not $ null rhss ]+	where+	firstAlts :: [Vs (AugT t) (AugNT nt)] -> LookaheadSet t+	firstAlts = LA.unions . map (mconcat . map (firstsV knownFirsts))++firstsV :: Ord nt+	=> M.Map (AugNT nt) (LookaheadSet t) -> V (AugT t) (AugNT nt)+					     -> LookaheadSet t+firstsV _ (T t) = LA.singleton t+firstsV fs (NT nt) = fromMaybe LA.empty (M.lookup nt fs)++    -- TODO I need a consistent story here of what I define and+    -- export.	FollowSet needs this one below, but you can see the+    -- code duplication with firstsV.  Resolve.++-- | Given a firsts function, find the first set of a list of symbols.+firstsOfVs :: Ord t+	   => (AugNT nt -> LookaheadSet t) -> AugVs t nt -> LookaheadSet t+firstsOfVs firsts vs = mconcat $ map firstsV' vs+    where+    firstsV' (T t) = LA.singleton t+    firstsV' (NT nt) = firsts nt

@@ -0,0 +1,81 @@+-- | Follow sets of a context-free grammar.+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Data.Cfg.Internal.FollowSet(followSetMap) where++import Control.Monad(guard)+import Data.Cfg.Augment+import Data.Cfg.Cfg+import Data.Cfg.Collect(collectOnFirst)+import Data.Cfg.Internal.FirstSet(firstsOfVs)+import Data.Cfg.FixedPoint(fixedPoint)+import Data.List(tails)+import Data.Cfg.LookaheadSet hiding(unions)+import qualified Data.Cfg.LookaheadSet as LA+import qualified Data.Map.Strict as M+import qualified Data.Set as S++-- | Represents the environment following a nonterminal symbol.	 A+-- production @foo ::= <vs> bar <vs'>@ will contribute a 'FollowSite' record+-- with @ntTail == <vs'>@ and @prodHead == foo@, where @<vs>@ is a+-- (possibly empty) list of vocabulary symbols.+data FollowSite t nt = FollowSite {+    ntTail :: AugVs t nt,+    prodHead :: AugNT nt+    }++-- | Calculates a map that gives all the follow sites in the grammar+-- for the given nonterminal.+followSitesMap :: (Cfg cfg (AugT t) (AugNT nt), Ord nt)+      => cfg (AugT t) (AugNT nt)+      -> M.Map (AugNT nt) [FollowSite t nt]+followSitesMap cfg = M.fromList . collectOnFirst $ do+    prodHd <- S.toList $ nonterminals cfg+    let rhss = S.toList $ productionRules cfg prodHd+    guard (not $ null rhss)+    rhs <- rhss+    NT nt : tl <- tails rhs+    return (nt, FollowSite { ntTail = tl, prodHead = prodHd })++-- | Given what we know of firsts and follows, find the first set of a+-- follow site.+firstsOfFollowSite :: forall t nt . (Ord t, Ord nt)+		   => (AugNT nt -> LookaheadSet t)+		   -> M.Map (AugNT nt) (LookaheadSet t)+		   -> FollowSite t nt+		   -> LookaheadSet t+firstsOfFollowSite firsts knownFollows followSite+    = firstsOfNTTail <> firstsOfProdHead+    where+    firstsOfNTTail, firstsOfProdHead  :: LookaheadSet t+    firstsOfNTTail = firstsOfVs firsts (ntTail followSite)+    firstsOfProdHead = knownFollows M.! prodHead followSite++-- | Returns the follow sets for the grammar as a map.+followSetMap :: forall cfg t nt+	     . (Cfg cfg (AugT t) (AugNT nt), Ord nt, Ord t)+	     => cfg (AugT t) (AugNT nt)+		     -- ^ the grammar+	     -> (AugNT nt -> LookaheadSet t)+		     -- ^ 'firstSet' for the grammar+	     -> M.Map (AugNT nt) (LookaheadSet t)+followSetMap cfg fs = fixedPoint go initMap+    where+    go :: M.Map (AugNT nt) (LookaheadSet t)+       -> M.Map (AugNT nt) (LookaheadSet t)+    go oldFols = M.mapWithKey (\ k v -> LA.unions $ f k v) oldFols+	where+	f :: AugNT nt -> LookaheadSet t -> [LookaheadSet t]+	f nt oldFollows = oldFollows : map (firstsOfFollowSite fs oldFols) folSites+	    where+	    folSites = M.findWithDefault [] nt followSitesMap'++    initMap :: M.Map (AugNT nt) (LookaheadSet t)+    initMap = M.fromList [(nt, case nt of+				   StartSymbol -> singleton EOF+                                   _ -> empty) | nt <- nts]+        where+        nts = S.toList $ nonterminals cfg++    followSitesMap' :: M.Map (AugNT nt) [FollowSite t nt]+    followSitesMap' = followSitesMap cfg

@@ -0,0 +1,29 @@+-- | Nullable nonterminals+{-# LANGUAGE ScopedTypeVariables #-}+module Data.Cfg.Internal.Nullable(nullables) where++import Control.Monad(guard)+import Data.Cfg.Cfg+import Data.Cfg.FixedPoint(fixedPoint)+import qualified Data.Set as S++-- | Returns the nonterminals in the grammar that can produce the+-- empty string.+nullables :: forall cfg t nt . (Cfg cfg t nt, Ord nt)+	  => cfg t nt -> S.Set nt+nullables cfg = fixedPoint go S.empty+    where+    go :: S.Set nt -> S.Set nt+    go knownNullables = calculatedNullables+	where+	isKnownNullable :: V t nt -> Bool+	isKnownNullable (NT nm) = nm `S.member` knownNullables+	isKnownNullable _ = False++	calculatedNullables :: S.Set nt+	calculatedNullables = S.fromList $ do+	    nt <- S.toList $ nonterminals cfg+	    let rhss = S.toList $ productionRules cfg nt+	    guard $ any (all isKnownNullable) rhss+            return nt+

@@ -0,0 +1,67 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- | Predict sets of a context-free grammar.+module Data.Cfg.Internal.PredictSet (+    Prediction,+    Predictions,+    predictSet,+    ll1InfoMap,+    isLL1+    ) where++import Data.Cfg.Augment+import Data.Cfg.Cfg(Cfg(..))+import Data.Cfg.Collect+import Data.Cfg.Internal.FirstSet(firstsOfVs)+import Data.Cfg.LookaheadSet+import qualified Data.Map.Strict as M+import qualified Data.Set as S++-- | Returns the predict set of a production.+predictSet :: (Ord t)+	   => (AugNT nt -> LookaheadSet t)    -- ^ 'firstSet' for the grammar+	   -> (AugNT nt -> LookaheadSet t)    -- ^ 'followSet' for the grammar+	   -> AugProduction t nt	      -- ^ the production+	   -> LookaheadSet t+predictSet firstSet' followSet' (hd, vs)+    = firstsOfVs firstSet' vs <> followSet' hd++-- | A lookahead set with the productions it predicts+type Prediction t nt = (LookaheadSet t, S.Set (AugProduction t nt))++-- | A set of 'Prediction's.  The 'LookaheadSet's of the 'Prediction's+-- will be pairwise disjoint.+type Predictions t nt = S.Set (Prediction t nt)++-- | Returns the production 'Predictions' for the grammar as a map.+ll1InfoMap :: forall cfg t nt+	   . (Cfg cfg (AugT t) (AugNT nt), Ord nt, Ord t)+	   => cfg (AugT t) (AugNT nt)+	   -> (AugProduction t nt -> LookaheadSet t)+	   -> M.Map (AugNT nt) (Predictions t nt)+ll1InfoMap cfg predictSet' = mkMap mkPredictions $ S.toList $ nonterminals cfg+    where+    mkPredictions :: AugNT nt -> Predictions t nt+	-- Mostly reshuffling data+    mkPredictions nt+	= S.fromList $ f $ collectOnSecond $ collectOnFirst' lookaheadProds+	where+	-- Possible lookahead symbols for productions of this nonterminal+	lookaheadProds :: [(AugT t, AugProduction t nt)]+	lookaheadProds	= do+	    rhs <- S.toList $ productionRules cfg nt+	    let prod = (nt, rhs)+	    t <- S.toList $ toSet $ predictSet' prod+	    return (t, prod)++	f :: [([AugT t], S.Set (AugProduction t nt))]+	  -> [(LookaheadSet t, S.Set (AugProduction t nt))]+	f pairs = [(fromList la, ps) | (la, ps) <- pairs]++    mkMap :: Ord k => (k -> v) -> [k] -> M.Map k v+    mkMap f ks = M.fromList [(k, f k) | k <- ks]++-- | Returns true iff the predictions are unambiguous, true iff the+-- grammar is LL(1).+isLL1 :: M.Map (AugNT nt) (Predictions t nt) -> Bool+isLL1 m = all (\ ps -> S.size ps == 1) $ M.elems m

@@ -1,29 +0,0 @@--- | Nullable nonterminals-{-# LANGUAGE ScopedTypeVariables #-}-module Data.Cfg.Nullable(nullables) where--import Control.Monad(guard)-import Data.Cfg.Cfg-import Data.Cfg.FixedPoint(fixedPoint)-import qualified Data.Set as S---- | Returns the nonterminals in the grammar that can produce the--- empty string.-nullables :: forall cfg t nt . (Cfg cfg t nt, Ord nt)-	  => cfg t nt -> S.Set nt-nullables cfg = fixedPoint go S.empty-    where-    go :: S.Set nt -> S.Set nt-    go knownNullables = calculatedNullables-	where-	isKnownNullable :: V t nt -> Bool-	isKnownNullable (NT nm) = nm `S.member` knownNullables-	isKnownNullable _ = False--	calculatedNullables :: S.Set nt-	calculatedNullables = S.fromList $ do-	    nt <- S.toList $ nonterminals cfg-	    let rhss = S.toList $ productionRules cfg nt-	    guard $ any (all isKnownNullable) rhss-            return nt-

@@ -1,76 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}--- | Predict sets of a context-free grammar.-module Data.Cfg.PredictSet (-    Prediction,-    Predictions,-    predictSet,-    ll1Info,-    ll1InfoMap,-    isLL1-    ) where--import Data.Cfg.Augment-import Data.Cfg.Cfg(Cfg(..))-import Data.Cfg.Collect-import Data.Cfg.FirstSet(firstsOfVs)-import Data.Cfg.LookaheadSet-import qualified Data.Map as M-import qualified Data.Set as S---- | Returns the predict set of a production.-predictSet :: (Ord t)-	   => (AugNT nt -> LookaheadSet t)    -- ^ 'firstSet' for the grammar-	   -> (AugNT nt -> LookaheadSet t)    -- ^ 'followSet' for the grammar-	   -> AugProduction t nt	      -- ^ the production-	   -> LookaheadSet t-predictSet firstSet' followSet' (hd, vs)-    = firstsOfVs firstSet' vs <> followSet' hd---- | A lookahead set with the productions it predicts-type Prediction t nt = (LookaheadSet t, S.Set (AugProduction t nt))---- | A set of 'Prediction's.  The 'LookaheadSet's of the 'Prediction's--- will be pairwise disjoint.-type Predictions t nt = S.Set (Prediction t nt)---- | Returns the production 'Predictions' for a nonterminal symbol.-ll1Info :: (Cfg cfg (AugT t) (AugNT nt), Ord nt, Ord t)-	=> cfg (AugT t) (AugNT nt)-	-> (AugProduction t nt -> LookaheadSet t)-	-> AugNT nt-	-> Predictions t nt-ll1Info cfg predictSet' nt = ll1InfoMap cfg predictSet' M.! nt---- | Returns the production 'Predictions' for the grammar as a map.-ll1InfoMap :: forall cfg t nt-	   . (Cfg cfg (AugT t) (AugNT nt), Ord nt, Ord t)-	   => cfg (AugT t) (AugNT nt)-	   -> (AugProduction t nt -> LookaheadSet t)-	   -> M.Map (AugNT nt) (Predictions t nt)-ll1InfoMap cfg predictSet' = mkMap mkPredictions $ S.toList $ nonterminals cfg-    where-    mkPredictions :: AugNT nt -> Predictions t nt-	-- Mostly reshuffling data-    mkPredictions nt-	= S.fromList $ f $ collectOnSecond $ collectOnFirst' lookaheadProds-	where-	-- Possible lookahead symbols for productions of this nonterminal-	lookaheadProds :: [(AugT t, AugProduction t nt)]-	lookaheadProds	= do-	    rhs <- S.toList $ productionRules cfg nt-	    let prod = (nt, rhs)-	    t <- S.toList $ toSet $ predictSet' prod-	    return (t, prod)--	f :: [([AugT t], S.Set (AugProduction t nt))]-	  -> [(LookaheadSet t, S.Set (AugProduction t nt))]-	f pairs = [(fromList la, ps) | (la, ps) <- pairs]--    mkMap :: Ord k => (k -> v) -> [k] -> M.Map k v-    mkMap f ks = M.fromList [(k, f k) | k <- ks]---- | Returns true iff the predictions are unambiguous, true iff the--- grammar is LL(1).-isLL1 :: M.Map (AugNT nt) (Predictions t nt) -> Bool-isLL1 m = all (\ ps -> S.size ps == 1) $ M.elems m

@@ -10,7 +10,7 @@ import Control.Monad.Omega import Data.Cfg.Cfg import qualified Data.DList as DL-import qualified Data.Map as M+import qualified Data.Map.Strict as M import qualified Data.Set as S  -- | Given a grammar and a string of symbols, returns the strings@@ -26,7 +26,7 @@ -- | Given a grammar, returns all strings yielded by application of -- production rules. yields :: forall cfg t nt . (Cfg cfg t nt, Ord nt)-        => cfg t nt -> [Vs t nt]+	=> cfg t nt -> [Vs t nt] yields cfg = map DL.toList $ runOmega $ yieldNT (startSymbol cfg)     where     yieldNT :: nt -> Omega (DL.DList (V t nt))

@@ -2,8 +2,8 @@     tests     ) where +import Data.Cfg.Analysis import Data.Cfg.Augment-import Data.Cfg.FirstSet import Data.Cfg.LookaheadSet import Data.Cfg.TestGrammars import Test.Framework(Test, testGroup)@@ -30,7 +30,7 @@ 	   ("tail", mkLookaheadSet True ["PLUS"])]      fs :: AugNT String -> LookaheadSet String-    fs = firstSet g0+    fs = firstSet g0Analysis  microFirstSetTest :: Test microFirstSetTest = testCase "micro first-set test" $ mapM_ f tab@@ -58,5 +58,5 @@             ("add_op", mkLookaheadSet False $ words "PLUS MINUS") ]      fs :: AugNT String -> LookaheadSet String-    fs = firstSet micro+    fs = firstSet microAnalysis 

@@ -2,9 +2,8 @@     tests     ) where +import Data.Cfg.Analysis import Data.Cfg.Augment-import Data.Cfg.FirstSet-import Data.Cfg.FollowSet import Data.Cfg.LookaheadSet import Data.Cfg.TestGrammars import Test.Framework(Test, testGroup)@@ -30,11 +29,8 @@ 	   ("prefix", mkLookaheadSet False ["LPAREN"]), 	   ("tail", mkLookaheadSet True ["RPAREN"])] -    fs :: AugNT String -> LookaheadSet String-    fs = firstSet g0-     fols :: AugNT String -> LookaheadSet String-    fols = followSet g0 fs+    fols = followSet g0Analysis  microFollowSetTest :: Test microFollowSetTest = testCase "micro follow-set test" $ mapM_ f tab@@ -59,9 +55,6 @@ 	    ("primary_tail", mkLookaheadSet False $ words "COMMA SEMI RPAREN"), 	    ("add_op", mkLookaheadSet False $ words "ID INT_LITERAL LPAREN") ] -    fs :: AugNT String -> LookaheadSet String-    fs = firstSet micro-     fols :: AugNT String -> LookaheadSet String-    fols = followSet micro fs+    fols = followSet microAnalysis 

@@ -7,15 +7,20 @@     g0,     micro,     wiki,+    -- * Analysis of grammars for sanity checks+    g0Analysis,+    microAnalysis,+    wikiAnalysis,     -- * Convenience functions for the REPL     pretty'     ) where +import Data.Cfg.Analysis import Data.Cfg.Augment import Data.Cfg.Bnf import Data.Cfg.Cfg(Cfg(..), V(..), eqCfg) import Data.Cfg.CPretty-import Data.Cfg.FreeCfg+-- import Data.Cfg.FreeCfg import Text.PrettyPrint import Test.HUnit(assertBool) @@ -45,8 +50,8 @@  -- | A test grammar.  Found in Crafting a compiler, by Charles -- N. Fischer and Richard J. LeBlanc, Jr., (c) 1998, pg. 95.-g0 :: FreeCfg (AugT String) (AugNT String)-g0 = augmentCfg [bnf|+g0 :: Grammar String String+g0 = [bnf|     e ::= prefix LPAREN e RPAREN.     e ::= V tail.     prefix ::= F.@@ -56,8 +61,8 @@    |]  -- | A test grammar.  Found in Fischer and LeBlanc, pg. 111.-micro :: FreeCfg (AugT String) (AugNT String)-micro = augmentCfg [bnf|+micro :: Grammar String String+micro = [bnf|     program ::= BEGIN statement_list END.     statement_list ::= statement statement_tail.     statement_tail ::= statement statement_tail.@@ -91,3 +96,12 @@     d ::= b D | c D | D.     e ::= e E.     |]++g0Analysis :: Analysis String String+g0Analysis = mkAnalysis g0++microAnalysis :: Analysis String String+microAnalysis = mkAnalysis micro++wikiAnalysis :: Analysis String String+wikiAnalysis = mkAnalysis wiki