Commit 4c89825b authored by Michael Hanus 's avatar Michael Hanus
Browse files

NonDetDeps analysis extended by storing "called-from" chain

parent eadbc426
......@@ -6,7 +6,7 @@
--- the analysis server (which is implicitly started if necessary).
---
--- @author Michael Hanus
--- @version July 2016
--- @version August 2016
--------------------------------------------------------------------------
module Configuration
......@@ -14,7 +14,7 @@ module Configuration
, getServerAddress, updateRCFile, updateCurrentProperty
, getFPMethod, getWithPrelude
, storeServerPortNumber, removeServerPortNumber, getServerPortNumber
, getDefaultPath, waitTime, numberOfWorkers, debugMessage
, getDefaultPath, waitTime, numberOfWorkers, debugMessage, debugString
) where
import System
......@@ -31,7 +31,7 @@ import Char(isSpace)
systemBanner :: String
systemBanner =
let bannerText = "CASS: Curry Analysis Server System ("++
"version of 28/07/2016 for "++curryCompiler++")"
"version of 25/08/2016 for "++curryCompiler++")"
bannerLine = take (length bannerText) (repeat '=')
in bannerLine ++ "\n" ++ bannerText ++ "\n" ++ bannerLine
......@@ -225,16 +225,21 @@ numberOfWorkers = do
Nothing -> return defaultWorkers
Nothing -> return defaultWorkers
--- Prints a message if debugging level (as specified in the Config file)
--- Prints a message line if debugging level (as specified in the Config file)
--- is at least n:
debugMessage :: Int -> String -> IO ()
debugMessage n message = do
debugMessage n message = debugString n (message++"\n")
--- Prints a string if debugging level (as specified in the Config file)
--- is at least n:
debugString :: Int -> String -> IO ()
debugString n message = do
properties <- getProperties
let number = lookup "debugLevel" properties
case number of
Just value -> do
case (readInt value) of
Just (dl,_) -> if dl>=n then putStrLn message else done
Just (dl,_) -> if dl>=n then putStr message else done
Nothing -> done
Nothing -> done
......
......@@ -3,7 +3,7 @@
--- In particular, it contains some simple fixpoint computations.
---
--- @author Heiko Hoffmann, Michael Hanus
--- @version March 2013
--- @version August 2016
--------------------------------------------------------------------------
module WorkerFunctions where
......@@ -55,6 +55,7 @@ analysisClientWithStore store analysis fpmethod moduleName = do
if isSimpleAnalysis analysis
then return emptyProgInfo
else getInterfaceInfosWS store (analysisName analysis) importList
debugString 1 $ "Analysis time for " ++ ananame ++ "/" ++ moduleName ++ ": "
starttime <- getCPUTime
startvals <- getStartValues analysis prog
result <-
......@@ -64,9 +65,7 @@ analysisClientWithStore store analysis fpmethod moduleName = do
else runAnalysis analysis prog importInfos startvals fpmethod
storeAnalysisResult ananame moduleName result
stoptime <- getCPUTime
debugMessage 1
("Analysis time for " ++ ananame ++ "/" ++ moduleName ++ " " ++
show (stoptime-starttime) ++ " msecs")
debugMessage 1 $ show (stoptime-starttime) ++ " msecs"
loadinfos <- readIORef store
writeIORef store ((moduleName,publicProgInfo result):loadinfos)
......
......@@ -5,7 +5,7 @@
--- different computation paths.
---
--- @author Michael Hanus
--- @version July 2016
--- @version August 2016
------------------------------------------------------------------------------
module Deterministic
......@@ -109,16 +109,34 @@ pre n = ("Prelude",n)
--- Basically, it is the set (represented as a sorted list) of
--- all function names that are defined by overlapping rules or rules
--- containing free variables which might be called.
type NonDetDeps = [QName]
--- In addition, the second component is (possibly) the list of
--- functions from which this non-deterministic function is called.
--- The length of this list is limited by 'maxDepsLength' in the
--- `NonDetAllDeps` analysis or to 1 (i.e., only the direct caller is
--- stored) in the `NonDetDeps` analysis.
type NonDetDeps = [(QName,[QName])]
--- The maximal length of a call chain associated with a non-deterministic
--- operation dependency. We limit the length in order to avoid large
--- analysis times for the `NonDetAllDeps` analysis.
maxDepsLength :: Int
maxDepsLength = 10
-- Show determinism dependency information as a string.
showNonDetDeps :: AOutFormat -> NonDetDeps -> String
showNonDetDeps AText [] = "deterministic"
showNonDetDeps ANote [] = ""
showNonDetDeps ANote xs@(_:_) = intercalate " " (map (snd . fst) xs)
showNonDetDeps AText xs@(_:_) =
"depends on non-deterministic operations: " ++
intercalate ", " (map (\ (mn,fn) -> mn++"."++fn) xs)
showNonDetDeps ANote xs@(_:_) = intercalate " " (map snd xs)
"depends on non-det. operations: " ++
intercalate ", " (map showNDOpInfo xs)
where
showNDOpInfo (ndop,cfs) = showQName ndop ++
(if null cfs
then ""
else " (called from " ++ intercalate " -> " (map showQName cfs) ++ ")")
showQName (mn,fn) = mn++"."++fn
--- Non-deterministic dependency analysis.
--- The analysis computes for each operation the set of operations
......@@ -143,16 +161,22 @@ nondetDepAllAnalysis =
-- or it depends on some called non-deterministic function.
nondetDeps :: Bool -> FuncDecl -> [(QName,NonDetDeps)] -> NonDetDeps
nondetDeps alldeps func@(Func f _ _ _ rule) calledFuncs =
if isNondetDefined func
then f : (if alldeps then sort (nub (calledNDFuncsInRule rule)) else [])
else sort (nub (calledNDFuncsInRule rule))
let calledndfuncs = sort (nub (map addCaller (calledNDFuncsInRule rule)))
addCaller (ndf,cfs)
| null cfs = (ndf,[f])
| alldeps && f `notElem` cfs
&& length cfs < maxDepsLength = (ndf,f:cfs)
| otherwise = (ndf,cfs)
in if isNondetDefined func
then (f,[]) : (if alldeps then calledndfuncs else [])
else calledndfuncs
where
calledNDFuncsInRule (Rule _ e) = calledNDFuncs e
calledNDFuncsInRule (External _) = []
calledNDFuncs (Var _) = []
calledNDFuncs (Lit _) = []
calledNDFuncs (Free vars e) = calledNDFuncs e
calledNDFuncs (Free _ e) = calledNDFuncs e
calledNDFuncs (Let bs e) =
concatMap calledNDFuncs (map snd bs) ++ calledNDFuncs e
calledNDFuncs (Or e1 e2) = calledNDFuncs e1 ++ calledNDFuncs e2
......@@ -165,6 +189,10 @@ nondetDeps alldeps func@(Func f _ _ _ rule) calledFuncs =
-- its called ND functions are not relevant:
if null es then [] -- this case should not occur
else concatMap calledNDFuncs (tail es)
| mn == "AllSolutions" -- && fn `elem`== "getAllValues"
= -- non-determinism of argument is encapsulated so that
-- its called ND functions are not relevant:
[]
| otherwise
= maybe [] id (lookup qf calledFuncs) ++ (concatMap calledNDFuncs es)
......
......@@ -198,7 +198,6 @@ makeSystemLibsIndex docdir modnames = do
where
fst3 (x,_,_) = x
snd3 (_,y,_) = y
trd3 (_,_,z) = z
sortByCategory = sortBy ((<=) `on` fst3)
groupByCategory = groupBy ((==) `on` fst3)
sortByName = sortBy ((<=) `on` snd3)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment