From a663a046edf310247cf1e82761c79397d9bd42ad Mon Sep 17 00:00:00 2001 From: bringert Date: Tue, 18 Apr 2006 12:42:20 +0000 Subject: [PATCH] Look at both command-line and grammar startcat falgs in pg commands. --- src/GF/Compile/ShellState.hs | 20 ++++++++++++----- src/GF/Speech/GrammarToVoiceXML.hs | 11 ++++++---- src/GF/Speech/PrGSL.hs | 5 +++-- src/GF/Speech/PrJSGF.hs | 7 +++--- src/GF/Speech/PrSRGS.hs | 5 +++-- src/GF/Speech/SRG.hs | 6 +++-- src/GF/Speech/TransformCFG.hs | 5 +---- src/GF/UseGrammar/Custom.hs | 35 ++++++++++++++++++------------ 8 files changed, 58 insertions(+), 36 deletions(-) diff --git a/src/GF/Compile/ShellState.hs b/src/GF/Compile/ShellState.hs index 0718814c5..7f8ae17e7 100644 --- a/src/GF/Compile/ShellState.hs +++ b/src/GF/Compile/ShellState.hs @@ -43,8 +43,11 @@ import qualified GF.OldParsing.ConvertGrammar as CnvOld -- OBSOLETE import qualified GF.Conversion.GFC as Cnv import qualified GF.Parsing.GFC as Prs +import Control.Monad (mplus) import Data.List (nub,nubBy) import qualified Data.Map as Map +import Data.Maybe (fromMaybe) + -- AR 11/11/2001 -- 17/6/2003 (for modules) ---- unfinished @@ -458,13 +461,20 @@ firstCatOpts opts sgr = firstAbsCat :: Options -> StateGrammar -> G.QIdent firstAbsCat opts = cfCat2Cat . firstCatOpts opts +-- | Gets the start category for the grammar from the options. +-- If the startcat is not set in the options, we look +-- for a flag in the grammar. If there is no flag in the +-- grammar, S is returned. +startCatStateOpts :: Options -> StateGrammar -> CFCat +startCatStateOpts opts sgr = + string2CFCat a (fromMaybe "S" (optsStartCat `mplus` grStartCat)) + where optsStartCat = getOptVal opts gStartCat + grStartCat = getOptVal (stateOptions sgr) gStartCat + a = P.prt (absId sgr) + -- | a grammar can have start category as option startcat=foo ; default is S stateFirstCat :: StateGrammar -> CFCat -stateFirstCat sgr = - maybe (string2CFCat a "S") (string2CFCat a) $ - getOptVal (stateOptions sgr) gStartCat - where - a = P.prt (absId sgr) +stateFirstCat = startCatStateOpts noOptions stateIsWord :: StateGrammar -> String -> Bool stateIsWord sg = isKnownWord (stateMorpho sg) diff --git a/src/GF/Speech/GrammarToVoiceXML.hs b/src/GF/Speech/GrammarToVoiceXML.hs index 1e3916953..f61e75f24 100644 --- a/src/GF/Speech/GrammarToVoiceXML.hs +++ b/src/GF/Speech/GrammarToVoiceXML.hs @@ -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] diff --git a/src/GF/Speech/PrGSL.hs b/src/GF/Speech/PrGSL.hs index 5fdb28e8e..ffcd00509 100644 --- a/src/GF/Speech/PrGSL.hs +++ b/src/GF/Speech/PrGSL.hs @@ -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}) diff --git a/src/GF/Speech/PrJSGF.hs b/src/GF/Speech/PrJSGF.hs index 56f5eda1b..2a4c4fd51 100644 --- a/src/GF/Speech/PrJSGF.hs +++ b/src/GF/Speech/PrJSGF.hs @@ -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}) diff --git a/src/GF/Speech/PrSRGS.hs b/src/GF/Speech/PrSRGS.hs index 8e358e51f..dae6f35f6 100644 --- a/src/GF/Speech/PrSRGS.hs +++ b/src/GF/Speech/PrSRGS.hs @@ -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, diff --git a/src/GF/Speech/SRG.hs b/src/GF/Speech/SRG.hs index 03204d888..2dd41cfaf 100644 --- a/src/GF/Speech/SRG.hs +++ b/src/GF/Speech/SRG.hs @@ -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' diff --git a/src/GF/Speech/TransformCFG.hs b/src/GF/Speech/TransformCFG.hs index b1ddcbde2..27435ed89 100644 --- a/src/GF/Speech/TransformCFG.hs +++ b/src/GF/Speech/TransformCFG.hs @@ -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])) diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs index 69d6d7df1..82aade7ff 100644 --- a/src/GF/UseGrammar/Custom.hs +++ b/src/GF/UseGrammar/Custom.hs @@ -244,35 +244,41 @@ customGrammarPrinter = ,(strCI "old", \_ -> printGrammarOld . stateGrammarST) ,(strCI "srg", \_ -> prSRG . stateCF) ,(strCI "gsl", \opts s -> let name = cncId s - in gslPrinter name opts Nothing $ stateCFG s) + start = getStartCatCF opts s + in gslPrinter name start opts Nothing $ stateCFG s) ,(strCI "jsgf", \opts s -> let name = cncId s - in jsgfPrinter name opts Nothing $ stateCFG s) + start = getStartCatCF opts s + in jsgfPrinter name start opts Nothing $ stateCFG s) ,(strCI "srgs_xml", \opts s -> let name = cncId s - in srgsXmlPrinter name opts False Nothing $ stateCFG s) + start = getStartCatCF opts s + in srgsXmlPrinter name start opts False Nothing $ stateCFG s) ,(strCI "srgs_xml_prob", \opts s -> let name = cncId s probs = stateProbs s - in srgsXmlPrinter name opts False (Just probs) $ stateCFG s) + start = getStartCatCF opts s + in srgsXmlPrinter name start opts False (Just probs) $ stateCFG s) ,(strCI "srgs_xml_ms_sem", \opts s -> let name = cncId s - in srgsXmlPrinter name opts True Nothing $ stateCFG s) - ,(strCI "vxml", \_ -> grammar2vxml . stateGrammarST) - ,(strCI "slf", \opts s -> let start = getStartCat opts + start = getStartCatCF opts s + in srgsXmlPrinter name start opts True Nothing $ stateCFG s) + ,(strCI "vxml", \opts s -> let start = getStartCat opts s + in grammar2vxml start (stateGrammarST s)) + ,(strCI "slf", \opts s -> let start = getStartCatCF opts s name = cncId s in slfPrinter name start $ stateCFG s) - ,(strCI "slf_graphviz", \opts s -> let start = getStartCat opts + ,(strCI "slf_graphviz", \opts s -> let start = getStartCatCF opts s name = cncId s in slfGraphvizPrinter name start $ stateCFG s) - ,(strCI "slf_sub", \opts s -> let start = getStartCat opts + ,(strCI "slf_sub", \opts s -> let start = getStartCatCF opts s name = cncId s in slfSubPrinter name start $ stateCFG s) - ,(strCI "slf_sub_graphviz", \opts s -> let start = getStartCat opts + ,(strCI "slf_sub_graphviz", \opts s -> let start = getStartCatCF opts s name = cncId s in slfSubGraphvizPrinter name start $ stateCFG s) - ,(strCI "fa_graphviz", \opts s -> let start = getStartCat opts + ,(strCI "fa_graphviz", \opts s -> let start = getStartCatCF opts s name = cncId s in faGraphvizPrinter name start $ stateCFG s) - ,(strCI "fa_c", \opts s -> let start = getStartCat opts + ,(strCI "fa_c", \opts s -> let start = getStartCatCF opts s name = cncId s in faCPrinter name start $ stateCFG s) ,(strCI "regular", \_ -> regularPrinter . stateCFG) @@ -325,8 +331,9 @@ customGrammarPrinter = -- ,(strCI "cfg-old", PrtOld.prt . CnvOld.cfg . statePInfoOld) ] where stateGrammarLangOpts s = (stateOptions s, stateGrammarLang s) - getStartCat :: Options -> String - getStartCat opts = fromMaybe "S" (getOptVal opts gStartCat) ++ "{}.s" + getStartCat,getStartCatCF :: Options -> StateGrammar -> String + getStartCat opts sgr = prCFCat (startCatStateOpts opts sgr) + getStartCatCF opts sgr = getStartCat opts sgr ++ "{}.s" customMultiGrammarPrinter = customData "Printers for multiple grammars, selected by option -printer=x" $