msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

Some clean-up in GF/Speech/TransformCFG.hs

Browse Source
This commit is contained in:
bringert
2006-12-17 13:29:12 +00:00
parent 0bf909b0fd
commit f252bb6090
1 changed files with 11 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
src/GF/Speech/TransformCFG.hs
View File

@@ -56,14 +56,6 @@ cfgToCFRules cfg = groupProds [CFRule (catToString c) (map symb r) n | CFRule c
-- symb (Tok t) = Tok t -- symb (Tok t) = Tok t
catToString = prt catToString = prt
-- | Group productions by their lhs categories
groupProds :: [CFRule_] -> CFRules
groupProds = Map.toList . Map.fromListWith (++) . map (\r -> (lhsCat r,[r]))
ungroupProds :: CFRules -> [CFRule_]
ungroupProds = concat . map snd
-- | Remove productions which use categories which have no productions -- | Remove productions which use categories which have no productions
removeEmptyCats :: CFRules -> CFRules removeEmptyCats :: CFRules -> CFRules
removeEmptyCats = fix removeEmptyCats' removeEmptyCats = fix removeEmptyCats'
@@ -84,6 +76,8 @@ removeIdenticalRules g = [(c,sortNubBy cmpRules rs) | (c,rs) <- g]
cmpRules (CFRule c1 ss1 _) (CFRule c2 ss2 _) = cmpRules (CFRule c1 ss1 _) (CFRule c2 ss2 _) =
mconcat [c1 `compare` c2, ss1 `compare` ss2] mconcat [c1 `compare` c2, ss1 `compare` ss2]
-- * Removing left recursion
-- Paull's algorithm, see -- Paull's algorithm, see
-- http://research.microsoft.com/users/bobmoore/naacl2k-proc-rev.pdf -- http://research.microsoft.com/users/bobmoore/naacl2k-proc-rev.pdf
removeLeftRecursion :: CFRules -> CFRules removeLeftRecursion :: CFRules -> CFRules
@@ -125,6 +119,8 @@ isDirectLeftRecursive :: CFRule_ -> Bool
isDirectLeftRecursive (CFRule c (Cat c':_) _) = c == c' isDirectLeftRecursive (CFRule c (Cat c':_) _) = c == c'
isDirectLeftRecursive _ = False isDirectLeftRecursive _ = False
-- * Removing cycles
removeCycles :: CFRules -> CFRules removeCycles :: CFRules -> CFRules
removeCycles = groupProds . removeCycles_ . ungroupProds removeCycles = groupProds . removeCycles_ . ungroupProds
where removeCycles_ rs = [r | r@(CFRule c rhs n) <- rs, rhs /= [Cat c]] where removeCycles_ rs = [r | r@(CFRule c rhs n) <- rs, rhs /= [Cat c]]
@@ -133,6 +129,13 @@ removeCycles = groupProds . removeCycles_ . ungroupProds
-- * CFG rule utilities -- * CFG rule utilities
-- --
-- | Group productions by their lhs categories
groupProds :: [CFRule_] -> CFRules
groupProds = buildMultiMap . map (\r -> (lhsCat r,r))
ungroupProds :: CFRules -> [CFRule_]
ungroupProds = concat . map snd
allCats :: CFRules -> [Cat_] allCats :: CFRules -> [Cat_]
allCats = map fst allCats = map fst