Registry.curry 10.6 KB
Newer Older
1
2
3
4
5
6
7
--------------------------------------------------------------------
--- This module collects all analyses in the analysis system.
---
--- Each analysis available in the analysis system must be
--- registered in the top part of this module.
---
--- @author Heiko Hoffmann, Michael Hanus
8
--- @version June 2015
9
10
--------------------------------------------------------------------

11
module Registry
12
 ( functionAnalysisInfos, registeredAnalysisNames, registeredAnalysisInfos
13
14
 , lookupRegAnaWorker, runAnalysisWithWorkers, analyzeMain
 ) where
15

16
17
import FlatCurry.Types
import FlatCurry.Goodies(progImports)
18
19
20
21
22
import IO
import IOExts
import XML

import Analysis
23
import Configuration(debugMessage,numberOfWorkers)
24
25
26
import CurryFiles(getImports)
import GenericProgInfo
import AnalysisDependencies(getModulesToAnalyze)
Michael Hanus 's avatar
Michael Hanus committed
27
import ServerFunctions(masterLoop)
28
29
30
31
32
33
34
35
36
37
38
39
40
import WorkerFunctions(analysisClient)
import LoadAnalysis(loadCompleteAnalysis)

--------------------------------------------------------------------
-- Configurable part of this module.
--------------------------------------------------------------------

import Deterministic
import HigherOrder
import RightLinearity
import SolutionCompleteness
import TotallyDefined
import Indeterministic
41
import Demandedness
Michael Hanus 's avatar
Michael Hanus committed
42
import Groundness
43
44
import RequiredValue
import qualified RequiredValues as RVS
45
import RootReplaced
46
47
48
49
50
51

--------------------------------------------------------------------
--- Each analysis used in our tool must be registered in this list
--- together with an operation to show the analysis result as a string.
registeredAnalysis :: [RegisteredAnalysis]
registeredAnalysis =
52
53
  [cassAnalysis "Overlapping rules"          overlapAnalysis  showOverlap
  ,cassAnalysis "Deterministic operations"   nondetAnalysis   showDet
54
55
  ,cassAnalysis "Depends on non-deterministic operations"
                                             nondetDepAnalysis showNonDetDeps
56
57
58
59
60
61
62
63
64
65
66
67
  ,cassAnalysis "Right-linear operations"    rlinAnalysis     showRightLinear
  ,cassAnalysis "Solution completeness"      solcompAnalysis  showSolComplete
  ,cassAnalysis "Pattern completeness"       patCompAnalysis  showComplete
  ,cassAnalysis "Totally defined operations" totalAnalysis    showTotally
  ,cassAnalysis "Indeterministic operations" indetAnalysis    showIndet
  ,cassAnalysis "Demanded arguments"         demandAnalysis   showDemand
  ,cassAnalysis "Groundness"                 groundAnalysis   showGround
  ,cassAnalysis "Non-determinism effects"    ndEffectAnalysis showNDEffect
  ,cassAnalysis "Higher-order datatypes"     hiOrdType        showOrder
  ,cassAnalysis "Higher-order constructors"  hiOrdCons        showOrder
  ,cassAnalysis "Higher-order functions"     hiOrdFunc        showOrder
  ,cassAnalysis "Sibling constructors"       siblingCons      showSibling
68
69
  ,cassAnalysis "Required value"             reqValueAnalysis showAFType
  ,cassAnalysis "Required value sets"        RVS.reqValueAnalysis RVS.showAFType
70
  ,cassAnalysis "Root replacements"          rootReplAnalysis showRootRepl
71
72
73
74
75
76
77
78
  ]



--------------------------------------------------------------------
-- Static part of this module follows below
--------------------------------------------------------------------

79
80
81
82
--- This auxiliary operation creates a new program analysis to be used
--- by the server/client analysis tool from a given analysis and
--- analysis show function. The first argument is a short title for the
--- analysis.
83
84
cassAnalysis :: String -> Analysis a -> (AOutFormat -> a -> String)
             -> RegisteredAnalysis
85
86
87
88
89
90
91
cassAnalysis title analysis showres =
  RegAna (analysisName analysis)
         (isFunctionAnalysis analysis)
         title
         (analyzeAsString analysis showres)
         (analysisClient analysis)

