diff options
| author | bringert <bringert@cs.chalmers.se> | 2007-03-20 21:59:36 +0000 |
|---|---|---|
| committer | bringert <bringert@cs.chalmers.se> | 2007-03-20 21:59:36 +0000 |
| commit | 50614d399a8270ad53ac577c6ad7f3563e8bee44 (patch) | |
| tree | e5d02eff1a97d83a41a5d07e5f6f92b0766aaf34 /src | |
| parent | fa33c22e07782c0e528c428dc976a108724771ce (diff) | |
Do top-down and bottom-up filtering together to a fixed point.
Diffstat (limited to 'src')
| -rw-r--r-- | src/GF/Speech/SRG.hs | 3 | ||||
| -rw-r--r-- | src/GF/Speech/TransformCFG.hs | 9 |
2 files changed, 5 insertions, 7 deletions
diff --git a/src/GF/Speech/SRG.hs b/src/GF/Speech/SRG.hs index 9dbfe4606..edd02a21b 100644 --- a/src/GF/Speech/SRG.hs +++ b/src/GF/Speech/SRG.hs @@ -96,8 +96,7 @@ makeSimpleSRG opt s = l = fmap (replace '_' '-') $ getOptVal opts speechLanguage (cats,cfgRules) = unzip $ preprocess $ cfgToCFRules s preprocess = removeLeftRecursion origStart - . bottomUpFilter - . topDownFilter origStart + . fix (topDownFilter origStart . bottomUpFilter) . removeIdenticalRules . removeCycles names = mkCatNames name cats diff --git a/src/GF/Speech/TransformCFG.hs b/src/GF/Speech/TransformCFG.hs index 719e6af05..1439cc09d 100644 --- a/src/GF/Speech/TransformCFG.hs +++ b/src/GF/Speech/TransformCFG.hs @@ -93,12 +93,10 @@ 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 +-- | Removes productions which use categories which have no productions. +-- Only does one pass through the grammar. bottomUpFilter :: CFRules -> CFRules -bottomUpFilter = fix removeEmptyCats' - where - removeEmptyCats' :: CFRules -> CFRules - removeEmptyCats' rs = k' +bottomUpFilter rs = k' where keep = filter (not . null . snd) rs allCats = nub [c | (_,r) <- rs, CFRule _ rhs _ <- r, Cat c <- rhs] @@ -106,6 +104,7 @@ bottomUpFilter = fix removeEmptyCats' k' = map (\ (c,xs) -> (c, filter (not . anyUsedBy emptyCats) xs)) keep -- | Removes categories which are not reachable from the start category. +-- Only does one pass through the grammar. topDownFilter :: Cat_ -> CFRules -> CFRules topDownFilter start rules = filter ((`Set.member` keep) . fst) rules where |