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
|
--------------------------------------------------------------------------
--- This is the main module to start the executable of the analysis system.
---
--- @author Michael Hanus
--- @version January 2017
--------------------------------------------------------------------------
module Main(main) where
import Char (toLower)
import Distribution (stripCurrySuffix)
import FilePath ((</>), (<.>))
import GetOpt
import List (isPrefixOf)
import ReadNumeric (readNat)
import Sort (sort)
import System (exitWith,getArgs)
import AnalysisDoc (getAnalysisDoc)
import AnalysisServer
import Configuration
import LoadAnalysis (deleteAllAnalysisFiles)
import Registry
--- Main function to start the analysis system.
--- With option -s or --server, the server is started on a socket.
--- Otherwise, it is started in batch mode to analyze a single module.
main :: IO ()
main = do
argv <- getArgs
let (funopts, args, opterrors) = getOpt Permute options argv
let opts = foldl (flip id) defaultOptions funopts
unless (null opterrors)
(putStr (unlines opterrors) >> putStr usageText >> exitWith 1)
initializeAnalysisSystem
when (optHelp opts) (printHelp args >> exitWith 1)
when (optDelete opts) (deleteFiles args)
when ((optServer opts && not (null args)) ||
(not (optServer opts) && length args /= 2))
(error "Illegal arguments (try `-h' for help)" >> exitWith 1)
mapIO_ (\ (k,v) -> updateCurrentProperty k v) (optProp opts)
let verb = optVerb opts
when (verb >= 0) (updateCurrentProperty "debugLevel" (show verb))
debugMessage 1 systemBanner
if optServer opts
then mainServer (let p = optPort opts in if p == 0 then Nothing else Just p)
else do let [ananame,mname] = args
fullananame <- checkAnalysisName ananame
putStrLn $ "Computing results for analysis `" ++ fullananame ++ "'"
analyzeModuleAsText fullananame (stripCurrySuffix mname)
(optAll opts) (optReAna opts) >>= putStrLn
where
deleteFiles args = case args of
[aname] -> do fullaname <- checkAnalysisName aname
putStrLn $ "Deleting files for analysis `" ++ fullaname ++ "'"
deleteAllAnalysisFiles fullaname
exitWith 0
[] -> error "Missing analysis name!"
_ -> error "Too many arguments (only analysis name should be given)!"
-- Checks whether a given analysis name is a unique abbreviation
-- of a registered analysis name and return the registered name.
-- Otherwise, raise an error.
checkAnalysisName :: String -> IO String
checkAnalysisName aname = case matchedNames of
[] -> error $ "Unknown analysis name `"++ aname ++ "' " ++ tryCmt
[raname] -> return raname
(_:_:_) -> error $ "Analysis name `"++ aname ++ "' not unique " ++ tryCmt ++
":\nPossible names are: " ++ unwords matchedNames
where
matchedNames = filter (isPrefixOf (map toLower aname) . map toLower)
registeredAnalysisNames
tryCmt = "(try `-h' for help)"
--------------------------------------------------------------------------
-- Representation of command line options.
data Options = Options
{ optHelp :: Bool -- print help?
, optVerb :: Int -- verbosity level
, optServer :: Bool -- start CASS in server mode?
, optPort :: Int -- port number (if used in server mode)
, optAll :: Bool -- show analysis results for all operations?
, optReAna :: Bool -- force re-analysis?
, optDelete :: Bool -- delete analysis files?
, optProp :: [(String,String)] -- property (of ~/.curryanalsisrc) to be set
}
-- Default command line options.
defaultOptions :: Options
defaultOptions = Options
{ optHelp = False
, optVerb = -1
, optServer = False
, optPort = 0
, optAll = False
, optReAna = False
, optDelete = False
, optProp = []
}
-- Definition of actual command line options.
options :: [OptDescr (Options -> Options)]
options =
[ Option "h?" ["help"] (NoArg (\opts -> opts { optHelp = True }))
"print help and exit"
, Option "q" ["quiet"] (NoArg (\opts -> opts { optVerb = 0 }))
"run quietly (no output)"
, Option "v" ["verbosity"]
(ReqArg (safeReadNat checkVerb) "<n>")
"verbosity/debug level:\n0: quiet (same as `-q')\n1: show worker activity, e.g., timings\n2: show server communication\n3: ...and show read/store information\n4: ...show also stored/computed analysis data\n(default: see debugLevel in ~/.curryanalysisrc)"
, Option "a" ["all"]
(NoArg (\opts -> opts { optAll = True }))
"show-analysis results for all operations\n(i.e., also for non-exported operations)"
, Option "r" ["reanalyze"]
(NoArg (\opts -> opts { optReAna = True }))
"force re-analysis \n(i.e., ignore old analysis information)"
, Option "d" ["delete"]
(NoArg (\opts -> opts { optDelete = True }))
"delete existing analysis results"
, Option "s" ["server"]
(NoArg (\opts -> opts { optServer = True }))
"start analysis system in server mode"
, Option "p" ["port"]
(ReqArg (safeReadNat (\n opts -> opts { optPort = n })) "<n>")
"port number for communication\n(only for server mode;\n if omitted, a free port number is selected)"
, Option "D" []
(ReqArg checkSetProperty "name=v")
"set property (of ~/.curryanalysisrc)\n`name' as `v'"
]
where
safeReadNat opttrans s opts =
let numError = error "Illegal number argument (try `-h' for help)" in
maybe numError
(\ (n,rs) -> if null rs then opttrans n opts else numError)
(readNat s)
checkVerb n opts = if n>=0 && n<5
then opts { optVerb = n }
else error "Illegal verbosity level (try `-h' for help)"
checkSetProperty s opts =
let (key,eqvalue) = break (=='=') s
in if null eqvalue
then error "Illegal property setting (try `-h' for help)"
else opts { optProp = optProp opts ++ [(key,tail eqvalue)] }
--------------------------------------------------------------------------
-- Printing help:
printHelp :: [String] -> IO ()
printHelp args =
if null args
then putStrLn usageText
else do aname <- checkAnalysisName (head args)
getAnalysisDoc aname >>=
maybe (putStrLn $
"Sorry, no documentation for analysis `" ++ aname ++ "'")
putStrLn
-- Help text
usageText :: String
usageText =
usageInfo ("Usage: curry analyze <options> <analysis name> <module name>\n" ++
" or: curry analyze <options> [-s|--server]\n")
options ++
unlines ("" : "Registered analyses names:" :
"(use option `-h <analysis name>' for more documentation)" :
"" : map showAnaInfo (sort registeredAnalysisInfos))
where
maxName = foldr1 max (map (length . fst) registeredAnalysisInfos) + 1
showAnaInfo (n,t) = n ++ take (maxName - length n) (repeat ' ') ++ ": " ++ t
--------------------------------------------------------------------------
|
