merge GF.Infra.Modules and GF.Grammar.Grammar. This is a preparation for the separate PGF building

1 files changed, 0 insertions, 340 deletions

diff --git a/src/compiler/GF/Infra/Modules.hs b/src/compiler/GF/Infra/Modules.hs
deleted file mode 100644
index 67e010ece..000000000
--- a/src/compiler/GF/Infra/Modules.hs
+++ /dev/null
@@ -1,340 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : Modules
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/11/09 15:14:30 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.26 $
---
--- Datastructures and functions for modules, common to GF and GFC.
---
--- AR 29\/4\/2003
---
--- The same structure will be used in both source code and canonical.
--- The parameters tell what kind of data is involved.
------------------------------------------------------------------------------
-
-module GF.Infra.Modules (
-        MGrammar, ModInfo(..), ModuleType(..),
-        MInclude (..),
-        mGrammar,modules,prependModule,
-        extends, isInherited,inheritAll, 
-        updateModule, replaceJudgements, addFlag,
-        addOpenQualif, flagsModule, allFlags,
-        OpenSpec(..),
-        ModuleStatus(..),
-        openedModule, depPathModule, allDepsModule, partOfGrammar,
-        allExtends, allExtendSpecs, allExtendsPlus, allExtensions, 
-        searchPathModule,
-     -- addModule, mapModules, updateMGrammar, 
-        emptyMGrammar, emptyModInfo,
-        abstractOfConcrete, abstractModOfConcrete,
-        lookupModule, lookupModuleType, lookupInfo,
-        isModAbs, isModRes, isModCnc,
-        sameMType, isCompilableModule, isCompleteModule,
-        allAbstracts, greatestAbstract, allResources,
-        greatestResource, allConcretes, allConcreteModules
-        ) where
-
-import GF.Infra.Ident
-import GF.Infra.Option
-import GF.Data.Operations
-
-import Data.List
-import qualified Data.Map as Map
-import Text.PrettyPrint
-import System.FilePath
-
-
--- Invariant: modules are stored in dependency order
-
-data MGrammar a = MGrammar { moduleMap :: Map.Map Ident (ModInfo a),
-                             modules :: [(Ident,ModInfo a)] }
-  deriving Show
-mGrammar ms = MGrammar (Map.fromList ms) ms
-
-data ModInfo a = ModInfo {
-    mtype   :: ModuleType,
-    mstatus :: ModuleStatus,
-    flags   :: Options,
-    extend  :: [(Ident,MInclude)],
-    mwith   :: Maybe (Ident,MInclude,[(Ident,Ident)]),
-    opens   :: [OpenSpec],
-    mexdeps :: [Ident],
-    msrc    :: FilePath,
-    jments  :: Map.Map Ident a
-  }
-  deriving Show
-
--- | encoding the type of the module
-data ModuleType = 
-    MTAbstract 
-  | MTResource
-  | MTConcrete Ident
-    -- ^ up to this, also used in GFO. Below, source only.
-  | MTInterface
-  | MTInstance (Ident,MInclude)
-  deriving (Eq,Show)
-
-data MInclude = MIAll | MIOnly [Ident] | MIExcept [Ident]
-  deriving (Eq,Show)
-
-extends :: ModInfo a -> [Ident]
-extends = map fst . extend
-
-isInherited :: MInclude -> Ident -> Bool
-isInherited c i = case c of
-  MIAll -> True
-  MIOnly is -> elem i is
-  MIExcept is -> notElem i is
-
-inheritAll :: Ident -> (Ident,MInclude)
-inheritAll i = (i,MIAll)
-
--- destructive update
-{-
--- | dep order preserved since old cannot depend on new
-updateMGrammar :: MGrammar a -> MGrammar a -> MGrammar a
-updateMGrammar (MGrammar omap os) (MGrammar nmap ns) =
-  MGrammar (Map.union nmap omap) -- Map.union is left-biased
-           ([im | im@(i,m) <- os, i `notElem` nis] ++ ns)
-  where
-    nis = map fst ns
--}
-updateModule :: ModInfo t -> Ident -> t -> ModInfo t
-updateModule (ModInfo mt ms fs me mw ops med src js) i t = ModInfo mt ms fs me mw ops med src (updateTree (i,t) js)
-
-replaceJudgements :: ModInfo t -> Map.Map Ident t -> ModInfo t
-replaceJudgements (ModInfo mt ms fs me mw ops med src _) js = ModInfo mt ms fs me mw ops med src js
-
-addOpenQualif :: Ident -> Ident -> ModInfo t -> ModInfo t
-addOpenQualif i j (ModInfo mt ms fs me mw ops med src js) = ModInfo mt ms fs me mw (OQualif i j : ops) med src js
-
-addFlag :: Options -> ModInfo t -> ModInfo t
-addFlag f mo = mo {flags = flags mo `addOptions` f} 
-
-flagsModule :: (Ident,ModInfo a) -> Options
-flagsModule (_,mi) = flags mi
-
-allFlags :: MGrammar a -> Options
-allFlags gr = concatOptions [flags m | (_,m) <- modules gr]
-{-
-mapModules :: (ModInfo a -> ModInfo a) -> MGrammar a -> MGrammar a 
-mapModules f = mGrammar . map (onSnd f) . modules
--}
-data OpenSpec = 
-   OSimple Ident
- | OQualif Ident Ident
-  deriving (Eq,Show)
-
-data ModuleStatus = 
-   MSComplete 
- | MSIncomplete 
-  deriving (Eq,Ord,Show)
-
-openedModule :: OpenSpec -> Ident
-openedModule o = case o of
-  OSimple m -> m
-  OQualif _ m -> m
-
--- | initial dependency list
-depPathModule :: ModInfo a -> [OpenSpec]
-depPathModule m = fors m ++ exts m ++ opens m
-  where
-    fors m = 
-      case mtype m of
-        MTConcrete i   -> [OSimple i]
-        MTInstance (i,_)   -> [OSimple i]
-        _              -> []
-    exts m = map OSimple (extends m)
-
--- | all dependencies
-allDepsModule :: MGrammar a -> ModInfo a -> [OpenSpec]
-allDepsModule gr m = iterFix add os0 where
-  os0 = depPathModule m
-  add os = [m | o <- os, Just n <- [lookup (openedModule o) mods], 
-                m <- depPathModule n]
-  mods = modules gr
-
--- | select just those modules that a given one depends on, including itself
-partOfGrammar :: MGrammar a -> (Ident,ModInfo a) -> MGrammar a
-partOfGrammar gr (i,m) = mGrammar [mo | mo@(j,_) <- mods, elem j modsFor]
-  where
-    mods = modules gr
-    modsFor = (i:) $ map openedModule $ allDepsModule gr m
-
--- | all modules that a module extends, directly or indirectly, without restricts
-allExtends :: MGrammar a -> Ident -> [Ident]
-allExtends gr i =
-  case lookupModule gr i of
-    Ok m -> case extends m of 
-              [] -> [i]
-              is -> i : concatMap (allExtends gr) is
-    _    -> []
-
--- | all modules that a module extends, directly or indirectly, with restricts
-allExtendSpecs :: MGrammar a -> Ident -> [(Ident,MInclude)]
-allExtendSpecs gr i =
-  case lookupModule gr i of
-    Ok m -> case extend m of 
-              [] -> [(i,MIAll)]
-              is ->  (i,MIAll) : concatMap (allExtendSpecs gr . fst) is
-    _    -> []
-
--- | this plus that an instance extends its interface
-allExtendsPlus :: MGrammar a -> Ident -> [Ident]
-allExtendsPlus gr i =
-  case lookupModule gr i of
-    Ok m -> i : concatMap (allExtendsPlus gr) (exts m)
-    _    -> []
-  where
-    exts m = extends m ++ [j | MTInstance (j,_) <- [mtype m]]
-
--- | conversely: all modules that extend a given module, incl. instances of interface
-allExtensions :: MGrammar a -> Ident -> [Ident]
-allExtensions gr i =
-  case lookupModule gr i of
-    Ok m -> let es = exts i in es ++ concatMap (allExtensions gr) es
-    _    -> []
- where
-   exts i = [j | (j,m) <- mods, elem i (extends m) || isInstanceOf i m]
-   mods = modules gr
-   isInstanceOf i m = case mtype m of
-     MTInstance (j,_) -> j == i
-     _ -> False
-
--- | initial search path: the nonqualified dependencies
-searchPathModule :: ModInfo a -> [Ident]
-searchPathModule m = [i | OSimple i <- depPathModule m]
-
-{-
--- | a new module can safely be added to the end, since nothing old can depend on it
-addModule :: MGrammar a -> Ident -> ModInfo a -> MGrammar a
---addModule gr name mi = MGrammar $ (modules gr ++ [(name,mi)])
-addModule gr name mi = MGrammar $ Map.insert name mi (moduleMap gr)
--}
-
-prependModule (MGrammar mm ms) im@(i,m) = MGrammar (Map.insert i m mm) (im:ms)
-
-emptyMGrammar :: MGrammar a
-emptyMGrammar = mGrammar []
-
-emptyModInfo :: ModInfo a
-emptyModInfo = ModInfo MTResource MSComplete noOptions [] Nothing [] [] "" emptyBinTree
-
--- | we store the module type with the identifier
-
-abstractOfConcrete :: MGrammar a -> Ident -> Err Ident
-abstractOfConcrete gr c = do
-  n <- lookupModule gr c
-  case mtype n of
-    MTConcrete a -> return a
-    _ -> Bad $ render (text "expected concrete" <+> ppIdent c)
-
-abstractModOfConcrete :: MGrammar a -> Ident -> Err (ModInfo a)
-abstractModOfConcrete gr c = lookupModule gr =<< abstractOfConcrete gr c
-
--- the canonical file name
-
---- canonFileName s = prt s ++ ".gfc"
-
-lookupModule :: MGrammar a -> Ident -> Err (ModInfo a)
---lookupModule gr m = case lookup m (modules gr) of
-lookupModule gr m = case Map.lookup m (moduleMap gr) of
-  Just i  -> return i
-  Nothing -> Bad $ render (text "unknown module" <+> ppIdent m <+> text "among" <+> hsep (map (ppIdent . fst) (modules gr)))
-
-lookupModuleType :: MGrammar a -> Ident -> Err ModuleType
-lookupModuleType gr m = mtype `fmap` lookupModule gr m
-
-lookupInfo :: ModInfo a -> Ident -> Err a
-lookupInfo mo i = lookupTree showIdent i (jments mo)
-
-isModAbs :: ModInfo a -> Bool
-isModAbs m =
-  case mtype m of
-    MTAbstract -> True
-    _          -> False
-
-isModRes :: ModInfo a -> Bool
-isModRes m =
-  case mtype m of
-    MTResource   -> True
-    MTInterface  -> True ---
-    MTInstance _ -> True
-    _            -> False
-
-isModCnc :: ModInfo a -> Bool
-isModCnc m =
-  case mtype m of
-    MTConcrete _ -> True
-    _            -> False
-
-sameMType :: ModuleType -> ModuleType -> Bool
-sameMType m n =
-  case (n,m) of
-    (MTConcrete _, MTConcrete _) -> True
-
-    (MTInstance _, MTInstance _) -> True
-    (MTInstance _, MTResource)   -> True
-    (MTInstance _, MTConcrete _) -> True
-
-    (MTInterface,  MTInstance _) -> True
-    (MTInterface,  MTResource)   -> True    -- for reuse
-    (MTInterface,  MTAbstract)   -> True    -- for reuse
-    (MTInterface,  MTConcrete _) -> True    -- for reuse
-
-    (MTResource,   MTInstance _) -> True
-    (MTResource,   MTConcrete _) -> True    -- for reuse
-
-    _                            -> m == n
-
--- | don't generate code for interfaces and for incomplete modules
-isCompilableModule :: ModInfo a -> Bool
-isCompilableModule m =
-  case mtype m of
-    MTInterface -> False
-    _           -> mstatus m == MSComplete
-
--- | interface and "incomplete M" are not complete
-isCompleteModule :: ModInfo a -> Bool
-isCompleteModule m = mstatus m == MSComplete && mtype m /= MTInterface
-
-
--- | all abstract modules sorted from least to most dependent
-allAbstracts :: MGrammar a -> [Ident]
-allAbstracts gr = 
- case topoTest [(i,extends m) | (i,m) <- modules gr, mtype m == MTAbstract] of
-   Left  is     -> is
-   Right cycles -> error $ render (text "Cyclic abstract modules:" <+> vcat (map (hsep . map ppIdent) cycles))
-
--- | the last abstract in dependency order (head of list)
-greatestAbstract :: MGrammar a -> Maybe Ident
-greatestAbstract gr =
-  case allAbstracts gr of
-    [] -> Nothing
-    as -> return $ last as
-
--- | all resource modules
-allResources :: MGrammar a -> [Ident]
-allResources gr = [i | (i,m) <- modules gr, isModRes m || isModCnc m]
-
--- | the greatest resource in dependency order
-greatestResource :: MGrammar a -> Maybe Ident
-greatestResource gr =
-  case allResources gr of
-    [] -> Nothing
-    a  -> return $ head a ---- why not last as in Abstract? works though AR 24/5/2008
-
--- | all concretes for a given abstract
-allConcretes :: MGrammar a -> Ident -> [Ident]
-allConcretes gr a =
-  [i | (i, m) <- modules gr, mtype m == MTConcrete a, isCompleteModule m]
-
--- | all concrete modules for any abstract
-allConcreteModules :: MGrammar a -> [Ident]
-allConcreteModules gr =
-  [i | (i, m) <- modules gr, MTConcrete _ <- [mtype m], isCompleteModule m]