|
sourcecode:
|
module CASS.Dependencies(getModulesToAnalyze,reduceDependencies) where
import Control.Monad ( when )
import FlatCurry.Types
import FlatCurry.Goodies ( progImports )
import System.Directory ( doesFileExist, getModificationTime, removeFile )
import Data.Maybe ( fromMaybe )
import Data.List ( delete )
import Data.Time(ClockTime)
import RW.Base
import Analysis.Logging ( DLevel, debugMessage )
import Analysis.Types
import Analysis.ProgInfo
import Analysis.Files
import CASS.Configuration ( CConfig, debugLevel, withPrelude, ccOptions )
import CASS.Options
-----------------------------------------------------------------------
--- Compute the modules and their imports which must be analyzed
--- w.r.t. a given analysis and main module.
--- If the first argument is true, then the analysis is enforced
--- (even if analysis information exists).
getModulesToAnalyze :: (Eq a, Read a, ReadWrite a) => CConfig -> Bool
-> Analysis a -> String -> IO [(String,[String])]
getModulesToAnalyze cconfig enforce analysis moduleName = do
checkPrivateProgInfo cconfig analysis moduleName
if isSimpleAnalysis analysis
then do
ananewer <- isAnalysisFileNewer ananame moduleName
return (if ananewer && not enforce then [] else [(moduleName,[])])
else do
valid <- isAnalysisValid ananame moduleName
if valid && not enforce
then do
debugMessage dl 3 $
"Analysis file for '" ++ moduleName ++ "' up-to-date"
return []
else do
moduleList <- getDependencyList cconfig [moduleName] []
debugMessage dl 3 $ "Complete module list: "++ show moduleList
let impmods = map fst moduleList
storeImportModuleList dl moduleName impmods
sourceTimeList <- mapM getSourceFileTime impmods
fcyTimeList <- mapM getFlatCurryFileTime impmods
anaTimeList <- mapM (getAnaFileTime ananame) impmods
let (modulesToDo,modulesUpToDate) =
findModulesToAnalyze moduleList anaTimeList sourceTimeList
fcyTimeList ([],[])
--debugMessage dl 3 ("Modules up-to-date: "++ show modulesUpToDate)
let modulesToAnalyze =
if enforce
then moduleList
else
if withPrelude cconfig
then reduceDependencies modulesToDo modulesUpToDate
else let reduced = reduceDependencies modulesToDo
(modulesUpToDate ++ ["Prelude"])
in case reduced of
(("Prelude",_):remaining) -> remaining
_ -> reduced
debugMessage dl 3 ("Modules to analyze: " ++ show modulesToAnalyze)
return modulesToAnalyze
where
dl = debugLevel cconfig
ananame = analysisName analysis
---- The empty program information for a given analysis.
emptyAnalysisInfo:: Analysis a -> ProgInfo a
emptyAnalysisInfo _ = emptyProgInfo
-- Checks whether the private `ProgInfo` is empty if option `--all` is set.
-- If this is the case, the analysis files will be deleted so that the
-- module will be re-analyzed. This is necessary if the analysis files
-- have been created from the CurryInfo system (which contains only information
-- about public entities).
checkPrivateProgInfo :: (Eq a, Read a, ReadWrite a) => CConfig
-> Analysis a -> String -> IO ()
checkPrivateProgInfo cconfig analysis modname
| not (optAll (ccOptions cconfig)) = return ()
| otherwise
= do
privfname <- getAnalysisPrivateFile modname ananame
privexists <- doesFileExist privfname
if privexists
then do
privinfo <- readAnalysisPrivateFile dl privfname
when (equalProgInfo (emptyAnalysisInfo analysis) privinfo) $ do
removeFile privfname
removePubInfo
else removePubInfo
where
dl = debugLevel cconfig
ananame = analysisName analysis
removePubInfo = do
pubfname <- getAnalysisPublicFile modname ananame
debugMessage dl 3 $ "Removing public analysis file '" ++ pubfname ++ "'..."
pubexists <- doesFileExist pubfname
when pubexists $ removeFile pubfname
-- Checks whether the analysis file is up-to-date.
-- Returns True if the analysis file is newer than the source file
-- and the FlatCurry file (if is exists).
isAnalysisFileNewer :: String -> String -> IO Bool
isAnalysisFileNewer ananame modname = do
atime <- getAnaFileTime ananame modname
stime <- getSourceFileTime modname
ftime <- getFlatCurryFileTime modname
return (isAnalysisFileTimeNewer (snd atime) (Just (snd stime)) (snd ftime))
-- Is the analysis file time up-to-date w.r.t. the file times of
-- the source file and the FlatCurry file?
-- Returns True if the analysis file is newer than the source file
-- and the FlatCurry file (if is exists).
isAnalysisFileTimeNewer :: Maybe ClockTime -> Maybe ClockTime -> Maybe ClockTime
-> Bool
isAnalysisFileTimeNewer anatime srctime fcytime =
anatime >= srctime && anatime >= fcytime
-- Read current import dependencies and checks whether the current analysis
-- file is valid, i.e., it is newer than the source and FlatCurry files
-- of all (directly and indirectly) imported modules.
isAnalysisValid :: String -> String -> IO Bool
isAnalysisValid ananame modname =
getImportModuleListFile modname >>= maybe
(return False)
(\importListFile -> do
itime <- getModificationTime importListFile
stime <- getSourceFileTime modname >>= return . snd
if itime>=stime
then do
implist <- readFile importListFile >>= return . read
sourceTimeList <- mapM getSourceFileTime implist
fcyTimeList <- mapM getFlatCurryFileTime implist
anaTimeList <- mapM (getAnaFileTime ananame) implist
return (all (\ (x,y,z) -> isAnalysisFileTimeNewer x y z)
(zip3 (map snd anaTimeList)
(map (Just . snd) sourceTimeList)
(map snd fcyTimeList)))
else return False)
--- Gets the list of all modules required by the first module.
--- The result is sorted according to their dependencies
--- (Prelude first, main module last)
getDependencyList :: CConfig -> [String] -> [(String,[String])]
-> IO [(String,[String])]
getDependencyList _ [] moddeps = return moddeps
getDependencyList cc (mname:mods) moddeps =
maybe (do --debugMessage 3 ("Getting imports of "++ mname)
--debugMessage 3 ("Still to do: "++ show mods)
imports <- getImports dl mname
getDependencyList cc (addNewMods mods imports)
((mname,imports):moddeps))
(\ (newmoddeps,imps) ->
getDependencyList cc (addNewMods mods imps) newmoddeps)
(lookupAndReorder mname [] moddeps)
where dl = debugLevel cc
-- add new modules if they are not already there:
addNewMods :: [String] -> [String] -> [String]
addNewMods oldmods newmods = oldmods ++ filter (`notElem` oldmods) newmods
lookupAndReorder :: String -> [(String, [String])] -> [(String, [String])]
-> Maybe ([(String, [String])], [String])
lookupAndReorder _ _ [] = Nothing
lookupAndReorder mname list1 ((amod,amodimports):rest)
| mname==amod = Just ((amod,amodimports):reverse list1++rest, amodimports)
| otherwise = lookupAndReorder mname ((amod,amodimports):list1) rest
-- get timestamp of analysis file
getAnaFileTime :: String -> String -> IO (String,Maybe ClockTime)
getAnaFileTime anaName moduleName = do
fileName <- getAnalysisPublicFile moduleName anaName
fileExists <- doesFileExist fileName
if fileExists
then do time <- getModificationTime fileName
return (moduleName,Just time)
else return (moduleName,Nothing)
-- check if analysis result of a module can be loaded or needs to be
-- newly analyzed
findModulesToAnalyze :: [(String,[String])]
-> [(String,Maybe ClockTime)]
-> [(String,ClockTime)]
-> [(String,Maybe ClockTime)]
-> ([(String,[String])],[String])
-> ([(String,[String])],[String])
findModulesToAnalyze [] _ _ _ (modulesToDo,modulesUpToDate) =
(reverse modulesToDo, modulesUpToDate)
findModulesToAnalyze (m@(mod,imports):ms)
anaTimeList sourceTimeList fcyTimeList
(modulesToDo,modulesUpToDate) =
case (lookup mod anaTimeList) of
Just Nothing -> findModulesToAnalyze ms anaTimeList sourceTimeList
fcyTimeList
((m:modulesToDo),modulesUpToDate)
Just (Just time) ->
if checkTime mod time imports anaTimeList sourceTimeList fcyTimeList
modulesToDo
then findModulesToAnalyze ms anaTimeList sourceTimeList fcyTimeList
(modulesToDo,(mod:modulesUpToDate))
else findModulesToAnalyze ms anaTimeList sourceTimeList fcyTimeList
((m:modulesToDo),modulesUpToDate)
Nothing -> error
"Internal error in AnalysisDependencies.findModulesToAnalyz"
-- function to check if result file is up-to-date
-- compares timestamp of analysis result file with module source/FlatCurry file
-- and with timpestamp of result files of all imported modules
checkTime :: String -> ClockTime -> [String] -> [(String,Maybe ClockTime)]
-> [(String,ClockTime)] -> [(String,Maybe ClockTime)]
-> [(String,[String])] -> Bool
checkTime mod time1 [] _ sourceTimeList fcyTimeList _ =
isAnalysisFileTimeNewer (Just time1) (lookup mod sourceTimeList)
(fromMaybe Nothing (lookup mod fcyTimeList))
checkTime mod time1 (impt:impts) anaTimeList sourceTimeList fcyTimeList
resultList =
(lookup impt resultList) == Nothing
&& (Just time1) >= (fromMaybe Nothing (lookup impt anaTimeList))
&& checkTime mod time1 impts anaTimeList sourceTimeList fcyTimeList resultList
-----------------------------------------------------------------------
-- Remove the module analysis dependencies (first argument) w.r.t.
-- a list of modules that are already analyzed (second argument).
reduceDependencies :: [(String,[String])] -> [String] -> [(String,[String])]
reduceDependencies modulesToDo [] = modulesToDo
reduceDependencies modulesToDo (mod:mods) =
let modulesToDo2 = map (\ (m,list) -> (m,(delete mod list))) modulesToDo
in reduceDependencies modulesToDo2 mods
|