cpm and currypp updated

cpm/src/CPM/FileUtil.curry

@@ -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

cpm/src/CPM/Main.curry

@@ -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

cpm/src/CPM/PackageCache/Local.curry

@@ -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 '" ++

cpm/src/CPM/PackageCopy.curry

@@ -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

cpm/vendor/cass-analysis/src/Analysis/SensibleTypes.curry

+------------------------------------------------------------------------
+--- 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
+
+-- 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
+
+-----------------------------------------------------------------------

cpm/vendor/cass/docs/SensibleType.md

+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.

cpm/vendor/cass/src/CASS/FlatCurryDependency.curry

@@ -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
@@ -24,7 +24,7 @@ dependsDirectlyOnTypes (TypeSyn _ _ _ typeExpr) = nub (tconsOf typeExpr)
 tconsOf :: TypeExpr -> [(String,String)]
 tconsOf (TVar _) = []
 tconsOf (FuncType a b) =  tconsOf a ++ tconsOf b
-tconsOf (TCons qName _) = [qName]
+tconsOf (TCons qName texps) = qName : concatMap tconsOf texps
 
 
 -----------------------------------------------------------------------------

cpm/vendor/cass/src/CASS/Registry.curry

@@ -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

currycheck/src/CurryCheck.curry

@@ -25,7 +25,7 @@ import AbstractCurry.Pretty    (showCProg)
 import AbstractCurry.Transform (renameCurryModule,updCProg,updQNamesInCProg)
 import AnsiCodes
 import Distribution
-import FilePath                ((</>), takeDirectory)
+import FilePath                ((</>), pathSeparator, takeDirectory)
 import qualified FlatCurry.Types as FC
 import FlatCurry.Files
 import qualified FlatCurry.Goodies as FCG
@@ -34,7 +34,7 @@ import IO
 import List
 import Maybe                   (fromJust, isJust)
 import ReadNumeric             (readNat)
-import System                  (system, exitWith, getArgs, getPID)
+import System                  (system, exitWith, getArgs, getPID, getEnviron)
 
 import CheckDetUsage           (checkDetUse, containsDetOperations)
 import ContractUsage
@@ -54,7 +54,7 @@ ccBanner :: String
 ccBanner = unlines [bannerLine,bannerText,bannerLine]
  where
    bannerText = "CurryCheck: a tool for testing Curry programs (Version " ++
-                packageVersion ++ " of 06/02/2017)"
+                packageVersion ++ " of 01/06/2017)"
    bannerLine = take (length bannerText) (repeat '-')
 
 -- Help text
@@ -172,6 +172,10 @@ putStrIfNormal opts s = unless (isQuiet opts) (putStr s >> hFlush stdout)
 putStrIfVerbose :: Options -> String -> IO ()
 putStrIfVerbose opts s = when (optVerb opts > 1) (putStr s >> hFlush stdout)
 
+--- Print second argument if verbosity level > 3:
+putStrLnIfDebug :: Options -> String -> IO ()
+putStrLnIfDebug opts s = when (optVerb opts > 3) (putStrLn s >> hFlush stdout)
+
 --- use some coloring (from library AnsiCodes) if color option is on:
 withColor :: Options -> (String -> String) -> String -> String
 withColor opts coloring = if optColor opts then coloring else id
@@ -676,7 +680,7 @@ analyseCurryProg opts modname orgprog = do
         return .
         maybe (error $ "Source file of module '"++modname++"' not found!") id
   let srcdir = takeDirectory srcfilename
-  when (optVerb opts > 3) $ putStrLn ("Source file: " ++ srcfilename)
+  putStrLnIfDebug opts $ "Source file: " ++ srcfilename
   prooffiles <- if optProof opts then getProofFiles srcdir else return []
   unless (null prooffiles) $ putStrIfVerbose opts $
     unlines ("Proof files found:" : map ("- " ++) prooffiles)
@@ -879,7 +883,7 @@ cleanup opts mainmodname modules =
     maybe done
           (\ (_,srcfilename) -> do
             system $ installDir </> "bin" </> "cleancurry" ++ " " ++ modname
-            system $ "rm -f " ++ srcfilename
+            system $ "/bin/rm -f " ++ srcfilename
             done )
 
 -- Show some statistics about number of tests:
@@ -906,7 +910,9 @@ main = do
          (putStr (unlines opterrors) >> putStrLn usageText >> exitWith 1)
   putStrIfNormal opts ccBanner 
   when (null args || optHelp opts) (putStrLn usageText >> exitWith 1)
-  testModules <- mapIO (analyseModule opts) (map stripCurrySuffix args)
+  let mods = map stripCurrySuffix args
+  mapIO_ checkModuleName mods
+  testModules <- mapIO (analyseModule opts) mods
   let staticerrs       = concatMap staticErrors (concat testModules)
       finaltestmodules = filter testThisModule (concat testModules)
       testmodname = if null (optMainProg opts)
@@ -922,12 +928,17 @@ main = do
                           "Generating main test module '"++testmodname++"'..."
     genMainTestModule opts testmodname finaltestmodules
     putStrIfNormal opts $ withColor opts blue $ "and compiling it...\n"
-    ret <- system $ unwords $ [installDir </> "bin" </> "curry"
-                              ,"--noreadline"
-                              ,":set -time"
-                              ,":set v0"
-                              ,":set parser -Wnone"
-                              ,":l "++testmodname,":eval main :q"]
+    currypath <- getEnviron "CURRYPATH"
+    let runcmd = unwords $
+                   [ installDir </> "bin" </> "curry"
+                   , "--noreadline"
+                   , ":set -time"
+                   , ":set " ++ if optVerb opts > 3 then "v1" else "v0"
+                   , ":set parser -Wnone"
+                   , if null currypath then "" else ":set path " ++ currypath
+                   , ":l "++testmodname,":eval main :q" ]
+    putStrLnIfDebug opts $ "Executing command:\n" ++ runcmd
+    ret <- system runcmd
     cleanup opts testmodname finaltestmodules
     unless (isQuiet opts || ret /= 0) $
       putStrLn $ withColor opts green $ showTestStatistics finaltestmodules
@@ -935,6 +946,12 @@ main = do
  where
   showStaticErrors opts errs = putStrLn $ withColor opts red $
     unlines (line : "STATIC ERRORS IN PROGRAMS:" : errs) ++ line
+
+  checkModuleName mn =
+    when (pathSeparator `elem` mn) $ do
+      putStrLn $ "Module names with path prefixes not allowed: " ++ mn
+      exitWith 1
+
   line = take 78 (repeat '=')
 
 -------------------------------------------------------------------------
@@ -983,7 +1000,7 @@ generatorModule = "SearchTreeGenerators"
 writeCurryProgram :: Options -> String -> CurryProg -> String -> IO ()
 writeCurryProgram opts srcdir p appendix = do
   let progfile = srcdir </> modNameToPath (progName p) ++ ".curry"
-  when (optVerb opts > 3) $ putStrLn ("Writing program: " ++ progfile)
+  putStrLnIfDebug opts $ "Writing program: " ++ progfile
   writeFile progfile
             (showCProg p ++ "\n" ++ appendix ++ "\n")
 

currypp/.cpm/packages/cass-analysis/src/Analysis/SensibleTypes.curry

+------------------------------------------------------------------------
+--- 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
+
+-- 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
+
+-----------------------------------------------------------------------

currypp/.cpm/packages/cass/docs/SensibleType.md

+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)
+