diff --git a/src/GF/API.hs b/src/GF/API.hs index 768fa7d6b..950fed731 100644 --- a/src/GF/API.hs +++ b/src/GF/API.hs @@ -216,7 +216,7 @@ speechInput opt s = recognizeSpeech name language cfg cat number name = cncId s cfg = stateCFG s -- FIXME: use lang flag to select grammar language = fromMaybe "en_UK" (getOptVal opts speechLanguage) - cat = fromMaybe "S" (getOptVal opts gStartCat) ++ "{}.s" + cat = prCFCat (firstCatOpts opts s) ++ "{}.s" number = optIntOrN opts flagNumber 1 optLinearizeTreeVal :: Options -> GFGrammar -> Tree -> String @@ -327,7 +327,9 @@ prMultiGrammar opts = M.showMGrammar (oElem optimizeCanon opts) -- access to customizable commands optPrintGrammar :: Options -> StateGrammar -> String -optPrintGrammar opts = customOrDefault opts grammarPrinter customGrammarPrinter +optPrintGrammar opts = pg opts + where + pg = customOrDefault opts grammarPrinter customGrammarPrinter optPrintMultiGrammar :: Options -> CanonGrammar -> String optPrintMultiGrammar opts = encodeId . pmg opts . encode diff --git a/src/GF/Shell/HelpFile.hs b/src/GF/Shell/HelpFile.hs index 57692b493..8d7b72c08 100644 --- a/src/GF/Shell/HelpFile.hs +++ b/src/GF/Shell/HelpFile.hs @@ -133,6 +133,8 @@ txtHelpFile = "\n flags: " ++ "\n -printer" ++ "\n -lang" ++ + "\n -startcat -- The start category of the generated grammar." ++ + "\n Only supported by some grammar printers." ++ "\n examples:" ++ "\n pg -printer=cf -- show the context-free skeleton" ++ "\n" ++ diff --git a/src/GF/Shell/ShellCommands.hs b/src/GF/Shell/ShellCommands.hs index b93335416..2740101a7 100644 --- a/src/GF/Shell/ShellCommands.hs +++ b/src/GF/Shell/ShellCommands.hs @@ -212,7 +212,7 @@ optionsOfCommand co = case co of CSystemCommand _ -> none CGrep _ -> opts "v" - CPrintGrammar -> both "utf8" "printer lang" + CPrintGrammar -> both "utf8" "printer lang startcat" CPrintMultiGrammar -> both "utf8 utf8id" "printer" CPrintSourceGrammar -> both "utf8" "printer" diff --git a/src/GF/System/ATKSpeechInput.hs b/src/GF/System/ATKSpeechInput.hs index 2b46915f5..2e9e5c0a1 100644 --- a/src/GF/System/ATKSpeechInput.hs +++ b/src/GF/System/ATKSpeechInput.hs @@ -110,7 +110,6 @@ recognizeSpeech :: Ident -- ^ Grammar name -> IO [String] recognizeSpeech name language cfg start number = do - -- FIXME: use cat let slf = slfPrinter name start cfg n = prIdent name hmmName = "hmm_" ++ language @@ -119,10 +118,10 @@ recognizeSpeech name language cfg start number = recName = "rec_" ++ language ++ "_" ++ n writeFile "debug.net" slf initATK language - hPutStrLn stderr "Loading grammar..." + hPutStrLn stderr $ "Loading grammar " ++ n ++ " ..." loadGrammarString slfName slf createRecognizer recName hmmName dictName slfName - hPutStrLn stderr "Listening..." + hPutStrLn stderr $ "Listening in category " ++ start ++ "..." s <- replicateM number (recognize recName) return s diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs index efaa1abeb..69d6d7df1 100644 --- a/src/GF/UseGrammar/Custom.hs +++ b/src/GF/UseGrammar/Custom.hs @@ -141,7 +141,7 @@ import GF.Text.ExtraDiacritics (mkExtraDiacritics) customGrammarParser :: CustomData (FilePath -> IOE C.CanonGrammar) -- | grammarPrinter, \"-printer=x\" -customGrammarPrinter :: CustomData (StateGrammar -> String) +customGrammarPrinter :: CustomData (Options -> StateGrammar -> String) -- | multiGrammarPrinter, \"-printer=x\" customMultiGrammarPrinter :: CustomData (Options -> CanonGrammar -> String) @@ -238,67 +238,58 @@ customGrammarParser = customGrammarPrinter = customData "Grammar printers, selected by option -printer=x" $ [ - (strCI "gfc", prCanon . stateGrammarST) -- DEFAULT - ,(strCI "gf", err id prGrammar . canon2sourceGrammar . stateGrammarST) - ,(strCI "cf", prCF . stateCF) - ,(strCI "old", printGrammarOld . stateGrammarST) - ,(strCI "srg", prSRG . stateCF) - ,(strCI "gsl", \s -> let opts = stateOptions s - name = cncId s - in gslPrinter name opts Nothing $ stateCFG s) - ,(strCI "jsgf", \s -> let opts = stateOptions s - name = cncId s - in jsgfPrinter name opts Nothing $ stateCFG s) - ,(strCI "srgs_xml", \s -> let opts = stateOptions s - name = cncId s - in srgsXmlPrinter name opts False Nothing $ stateCFG s) - ,(strCI "srgs_xml_prob", \s -> let opts = stateOptions s - name = cncId s - probs = stateProbs s - in srgsXmlPrinter name opts False (Just probs) $ stateCFG s) - ,(strCI "srgs_xml_ms_sem", \s -> let opts = stateOptions s - name = cncId s - in srgsXmlPrinter name opts True Nothing $ stateCFG s) - ,(strCI "vxml", grammar2vxml . stateGrammarST) - ,(strCI "slf", \s -> let opts = stateOptions s - start = getStartCat opts - name = cncId s - in slfPrinter name start $ stateCFG s) - ,(strCI "slf_graphviz", \s -> let opts = stateOptions s - start = getStartCat opts + (strCI "gfc", \_ -> prCanon . stateGrammarST) -- DEFAULT + ,(strCI "gf", \_ -> err id prGrammar . canon2sourceGrammar . stateGrammarST) + ,(strCI "cf", \_ -> prCF . stateCF) + ,(strCI "old", \_ -> printGrammarOld . stateGrammarST) + ,(strCI "srg", \_ -> prSRG . stateCF) + ,(strCI "gsl", \opts s -> let name = cncId s + in gslPrinter name opts Nothing $ stateCFG s) + ,(strCI "jsgf", \opts s -> let name = cncId s + in jsgfPrinter name opts Nothing $ stateCFG s) + ,(strCI "srgs_xml", \opts s -> let name = cncId s + in srgsXmlPrinter name 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) + ,(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 + name = cncId s + in slfPrinter name start $ stateCFG s) + ,(strCI "slf_graphviz", \opts s -> let start = getStartCat opts + name = cncId s + in slfGraphvizPrinter name start $ stateCFG s) + ,(strCI "slf_sub", \opts s -> let start = getStartCat opts name = cncId s - in slfGraphvizPrinter name start $ stateCFG s) - ,(strCI "slf_sub", \s -> let opts = stateOptions s - start = getStartCat opts - name = cncId s - in slfSubPrinter name start $ stateCFG s) - ,(strCI "slf_sub_graphviz", \s -> let opts = stateOptions s - start = getStartCat opts + in slfSubPrinter name start $ stateCFG s) + ,(strCI "slf_sub_graphviz", \opts s -> let start = getStartCat opts + name = cncId s + in slfSubGraphvizPrinter name start $ stateCFG s) + ,(strCI "fa_graphviz", \opts s -> let start = getStartCat opts name = cncId s - in slfSubGraphvizPrinter name start $ stateCFG s) - ,(strCI "fa_graphviz", \s -> let opts = stateOptions s - start = getStartCat opts - name = cncId s - in faGraphvizPrinter name start $ stateCFG s) - ,(strCI "fa_c", \s -> let opts = stateOptions s - start = getStartCat opts - name = cncId s - in faCPrinter name start $ stateCFG s) - ,(strCI "regular", regularPrinter . stateCFG) - ,(strCI "plbnf", prLBNF True) - ,(strCI "lbnf", prLBNF False) - ,(strCI "bnf", prBNF False) - ,(strCI "haskell", grammar2haskell . stateGrammarST) - ,(strCI "transfer", grammar2transfer . stateGrammarST) - ,(strCI "morpho", prMorpho . stateMorpho) - ,(strCI "fullform",prFullForm . stateMorpho) - ,(strCI "opts", prOpts . stateOptions) - ,(strCI "words", unwords . stateGrammarWords) - ,(strCI "printnames", C.prPrintnamesGrammar . stateGrammarST) - ,(strCI "stat", prStatistics . stateGrammarST) - ,(strCI "probs", prProbs . stateProbs) - ,(strCI "unpar", prCanon . unparametrizeCanon . stateGrammarST) - ,(strCI "subs", prSubtermStat . stateGrammarST) + in faGraphvizPrinter name start $ stateCFG s) + ,(strCI "fa_c", \opts s -> let start = getStartCat opts + name = cncId s + in faCPrinter name start $ stateCFG s) + ,(strCI "regular", \_ -> regularPrinter . stateCFG) + ,(strCI "plbnf", \_ -> prLBNF True) + ,(strCI "lbnf", \_ -> prLBNF False) + ,(strCI "bnf", \_ -> prBNF False) + ,(strCI "haskell", \_ -> grammar2haskell . stateGrammarST) + ,(strCI "transfer", \_ -> grammar2transfer . stateGrammarST) + ,(strCI "morpho", \_ -> prMorpho . stateMorpho) + ,(strCI "fullform",\_ -> prFullForm . stateMorpho) + ,(strCI "opts", \_ -> prOpts . stateOptions) + ,(strCI "words", \_ -> unwords . stateGrammarWords) + ,(strCI "printnames", \_ -> C.prPrintnamesGrammar . stateGrammarST) + ,(strCI "stat", \_ -> prStatistics . stateGrammarST) + ,(strCI "probs", \_ -> prProbs . stateProbs) + ,(strCI "unpar", \_ -> prCanon . unparametrizeCanon . stateGrammarST) + ,(strCI "subs", \_ -> prSubtermStat . stateGrammarST) {- ---- (strCI "gf", prt . st2grammar . stateGrammarST) -- DEFAULT @@ -310,26 +301,26 @@ customGrammarPrinter = -- add your own grammar printers here -- grammar conversions: - ,(strCI "mcfg", Prt.prt . stateMCFG) - ,(strCI "cfg", Prt.prt . stateCFG) - ,(strCI "pinfo", Prt.prt . statePInfo) - ,(strCI "abstract", Prt.prtAfter "\n" . Cnv.gfc2abstract . stateGrammarLang) + ,(strCI "mcfg", \_ -> Prt.prt . stateMCFG) + ,(strCI "cfg", \_ -> Prt.prt . stateCFG) + ,(strCI "pinfo", \_ -> Prt.prt . statePInfo) + ,(strCI "abstract", \_ -> Prt.prtAfter "\n" . Cnv.gfc2abstract . stateGrammarLang) - ,(strCI "functiongraph",CnvTypeGraph.prtFunctionGraph . Cnv.gfc2simple noOptions . stateGrammarLang) - ,(strCI "typegraph", CnvTypeGraph.prtTypeGraph . Cnv.gfc2simple noOptions . stateGrammarLang) + ,(strCI "functiongraph",\_ -> CnvTypeGraph.prtFunctionGraph . Cnv.gfc2simple noOptions . stateGrammarLang) + ,(strCI "typegraph", \_ -> CnvTypeGraph.prtTypeGraph . Cnv.gfc2simple noOptions . stateGrammarLang) - ,(strCI "gfc-haskell", CnvHaskell.prtSGrammar . uncurry Cnv.gfc2simple . stateGrammarLangOpts) - ,(strCI "mcfg-haskell", CnvHaskell.prtMGrammar . stateMCFG) - ,(strCI "cfg-haskell", CnvHaskell.prtCGrammar . stateCFG) - ,(strCI "gfc-prolog", CnvProlog.prtSGrammar . uncurry Cnv.gfc2simple . stateGrammarLangOpts) - ,(strCI "mcfg-prolog", CnvProlog.prtMGrammar . stateMCFG) - ,(strCI "cfg-prolog", CnvProlog.prtCGrammar . stateCFG) + ,(strCI "gfc-haskell", \_ -> CnvHaskell.prtSGrammar . uncurry Cnv.gfc2simple . stateGrammarLangOpts) + ,(strCI "mcfg-haskell", \_ -> CnvHaskell.prtMGrammar . stateMCFG) + ,(strCI "cfg-haskell", \_ -> CnvHaskell.prtCGrammar . stateCFG) + ,(strCI "gfc-prolog", \_ -> CnvProlog.prtSGrammar . uncurry Cnv.gfc2simple . stateGrammarLangOpts) + ,(strCI "mcfg-prolog", \_ -> CnvProlog.prtMGrammar . stateMCFG) + ,(strCI "cfg-prolog", \_ -> CnvProlog.prtCGrammar . stateCFG) -- obsolete, or only for testing: - ,(strCI "abs-skvatt", Cnv.abstract2skvatt . Cnv.gfc2abstract . stateGrammarLang) - ,(strCI "cfg-skvatt", Cnv.cfg2skvatt . stateCFG) - ,(strCI "simple", Prt.prt . uncurry Cnv.gfc2simple . stateGrammarLangOpts) - ,(strCI "mcfg-erasing", Prt.prt . fst . snd . uncurry Cnv.convertGFC . stateGrammarLangOpts) + ,(strCI "abs-skvatt", \_ -> Cnv.abstract2skvatt . Cnv.gfc2abstract . stateGrammarLang) + ,(strCI "cfg-skvatt", \_ -> Cnv.cfg2skvatt . stateCFG) + ,(strCI "simple", \_ -> Prt.prt . uncurry Cnv.gfc2simple . stateGrammarLangOpts) + ,(strCI "mcfg-erasing", \_ -> Prt.prt . fst . snd . uncurry Cnv.convertGFC . stateGrammarLangOpts) -- ,(strCI "mcfg-old", PrtOld.prt . CnvOld.mcfg . statePInfoOld) -- ,(strCI "cfg-old", PrtOld.prt . CnvOld.cfg . statePInfoOld) ] diff --git a/src/HelpFile b/src/HelpFile index 97ce04186..634b0ee45 100644 --- a/src/HelpFile +++ b/src/HelpFile @@ -104,6 +104,8 @@ pg, print_grammar: pg flags: -printer -lang + -startcat -- The start category of the generated grammar. + Only supported by some grammar printers. examples: pg -printer=cf -- show the context-free skeleton