diff --git a/src/GF/Compile/Export.hs b/src/GF/Compile/Export.hs index 2aac9ad13..739079c9c 100644 --- a/src/GF/Compile/Export.hs +++ b/src/GF/Compile/Export.hs @@ -10,6 +10,7 @@ import GF.Compile.GFCCtoJS import GF.Infra.Option import GF.Speech.CFG import GF.Speech.PGFToCFG +import GF.Speech.SRGS_ABNF import GF.Speech.SRGS_XML import GF.Speech.JSGF import GF.Speech.GSL @@ -38,6 +39,8 @@ exportPGF opts fmt pgf = FmtBNF -> single "bnf" bnfPrinter FmtSRGS_XML -> single "grxml" (srgsXmlPrinter sisr) FmtSRGS_XML_NonRec -> single "grxml" srgsXmlNonRecursivePrinter + FmtSRGS_ABNF -> single "gram" (srgsAbnfPrinter sisr) + FmtSRGS_ABNF_NonRec -> single "gram" srgsXmlNonRecursivePrinter FmtJSGF -> single "jsgf" (jsgfPrinter sisr) FmtGSL -> single "gsl" gslPrinter FmtVoiceXML -> single "vxml" grammar2vxml diff --git a/src/GF/Speech/SRG.hs b/src/GF/Speech/SRG.hs index a861d889d..f9065dae9 100644 --- a/src/GF/Speech/SRG.hs +++ b/src/GF/Speech/SRG.hs @@ -50,8 +50,7 @@ data SRG = SRG { srgName :: String -- ^ grammar name } deriving (Eq,Show) -data SRGRule = SRGRule Cat [SRGAlt] -- ^ SRG category name, original category name - -- and productions +data SRGRule = SRGRule Cat [SRGAlt] deriving (Eq,Show) -- | maybe a probability, a rule name and an EBNF right-hand side diff --git a/src/GF/Speech/SRGS_ABNF.hs b/src/GF/Speech/SRGS_ABNF.hs index abb84c5dc..28f4b5684 100644 --- a/src/GF/Speech/SRGS_ABNF.hs +++ b/src/GF/Speech/SRGS_ABNF.hs @@ -17,21 +17,15 @@ -- FIXME: convert to UTF-8 ----------------------------------------------------------------------------- -module GF.Speech.PrSRGS_ABNF (srgsAbnfPrinter, srgsAbnfNonRecursivePrinter) where +module GF.Speech.SRGS_ABNF (srgsAbnfPrinter, srgsAbnfNonRecursivePrinter) where -import GF.Conversion.Types import GF.Data.Utilities -import GF.Formalism.CFG -import GF.Formalism.Utilities (Symbol(..), NameProfile(..), Profile(..), filterCats) -import GF.Infra.Ident -import GF.Infra.Print import GF.Infra.Option -import GF.Probabilistic.Probabilistic (Probs) -import GF.Speech.SISR +import GF.Speech.CFG +import GF.Speech.SISR as SISR import GF.Speech.SRG import GF.Speech.RegExp -import GF.Compile.ShellState (StateGrammar) -import GF.Today +import PGF (PGF, CId) import Data.Char import Data.List @@ -43,49 +37,33 @@ width :: Int width = 75 srgsAbnfPrinter :: Maybe SISRFormat - -> Bool -- ^ Include probabilities - -> Options - -> StateGrammar -> String -srgsAbnfPrinter sisr probs opts s = showDoc $ prABNF sisr probs $ makeSimpleSRG opts s + -> PGF -> CId -> String +srgsAbnfPrinter sisr pgf cnc = showDoc $ prABNF sisr $ makeSimpleSRG pgf cnc -srgsAbnfNonRecursivePrinter :: Options -> StateGrammar -> String -srgsAbnfNonRecursivePrinter opts s = showDoc $ prABNF Nothing False $ makeNonRecursiveSRG opts s +srgsAbnfNonRecursivePrinter :: PGF -> CId -> String +srgsAbnfNonRecursivePrinter pgf cnc = showDoc $ prABNF Nothing $ makeNonRecursiveSRG pgf cnc showDoc = renderStyle (style { lineLength = width }) -prABNF :: Maybe SISRFormat -> Bool -> SRG -> Doc -prABNF sisr probs srg@(SRG{grammarName=name,grammarLanguage=ml, - startCat=start,origStartCat=origStart,rules=rs}) - = header $++$ vcat topCatRules $++$ foldr ($++$) empty (map prRule rs) +prABNF :: Maybe SISRFormat -> SRG -> Doc +prABNF sisr srg + = header $++$ foldr ($++$) empty (map prRule (srgRules srg)) where header = text "#ABNF 1.0 UTF-8;" $$ - meta "description" - ("Speech recognition grammar for " ++ name - ++ ". " ++ "Original start category: " ++ origStart) $$ - meta "generator" ("Grammatical Framework " ++ version) $$ + meta "description" ("Speech recognition grammar for " ++ srgName srg) $$ + meta "generator" "Grammatical Framework" $$ language $$ tagFormat $$ mainCat - language = maybe empty (\l -> text "language" <+> text l <> char ';') ml + language = maybe empty (\l -> text "language" <+> text l <> char ';') (srgLanguage srg) tagFormat | isJust sisr = text "tag-format" <+> text "" <> char ';' | otherwise = empty - mainCat = case cfgCatToGFCat origStart of - Just c -> text "root" <+> prCat (catFormId c) <> char ';' - Nothing -> empty - prRule (SRGRule cat origCat rhs) = - comment origCat $$ - rule False cat (map prAlt rhs) - -- FIXME: use the probability + mainCat = text "root" <+> prCat (srgStartCat srg) <> char ';' + prRule (SRGRule cat alts) = rule (isExternalCat srg cat) cat (map prAlt alts) prAlt (SRGAlt mp n rhs) = sep [initTag, p (prItem sisr n rhs), finalTag] where initTag = tag sisr (profileInitSISR n) finalTag = tag sisr (profileFinalSISR n) p = if isEmpty initTag && isEmpty finalTag then id else parens - topCatRules = [rule True (catFormId tc) (map (it tc) cs) | (tc,cs) <- srgTopCats srg] - where it i c = prCat c <+> tag sisr (topCatSISR c) - -catFormId :: String -> String -catFormId = (++ "_cat") - -prCat :: SRGCat -> Doc +prCat :: Cat -> Doc prCat c = char '$' <> text c prItem :: Maybe SISRFormat -> CFTerm -> SRGItem -> Doc @@ -102,10 +80,11 @@ prItem sisr t = f 0 f _ (RESymbol s) = prSymbol sisr t s -prSymbol :: Maybe SISRFormat -> CFTerm -> Symbol SRGNT Token -> Doc -prSymbol sisr cn (Cat n@(c,_)) = prCat c <+> tag sisr (catSISR cn n) -prSymbol _ cn (Tok t) | all isPunct (prt t) = empty -- removes punctuation - | otherwise = text (prt t) -- FIXME: quote if there is whitespace or odd chars +prSymbol :: Maybe SISRFormat -> CFTerm -> SRGSymbol -> Doc +prSymbol sisr cn (NonTerminal n@(c,_)) = prCat c <+> tag sisr (catSISR cn n) +prSymbol _ cn (Terminal t) + | all isPunct t = empty -- removes punctuation + | otherwise = text t -- FIXME: quote if there is whitespace or odd chars tag :: Maybe SISRFormat -> (SISRFormat -> SISRTag) -> Doc tag Nothing _ = empty @@ -126,7 +105,7 @@ comment s = text "//" <+> text s alts :: [Doc] -> Doc alts = fsep . prepunctuate (text "| ") -rule :: Bool -> SRGCat -> [Doc] -> Doc +rule :: Bool -> Cat -> [Doc] -> Doc rule pub c xs = p <+> prCat c <+> char '=' <+> nest 2 (alts xs) <+> char ';' where p = if pub then text "public" else empty