---------------------------------------------------------------------- -- | -- Module : ReadFiles -- Maintainer : AR -- Stability : (stable) -- Portability : (portable) -- -- > CVS $Date: 2005/11/11 23:24:34 $ -- > CVS $Author: aarne $ -- > CVS $Revision: 1.26 $ -- -- Decide what files to read as function of dependencies and time stamps. -- -- make analysis for GF grammar modules. AR 11\/6\/2003--24\/2\/2004 -- -- to find all files that have to be read, put them in dependency order, and -- decide which files need recompilation. Name @file.gf@ is returned for them, -- and @file.gfo@ otherwise. ----------------------------------------------------------------------------- module GF.Compile.ReadFiles ( getAllFiles,ModName,ModEnv,importsOfModule, gfoFile,gfFile,isGFO, getOptionsFromFile) where import GF.Infra.UseIO import GF.Infra.Option import GF.Data.Operations import GF.Source.AbsGF hiding (FileName) import GF.Source.LexGF import GF.Source.ParGF import Control.Monad import Data.Char import Data.List import qualified Data.ByteString.Char8 as BS import qualified Data.Map as Map import System.Time import System.Directory import System.FilePath type ModName = String type ModEnv = Map.Map ModName (ClockTime,[ModName]) -- | Returns a list of all files to be compiled in topological order i.e. -- the low level (leaf) modules are first. getAllFiles :: Options -> [InitPath] -> ModEnv -> FileName -> IOE [FullPath] getAllFiles opts ps env file = do -- read module headers from all files recursively ds <- liftM reverse $ get [] [] (justModuleName file) ioeIO $ putIfVerb opts $ "all modules:" +++ show [name | (name,_,_,_,_) <- ds] return $ paths ds where -- construct list of paths to read paths cs = [mk (p f) | (f,st,_,_,p) <- cs, mk <- mkFile st] where mkFile CSComp = [gfFile ] mkFile CSRead = [gfoFile] mkFile _ = [] -- | traverses the dependency graph and returns a topologicaly sorted -- list of ModuleInfo. An error is raised if there is circular dependency get :: [ModName] -- ^ keeps the current path in the dependency graph to avoid cycles -> [ModuleInfo] -- ^ a list of already traversed modules -> ModName -- ^ the current module -> IOE [ModuleInfo] -- ^ the final get trc ds name | name `elem` trc = ioeErr $ Bad $ "circular modules" +++ unwords trc | (not . null) [n | (n,_,_,_,_) <- ds, name == n] --- file already read = return ds | otherwise = do (name,st0,t0,imps,p) <- findModule name ds <- foldM (get (name:trc)) ds imps let (st,t) | (not . null) [f | (f,CSComp,_,_,_) <- ds, elem f imps] = (CSComp,Nothing) | otherwise = (st0,t0) return ((name,st,t,imps,p):ds) -- searches for module in the search path and if it is found -- returns 'ModuleInfo'. It fails if there is no such module findModule :: ModName -> IOE ModuleInfo findModule name = do (file,gfTime,gfoTime) <- do mb_gfFile <- ioeIO $ getFilePathMsg "" ps (gfFile name) case mb_gfFile of Just gfFile -> do gfTime <- ioeIO $ getModificationTime gfFile mb_gfoTime <- ioeIO $ catch (liftM Just $ getModificationTime (replaceExtension gfFile "gfo")) (\_->return Nothing) return (gfFile, Just gfTime, mb_gfoTime) Nothing -> do mb_gfoFile <- ioeIO $ getFilePathMsg "" ps (gfoFile name) case mb_gfoFile of Just gfoFile -> do gfoTime <- ioeIO $ getModificationTime gfoFile return (gfoFile, Nothing, Just gfoTime) Nothing -> ioeErr $ Bad ("File " ++ gfFile name ++ " does not exist.") let mb_envmod = Map.lookup name env (st,t) = selectFormat opts (fmap fst mb_envmod) gfTime gfoTime imps <- if st == CSEnv then return (maybe [] snd mb_envmod) else do s <- ioeIO $ BS.readFile file (mname,imps) <- ioeErr ((liftM importsOfModule . pModHeader . myLexer) s) ioeErr $ testErr (mname == name) ("module name" +++ mname +++ "differs from file name" +++ name) return imps return (name,st,t,imps,dropFileName file) isGFO :: FilePath -> Bool isGFO = (== ".gfo") . takeExtensions gfoFile :: FilePath -> FilePath gfoFile f = addExtension f "gfo" gfFile :: FilePath -> FilePath gfFile f = addExtension f "gf" -- From the given Options and the time stamps computes -- whether the module have to be computed, read from .gfo or -- the environment version have to be used selectFormat :: Options -> Maybe ClockTime -> Maybe ClockTime -> Maybe ClockTime -> (CompStatus,Maybe ClockTime) selectFormat opts mtenv mtgf mtgfo = case (mtenv,mtgfo,mtgf) of (_,_,Just tgf) | fromSrc -> (CSComp,Nothing) (Just tenv,_,_) | fromComp -> (CSEnv, Just tenv) (_,Just tgfo,_) | fromComp -> (CSRead,Just tgfo) (Just tenv,_,Just tgf) | tenv > tgf -> (CSEnv, Just tenv) (_,Just tgfo,Just tgf) | tgfo > tgf -> (CSRead,Just tgfo) (Just tenv,_,Nothing) -> (CSEnv,Just tenv) -- source does not exist (_,_, Nothing) -> (CSRead,Nothing) -- source does not exist _ -> (CSComp,Nothing) where fromComp = flag optRecomp opts == NeverRecomp fromSrc = flag optRecomp opts == AlwaysRecomp -- internal module dep information data CompStatus = CSComp -- compile: read gf | CSRead -- read gfo | CSEnv -- gfo is in env deriving Eq type ModuleInfo = (ModName,CompStatus,Maybe ClockTime,[ModName],InitPath) importsOfModule :: ModDef -> (ModName,[ModName]) importsOfModule (MModule _ typ body) = modType typ (modBody body []) where modType (MTAbstract m) xs = (modName m,xs) modType (MTResource m) xs = (modName m,xs) modType (MTInterface m) xs = (modName m,xs) modType (MTConcrete m m2) xs = (modName m,modName m2:xs) modType (MTInstance m m2) xs = (modName m,modName m2:xs) modType (MTTransfer m o1 o2) xs = (modName m,open o1 (open o2 xs)) modBody (MBody e o _) xs = extend e (opens o xs) modBody (MNoBody is) xs = foldr include xs is modBody (MWith i os) xs = include i (foldr open xs os) modBody (MWithBody i os o _) xs = include i (foldr open (opens o xs) os) modBody (MWithE is i os) xs = foldr include (include i (foldr open xs os)) is modBody (MWithEBody is i os o _) xs = foldr include (include i (foldr open (opens o xs) os)) is modBody (MReuse m) xs = modName m:xs modBody (MUnion is) xs = foldr include xs is include (IAll m) xs = modName m:xs include (ISome m _) xs = modName m:xs include (IMinus m _) xs = modName m:xs open (OName n) xs = modName n:xs open (OQualQO _ n) xs = modName n:xs open (OQual _ _ n) xs = modName n:xs extend NoExt xs = xs extend (Ext is) xs = foldr include xs is opens NoOpens xs = xs opens (OpenIn os) xs = foldr open xs os modName (PIdent (_,s)) = BS.unpack s -- | options can be passed to the compiler by comments in @--#@, in the main file getOptionsFromFile :: FilePath -> IOE Options getOptionsFromFile file = do s <- ioeIO $ readFileIfStrict file let ls = filter (BS.isPrefixOf (BS.pack "--#")) $ BS.lines s fs = map (BS.unpack . BS.unwords . BS.words . BS.drop 3) ls ioeErr $ liftM moduleOptions $ parseModuleOptions fs