Added options to support SRG printing.

This commit is contained in:
bjorn
2008-06-03 19:20:18 +00:00
parent 61ccd948d3
commit 2ee8ab8a71
3 changed files with 42 additions and 11 deletions

View File

@@ -1,11 +1,13 @@
module GF.Compile.Export where module GF.Compile.Export where
import PGF.Data (PGF) import PGF.CId
import PGF.Data (PGF(..))
import PGF.Raw.Print (printTree) import PGF.Raw.Print (printTree)
import PGF.Raw.Convert (fromPGF) import PGF.Raw.Convert (fromPGF)
import GF.Compile.GFCCtoHaskell import GF.Compile.GFCCtoHaskell
import GF.Compile.GFCCtoJS import GF.Compile.GFCCtoJS
import GF.Infra.Option import GF.Infra.Option
import GF.Speech.SRGS
import GF.Text.UTF8 import GF.Text.UTF8
-- top-level access to code generation -- top-level access to code generation
@@ -16,10 +18,18 @@ prPGF :: OutputFormat
-- module name. -- module name.
-> String -> String
prPGF fmt gr name = case fmt of prPGF fmt gr name = case fmt of
FmtPGF -> printPGF gr FmtPGF -> printPGF gr
FmtJavaScript -> pgf2js gr FmtJavaScript -> pgf2js gr
FmtHaskell -> grammar2haskell gr name FmtHaskell -> grammar2haskell gr name
FmtHaskellGADT -> grammar2haskellGADT gr name FmtHaskell_GADT -> grammar2haskellGADT gr name
FmtSRGS_XML -> srgsXmlPrinter Nothing gr (outputConcr gr)
-- | Get the name of the concrete syntax to generate output from.
-- FIXME: there should be an option to change this.
outputConcr :: PGF -> CId
outputConcr pgf = case cncnames pgf of
[] -> error "No concrete syntax."
cnc:_ -> cnc
printPGF :: PGF -> String printPGF :: PGF -> String
printPGF = encodeUTF8 . printTree . fromPGF printPGF = encodeUTF8 . printTree . fromPGF

View File

@@ -78,7 +78,18 @@ data Phase = Preproc | Convert | Compile | Link
data Encoding = UTF_8 | ISO_8859_1 data Encoding = UTF_8 | ISO_8859_1
deriving (Show,Eq,Ord) deriving (Show,Eq,Ord)
data OutputFormat = FmtPGF | FmtJavaScript | FmtHaskell | FmtHaskellGADT data OutputFormat = FmtPGF
| FmtJavaScript
| FmtHaskell
| FmtHaskell_GADT
| FmtSRGS_XML
| FmtSRGS_ABNF
| FmtJSGF
| FmtGSL
| FmtVoiceXML
| FmtSLF
| FmtRegExp
| FmtFA
deriving (Eq,Ord) deriving (Eq,Ord)
data Optimization = OptStem | OptCSE | OptExpand | OptParametrize | OptValues data Optimization = OptStem | OptCSE | OptExpand | OptParametrize | OptValues
@@ -406,7 +417,16 @@ outputFormats =
[("pgf", FmtPGF), [("pgf", FmtPGF),
("js", FmtJavaScript), ("js", FmtJavaScript),
("haskell", FmtHaskell), ("haskell", FmtHaskell),
("haskell_gadt", FmtHaskellGADT)] ("haskell_gadt", FmtHaskell_GADT),
("srgs", FmtSRGS_XML),
("srgs_xml", FmtSRGS_XML),
("srgs_abnf", FmtSRGS_ABNF),
("jsgf", FmtJSGF),
("gsl", FmtGSL),
("vxml", FmtVoiceXML),
("slf", FmtSLF),
("regexp", FmtRegExp),
("fa", FmtFA)]
instance Show OutputFormat where instance Show OutputFormat where
show = lookupShow outputFormats show = lookupShow outputFormats

View File

@@ -41,10 +41,11 @@ outputFilePath opts fmt name0 = addDir name <.> fmtExtension fmt
addDir = maybe id (</>) (flag optOutputDir opts) addDir = maybe id (</>) (flag optOutputDir opts)
fmtExtension :: OutputFormat -> String fmtExtension :: OutputFormat -> String
fmtExtension FmtPGF = "pgf" fmtExtension FmtPGF = "pgf"
fmtExtension FmtJavaScript = "js" fmtExtension FmtJavaScript = "js"
fmtExtension FmtHaskell = "hs" fmtExtension FmtHaskell = "hs"
fmtExtension FmtHaskellGADT = "hs" fmtExtension FmtHaskell_GADT = "hs"
fmtExtension FmtSRGS_XML = "grxml"
writeOutputFile :: FilePath -> String -> IOE () writeOutputFile :: FilePath -> String -> IOE ()
writeOutputFile outfile output = ioeIO $ writeOutputFile outfile output = ioeIO $