forked from GitHub/gf-core
Added makeSRG.
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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"
|
||||
|
||||
Reference in New Issue
Block a user