added srg; extended shallow

2 files changed, 50 insertions, 0 deletions

diff --git a/src/GF/CF/CFtoSRG.hs b/src/GF/CF/CFtoSRG.hs
new file mode 100644
index 000000000..c90a772d8
--- /dev/null
+++ b/src/GF/CF/CFtoSRG.hs
@@ -0,0 +1,48 @@
+{- 
+   **************************************************************
+    GF Module
+   
+    Description   : This module prints a CF as a SRG (Speech 
+                    Recognition Grammar).
+
+    Author        : Markus Forsberg (markus@cs.chalmers.se)
+
+    License       : GPL (GNU General Public License)
+
+    Created       : 21 January, 2001                           
+
+    Modified      : 16 April, 2004 by Aarne Ranta for GF 2
+   ************************************************************** 
+-}
+
+module CFtoSRG where
+
+import Operations
+import CF
+import CFIdent
+---import UseGrammar
+import PPrCF
+import List (intersperse)
+
+header :: String
+header = unlines ["#ABNF 1.0 ISO-8859-1;\n",
+		  "language en;",
+		  "mode voice;",
+		  "root $Main;",
+		  "meta \"author\" is \"Grammatical Framework\";\n"]
+
+prSRG :: CF -> String
+prSRG cf = (header ++) $ prSRGC (catsOfCF cf) cf
+
+prSRGC :: [CFCat] -> CF -> String
+prSRGC [] _      = []
+prSRGC (c:cs) cf =  "$" ++ prCFCat c ++ " = " ++ items ++ ";\n"++ prSRGC cs cf
+ where items    =   concat $ intersperse " | " $   
+		    map f $ map valItemsCF (rulesForCFCat cf c)
+       f [] = "$NULL"
+       f xs = unwords $ map prSRGItem xs
+
+prSRGItem :: CFItem -> [Char]
+prSRGItem (CFNonterm c) = "$" ++ prCFCat c
+prSRGItem (CFTerm a)    = prRegExp a
+
diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs
index bd1ed49e1..166f918ae 100644
--- a/src/GF/UseGrammar/Custom.hs
+++ b/src/GF/UseGrammar/Custom.hs
@@ -24,6 +24,7 @@ import PPrCF
 import PrLBNF
 import PrGrammar
 import MkGFC
+import CFtoSRG
 
 import Zipper
 
@@ -145,6 +146,7 @@ customGrammarPrinter =
   [
    (strCI "gfc",     prCanon . stateGrammarST) -- DEFAULT
   ,(strCI "cf",      prCF . stateCF)
+  ,(strCI "srg",     prSRG . stateCF)
   ,(strCI "lbnf",    prLBNF . stateCF)
   ,(strCI "morpho",  prMorpho . stateMorpho)
   ,(strCI "fullform",prFullForm . stateMorpho)