Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Comparing changes

Choose two branches to see what's changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
base fork: 23Skidoo/5dv117
base: e16158ac52
...
head fork: 23Skidoo/5dv117
compare: 0b9754b538
Checking mergeability… Don't worry, you can still create the pull request.
  • 2 commits
  • 5 files changed
  • 0 commit comments
  • 1 contributor
View
16 src/CFG/Helpers/CFG.hs
@@ -1,9 +1,7 @@
-- | Helpers for working with general context-free grammars.
module CFG.Helpers.CFG (
- -- * Basic helpers.
- isStartRule, nonTerminalRuleProductions
- -- * Monad for fresh names.
- ,NameMonad, runNameMonad, freshName, rememberName
+ -- * Monad for fresh names.
+ NameMonad, runNameMonad, freshName, rememberName
)
where
@@ -12,16 +10,6 @@ import CFG.Types
import Control.Monad.State
import qualified Data.Set as S
--- Basic helpers
-
-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
-nonTerminalRuleProductions _ = error "Non-terminal rule expected!"
-
-- Monad for generating fresh names.
data NameState = NameState { nameStateCounter :: !Int
View
13 src/CFG/Helpers/CNF.hs
@@ -2,9 +2,6 @@
module CFG.Helpers.CNF (
-- * Helpers for constructing the grammar.
compileGrammar
-
- -- * Misc. helper functions.
- ,isStartRule, nonTerminalRuleProductions
)
where
@@ -28,12 +25,4 @@ compileGrammar (CNFGrammar rules start e) =
CNFTerminalRule (lookupName name) symbol
compileRule (CNFNonTerminalRule name prods) =
CNFNonTerminalRule (lookupName name)
- [(lookupName a, lookupName b) | (a,b) <- prods]
-
-isStartRule :: (Eq a) => CNFGrammar a -> CNFRule a -> Bool
-isStartRule g r | (cnfStartRule g == ruleName r) = True
- | otherwise = False
-
-nonTerminalRuleProductions :: CNFRule a -> [(a, a)]
-nonTerminalRuleProductions (CNFNonTerminalRule _ prods) = prods
-nonTerminalRuleProductions _ = error "Non-terminal rule expected!"
+ [Pair (lookupName a) (lookupName b) | Pair a b <- prods]
View
3  src/CFG/Parse.hs
@@ -7,7 +7,6 @@ import Data.Array.IArray
import Data.Array.MArray
import Data.Array.ST
-import CFG.Helpers.CNF
import CFG.Types
-- The CYK algorithm.
@@ -36,7 +35,7 @@ cykAlgorithm grammar input' = if n == 0
forM_ [1..(i-1)] $ \k ->
forM_ (filter isNonTerminalRule rules) $ \rule -> do
let a = ruleNumber rule
- forM_ (nonTerminalRuleProductions rule) $ \(b,c) -> do
+ forM_ (nonTerminalRuleProductions rule) $ \(Pair b c) -> do
e0 <- readArray marr (j,k,b)
e1 <- readArray marr (j+k,i-k,c)
when (e0 && e1) $
View
51 src/CFG/Read.hs
@@ -2,7 +2,6 @@ module CFG.Read (readCFGrammar, readCNFGrammar)
where
import qualified CFG.Helpers.CFG as CFG
-import qualified CFG.Helpers.CNF as CNF
import CFG.Types
import Control.Applicative hiding (many, (<|>))
@@ -35,7 +34,7 @@ cfgRulesP :: Parsec String () [(RuleName, [SymOrName])]
cfgRulesP = sepBy cfgRuleP (char ',' >> spaces)
-- | A single CFG rule. Sum type representation makes it easier to extract
--- non-terminals (see 'processRules').
+-- nonterminals (see 'processRules').
cfgRuleP :: Parsec String () (RuleName, [SymOrName])
cfgRuleP = do
name <- ruleNameP
@@ -50,8 +49,8 @@ cfgRuleP = do
validateCFGrammar :: [(RuleName, [SymOrName])] ->
Either String NamedCFGrammar
validateCFGrammar g = do
- -- Replace all Lefts with Rights in non-terminal productions. We don't want to
- -- mix symbols and rule names in non-terminal rules.
+ -- Replace all Lefts with Rights in nonterminal productions. We don't want to
+ -- mix symbols and rule names in nonterminal rules.
let (terms, nonterms) = partition isTerm g
allNames = S.fromList . map fst $ g
allSyms = map snd namedSyms ++ concatMap extractSyms nonterms
@@ -66,8 +65,7 @@ validateCFGrammar g = do
allRules = termRules ++ nontermRules
-- Group productions of all nonterminals together.
- let grouped = groupRules allRules
- merged = foldr mergeProductions [] grouped
+ let merged = mergeRules allRules
validateCommon merged
return (CFGrammar merged "S")
@@ -95,15 +93,6 @@ 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 = ruleName . head $ rules
- prods = concatMap CFG.nonTerminalRuleProductions rules
- in (CFGNonTerminalRule name prods) : rest
-
-- | Parse a comma-delimited string representing a context-free grammar in
-- CNF. Uppercase letters followed by zero or more digits act as nonterminals
@@ -118,7 +107,7 @@ cnfRulesP :: Parsec String () [NamedCNFRule]
cnfRulesP = sepBy cnfRuleP (char ',' >> spaces)
-- | A rule name, followed by '<-', followed either by a terminal (lowercase
--- letter, digit or a punctuation symbol) or by two names of non-terminals.
+-- letter, digit or a punctuation symbol) or by two names of nonterminals.
cnfRuleP :: Parsec String () NamedCNFRule
cnfRuleP = do
name <- ruleNameP
@@ -127,7 +116,7 @@ cnfRuleP = do
case mTerm of
Just t -> return $ CNFTerminalRule name t
Nothing -> do
- rhs <- pure (,) <*> ruleNameP <*> ruleNameP
+ rhs <- pure Pair <*> ruleNameP <*> ruleNameP
return $ CNFNonTerminalRule name [rhs]
-- | A rule name: an upper-case letter followed by zero or more digits.
@@ -142,9 +131,8 @@ 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.
- let grouped = groupRules g
- merged = foldr mergeProductions [] grouped
+ -- Group productions of nonterminals together.
+ let merged = mergeRules g
-- A parsed grammar in CNF never produces an empty string, this can happen
-- only when converting a general CFG to CNF.
@@ -153,21 +141,22 @@ validateCNFGrammar g = do
validateCommon merged
return (CNFGrammar merged "S" producesEmpty)
+-- | Group productions of nonterminals together by name.
+mergeRules :: (Rule r) => [r RuleName] -> [r RuleName]
+mergeRules rs = foldr mergeProductions [] grouped
where
- mergeProductions :: [NamedCNFRule] -> [NamedCNFRule] -> [NamedCNFRule]
+ sorted = sortBy (comparing ruleName) rs
+ grouped = groupBy (\r0 r1 -> isNonTerminalRule r0
+ && isNonTerminalRule r1
+ && ruleName r0 == ruleName r1) sorted
+
+ mergeProductions :: Rule r => [r RuleName] -> [r RuleName] -> [r RuleName]
mergeProductions [] rest = rest
mergeProductions [rule] rest = rule:rest
mergeProductions rules rest =
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
+ prods = concatMap nonTerminalRuleProductions rules
+ in (mkNonTerminal name prods) : rest
-- | Common checks.
validateCommon :: Rule r => [r RuleName] -> Either String ()
@@ -191,5 +180,5 @@ validateCommon rules = do
nontermNamesSet `S.intersection` termNamesSet
unless (null intersection) $
- (Left $ "Some non-terminal rule names clash with non-terminals: "
+ (Left $ "Some nonterminal rule names clash with terminals: "
++ intersection)
View
57 src/CFG/Types.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE TypeFamilies #-}
-- | Basic types and helper functions for constructing a context-free grammar.
module CFG.Types (
-- * Types.
@@ -8,12 +9,12 @@ module CFG.Types (
,NamedCFGRule, NumberedCFGRule
,NamedCFGrammar, CompiledCFGrammar
- ,CNFRule(..), CNFGrammar(..)
+ ,Pair(..), CNFRule(..), CNFGrammar(..)
,NamedCNFRule, NumberedCNFRule
,NamedCNFGrammar, CompiledCNFGrammar
-- * Misc. helper functions.
- ,Rule(..)
+ ,Rule(..), Grammar(..), isStartRule
,charToSymbol, stringToSymbols, symbolsToString
)
where
@@ -43,8 +44,10 @@ type NamedCFGrammar = CFGrammar RuleName
type CompiledCFGrammar = CFGrammar RuleNumber
-- A context-free grammar in CNF form.
+data Pair a = Pair !a !a
+ deriving (Eq, Show)
data CNFRule a = CNFTerminalRule !a !Symbol
- | CNFNonTerminalRule !a ![(a, a)]
+ | CNFNonTerminalRule !a ![Pair a]
deriving (Eq, Show)
type NamedCNFRule = CNFRule RuleName
@@ -60,57 +63,79 @@ type CompiledCNFGrammar = CNFGrammar RuleNumber
-- Basic helpers.
+-- | Helpers for rules.
class Rule r where
+ type NonTermProduction r :: * -> *
- ruleName :: r a -> a
- ruleName = ruleNumber
-
+ ruleName :: r a -> a
+ ruleName = ruleNumber
ruleNumber :: r a -> a
ruleNumber = ruleName
- isTerminalRule :: r a -> Bool
+ isTerminalRule :: r a -> Bool
isNonTerminalRule :: r a -> Bool
- terminalRuleProduces :: r a -> Symbol -> Bool
+ terminalRuleProduces :: r a -> Symbol -> Bool
+ nonTerminalRuleProductions :: r a -> [NonTermProduction r a]
+ mkNonTerminal :: a -> [NonTermProduction r a] -> r a
instance Rule CFGRule where
+ type NonTermProduction CFGRule = []
--- 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!"
+ nonTerminalRuleProductions (CFGNonTerminalRule _ prods) = prods
+ nonTerminalRuleProductions _ = error "Nonterminal rule expected!"
+
+ mkNonTerminal name prods = CFGNonTerminalRule name prods
instance Rule CNFRule where
+ type NonTermProduction CNFRule = Pair
--- 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!"
+ nonTerminalRuleProductions (CNFNonTerminalRule _ prods) = prods
+ nonTerminalRuleProductions _ = error "Nonterminal rule expected!"
+
+ mkNonTerminal name prods = CNFNonTerminalRule name prods
+
+
+-- | Helpers for grammars.
+class Grammar g where
+ startRule :: g a -> a
+
+instance Grammar CNFGrammar where
+ startRule g = cnfStartRule g
+
+instance Grammar CFGrammar where
+ startRule g = cfgStartRule g
+
+isStartRule :: (Eq a, Grammar g, Rule r) => g a -> r a -> Bool
+isStartRule g r | (startRule g == ruleName r) = True
+ | otherwise = False
+
+
-- Helpers for working with the 'Symbol' type.
charToSymbol :: Char -> Symbol
charToSymbol = SymChar

No commit comments for this range

Something went wrong with that request. Please try again.