Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
  • 2 commits
  • 10 files changed
  • 0 comments
  • 1 contributor
7  src/CFG/CNF.hs
... ...
@@ -1,2 +1,7 @@
1  
-module CFG.CNF ()
  1
+module CFG.CNF (convertToCNF)
2 2
        where
  3
+
  4
+import CFG.Types
  5
+
  6
+convertToCNF :: (Eq a) => CFGrammar a -> CNFGrammar a
  7
+convertToCNF = undefined
19  src/CFG/Examples.hs
... ...
@@ -1,32 +1,33 @@
1 1
 module CFG.Examples (balancedParentheses, sillyGrammar, sillyGrammar2)
2 2
        where
3 3
 
  4
+import CFG.Helpers.CNF
4 5
 import CFG.Types
5 6
 
6 7
 -- | Example grammar: balanced parenthese.
7  
-balancedParentheses :: CNFGrammar
  8
+balancedParentheses :: CompiledCNFGrammar
8 9
 balancedParentheses =
9 10
   -- S -> SS | LH | LR
10 11
   -- H -> SR
11 12
   -- L -> '('
12 13
   -- R -> ')'
13  
-  compileGrammar
14  
-  [ ruleStart "S" [ ("S","S"), ("L","H"), ("L","R")]
  14
+  listToGrammar
  15
+  [ ruleNonTerminal "S" [ ("S","S"), ("L","H"), ("L","R")]
15 16
   , ruleNonTerminal "H" [("S","R")]
16 17
   , ruleTerminal "L" '('
17 18
   , ruleTerminal "R" ')'
18 19
   ]
19 20
 
20  
-sillyGrammar :: CNFGrammar
  21
+sillyGrammar :: CompiledCNFGrammar
21 22
 sillyGrammar =
22  
-  compileGrammar
23  
-  [ ruleStart "S" [("S1", "S2")]
  23
+  listToGrammar
  24
+  [ ruleNonTerminal "S" [("S1", "S2")]
24 25
   , ruleTerminal "S1" 'o'
25 26
   , ruleTerminal "S2" 'o' ]
26 27
 
27  
-sillyGrammar2 :: CNFGrammar
  28
+sillyGrammar2 :: CompiledCNFGrammar
28 29
 sillyGrammar2 =
29  
-  compileGrammar
30  
-  [ ruleStart "S" [("S", "S"), ("S1", "S1")]
  30
+  listToGrammar
  31
+  [ ruleNonTerminal "S" [("S", "S"), ("S1", "S1")]
31 32
   , ruleTerminal "S1" '1'
32 33
   , ruleTerminal "S1" '0' ]
14  src/CFG/Helpers/CFG.hs
... ...
@@ -0,0 +1,14 @@
  1
+-- | Helpers for working with general context-free grammars.
  2
+module CFG.Helpers.CFG (
  3
+    --  * Helpers for constructing the grammar.
  4
+   ruleTerminal, ruleNonTerminal
  5
+  )
  6
+  where
  7
+
  8
+import CFG.Types
  9
+
  10
+ruleTerminal :: RuleName -> Char -> NamedCFGRule
  11
+ruleTerminal name prod = CFGTerminalRule name (charToSymbol prod)
  12
+
  13
+ruleNonTerminal :: RuleName -> [[RuleName]] -> NamedCFGRule
  14
+ruleNonTerminal name prods = CFGNonTerminalRule name prods
76  src/CFG/Helpers/CNF.hs
... ...
@@ -0,0 +1,76 @@
  1
+-- | Helpers for working with context-free grammars in Chomsky normal form.
  2
+module CFG.Helpers.CNF (
  3
+  --  * Helpers for constructing the grammar.
  4
+   ruleTerminal, ruleNonTerminal
  5
+  ,compileGrammar, listToGrammar
  6
+
  7
+  -- * Misc. helper functions.
  8
+  ,ruleName, ruleNumber
  9
+  ,isTerminalRule, isNonTerminalRule, isStartRule
  10
+  ,terminalRuleProduces, nonTerminalRuleProductions
  11
+  )
  12
+  where
  13
+
  14
+import           CFG.Types
  15
+
  16
+import qualified Data.Map   as M
  17
+import           Data.Maybe (fromJust)
  18
+
  19
+
  20
+ruleTerminal :: RuleName -> Char -> NamedCNFRule
  21
+ruleTerminal name prod = CNFTerminalRule name (charToSymbol prod)
  22
+
  23
+ruleNonTerminal :: RuleName -> [(RuleName, RuleName)] -> NamedCNFRule
  24
+ruleNonTerminal name prods = CNFNonTerminalRule name prods
  25
+
  26
+compileGrammar :: NamedCNFGrammar -> CompiledCNFGrammar
  27
+compileGrammar (CNFGrammar rules start e) =
  28
+  CNFGrammar (map compileRule rules) (lookupName start) e
  29
+  where
  30
+    idxMap :: M.Map RuleName RuleNumber
  31
+    idxMap = M.fromList (zip (map ruleName rules) [1..])
  32
+
  33
+    lookupName :: RuleName -> RuleNumber
  34
+    lookupName k = fromJust $ M.lookup k idxMap
  35
+
  36
+    compileRule :: NamedCNFRule -> NumberedCNFRule
  37
+    compileRule (CNFTerminalRule name symbol) =
  38
+      CNFTerminalRule (lookupName name) symbol
  39
+    compileRule (CNFNonTerminalRule name prods) =
  40
+      CNFNonTerminalRule (lookupName name)
  41
+      [(lookupName a, lookupName b) | (a,b) <- prods]
  42
+
  43
+-- NB: this assumes that the grammar doesn't generate the empty string.
  44
+listToGrammar :: [NamedCNFRule] -> CompiledCNFGrammar
  45
+listToGrammar rules = compileGrammar $ CNFGrammar rules "S" False
  46
+
  47
+-- Misc. helper functions.
  48
+
  49
+ruleName :: NamedCNFRule -> RuleName
  50
+ruleName (CNFTerminalRule name _)    = name
  51
+ruleName (CNFNonTerminalRule name _) = name
  52
+
  53
+ruleNumber :: NumberedCNFRule -> RuleNumber
  54
+ruleNumber (CNFTerminalRule num _)    = num
  55
+ruleNumber (CNFNonTerminalRule num _) = num
  56
+
  57
+isTerminalRule :: CNFRule a -> Bool
  58
+isTerminalRule (CNFTerminalRule _ _) = True
  59
+isTerminalRule _                     = False
  60
+
  61
+isNonTerminalRule :: CNFRule a -> Bool
  62
+isNonTerminalRule (CNFNonTerminalRule _ _) = True
  63
+isNonTerminalRule _                        = False
  64
+
  65
+isStartRule :: (Eq a) => CNFGrammar a -> CNFRule a -> Bool
  66
+isStartRule g (CNFNonTerminalRule name _) | cnfStartRule g == name = True
  67
+                                          | otherwise              = False
  68
+isStartRule _ (CNFTerminalRule _ _)                                = False
  69
+
  70
+terminalRuleProduces :: CNFRule a -> Symbol -> Bool
  71
+terminalRuleProduces (CNFTerminalRule _ s) s' = (s == s')
  72
+terminalRuleProduces _                  _  = error "Terminal rule expected!"
  73
+
  74
+nonTerminalRuleProductions :: CNFRule a -> [(a, a)]
  75
+nonTerminalRuleProductions (CNFNonTerminalRule _ prods) = prods
  76
+nonTerminalRuleProductions  _ = error "Non-terminal rule expected!"
15  src/CFG/Parse.hs
@@ -7,25 +7,26 @@ import Data.Array.IArray
7 7
 import Data.Array.MArray
8 8
 import Data.Array.ST
9 9
 
  10
+import CFG.Helpers.CNF
10 11
 import CFG.Types
11 12
 
12 13
 -- The CYK algorithm.
13  
-cykAlgorithm :: CNFGrammar -> String -> Bool
  14
+cykAlgorithm :: CompiledCNFGrammar -> String -> Bool
14 15
 cykAlgorithm grammar input' = if n == 0
15  
-                              -- TODO: Decide emptiness.
16  
-                              then error "empty string"
  16
+                              then cnfProducesEmpty grammar
17 17
                               else or [arr ! (1,n,x) | x <- startIndices]
18 18
   where
19 19
     n = length input
20  
-    r = length grammar
21  
-    startIndices = map ruleNumber . filter isStartRule $ grammar
  20
+    r = length rules
  21
+    rules        = cnfRules grammar
  22
+    startIndices = map ruleNumber . filter (isStartRule grammar) $ rules
22 23
     input        = stringToSymbols input'
23 24
 
24 25
     arr = runSTUArray $ do
25 26
       marr <- newArray ((1,1,1),(n,n,r)) False
26 27
 
27 28
       forM_ (zip [1..] input) $ \(i, ci) ->
28  
-        forM_ (filter isTerminalRule grammar) $ \rule -> do
  29
+        forM_ (filter isTerminalRule rules) $ \rule -> do
29 30
           let j = ruleNumber rule
30 31
           when (terminalRuleProduces rule ci) $
31 32
             writeArray marr (i,1,j) True
@@ -33,7 +34,7 @@ cykAlgorithm grammar input' = if n == 0
33 34
       forM_ [2..n] $ \i ->
34 35
         forM_ [1..(n-i+1)] $ \j ->
35 36
           forM_ [1..(i-1)] $ \k ->
36  
-            forM_ (filter isNonTerminalRule grammar) $ \rule -> do
  37
+            forM_ (filter isNonTerminalRule rules) $ \rule -> do
37 38
               let a = ruleNumber rule
38 39
               forM_ (nonTerminalRuleProductions rule) $ \(b,c) -> do
39 40
                 e0 <- readArray marr (j,k,b)
50  src/CFG/Read.hs
... ...
@@ -1,24 +1,29 @@
1  
-module CFG.Read (readCNFGrammar)
  1
+module CFG.Read (readCFGrammar, readCNFGrammar)
2 2
        where
3 3
 
  4
+import CFG.Helpers.CNF
4 5
 import CFG.Types
5 6
 
6 7
 import Control.Applicative hiding (many, (<|>))
7  
-import Control.Monad       (when)
  8
+import Control.Monad       (unless)
8 9
 import Data.Bifunctor      (first)
9 10
 import Data.Char           (isPunctuation)
10 11
 import Data.Either         ()
11  
-import Data.List           (groupBy, sortBy)
  12
+import Data.List           (find, groupBy, sortBy)
  13
+import Data.Maybe          (isJust)
12 14
 import Data.Ord            (comparing)
13 15
 import Text.Parsec
14 16
 
  17
+readCFGrammar :: String -> Either String NamedCFGrammar
  18
+readCFGrammar _input = undefined
  19
+
15 20
 -- | Parse a comma-delimited string representing a context-free grammar in
16 21
 -- CNF. Uppercase letters followed by zero or more digits act as nonterminals
17 22
 -- and lowercase letters are terminals. The initial nonterminal is always called
18 23
 -- S.
19 24
 readCNFGrammar :: String -> Either String NamedCNFGrammar
20 25
 readCNFGrammar input = do g <- first show $ parse rulesP "<stdin>" input
21  
-                          validateGrammar g
  26
+                          validateCNFGrammar g
22 27
 
23 28
 -- | A list of rule names separated by commas.
24 29
 rulesP :: Parsec String () [NamedCNFRule]
@@ -33,38 +38,37 @@ ruleP = do
33 38
   mTerm <- optionMaybe (charToSymbol <$>
34 39
                         (lower <|> satisfy isPunctuation <|> digit))
35 40
   case mTerm of
36  
-    Just t  -> return $ TerminalRule name t
  41
+    Just t  -> return $ CNFTerminalRule name t
37 42
     Nothing -> do
38 43
       rhs <- pure (,) <*> ruleNameP <*> ruleNameP
39  
-      let isStart = if name == "S" then StartRule else NormalRule
40  
-      return $ NonTerminalRule name [rhs] isStart
  44
+      return $ CNFNonTerminalRule name [rhs]
41 45
 
42  
--- | A rule name: an upper-case letter followed by zero or more lower-case
43  
--- letters.
  46
+-- | A rule name: an upper-case letter followed by zero or more digits.
44 47
 ruleNameP :: Parsec String () String
45 48
 ruleNameP = (:) <$> upper <*> (many digit)
46 49
 
47  
-validateGrammar :: NamedCNFGrammar -> Either String NamedCNFGrammar
48  
-validateGrammar g = do
  50
+validateCNFGrammar :: [NamedCNFRule] -> Either String NamedCNFGrammar
  51
+validateCNFGrammar g = do
49 52
   -- Group productions of non-terminals together (not actually necessary).
50 53
   let sorted  = sortBy (comparing ruleName) g
51 54
       grouped = groupBy (\r0 r1 -> isNonTerminalRule r0
52 55
                                    && isNonTerminalRule r1
53 56
                                    && ruleName r0 == ruleName r1) sorted
54  
-      merged  = foldr merge [] grouped
55  
-      numStartRules = length . filter isStartRule $ merged
  57
+      merged  = foldr mergeProductions [] grouped
56 58
 
57  
-  -- Check that there is only one start rule.
58  
-  when (numStartRules > 1) $ (Left "More than one start rule!")
  59
+  -- Check that the start rule exists.
  60
+  unless (isJust $ find (\r -> ruleName r == "S") merged) $
  61
+    (Left "No start rule found!")
59 62
 
60  
-  -- TODO: Add more validity checks.
61  
-  return merged
  63
+  -- TODO: Add more validity checks. Check whether the grammar produces an empty
  64
+  -- string.
  65
+  return (CNFGrammar merged "S" False)
62 66
 
63 67
   where
64  
-    merge :: [NamedCNFRule] -> [NamedCNFRule] -> [NamedCNFRule]
65  
-    merge [] rest     = rest
66  
-    merge [rule] rest = rule:rest
67  
-    merge rules  rest =
68  
-      let (NonTerminalRule name _ isStart) = head rules
  68
+    mergeProductions :: [NamedCNFRule] -> [NamedCNFRule] -> [NamedCNFRule]
  69
+    mergeProductions [] rest     = rest
  70
+    mergeProductions [rule] rest = rule:rest
  71
+    mergeProductions rules  rest =
  72
+      let (CNFNonTerminalRule name _) = head rules
69 73
           prods = concatMap nonTerminalRuleProductions rules
70  
-      in  (NonTerminalRule name prods isStart) : rest
  74
+      in  (CNFNonTerminalRule name prods) : rest
110  src/CFG/Types.hs
@@ -3,28 +3,21 @@ module CFG.Types (
3 3
   -- * Types.
4 4
    Symbol
5 5
   ,RuleName, RuleNumber
6  
-  ,IsStartRule(..)
7  
-  ,CNFRule(..)
8  
-  ,NamedCNFRule, NumberedCNFRule
9  
-  ,NamedCNFGrammar, CNFGrammar
10 6
 
11  
-  --  * Helpers for constructing the grammar.
12  
-  ,ruleTerminal, ruleNonTerminal, ruleStart
13  
-  ,compileGrammar
  7
+  ,CFGRule(..), CFGrammar(..)
  8
+  ,NamedCFGRule, NumberedCFGRule
  9
+  ,NamedCFGrammar, CompiledCFGrammar
  10
+
  11
+  ,CNFRule(..), CNFGrammar(..)
  12
+  ,NamedCNFRule, NumberedCNFRule
  13
+  ,NamedCNFGrammar, CompiledCNFGrammar
14 14
 
15 15
   -- * Misc. helper functions.
16  
-  ,ruleName, ruleNumber
17  
-  ,isTerminalRule, isNonTerminalRule, isStartRule
18  
-  ,terminalRuleProduces, nonTerminalRuleProductions
19 16
   ,charToSymbol, stringToSymbols, symbolsToString
20 17
   )
21  
-       where
22  
-
23  
-import qualified Data.Map   as M
24  
-import           Data.Maybe (fromJust)
25  
-
  18
+  where
26 19
 
27  
--- Grammar ADT definition.
  20
+-- Basic types.
28 21
 
29 22
 newtype Symbol  = SymChar Char
30 23
                   deriving (Show, Eq)
@@ -32,76 +25,39 @@ type Symbols    = [Symbol]
32 25
 type RuleName   = String
33 26
 type RuleNumber = Int
34 27
 
35  
-data IsStartRule = StartRule | NormalRule
36  
-                 deriving (Eq,Show)
37  
-
38  
-data CNFRule a = TerminalRule !a !Symbol
39  
-               | NonTerminalRule !a ![(a, a)] !IsStartRule
  28
+-- General CFG. A rule that generates the empty string is represented as
  29
+-- @CFGNonTerminalRule "RuleName" [[]]@
  30
+data CFGRule a = CFGTerminalRule !a !Symbol
  31
+               | CFGNonTerminalRule !a ![[a]]
40 32
                deriving (Eq, Show)
41 33
 
42  
-type NamedCNFRule    = CNFRule RuleName
43  
-type NumberedCNFRule = CNFRule RuleNumber
44  
-
45  
-type NamedCNFGrammar = [NamedCNFRule]
46  
-type CNFGrammar = [NumberedCNFRule]
47  
-
48  
--- Helpers for constructing the grammar.
49  
-
50  
-ruleTerminal :: RuleName -> Char -> NamedCNFRule
51  
-ruleTerminal name prod = TerminalRule name (SymChar prod)
  34
+type NamedCFGRule    = CFGRule RuleName
  35
+type NumberedCFGRule = CFGRule RuleNumber
52 36
 
53  
-ruleNonTerminal :: RuleName -> [(RuleName, RuleName)] -> NamedCNFRule
54  
-ruleNonTerminal name prods = NonTerminalRule name prods NormalRule
  37
+data CFGrammar a = CFGrammar { cfgRules  :: [CFGRule a]
  38
+                             , cfgStartRule :: a
  39
+                             } deriving Show
55 40
 
56  
-ruleStart :: RuleName -> [(RuleName, RuleName)] -> NamedCNFRule
57  
-ruleStart name prods = NonTerminalRule name prods StartRule
  41
+type NamedCFGrammar    = CFGrammar RuleName
  42
+type CompiledCFGrammar = CFGrammar RuleNumber
58 43
 
59  
-compileGrammar :: NamedCNFGrammar -> CNFGrammar
60  
-compileGrammar grammar = map compileRule grammar
61  
-  where
62  
-    idxMap :: M.Map RuleName RuleNumber
63  
-    idxMap = M.fromList (zip (map ruleName grammar) [1..])
64  
-
65  
-    lookupName :: RuleName -> RuleNumber
66  
-    lookupName k = fromJust $ M.lookup k idxMap
67  
-
68  
-    compileRule :: NamedCNFRule -> NumberedCNFRule
69  
-    compileRule (TerminalRule name symbol) =
70  
-      TerminalRule (lookupName name) symbol
71  
-    compileRule (NonTerminalRule name prods isStart) =
72  
-      NonTerminalRule (lookupName name)
73  
-      [(lookupName a, lookupName b) | (a,b) <- prods] isStart
74  
-
75  
--- Misc. helper functions.
76  
-
77  
-ruleName :: NamedCNFRule -> RuleName
78  
-ruleName (TerminalRule name _)      = name
79  
-ruleName (NonTerminalRule name _ _) = name
80  
-
81  
-ruleNumber :: NumberedCNFRule -> RuleNumber
82  
-ruleNumber (TerminalRule num _)      = num
83  
-ruleNumber (NonTerminalRule num _ _) = num
84  
-
85  
-isTerminalRule :: CNFRule a -> Bool
86  
-isTerminalRule (TerminalRule _ _) = True
87  
-isTerminalRule _                  = False
88  
-
89  
-isNonTerminalRule :: CNFRule a -> Bool
90  
-isNonTerminalRule (NonTerminalRule _ _ _) = True
91  
-isNonTerminalRule _                       = False
  44
+-- A context-free grammar in CNF form.
  45
+data CNFRule a = CNFTerminalRule !a !Symbol
  46
+               | CNFNonTerminalRule !a ![(a, a)]
  47
+               deriving (Eq, Show)
92 48
 
93  
-isStartRule :: CNFRule a -> Bool
94  
-isStartRule (NonTerminalRule _ _ StartRule) = True
95  
-isStartRule _                               = False
  49
+type NamedCNFRule    = CNFRule RuleName
  50
+type NumberedCNFRule = CNFRule RuleNumber
96 51
 
97  
-terminalRuleProduces :: CNFRule a -> Symbol -> Bool
98  
-terminalRuleProduces (TerminalRule _ s) s' = (s == s')
99  
-terminalRuleProduces _                  _  = error "Terminal rule expected!"
  52
+data CNFGrammar a = CNFGrammar { cnfRules         :: [CNFRule a]
  53
+                               , cnfStartRule     :: a
  54
+                               , cnfProducesEmpty :: Bool
  55
+                               } deriving Show
100 56
 
101  
-nonTerminalRuleProductions :: CNFRule a -> [(a, a)]
102  
-nonTerminalRuleProductions (NonTerminalRule _ prods _) = prods
103  
-nonTerminalRuleProductions  _ = error "Non-terminal rule expected!"
  57
+type NamedCNFGrammar    = CNFGrammar RuleName
  58
+type CompiledCNFGrammar = CNFGrammar RuleNumber
104 59
 
  60
+-- Helpers for working with the 'Symbol' type.
105 61
 charToSymbol :: Char -> Symbol
106 62
 charToSymbol = SymChar
107 63
 
2  src/cfg.cabal
@@ -16,6 +16,8 @@ cabal-version:       >=1.8
16 16
 
17 17
 library
18 18
   exposed-modules:     CFG.Types,
  19
+                       CFG.Helpers.CNF,
  20
+                       CFG.Helpers.CFG,
19 21
                        CFG.Read,
20 22
                        CFG.Parse,
21 23
                        CFG.Decide
2  src/exe/cykAlgorithm/Main.hs
@@ -4,9 +4,9 @@ module Main
4 4
 import System.Environment (getArgs)
5 5
 
6 6
 import CFG.Examples
  7
+import CFG.Helpers.CNF    (compileGrammar)
7 8
 import CFG.Parse
8 9
 import CFG.Read
9  
-import CFG.Types
10 10
 
11 11
 exampleValidInput :: String
12 12
 exampleValidInput = "((((()))))"
2  src/tests/Tests.hs
@@ -9,9 +9,9 @@ import Test.HUnit
9 9
 import Test.QuickCheck
10 10
 
11 11
 import CFG.Examples
  12
+import CFG.Helpers.CNF                      (compileGrammar)
12 13
 import CFG.Parse
13 14
 import CFG.Read
14  
-import CFG.Types
15 15
 
16 16
 -- QuickCheck tests.
17 17
 prop_parentheses_gen :: Bool -> Gen Bool

No commit comments for this range

Something went wrong with that request. Please try again.