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
197
198
199
200
|
module CASS.Dependencies(getModulesToAnalyze,reduceDependencies) where
import FlatCurry.Types
import FlatCurry.Goodies (progImports)
import System.Directory (doesFileExist,getModificationTime)
import Data.Maybe (fromMaybe)
import Data.List (delete)
import Data.Time(ClockTime)
import Analysis.Logging ( DLevel, debugMessage )
import Analysis.Types
import Analysis.ProgInfo
import Analysis.Files
import CASS.Configuration ( CConfig, debugLevel, withPrelude )
getModulesToAnalyze :: CConfig -> Bool -> Analysis a -> String
-> IO [(String,[String])]
getModulesToAnalyze cconfig 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 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 ([],[])
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
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))
isAnalysisFileTimeNewer :: Maybe ClockTime -> Maybe ClockTime -> Maybe ClockTime
-> Bool
isAnalysisFileTimeNewer anatime srctime fcytime =
anatime >= srctime && anatime >= fcytime
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)
getDependencyList :: CConfig -> [String] -> [(String,[String])]
-> IO [(String,[String])]
getDependencyList _ [] moddeps = return moddeps
getDependencyList cc (mname:mods) moddeps =
maybe (do
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
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
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)
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"
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
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
|