From 65f012d15513814bd2cc4ad74f54edd35ade13fe Mon Sep 17 00:00:00 2001
From: bringert <unknown>
Date: Mon, 23 Aug 2004 07:51:36 +0000
Subject: Added CFGM format (pm -printer=cfgm) and utf8 conversion for pm.

---
 src/GF/CFGM/PrintCFGrammar.hs | 33 +++++++++++++++++++++++++++++++++
 1 file changed, 33 insertions(+)
 create mode 100644 src/GF/CFGM/PrintCFGrammar.hs

(limited to 'src/GF/CFGM/PrintCFGrammar.hs')

diff --git a/src/GF/CFGM/PrintCFGrammar.hs b/src/GF/CFGM/PrintCFGrammar.hs
new file mode 100644
index 000000000..f073893b1
--- /dev/null
+++ b/src/GF/CFGM/PrintCFGrammar.hs
@@ -0,0 +1,33 @@
+-- Handles printing a CFGrammar in CFGM format.
+module PrintCFGrammar (prCanonAsCFGM) where
+
+import AbsGFC
+import Ident
+import GFC
+import Modules
+import qualified ConvertGrammar as Cnv
+import qualified PrintParser as Prt
+
+import List (intersperse)
+import Maybe (listToMaybe, fromMaybe)
+
+-- FIXME: fix warning about bad -printer= value
+
+prCanonAsCFGM :: CanonGrammar -> String
+prCanonAsCFGM gr = unlines $ map (uncurry (prLangAsCFGM gr)) xs 
+    where 
+    xs = [(i,getFlag fs "startcat") | (i,ModMod (Module{mtype=MTConcrete _,flags=fs})) <- modules gr]
+
+-- FIXME: need to look in abstract module too
+getFlag :: [Flag] -> String -> Maybe String
+getFlag fs x = listToMaybe [v | Flg (IC k) (IC v) <- fs, k == x]
+
+prLangAsCFGM :: CanonGrammar -> Ident -> Maybe String -> String
+prLangAsCFGM gr i@(IC lang) start = (header . startcat . rules . footer) ""
+    where
+    header = showString "grammar " . showString lang . showString "\n"
+    startcat = maybe id (\s -> showString "startcat " . showString (s++"{}.s") . showString ";\n") start
+    rules0 = map Prt.prt $ Cnv.cfg $ Cnv.pInfo gr i
+    rules = showString $ concat $ map (\l -> init l++";\n") rules0 
+    footer = showString "end grammar\n"
+
-- 
cgit v1.2.3