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
|
module Analysis.ProgInfo
( ProgInfo, emptyProgInfo, lookupProgInfo, combineProgInfo
, lists2ProgInfo, publicListFromProgInfo, progInfo2Lists, progInfo2XML
, mapProgInfo, publicProgInfo
, showProgInfo, equalProgInfo
, readAnalysisFiles, readAnalysisPublicFile, writeAnalysisFiles
) where
import Directory (removeFile)
import FiniteMap
import FilePath ((<.>))
import FlatCurry.Types
import XML
import Analysis.Logging (debugMessage)
data ProgInfo a = ProgInfo (FM QName a) (FM QName a)
emptyProgInfo:: ProgInfo a
emptyProgInfo = ProgInfo (emptyFM (<)) (emptyFM (<))
lookupProgInfo:: QName -> ProgInfo a -> Maybe a
lookupProgInfo key (ProgInfo map1 map2) =
case lookupFM map1 key of
Just x -> Just x
Nothing -> lookupFM map2 key
combineProgInfo :: ProgInfo a -> ProgInfo a -> ProgInfo a
combineProgInfo (ProgInfo x1 x2) (ProgInfo y1 y2) =
ProgInfo (plusFM x1 y1) (plusFM x2 y2)
lists2ProgInfo :: ([(QName,a)],[(QName,a)]) -> ProgInfo a
lists2ProgInfo (xs,ys) = ProgInfo (listToFM (<) xs) (listToFM (<) ys)
publicListFromProgInfo:: ProgInfo a -> [(QName,a)]
publicListFromProgInfo (ProgInfo fm1 _) = fmToList fm1
progInfo2Lists :: ProgInfo a -> ([(QName,a)],[(QName,a)])
progInfo2Lists (ProgInfo map1 map2)= (fmToList map1,fmToList map2)
progInfo2XML :: ProgInfo String -> ([XmlExp],[XmlExp])
progInfo2XML (ProgInfo map1 map2) =
(foldFM entry2xml [] map1, foldFM entry2xml [] map2)
where
entry2xml (mname,name) value xmlList =
(xml "operation" [xml "module" [xtxt mname],
xml "name" [xtxt name],
xml "result" [xtxt value]]) : xmlList
mapProgInfo:: (a->b) -> ProgInfo a -> ProgInfo b
mapProgInfo func (ProgInfo map1 map2) =
ProgInfo (mapFM (\_ b->func b) map1) (mapFM (\_ b->func b) map2)
publicProgInfo :: ProgInfo a -> ProgInfo a
publicProgInfo (ProgInfo pub _) = ProgInfo pub (emptyFM (<))
showProgInfo :: ProgInfo _ -> String
showProgInfo (ProgInfo fm1 fm2) =
"Public: "++showFM fm1++"\nPrivate: "++showFM fm2
equalProgInfo :: Eq a => ProgInfo a -> ProgInfo a -> Bool
equalProgInfo (ProgInfo pi1p pi1v) (ProgInfo pi2p pi2v) =
eqFM pi1p pi2p && eqFM pi1v pi2v
writeAnalysisFiles :: String -> ProgInfo _ -> IO ()
writeAnalysisFiles basefname (ProgInfo pub priv) = do
debugMessage 3 $ "Writing analysis files '"++basefname++"'..."
writeFile (basefname <.> "priv") (showFM priv)
writeFile (basefname <.> "pub") (showFM pub)
readAnalysisFiles :: String -> IO (ProgInfo _)
readAnalysisFiles basefname = do
debugMessage 3 $ "Reading analysis files '"++basefname++"'..."
let pubcontfile = basefname <.> "pub"
privcontfile = basefname <.> "priv"
pubcont <- readFile pubcontfile
privcont <- readFile privcontfile
let pinfo = ProgInfo (readFM (<) pubcont) (readFM (<) privcont)
catch (return $!! pinfo)
(\err -> do
putStrLn ("Buggy analysis files detected and removed:\n"++
basefname)
mapIO_ removeFile [pubcontfile,privcontfile]
putStrLn "Please try to re-run the analysis!"
ioError err)
readAnalysisPublicFile :: String -> IO (ProgInfo _)
readAnalysisPublicFile fname = do
debugMessage 3 $ "Reading public analysis file '"++fname++"'..."
fcont <- readFile fname
let pinfo = ProgInfo (readFM (<) fcont) (emptyFM (<))
catch (return $!! pinfo)
(\err -> do
putStrLn ("Buggy analysis files detected and removed:\n"++fname)
removeFile fname
putStrLn "Please try to re-run the analysis!"
ioError err)
|