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
import PGF.Data (PGF)
import PGF.CId
import PGF.Data (PGF(..))
import PGF.Raw.Print (printTree)
import PGF.Raw.Convert (fromPGF)
import GF.Compile.GFCCtoHaskell
import GF.Compile.GFCCtoJS
import GF.Infra.Option
import GF.Speech.SRGS
import GF.Text.UTF8
-- top-level access to code generation
@@ -16,10 +18,18 @@ prPGF :: OutputFormat
-- module name.
-> String
prPGF fmt gr name = case fmt of
FmtPGF -> printPGF gr
FmtJavaScript -> pgf2js gr
FmtHaskell -> grammar2haskell gr name
FmtHaskellGADT -> grammar2haskellGADT gr name
FmtPGF -> printPGF gr
FmtJavaScript -> pgf2js gr
FmtHaskell -> grammar2haskell 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 = encodeUTF8 . printTree . fromPGF

View File

@@ -78,7 +78,18 @@ data Phase = Preproc | Convert | Compile | Link
data Encoding = UTF_8 | ISO_8859_1
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)
data Optimization = OptStem | OptCSE | OptExpand | OptParametrize | OptValues
@@ -406,7 +417,16 @@ outputFormats =
[("pgf", FmtPGF),
("js", FmtJavaScript),
("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
show = lookupShow outputFormats

View File

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