Permalink
Browse files

New checks, remove duplication.

  • Loading branch information...
1 parent 3bd8f14 commit e16158ac52303644d0c4f6bcef295561bc09b0a8 @23Skidoo committed Apr 10, 2013
Showing with 112 additions and 68 deletions.
  1. +1 −1 src/CFG/Examples.hs
  2. +4 −11 src/CFG/Helpers/CFG.hs
  3. +3 −28 src/CFG/Helpers/CNF.hs
  4. +50 −28 src/CFG/Read.hs
  5. +54 −0 src/CFG/Types.hs
View
@@ -20,4 +20,4 @@ sillyGrammar = CNF.compileGrammar . fromRight . readCNFGrammar $
sillyGrammar2 :: CompiledCNFGrammar
sillyGrammar2 = CNF.compileGrammar . fromRight . readCNFGrammar $
- "S -> SS, S -> S1S1, S1 -> 1, S1 -> 0"
+ "S -> SS, S -> S1S2, S -> S2S1, S1 -> 1, S2 -> 0"
View
@@ -1,7 +1,7 @@
-- | Helpers for working with general context-free grammars.
module CFG.Helpers.CFG (
-- * Basic helpers.
- ruleName, ruleNumber, isNonTerminalRule, nonTerminalRuleProductions
+ isStartRule, nonTerminalRuleProductions
-- * Monad for fresh names.
,NameMonad, runNameMonad, freshName, rememberName
)
@@ -13,17 +13,10 @@ import Control.Monad.State
import qualified Data.Set as S
-- Basic helpers
-ruleName :: NamedCFGRule -> RuleName
-ruleName (CFGTerminalRule name _) = name
-ruleName (CFGNonTerminalRule name _) = name
-ruleNumber :: NumberedCFGRule -> RuleNumber
-ruleNumber (CFGTerminalRule num _) = num
-ruleNumber (CFGNonTerminalRule num _) = num
-
-isNonTerminalRule :: CFGRule a -> Bool
-isNonTerminalRule (CFGNonTerminalRule _ _) = True
-isNonTerminalRule _ = False
+isStartRule :: (Eq a) => CFGrammar a -> CFGRule a -> Bool
+isStartRule g r | (cfgStartRule g == ruleName r) = True
+ | otherwise = False
nonTerminalRuleProductions :: CFGRule a -> [[a]]
nonTerminalRuleProductions (CFGNonTerminalRule _ prods) = prods
View
@@ -4,9 +4,7 @@ module CFG.Helpers.CNF (
compileGrammar
-- * Misc. helper functions.
- ,ruleName, ruleNumber
- ,isTerminalRule, isNonTerminalRule, isStartRule
- ,terminalRuleProduces, nonTerminalRuleProductions
+ ,isStartRule, nonTerminalRuleProductions
)
where
@@ -32,32 +30,9 @@ compileGrammar (CNFGrammar rules start e) =
CNFNonTerminalRule (lookupName name)
[(lookupName a, lookupName b) | (a,b) <- prods]
--- Misc. helper functions.
-
-ruleName :: NamedCNFRule -> RuleName
-ruleName (CNFTerminalRule name _) = name
-ruleName (CNFNonTerminalRule name _) = name
-
-ruleNumber :: NumberedCNFRule -> RuleNumber
-ruleNumber (CNFTerminalRule num _) = num
-ruleNumber (CNFNonTerminalRule num _) = num
-
-isTerminalRule :: CNFRule a -> Bool
-isTerminalRule (CNFTerminalRule _ _) = True
-isTerminalRule _ = False
-
-isNonTerminalRule :: CNFRule a -> Bool
-isNonTerminalRule (CNFNonTerminalRule _ _) = True
-isNonTerminalRule _ = False
-
isStartRule :: (Eq a) => CNFGrammar a -> CNFRule a -> Bool
-isStartRule g (CNFNonTerminalRule name _) | cnfStartRule g == name = True
- | otherwise = False
-isStartRule _ (CNFTerminalRule _ _) = False
-
-terminalRuleProduces :: CNFRule a -> Symbol -> Bool
-terminalRuleProduces (CNFTerminalRule _ s) s' = (s == s')
-terminalRuleProduces _ _ = error "Terminal rule expected!"
+isStartRule g r | (cnfStartRule g == ruleName r) = True
+ | otherwise = False
nonTerminalRuleProductions :: CNFRule a -> [(a, a)]
nonTerminalRuleProductions (CNFNonTerminalRule _ prods) = prods
View
@@ -9,7 +9,8 @@ import Control.Applicative hiding (many, (<|>))
import Control.Monad (foldM, unless)
import Data.Bifunctor (first)
import Data.Either (partitionEithers)
-import Data.List (find, groupBy, partition, sortBy)
+import Data.List (find, groupBy, intercalate
+ ,partition, sortBy)
import qualified Data.Map as M
import Data.Maybe (fromJust, isJust)
import Data.Ord (comparing)
@@ -64,20 +65,13 @@ validateCFGrammar g = do
nontermRules = map (toNonTermRule allSymsMap) nonterms
allRules = termRules ++ nontermRules
- -- Merge all non-terminal productions with the same name. TODO: remove
- -- duplication.
- sorted = sortBy (comparing CFG.ruleName) allRules
- grouped = groupBy
- (\r0 r1 ->
- CFG.isNonTerminalRule r0
- && CFG.isNonTerminalRule r1
- && CFG.ruleName r0 == CFG.ruleName r1) sorted
+ -- Group productions of all nonterminals together.
+ let grouped = groupRules allRules
merged = foldr mergeProductions [] grouped
- -- Check that the grammar contains the start rule.
- unless (S.member "S" allNames) $ (Left "No start rule found!")
-
+ validateCommon merged
return (CFGrammar merged "S")
+
where
isTerm :: (RuleName, [SymOrName]) -> Bool
isTerm (_,[Left _]) = True
@@ -87,8 +81,8 @@ validateCFGrammar g = do
extractSyms (_, l) = fst . partitionEithers $ l
bindSym :: SymbolMap -> Symbol -> CFG.NameMonad SymbolMap
- bindSym m sym = do n <- CFG.freshName
- return $ M.insert sym n m
+ bindSym m sym = do n <- CFG.freshName
+ return $ M.insert sym n m
toTermRule :: (RuleName, Symbol) -> NamedCFGRule
toTermRule (nam, sym) = CFGTerminalRule nam sym
@@ -101,11 +95,12 @@ validateCFGrammar g = do
toName (Left sym) = fromJust . M.lookup sym $ symMap
toName (Right n) = n
+ -- TODO: it'd would be nice to remove duplication here.
mergeProductions :: [NamedCFGRule] -> [NamedCFGRule] -> [NamedCFGRule]
mergeProductions [] rest = rest
mergeProductions [rule] rest = rule:rest
mergeProductions rules rest =
- let name = CFG.ruleName . head $ rules
+ let name = ruleName . head $ rules
prods = concatMap CFG.nonTerminalRuleProductions rules
in (CFGNonTerminalRule name prods) : rest
@@ -147,27 +142,54 @@ terminalP = charToSymbol <$>
-- | Given a bunch of CNF rules, perform various checks on them.
validateCNFGrammar :: [NamedCNFRule] -> Either String NamedCNFGrammar
validateCNFGrammar g = do
- -- Group productions of non-terminals together (not actually necessary).
- let sorted = sortBy (comparing CNF.ruleName) g
- grouped = groupBy (\r0 r1 -> CNF.isNonTerminalRule r0
- && CNF.isNonTerminalRule r1
- && CNF.ruleName r0 == CNF.ruleName r1) sorted
+ -- Group productions of non-terminals together.
+ let grouped = groupRules g
merged = foldr mergeProductions [] grouped
- -- Check that the start rule exists.
- unless (isJust $ find (\r -> CNF.ruleName r == "S") merged) $
- (Left "No start rule found!")
+ -- A parsed grammar in CNF never produces an empty string, this can happen
+ -- only when converting a general CFG to CNF.
+ let producesEmpty = False
- -- TODO: Add more validity checks. Check whether the grammar produces an empty
- -- string.
- -- Check that terminal rules are unique and don't intersect with nonterminals.
- return (CNFGrammar merged "S" False)
+ validateCommon merged
+ return (CNFGrammar merged "S" producesEmpty)
where
mergeProductions :: [NamedCNFRule] -> [NamedCNFRule] -> [NamedCNFRule]
mergeProductions [] rest = rest
mergeProductions [rule] rest = rule:rest
mergeProductions rules rest =
- let name = CNF.ruleName . head $ rules
+ let name = ruleName . head $ rules
prods = concatMap CNF.nonTerminalRuleProductions rules
in (CNFNonTerminalRule name prods) : rest
+
+-- | Group nonterminal rules by name (in preparation for merging).
+groupRules :: (Rule r) => [r RuleName] -> [[r RuleName]]
+groupRules rs = groupBy (\r0 r1 -> isNonTerminalRule r0 && isNonTerminalRule r1
+ && ruleName r0 == ruleName r1) sorted
+ where
+ sorted = sortBy (comparing ruleName) rs
+
+-- | Common checks.
+validateCommon :: Rule r => [r RuleName] -> Either String ()
+validateCommon rules = do
+ -- Check that the start rule exists.
+ unless (isJust $ find (\r -> ruleName r == "S") rules) $
+ (Left "No start rule found!")
+
+ -- Check that terminal rule names are unique.
+ let termNames = map ruleName . filter isTerminalRule $ rules
+ termNamesSet = S.fromList termNames
+ nonUnique = intercalate ", " . map head
+ . filter ((>1) . length) . groupBy (==) $ termNames
+ unless (S.size termNamesSet == length termNames) $
+ (Left $ "Some terminal rule names are not unique: " ++ nonUnique)
+
+ -- Check that terminal rule names don't intersect with nonterminals.
+ let nontermNames = map ruleName . filter isNonTerminalRule $ rules
+ nontermNamesSet = S.fromList nontermNames
+ intersection = intercalate ", " . S.toList $
+ nontermNamesSet `S.intersection` termNamesSet
+
+ unless (null intersection) $
+ (Left $ "Some non-terminal rule names clash with non-terminals: "
+ ++ intersection)
View
@@ -13,6 +13,7 @@ module CFG.Types (
,NamedCNFGrammar, CompiledCNFGrammar
-- * Misc. helper functions.
+ ,Rule(..)
,charToSymbol, stringToSymbols, symbolsToString
)
where
@@ -57,6 +58,59 @@ data CNFGrammar a = CNFGrammar { cnfRules :: [CNFRule a]
type NamedCNFGrammar = CNFGrammar RuleName
type CompiledCNFGrammar = CNFGrammar RuleNumber
+-- Basic helpers.
+
+class Rule r where
+
+ ruleName :: r a -> a
+ ruleName = ruleNumber
+
+ ruleNumber :: r a -> a
+ ruleNumber = ruleName
+
+ isTerminalRule :: r a -> Bool
+ isNonTerminalRule :: r a -> Bool
+
+ terminalRuleProduces :: r a -> Symbol -> Bool
+
+
+instance Rule CFGRule where
+
+-- ruleName :: CFGRule a -> a
+ ruleName (CFGTerminalRule name _) = name
+ ruleName (CFGNonTerminalRule name _) = name
+
+-- isTerminalRule :: CFGRule a -> Bool
+ isTerminalRule (CFGTerminalRule _ _) = True
+ isTerminalRule _ = False
+
+-- isNonTerminalRule :: CFGRule a -> Bool
+ isNonTerminalRule (CFGNonTerminalRule _ _) = True
+ isNonTerminalRule _ = False
+
+-- terminalRuleProduces :: CFGRule a -> Symbol -> Bool
+ terminalRuleProduces (CFGTerminalRule _ s) s' = (s == s')
+ terminalRuleProduces _ _ = error "Terminal rule expected!"
+
+
+instance Rule CNFRule where
+
+-- ruleName :: CNFRule a -> a
+ ruleName (CNFTerminalRule name _) = name
+ ruleName (CNFNonTerminalRule name _) = name
+
+-- isTerminalRule :: CNFRule a -> Bool
+ isTerminalRule (CNFTerminalRule _ _) = True
+ isTerminalRule _ = False
+
+-- isNonTerminalRule :: CFGRule a -> Bool
+ isNonTerminalRule (CNFNonTerminalRule _ _) = True
+ isNonTerminalRule _ = False
+
+-- terminalRuleProduces :: CNFRule a -> Symbol -> Bool
+ terminalRuleProduces (CNFTerminalRule _ s) s' = (s == s')
+ terminalRuleProduces _ _ = error "Terminal rule expected!"
+
-- Helpers for working with the 'Symbol' type.
charToSymbol :: Char -> Symbol
charToSymbol = SymChar

0 comments on commit e16158a

Please sign in to comment.