1
0
forked from GitHub/gf-core

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

This commit is contained in:
bringert
2006-12-17 13:29:12 +00:00
parent 0bf909b0fd
commit f252bb6090

View File

@@ -56,14 +56,6 @@ cfgToCFRules cfg = groupProds [CFRule (catToString c) (map symb r) n | CFRule c
-- symb (Tok t) = Tok t
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
removeEmptyCats :: CFRules -> CFRules
removeEmptyCats = fix removeEmptyCats'
@@ -84,6 +76,8 @@ removeIdenticalRules g = [(c,sortNubBy cmpRules rs) | (c,rs) <- g]
cmpRules (CFRule c1 ss1 _) (CFRule c2 ss2 _) =
mconcat [c1 `compare` c2, ss1 `compare` ss2]
-- * Removing left recursion
-- Paull's algorithm, see
-- http://research.microsoft.com/users/bobmoore/naacl2k-proc-rev.pdf
removeLeftRecursion :: CFRules -> CFRules
@@ -125,6 +119,8 @@ isDirectLeftRecursive :: CFRule_ -> Bool
isDirectLeftRecursive (CFRule c (Cat c':_) _) = c == c'
isDirectLeftRecursive _ = False
-- * Removing cycles
removeCycles :: CFRules -> CFRules
removeCycles = groupProds . removeCycles_ . ungroupProds
where removeCycles_ rs = [r | r@(CFRule c rhs n) <- rs, rhs /= [Cat c]]
@@ -133,6 +129,13 @@ removeCycles = groupProds . removeCycles_ . ungroupProds
-- * 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 = map fst