GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-09 04:59:31 -06:00
Code Issues Packages Projects Releases Wiki Activity

Look at both command-line and grammar startcat falgs in pg commands.

Browse Source
This commit is contained in:
bringert
2006-04-18 12:42:20 +00:00
parent 3e805a3531
commit 4d3dc4ac54
8 changed files with 58 additions and 36 deletions
Download Patch File Download Diff File Expand all files Collapse all files

20
src/GF/Compile/ShellState.hs
View File

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

11
src/GF/Speech/GrammarToVoiceXML.hs
View File

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

5
src/GF/Speech/PrGSL.hs
View File

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

7
src/GF/Speech/PrJSGF.hs
View File

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

5
src/GF/Speech/PrSRGS.hs
View File

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

6
src/GF/Speech/SRG.hs
View File

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

5
src/GF/Speech/TransformCFG.hs
View File

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

35
src/GF/UseGrammar/Custom.hs
View File

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