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
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
|
module Analysis.Types
( Analysis(..)
, simpleFuncAnalysis, simpleTypeAnalysis, simpleConstructorAnalysis
, dependencyFuncAnalysis, dependencyTypeAnalysis
, combinedSimpleFuncAnalysis, combined2SimpleFuncAnalysis
, combinedSimpleTypeAnalysis
, combinedDependencyFuncAnalysis, combinedDependencyTypeAnalysis
, simpleModuleAnalysis, dependencyModuleAnalysis
, isSimpleAnalysis, isCombinedAnalysis, isFunctionAnalysis
, analysisName, baseAnalysisNames, startValue
, AOutFormat(..)
) where
import FlatCurry.Types ( Prog, ConsDecl, FuncDecl, TypeDecl, QName )
import FlatCurry.Goodies ( progImports )
import Analysis.Logging ( DLevel(..) )
import Analysis.ProgInfo ( ProgInfo, combineProgInfo, lookupProgInfo )
import Analysis.Files ( getImports, loadCompleteAnalysis, getInterfaceInfos )
data Analysis a =
SimpleFuncAnalysis String (FuncDecl -> a)
| SimpleTypeAnalysis String (TypeDecl -> a)
| SimpleConstructorAnalysis String (ConsDecl -> TypeDecl -> a)
| DependencyFuncAnalysis String a (FuncDecl -> [(QName,a)] -> a)
| DependencyTypeAnalysis String a (TypeDecl -> [(QName,a)] -> a)
| CombinedSimpleFuncAnalysis [String] String Bool
(String -> IO (FuncDecl -> a))
| CombinedSimpleTypeAnalysis [String] String Bool
(String -> IO (TypeDecl -> a))
| CombinedDependencyFuncAnalysis [String] String Bool a
(String -> IO (FuncDecl -> [(QName,a)] -> a))
| CombinedDependencyTypeAnalysis [String] String Bool a
(String -> IO (TypeDecl -> [(QName,a)] -> a))
| SimpleModuleAnalysis String (Prog -> a)
| DependencyModuleAnalysis String (Prog -> [(String,a)] -> a)
simpleFuncAnalysis :: String -> (FuncDecl -> a) -> Analysis a
simpleFuncAnalysis anaName anaFunc =
SimpleFuncAnalysis anaName anaFunc
simpleTypeAnalysis :: String -> (TypeDecl -> a) -> Analysis a
simpleTypeAnalysis anaName anaFunc =
SimpleTypeAnalysis anaName anaFunc
simpleConstructorAnalysis :: String -> (ConsDecl -> TypeDecl -> a) -> Analysis a
simpleConstructorAnalysis anaName anaFunc =
SimpleConstructorAnalysis anaName anaFunc
dependencyFuncAnalysis :: String -> a -> (FuncDecl -> [(QName,a)] -> a)
-> Analysis a
dependencyFuncAnalysis anaName startval anaFunc =
DependencyFuncAnalysis anaName startval anaFunc
dependencyTypeAnalysis :: String -> a -> (TypeDecl -> [(QName,a)] -> a)
-> Analysis a
dependencyTypeAnalysis anaName startval anaType =
DependencyTypeAnalysis anaName startval anaType
combinedSimpleFuncAnalysis :: Read b => String -> Analysis b
-> (ProgInfo b -> FuncDecl -> a) -> Analysis a
combinedSimpleFuncAnalysis ananame baseAnalysis anaFunc =
CombinedSimpleFuncAnalysis [analysisName baseAnalysis] ananame True
(runWithBaseAnalysis Quiet baseAnalysis anaFunc)
combined2SimpleFuncAnalysis :: (Read b, Read c)
=> String -> Analysis b -> Analysis c
-> (ProgInfo b -> ProgInfo c -> FuncDecl -> a) -> Analysis a
combined2SimpleFuncAnalysis ananame baseAnalysisA baseAnalysisB anaFunc =
CombinedSimpleFuncAnalysis
[analysisName baseAnalysisA, analysisName baseAnalysisB]
ananame
True
(runWith2BaseAnalyses Quiet baseAnalysisA baseAnalysisB anaFunc)
combinedSimpleTypeAnalysis :: Read b => String -> Analysis b
-> (ProgInfo b -> TypeDecl -> a) -> Analysis a
combinedSimpleTypeAnalysis ananame baseAnalysis anaFunc =
CombinedSimpleTypeAnalysis [analysisName baseAnalysis] ananame True
(runWithBaseAnalysis Quiet baseAnalysis anaFunc)
combinedDependencyFuncAnalysis :: Read b => String -> Analysis b -> a
-> (ProgInfo b -> FuncDecl -> [(QName,a)] -> a) -> Analysis a
combinedDependencyFuncAnalysis ananame baseAnalysis startval anaFunc =
CombinedDependencyFuncAnalysis
[analysisName baseAnalysis] ananame True startval
(runWithBaseAnalysis Quiet baseAnalysis anaFunc)
combinedDependencyTypeAnalysis :: Read b => String -> Analysis b -> a
-> (ProgInfo b -> TypeDecl -> [(QName,a)] -> a) -> Analysis a
combinedDependencyTypeAnalysis ananame baseAnalysis startval anaType =
CombinedDependencyTypeAnalysis
[analysisName baseAnalysis] ananame True startval
(runWithBaseAnalysis Quiet baseAnalysis anaType)
simpleModuleAnalysis :: String -> (Prog -> a) -> Analysis a
simpleModuleAnalysis anaName anaFunc =
SimpleModuleAnalysis anaName anaFunc
dependencyModuleAnalysis :: String -> (Prog -> [(String,a)] -> a) -> Analysis a
dependencyModuleAnalysis anaName anaFunc =
DependencyModuleAnalysis anaName anaFunc
isSimpleAnalysis :: Analysis a -> Bool
isSimpleAnalysis analysis = case analysis of
SimpleFuncAnalysis _ _ -> True
SimpleTypeAnalysis _ _ -> True
SimpleConstructorAnalysis _ _ -> True
CombinedSimpleFuncAnalysis _ _ _ _ -> True
CombinedSimpleTypeAnalysis _ _ _ _ -> True
_ -> False
isCombinedAnalysis :: Analysis a -> Bool
isCombinedAnalysis analysis = case analysis of
CombinedSimpleFuncAnalysis _ _ _ _ -> True
CombinedSimpleTypeAnalysis _ _ _ _ -> True
CombinedDependencyFuncAnalysis _ _ _ _ _ -> True
CombinedDependencyTypeAnalysis _ _ _ _ _ -> True
_ -> False
isFunctionAnalysis :: Analysis a -> Bool
isFunctionAnalysis analysis = case analysis of
SimpleFuncAnalysis _ _ -> True
DependencyFuncAnalysis _ _ _ -> True
CombinedSimpleFuncAnalysis _ _ _ _ -> True
CombinedDependencyFuncAnalysis _ _ _ _ _ -> True
_ -> False
analysisName :: Analysis a -> String
analysisName (SimpleFuncAnalysis name _ ) = name
analysisName (SimpleTypeAnalysis name _ ) = name
analysisName (SimpleConstructorAnalysis name _ ) = name
analysisName (DependencyFuncAnalysis name _ _) = name
analysisName (DependencyTypeAnalysis name _ _) = name
analysisName (CombinedSimpleFuncAnalysis _ nameB _ _) = nameB
analysisName (CombinedSimpleTypeAnalysis _ nameB _ _) = nameB
analysisName (CombinedDependencyFuncAnalysis _ nameB _ _ _) = nameB
analysisName (CombinedDependencyTypeAnalysis _ nameB _ _ _) = nameB
analysisName (SimpleModuleAnalysis name _) = name
analysisName (DependencyModuleAnalysis name _) = name
baseAnalysisNames :: Analysis a -> [String]
baseAnalysisNames ana = case ana of
CombinedSimpleFuncAnalysis bnames _ _ _ -> bnames
CombinedSimpleTypeAnalysis bnames _ _ _ -> bnames
CombinedDependencyFuncAnalysis bnames _ _ _ _ -> bnames
CombinedDependencyTypeAnalysis bnames _ _ _ _ -> bnames
_ -> []
startValue :: Analysis a -> a
startValue ana = case ana of
DependencyFuncAnalysis _ startval _ -> startval
DependencyTypeAnalysis _ startval _ -> startval
CombinedDependencyFuncAnalysis _ _ _ startval _ -> startval
CombinedDependencyTypeAnalysis _ _ _ startval _ -> startval
_ -> error "Internal error in Analysis.startValue"
data AOutFormat = AText | ANote
deriving Eq
runWithBaseAnalysis :: Read a
=> DLevel -> Analysis a -> (ProgInfo a -> (input -> b))
-> String -> IO (input -> b)
runWithBaseAnalysis dl baseAnalysis analysisFunction moduleName = do
importedModules <- getImports dl moduleName
let baseananame = analysisName baseAnalysis
impbaseinfos <- getInterfaceInfos dl baseananame importedModules
mainbaseinfos <- loadCompleteAnalysis dl baseananame moduleName
let baseinfos = combineProgInfo impbaseinfos mainbaseinfos
return (analysisFunction baseinfos)
runWith2BaseAnalyses :: (Read a, Read b)
=> DLevel -> Analysis a -> Analysis b
-> (ProgInfo a -> ProgInfo b -> (input -> c)) -> String
-> IO (input -> c)
runWith2BaseAnalyses dl baseanaA baseanaB analysisFunction moduleName = do
importedModules <- getImports dl moduleName
let baseananameA = analysisName baseanaA
baseananameB = analysisName baseanaB
impbaseinfosA <- getInterfaceInfos dl baseananameA importedModules
mainbaseinfosA <- loadCompleteAnalysis dl baseananameA moduleName
impbaseinfosB <- getInterfaceInfos dl baseananameB importedModules
mainbaseinfosB <- loadCompleteAnalysis dl baseananameB moduleName
let baseinfosA = combineProgInfo impbaseinfosA mainbaseinfosA
baseinfosB = combineProgInfo impbaseinfosB mainbaseinfosB
return (analysisFunction baseinfosA baseinfosB)
|