mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-11 04:02:52 -06:00
Look at both command-line and grammar startcat falgs in pg commands.
This commit is contained in:
@@ -21,10 +21,9 @@ import GF.Data.XML
|
||||
import Data.List (isPrefixOf, find, intersperse)
|
||||
|
||||
-- | the main function
|
||||
grammar2vxml :: GFC.CanonGrammar -> String
|
||||
grammar2vxml gr = showsXMLDoc (skel2vxml name startcat gr') ""
|
||||
grammar2vxml :: String -> GFC.CanonGrammar -> String
|
||||
grammar2vxml startcat gr = showsXMLDoc (skel2vxml name startcat gr') ""
|
||||
where (name, gr') = vSkeleton gr
|
||||
startcat = "Order" -- FIXME
|
||||
|
||||
type VIdent = String
|
||||
|
||||
@@ -109,7 +108,7 @@ cat2form :: String -> VIdent -> [(VIdent, [VIdent])] -> XML
|
||||
cat2form gr cat fs =
|
||||
form cat [var "value" (Just "'?'"), formDebug cat,
|
||||
block [if_ "value != '?'" [assign cat "value"]],
|
||||
field cat [] [promptString ("quest_"++cat),
|
||||
field cat [] [promptString (catQuestion cat),
|
||||
grammar (gr++"#"++cat),
|
||||
nomatch [Data "I didn't understand you.", reprompt],
|
||||
help [Data ("help_"++cat)],
|
||||
@@ -120,6 +119,10 @@ cat2form gr cat fs =
|
||||
where subDone = [assign cat "sub.value", return_ [cat]]
|
||||
feedback = []
|
||||
|
||||
catQuestion :: VIdent -> String
|
||||
catQuestion cat = questFun
|
||||
where questFun = "quest_"++cat
|
||||
|
||||
fun2form :: String -> VIdent -> [VIdent] -> XML
|
||||
fun2form gr fun args =
|
||||
form fun ([var "value" Nothing] ++ [formDebug fun]
|
||||
|
||||
@@ -31,9 +31,10 @@ import GF.Probabilistic.Probabilistic (Probs)
|
||||
import Data.Char (toUpper,toLower)
|
||||
|
||||
gslPrinter :: Ident -- ^ Grammar name
|
||||
-> String -- ^ Start category
|
||||
-> Options -> Maybe Probs -> CGrammar -> String
|
||||
gslPrinter name opts probs cfg = prGSL srg ""
|
||||
where srg = topDownFilter $ makeSimpleSRG name opts probs $ rmPunctCFG cfg
|
||||
gslPrinter name start opts probs cfg = prGSL srg ""
|
||||
where srg = topDownFilter $ makeSimpleSRG name start opts probs $ rmPunctCFG cfg
|
||||
|
||||
prGSL :: SRG -> ShowS
|
||||
prGSL (SRG{grammarName=name,startCat=start,origStartCat=origStart,rules=rs})
|
||||
|
||||
@@ -30,9 +30,10 @@ import GF.Probabilistic.Probabilistic (Probs)
|
||||
import GF.Speech.SRG
|
||||
|
||||
jsgfPrinter :: Ident -- ^ Grammar name
|
||||
-> Options -> Maybe Probs -> CGrammar -> String
|
||||
jsgfPrinter name opts probs cfg = prJSGF srg ""
|
||||
where srg = makeSimpleSRG name opts probs cfg
|
||||
-> String -- ^ Start category
|
||||
-> Options -> Maybe Probs -> CGrammar -> String
|
||||
jsgfPrinter name start opts probs cfg = prJSGF srg ""
|
||||
where srg = makeSimpleSRG name start opts probs cfg
|
||||
|
||||
prJSGF :: SRG -> ShowS
|
||||
prJSGF (SRG{grammarName=name,startCat=start,origStartCat=origStart,rules=rs})
|
||||
|
||||
@@ -36,12 +36,13 @@ import qualified Data.Map as Map
|
||||
import qualified Data.Set as Set
|
||||
|
||||
srgsXmlPrinter :: Ident -- ^ Grammar name
|
||||
-> String -- ^ Start category
|
||||
-> Options
|
||||
-> Bool -- ^ Whether to include semantic interpretation
|
||||
-> Maybe Probs
|
||||
-> CGrammar -> String
|
||||
srgsXmlPrinter name opts sisr probs cfg = prSrgsXml sisr srg ""
|
||||
where srg = makeSRG name opts probs cfg
|
||||
srgsXmlPrinter name start opts sisr probs cfg = prSrgsXml sisr srg ""
|
||||
where srg = makeSRG name start opts probs cfg
|
||||
|
||||
prSrgsXml :: Bool -> SRG -> ShowS
|
||||
prSrgsXml sisr (SRG{grammarName=name,startCat=start,
|
||||
|
||||
@@ -69,6 +69,7 @@ type CatNames = Map String String
|
||||
-- FIXME: the probabilities, names and profiles in the returned
|
||||
-- grammar may be meaningless.
|
||||
makeSimpleSRG :: Ident -- ^ Grammar name
|
||||
-> String -- ^ Start category
|
||||
-> Options -- ^ Grammar options
|
||||
-> Maybe Probs -- ^ Probabilities
|
||||
-> CGrammar -- ^ A context-free grammar
|
||||
@@ -79,6 +80,7 @@ makeSimpleSRG
|
||||
-- | Create a SRG preserving the names, profiles and probabilities of the
|
||||
-- input grammar. The returned grammar may be left-recursive.
|
||||
makeSRG :: Ident -- ^ Grammar name
|
||||
-> String -- ^ Start category
|
||||
-> Options -- ^ Grammar options
|
||||
-> Maybe Probs -- ^ Probabilities
|
||||
-> CGrammar -- ^ A context-free grammar
|
||||
@@ -88,11 +90,12 @@ makeSRG = makeSRG_ removeEmptyCats
|
||||
makeSRG_ :: (CFRules -> CFRules) -- ^ Transformations to apply to the
|
||||
-- CFG before converting to SRG
|
||||
-> Ident -- ^ Grammar name
|
||||
-> String -- ^ Start category
|
||||
-> Options -- ^ Grammar options
|
||||
-> Maybe Probs -- ^ Probabilities
|
||||
-> CGrammar -- ^ A context-free grammar
|
||||
-> SRG
|
||||
makeSRG_ f i opts probs gr
|
||||
makeSRG_ f i origStart opts probs gr
|
||||
= SRG { grammarName = name,
|
||||
startCat = lookupFM_ names origStart,
|
||||
origStartCat = origStart,
|
||||
@@ -100,7 +103,6 @@ makeSRG_ f i opts probs gr
|
||||
rules = rs }
|
||||
where
|
||||
name = prIdent i
|
||||
origStart = getStartCat opts
|
||||
l = fromMaybe "en_UK" (getOptVal opts speechLanguage)
|
||||
gr' = f (cfgToCFRules gr)
|
||||
(cats,cfgRules) = unzip gr'
|
||||
|
||||
@@ -19,7 +19,7 @@
|
||||
-- FIXME: lots of this stuff is used by CFGToFiniteState, thus
|
||||
-- the missing explicit expot list.
|
||||
module GF.Speech.TransformCFG {- (CFRule_, CFRules,
|
||||
cfgToCFRules, getStartCat,
|
||||
cfgToCFRules,
|
||||
removeLeftRecursion,
|
||||
removeEmptyCats, removeIdenticalRules) -} where
|
||||
|
||||
@@ -56,9 +56,6 @@ cfgToCFRules cfg = groupProds [CFRule (catToString c) (map symb r) n | CFRule c
|
||||
-- symb (Tok t) = Tok t
|
||||
catToString = prt
|
||||
|
||||
getStartCat :: Options -> String
|
||||
getStartCat opts = fromMaybe "S" (getOptVal opts gStartCat) ++ "{}.s"
|
||||
|
||||
-- | Group productions by their lhs categories
|
||||
groupProds :: [CFRule_] -> CFRules
|
||||
groupProds = Map.toList . Map.fromListWith (++) . map (\r -> (lhsCat r,[r]))
|
||||
|
||||
Reference in New Issue
Block a user