Added CFGM format (pm -printer=cfgm) and utf8 conversion for pm.

1 files changed, 67 insertions, 0 deletions

diff --git a/src/GF/Canon/GFC.hs b/src/GF/Canon/GFC.hs
index 48c77dfe3..c5af14785 100644
--- a/src/GF/Canon/GFC.hs
+++ b/src/GF/Canon/GFC.hs
@@ -47,3 +47,70 @@ prCanonModInfo = printTree . info2mod
 prGrammar :: CanonGrammar -> String
 prGrammar = printTree . grammar2canon
 -}
+
+{-
+-- apply a function to all concrete terms in a grammar
+mapConcreteTerms :: (Term -> Term) -> CanonGrammar -> CanonGrammar
+mapConcreteTerms f (M.MGrammar xs) = M.MGrammar $ map (onSnd (onModule f)) xs
+    where
+    onModule :: (Term -> Term) -> M.ModInfo i f Info -> M.ModInfo i f Info
+    onModule f m = case m of
+       M.ModMod (m@M.Module{M.jments=js}) -> 
+	   M.ModMod (m{ M.jments = mapTree (onSnd (onInfo f)) js })
+       _ -> m
+
+
+
+
+
+    -- if -utf8 was given, convert from language specific coding
+    encode = if oElem useUTF8 opts then setUTF8Flag . canonUTF8 else id
+    canonUTF8 = mapConcreteTerms (onTokens (anyCodingToUTF8 opts))
+    setUTF8Flag = setFlag "coding" "utf8"
+
+moduleToUTF8 :: Module Ident Flag Info -> Module Ident Flag Info
+moduleToUTF8 m = m{ jments = mapTree (onSnd }
+    where 
+    code = anyCodingToUTF8 (moduleOpts m)
+    moduleOpts = okError . mapM redFlag . flags
+
+data MGrammar i f a = MGrammar {modules :: [(i,ModInfo i f a)]}
+  deriving Show
+
+data ModInfo i f a =
+    ModMainGrammar (MainGrammar i)
+  | ModMod  (Module i f a)
+  | ModWith (ModuleType i) ModuleStatus i [OpenSpec i]
+  deriving Show
+
+data Module i f a = Module {
+    mtype   :: ModuleType i ,
+    mstatus :: ModuleStatus ,
+    flags   :: [f] ,
+    extends :: Maybe i ,
+    opens   :: [OpenSpec i] ,
+    jments  :: BinTree (i,a)
+  }
+  deriving Show
+
+
+
+-- Set a flag in all modules in a grammar
+setFlag :: String -> String -> CanonGrammar -> CanonGrammar
+setFlag n v (M.MGrammar ms) = M.MGrammar $ map (onSnd setFlagMod) ms
+    where
+    setFlagMod m = case m of
+      M.ModMod (m@M.Module{M.flags=fs}) -> M.ModMod $ m{ M.flags = fs' }
+	  where fs' = Flg (IC n) (IC v):[f | f@(Flg (IC n') _) <- fs, n' /= n]
+      _ -> m
+-}
+	      
+mapInfoTerms :: (Term -> Term) -> Info -> Info
+mapInfoTerms f i = case i of 
+         ResOper x a -> ResOper x (f a)
+	 CncCat  x a y -> CncCat x (f a) y
+	 CncFun  x y a z -> CncFun x y (f a) z
+	 _ -> i
+
+setFlag :: String -> String -> [Flag] -> [Flag]
+setFlag n v fs = Flg (IC n) (IC v):[f | f@(Flg (IC n') _) <- fs, n' /= n]
\ No newline at end of file