Commit 381b596f authored by Michael Hanus 's avatar Michael Hanus

Termination analysis integrated so that only terminating and productive...

Termination analysis integrated so that only terminating and productive functions are passed to CurryCheck for diff
parent 44629947
# Root direcotry of Curry system:
ROOT = $(HOME)/pakcs
# Curry system binary:
export CURRY = curry
export CURRY = $(ROOT)/bin/curry
# The default options for the REPL
export REPL_OPTS = --noreadline :set -time
# Load path for building:
CPATH = $(ROOT)/currytools/analysis:$(ROOT)/currytools/CASS
.PHONY: build
build: fetchdeps
@export CURRYPATH=""; \
@export CURRYPATH="$(CPATH)"; \
for i in `ls vendor`; do \
export CURRYPATH="$$CURRYPATH:`pwd`/vendor/$$i/src"; \
done; \
......
......@@ -5,16 +5,17 @@
--------------------------------------------------------------------------------
module CPM.AbstractCurry
( readAbstractCurryFromPath
( loadPathForPackage
, readAbstractCurryFromPath
, readAbstractCurryFromDeps
, transformAbstractCurryInDeps
, applyModuleRenames
) where
import Distribution (FrontendTarget (..), FrontendParams (..), defaultParams
, callFrontendWithParams, setQuiet, setFullPath
, callFrontendWithParams, setQuiet, setFullPath, sysLibPath
, curryCompiler, installDir, inCurrySubdir, modNameToPath
, inCurrySubdirModule)
, inCurrySubdirModule, lookupModuleSource)
import List (intercalate, nub)
import Directory (doesFileExist)
import FilePath ((</>), (<.>), takeFileName, replaceExtension)
......@@ -28,6 +29,25 @@ import System
import qualified CPM.PackageCache.Runtime as RuntimeCache
import CPM.Package (Package)
--- Returns the load path for a package stored in some directory
--- w.r.t. the dependent packages
---
--- @param - pkgDir - the package's directory
--- @param - deps - the resolved dependencies of the package
--- @return the full load path for modules in the package or dependent packages
loadPathForPackage :: String -> [Package] -> [String]
loadPathForPackage pkgDir deps =
[pkgDir </> "src"] ++ RuntimeCache.dependencyPathsSeparate deps pkgDir
--- Returns the full load path for a package stored in some directory.
---
--- @param - pkgDir - the package's directory
--- @param - deps - the resolved dependencies of the package
--- @return the full load path for modules in the package or dependent packages
fullLoadPathForPackage :: String -> [Package] -> [String]
fullLoadPathForPackage pkgDir deps =
sysLibPath ++ loadPathForPackage pkgDir deps
--- Reads an AbstractCurry module from a package.
---
--- @param - dir the package's directory
......@@ -35,9 +55,7 @@ import CPM.Package (Package)
--- @param - mod the module to read
readAbstractCurryFromPath :: String -> [Package] -> String -> IO CurryProg
readAbstractCurryFromPath pkgDir deps modname = do
sysLib <- getSysLibPath
loadPath <- return $ sysLib ++ [pkgDir </> "src"] ++
RuntimeCache.dependencyPathsSeparate deps pkgDir
let loadPath = fullLoadPathForPackage pkgDir deps
params <- return $ setQuiet True (setFullPath loadPath defaultParams)
callFrontendWithParams ACY params modname
readAbstractCurryFile acyName
......@@ -51,11 +69,9 @@ readAbstractCurryFromPath pkgDir deps modname = do
--- @param mod - the module to read
readAbstractCurryFromDeps :: String -> [Package] -> String -> IO CurryProg
readAbstractCurryFromDeps pkgDir deps modname = do
sysLib <- getSysLibPath
loadPath <- return $ sysLib ++ [pkgDir </> "src"] ++
RuntimeCache.dependencyPathsSeparate deps pkgDir
let loadPath = fullLoadPathForPackage pkgDir deps
params <- return $ setQuiet True (setFullPath loadPath defaultParams)
src <- lookupModuleSource modname loadPath
src <- lookupModuleSource loadPath modname
sourceFile <- return $ case src of
Nothing -> error $ "Module not found: " ++ modname
Just (_, file) -> replaceExtension (inCurrySubdirModule modname file) ".acy"
......@@ -73,10 +89,9 @@ readAbstractCurryFromDeps pkgDir deps modname = do
transformAbstractCurryInDeps :: String -> [Package] -> (CurryProg -> CurryProg)
-> String -> String -> IO ()
transformAbstractCurryInDeps pkgDir deps transform modname destFile = do
sysLib <- getSysLibPath
loadPath <- return $ sysLib ++ [pkgDir </> "src"] ++ (RuntimeCache.dependencyPathsSeparate deps pkgDir)
let loadPath = fullLoadPathForPackage pkgDir deps
params <- return $ setQuiet True (setFullPath loadPath defaultParams)
src <- lookupModuleSource modname loadPath
src <- lookupModuleSource loadPath modname
sourceFile <- return $ case src of
Nothing -> error $ "Module not found: " ++ modname
Just (_, file) -> replaceExtension (inCurrySubdirModule modname file) ".acy"
......@@ -99,28 +114,3 @@ applyModuleRenames names prog =
Just mod' -> (mod', n)
Nothing -> mn
--- Get the system library path of the current compiler. Copied from
--- Distribution.
getSysLibPath :: IO [String]
getSysLibPath = case curryCompiler of
"pakcs" -> return [installDir </> "lib"]
"kics" -> return [installDir </> "src" </> "lib"]
"kics2" -> return [installDir </> "lib"]
_ -> error "CPM.FlatCurryGoodies.getSysLibPath: unknown curryCompiler"
--- Lookup the location of a module in a list of possible directories. Adapted
--- from Distribution.
lookupModuleSource :: String -> [String] -> IO (Maybe (String, String))
lookupModuleSource mod path = lookupSourceInPath path
where
fn = takeFileName mod
fnlcurry = modNameToPath fn ++ ".lcurry"
fncurry = modNameToPath fn ++ ".curry"
lookupSourceInPath [] = return Nothing
lookupSourceInPath (dir:dirs) = do
lcurryExists <- doesFileExist (dir </> fnlcurry)
if lcurryExists then return (Just (dir, dir </> fnlcurry)) else do
curryExists <- doesFileExist (dir </> fncurry)
if curryExists then return (Just (dir, dir </> fncurry))
else lookupSourceInPath dirs
This diff is collapsed.
......@@ -9,15 +9,16 @@ import List (isSuffixOf)
-- This is adapted from the currydoc source code.
--- Reads the comments from a Curry program. The first component of the result
--- Reads the pragma comments from a Curry program.
--- The first component of the result
--- is the comment for the module definition. The second component is a map
--- from different source line types to comments on that source line.
--- from different source line types to pragma comments on that source line.
readComments :: String -> IO (String, [(SourceLine, String)])
readComments filename = do
prog <- readFile filename
return (groupLines . filter (/= OtherLine) . map classifyLine . lines $ prog)
data SourceLine = PragmaComment String
data SourceLine = PragmaCmt String
| ModDef
| DataDef String
| FuncDef String
......@@ -25,7 +26,7 @@ data SourceLine = PragmaComment String
classifyLine :: String -> SourceLine
classifyLine line
| take 3 line == "{-#" = PragmaComment (drop 3 line)
| take 3 line == "{-#" = PragmaCmt (drop 3 line) -- #-}
| take 7 line == "module " = ModDef
| take 7 line == "import " = ModDef
| otherwise = if null id1
......@@ -64,46 +65,47 @@ groupLines sls =
groupProgLines (filter (/= ModDef) (tail progCmts)))
where
getComment src = case src of
PragmaComment cmt -> cmt ++ "\n"
_ -> ""
PragmaCmt cmt -> cmt ++ "\n"
_ -> ""
groupProgLines :: [SourceLine] -> [(SourceLine, String)]
groupProgLines [] = []
groupProgLines (PragmaComment cmt : sls) = groupComment cmt sls
groupProgLines (FuncDef f : sls) = (FuncDef f, "") : skipFuncDefs f sls
groupProgLines (DataDef d : sls) = (DataDef d, "") : skipDataDefs d sls
groupProgLines (ModDef : sls) = groupProgLines sls
groupProgLines (OtherLine : sls) = groupProgLines sls
groupProgLines (PragmaCmt cmt : sls) = groupComment cmt sls
groupProgLines (FuncDef f : sls) = (FuncDef f, "") : skipFuncDefs f sls
groupProgLines (DataDef d : sls) = (DataDef d, "") : skipDataDefs d sls
groupProgLines (ModDef : sls) = groupProgLines sls
groupProgLines (OtherLine : sls) = groupProgLines sls
groupComment :: String -> [SourceLine] -> [(SourceLine, String)]
groupComment _ [] = []
groupComment cmt (PragmaComment cmt1 : sls) = groupComment (cmt ++ "\n" ++ cmt1) sls
groupComment cmt (FuncDef f : sls) = (FuncDef f, cmt) : skipFuncDefs f sls
groupComment cmt (DataDef d : sls) = (DataDef d, cmt) : skipDataDefs d sls
groupComment cmt (ModDef : sls) = groupComment cmt sls
groupComment cmt (OtherLine : sls) = groupComment cmt sls
groupComment cmt (PragmaCmt cmt1 : sls) = groupComment (cmt ++ "\n" ++ cmt1) sls
groupComment cmt (FuncDef f : sls) = (FuncDef f, cmt) : skipFuncDefs f sls
groupComment cmt (DataDef d : sls) = (DataDef d, cmt) : skipDataDefs d sls
groupComment cmt (ModDef : sls) = groupComment cmt sls
groupComment cmt (OtherLine : sls) = groupComment cmt sls
skipFuncDefs :: String -> [SourceLine] -> [(SourceLine, String)]
skipFuncDefs _ [] = []
skipFuncDefs _ (PragmaComment cmt : sls) = groupProgLines (PragmaComment cmt : sls)
skipFuncDefs _ (DataDef d : sls) = groupProgLines (DataDef d : sls)
skipFuncDefs f (FuncDef f1 : sls) =
skipFuncDefs _ (PragmaCmt cmt : sls) = groupProgLines (PragmaCmt cmt : sls)
skipFuncDefs _ (DataDef d : sls) = groupProgLines (DataDef d : sls)
skipFuncDefs f (FuncDef f1 : sls) =
if f == f1 then skipFuncDefs f sls
else groupProgLines (FuncDef f1 : sls)
skipFuncDefs f (ModDef : sls) = skipFuncDefs f sls
skipFuncDefs f (OtherLine : sls) = skipFuncDefs f sls
skipFuncDefs f (ModDef : sls) = skipFuncDefs f sls
skipFuncDefs f (OtherLine : sls) = skipFuncDefs f sls
skipDataDefs :: String -> [SourceLine] -> [(SourceLine, String)]
skipDataDefs _ [] = []
skipDataDefs _ (PragmaComment cmt : sls) = groupProgLines (PragmaComment cmt : sls)
skipDataDefs _ (FuncDef f : sls) = groupProgLines (FuncDef f : sls)
skipDataDefs d (DataDef d1 : sls) =
skipDataDefs _ (PragmaCmt cmt : sls) = groupProgLines (PragmaCmt cmt : sls)
skipDataDefs _ (FuncDef f : sls) = groupProgLines (FuncDef f : sls)
skipDataDefs d (DataDef d1 : sls) =
if d == d1 then skipDataDefs d sls
else groupProgLines (DataDef d1 : sls)
skipDataDefs d (ModDef : sls) = skipDataDefs d sls
skipDataDefs d (OtherLine : sls) = skipDataDefs d sls
skipDataDefs d (ModDef : sls) = skipDataDefs d sls
skipDataDefs d (OtherLine : sls) = skipDataDefs d sls
--- Get the comments for a function from a map from source lines to comments.
--- Get the pragma comments for a function from a map from source lines
--- to comments.
getFuncComment :: String -> [(SourceLine, String)] -> String
getFuncComment _ [] = ""
getFuncComment fname ((def, cmt):fdcmts) = case def of
......
......@@ -37,7 +37,7 @@ cpmBanner :: String
cpmBanner = unlines [bannerLine,bannerText,bannerLine]
where
bannerText =
"Curry Package Manager <curry-language.org/tools/cpm> (version of 06/02/2017)"
"Curry Package Manager <curry-language.org/tools/cpm> (version of 07/02/2017)"
bannerLine = take (length bannerText) (repeat '-')
main :: IO ()
......@@ -172,7 +172,8 @@ data DiffOptions = DiffOptions
{ diffVersion :: Maybe Version
, diffModules :: Maybe [String]
, diffAPI :: Bool
, diffBehavior :: Bool }
, diffBehavior :: Bool
, diffUseAna :: Bool }
checkoutOpts :: Options -> CheckoutOptions
checkoutOpts s = case optCommand s of
......@@ -232,7 +233,7 @@ checkOpts s = case optCommand s of
diffOpts :: Options -> DiffOptions
diffOpts s = case optCommand s of
Diff opts -> opts
_ -> DiffOptions Nothing Nothing True True
_ -> DiffOptions Nothing Nothing True True True
readLogLevel :: String -> Either String LogLevel
readLogLevel s = if s == "debug"
......@@ -345,8 +346,9 @@ optionParser = optParser
<> help
"The modules to be checked, separate multiple modules by comma"
<> optional ) )
<|> command "diff" (help "Diff the current package against another version")
(\a -> Right $ a { optCommand = Diff (diffOpts a) })
<|> command "diff"
(help "Diff the current package against another version")
(\a -> Right $ a { optCommand = Diff (diffOpts a) })
( arg (\s a -> readVersion' s >.> \v -> a
{ optCommand = Diff (diffOpts a)
{ diffVersion = Just v } })
......@@ -359,14 +361,21 @@ optionParser = optParser
<> short "m"
<> help "The modules to compare, separate multiple modules by comma"
<> optional )
<.> flag (\a -> Right $ a { optCommand = Diff (diffOpts a) { diffAPI = True, diffBehavior = False } })
<.> flag (\a -> Right $ a { optCommand = Diff (diffOpts a)
{ diffAPI = True, diffBehavior = False } })
( long "api-only"
<> short "a"
<> help "Diff only the API")
<.> flag (\a -> Right $ a { optCommand = Diff (diffOpts a) { diffAPI = False, diffBehavior = True } })
<.> flag (\a -> Right $ a { optCommand = Diff (diffOpts a)
{ diffAPI = False, diffBehavior = True } })
( long "behavior-only"
<> short "b"
<> help "Diff only the behavior") )
<> help "Diff only the behavior")
<.> flag (\a -> Right $ a { optCommand = Diff (diffOpts a)
{ diffUseAna = False } })
( long "unsafe"
<> short "u"
<> help "Do not use automatic termination analysis for safe behavior checking") )
<|> command "list" (help "List all packages of the repository")
(\a -> Right $ a { optCommand = List (listOpts a) })
( flag (\a -> Right $ a { optCommand = List (listOpts a)
......@@ -634,7 +643,8 @@ diff opts cfg repo gc =
then (putStrLn "Preparing behavior diff...\n" >> succeedIO ()) |>
BDiff.preparePackageAndDir cfg repo gc specDir (name localSpec)
diffversion |>=
\i -> BDiff.diffBehavior cfg repo gc i (diffModules opts)
\i -> BDiff.diffBehavior cfg repo gc i (diffUseAna opts)
(diffModules opts)
else succeedIO ()
......
......@@ -136,7 +136,7 @@ behaviorDiffPerformance o = do
genTestProgram :: IO (ErrorLogger ())
genTestProgram = preparePackageDirs defaultConfig emptyRepository GC.emptyCache "/tmp/verA" "/tmp/verB" |>=
\info -> findFunctionsToCompare defaultConfig emptyRepository GC.emptyCache (infSourceDirA info) (infSourceDirB info) Nothing |>=
\info -> findFunctionsToCompare defaultConfig emptyRepository GC.emptyCache (infSourceDirA info) (infSourceDirB info) False Nothing |>=
\(acyCache, funcs, _) -> genCurryCheckProgram defaultConfig emptyRepository GC.emptyCache funcs info acyCache |>
succeedIO ()
......
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