Registry.curry 10.1 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
12
13
14
module Registry
 ( functionAnalysisInfos, registeredAnalysisNames
 , 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
46
47
48
49
50

--------------------------------------------------------------------
--- 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 =
51
52
53
54
55
56
57
58
59
60
61
62
63
64
  [cassAnalysis "Overlapping rules"          overlapAnalysis  showOverlap
  ,cassAnalysis "Deterministic operations"   nondetAnalysis   showDet
  ,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
65
66
  ,cassAnalysis "Required value"             reqValueAnalysis showAFType
  ,cassAnalysis "Required value sets"        RVS.reqValueAnalysis RVS.showAFType
67
68
69
70
71
72
73
74
  ]



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

75
76
77
78
--- 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.
79
80
cassAnalysis :: String -> Analysis a -> (AOutFormat -> a -> String)
             -> RegisteredAnalysis
81
82
83
84
85
86
87
cassAnalysis title analysis showres =
  RegAna (analysisName analysis)
         (isFunctionAnalysis analysis)
         title
         (analyzeAsString analysis showres)
         (analysisClient analysis)

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

Michael Hanus 's avatar
Michael Hanus committed
104
regAnaName :: RegisteredAnalysis -> String
105
regAnaName (RegAna n _ _ _ _) = n
106

Michael Hanus 's avatar
Michael Hanus committed
107
regAnaServer :: RegisteredAnalysis
108
                -> (String -> Bool -> [Handle] -> Maybe AOutFormat
Michael Hanus 's avatar
Michael Hanus committed
109
                    -> IO (Either (ProgInfo String) String))
110
regAnaServer (RegAna _ _ _ a _) = a
111

Michael Hanus 's avatar
Michael Hanus committed
112
regAnaWorker :: RegisteredAnalysis -> ([String] -> IO ())
113
regAnaWorker (RegAna _ _ _ _ a) = a
114
115

--- Names of all registered analyses.
Michael Hanus 's avatar
Michael Hanus committed
116
registeredAnalysisNames :: [String]
117
118
registeredAnalysisNames = map regAnaName registeredAnalysis

119
--- Names and titles of all registered function analyses.
Michael Hanus 's avatar
Michael Hanus committed
120
functionAnalysisInfos :: [(String,String)]
121
122
123
124
functionAnalysisInfos =
  map (\ (RegAna n _ t _ _) -> (n,t))
      (filter (\ (RegAna _ fa _ _ _) -> fa) registeredAnalysis)

125
126
lookupRegAna :: String -> [RegisteredAnalysis] -> Maybe RegisteredAnalysis
lookupRegAna _ [] = Nothing
127
lookupRegAna aname (ra@(RegAna raname _ _ _ _) : ras) =
128
129
130
  if aname==raname then Just ra else lookupRegAna aname ras

-- Look up a registered analysis server with a given analysis name.
131
lookupRegAnaServer :: String -> (String -> Bool -> [Handle] -> Maybe AOutFormat
132
                                        -> IO (Either (ProgInfo String) String))
133
lookupRegAnaServer aname =
134
  maybe (\_ _ _ _ -> return (Right ("unknown analysis: "++aname)))
135
136
137
138
139
140
141
142
143
144
145
        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.
146
runAnalysisWithWorkers :: String -> AOutFormat -> Bool -> [Handle] -> String
147
                       -> IO (Either (ProgInfo String) String)
148
149
runAnalysisWithWorkers ananame aoutformat enforce handles moduleName =
  (lookupRegAnaServer ananame) moduleName enforce handles (Just aoutformat)
150
151
152
153
154

-- 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 =
155
  (lookupRegAnaServer ananame) moduleName False handles Nothing >> done
156
157
158

--- Generic operation to analyze a module.
--- The parameters are the analysis, the show operation for analysis results,
159
160
161
--- the name of the main module to be analyzed,
--- a flag indicating whether the (re-)analysis should be enforced,
--- the handles for the workers,
162
163
164
165
--- 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 ...)`.
166
167
168
169
170
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) >>=
171
172
173
    return . either (Left . mapProgInfo (showres aoutformat)) Right
 where
  aoutformat = maybe AText id mbaoutformat
174
175
176
177

--- 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,
178
--- a flag indicating whether the (re-)analysis should be enforced,
179
180
181
182
--- 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 ...)`.
183
analyzeMain :: Analysis a -> String -> [Handle] -> Bool -> Bool
184
            -> IO (Either (ProgInfo a) String)
185
analyzeMain analysis modname handles enforce load = do
186
  let ananame = analysisName analysis
187
  debugMessage 2 ("Start analysis: "++modname++"/"++ananame)
188
  modulesToDo <- getModulesToAnalyze enforce analysis modname
189
  let numModules = length modulesToDo
190
  workresult <-
191
    if numModules==0
192
193
    then return Nothing
    else do
194
     when (numModules>1) $
195
196
       debugMessage 1
         ("Number of modules to be analyzed: " ++ show numModules)
197
198
199
     prepareCombinedAnalysis analysis modname (map fst modulesToDo) handles
     numworkers <- numberOfWorkers
     if numworkers>0
200
       then do debugMessage 2 "Starting master loop"
Michael Hanus 's avatar
Michael Hanus committed
201
               masterLoop handles [] ananame modname modulesToDo []
202
203
204
205
206
207
208
209
       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
210
  debugMessage 4 ("Result: " ++ either showProgInfo id result)
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
  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

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