Typeclass version packaged

examples/ExampleTests.curry

@@ -27,7 +27,7 @@ plusComm :: Int -> Int -> Prop
 plusComm x y = x + y -=- y + x
 
 -- We can even write a polymorphic test:
-rev_rev_is_id :: [a] -> Prop
+rev_rev_is_id :: (Eq a, Show a) => [a] -> Prop
 rev_rev_is_id xs = reverse (reverse xs) -=- xs
 -- A polymorphic test will be automatically transformed into the same
 -- test specialized to values of type Ordering.

examples/ExamplesFromManual.curry

@@ -6,7 +6,7 @@ rev []     = []
 rev (x:xs) = rev xs ++ [x]
 
 -- Unit tests:
-revNull = rev []      -=- []
+revNull = rev []      -=- ([] :: [Int])
 rev123  = rev [1,2,3] -=- [3,2,1]
 
 -- Property: reversing two times is the identity:
@@ -69,6 +69,7 @@ neg_or b1 b2 = not (b1 || b2) -=- not b1 && not b2
 
 -- Natural numbers defined by s-terms (Z=zero, S=successor):
 data Nat = Z | S Nat
+ deriving (Eq,Show)
 
 -- addition on natural numbers:
 add :: Nat -> Nat -> Nat
@@ -84,6 +85,7 @@ addIsAssociative x y z = add (add x y) z -=- add x (add y z)
 
 -- A general tree type:
 data Tree a = Leaf a | Node [Tree a]
+ deriving (Eq,Show)
 
 -- The leaves of a tree:
 leaves (Leaf x) = [x]
@@ -107,6 +109,7 @@ sumUpIsCorrect n = n>=0 ==> sumUp n -=- n * (n+1) `div` 2
 -- To test sumUpIsCorrect explicitly on non-ngeative integers,
 -- we define a new data type to wrap integers:
 data NonNeg = NonNeg { nonNeg :: Int }
+ deriving (Eq,Show)
 
 -- We define our own generator for producing only non-negative integers:
 genNonNeg = genCons1 NonNeg genNN

examples/ListSpecifications.curry

@@ -8,33 +8,33 @@
 import qualified List
 import Test.Prop
 
-nub :: [a] -> [a]
+nub :: Eq a => [a] -> [a]
 nub = List.nub
 
-nub'spec :: [a] ->DET [a]
+nub'spec :: Eq a => [a] ->DET [a]
 nub'spec (xs++[e]++ys++[e]++zs) = nub'spec (xs++[e]++ys++zs)
 nub'spec'default xs = xs
 
-isPrefixOf :: [a] -> [a] -> Bool
+isPrefixOf :: Eq a => [a] -> [a] -> Bool
 isPrefixOf = List.isPrefixOf
 
-isPrefixOf'spec :: [a] -> [a] ->DET Bool
+isPrefixOf'spec :: Eq a => [a] -> [a] ->DET Bool
 isPrefixOf'spec xs (xs ++ _) = True
 isPrefixOf'spec'default _ _  = False
 
 
-isSuffixOf :: [a] -> [a] -> Bool
+isSuffixOf :: Eq a => [a] -> [a] -> Bool
 isSuffixOf = List.isSuffixOf
 
-isSuffixOf'spec :: [a] -> [a] ->DET Bool
+isSuffixOf'spec :: Eq a => [a] -> [a] ->DET Bool
 isSuffixOf'spec xs (_ ++ xs) = True
 isSuffixOf'spec'default _ _  = False
 
 
-isInfixOf :: [a] -> [a] -> Bool
+isInfixOf :: Eq a => [a] -> [a] -> Bool
 isInfixOf = List.isInfixOf
 
-isInfixOf'spec :: [a] -> [a] ->DET Bool
+isInfixOf'spec :: Eq a => [a] -> [a] ->DET Bool
 isInfixOf'spec xs (_ ++ xs ++ _) = True
 isInfixOf'spec'default _ _       = False
 

examples/Nats.curry

@@ -4,6 +4,7 @@ import Test.Prop
 
 -- Natural numbers defined by s-terms (Z=zero, S=successor):
 data Nat = Z | S Nat
