mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-11 04:02:52 -06:00
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
|
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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|
||||||
|
|||||||
@@ -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"
|
||||||
|
|||||||
Reference in New Issue
Block a user