diff options
Diffstat (limited to 'src/GF/Canon/GFC.hs')
| -rw-r--r-- | src/GF/Canon/GFC.hs | 67 |
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 |