From 278a0ab45d02e85ba6d863615abaaf24bba5317b Mon Sep 17 00:00:00 2001
From: aarne <aarne@cs.chalmers.se>
Date: Thu, 10 May 2007 12:51:40 +0000
Subject: [PATCH] printing abs as BNF

---
 src/GF/Canon/AbsToBNF.hs    | 32 ++++++++++++++++++++++++++++++++
 src/GF/UseGrammar/Custom.hs |  2 ++
 2 files changed, 34 insertions(+)
 create mode 100644 src/GF/Canon/AbsToBNF.hs

diff --git a/src/GF/Canon/AbsToBNF.hs b/src/GF/Canon/AbsToBNF.hs
new file mode 100644
index 000000000..71845971c
--- /dev/null
+++ b/src/GF/Canon/AbsToBNF.hs
@@ -0,0 +1,32 @@
+module GF.Canon.AbsToBNF where
+
+import GF.Grammar.SGrammar
+import GF.Data.Operations
+import GF.Infra.Option
+import GF.Canon.GFC (CanonGrammar)
+
+abstract2bnf :: CanonGrammar -> String
+abstract2bnf = sgrammar2bnf . gr2sgr noOptions emptyProbs
+
+sgrammar2bnf :: SGrammar -> String
+sgrammar2bnf = unlines . map (prBNFRule . mkBNF) . allRules
+
+prBNFRule :: BNFRule -> String
+prBNFRule = id
+
+type BNFRule = String
+
+mkBNF :: SRule -> BNFRule
+mkBNF (pfun,(args,cat)) = 
+  fun ++ "." +++ gfId cat +++ "::=" +++ rhs +++ ";"
+ where
+   fun = gfId (snd pfun)
+   rhs = case args of
+     [] -> prQuotedString (snd pfun)
+     _ -> unwords (map gfId args)
+
+gfId i = case i of
+  "Int"    -> "Integer"
+  "String" -> i 
+  "Float"  -> "Double"
+  _   -> "G" ++ i ++ "_"
diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs
index 32b7cffa0..bbfb1e09e 100644
--- a/src/GF/UseGrammar/Custom.hs
+++ b/src/GF/UseGrammar/Custom.hs
@@ -96,6 +96,7 @@ import qualified GF.Conversion.Prolog as CnvProlog
 import qualified GF.Conversion.TypeGraph as CnvTypeGraph
 import GF.Canon.Unparametrize
 import GF.Canon.Subexpressions
+import GF.Canon.AbsToBNF
 
 import GF.Canon.GFC
 import qualified GF.Canon.MkGFC as MC
@@ -267,6 +268,7 @@ customGrammarPrinter =
   ,(strCI "plbnf",   \_ -> prLBNF True)
   ,(strCI "lbnf",    \_ -> prLBNF False)
   ,(strCI "bnf",     \_ -> prBNF False)
+  ,(strCI "absbnf",  \_ -> abstract2bnf . stateGrammarST)
   ,(strCI "haskell", \_ -> grammar2haskell . stateGrammarST)
   ,(strCI "transfer", \_ -> grammar2transfer . stateGrammarST)
   ,(strCI "morpho",  \_ -> prMorpho . stateMorpho)