92
--- The type of all registered analysis.
93
94
95
--- The components are as follows:
--- * the name of the analysis
--- * is this a function analysis?
96
--- * a long meaningful title of the analysis
97
98
99
--- * the operation used by the server to distribute analysis work
---   to the clients
--- * the worker operation to analyze a list of modules
100
101
data RegisteredAnalysis =
  RegAna String
102
103
         Bool
         String
104
         (String -> Bool -> [Handle] -> Maybe AOutFormat
105
                 -> IO (Either (ProgInfo String) String))
106
107
         ([String] -> IO ())

Michael Hanus 's avatar
Michael Hanus committed
108
regAnaName :: RegisteredAnalysis -> String
109
regAnaName (RegAna n _ _ _ _) = n
110

111
112
113
114
115
116
regAnaInfo :: RegisteredAnalysis -> (String,String)
regAnaInfo (RegAna n _ t _ _) = (n,t)

regAnaFunc :: RegisteredAnalysis -> Bool
regAnaFunc (RegAna _ fa _ _ _) = fa

Michael Hanus 's avatar
Michael Hanus committed
117
regAnaServer :: RegisteredAnalysis
118
                -> (String -> Bool -> [Handle] -> Maybe AOutFormat
Michael Hanus 's avatar
Michael Hanus committed
119
                    -> IO (Either (ProgInfo String) String))
120
regAnaServer (RegAna _ _ _ a _) = a
121

Michael Hanus 's avatar
Michael Hanus committed
122
regAnaWorker :: RegisteredAnalysis -> ([String] -> IO ())
123
regAnaWorker (RegAna _ _ _ _ a) = a
124
125

--- Names of all registered analyses.
Michael Hanus 's avatar
Michael Hanus committed
126
registeredAnalysisNames :: [String]
127
128
registeredAnalysisNames = map regAnaName registeredAnalysis

129
130
131
132
--- Names and titles of all registered analyses.
registeredAnalysisInfos :: [(String,String)]
registeredAnalysisInfos = map regAnaInfo registeredAnalysis

133
--- Names and titles of all registered function analyses.
Michael Hanus 's avatar
Michael Hanus committed
134
functionAnalysisInfos :: [(String,String)]
135
functionAnalysisInfos = map regAnaInfo (filter regAnaFunc registeredAnalysis)
136

137
138
lookupRegAna :: String -> [RegisteredAnalysis] -> Maybe RegisteredAnalysis
lookupRegAna _ [] = Nothing
139
lookupRegAna aname (ra@(RegAna raname _ _ _ _) : ras) =
140
141
142
  if aname==raname then Just ra else lookupRegAna aname ras

-- Look up a registered analysis server with a given analysis name.
143
lookupRegAnaServer :: String -> (String -> Bool -> [Handle] -> Maybe AOutFormat
144
                                        -> IO (Either (ProgInfo String) String))
145
lookupRegAnaServer aname =
146
  maybe (\_ _ _ _ -> return (Right ("unknown analysis: "++aname)))
147
148
149
150
151
152
153
154
155
156
157
        regAnaServer
        (lookupRegAna aname registeredAnalysis)

-- Look up a registered analysis worker with a given analysis name.
lookupRegAnaWorker :: String -> ([String] -> IO ())
lookupRegAnaWorker aname =
  maybe (const done) regAnaWorker (lookupRegAna aname registeredAnalysis)

--------------------------------------------------------------------
-- Run an analysis with a given name on a given module with a list
-- of workers identified by their handles and return the analysis results.
158
runAnalysisWithWorkers :: String -> AOutFormat -> Bool -> [Handle] -> String
159
                       -> IO (Either (ProgInfo String) String)
160
161
runAnalysisWithWorkers ananame aoutformat enforce handles moduleName =
  (lookupRegAnaServer ananame) moduleName enforce handles (Just aoutformat)
162
163
164
165
166

-- Run an analysis with a given name on a given module with a list
-- of workers identified by their handles but do not load analysis results.
runAnalysisWithWorkersNoLoad :: String -> [Handle] -> String -> IO ()
runAnalysisWithWorkersNoLoad ananame handles moduleName =
167
  (lookupRegAnaServer ananame) moduleName False handles Nothing >> done
168
169
170

--- Generic operation to analyze a module.
--- The parameters are the analysis, the show operation for analysis results,
171
172
173
--- the name of the main module to be analyzed,
--- a flag indicating whether the (re-)analysis should be enforced,
--- the handles for the workers,
174
175
176
177
--- and a flag indicating whether the analysis results should be loaded
--- and returned (if the flag is false, the result contains the empty
--- program information).
--- An error occurred during the analysis is returned as `(Right ...)`.
178
179
180
181
182
analyzeAsString :: Analysis a -> (AOutFormat->a->String) -> String -> Bool
                -> [Handle] -> Maybe AOutFormat
                -> IO (Either (ProgInfo String) String)
analyzeAsString analysis showres modname enforce handles mbaoutformat = do
  analyzeMain analysis modname handles enforce (mbaoutformat /= Nothing) >>=
183
184
185
    return . either (Left . mapProgInfo (showres aoutformat)) Right
 where
  aoutformat = maybe AText id mbaoutformat
186
187
188
189

--- Generic operation to analyze a module.
--- The parameters are the analysis, the name of the main module
--- to be analyzed, the handles for the workers,
190
--- a flag indicating whether the (re-)analysis should be enforced,
191
192
193
194
--- and a flag indicating whether the analysis results should be loaded
--- and returned (if the flag is false, the result contains the empty
--- program information).
--- An error occurred during the analysis is returned as `(Right ...)`.
195
analyzeMain :: Analysis a -> String -> [Handle] -> Bool -> Bool
196
            -> IO (Either (ProgInfo a) String)
197
analyzeMain analysis modname handles enforce load = do
198
  let ananame = analysisName analysis
199
  debugMessage 2 ("Start analysis: "++modname++"/"++ananame)
200
  modulesToDo <- getModulesToAnalyze enforce analysis modname
201
  let numModules = length modulesToDo
202
  workresult <-
203
    if numModules==0
204
205
    then return Nothing
    else do
206
     when (numModules>1) $
207
208
       debugMessage 1
         ("Number of modules to be analyzed: " ++ show numModules)
209
210
211
     prepareCombinedAnalysis analysis modname (map fst modulesToDo) handles
     numworkers <- numberOfWorkers
     if numworkers>0
212
       then do debugMessage 2 "Starting master loop"
Michael Hanus 's avatar
Michael Hanus committed
213
               masterLoop handles [] ananame modname modulesToDo []
214
215
216
217
218
219
220
221
       else analyzeLocally ananame (map fst modulesToDo)
  result <-
    maybe (if load
           then do debugMessage 3 ("Reading analysis of: "++modname)
                   loadCompleteAnalysis ananame modname >>= return . Left
           else return (Left emptyProgInfo))
          (return . Right)
          workresult
222
  debugMessage 4 ("Result: " ++ either showProgInfo id result)
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
  return result

-- Analyze a module and all its imports locally without worker processes.
analyzeLocally :: String -> [String] -> IO (Maybe String)
analyzeLocally ananame modules = do
  debugMessage 3 ("Local analysis of: "++ananame++"/"++show modules)
  (lookupRegAnaWorker ananame) modules -- run client
  return Nothing


-- Perform the first analysis part of a combined analysis
-- so that their results are available for the main analysis.
prepareCombinedAnalysis:: Analysis a -> String -> [String] -> [Handle] -> IO ()
prepareCombinedAnalysis analysis moduleName depmods handles =
  if isCombinedAnalysis analysis
  then
    if isSimpleAnalysis analysis
    then do
      -- the directly imported interface information might be required...
      importedModules <- getImports moduleName
      mapIO_ (runAnalysisWithWorkersNoLoad baseAnaName handles)
             (importedModules++[moduleName])
    else do
      -- for a dependency analysis, the information of all implicitly
      -- imported modules might be required:
      mapIO_ (runAnalysisWithWorkersNoLoad baseAnaName handles) depmods
  else done
 where
   baseAnaName = baseAnalysisName analysis

--------------------------------------------------------------------