| 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
 |