reorganize the directories under src, and rescue the JavaScript interpreter from deprecated

src/compiler/GF/Speech/SRGS_XML.hs

@@ -0,0 +1,105 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : GF.Speech.SRGS_XML
+--
+-- Prints an SRGS XML speech recognition grammars.
+----------------------------------------------------------------------
+module GF.Speech.SRGS_XML (srgsXmlPrinter, srgsXmlNonRecursivePrinter) where
+
+import GF.Data.Utilities
+import GF.Data.XML
+import GF.Infra.Option
+import GF.Speech.CFG
+import GF.Speech.RegExp
+import GF.Speech.SISR as SISR
+import GF.Speech.SRG
+import PGF (PGF, CId)
+
+import Control.Monad
+import Data.Char (toUpper,toLower)
+import Data.List
+import Data.Maybe
+import qualified Data.Map as Map
+
+srgsXmlPrinter :: Options
+               -> PGF -> CId -> String
+srgsXmlPrinter opts pgf cnc = prSrgsXml sisr $ makeNonLeftRecursiveSRG opts pgf cnc
+    where sisr = flag optSISR opts
+
+srgsXmlNonRecursivePrinter :: Options -> PGF -> CId -> String
+srgsXmlNonRecursivePrinter opts pgf cnc = prSrgsXml Nothing $ makeNonRecursiveSRG opts pgf cnc
+
+
+prSrgsXml :: Maybe SISRFormat -> SRG -> String
+prSrgsXml sisr srg = showXMLDoc (optimizeSRGS xmlGr)
+    where
+    xmlGr = grammar sisr (srgStartCat srg) (srgLanguage srg) $
+              [meta "description" 
+                 ("SRGS XML speech recognition grammar for " ++ srgName srg ++ "."),
+               meta "generator" "Grammatical Framework"]
+	    ++ map ruleToXML (srgRules srg)
+    ruleToXML (SRGRule cat alts) = Tag "rule" ([("id",cat)]++pub) (prRhs alts)
+        where pub = if isExternalCat srg cat then [("scope","public")] else []
+    prRhs rhss = [oneOf (map (mkProd sisr) rhss)] 
+
+mkProd :: Maybe SISRFormat -> SRGAlt -> XML
+mkProd sisr (SRGAlt mp n rhs) = Tag "item" [] (ti ++ [x] ++ tf)
+  where x = mkItem sisr n rhs
+        ti = tag sisr (profileInitSISR n)
+        tf = tag sisr (profileFinalSISR n)
+
+mkItem :: Maybe SISRFormat -> CFTerm -> SRGItem -> XML
+mkItem sisr cn = f
+  where 
+    f (REUnion [])  = ETag "ruleref" [("special","VOID")]
+    f (REUnion xs) 
+        | not (null es) = Tag "item" [("repeat","0-1")] [f (REUnion nes)]
+        | otherwise = oneOf (map f xs)
+      where (es,nes) = partition isEpsilon xs
+    f (REConcat []) = ETag "ruleref" [("special","NULL")]
+    f (REConcat xs) = Tag "item" [] (map f xs)
+    f (RERepeat x)  = Tag "item" [("repeat","0-")] [f x]
+    f (RESymbol s)  = symItem sisr cn s
+
+symItem :: Maybe SISRFormat -> CFTerm -> Symbol SRGNT Token -> XML
+symItem sisr cn (NonTerminal n@(c,_)) = 
+    Tag "item" [] $ [ETag "ruleref" [("uri","#" ++ c)]] ++ tag sisr (catSISR cn n)
+symItem _ _ (Terminal t) = Tag "item" [] [Data (showToken t)]
+
+tag :: Maybe SISRFormat -> (SISRFormat -> SISRTag) -> [XML]
+tag Nothing _ = []
+tag (Just fmt) t = case t fmt of
+                     [] -> []
+                     ts -> [Tag "tag" [] [Data (prSISR ts)]]
+
+showToken :: Token -> String
+showToken t = t
+
+oneOf :: [XML] -> XML
+oneOf = Tag "one-of" []
+
+grammar :: Maybe SISRFormat
+        -> String  -- ^ root
+        -> Maybe String -- ^language
+	-> [XML] -> XML
+grammar sisr root ml = 
+    Tag "grammar" $ [("xmlns","http://www.w3.org/2001/06/grammar"),
+		     ("version","1.0"),
+		     ("mode","voice"),
+		     ("root",root)]
+                 ++ (if isJust sisr then [("tag-format","semantics/1.0")] else [])
+                 ++ maybe [] (\l -> [("xml:lang", l)]) ml
+
+meta :: String -> String -> XML
+meta n c = ETag "meta" [("name",n),("content",c)]
+
+optimizeSRGS :: XML -> XML
+optimizeSRGS = bottomUpXML f 
+  where f (Tag "item" [] [x@(Tag "item" _ _)]) = x
+        f (Tag "item" [] [x@(Tag "one-of" _ _)]) = x
+        f (Tag "item" as [Tag "item" [] xs]) = Tag "item" as xs
+        f (Tag "item" as xs) = Tag "item" as (map g xs)
+           where g (Tag "item" [] [x@(ETag "ruleref" _)]) = x
+                 g x = x
+        f (Tag "one-of" [] [x]) = x
+        f x = x