diff --git a/src/GF/Speech/CFGToFiniteState.hs b/src/GF/Speech/CFGToFiniteState.hs index 692d12a67..efc4c562e 100644 --- a/src/GF/Speech/CFGToFiniteState.hs +++ b/src/GF/Speech/CFGToFiniteState.hs @@ -63,7 +63,7 @@ cfgToFA opts s = minimize $ compileAutomaton start $ makeSimpleRegular opts s where start = getStartCatCF opts s makeSimpleRegular :: Options -> StateGrammar -> CFRules -makeSimpleRegular opts s = makeRegular $ preprocess $ cfgToCFRules s +makeSimpleRegular opts s = makeRegular $ cfgToCFRules s where start = getStartCatCF opts s preprocess = fix (topDownFilter start . bottomUpFilter) . removeCycles diff --git a/src/GF/Speech/SRG.hs b/src/GF/Speech/SRG.hs index 7ec96232e..8370f130a 100644 --- a/src/GF/Speech/SRG.hs +++ b/src/GF/Speech/SRG.hs @@ -17,8 +17,9 @@ ----------------------------------------------------------------------------- module GF.Speech.SRG (SRG(..), SRGRule(..), SRGAlt(..), SRGItem, - SRGCat, SRGNT, CFTerm, - makeSimpleSRG + SRGCat, SRGNT, CFTerm + , makeSRG + , makeSimpleSRG , lookupFM_, prtS , cfgCatToGFCat, srgTopCats ) where @@ -82,7 +83,18 @@ type CatNames = Map String String makeSimpleSRG :: Options -- ^ Grammar options -> StateGrammar -> 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, startCat = lookupFM_ names origStart, origStartCat = origStart, @@ -94,11 +106,7 @@ makeSimpleSRG opt s = origStart = getStartCatCF opts s probs = stateProbs s l = fmap (replace '_' '-') $ getOptVal opts speechLanguage - (cats,cfgRules) = unzip $ preprocess $ cfgToCFRules s - preprocess = mergeIdentical - . removeLeftRecursion origStart - . fix (topDownFilter origStart . bottomUpFilter) - . removeCycles + (cats,cfgRules) = unzip $ preprocess origStart $ cfgToCFRules s names = mkCatNames name cats rs = map (cfgRulesToSRGRule names probs) cfgRules diff --git a/src/GF/Speech/TransformCFG.hs b/src/GF/Speech/TransformCFG.hs index 33ef9771d..a94cf3817 100644 --- a/src/GF/Speech/TransformCFG.hs +++ b/src/GF/Speech/TransformCFG.hs @@ -29,7 +29,7 @@ import GF.Infra.Ident import GF.Infra.Option import GF.Infra.Print 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.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) 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 opts sgr = getStartCat opts sgr ++ "{}.s"