From 60a3390173867862390cd8029233028d9b846f55 Mon Sep 17 00:00:00 2001 From: "kr.angelov" Date: Thu, 22 May 2008 15:32:31 +0000 Subject: [PATCH] GF.Devel.ModDeps is removed. The only used function is moved to GrammarToGFCC --- src-3.0/GF/Compile/GrammarToGFCC.hs | 15 ++- src-3.0/GF/Devel/ModDeps.hs | 153 ---------------------------- 2 files changed, 14 insertions(+), 154 deletions(-) delete mode 100644 src-3.0/GF/Devel/ModDeps.hs diff --git a/src-3.0/GF/Compile/GrammarToGFCC.hs b/src-3.0/GF/Compile/GrammarToGFCC.hs index 93fe856ad..fc52e7d1c 100644 --- a/src-3.0/GF/Compile/GrammarToGFCC.hs +++ b/src-3.0/GF/Compile/GrammarToGFCC.hs @@ -19,7 +19,6 @@ import qualified GF.Infra.Option as O import GF.Conversion.SimpleToFCFG (convertConcrete) import GF.Parsing.FCFG.PInfo (buildFCFPInfo) import GF.Devel.PrintGFCC -import GF.Devel.ModDeps import GF.Infra.Ident import GF.Infra.Option import GF.Data.Operations @@ -539,3 +538,17 @@ prtTrace tr n = prTrace tr n = trace ("-- OBSERVE" +++ A.prt tr +++ show n +++ show tr) n +-- | this function finds out what modules are really needed in the canonical gr. +-- its argument is typically a concrete module name +requiredCanModules :: (Ord i, Show i) => Bool -> M.MGrammar i f a -> i -> [i] +requiredCanModules isSingle gr c = nub $ filter notReuse ops ++ exts where + exts = M.allExtends gr c + ops = if isSingle + then map fst (M.modules gr) + else iterFix (concatMap more) $ exts + more i = errVal [] $ do + m <- M.lookupModMod gr i + return $ M.extends m ++ [o | o <- map M.openedModule (M.opens m)] + notReuse i = errVal True $ do + m <- M.lookupModMod gr i + return $ M.isModRes m -- to exclude reused Cnc and Abs from required diff --git a/src-3.0/GF/Devel/ModDeps.hs b/src-3.0/GF/Devel/ModDeps.hs deleted file mode 100644 index cfe502f5f..000000000 --- a/src-3.0/GF/Devel/ModDeps.hs +++ /dev/null @@ -1,153 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : ModDeps --- Maintainer : AR --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/11/11 23:24:34 $ --- > CVS $Author: aarne $ --- > CVS $Revision: 1.14 $ --- --- Check correctness of module dependencies. Incomplete. --- --- AR 13\/5\/2003 ------------------------------------------------------------------------------ - -module GF.Devel.ModDeps (mkSourceGrammar, - moduleDeps, - openInterfaces, - requiredCanModules - ) where - -import GF.Infra.Ident -import GF.Infra.Option -import GF.Infra.Modules -import GF.Grammar.Grammar -import GF.Grammar.PrGrammar -import GF.Grammar.Lookup -import GF.Compile.Update - -import GF.Data.Operations - -import Control.Monad -import Data.List - --- | to check uniqueness of module names and import names, the --- appropriateness of import and extend types, --- to build a dependency graph of modules, and to sort them topologically -mkSourceGrammar :: [(Ident,SourceModInfo)] -> Err SourceGrammar -mkSourceGrammar ms = do - let ns = map fst ms - checkUniqueErr ns - mapM (checkUniqueImportNames ns . snd) ms - deps <- moduleDeps ms - deplist <- either - return - (\ms -> Bad $ "circular modules" +++ unwords (map show ms)) $ - topoTest deps - return $ MGrammar [(m, maybe undefined id $ lookup m ms) | IdentM m _ <- deplist] - -checkUniqueErr :: (Show i, Eq i) => [i] -> Err () -checkUniqueErr ms = do - let msg = checkUnique ms - if null msg then return () else Bad $ unlines msg - --- | check that import names don't clash with module names -checkUniqueImportNames :: [Ident] -> SourceModInfo -> Err () -checkUniqueImportNames ns mo = case mo of - ModMod m -> test [n | OQualif _ n v <- opens m, n /= v] - _ -> return () --- Bad $ "bug: ModDeps does not treat" +++ show mo - where - - test ms = testErr (all (`notElem` ns) ms) - ("import names clashing with module names among" +++ - unwords (map prt ms)) - -type Dependencies = [(IdentM Ident,[IdentM Ident])] - --- | to decide what modules immediately depend on what, and check if the --- dependencies are appropriate -moduleDeps :: [(Ident,SourceModInfo)] -> Err Dependencies -moduleDeps ms = mapM deps ms where - deps (c,mi) = errIn ("checking dependencies of module" +++ prt c) $ case mi of - ModMod m -> case mtype m of - MTConcrete a -> do - aty <- lookupModuleType gr a - testErr (aty == MTAbstract) "the of-module is not an abstract syntax" - chDep (IdentM c (MTConcrete a)) - (extends m) (MTConcrete a) (opens m) MTResource - t -> chDep (IdentM c t) (extends m) t (opens m) t - - chDep it es ety os oty = do - ests <- mapM (lookupModuleType gr) es - testErr (all (compatMType ety) ests) "inappropriate extension module type" ----- osts <- mapM (lookupModuleType gr . openedModule) os ----- testErr (all (compatOType oty) osts) "inappropriate open module type" - let ab = case it of - IdentM _ (MTConcrete a) -> [IdentM a MTAbstract] - _ -> [] ---- - return (it, ab ++ - [IdentM e ety | e <- es] ++ - [IdentM (openedModule o) oty | o <- os]) - - -- check for superficial compatibility, not submodule relation etc: what can be extended - compatMType mt0 mt = case (mt0,mt) of - (MTResource, MTConcrete _) -> True - (MTInstance _, MTConcrete _) -> True - (MTInterface, MTAbstract) -> True - (MTConcrete _, MTConcrete _) -> True - (MTInstance _, MTInstance _) -> True - (MTReuse _, MTReuse _) -> True - (MTInstance _, MTResource) -> True - (MTResource, MTInstance _) -> True - ---- some more? - _ -> mt0 == mt - -- in the same way; this defines what can be opened - compatOType mt0 mt = case mt0 of - MTAbstract -> mt == MTAbstract - MTTransfer _ _ -> mt == MTAbstract - _ -> case mt of - MTResource -> True - MTReuse _ -> True - MTInterface -> True - MTInstance _ -> True - _ -> False - - gr = MGrammar ms --- hack - -openInterfaces :: Dependencies -> Ident -> Err [Ident] -openInterfaces ds m = do - let deps = [(i,ds) | (IdentM i _,ds) <- ds] - let more (c,_) = [(i,mt) | Just is <- [lookup c deps], IdentM i mt <- is] - let mods = iterFix (concatMap more) (more (m,undefined)) - return $ [i | (i,MTInterface) <- mods] - --- | this function finds out what modules are really needed in the canonical gr. --- its argument is typically a concrete module name -requiredCanModules :: (Ord i, Show i) => Bool -> MGrammar i f a -> i -> [i] -requiredCanModules isSingle gr c = nub $ filter notReuse ops ++ exts where - exts = allExtends gr c - ops = if isSingle - then map fst (modules gr) - else iterFix (concatMap more) $ exts - more i = errVal [] $ do - m <- lookupModMod gr i - return $ extends m ++ [o | o <- map openedModule (opens m)] - notReuse i = errVal True $ do - m <- lookupModMod gr i - return $ isModRes m -- to exclude reused Cnc and Abs from required - - -{- --- to test -exampleDeps = [ - (ir "Nat",[ii "Gen", ir "Adj"]), - (ir "Adj",[ii "Num", ii "Gen", ir "Nou"]), - (ir "Nou",[ii "Cas"]) - ] - -ii s = IdentM (IC s) MTInterface -ir s = IdentM (IC s) MTResource --} -