summaryrefslogtreecommitdiff
path: root/src/GF/CFGM/PrintCFGrammar.hs
diff options
context:
space:
mode:
authorbringert <unknown>2004-08-23 07:51:36 +0000
committerbringert <unknown>2004-08-23 07:51:36 +0000
commit65f012d15513814bd2cc4ad74f54edd35ade13fe (patch)
tree089419071773038e8357a6b97a9ec0481df2a338 /src/GF/CFGM/PrintCFGrammar.hs
parent25ffe15333a881022047409a1c12a17dd41d1198 (diff)
Added CFGM format (pm -printer=cfgm) and utf8 conversion for pm.
Diffstat (limited to 'src/GF/CFGM/PrintCFGrammar.hs')
-rw-r--r--src/GF/CFGM/PrintCFGrammar.hs33
1 files changed, 33 insertions, 0 deletions
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"
+