diff options
Diffstat (limited to 'src/GF/Compile/ReadFiles.hs')
| -rw-r--r-- | src/GF/Compile/ReadFiles.hs | 220 |
1 files changed, 0 insertions, 220 deletions
diff --git a/src/GF/Compile/ReadFiles.hs b/src/GF/Compile/ReadFiles.hs deleted file mode 100644 index b96d3127b..000000000 --- a/src/GF/Compile/ReadFiles.hs +++ /dev/null @@ -1,220 +0,0 @@ ----------------------------------------------------------------------- --- | --- 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,gf2gfo, - getOptionsFromFile) where - -import GF.Infra.UseIO -import GF.Infra.Option -import GF.Infra.Ident -import GF.Infra.Modules -import GF.Data.Operations -import GF.Grammar.Lexer -import GF.Grammar.Parser -import GF.Grammar.Grammar -import GF.Grammar.Binary - -import Control.Monad -import Data.Char -import Data.List -import Data.Maybe(isJust) -import qualified Data.ByteString.Char8 as BS -import qualified Data.Map as Map -import System.Time -import System.Directory -import System.FilePath -import Text.PrettyPrint - -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 ds = concatMap mkFile ds - where - mkFile (f,st,gfTime,gfoTime,p) = - case st of - CSComp -> [p </> gfFile f] - CSRead | isJust gfTime -> [gf2gfo opts (p </> gfFile f)] - | otherwise -> [p </> gfoFile f] - CSEnv -> [] - - -- | 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,_,t1,_,_) <- ds, elem f imps && liftM2 (>=) t0 t1 /= Just True] - = (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 $ getFilePath ps (gfFile name) - case mb_gfFile of - Just gfFile -> do gfTime <- ioeIO $ getModificationTime gfFile - mb_gfoTime <- ioeIO $ catch (liftM Just $ getModificationTime (gf2gfo opts gfFile)) - (\_->return Nothing) - return (gfFile, Just gfTime, mb_gfoTime) - Nothing -> do mb_gfoFile <- ioeIO $ getFilePath (maybe id (:) (flag optGFODir opts) ps) (gfoFile name) - case mb_gfoFile of - Just gfoFile -> do gfoTime <- ioeIO $ getModificationTime gfoFile - return (gfoFile, Nothing, Just gfoTime) - Nothing -> ioeErr $ Bad (render (text "File" <+> text (gfFile name) <+> text "does not exist." $$ - text "searched in:" <+> vcat (map text ps))) - - - let mb_envmod = Map.lookup name env - (st,t) = selectFormat opts (fmap fst mb_envmod) gfTime gfoTime - - (mname,imps) <- case st of - CSEnv -> return (name, maybe [] snd mb_envmod) - CSRead -> ioeIO $ fmap importsOfModule (decodeModHeader ((if isGFO file then id else gf2gfo opts) file)) - CSComp -> do s <- ioeIO $ BS.readFile file - case runP pModHeader s of - Left (Pn l c,msg) -> ioeBad (file ++ ":" ++ show l ++ ":" ++ show c ++ ": " ++ msg) - Right mo -> return (importsOfModule mo) - ioeErr $ testErr (mname == name) - ("module name" +++ mname +++ "differs from file name" +++ name) - 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" - -gf2gfo :: Options -> FilePath -> FilePath -gf2gfo opts file = maybe (gfoFile (dropExtension file)) - (\dir -> dir </> gfoFile (dropExtension (takeFileName file))) - (flag optGFODir opts) - --- 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 - (_,Just tgfo,Nothing) -> (CSRead,Just tgfo) -- 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 :: SourceModule -> (ModName,[ModName]) -importsOfModule (m,mi) = (modName m,depModInfo mi []) - where - depModInfo mi = - depModType (mtype mi) . - depExtends (extend mi) . - depWith (mwith mi) . - depExDeps (mexdeps mi). - depOpens (opens mi) - - depModType (MTAbstract) xs = xs - depModType (MTResource) xs = xs - depModType (MTInterface) xs = xs - depModType (MTConcrete m2) xs = modName m2:xs - depModType (MTInstance m2) xs = modName m2:xs - - depExtends es xs = foldr depInclude xs es - - depWith (Just (m,_,is)) xs = modName m : depInsts is xs - depWith Nothing xs = xs - - depExDeps eds xs = map modName eds ++ xs - - depOpens os xs = foldr depOpen xs os - - depInsts is xs = foldr depInst xs is - - depInclude (m,_) xs = modName m:xs - - depOpen (OSimple n ) xs = modName n:xs - depOpen (OQualif _ n) xs = modName n:xs - - depInst (m,n) xs = modName m:modName n:xs - - modName = showIdent - --- | options can be passed to the compiler by comments in @--#@, in the main file -getOptionsFromFile :: FilePath -> IOE Options -getOptionsFromFile file = do - s <- ioe $ catch (fmap Ok $ BS.readFile file) - (\_ -> return (Bad $ "File " ++ file ++ " does not exist")) - let ls = filter (BS.isPrefixOf (BS.pack "--#")) $ BS.lines s - fs = map (BS.unpack . BS.unwords . BS.words . BS.drop 3) ls - ioeErr $ parseModuleOptions fs - -getFilePath :: [FilePath] -> String -> IO (Maybe FilePath) -getFilePath paths file = get paths - where - get [] = return Nothing - get (p:ps) = do - let pfile = p </> file - exist <- doesFileExist pfile - if not exist - then get ps - else do pfile <- canonicalizePath pfile - return (Just pfile) |