Commit b3d81014 authored by Michael Hanus 's avatar Michael Hanus
Browse files

cpm and currycheck updated

parent 22cf9acb
......@@ -58,7 +58,7 @@ createSymlink from to = system $ "ln -s " ++ (quote from) ++ " " ++ (quote to)
--- Deletes a symlink.
removeSymlink :: String -> IO Int
removeSymlink link = system $ "rm " ++ (quote link)
removeSymlink link = system $ "rm " ++ quote link
--- Tests whether a file is a symlink.
isSymlink :: String -> IO Bool
......
......@@ -45,7 +45,7 @@ cpmBanner :: String
cpmBanner = unlines [bannerLine,bannerText,bannerLine]
where
bannerText =
"Curry Package Manager <curry-language.org/tools/cpm> (version of 24/05/2017)"
"Curry Package Manager <curry-language.org/tools/cpm> (version of 01/06/2017)"
bannerLine = take (length bannerText) (repeat '-')
main :: IO ()
......@@ -87,7 +87,7 @@ runWithArgs opts = do
Compiler o -> compiler o config getRepoGC
Exec o -> exec o config getRepoGC
Doc o -> docCmd o config getRepoGC
Test o -> test o config getRepoGC
Test o -> testCmd o config getRepoGC
Link o -> linkCmd o config
Add o -> addCmd o config
Clean -> cleanPackage Info
......@@ -912,7 +912,7 @@ linkCmd :: LinkOptions -> Config -> IO (ErrorLogger ())
linkCmd (LinkOptions src) _ =
tryFindLocalPackageSpec "." |>= \specDir ->
cleanCurryPathCache specDir |>
log Info ("Linking '" ++ src ++ "' into local package cache") |>
log Info ("Linking '" ++ src ++ "' into local package cache...") |>
linkToLocalCache src specDir
--- `add` command: copy the given package to the repository index
......@@ -1002,9 +1002,9 @@ docCmd opts cfg getRepoGC =
--- `test` command: run `curry check` on the modules provided as an argument
--- or, if they are not provided, on the exported (if specified)
--- or all source modules of the package.
test :: TestOptions -> Config -> IO (Repository,GlobalCache)
-> IO (ErrorLogger ())
test opts cfg getRepoGC =
testCmd :: TestOptions -> Config -> IO (Repository,GlobalCache)
-> IO (ErrorLogger ())
testCmd opts cfg getRepoGC =
tryFindLocalPackageSpec "." |>= \specDir ->
loadPackageSpec specDir |>= \pkg -> do
checkCompiler cfg pkg
......
......@@ -22,8 +22,8 @@ module CPM.PackageCache.Local
) where
import Debug
import Directory (createDirectoryIfMissing, copyFile, getDirectoryContents
, doesDirectoryExist, doesFileExist)
import Directory (createDirectoryIfMissing, copyFile, getAbsolutePath
, getDirectoryContents, doesDirectoryExist, doesFileExist)
import Either (rights)
import FilePath ((</>))
import List (isPrefixOf)
......@@ -34,7 +34,7 @@ import CPM.FileUtil (isSymlink, removeSymlink, createSymlink, linkTarget)
import CPM.Package (Package, packageId, readPackageSpec)
import CPM.PackageCache.Global (installedPackageDir)
--- Get the cache directory of the local package cache.
--- The cache directory of the local package cache.
---
--- @param dir the package directory
cacheDir :: String -> String
......@@ -48,9 +48,11 @@ allPackages pkgDir = do
cacheExists <- doesDirectoryExist cdir
if cacheExists
then do
pkgDirs <- getDirectoryContents cdir
pkgPaths <- return $ map (cdir </>) $ filter (not . isPrefixOf ".") pkgDirs
specPaths <- return $ map (</> "package.json") pkgPaths
debugMessage $ "Reading local package cache from '" ++ cdir ++ "'..."
cdircont <- getDirectoryContents cdir
let pkgDirs = filter (not . isPrefixOf ".") cdircont
pkgPaths <- mapIO removeIfIllegalSymLink $ map (cdir </>) pkgDirs
specPaths <- return $ map (</> "package.json") $ concat pkgPaths
specs <- mapIO (readPackageSpecIO . readFile) specPaths
succeedIO $ rights specs
else succeedIO []
......@@ -58,6 +60,14 @@ allPackages pkgDir = do
readPackageSpecIO = liftIO readPackageSpec
cdir = cacheDir pkgDir
removeIfIllegalSymLink target = do
dirExists <- doesDirectoryExist target
fileExists <- doesFileExist target
isLink <- isSymlink target
if isLink && (dirExists || fileExists)
then return [target]
else when isLink (removeSymlink target >> done) >> return []
--- Creates a link to a package from the global cache in the local cache. Does
--- not overwrite existing links.
---
......@@ -137,16 +147,19 @@ ensureCacheDir pkgDir = do
deleteIfLink :: String -> IO (ErrorLogger ())
deleteIfLink target = do
dirExists <- doesDirectoryExist target
dirExists <- doesDirectoryExist target
fileExists <- doesFileExist target
isLink <- isSymlink target
if dirExists || fileExists
then do
isLink <- isSymlink target
then
if isLink
then removeSymlink target >> succeedIO ()
else failIO $ "deleteIfLink can only delete links!\n" ++
"Unexpected target: " ++ target
else succeedIO ()
else
if isLink -- maybe it is a link to some non-existing target
then removeSymlink target >> succeedIO ()
else succeedIO ()
linkExists :: String -> IO Bool
linkExists target = do
......@@ -176,7 +189,8 @@ createLink pkgDir from name replace = do
if exists && not replace
then succeedIO ()
else deleteIfLink target |> do
rc <- createSymlink from target
fromabs <- getAbsolutePath from
rc <- createSymlink fromabs target
if rc == 0
then succeedIO ()
else failIO $ "Failed to create symlink from '" ++ from ++ "' to '" ++
......
......@@ -148,7 +148,7 @@ installLocalDependencies cfg repo gc dir =
copyDependencies cfg gc pkgSpec (resolvedPackages result) dir |>
succeedIO (pkgSpec, resolvedPackages result)
--- Links a directory into the local package cache. Used for cpm link.
--- Links a directory into the local package cache. Used for `cpm link`.
linkToLocalCache :: String -> String -> IO (ErrorLogger ())
linkToLocalCache src pkgDir = do
dirExists <- doesDirectoryExist src
......
------------------------------------------------------------------------
--- A type is sensible if there exists at least one value of this type.
--- This module contains an analysis which associates to each type
--- constructor the following information:
--- * sensible, i.e., there is always some value of this type
--- * parametric sensible, i.e., it is sensible of all type arguments
--- are instantiated with sensible types
--- * not sensible, i.e., maybe not sensible
------------------------------------------------------------------------
module Analysis.SensibleTypes
( Sensible(..), showSensible, sensibleType )
where
import Analysis.Types
import Analysis.ProgInfo
import FlatCurry.Types
import FlatCurry.Goodies
import Maybe
--- Datatype to represent sensible type information.
data Sensible = NotSensible | PSensible | Sensible
deriving Eq
-- Show higher-order information as a string.
showSensible :: AOutFormat -> Sensible -> String
showSensible _ Sensible = "sensible"
showSensible _ PSensible = "parametric sensible"
showSensible _ NotSensible = "not sensible"
lubSens :: Sensible -> Sensible -> Sensible
lubSens Sensible _ = Sensible
lubSens PSensible Sensible = Sensible
lubSens PSensible PSensible = PSensible
lubSens PSensible NotSensible = PSensible
lubSens NotSensible x = x
------------------------------------------------------------------------
-- Analysis of sensible types
sensibleType :: Analysis Sensible
sensibleType = dependencyTypeAnalysis "SensibleType" NotSensible sensOfType
-- predefined sensible data types
predefinedSensibles :: [QName]
predefinedSensibles = [pre "Int", pre "Float", pre "Char", pre "IO"]
where pre tc = ("Prelude",tc)
sensOfType :: TypeDecl -> [(QName,Sensible)] -> Sensible
sensOfType (TypeSyn _ _ _ typeExpr) usedtypes =
sensOfTypeExpr usedtypes typeExpr
sensOfType (Type tc _ _ conDecls) usedtypes
| tc `elem` predefinedSensibles = Sensible
| otherwise = foldr lubSens NotSensible (map sensOfConsDecl conDecls)
where
sensOfConsDecl (Cons _ _ _ typeExprs)
| all (== Sensible) senstargs = Sensible
| all (/= NotSensible) senstargs = PSensible
| otherwise = NotSensible
where senstargs = map (sensOfTypeExpr usedtypes) typeExprs
-- Compute the sensibility of a type expression which depends on the
-- information about type cosntructors.
sensOfTypeExpr :: [(QName,Sensible)] -> TypeExpr -> Sensible
sensOfTypeExpr _ (TVar _) = PSensible
sensOfTypeExpr _ (FuncType _ _) = NotSensible -- we do not know which functions
-- of some type exists...
sensOfTypeExpr usedtypes (TCons tc typeExprs)
| senstc == Sensible || (senstc == PSensible && all (==Sensible) senstargs)
= Sensible
| senstc == PSensible && all (/=NotSensible) senstargs
= PSensible
| otherwise
= NotSensible
where
senstc = maybe NotSensible id (lookup tc usedtypes)
senstargs = map (sensOfTypeExpr usedtypes) typeExprs
sensOfTypeExpr usedtypes (ForallType _ texp) = sensOfTypeExpr usedtypes texp
-----------------------------------------------------------------------
Sensible types analysis
-----------------------
The `SensibleType` analysis is a type analysis which checks
whether a type is sensible, i.e., whether there exists at least
one value of this type. This analysis associates to each type
constructor the following information:
* sensible, i.e., there is exists some value of this type
* parametric sensible, i.e., it is parametric type which is sensible
if all type arguments are instantiated with sensible types
* not sensible, i.e., there may be no values of this type
For instance, the list type constructor "[]" is sensible
and the pair type constructor "(,)" is parametric sensible.
For further examples, consider the following type declarations:
type Pair = (Int,Int)
data RTree a = RTree a [RTree a]
data ITree a = ITree a (ITree a)
type IntRTree = RTree Int
type IntITree = ITree Int
type ITreeRTree = RTree (ITree Int)
Then this analysis computes the following information:
Pair : sensible
RTree : parametric sensible
ITree : not sensible
IntRTree : sensible
IntITree : not sensible
ITreeRTree : not sensible
Note that function types are classified as not sensible since it is
not known whether some operation of this type exists.
......@@ -2,7 +2,7 @@
--- A few base functions for analysing type dependencies in FlatCurry programs.
---
--- @author Heiko Hoffmann, Michael Hanus
--- @version April 2013
--- @version Junes 2017
-----------------------------------------------------------------------------
module CASS.FlatCurryDependency(dependsDirectlyOnTypes,callsDirectly) where
......@@ -22,10 +22,10 @@ dependsDirectlyOnTypes (TypeSyn _ _ _ typeExpr) = nub (tconsOf typeExpr)
tconsOf :: TypeExpr -> [QName]
tconsOf (TVar _) = []
tconsOf (FuncType a b) = tconsOf a ++ tconsOf b
tconsOf (TCons qName _) = [qName]
tconsOf (ForallType _ te) = tconsOf te
tconsOf (TVar _) = []
tconsOf (FuncType a b) = tconsOf a ++ tconsOf b
tconsOf (TCons qName texps) = qName : concatMap tconsOf texps
tconsOf (ForallType _ te) = tconsOf te
-----------------------------------------------------------------------------
......
......@@ -41,6 +41,7 @@ import Analysis.RequiredValue
import qualified Analysis.RequiredValues as RVS
import Analysis.RightLinearity
import Analysis.RootReplaced
import Analysis.SensibleTypes
import Analysis.SolutionCompleteness
import Analysis.Termination
import Analysis.TotallyDefined
......@@ -70,6 +71,7 @@ registeredAnalysis =
,cassAnalysis "Higher-order constructors" hiOrdCons showOrder
,cassAnalysis "Higher-order functions" hiOrdFunc showOrder
,cassAnalysis "Productive operations" productivityAnalysis showProductivity
,cassAnalysis "Sensible types" sensibleType showSensible
,cassAnalysis "Sibling constructors" siblingCons showSibling
,cassAnalysis "Required value" reqValueAnalysis showAFType
,cassAnalysis "Required value sets" RVS.reqValueAnalysis RVS.showAFType
......
------------------------------------------------------------------------
--- A type is sensible if there exists at least one value of this type.
--- This module contains an analysis which associates to each type
--- constructor the following information:
--- * sensible, i.e., there is always some value of this type
--- * parametric sensible, i.e., it is sensible of all type arguments
--- are instantiated with sensible types
--- * not sensible, i.e., maybe not sensible
------------------------------------------------------------------------
module Analysis.SensibleTypes
( Sensible(..), showSensible, sensibleType )
where
import Analysis.Types
import Analysis.ProgInfo
import FlatCurry.Types
import FlatCurry.Goodies
import Maybe
--- Datatype to represent sensible type information.
data Sensible = NotSensible | PSensible | Sensible
deriving Eq
-- Show higher-order information as a string.
showSensible :: AOutFormat -> Sensible -> String
showSensible _ Sensible = "sensible"
showSensible _ PSensible = "parametric sensible"
showSensible _ NotSensible = "not sensible"
lubSens :: Sensible -> Sensible -> Sensible
lubSens Sensible _ = Sensible
lubSens PSensible Sensible = Sensible
lubSens PSensible PSensible = PSensible
lubSens PSensible NotSensible = PSensible
lubSens NotSensible x = x
------------------------------------------------------------------------
-- Analysis of sensible types
sensibleType :: Analysis Sensible
sensibleType = dependencyTypeAnalysis "SensibleType" NotSensible sensOfType
-- predefined sensible data types
predefinedSensibles :: [QName]
predefinedSensibles = [pre "Int", pre "Float", pre "Char", pre "IO"]
where pre tc = ("Prelude",tc)
sensOfType :: TypeDecl -> [(QName,Sensible)] -> Sensible
sensOfType (TypeSyn _ _ _ typeExpr) usedtypes =
sensOfTypeExpr usedtypes typeExpr
sensOfType (Type tc _ _ conDecls) usedtypes
| tc `elem` predefinedSensibles = Sensible
| otherwise = foldr lubSens NotSensible (map sensOfConsDecl conDecls)
where
sensOfConsDecl (Cons _ _ _ typeExprs)
| all (== Sensible) senstargs = Sensible
| all (/= NotSensible) senstargs = PSensible
| otherwise = NotSensible
where senstargs = map (sensOfTypeExpr usedtypes) typeExprs
-- Compute the sensibility of a type expression which depends on the
-- information about type cosntructors.
sensOfTypeExpr :: [(QName,Sensible)] -> TypeExpr -> Sensible
sensOfTypeExpr _ (TVar _) = PSensible
sensOfTypeExpr _ (FuncType _ _) = NotSensible -- we do not know which functions
-- of some type exists...
sensOfTypeExpr usedtypes (TCons tc typeExprs)
| senstc == Sensible || (senstc == PSensible && all (==Sensible) senstargs)
= Sensible
| senstc == PSensible && all (/=NotSensible) senstargs
= PSensible
| otherwise
= NotSensible
where
senstc = maybe NotSensible id (lookup tc usedtypes)
senstargs = map (sensOfTypeExpr usedtypes) typeExprs
sensOfTypeExpr usedtypes (ForallType _ texp) = sensOfTypeExpr usedtypes texp
-----------------------------------------------------------------------
Sensible types analysis
-----------------------
The `SensibleType` analysis is a type analysis which checks
whether a type is sensible, i.e., whether there exists at least
one value of this type. This analysis associates to each type
constructor the following information:
* sensible, i.e., there is exists some value of this type
* parametric sensible, i.e., it is parametric type which is sensible
if all type arguments are instantiated with sensible types
* not sensible, i.e., there may be no values of this type
For instance, the list type constructor "[]" is sensible
and the pair type constructor "(,)" is parametric sensible.
For further examples, consider the following type declarations:
type Pair = (Int,Int)
data RTree a = RTree a [RTree a]
data ITree a = ITree a (ITree a)
type IntRTree = RTree Int
type IntITree = ITree Int
type ITreeRTree = RTree (ITree Int)
Then this analysis computes the following information:
Pair : sensible
RTree : parametric sensible
ITree : not sensible
IntRTree : sensible
IntITree : not sensible
ITreeRTree : not sensible
Note that function types are classified as not sensible since it is
not known whether some operation of this type exists.
......@@ -2,7 +2,7 @@
--- A few base functions for analysing type dependencies in FlatCurry programs.
---
--- @author Heiko Hoffmann, Michael Hanus
--- @version April 2013
--- @version Junes 2017
-----------------------------------------------------------------------------
module CASS.FlatCurryDependency(dependsDirectlyOnTypes,callsDirectly) where
......@@ -22,10 +22,10 @@ dependsDirectlyOnTypes (TypeSyn _ _ _ typeExpr) = nub (tconsOf typeExpr)
tconsOf :: TypeExpr -> [QName]
tconsOf (TVar _) = []
tconsOf (FuncType a b) = tconsOf a ++ tconsOf b
tconsOf (TCons qName _) = [qName]
tconsOf (ForallType _ te) = tconsOf te
tconsOf (TVar _) = []
tconsOf (FuncType a b) = tconsOf a ++ tconsOf b
tconsOf (TCons qName texps) = qName : concatMap tconsOf texps
tconsOf (ForallType _ te) = tconsOf te
-----------------------------------------------------------------------------
......
......@@ -41,6 +41,7 @@ import Analysis.RequiredValue
import qualified Analysis.RequiredValues as RVS
import Analysis.RightLinearity
import Analysis.RootReplaced
import Analysis.SensibleTypes
import Analysis.SolutionCompleteness
import Analysis.Termination
import Analysis.TotallyDefined
......@@ -70,6 +71,7 @@ registeredAnalysis =
,cassAnalysis "Higher-order constructors" hiOrdCons showOrder
,cassAnalysis "Higher-order functions" hiOrdFunc showOrder
,cassAnalysis "Productive operations" productivityAnalysis showProductivity
,cassAnalysis "Sensible types" sensibleType showSensible
,cassAnalysis "Sibling constructors" siblingCons showSibling
,cassAnalysis "Required value" reqValueAnalysis showAFType
,cassAnalysis "Required value sets" RVS.reqValueAnalysis RVS.showAFType
......
------------------------------------------------------------------------
--- A type is sensible if there exists at least one value of this type.
--- This module contains an analysis which associates to each type
--- constructor the following information:
--- * sensible, i.e., there is always some value of this type
--- * parametric sensible, i.e., it is sensible of all type arguments
--- are instantiated with sensible types
--- * not sensible, i.e., maybe not sensible
------------------------------------------------------------------------
module Analysis.SensibleTypes
( Sensible(..), showSensible, sensibleType )
where
import Analysis.Types
import Analysis.ProgInfo
import FlatCurry.Types
import FlatCurry.Goodies
import Maybe
--- Datatype to represent sensible type information.
data Sensible = NotSensible | PSensible | Sensible
deriving Eq
-- Show higher-order information as a string.
showSensible :: AOutFormat -> Sensible -> String
showSensible _ Sensible = "sensible"
showSensible _ PSensible = "parametric sensible"
showSensible _ NotSensible = "not sensible"
lubSens :: Sensible -> Sensible -> Sensible
lubSens Sensible _ = Sensible
lubSens PSensible Sensible = Sensible
lubSens PSensible PSensible = PSensible
lubSens PSensible NotSensible = PSensible
lubSens NotSensible x = x
------------------------------------------------------------------------
-- Analysis of sensible types
sensibleType :: Analysis Sensible
sensibleType = dependencyTypeAnalysis "SensibleType" NotSensible sensOfType
-- predefined sensible data types
predefinedSensibles :: [QName]
predefinedSensibles = [pre "Int", pre "Float", pre "Char", pre "IO"]
where pre tc = ("Prelude",tc)
sensOfType :: TypeDecl -> [(QName,Sensible)] -> Sensible
sensOfType (TypeSyn _ _ _ typeExpr) usedtypes =
sensOfTypeExpr usedtypes typeExpr
sensOfType (Type tc _ _ conDecls) usedtypes
| tc `elem` predefinedSensibles = Sensible
| otherwise = foldr lubSens NotSensible (map sensOfConsDecl conDecls)
where
sensOfConsDecl (Cons _ _ _ typeExprs)
| all (== Sensible) senstargs = Sensible
| all (/= NotSensible) senstargs = PSensible
| otherwise = NotSensible
where senstargs = map (sensOfTypeExpr usedtypes) typeExprs
-- Compute the sensibility of a type expression which depends on the
-- information about type cosntructors.
sensOfTypeExpr :: [(QName,Sensible)] -> TypeExpr -> Sensible
sensOfTypeExpr _ (TVar _) = PSensible
sensOfTypeExpr _ (FuncType _ _) = NotSensible -- we do not know which functions
-- of some type exists...
sensOfTypeExpr usedtypes (TCons tc typeExprs)
| senstc == Sensible || (senstc == PSensible && all (==Sensible) senstargs)
= Sensible
| senstc == PSensible && all (/=NotSensible) senstargs
= PSensible
| otherwise
= NotSensible
where
senstc = maybe NotSensible id (lookup tc usedtypes)
senstargs = map (sensOfTypeExpr usedtypes) typeExprs
sensOfTypeExpr usedtypes (ForallType _ texp) = sensOfTypeExpr usedtypes texp
-----------------------------------------------------------------------
Sensible types analysis
-----------------------
The `SensibleType` analysis is a type analysis which checks
whether a type is sensible, i.e., whether there exists at least
one value of this type. This analysis associates to each type
constructor the following information:
* sensible, i.e., there is exists some value of this type
* parametric sensible, i.e., it is parametric type which is sensible
if all type arguments are instantiated with sensible types
* not sensible, i.e., there may be no values of this type
For instance, the list type constructor "[]" is sensible
and the pair type constructor "(,)" is parametric sensible.
For further examples, consider the following type declarations:
type Pair = (Int,Int)
data RTree a = RTree a [RTree a]
data ITree a = ITree a (ITree a)
type IntRTree = RTree Int
type IntITree = ITree Int
type ITreeRTree = RTree (ITree Int)
Then this analysis computes the following information:
Pair : sensible
RTree : parametric sensible
ITree : not sensible
IntRTree : sensible
IntITree : not sensible
ITreeRTree : not sensible
Note that function types are classified as not sensible since it is
not known whether some operation of this type exists.
......@@ -2,7 +2,7 @@
--- A few base functions for analysing type dependencies in FlatCurry programs.
---
--- @author Heiko Hoffmann, Michael Hanus
--- @version April 2013
--- @version Junes 2017
-----------------------------------------------------------------------------
module CASS.FlatCurryDependency(dependsDirectlyOnTypes,callsDirectly) where
......@@ -22,10 +22,10 @@ dependsDirectlyOnTypes (TypeSyn _ _ _ typeExpr) = nub (tconsOf typeExpr)
tconsOf :: TypeExpr -> [QName]
tconsOf (TVar _) = []
tconsOf (FuncType a b) = tconsOf a ++ tconsOf b
tconsOf (TCons qName _) = [qName]
tconsOf (ForallType _ te) = tconsOf te
tconsOf (TVar _) = []
tconsOf (FuncType a b) = tconsOf a ++ tconsOf b
tconsOf (TCons qName texps) = qName : concatMap tconsOf texps
tconsOf (ForallType _ te) = tconsOf te
-----------------------------------------------------------------------------
......
......@@ -41,6 +41,7 @@ import Analysis.RequiredValue
import qualified Analysis.RequiredValues as RVS
import Analysis.RightLinearity
import Analysis.RootReplaced
import Analysis.SensibleTypes
import Analysis.SolutionCompleteness
import Analysis.Termination
import Analysis.TotallyDefined
......@@ -70,6 +71,7 @@ registeredAnalysis =
,cassAnalysis "Higher-order constructors" hiOrdCons showOrder
,cassAnalysis "Higher-order functions" hiOrdFunc showOrder
,cassAnalysis "Productive operations" productivityAnalysis showProductivity
,cassAnalysis "Sensible types" sensibleType showSensible
,cassAnalysis "Sibling constructors" siblingCons showSibling
,cassAnalysis "Required value" reqValueAnalysis showAFType
,cassAnalysis "Required value sets" RVS.reqValueAnalysis RVS.showAFType
......