+ deriving (Eq,Show)
 
 -- addition on natural numbers:
 add         :: Nat -> Nat -> Nat

examples/Tree.curry

@@ -4,6 +4,7 @@ import Test.Prop
 
 -- A general tree type:
 data Tree a = Leaf a | Node [Tree a]
+ deriving (Eq,Show)
 
 leaves (Leaf x) = [x]
 leaves (Node ts) = concatMap leaves ts

package.json

 {
     "name": "currycheck",
-    "version": "1.0.1",
+    "version": "2.0.0",
     "author": "Michael Hanus <mh@informatik.uni-kiel.de>",
     "synopsis": "A tool to support automatic testing of Curry programs",
     "category": [ "Testing" ],
     "dependencies": {
-        "rewriting" : ">= 0.0.1"
+        "rewriting" : ">= 2.0.0"
     },
     "compilerCompatibility": {
-        "pakcs": ">= 1.14.0, < 2.0.0",
-        "kics2": ">= 0.5.0, < 2.0.0"
+        "pakcs": ">= 2.0.0",
+        "kics2": ">= 2.0.0"
     },
     "configModule": "CurryCheckConfig",
     "executable": {
@@ -18,6 +18,7 @@
     },
     "testsuite": [
         { "src-dir": "examples",
+          "options": "-m70",
           "modules": [ "DefaultRulesTest", "DetOperations", "ExampleTests",
                        "ExamplesFromManual", "FloatTest", "ListSpecifications",
                        "Nats", "SEBF", "Sum", "SortSpec", "Tree" ]

src/CheckDetUsage.curry

@@ -7,7 +7,7 @@
 --- See example program `Examples/UsageErrors.curry` for some examples.
 ---
 --- @author Michael Hanus
---- @version May 2016
+--- @version October 2016
 ---------------------------------------------------------------------------
 
 module CheckDetUsage(containsDetOperations, checkDetUse) where
@@ -18,25 +18,26 @@ import AbstractCurry.Select
 ---------------------------------------------------------------------
 --- Does a Curr program contains operations with DET annotations?
 containsDetOperations :: CurryProg -> Bool
-containsDetOperations (CurryProg _ _ _ fdecls _) =
-  any (detInTopLevelType . funcType) fdecls
+containsDetOperations (CurryProg _ _ _ _ _ _ fdecls _) =
+  any (detInTopLevelType . typeOfQualType . funcType) fdecls
  where
-  detInTopLevelType (CTVar _)     = False
-  detInTopLevelType (CTCons tc _) = tc == pre "DET"
+  detInTopLevelType (CTVar _)        = False
+  detInTopLevelType (CTCons _)       = False
   detInTopLevelType (CFuncType _ rt) = detInTopLevelType rt
+  detInTopLevelType (CTApply tc _)   = tc == CTCons (pre "DET")
 
 ---------------------------------------------------------------------
 --- Returns messages about unintended uses of type synonym `DET`
 --- in a Curry program.
 checkDetUse :: CurryProg -> [(QName,String)]
-checkDetUse (CurryProg _ _ _ fdecls _) =
+checkDetUse (CurryProg _ _ _ _ _ _ fdecls _) =
   concatMap (map showDetError . checkDetUseInFDecl) fdecls
  where
   showDetError qf = (qf, "wrong use of DET type synonym!")
 
 checkDetUseInFDecl :: CFuncDecl -> [QName]
 checkDetUseInFDecl (CFunc qn _ _ t rs) =
-  if checkDetInTopLevelType t || any detInRule rs
+  if checkDetInTopLevelType (typeOfQualType t) || any detInRule rs
   then [qn]
   else []
 checkDetUseInFDecl (CmtFunc _  qn ar vis t rs) =
@@ -44,15 +45,16 @@ checkDetUseInFDecl (CmtFunc _  qn ar vis t rs) =
 
 checkDetInTopLevelType :: CTypeExpr -> Bool
 checkDetInTopLevelType (CTVar _)     = False
-checkDetInTopLevelType (CTCons _ ts) = any detInTypeExpr ts
+checkDetInTopLevelType (CTCons _)    = False
 checkDetInTopLevelType (CFuncType at rt) =
   detInTypeExpr at || checkDetInTopLevelType rt
+checkDetInTopLevelType (CTApply _ ta) = detInTypeExpr ta
 
 detInTypeExpr :: CTypeExpr -> Bool
 detInTypeExpr (CTVar _) = False
-detInTypeExpr (CTCons tc ts) =
-  tc == pre "DET" || any detInTypeExpr ts
+detInTypeExpr (CTCons tc) =  tc == pre "DET"
 detInTypeExpr (CFuncType at rt) = detInTypeExpr at || detInTypeExpr rt
+detInTypeExpr (CTApply   tc ta) = detInTypeExpr tc || detInTypeExpr ta
 
 detInRule :: CRule -> Bool
 detInRule (CRule _ rhs) = detInRhs rhs
@@ -64,9 +66,9 @@ detInRhs (CGuardedRhs gs ldcls) = any detInGuard gs || any detInLocalDecl ldcls
 
 detInLocalDecl :: CLocalDecl -> Bool
 detInLocalDecl (CLocalFunc (CFunc _ _ _ t rs)) =
-  detInTypeExpr t || any detInRule rs
+  detInTypeExpr (typeOfQualType t) || any detInRule rs
 detInLocalDecl (CLocalFunc (CmtFunc _ _ _ _ t rs)) =
-  detInTypeExpr t || any detInRule rs
+  detInTypeExpr (typeOfQualType t) || any detInRule rs
 detInLocalDecl (CLocalPat _ rhs) = detInRhs rhs
 detInLocalDecl (CLocalVars _) = False
 
@@ -80,7 +82,7 @@ detInExp (CLetDecl ldecls e) = any detInLocalDecl ldecls || detInExp e
 detInExp (CDoExpr stmts) = any detInStatement stmts
 detInExp (CListComp e stmts) = detInExp e || any detInStatement stmts
 detInExp (CCase _ e branches) = detInExp e || any (detInRhs . snd) branches
-detInExp (CTyped e t) = detInExp e || detInTypeExpr t
+detInExp (CTyped e t) = detInExp e || detInTypeExpr (typeOfQualType t)
 detInExp (CRecConstr _ fields) = any (detInExp . snd) fields
 detInExp (CRecUpdate e fields) = detInExp e || any (detInExp . snd) fields
 

src/ContractUsage.curry

@@ -5,7 +5,7 @@
 --- and pre/postconditions.
 ---
 --- @author Michael Hanus
---- @version May 2016
+--- @version October 2016
 ------------------------------------------------------------------------
 
 module ContractUsage
@@ -56,7 +56,7 @@ checkPrePostResultTypes prog =
    in preerrs ++ posterrs
 
 hasBoolResultType :: CFuncDecl -> Bool
-hasBoolResultType fd = resultType (funcType fd) == boolType
+hasBoolResultType fd = resultType (typeOfQualType (funcType fd)) == boolType
 
 -- Get function names from a Curry module with a name satisfying the predicate:
 funDeclsWithNameArity :: (String -> Bool) -> CurryProg -> [(String,Int)]
@@ -66,7 +66,8 @@ funDeclsWithNameArity pred prog =
 
 -- Computes the unqualified name and the arity from the type of the function.
 nameArityOfFunDecl :: CFuncDecl -> (String,Int)
-nameArityOfFunDecl fd = (snd (funcName fd), length (argTypes (funcType fd)))
+nameArityOfFunDecl fd =
+  (snd (funcName fd), length (argTypes (typeOfQualType (funcType fd))))
 
 
 -- Is this the name of a specification?

src/CurryCheck.curry

@@ -22,7 +22,8 @@ import AbstractCurry.Files
 import AbstractCurry.Select
 import AbstractCurry.Build
 import AbstractCurry.Pretty    (showCProg)
-import AbstractCurry.Transform (renameCurryModule,updCProg,updQNamesInCProg)
+import AbstractCurry.Transform (renameCurryModule, trCTypeExpr
+                               ,updCProg, updQNamesInCProg)
 import AnsiCodes
 import Distribution
 import FilePath                ((</>), takeDirectory)
@@ -54,7 +55,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 08/05/2017)"
    bannerLine = take (length bannerText) (repeat '-')
 
 -- Help text
@@ -261,9 +262,8 @@ userTestDataOfModule testmod = concatMap testDataOf (propTests testmod)
 
   userTypesOf (CTVar _) = []
   userTypesOf (CFuncType from to) = union (userTypesOf from) (userTypesOf to)
-  userTypesOf (CTCons (mn,tc) argtypes) =
-    union (if mn == preludeName then [] else [(mn,tc)])
-          (unionOn userTypesOf argtypes)
+  userTypesOf (CTCons (mn,tc)) = if mn == preludeName then [] else [(mn,tc)]
+  userTypesOf (CTApply tc ta) = union (userTypesOf tc) (userTypesOf ta)
 
   unionOn f = foldr union [] . map f
 
@@ -274,7 +274,7 @@ createTests opts mainmodname tm = map createTest (propTests tm)
  where
   createTest test =
     cfunc (mainmodname, (genTestName $ getTestName test)) 0 Public
-          (ioType (maybeType stringType))
+          (emptyClassType (ioType (maybeType stringType)))
           (case test of PropTest   name t _ -> propBody name (argTypes t) test
                         IOTest name       _ -> ioTestBody name test)
 
@@ -308,10 +308,15 @@ createTests opts mainmodname tm = map createTest (propTests tm)
                   ])]
    where
     useUserDefinedGen texp = case texp of
-      CTVar _         -> error "No polymorphic generator!"
-      CFuncType _ _   -> error "No generator for functional types!"
-      CTCons (_,tc) _ -> isJust
-                           (find (\qn -> "gen"++tc == snd qn) (generators tm))
+      CTVar _       -> error "No polymorphic generator!"
+      CFuncType _ _ -> error "No generator for functional types!"
+      CTApply _ _   ->
+        maybe (error "No generator for type applications!")
+              (\ ((_,tc),_) -> isJust
+                         (find (\qn -> "gen"++tc == snd qn) (generators tm)))
+              (tconsArgsOfType texp)
+      CTCons (_,tc) -> isJust
+                         (find (\qn -> "gen"++tc == snd qn) (generators tm))
 
     configOpWithMaxTest =
       let n = optMaxTest opts
@@ -345,13 +350,17 @@ easyCheckConfig opts =
 type2genop :: String -> TestModule -> CTypeExpr -> CExpr
 type2genop _ _ (CTVar _)       = error "No polymorphic generator!"
 type2genop _ _ (CFuncType _ _) = error "No generator for functional types!"
-type2genop mainmod tm (CTCons qt targs) =
-  applyF (typename2genopname mainmod (generators tm) qt)
-         (map (type2genop mainmod tm) targs)
+type2genop mainmod tm (CTCons qt) =
+  constF (typename2genopname mainmod (generators tm) qt)
+type2genop mainmod tm te@(CTApply _ _) =
+  maybe (error "No generator for type applications!")
+        (\ (qt,targs) -> applyF (typename2genopname mainmod (generators tm) qt)
+                                (map (type2genop mainmod tm) targs))
+        (tconsArgsOfType te)
 
 isFloatType :: CTypeExpr -> Bool
-isFloatType texp = case texp of CTCons tc [] -> tc == (preludeName,"Float")
-                                _            -> False
+isFloatType texp = case texp of CTCons tc -> tc == (preludeName,"Float")
+                                _         -> False
 
 typename2genopname :: String -> [QName] -> QName -> QName
 typename2genopname mainmod definedgenops (mn,tc)
@@ -378,8 +387,10 @@ typename2genopname mainmod definedgenops (mn,tc)
 -- Turn all functions into public ones.
 -- This ensures that all tests can be executed.
 makeAllPublic :: CurryProg -> CurryProg
-makeAllPublic (CurryProg modname imports typedecls functions opdecls) =
-  CurryProg modname stimports typedecls publicFunctions opdecls
+makeAllPublic (CurryProg modname imports dfltdecl clsdecls instdecls
+                         typedecls functions opdecls) =
+  CurryProg modname stimports dfltdecl clsdecls instdecls
+            typedecls publicFunctions opdecls
  where
   stimports = if generatorModule `elem` imports &&
                  searchTreeModule `notElem` imports
@@ -405,9 +416,10 @@ makeAllPublic (CurryProg modname imports typedecls functions opdecls) =
 classifyTests :: [CFuncDecl] -> [Test]
 classifyTests = map makeProperty
  where
-  makeProperty test = if isPropIOType (funcType test)
+  makeProperty test = if isPropIOType ftype
                       then IOTest (funcName test) 0
-                      else PropTest (funcName test) (funcType test) 0
+                      else PropTest (funcName test) ftype 0
+   where ftype = typeOfQualType (funcType test)
 
 -- Extracts all tests from a given Curry module and transforms
 -- all polymorphic tests into tests on a base type.
@@ -416,7 +428,8 @@ classifyTests = map makeProperty
 transformTests :: Options -> String -> CurryProg
                -> IO ([CFuncDecl],[CFuncDecl],CurryProg)
 transformTests opts srcdir
-               prog@(CurryProg mname imps typeDecls functions opDecls) = do
+               prog@(CurryProg mname imps dfltdecl clsdecls instdecls
+                               typeDecls functions opDecls) = do
   theofuncs <- if optProof opts then getTheoremFunctions srcdir prog
                                 else return []
   simpfuncs <- simplifyPostConditionsWithTheorems (optVerb opts) theofuncs funcs
@@ -442,6 +455,7 @@ transformTests opts srcdir
           map snd ignoredtests,
           CurryProg mname
                     (nub (easyCheckModule:imps))
+                    dfltdecl clsdecls instdecls
                     typeDecls
                     (simpfuncs ++ map snd (realtests ++ ignoredtests))
                     opDecls)
@@ -458,10 +472,12 @@ transformTests opts srcdir
 transformDetTests :: Options -> [String] -> CurryProg
                   -> ([CFuncDecl],[CFuncDecl],CurryProg)
 transformDetTests opts prooffiles
-                  (CurryProg mname imports typeDecls functions opDecls) =
+                  (CurryProg mname imports dfltdecl clsdecls instdecls
+                             typeDecls functions opDecls) =
   (map snd realtests, map snd ignoredtests,
    CurryProg mname
              (nub (easyCheckModule:imports))
+             dfltdecl clsdecls instdecls
              typeDecls
              (map (revertDetOpTrans detOpNames) functions ++
               map snd (realtests ++ ignoredtests))
@@ -507,10 +523,11 @@ propResultType te = case te of
 genPostCondTest :: [QName] -> [QName] -> CFuncDecl -> [CFuncDecl]
 genPostCondTest prefuns postops (CmtFunc _ qf ar vis texp rules) =
   genSpecTest prefuns postops (CFunc qf ar vis texp rules)
-genPostCondTest prefuns postops (CFunc qf@(mn,fn) _ _ texp _) =
+genPostCondTest prefuns postops
+                (CFunc qf@(mn,fn) _ _ (CQualType clscon texp) _) =
  if qf `notElem` postops then [] else
   [CFunc (mn, fn ++ postCondSuffix) ar Public
-    (propResultType texp)
+    (CQualType clscon (propResultType texp))
     [simpleRule (map CPVar cvars) $
       if qf `elem` prefuns
        then applyF (easyCheckModule,"==>")
@@ -533,10 +550,11 @@ genPostCondTest prefuns postops (CFunc qf@(mn,fn) _ _ texp _) =
 genSpecTest :: [QName] -> [QName] -> CFuncDecl -> [CFuncDecl]
 genSpecTest prefuns specops (CmtFunc _ qf ar vis texp rules) =
   genSpecTest prefuns specops (CFunc qf ar vis texp rules)
-genSpecTest prefuns specops (CFunc qf@(mn,fn) _ _ texp _) =
+genSpecTest prefuns specops
+            (CFunc qf@(mn,fn) _ _ (CQualType clscon texp) _) =
  if qf `notElem` specops then [] else
   [CFunc (mn, fn ++ satSpecSuffix) ar Public
-    (propResultType texp)
+    (CQualType (addShowContext clscon) (propResultType texp))
     [simpleRule (map CPVar cvars) $
        addPreCond (applyF (easyCheckModule,"<~>")
                           [applyF qf (map CVar cvars),
@@ -579,9 +597,9 @@ genDetOpTests prooffiles prefuns fdecls =
 genDetProp :: [QName] -> CFuncDecl -> CFuncDecl
 genDetProp prefuns (CmtFunc _ qf ar vis texp rules) =
   genDetProp prefuns (CFunc qf ar vis texp rules)
-genDetProp prefuns (CFunc (mn,fn) ar _ texp _) =
+genDetProp prefuns (CFunc (mn,fn) ar _ (CQualType clscon texp) _) =
   CFunc (mn, forg ++ isDetSuffix) ar Public
-   (propResultType texp)
+   (CQualType (addShowContext clscon) (propResultType texp))
    [simpleRule (map CPVar cvars) $
       if (mn,forg) `elem` prefuns
        then applyF (easyCheckModule,"==>")
@@ -600,18 +618,76 @@ genDetProp prefuns (CFunc (mn,fn) ar _ texp _) =
 poly2default :: String -> CFuncDecl -> [(Bool,CFuncDecl)]
 poly2default dt (CmtFunc _ name arity vis ftype rules) =
   poly2default dt (CFunc name arity vis ftype rules)
-poly2default dt fdecl@(CFunc (mn,fname) arity vis ftype _)
+poly2default dt fdecl@(CFunc (mn,fname) arity vis qftype rs)
   | isPolyType ftype
   = [(False,fdecl)
-    ,(True, CFunc (mn,fname++defTypeSuffix) arity vis (p2dt ftype)
-                     [simpleRule [] (applyF (mn,fname) [])])
+    ,(True, CFunc (mn,fname++defTypeSuffix) arity vis
+                  (emptyClassType (p2dt ftype))
+                  [simpleRule [] (applyF (mn,fname) [])])
     ]
   | otherwise
-  = [(True,fdecl)]
+  = [(True, CFunc (mn,fname) arity vis (CQualType clscon ftype) rs)]
  where
-  p2dt (CTVar _) = baseType (pre dt)
+  CQualType clscon ftype = defaultQualType qftype
+  
+  p2dt (CTVar _)         = baseType (pre dt)
   p2dt (CFuncType t1 t2) = CFuncType (p2dt t1) (p2dt t2)
-  p2dt (CTCons ct ts) = CTCons ct (map p2dt ts)
+  p2dt (CTApply t1 t2)   = CTApply (p2dt t1) (p2dt t2)
+  p2dt (CTCons ct)       = CTCons ct
+
+-------------------------------------------------------------------------
+-- Try to default a qualified type by replacing Num/Integral-constrained
+-- types by Int and Fractional-constrained types by Float.
+defaultQualType :: CQualTypeExpr -> CQualTypeExpr
+defaultQualType (CQualType (CContext allclscon) ftype) =
+  CQualType (CContext deffractxt) deffratype
+ where
+  (numcons,nonnumcons) =
+    partition (\ (cls,te) -> (cls == pre "Num" || cls == pre "Integral")
+                             && isTVar te)
+              allclscon
+  defnumtype = def2TConsInType numcons (pre "Int") ftype
+  defnumctxt = removeNonTVarClassContexts
+                 (map (\ (cls,con) ->
+                                (cls, def2TConsInType numcons (pre "Int") con))
+                      nonnumcons)
+
+  (fracons,nonfracons) =
+    partition (\ (cls,te) -> cls == pre "Fractional" && isTVar te) defnumctxt
+  deffratype = def2TConsInType fracons (pre "Float") defnumtype
+  deffractxt = removeNonTVarClassContexts
+                 (map (\ (cls,con) ->
+                              (cls, def2TConsInType fracons (pre "Float") con))
+                      nonfracons)
+
+  -- remove constant type class contexts
+  removeNonTVarClassContexts = filter (\ (_,te) -> isTVar te)
+
+  -- replace all type variables (occurring in the first list of class
+  -- constraints) by the type constructor (second argument) in a given
+  -- type expression (third argument)
+  def2TConsInType clscons tcons texp =
+    foldr (tvar2TCons tcons) texp (map snd clscons)
+
+  -- substitute a type variable by type Int in a type
+  tvar2TCons tcons texp = case texp of
+    CTVar tv -> substTVar tv (CTCons tcons)
+    _        -> id
+
+  -- substitute a type variable by a type expression in a type expression:
+  substTVar tvariname texp =
+    trCTypeExpr (\tv -> if tv==tvariname then texp else CTVar tv)
+                CTCons CFuncType CTApply
+
+  isTVar te = case te of CTVar _ -> True
+                         _       -> False
+
+-- Add a "Show" class context to all types occurring in the context.
+addShowContext :: CContext -> CContext
+addShowContext (CContext clscons) =
+  CContext (nub (clscons ++ (map (\t -> (pre "Show",t)) (map snd clscons))))
+
+-------------------------------------------------------------------------
 
 -- Transforms a possibly changed test name (like "test_ON_BASETYPE")
 -- back to its original name.
@@ -734,11 +810,12 @@ generatorsOfProg :: CurryProg -> [QName]
 generatorsOfProg = map funcName . filter isGen . functions
  where
    isGen fdecl = "gen" `isPrefixOf` snd (funcName fdecl) &&
-                 isSearchTreeType (resultType (funcType fdecl))
+                 isSearchTreeType (resultType (typeOfQualType (funcType fdecl)))
 
    isSearchTreeType (CTVar _) = False
    isSearchTreeType (CFuncType _ _) = False
-   isSearchTreeType (CTCons tc _) = tc == searchTreeTC
+   isSearchTreeType (CTApply _ _) = False
+   isSearchTreeType (CTCons tc) = tc == searchTreeTC -- TODO!
 
 -------------------------------------------------------------------------
 -- Create the main test module containing all tests of all test modules as
@@ -762,14 +839,15 @@ genMainTestModule opts mainmodname modules = do
                            map fst testtypes ++ map testModuleName modules
   appendix <- readFile (packagePath </> "src" </> "TestAppendix.curry")
   writeCurryProgram opts "."
-                    (CurryProg mainmodname imports [] (mainFunction : funcs) [])
-                    appendix
+    (CurryProg mainmodname imports Nothing [] [] [] (mainFunction : funcs) [])
+    appendix
 
 -- Generates the main function which executes all property tests
 -- of all test modules.
 genMainFunction :: Options -> String -> [Test] -> CFuncDecl
 genMainFunction opts testModule tests =
-  CFunc (testModule, "main") 0 Public (ioType unitType) [simpleRule [] body]
+  CFunc (testModule, "main") 0 Public (emptyClassType (ioType unitType))
+        [simpleRule [] body]
  where
   body = CDoExpr $
      (if isQuiet opts
@@ -843,8 +921,10 @@ createTestDataGenerator mainmodname tdecl = type2genData tdecl
     then error $ "Cannot create value generator for type '" ++ qtString ++
                  "' without constructors!"
     else CFunc (typename2genopname mainmodname [] qt) (length tvars) Public
-               (foldr (~>) (CTCons searchTreeTC [CTCons qt ctvars])
-                           (map (\v -> CTCons searchTreeTC [v]) ctvars))
+               (emptyClassType
+                 (foldr (~>) (CTApply (CTCons searchTreeTC)
+                                      (applyTC qt ctvars))
+                             (map (\v -> applyTC searchTreeTC [v]) ctvars)))
                [simpleRule (map CPVar cvars)
                   (foldr1 (\e1 e2 -> applyF (generatorModule,"|||") [e1,e2])
                           (map cons2gen cdecls))]
@@ -874,13 +954,12 @@ cleanup opts mainmodname modules =
     removeCurryModule mainmodname
     mapIO_ removeCurryModule (map testModuleName modules)
  where
-  removeCurryModule modname =
-    lookupModuleSourceInLoadPath modname >>=
-    maybe done
-          (\ (_,srcfilename) -> do
-            system $ installDir </> "bin" </> "cleancurry" ++ " " ++ modname
-            system $ "rm -f " ++ srcfilename
-            done )
+  removeCurryModule modname = do
+    (_,srcfilename) <- lookupModuleSourceInLoadPath modname >>=
+        return .
+        maybe (error $ "Source file of module '"++modname++"' not found!") id
+    system $ installDir </> "bin" </> "cleancurry" ++ " " ++ modname
+    system $ "rm -f " ++ srcfilename
 
 -- Show some statistics about number of tests:
 showTestStatistics :: [TestModule] -> String
@@ -921,6 +1000,7 @@ main = do
     putStrIfNormal opts $ withColor opts blue $
                           "Generating main test module '"++testmodname++"'..."
     genMainTestModule opts testmodname finaltestmodules
+    showGeneratedModule opts "main test" testmodname
     putStrIfNormal opts $ withColor opts blue $ "and compiling it...\n"
     ret <- system $ unwords $ [installDir </> "bin" </> "curry"
                               ,"--noreadline"
@@ -937,13 +1017,23 @@ main = do
     unlines (line : "STATIC ERRORS IN PROGRAMS:" : errs) ++ line
   line = take 78 (repeat '=')
 
+showGeneratedModule :: Options -> String -> String -> IO ()
+showGeneratedModule opts mkind modname = when (optVerb opts > 3) $ do
+  putStrLn $ '\n' : line
+  putStrLn $ "Generated " ++ mkind ++ " module `" ++ modname ++ ".curry':"
+  putStrLn line
+  readFile (modname ++ ".curry") >>= putStr
+  putStrLn line
+ where
+  line = take 78 (repeat '=')
+
 -------------------------------------------------------------------------
 -- Auxiliaries
 
 -- Rename all module references to "Test.Prog" into "Test.EasyCheck"
 renameProp2EasyCheck :: CurryProg -> CurryProg
 renameProp2EasyCheck prog =
-  updCProg id (map rnmMod) id id id
+  updCProg id (map rnmMod) id id id id id id
            (updQNamesInCProg (\ (mod,n) -> (rnmMod mod,n)) prog)
  where
   rnmMod mod | mod == propModule = easyCheckModule

src/DefaultRuleUsage.curry

@@ -3,7 +3,7 @@
 --- default rules in a Curry program.
 ---
 --- @author Michael Hanus
---- @version May 2016
+--- @version October 2016
 ------------------------------------------------------------------------
 
 module DefaultRuleUsage

src/PropertyUsage.curry

@@ -3,7 +3,7 @@
 --- a Curry program.
 ---
 --- @author Michael Hanus
---- @version Augsut 2016
+--- @version October 2016
 ------------------------------------------------------------------------
 
 module PropertyUsage
@@ -12,27 +12,27 @@ module PropertyUsage
   )  where
 
 import AbstractCurry.Types
-import AbstractCurry.Select (funcType, resultType)
+import AbstractCurry.Select (funcType, resultType, typeOfQualType)
 
 ------------------------------------------------------------------------
 -- Check whether a function definition is a property,
 -- i.e., if the result type is `Prop` or `PropIO`.
 isProperty :: CFuncDecl -> Bool
-isProperty = isPropertyType . funcType
+isProperty = isPropertyType . typeOfQualType . funcType
  where
   isPropertyType ct = isPropIOType ct || isPropType (resultType ct)
 
 -- Is the type expression the type Test.EasyCheck.Prop?
 isPropType :: CTypeExpr -> Bool
 isPropType texp = case texp of
-  CTCons (mn,tc) [] -> tc == "Prop" && isCheckModule mn
-  _                 -> False
+  CTCons (mn,tc) -> tc == "Prop" && isCheckModule mn
+  _              -> False
 
 -- Is the type expression the type Test.EasyCheck.PropIO?
 isPropIOType :: CTypeExpr -> Bool
 isPropIOType texp = case texp of
-  CTCons (mn,tc) [] -> tc == "PropIO" && isCheckModule mn
-  _                 -> False
+  CTCons (mn,tc) -> tc == "PropIO" && isCheckModule mn
+  _              -> False
 
 -- Is the module name Test.Prop or Test.EasyCheck?
 isCheckModule :: String -> Bool

src/SimplifyPostConds.curry

@@ -11,7 +11,7 @@
 ---      theorem'sorted xs = always (sorted (sort xs))
 ---
 --- @author Michael Hanus
---- @version August 2016
+--- @version October 2016
 ------------------------------------------------------------------------