Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
curry
curry-tools
Commits
bb371ce1
Commit
bb371ce1
authored
Jul 29, 2016
by
Michael Hanus
Browse files
Non-determinism dependency analysis extended
parent
efa14f9c
Changes
14
Hide whitespace changes
Inline
Side-by-side
CASS/AnalysisDoc.curry
View file @
bb371ce1
...
...
@@ -16,6 +16,8 @@ import Configuration (docDir)
--------------------------------------------------------------------------
--- Gets the documentation of an analysis with a registered name.
--- Returns `Nothing` if no documentation exist.
--- The documentation of an analysis with name AN is usually stored
--- in the file `<CURRYROOT>/currytools/CASS/Docs/AN.md`.
getAnalysisDoc :: String -> IO (Maybe String)
getAnalysisDoc aname = do
let docfilename = docDir </> aname <.> "md"
...
...
CASS/Docs/Deterministic.md
View file @
bb371ce1
...
...
@@ -5,5 +5,5 @@ This analysis checks whether an operation is deterministically defined.
Intuitively, an operation is deterministic if the evaluation of
this operation applied to ground terms does not cause any non-determinism.
The determinism analysis returns
`nondeterministic`
for a given operation
if its definition contain overlapping left-hand sides or free variables,
if its definition contain
s
overlapping left-hand sides or free variables,
or if it depends on some non-deterministic operation.
CASS/Docs/NonDetAllDeps.md
0 → 100644
View file @
bb371ce1
Analysis of dependencies on all non-deterministic operations
------------------------------------------------------------
This analysis is useful if some operation has a non-deterministic
behavior and one wants to find the reason for this behavior.
For this purpose, the analysis computes for each operation the set of
operations with a non-deterministic definition that might be called
by this operation. An operation has a non-deterministic definition
if its definition contains overlapping left-hand sides or free variables.
If the non-determinism of an operation is encapsulated
by a set function, it is considered as deterministic.
For instance, consider the operations
last xs | _ ++ [x] == xs = x where x free
coin = 0 ? 1
lastCoin = id (last [coin])
Then the operation
`lastCoin`
depends on the non-deterministic
operations
`last`
and
`coin`
. Now consider the operations
f x = x ? lastCoin
g x = f x
Then the operation
`g`
depends on the non-deterministic operation
`f`
,
and also on the non-deterministic operations
`last`
and
`coin`
.
CASS/Docs/NonDetDeps.md
0 → 100644
View file @
bb371ce1
Analysis of dependencies on non-deterministic operations
--------------------------------------------------------
This analysis is useful if some operation has a non-deterministic
behavior and one wants to find the reason for this behavior.
For this purpose, the analysis computes for each operation the set of
operations with a non-deterministic definition that might be called
by this operation. An operation has a non-deterministic definition
if its definition contains overlapping left-hand sides or free variables.
Non-deterministic operations that are called by other
non-deterministic operations are ignored so that only the first
(w.r.t. the call sequence) non-deterministic operations are returned.
Moreover, if the non-determinism of an operation is encapsulated by a
set function, it is considered as deterministic.
For instance, consider the operations
last xs | _ ++ [x] == xs = x where x free
coin = 0 ? 1
lastCoin = id (last [coin])
Then the operation
`lastCoin`
depends on the non-deterministic
operations
`last`
and
`coin`
. Now consider the operations
f x = x ? lastCoin
g x = f x
Then the operation
`g`
depends on the non-deterministic operation
`f`
,
but the dependency on the non-deterministic
operations
`last`
and
`coin`
is not reported.
CASS/Examples/NonDetTest.curry
0 → 100644
View file @
bb371ce1
-- Tests for the RootReplaced analysis
--
-- Runt test with:
-- > cass NonDetDeps NonDetTest.curry
import SetFunctions
last xs | _ ++ [x] == xs = x where x free
lastfp (_ ++ [x]) = x
printLast = do
print $ last [1..7]
print $ lastfp [1..42]
coin = 0 ? 1
lastCoin = id (last [coin])
--> last, coin
f x = x ? lastCoin
g x = f x
-- For this operation, the NonDetDeps analysis reports that the
-- non-determinism depends on `f`.
-- However, the analysis NonDetAllDeps reports also the dependency
-- on the non-deterministic operations coin, last,...
main0 = set0 lastCoin
main1 = set1 last [1,2,3]
main2 = set1 last [1,2,coin]
CASS/Examples/RootReplacedTest.curry
0 → 100644
View file @
bb371ce1
-- Tests for the RootReplaced analysis
--
-- Runt test with:
-- > cass RootReplaced RootReplacedTest.curry
loop = loop
--> root replacements: [loop] --> indicates infinite loop
f x = g x
--> root replacements: [g,h]
g x = h x
--> root replacements: [h]
h x = k x : []
--> root replacements: []
k x = x
--> root replacements: []
CASS/GenericProgInfo.curry
View file @
bb371ce1
...
...
@@ -5,7 +5,13 @@
--- @version January 2015
-----------------------------------------------------------------------
module GenericProgInfo where
module GenericProgInfo
( ProgInfo, emptyProgInfo, lookupProgInfo, combineProgInfo
, lists2ProgInfo, publicListFromProgInfo, progInfo2Lists, progInfo2XML
, mapProgInfo, publicProgInfo
, showProgInfo, equalProgInfo
, readAnalysisFiles, readAnalysisPublicFile, writeAnalysisFiles
) where
import Configuration(debugMessage)
import Directory(removeFile)
...
...
@@ -66,6 +72,16 @@ mapProgInfo func (ProgInfo map1 map2) =
publicProgInfo :: ProgInfo a -> ProgInfo a
publicProgInfo (ProgInfo pub _) = ProgInfo pub (emptyFM (<))
--- Show a ProgInfo as a string (used for debugging only).
showProgInfo :: ProgInfo _ -> String
showProgInfo (ProgInfo fm1 fm2) =
"Public: "++showFM fm1++"\nPrivate: "++showFM fm2
-- Equality on ProgInfo
equalProgInfo :: ProgInfo a -> ProgInfo a -> Bool
equalProgInfo (ProgInfo pi1p pi1v) (ProgInfo pi2p pi2v) =
eqFM pi1p pi2p && eqFM pi1v pi2v
--- Writes a ProgInfo into a file.
writeAnalysisFiles :: String -> ProgInfo _ -> IO ()
writeAnalysisFiles basefname (ProgInfo pub priv) = do
...
...
@@ -103,12 +119,4 @@ readAnalysisPublicFile fname = do
putStrLn "Please try to re-run the analysis!"
ioError err)
--- Show a ProgInfo as a string (used for debugging only).
showProgInfo :: ProgInfo _ -> String
showProgInfo (ProgInfo fm1 fm2) =
"Public: "++showFM fm1++"\nPrivate: "++showFM fm2
-- Equality on ProgInfo
equalProgInfo :: ProgInfo a -> ProgInfo a -> Bool
equalProgInfo (ProgInfo pi1p pi1v) (ProgInfo pi2p pi2v) =
eqFM pi1p pi2p && eqFM pi1v pi2v
-----------------------------------------------------------------------
CASS/LoadAnalysis.curry
View file @
bb371ce1
...
...
@@ -3,22 +3,24 @@
--- persistently in files.
---
--- @author Heiko Hoffmann, Michael Hanus
--- @version J
anuar
y 201
5
--- @version J
ul
y 201
6
--------------------------------------------------------------------------
module LoadAnalysis where
import Directory
import Distribution(stripCurrySuffix)
import FlatCurry.Types(QName)
import FilePath
import System(system)
import GenericProgInfo
import Configuration(debugMessage,getWithPrelude)
import IO
import FiniteMap
import ReadShowTerm(readQTerm,showQTerm)
import FlatCurry.Types(QName)
import IO
import List(isPrefixOf, isSuffixOf)
import ReadShowTerm(readQTerm, showQTerm)
import System(system)
import Configuration(debugMessage, getWithPrelude)
import CurryFiles(findModuleSourceInLoadPath)
import GenericProgInfo
--- Get the file name in which analysis results are stored
...
...
@@ -122,9 +124,24 @@ createDirectoryR maindir =
createDirectory createdDir
createDirectories createdDir dirs
--
d
elete all
savefiles of
analysis
deleteAnalysisFiles :: String -> IO
Int
deleteAnalysisFiles ananame = do
--
- D
elete
s
all
analysis files for a given
analysis
name.
deleteA
llA
nalysisFiles :: String -> IO
()
deleteA
llA
nalysisFiles ananame = do
analysisDir <- getAnalysisDirectory
system ("find "++analysisDir++" -name '*."++ananame++"' -type f -delete")
deleteAllInDir analysisDir
where
deleteAllInDir dir = do
dircont <- getDirectoryContents dir
mapIO_ processDirElem (filter (not . isPrefixOf ".") dircont)
where
processDirElem f = do
let fullname = dir </> f
when (isAnaFile f) $ do
putStrLn ("DELETE: " ++ fullname)
removeFile fullname
isdir <- doesDirectoryExist fullname
when isdir $ deleteAllInDir fullname
isAnaFile f =
(".pub" `isSuffixOf` f && ('.':ananame) `isSuffixOf` dropExtension f) ||
(".priv" `isSuffixOf` f && ('.':ananame) `isSuffixOf` dropExtension f)
CASS/Main.curry
View file @
bb371ce1
...
...
@@ -2,7 +2,7 @@
--- This is the main module to start the executable of the analysis system.
---
--- @author Michael Hanus
--- @version Ju
ne
2016
--- @version Ju
ly
2016
--------------------------------------------------------------------------
module Main(main) where
...
...
@@ -16,6 +16,7 @@ import System (exitWith,getArgs)
import AnalysisDoc (getAnalysisDoc)
import AnalysisServer
import Configuration
import LoadAnalysis (deleteAllAnalysisFiles)
import Registry
--- Main function to start the analysis system.
...
...
@@ -30,6 +31,7 @@ main = do
(putStr (unlines opterrors) >> putStr usageText >> exitWith 1)
initializeAnalysisSystem
when (optHelp opts) (printHelp args >> exitWith 1)
when (optDelete opts) (deleteFiles args)
when ((optServer opts && not (null args)) ||
(not (optServer opts) && length args /= 2))
(error "Illegal arguments (try `-h' for help)" >> exitWith 1)
...
...
@@ -43,8 +45,18 @@ main = do
in if ananame `elem` registeredAnalysisNames
then analyzeModuleAsText ananame (stripCurrySuffix mname)
(optReAna opts) >>= putStrLn
else error $ "Unknown analysis name `"++ ananame ++
"' (try `-h' for help)"
else anaUnknownError ananame
where
deleteFiles args = case args of
[aname] -> if aname `elem` registeredAnalysisNames
then deleteAllAnalysisFiles aname >> exitWith 0
else anaUnknownError aname
[] -> error "Missing analysis name!"
_ -> error "Too many arguments (only analysis name should be given)!"
anaUnknownError aname =
error $ "Unknown analysis name `"++ aname ++ "' (try `-h' for help)"
--------------------------------------------------------------------------
-- Representation of command line options.
...
...
@@ -53,7 +65,8 @@ data Options = Options
, optVerb :: Int -- verbosity level
, optServer :: Bool -- start CASS in server mode?
, optPort :: Int -- port number (if used in server mode)
, optReAna :: Bool -- fore re-analysis?
, optReAna :: Bool -- force re-analysis?
, optDelete :: Bool -- delete analysis files?
, optProp :: [(String,String)] -- property (of ~/.curryanalsisrc) to be set
}
...
...
@@ -65,6 +78,7 @@ defaultOptions = Options
, optServer = False
, optPort = 0
, optReAna = False
, optDelete = False
, optProp = []
}
...
...
@@ -87,6 +101,9 @@ options =
, Option "r" ["reanalyze"]
(NoArg (\opts -> opts { optReAna = True }))
"force re-analysis \n(i.e., ignore old analysis information)"
, Option "d" ["delete"]
(NoArg (\opts -> opts { optDelete = True }))
"delete existing analysis results"
, Option "D" []
(ReqArg checkSetProperty "name=v")
"set property (of ~/.curryanalysisrc)\n`name' as `v'"
...
...
@@ -131,7 +148,7 @@ usageText =
"(use option `-h <analysis name>' for more documentation)" :
"" : map showAnaInfo registeredAnalysisInfos)
where
maxName = foldr1 max (map (length . fst) registeredAnalysisInfos)
maxName = foldr1 max (map (length . fst) registeredAnalysisInfos)
+ 1
showAnaInfo (n,t) = n ++ take (maxName - length n) (repeat ' ') ++ ": " ++ t
--------------------------------------------------------------------------
CASS/Registry.curry
View file @
bb371ce1
...
...
@@ -5,7 +5,7 @@
--- registered in the top part of this module.
---
--- @author Heiko Hoffmann, Michael Hanus
--- @version Ju
ne
201
5
--- @version Ju
ly
201
6
--------------------------------------------------------------------
module Registry
...
...
@@ -53,6 +53,8 @@ registeredAnalysis =
,cassAnalysis "Deterministic operations" nondetAnalysis showDet
,cassAnalysis "Depends on non-deterministic operations"
nondetDepAnalysis showNonDetDeps
,cassAnalysis "Depends on all non-deterministic operations"
nondetDepAllAnalysis showNonDetDeps
,cassAnalysis "Right-linear operations" rlinAnalysis showRightLinear
,cassAnalysis "Solution completeness" solcompAnalysis showSolComplete
,cassAnalysis "Pattern completeness" patCompAnalysis showComplete
...
...
analysis/Deterministic.curry
View file @
bb371ce1
...
...
@@ -5,16 +5,17 @@
--- different computation paths.
---
--- @author Michael Hanus
--- @version
September
201
3
--- @version
July
201
6
------------------------------------------------------------------------------
module Deterministic
( overlapAnalysis, showOverlap, showDet
, Deterministic(..),nondetAnalysis
, showNonDetDeps, nondetDepAnalysis
, showNonDetDeps, nondetDepAnalysis
, nondetDepAllAnalysis
) where
import Analysis
import Char(isDigit)
import FlatCurry.Types
import FlatCurry.Goodies
import List
...
...
@@ -114,23 +115,57 @@ type NonDetDeps = [QName]
showNonDetDeps :: AOutFormat -> NonDetDeps -> String
showNonDetDeps AText [] = "deterministic"
showNonDetDeps ANote [] = ""
showNonDetDeps fmt (x:xs) =
(if fmt==AText then "depends on non-deterministic operations: " else "") ++
intercalate "," (map (\ (mn,fn) -> mn++"."++fn) (x:xs))
showNonDetDeps AText xs@(_:_) =
"depends on non-deterministic operations: " ++
intercalate ", " (map (\ (mn,fn) -> mn++"."++fn) xs)
showNonDetDeps ANote xs@(_:_) = intercalate " " (map snd xs)
--- Non-deterministic dependency analysis.
--- The analysis computes for each operation the set of operations
--- with a non-deterministic definition which might be called by this
--- operation. Non-deterministic operations that are called by other
--- non-deterministic operations are ignored so that only the first
--- (w.r.t. the call sequence) non-deterministic operations are returned.
nondetDepAnalysis :: Analysis NonDetDeps
nondetDepAnalysis = dependencyFuncAnalysis "NonDetDependency" [] nondetDeps
nondetDepAnalysis =
dependencyFuncAnalysis "NonDetDeps" [] (nondetDeps False)
--- Non-deterministic dependency analysis.
--- The analysis computes for each operation the set of *all* operations
--- with a non-deterministic definition which might be called by this
--- operation.
nondetDepAllAnalysis :: Analysis NonDetDeps
nondetDepAllAnalysis =
dependencyFuncAnalysis "NonDetAllDeps" [] (nondetDeps True)
-- An operation is non-deterministic if its definition is potentially
-- non-deterministic (i.e., the dependency is the operation itself)
-- or it depends on some called non-deterministic function.
-- TODO: check if non-determinism is encapsulated by set function
-- so that it is actually a deterministic function
nondetDeps :: FuncDecl -> [(QName,NonDetDeps)] -> NonDetDeps
nondetDeps func calledFuncs =
nondetDeps :: Bool -> FuncDecl -> [(QName,NonDetDeps)] -> NonDetDeps
nondetDeps alldeps func@(Func f _ _ _ rule) calledFuncs =
if isNondetDefined func
then [funcName func]
else sort (nub (concatMap snd calledFuncs))
then f : (if alldeps then sort (nub (calledNDFuncsInRule rule)) else [])
else sort (nub (calledNDFuncsInRule rule))
where
calledNDFuncsInRule (Rule _ e) = calledNDFuncs e
calledNDFuncsInRule (External _) = []
calledNDFuncs (Var _) = []
calledNDFuncs (Lit _) = []
calledNDFuncs (Free vars e) = calledNDFuncs e
calledNDFuncs (Let bs e) =
concatMap calledNDFuncs (map snd bs) ++ calledNDFuncs e
calledNDFuncs (Or e1 e2) = calledNDFuncs e1 ++ calledNDFuncs e2
calledNDFuncs (Case _ e bs) =
calledNDFuncs e ++ concatMap (\ (Branch _ be) -> calledNDFuncs be) bs
calledNDFuncs (Typed e _) = calledNDFuncs e
calledNDFuncs (Comb _ qf@(mn,fn) es)
| mn == "SetFunctions" && take 3 fn == "set" && all isDigit (drop 3 fn)
= -- non-determinism of function (first argument) is encapsulated so that
-- its called ND functions are not relevant:
if null es then [] -- this case should not occur
else concatMap calledNDFuncs (tail es)
| otherwise
= maybe [] id (lookup qf calledFuncs) ++ (concatMap calledNDFuncs es)
------------------------------------------------------------------------------
analysis/RootReplaced.curry
View file @
bb371ce1
...
...
@@ -33,9 +33,9 @@ type RootReplaced = [QName]
showRootRepl :: AOutFormat -> RootReplaced -> String
showRootRepl AText [] = "no root replacements"
showRootRepl ANote [] = ""
showRootRepl
fmt (x:xs
) =
(if fmt==AText then
"root replacements: "
else "") ++
intercalate "," (map (\ (mn,fn) -> mn++"."++fn) (x:xs))
showRootRepl
AText xs@(_:_
) =
"root replacements: "
++ intercalate "," (map (\ (mn,fn) -> mn++"."++fn) xs)
showRootRepl ANote xs@(_:_) = "[" ++ intercalate "," (map snd xs) ++ "]"
--- Root replacement analysis.
rootReplAnalysis :: Analysis RootReplaced
...
...
browser/BrowserGUI.curry
View file @
bb371ce1
...
...
@@ -3,38 +3,39 @@
--- programs.
---
--- @author Michael Hanus
--- @version
April
2016
--- @version
July
2016
---------------------------------------------------------------------
module BrowserGUI where
import GUI
import Read
import IOExts
import Imports
import Directory
import Distribution
import FileGoodies
import FlatCurry.Types
import FlatCurry.Files
import FlatCurry.Goodies
import FlatCurry.Show
import
ShowFlatCurry(leqFunc,funcModule)
import
System
import
FileGoodie
s
import List
import
GUI
import
Imports
import
IOExt
s
import List
(isPrefixOf,delete,union)
import Maybe
import Read
import Sort (sortBy)
import System
import Time (toCalendarTime,calendarTimeToString)
import AnalysisTypes
import BrowserAnalysis
import Sort
import Dependency(callsDirectly,indirectlyDependent)
import ShowGraph
import Dependency (callsDirectly,indirectlyDependent)
import ImportCalls
import Directory
import Time(toCalendarTime,calendarTimeToString)
import Distribution
import ShowFlatCurry (leqFunc,funcModule)
import ShowGraph
import Analysis (AOutFormat(..))
import AnalysisDoc (getAnalysisDoc)
import AnalysisServer (initializeAnalysisSystem,analyzeModuleForBrowser)
import Registry (functionAnalysisInfos)
import Analysis
(AOutFormat(..))
import AnalysisDoc
(getAnalysisDoc)
import AnalysisServer
(initializeAnalysisSystem,analyzeModuleForBrowser)
import Registry
(functionAnalysisInfos)
---------------------------------------------------------------------
-- Set this constant to True if the execution times of the main operations
...
...
@@ -48,7 +49,7 @@ title :: String
title = "CurryBrowser"
version :: String
version = "Version of
16
/0
1
/201
5
"
version = "Version of
29
/0
7
/201
6
"
patchReadmeVersion :: IO ()
patchReadmeVersion = do
...
...
@@ -204,7 +205,7 @@ getFuns gs = readIORef gs >>= \ (GS _ _ _ funs _ _ _) -> return funs
storeSelectedFunctions :: IORef GuiState -> [FuncDecl] -> IO ()
storeSelectedFunctions gs funs = do
(GS t mm ms _ ct flag fana) <- readIORef gs
writeIORef gs (GS t mm ms (
mergeS
ortBy leqFunc funs) ct flag fana)
writeIORef gs (GS t mm ms (
s
ortBy leqFunc funs) ct flag fana)
setMainContentsModule :: IORef GuiState -> String -> ContentsKind -> String
-> IO ()
...
...
@@ -341,7 +342,7 @@ browserGUI gstate rmod rtxt names =
Menu (map (\ (aname,atitle) ->
MButton (showMBusy (analyzeAllFunsWithCASS aname atitle))
atitle)
functionAnalysisInfos)],
(sortBy (\i1 i2 -> snd i1 <= snd i2)
functionAnalysisInfos)
)
],
row [MenuButton
[Text "Select functions...",
Menu [MButton (showMBusy (executeForModule showExportedFuns))
...
...
@@ -581,7 +582,7 @@ browserGUI gstate rmod rtxt names =
if mod==Nothing || null self then done else
getFuns gstate >>= \funs ->
let mainfun = funs!!(readNat self)
qfnames =
mergeS
ortBy leqQName
qfnames =
s
ortBy leqQName
(union [funcName mainfun] (callsDirectly mainfun))
in getAllFunctions gstate (showDoing gp) (fromJust mod) >>= \allfuns ->
storeSelectedFunctions gstate (map (findDecl4name allfuns) qfnames) >>
...
...
@@ -596,7 +597,7 @@ browserGUI gstate rmod rtxt names =
getFuns gstate >>= \funs ->
let mainfun = funcName (funs!!(readNat self)) in
getAllFunctions gstate (showDoing gp) (fromJust mod) >>= \allfuns ->
let qfnames =
mergeS
ortBy leqQName
let qfnames =
s
ortBy leqQName
(union [mainfun]
(fromJust (lookup mainfun (indirectlyDependent allfuns))))
in storeSelectedFunctions gstate (map (findDecl4name allfuns) qfnames) >>
...
...
@@ -773,7 +774,7 @@ browserDir = installDir++"/currytools/browser"
-- order qualified names by basename first:
leqQName :: QName -> QName -> Bool
leqQName (mod1,n1) (mod2,n2) =
leqString n1
n2 || n1==n2 &&
leqString
mod1 mod2
leqQName (mod1,n1) (mod2,n2) =
n1 <=
n2 || n1==n2 && mod1
<=
mod2
-- show qualified name with module:
showQNameWithMod :: QName -> String
...
...
browser/README
View file @
bb371ce1
...
...
@@ -12,7 +12,7 @@ they have no effect.
Developed by
Michael Hanus (CAU Kiel, Germany, mh@informatik.uni-kiel.de)
Version of
16
/0
1
/201
5
Version of
29
/0
7
/201
6
Software requirements:
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment