Registry.curry 10.8 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 July 2016
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 "Functionally defined"       functionalAnalysis showFunctional
  ,cassAnalysis "Overlapping rules"          overlapAnalysis  showOverlap
54
  ,cassAnalysis "Deterministic operations"   nondetAnalysis   showDet
55
56
  ,cassAnalysis "Depends on non-deterministic operations"
                                             nondetDepAnalysis showNonDetDeps
57
58
  ,cassAnalysis "Depends on all non-deterministic operations"
                                             nondetDepAllAnalysis showNonDetDeps
59
60
61
62
63
64
65
66
67
68
69
70
  ,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
71
72
  ,cassAnalysis "Required value"             reqValueAnalysis showAFType
  ,cassAnalysis "Required value sets"        RVS.reqValueAnalysis RVS.showAFType
73
  ,cassAnalysis "Root replacements"          rootReplAnalysis showRootRepl
74
75
76
77
78
79
80
81
  ]



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

82
83
84
85
--- 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.
86
87
cassAnalysis :: String -> Analysis a -> (AOutFormat -> a -> String)
             -> RegisteredAnalysis
88
89
90
91
92
93
94
cassAnalysis title analysis showres =
  RegAna (analysisName analysis)
         (isFunctionAnalysis analysis)
         title
         (analyzeAsString analysis showres)
         (analysisClient analysis)

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

Michael Hanus 's avatar
Michael Hanus committed
111
regAnaName :: RegisteredAnalysis -> String
112
regAnaName (RegAna n _ _ _ _) = n
113

114
115
116
117
118
119
regAnaInfo :: RegisteredAnalysis -> (String,String)
regAnaInfo (RegAna n _ t _ _) = (n,t)

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

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

Michael Hanus 's avatar
Michael Hanus committed
125
regAnaWorker :: RegisteredAnalysis -> ([String] -> IO ())
126
regAnaWorker (RegAna _ _ _ _ a) = a
127
128

--- Names of all registered analyses.
Michael Hanus 's avatar
Michael Hanus committed
129
registeredAnalysisNames :: [String]
130
131
registeredAnalysisNames = map regAnaName registeredAnalysis

132
133
134
135
--- Names and titles of all registered analyses.
registeredAnalysisInfos :: [(String,String)]
registeredAnalysisInfos = map regAnaInfo registeredAnalysis

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

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

-- Look up a registered analysis server with a given analysis name.
146
lookupRegAnaServer :: String -> (String -> Bool -> [Handle] -> Maybe AOutFormat
147
                                        -> IO (Either (ProgInfo String) String))
148
lookupRegAnaServer aname =
149
  maybe (\_ _ _ _ -> return (Right ("unknown analysis: "++aname)))
150
151
152
153
154
155
156
157
158
159
160
        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.
161
runAnalysisWithWorkers :: String -> AOutFormat -> Bool -> [Handle] -> String
162
                       -> IO (Either (ProgInfo String) String)
163
164
runAnalysisWithWorkers ananame aoutformat enforce handles moduleName =
  (lookupRegAnaServer ananame) moduleName enforce handles (Just aoutformat)
165
166
167
168
169

-- 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 =
170
  (lookupRegAnaServer ananame) moduleName False handles Nothing >> done
171
172
173

--- Generic operation to analyze a module.
--- The parameters are the analysis, the show operation for analysis results,
174
175
176
--- the name of the main module to be analyzed,
--- a flag indicating whether the (re-)analysis should be enforced,
--- the handles for the workers,
177
178
179
180
--- 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 ...)`.
181
182
183
184
185
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) >>=
186
187
188
    return . either (Left . mapProgInfo (showres aoutformat)) Right
 where
  aoutformat = maybe AText id mbaoutformat
189
190
191
192

--- 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,
193
--- a flag indicating whether the (re-)analysis should be enforced,
194
195
196
197
--- 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 ...)`.
198
analyzeMain :: Analysis a -> String -> [Handle] -> Bool -> Bool
199
            -> IO (Either (ProgInfo a) String)
200
analyzeMain analysis modname handles enforce load = do
201
  let ananame = analysisName analysis
202
  debugMessage 2 ("Start analysis: "++modname++"/"++ananame)
203
  modulesToDo <- getModulesToAnalyze enforce analysis modname
204
  let numModules = length modulesToDo
205
  workresult <-
206
    if numModules==0
207
208
    then return Nothing
    else do
209
     when (numModules>1) $
210
211
       debugMessage 1
         ("Number of modules to be analyzed: " ++ show numModules)
212
213
214
     prepareCombinedAnalysis analysis modname (map fst modulesToDo) handles
     numworkers <- numberOfWorkers
     if numworkers>0
215
       then do debugMessage 2 "Starting master loop"
Michael Hanus 's avatar
Michael Hanus committed
216
               masterLoop handles [] ananame modname modulesToDo []
217
218
219
220
221
222
223
224
       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
225
  debugMessage 4 ("Result: " ++ either showProgInfo id result)
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
  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

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