diff --git a/src/GF/Canon/GFC.hs b/src/GF/Canon/GFC.hs index a4765b304..a777f4b76 100644 --- a/src/GF/Canon/GFC.hs +++ b/src/GF/Canon/GFC.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/02/18 19:21:06 $ --- > CVS $Author: peb $ --- > CVS $Revision: 1.6 $ +-- > CVS $Date: 2005/03/04 14:08:36 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.7 $ -- -- canonical GF. AR 10\/9\/2002 -- 9\/5\/2003 -- 21\/9 ----------------------------------------------------------------------------- @@ -58,73 +58,6 @@ data Info = deriving (Show) type Printname = Term - --- some printing ---- - -{- -prCanonModInfo :: (Ident,CanonModInfo) -> String -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