forked from GitHub/gf-core
Moved code and comments around in TransformCFG.
This commit is contained in:
@@ -86,7 +86,14 @@ getStartCatCF opts sgr = getStartCat opts sgr ++ "{}.s"
|
|||||||
stateGFCC :: StateGrammar -> GFCC
|
stateGFCC :: StateGrammar -> GFCC
|
||||||
stateGFCC = mkGFCC . mkCanon2gfcc . stateGrammarST
|
stateGFCC = mkGFCC . mkCanon2gfcc . stateGrammarST
|
||||||
|
|
||||||
-- | Remove productions which use categories which have no productions
|
-- * Grammar filtering
|
||||||
|
|
||||||
|
-- | Removes all directly cyclic productions.
|
||||||
|
removeCycles :: CFRules -> CFRules
|
||||||
|
removeCycles = groupProds . removeCycles_ . ungroupProds
|
||||||
|
where removeCycles_ rs = [r | r@(CFRule c rhs _) <- rs, rhs /= [Cat c]]
|
||||||
|
|
||||||
|
-- | Removes productions which use categories which have no productions
|
||||||
bottomUpFilter :: CFRules -> CFRules
|
bottomUpFilter :: CFRules -> CFRules
|
||||||
bottomUpFilter = fix removeEmptyCats'
|
bottomUpFilter = fix removeEmptyCats'
|
||||||
where
|
where
|
||||||
@@ -98,6 +105,14 @@ bottomUpFilter = fix removeEmptyCats'
|
|||||||
emptyCats = filter (nothingOrNull . flip lookup rs) allCats
|
emptyCats = filter (nothingOrNull . flip lookup rs) allCats
|
||||||
k' = map (\ (c,xs) -> (c, filter (not . anyUsedBy emptyCats) xs)) keep
|
k' = map (\ (c,xs) -> (c, filter (not . anyUsedBy emptyCats) xs)) keep
|
||||||
|
|
||||||
|
-- | Removes categories which are not reachable from the start category.
|
||||||
|
topDownFilter :: Cat_ -> CFRules -> CFRules
|
||||||
|
topDownFilter start rules = filter ((`Set.member` keep) . fst) rules
|
||||||
|
where
|
||||||
|
rhsCats = [ (c, c') | (c,rs) <- rules, r <- rs, c' <- filterCats (ruleRhs r) ]
|
||||||
|
uses = reflexiveClosure_ (allCats rules) $ transitiveClosure $ mkRel rhsCats
|
||||||
|
keep = allRelated uses start
|
||||||
|
|
||||||
-- | Remove rules which have the same rhs.
|
-- | Remove rules which have the same rhs.
|
||||||
-- FIXME: this messes up probabilities, names and profiles
|
-- FIXME: this messes up probabilities, names and profiles
|
||||||
removeIdenticalRules :: CFRules -> CFRules
|
removeIdenticalRules :: CFRules -> CFRules
|
||||||
@@ -214,22 +229,6 @@ isDirectLeftRecursive _ = False
|
|||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
-- * Removing cycles
|
|
||||||
|
|
||||||
removeCycles :: CFRules -> CFRules
|
|
||||||
removeCycles = groupProds . removeCycles_ . ungroupProds
|
|
||||||
where removeCycles_ rs = [r | r@(CFRule c rhs _) <- rs, rhs /= [Cat c]]
|
|
||||||
|
|
||||||
-- * Top-down filtering
|
|
||||||
|
|
||||||
-- | Remove categories which are not reachable from the start category.
|
|
||||||
topDownFilter :: Cat_ -> CFRules -> CFRules
|
|
||||||
topDownFilter start rules = filter ((`Set.member` keep) . fst) rules
|
|
||||||
where
|
|
||||||
rhsCats = [ (c, c') | (c,rs) <- rules, r <- rs, c' <- filterCats (ruleRhs r) ]
|
|
||||||
uses = reflexiveClosure_ (allCats rules) $ transitiveClosure $ mkRel rhsCats
|
|
||||||
keep = allRelated uses start
|
|
||||||
|
|
||||||
-- | Get the sets of mutually recursive non-terminals for a grammar.
|
-- | Get the sets of mutually recursive non-terminals for a grammar.
|
||||||
mutRecCats :: Bool -- ^ If true, all categories will be in some set.
|
mutRecCats :: Bool -- ^ If true, all categories will be in some set.
|
||||||
-- If false, only recursive categories will be included.
|
-- If false, only recursive categories will be included.
|
||||||
|
|||||||
Reference in New Issue
Block a user