Get JSGF generation to compile. Still untested.

3 files changed, 26 insertions, 53 deletions

diff --git a/src-3.0/GF/Compile/Export.hs b/src-3.0/GF/Compile/Export.hs
index 22b248159..d5f9e33ae 100644
--- a/src-3.0/GF/Compile/Export.hs
+++ b/src-3.0/GF/Compile/Export.hs
@@ -10,6 +10,7 @@ import GF.Infra.Option
 import GF.Speech.CFG
 import GF.Speech.PGFToCFG
 import GF.Speech.SRGS_XML
+import GF.Speech.JSGF
 import GF.Speech.VoiceXML
 import GF.Text.UTF8
 
@@ -27,9 +28,11 @@ prPGF fmt gr name = case fmt of
   FmtHaskell_GADT -> grammar2haskellGADT gr name
   FmtBNF          -> prCFG $ pgfToCFG gr (outputConcr gr)
   FmtSRGS_XML     -> srgsXmlPrinter Nothing gr (outputConcr gr)
+  FmtJSGF         -> jsgfPrinter Nothing gr (outputConcr gr)
   FmtVoiceXML     -> grammar2vxml 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
diff --git a/src-3.0/GF/Speech/PrJSGF.hs b/src-3.0/GF/Speech/JSGF.hs
index 037a4f4e2..53a40ffd4 100644
--- a/src-3.0/GF/Speech/PrJSGF.hs
+++ b/src-3.0/GF/Speech/JSGF.hs
@@ -1,13 +1,6 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : PrJSGF
--- Maintainer  : BB
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/11/01 20:09:04 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.16 $
+-- Module      : GF.Speech.JSGF
 --
 -- This module prints a CFG as a JSGF grammar.
 --
@@ -17,20 +10,15 @@
 -- FIXME: convert to UTF-8
 -----------------------------------------------------------------------------
 
-module GF.Speech.PrJSGF (jsgfPrinter) where
+module GF.Speech.JSGF (jsgfPrinter) 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.CFG
+import GF.Speech.RegExp
 import GF.Speech.SISR
 import GF.Speech.SRG
-import GF.Speech.RegExp
-import GF.Compile.ShellState (StateGrammar)
+import PGF.CId
+import PGF.Data
 
 import Data.Char
 import Data.List
@@ -42,45 +30,33 @@ width :: Int
 width = 75
 
 jsgfPrinter :: Maybe SISRFormat
-	    -> Options 
-            -> StateGrammar -> String
-jsgfPrinter sisr opts s = renderStyle st $ prJSGF sisr $ makeSimpleSRG opts s
+	    -> PGF 
+            -> CId -> String
+jsgfPrinter sisr pgf cnc = renderStyle st $ prJSGF sisr $ makeSimpleSRG pgf cnc
   where st = style { lineLength = width }
 
 prJSGF :: Maybe SISRFormat -> SRG -> Doc
-prJSGF sisr srg@(SRG{grammarName=name,grammarLanguage=ml,
-                     startCat=start,origStartCat=origStart,rules=rs})
-    = header $++$ mainCat $++$ vcat topCatRules $++$ foldr ($++$) empty (map prRule rs)
+prJSGF sisr srg
+    = header $++$ mainCat $++$ foldr ($++$) empty (map prRule (srgRules srg))
     where
     header = text "#JSGF" <+> text "V1.0" <+> text "UTF-8" <+> lang <> char ';' $$
-             comment ("JSGF speech recognition grammar for " ++ name) $$
+             comment ("JSGF speech recognition grammar for " ++ srgName srg) $$
              comment "Generated by GF" $$
-	     text ("grammar " ++ name ++ ";") 
-    lang = maybe empty text ml
-    mainCat = comment ("Start category: " ++ origStart) $$
-              case cfgCatToGFCat origStart of
-                Just c  -> rule True "MAIN" [prCat (catFormId c)]
-                Nothing -> empty
-    prRule (SRGRule cat origCat rhs) = 
-	comment origCat $$
-        rule False cat (map prAlt rhs)
---        rule False cat (map prAlt rhs)
-    -- FIXME: use the probability
+	     text ("grammar " ++ srgName srg ++ ";") 
+    lang = maybe empty text (srgLanguage srg)
+    mainCat = rule True "MAIN" [prCat (srgStartCat srg)]
+    prRule (SRGRule cat rhs) = rule (isExternalCat srg cat) cat (map prAlt rhs)
     prAlt (SRGAlt mp n rhs) = sep [initTag, p (prItem sisr n rhs), finalTag]
---    prAlt (SRGAlt mp n rhs) = initTag <+> prItem sisr n rhs <+> finalTag
       where initTag | isEmpty t = empty
                     | otherwise = text "<NULL>" <+>  t
                 where t = 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 <> char '>'
 
 prItem :: Maybe SISRFormat -> CFTerm -> SRGItem -> Doc
@@ -96,17 +72,10 @@ prItem sisr t = f 0
     f p (RERepeat x)  = f 3 x <> char '*'
     f _ (RESymbol s)  = prSymbol sisr t s
 
-{-
-prItem :: Maybe SISRFormat -> CFTerm -> [Symbol SRGNT Token] -> Doc
-prItem _ _ [] = text "<NULL>"
-prItem sisr cn ss = paren $ hsep $ map (prSymbol sisr cn) ss
-  where paren = if length ss == 1 then id else parens
--}
-
-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
@@ -127,7 +96,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
 
diff --git a/src-3.0/GFC.hs b/src-3.0/GFC.hs
index f8ae6e8e3..73fb6f9f9 100644
--- a/src-3.0/GFC.hs
+++ b/src-3.0/GFC.hs
@@ -47,6 +47,7 @@ fmtExtension FmtHaskell      = "hs"
 fmtExtension FmtHaskell_GADT = "hs"
 fmtExtension FmtBNF          = "bnf"
 fmtExtension FmtSRGS_XML     = "grxml"
+fmtExtension FmtJSGF         = "jsgf"
 fmtExtension FmtVoiceXML     = "vxml"
 
 writeOutputFile :: FilePath -> String -> IOE ()