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
|
module Analysis.ProgInfo
( ProgInfo, emptyProgInfo, lookupProgInfo, combineProgInfo
, lists2ProgInfo, publicListFromProgInfo, progInfo2Lists, progInfo2XML
, mapProgInfo, publicProgInfo
, showProgInfo, equalProgInfo
, readAnalysisFiles, readAnalysisPublicFile, writeAnalysisFiles
) where
import Prelude hiding ( empty, lookup )
import System.Directory ( removeFile )
import System.FilePath ( (<.>) )
import Data.Map
import FlatCurry.Types
import XML
import Analysis.Logging ( DLevel, debugMessage )
data ProgInfo a = ProgInfo (Map QName a) (Map QName a)
emptyProgInfo:: ProgInfo a
emptyProgInfo = ProgInfo empty empty
lookupProgInfo:: QName -> ProgInfo a -> Maybe a
lookupProgInfo key (ProgInfo map1 map2) =
case lookup key map1 of
Just x -> Just x
Nothing -> lookup key map2
combineProgInfo :: ProgInfo a -> ProgInfo a -> ProgInfo a
combineProgInfo (ProgInfo x1 x2) (ProgInfo y1 y2) =
ProgInfo (union x1 y1) (union x2 y2)
lists2ProgInfo :: ([(QName,a)],[(QName,a)]) -> ProgInfo a
lists2ProgInfo (xs,ys) = ProgInfo (fromList xs) (fromList ys)
publicListFromProgInfo:: ProgInfo a -> [(QName,a)]
publicListFromProgInfo (ProgInfo fm1 _) = toList fm1
progInfo2Lists :: ProgInfo a -> ([(QName,a)],[(QName,a)])
progInfo2Lists (ProgInfo map1 map2)= (toList map1,toList map2)
progInfo2XML :: ProgInfo String -> ([XmlExp],[XmlExp])
progInfo2XML (ProgInfo map1 map2) =
(foldrWithKey entry2xml [] map1, foldrWithKey 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 (mapWithKey (\_ b->func b) map1) (mapWithKey (\_ b->func b) map2)
publicProgInfo :: ProgInfo a -> ProgInfo a
publicProgInfo (ProgInfo pub _) = ProgInfo pub empty
showProgInfo :: Show a => ProgInfo a -> String
showProgInfo (ProgInfo fm1 fm2) =
"Public: "++show fm1++"\nPrivate: "++show fm2
equalProgInfo :: Eq a => ProgInfo a -> ProgInfo a -> Bool
equalProgInfo (ProgInfo pi1p pi1v) (ProgInfo pi2p pi2v) =
pi1p == pi2p && pi1v == pi2v
writeAnalysisFiles :: Show a => DLevel -> String -> ProgInfo a -> IO ()
writeAnalysisFiles dl basefname (ProgInfo pub priv) = do
debugMessage dl 3 $ "Writing analysis files '"++basefname++"'..."
writeFile (basefname <.> "priv") (show priv)
writeFile (basefname <.> "pub") (show pub)
readAnalysisFiles :: Read a => DLevel -> String -> IO (ProgInfo a)
readAnalysisFiles dl basefname = do
debugMessage dl 3 $ "Reading analysis files '"++basefname++"'..."
let pubcontfile = basefname <.> "pub"
privcontfile = basefname <.> "priv"
pubcont <- readFile pubcontfile
privcont <- readFile privcontfile
let pinfo = ProgInfo (read pubcont) (read privcont)
catch (return $!! pinfo)
(\err -> do
putStrLn ("Buggy analysis files detected and removed:\n"++
basefname)
mapM_ removeFile [pubcontfile,privcontfile]
putStrLn "Please try to re-run the analysis!"
ioError err)
readAnalysisPublicFile :: Read a => DLevel -> String -> IO (ProgInfo a)
readAnalysisPublicFile dl fname = do
debugMessage dl 3 $ "Reading public analysis file '"++fname++"'..."
fcont <- readFile fname
let pinfo = ProgInfo (read fcont) empty
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)
|