1
0
forked from GitHub/gf-core

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
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

View File

@@ -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

View File

@@ -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"