AnalysisHelpers.curry 3.78 KB
Newer Older
Michael Hanus 's avatar
Michael Hanus committed
1
------------------------------------------------------------------------------
2
-- Some auxiliary operations to analyze programs with CASS
Michael Hanus 's avatar
Michael Hanus committed
3
------------------------------------------------------------------------------
4

Michael Hanus 's avatar
Michael Hanus committed
5
module CC.AnalysisHelpers
6 7
  ( getTerminationInfos, getProductivityInfos, getUnsafeModuleInfos
  , dropPublicSuffix )
8
 where
9

Michael Hanus 's avatar
Michael Hanus committed
10 11
import AnsiCodes            ( blue )
import List                 ( intercalate, isSuffixOf )
12

13 14 15 16 17 18 19 20
import AbstractCurry.Types   ( QName )
import Analysis.Types        ( Analysis )
import Analysis.ProgInfo     ( ProgInfo, emptyProgInfo, combineProgInfo
                             , lookupProgInfo )
import Analysis.Termination  ( Productivity(..), productivityAnalysis
                             , terminationAnalysis )
import Analysis.UnsafeModule ( unsafeModuleAnalysis )
import CASS.Server           ( analyzeGeneric )
21

Michael Hanus 's avatar
Michael Hanus committed
22 23
import CC.Options

24
-- Analyzes a list of modules for their termination behavior.
25
-- If a module is a `_PUBLIC` module, we analyze the original module
26 27
-- and map these results to the `_PUBLIC` names, in order to support
-- caching of analysis results for the original modules.
Michael Hanus 's avatar
Michael Hanus committed
28 29 30
getTerminationInfos :: Options -> [String] -> IO (QName -> Bool)
getTerminationInfos opts mods = do
  ainfo <- analyzeModules opts "termination" terminationAnalysis
31 32 33
                          (map dropPublicSuffix mods)
  return (\qn -> maybe False id (lookupProgInfo (dropPublicQName qn) ainfo))

34
-- Analyzes a list of modules for their productivity behavior.
35 36 37
-- If a module is a `_PUBLIC` module, we analyze the original module
-- and map these results to the `_PUBLIC` names, in order to support
-- caching of analysis results for the original modules.
Michael Hanus 's avatar
Michael Hanus committed
38 39 40
getProductivityInfos :: Options -> [String] -> IO (QName -> Productivity)
getProductivityInfos opts mods = do
  ainfo <- analyzeModules opts "productivity" productivityAnalysis
41 42 43
                          (map dropPublicSuffix mods)
  return (\qn -> maybe NoInfo id (lookupProgInfo (dropPublicQName qn) ainfo))

44 45 46 47 48 49 50 51 52 53
-- Analyzes a list of modules for their productivity behavior.
-- If a module is a `_PUBLIC` module, we analyze the original module
-- and map these results to the `_PUBLIC` names, in order to support
-- caching of analysis results for the original modules.
getUnsafeModuleInfos :: Options -> [String] -> IO (QName -> [String])
getUnsafeModuleInfos opts mods = do
  ainfo <- analyzeModules opts "unsafe module" unsafeModuleAnalysis
                          (map dropPublicSuffix mods)
  return (\qn -> maybe [] id (lookupProgInfo (dropPublicQName qn) ainfo))

54 55 56 57 58 59 60 61 62

dropPublicSuffix :: String -> String
dropPublicSuffix s = if "_PUBLIC" `isSuffixOf` s
                       then take (length s - 7) s
                       else s

dropPublicQName :: QName -> QName
dropPublicQName (m,f) = (dropPublicSuffix m, f)

63 64 65 66

-- Analyze a list of modules with some static program analysis.
-- Returns the combined analysis information.
-- Raises an error if something goes wrong.
Michael Hanus 's avatar
Michael Hanus committed
67 68 69 70 71
analyzeModules :: Options -> String -> Analysis a -> [String] -> IO (ProgInfo a)
analyzeModules opts ananame analysis mods = do
  putStrIfNormal opts $ withColor opts blue $
    "\nRunning " ++ ananame ++ " analysis on modules: " ++
    intercalate ", " mods ++ "..."
72
  anainfos <- mapIO (analyzeModule analysis) mods
Michael Hanus 's avatar
Michael Hanus committed
73
  putStrIfNormal opts $ withColor opts blue $ "done...\n"
74 75 76 77 78 79 80 81 82 83 84 85 86 87
  return $ foldr combineProgInfo emptyProgInfo anainfos

-- Analyze a module with some static program analysis.
-- Raises an error if something goes wrong.
analyzeModule :: Analysis a -> String -> IO (ProgInfo a)
analyzeModule analysis mod = do
  aresult <- analyzeGeneric analysis mod
  either return
         (\e -> do putStrLn "WARNING: error occurred during analysis:"
                   putStrLn e
                   putStrLn "Ignoring analysis information"
                   return emptyProgInfo)
         aresult