Added makeSRG.

This commit is contained in:
bringert
2007-06-21 13:40:13 +00:00
parent 336273c534
commit 16bfb1250b
3 changed files with 20 additions and 11 deletions

View File

@@ -63,7 +63,7 @@ cfgToFA opts s = minimize $ compileAutomaton start $ makeSimpleRegular opts s
where start = getStartCatCF opts s where start = getStartCatCF opts s
makeSimpleRegular :: Options -> StateGrammar -> CFRules makeSimpleRegular :: Options -> StateGrammar -> CFRules
makeSimpleRegular opts s = makeRegular $ preprocess $ cfgToCFRules s makeSimpleRegular opts s = makeRegular $ cfgToCFRules s
where start = getStartCatCF opts s where start = getStartCatCF opts s
preprocess = fix (topDownFilter start . bottomUpFilter) preprocess = fix (topDownFilter start . bottomUpFilter)
. removeCycles . removeCycles

View File

@@ -17,8 +17,9 @@
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module GF.Speech.SRG (SRG(..), SRGRule(..), SRGAlt(..), SRGItem, module GF.Speech.SRG (SRG(..), SRGRule(..), SRGAlt(..), SRGItem,
SRGCat, SRGNT, CFTerm, SRGCat, SRGNT, CFTerm
makeSimpleSRG , makeSRG
, makeSimpleSRG
, lookupFM_, prtS , lookupFM_, prtS
, cfgCatToGFCat, srgTopCats , cfgCatToGFCat, srgTopCats
) where ) where
@@ -82,7 +83,18 @@ type CatNames = Map String String
makeSimpleSRG :: Options -- ^ Grammar options makeSimpleSRG :: Options -- ^ Grammar options
-> StateGrammar -> StateGrammar
-> SRG -> SRG
makeSimpleSRG opt s = makeSimpleSRG opt s = makeSRG preprocess opt s
where
preprocess origStart = mergeIdentical
. removeLeftRecursion origStart
. fix (topDownFilter origStart . bottomUpFilter)
. removeCycles
makeSRG :: (Cat_ -> CFRules -> CFRules)
-> Options -- ^ Grammar options
-> StateGrammar
-> SRG
makeSRG preprocess opt s =
SRG { grammarName = name, SRG { grammarName = name,
startCat = lookupFM_ names origStart, startCat = lookupFM_ names origStart,
origStartCat = origStart, origStartCat = origStart,
@@ -94,11 +106,7 @@ makeSimpleSRG opt s =
origStart = getStartCatCF opts s origStart = getStartCatCF opts s
probs = stateProbs s probs = stateProbs s
l = fmap (replace '_' '-') $ getOptVal opts speechLanguage l = fmap (replace '_' '-') $ getOptVal opts speechLanguage
(cats,cfgRules) = unzip $ preprocess $ cfgToCFRules s (cats,cfgRules) = unzip $ preprocess origStart $ cfgToCFRules s
preprocess = mergeIdentical
. removeLeftRecursion origStart
. fix (topDownFilter origStart . bottomUpFilter)
. removeCycles
names = mkCatNames name cats names = mkCatNames name cats
rs = map (cfgRulesToSRGRule names probs) cfgRules rs = map (cfgRulesToSRGRule names probs) cfgRules

View File

@@ -29,7 +29,7 @@ import GF.Infra.Ident
import GF.Infra.Option import GF.Infra.Option
import GF.Infra.Print import GF.Infra.Print
import GF.Speech.Relation import GF.Speech.Relation
import GF.Compile.ShellState (StateGrammar, stateCFG, stateGrammarST, startCatStateOpts) import GF.Compile.ShellState (StateGrammar, stateCFG, stateGrammarST, startCatStateOpts, stateOptions)
import Control.Monad import Control.Monad
import Control.Monad.State (State, get, put, evalState) import Control.Monad.State (State, get, put, evalState)
@@ -78,7 +78,8 @@ cfgToCFRules s =
profileToTerm (C.CId t) (Constant f) = maybe (CFMeta t) (\x -> CFObj x []) (forestName f) profileToTerm (C.CId t) (Constant f) = maybe (CFMeta t) (\x -> CFObj x []) (forestName f)
getStartCat :: Options -> StateGrammar -> String getStartCat :: Options -> StateGrammar -> String
getStartCat opts sgr = prCFCat (startCatStateOpts opts sgr) getStartCat opts sgr = prCFCat (startCatStateOpts opts' sgr)
where opts' = addOptions opts (stateOptions sgr)
getStartCatCF :: Options -> StateGrammar -> String getStartCatCF :: Options -> StateGrammar -> String
getStartCatCF opts sgr = getStartCat opts sgr ++ "{}.s" getStartCatCF opts sgr = getStartCat opts sgr ++ "{}.s"