mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
Got GSL generation working.
This commit is contained in:
@@ -11,6 +11,7 @@ import GF.Speech.CFG
|
||||
import GF.Speech.PGFToCFG
|
||||
import GF.Speech.SRGS_XML
|
||||
import GF.Speech.JSGF
|
||||
import GF.Speech.GSL
|
||||
import GF.Speech.VoiceXML
|
||||
import GF.Text.UTF8
|
||||
|
||||
@@ -30,6 +31,7 @@ prPGF opts fmt gr name = case fmt of
|
||||
FmtBNF -> prCFG $ pgfToCFG gr (outputConcr gr)
|
||||
FmtSRGS_XML -> srgsXmlPrinter (flag optSISR opts) gr (outputConcr gr)
|
||||
FmtJSGF -> jsgfPrinter (flag optSISR opts) gr (outputConcr gr)
|
||||
FmtGSL -> gslPrinter gr (outputConcr gr)
|
||||
FmtVoiceXML -> grammar2vxml gr (outputConcr gr)
|
||||
|
||||
|
||||
|
||||
@@ -1,34 +1,20 @@
|
||||
----------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : PrGSL
|
||||
-- Maintainer : BB
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/11/01 20:09:04 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.22 $
|
||||
-- Module : GF.Speech.GSL
|
||||
--
|
||||
-- This module prints a CFG as a Nuance GSL 2.0 grammar.
|
||||
--
|
||||
-- FIXME: remove \/ warn \/ fail if there are int \/ string literal
|
||||
-- categories in the grammar
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module GF.Speech.PrGSL (gslPrinter) where
|
||||
module GF.Speech.GSL (gslPrinter) where
|
||||
|
||||
import GF.Data.Utilities
|
||||
import GF.Speech.CFG
|
||||
import GF.Speech.SRG
|
||||
import GF.Speech.RegExp
|
||||
import GF.Infra.Ident
|
||||
|
||||
import GF.Formalism.CFG
|
||||
import GF.Formalism.Utilities (Symbol(..))
|
||||
import GF.Conversion.Types
|
||||
import GF.Infra.Print
|
||||
import GF.Infra.Option
|
||||
import GF.Probabilistic.Probabilistic (Probs)
|
||||
import GF.Compile.ShellState (StateGrammar)
|
||||
import PGF.CId
|
||||
import PGF.Data
|
||||
|
||||
import Data.Char (toUpper,toLower)
|
||||
import Data.List (partition)
|
||||
@@ -37,22 +23,18 @@ import Text.PrettyPrint.HughesPJ
|
||||
width :: Int
|
||||
width = 75
|
||||
|
||||
gslPrinter :: Options -> StateGrammar -> String
|
||||
gslPrinter opts s = renderStyle st $ prGSL $ makeSimpleSRG opts s
|
||||
gslPrinter :: PGF -> CId -> String
|
||||
gslPrinter pgf cnc = renderStyle st $ prGSL $ makeSimpleSRG pgf cnc
|
||||
where st = style { lineLength = width }
|
||||
|
||||
prGSL :: SRG -> Doc
|
||||
prGSL (SRG{grammarName=name,startCat=start,origStartCat=origStart,rules=rs})
|
||||
= header $++$ mainCat $++$ foldr ($++$) empty (map prRule rs)
|
||||
prGSL srg = header $++$ mainCat $++$ foldr ($++$) empty (map prRule (srgRules srg))
|
||||
where
|
||||
header = text ";GSL2.0" $$
|
||||
comment ("Nuance speech recognition grammar for " ++ name) $$
|
||||
comment ("Nuance speech recognition grammar for " ++ srgName srg) $$
|
||||
comment ("Generated by GF")
|
||||
mainCat = comment ("Start category: " ++ origStart) $$
|
||||
text ".MAIN" <+> prCat start
|
||||
prRule (SRGRule cat origCat rhs) =
|
||||
comment (prt origCat) $$
|
||||
prCat cat <+> union (map prAlt rhs)
|
||||
mainCat = text ".MAIN" <+> prCat (srgStartCat srg)
|
||||
prRule (SRGRule cat rhs) = prCat cat <+> union (map prAlt rhs)
|
||||
-- FIXME: use the probability
|
||||
prAlt (SRGAlt mp _ rhs) = prItem rhs
|
||||
|
||||
@@ -72,12 +54,11 @@ union [x] = x
|
||||
union xs = text "[" <> fsep xs <> text "]"
|
||||
|
||||
prSymbol :: Symbol SRGNT Token -> Doc
|
||||
prSymbol (Cat (c,_)) = prCat c
|
||||
prSymbol (Tok t) = doubleQuotes (showToken t)
|
||||
prSymbol = symbol (prCat . fst) (doubleQuotes . showToken)
|
||||
|
||||
-- GSL requires an upper case letter in category names
|
||||
prCat :: SRGCat -> Doc
|
||||
prCat c = text (firstToUpper c)
|
||||
prCat :: Cat -> Doc
|
||||
prCat = text . firstToUpper
|
||||
|
||||
|
||||
firstToUpper :: String -> String
|
||||
@@ -95,7 +76,7 @@ keepSymbol _ = True
|
||||
|
||||
-- Nuance does not like upper case characters in tokens
|
||||
showToken :: Token -> Doc
|
||||
showToken t = text (map toLower (prt t))
|
||||
showToken = text . map toLower
|
||||
|
||||
isPunct :: Char -> Bool
|
||||
isPunct c = c `elem` "-_.:;.,?!()[]{}"
|
||||
@@ -48,6 +48,7 @@ fmtExtension FmtHaskell_GADT = "hs"
|
||||
fmtExtension FmtBNF = "bnf"
|
||||
fmtExtension FmtSRGS_XML = "grxml"
|
||||
fmtExtension FmtJSGF = "jsgf"
|
||||
fmtExtension FmtGSL = "gsl"
|
||||
fmtExtension FmtVoiceXML = "vxml"
|
||||
|
||||
writeOutputFile :: FilePath -> String -> IOE ()
|
||||
|
||||
Reference in New Issue
Block a user