1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
|
-----------------------------------------------------------------------
--- Operations to handle dependencies of analysis files.
---
--- @author Heiko Hoffmann, Michael Hanus
--- @version January 2015
-----------------------------------------------------------------------
module AnalysisDependencies(getModulesToAnalyze,reduceDependencies) where
import FlatCurry.Types
import FlatCurry.Goodies(progImports)
import ReadShowTerm(readQTerm)
import Directory(doesFileExist,getModificationTime)
import Maybe(fromMaybe)
import List(delete)
import Time(ClockTime)
import Analysis
import GenericProgInfo
import LoadAnalysis(getAnalysisPublicFile,storeImportModuleList,
getImportModuleListFile)
import Configuration(debugMessage,getWithPrelude)
import CurryFiles
-----------------------------------------------------------------------
--- 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 :: Bool -> Analysis a -> String -> IO [(String,[String])]
getModulesToAnalyze enforce 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 3 ("Analysis file for '"++moduleName++"' up-to-date")
return []
else do
moduleList <- getDependencyList [moduleName] []
debugMessage 3 ("Complete module list: "++ show moduleList)
let impmods = map fst moduleList
storeImportModuleList moduleName impmods
sourceTimeList <- mapIO getSourceFileTime impmods
fcyTimeList <- mapIO getFlatCurryFileTime impmods
anaTimeList <- mapIO (getAnaFileTime ananame) impmods
let (modulesToDo,modulesUpToDate) =
findModulesToAnalyze moduleList
anaTimeList sourceTimeList fcyTimeList ([],[])
--debugMessage 3 ("Modules up-to-date: "++ show modulesUpToDate)
withprelude <- getWithPrelude
let modulesToAnalyze = if enforce then moduleList else
if withprelude=="no"
then let reduced = reduceDependencies modulesToDo
(modulesUpToDate ++ ["Prelude"])
in case reduced of (("Prelude",_):remaining) -> remaining
_ -> reduced
else reduceDependencies modulesToDo modulesUpToDate
debugMessage 3 ("Modules to analyze: " ++ show modulesToAnalyze)
return modulesToAnalyze
where
ananame = analysisName analysis
-- 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 . readQTerm
sourceTimeList <- mapIO getSourceFileTime implist
fcyTimeList <- mapIO getFlatCurryFileTime implist
anaTimeList <- mapIO (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 :: [String] -> [(String,[String])]
-> IO [(String,[String])]
getDependencyList [] moddeps = return moddeps
getDependencyList (mname:mods) moddeps =
maybe (do --debugMessage 3 ("Getting imports of "++ mname)
--debugMessage 3 ("Still to do: "++ show mods)
imports <- getImports mname
getDependencyList (addNewMods mods imports)
((mname,imports):moddeps))
(\ (newmoddeps,imps) ->
getDependencyList (addNewMods mods imps) newmoddeps)
(lookupAndReorder mname [] moddeps)
-- 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)
where
-- 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
|
