Commit f63812da authored by Jan Rasmus Tikovsky 's avatar Jan Rasmus Tikovsky
Browse files

Fix test suite for type classes

parent ea6d144a
......@@ -203,7 +203,7 @@ failInfos = map (uncurry mkFailTest)
, ("ExportCheck/OutsideTypeLabel", ["Label `value' outside type export in export list"])
, ("ExportCheck/UndefinedElement", ["`foo' is not a constructor or label of type `Bool'"])
, ("ExportCheck/UndefinedName", ["Undefined name `foo' in export list"])
, ("ExportCheck/UndefinedType", ["Undefined type `Foo' in export list"])
, ("ExportCheck/UndefinedType", ["Undefined type or class `Foo' in export list"])
, ("FP_Cyclic", ["Function `g' used in functional pattern depends on `f' causing a cyclic dependency"])
, ("FP_Restrictions",
[ "Functional patterns are not supported inside a case expression"
......@@ -219,8 +219,8 @@ failInfos = map (uncurry mkFailTest)
]
)
, ("KindCheck",
[ "Type variable a occurs more than once on left hand side of type declaration"
, "Type variable b occurs more than once on left hand side of type declaration"
[ "Type variable a occurs more than once in left hand side of type declaration"
, "Type variable b occurs more than once in left hand side of type declaration"
]
)
, ("MultipleArities", ["Equations for `test' have different arities"])
......@@ -236,17 +236,13 @@ failInfos = map (uncurry mkFailTest)
, ("PragmaError", ["Unknown language extension"])
, ("PrecedenceRange", ["Precedence out of range"])
, ("RecordLabelIDs", ["Multiple declarations of `RecordLabelIDs.id'"])
, ("RecursiveTypeSyn", ["Recursive synonym types A and B"])
, ("RecursiveTypeSyn", ["Mutually recursive synonym and/or renaming types A and B (line 12.6)"])
, ("SyntaxError", ["Type error in application"])
, ("TypedFreeVariables",
["Free variable x has a polymorphic type", "Type signature too general"]
["Variable x has a polymorphic type", "Type error in equation"]
)
, ("TypeError1",
[ "Type error in explicitly typed expression"
, "Type signature too general"
]
)
, ("TypeError2", ["Type error in infix application"])
, ("TypeError1", ["Type error in explicitly typed expression"])
, ("TypeError2", ["Missing instance for Prelude.Num Prelude.Bool"])
]
--------------------------------------------------------------------------------
......@@ -266,11 +262,11 @@ warnInfos = map (uncurry mkFailTest)
)
, ("Case1", ["Pattern matches are non-exhaustive", "In an equation for `h'"])
, ("Case2",
[ "An fcase expression is non-deterministic due to overlapping rules"
[ "An fcase expression is potentially non-deterministic due to overlapping rules"
, "Pattern matches are non-exhaustive", "In an fcase alternative"
, "In a case alternative", "In an equation for `fp'"
, "Pattern matches are unreachable"
, "Function `fp' is non-deterministic due to overlapping rules"
, "Function `fp' is potentially non-deterministic due to overlapping rules"
, "Pattern matches are non-exhaustive"
]
)
......@@ -304,10 +300,10 @@ warnInfos = map (uncurry mkFailTest)
)
, ("OverlappingPatterns",
[ "Pattern matches are unreachable", "In a case alternative"
, "An fcase expression is non-deterministic due to overlapping rules"
, "Function `i' is non-deterministic due to overlapping rules"
, "Function `j' is non-deterministic due to overlapping rules"
, "Function `k' is non-deterministic due to overlapping rules"
, "An fcase expression is potentially non-deterministic due to overlapping rules"
, "Function `i' is potentially non-deterministic due to overlapping rules"
, "Function `j' is potentially non-deterministic due to overlapping rules"
, "Function `k' is potentially non-deterministic due to overlapping rules"
]
)
, ("ShadowingSymbols",
......
----------------------------------------------------------------------------
--- The standard prelude of Curry.
--- All top-level functions defined in this module
--- are always available in any Curry program.
--- The standard prelude of Curry (with type classes).
--- All top-level functions, data types, classes and methods defined
--- in this module are always available in any Curry program.
---
--- @category general
----------------------------------------------------------------------------
{-# LANGUAGE CPP #-}
{-# OPTIONS_CYMAKE -Wno-incomplete-patterns -Wno-overlapping #-}
module Prelude where
module Prelude
(
-- classes and overloaded functions
Eq(..)
, elem, notElem, lookup
, Ord(..)
, Show(..), ShowS, print, shows, showChar, showString, showParen
, Read (..), ReadS, lex, read, reads, readParen
, Bounded (..), Enum (..), boundedEnumFrom, boundedEnumFromThen
, asTypeOf
, Num(..), Fractional(..), Real(..), Integral(..)
-- data types
, Bool (..) , Char (..) , Int (..) , Float (..), String , Ordering (..)
, Success, Maybe (..), Either (..), IO (..), IOError (..)
, DET
-- functions
, (.), id, const, curry, uncurry, flip, until, seq, ensureNotFree
, ensureSpine, ($), ($!), ($!!), ($#), ($##), error
, failed, (&&), (||), not, otherwise, if_then_else, solve
, fst, snd, head, tail, null, (++), length, (!!), map, foldl, foldl1
, foldr, foldr1, filter, zip, zip3, zipWith, zipWith3, unzip, unzip3
, concat, concatMap, iterate, repeat, replicate, take, drop, splitAt
, takeWhile, dropWhile, span, break, lines, unlines, words, unwords
, reverse, and, or, any, all
, ord, chr, (=:=), success, (&), (&>), maybe
, either, (>>=), return, (>>), done, putChar, getChar, readFile
, writeFile, appendFile
, putStr, putStrLn, getLine, userError, ioError, showError
, catch, doSolve, sequenceIO, sequenceIO_, mapIO
, mapIO_, (?), anyOf, unknown
, when, unless, forIO, forIO_, liftIO, foldIO
, normalForm, groundNormalForm, apply, cond, (=:<=)
, enumFrom_, enumFromTo_, enumFromThen_, enumFromThenTo_, negate_, negateFloat
, PEVAL
, Monad(..)
, Functor(..)
#ifdef __PAKCS__
, (=:<<=), letrec
#endif
) where
-- Lines beginning with "--++" are part of the prelude
-- but cannot parsed by the compiler
-- Infix operator declarations:
infixl 9 !!
infixr 9 .
infixl 7 *, `div`, `mod`, `quot`, `rem`
infixl 7 *, `div`, `mod`, `quot`, `rem`, /
infixl 6 +, -
-- infixr 5 : -- declared together with list
infixr 5 ++
infix 4 =:=, ==, /=, <, >, <=, >=, =:<=
infix 4 `elem`, `notElem`
#ifdef __PAKCS__
infix 4 =:<<=
#endif
infix 4 `elem`, `notElem`
infixr 3 &&
infixr 2 ||
infixl 1 >>, >>=
......@@ -31,10 +73,9 @@ infixr 0 $, $!, $!!, $#, $##, `seq`, &, &>, ?
-- externally defined types for numbers and characters
data Int
data Float
data Char
external data Int
external data Float
external data Char
type String = [Char]
......@@ -126,6 +167,7 @@ failed external
-- Boolean values
-- already defined as builtin, since it is required for if-then-else
data Bool = False | True
deriving (Eq, Ord, Show, Read)
--- Sequential conjunction on Booleans.
(&&) :: Bool -> Bool -> Bool
......@@ -166,14 +208,6 @@ solve True = True
(&>) :: Bool -> a -> a
True &> x = x
--- Equality on finite ground data terms.
(==) :: a -> a -> Bool
(==) external
--- Disequality.
(/=) :: a -> a -> Bool
x /= y = not (x==y)
--- The equational constraint.
--- `(e1 =:= e2)` is satisfiable if both sides `e1` and `e2` can be
--- reduced to a unifiable data term (i.e., a term without defined
......@@ -187,42 +221,71 @@ x /= y = not (x==y)
(&) :: Bool -> Bool -> Bool
(&) external
-- used for comparison of standard types like Int, Float and Char
eqChar :: Char -> Char -> Bool
#ifdef __PAKCS__
eqChar x y = (prim_eqChar $# y) $# x
prim_eqChar :: Char -> Char -> Bool
prim_eqChar external
#else
eqChar external
#endif
eqInt :: Int -> Int -> Bool
#ifdef __PAKCS__
eqInt x y = (prim_eqInt $# y) $# x
prim_eqInt :: Int -> Int -> Bool
prim_eqInt external
#else
eqInt external
#endif
eqFloat :: Float -> Float -> Bool
#ifdef __PAKCS__
eqFloat x y = (prim_eqFloat $# y) $# x
prim_eqFloat :: Float -> Float -> Bool
prim_eqFloat external
#else
eqFloat external
#endif
--- Ordering type. Useful as a result of comparison functions.
data Ordering = LT | EQ | GT
--- Comparison of arbitrary ground data terms.
--- Data constructors are compared in the order of their definition
--- in the datatype declarations and recursively in the arguments.
compare :: a -> a -> Ordering
compare x y | x == y = EQ
| x <= y = LT
| otherwise = GT
--- Less-than on ground data terms.
(<) :: a -> a -> Bool
x < y = not (y <= x)
--- Greater-than on ground data terms.
(>) :: a -> a -> Bool
x > y = not (x <= y)
--- Less-or-equal on ground data terms.
(<=) :: a -> a -> Bool
(<=) external
--- Greater-or-equal on ground data terms.
(>=) :: a -> a -> Bool
x >= y = not (x < y)
--- Maximum of ground data terms.
max :: a -> a -> a
max x y = if x >= y then x else y
--- Minimum of ground data terms.
min :: a -> a -> a
min x y = if x <= y then x else y
deriving (Eq, Ord, Show, Read)
-- used for comparison of standard types like Int, Float and Char
ltEqChar :: Char -> Char -> Bool
#ifdef __PAKCS__
ltEqChar x y = (prim_ltEqChar $# y) $# x
prim_ltEqChar :: Char -> Char -> Bool
prim_ltEqChar external
#else
ltEqChar external
#endif
ltEqInt :: Int -> Int -> Bool
#ifdef __PAKCS__
ltEqInt x y = (prim_ltEqInt $# y) $# x
prim_ltEqInt :: Int -> Int -> Bool
prim_ltEqInt external
#else
ltEqInt external
#endif
ltEqFloat :: Float -> Float -> Bool
#ifdef __PAKCS__
ltEqFloat x y = (prim_ltEqFloat $# y) $# x
prim_ltEqFloat :: Float -> Float -> Bool
prim_ltEqFloat external
#else
ltEqFloat external
#endif
-- Pairs
......@@ -266,13 +329,15 @@ null (_:_) = False
(x:xs) ++ ys = x : xs++ys
--- Computes the length of a list.
length :: [_] -> Int
--length :: [_] -> Int
--length [] = 0
--length (_:xs) = 1 + length xs
length :: [_] -> Int
length xs = len xs 0
where
len [] n = n
len (_:ys) n = let np1 = n + 1 in len ys $!! np1
--length [] = 0
--length (_:xs) = 1 + length xs
--- List index (subscript) operator, head has index 0.
(!!) :: [a] -> Int -> a
......@@ -305,9 +370,9 @@ foldr _ z [] = z
foldr f z (x:xs) = f x (foldr f z xs)
--- Accumulates a non-empty list from right to left:
foldr1 :: (a -> a -> a) -> [a] -> a
foldr1 _ [x] = x
foldr1 f (x1:x2:xs) = f x1 (foldr1 f (x2:xs))
foldr1 :: (a -> a -> a) -> [a] -> a
foldr1 _ [x] = x
foldr1 f (x:xs@(_:_)) = f x (foldr1 f xs)
--- Filters all elements satisfying a given predicate in a list.
filter :: (a -> Bool) -> [a] -> [a]
......@@ -384,10 +449,10 @@ take n l = if n<=0 then [] else takep n l
takep m (x:xs) = x : take (m-1) xs
--- Returns suffix without first n elements.
drop :: Int -> [a] -> [a]
drop n l = if n<=0 then l else dropp n l
where dropp _ [] = []
dropp m (_:xs) = drop (m-1) xs
drop :: Int -> [a] -> [a]
drop n xs = if n<=0 then xs
else case xs of [] -> []
(_:ys) -> drop (n-1) ys
--- (splitAt n xs) is equivalent to (take n xs, drop n xs)
splitAt :: Int -> [a] -> ([a],[a])
......@@ -438,8 +503,6 @@ words s = let s1 = dropWhile isSpace s
in if s1=="" then []
else let (w,s2) = break isSpace s1
in w : words s2
where
isSpace c = c == ' ' || c == '\t' || c == '\n' || c == '\r'
--- Concatenates a list of strings with a blank between two strings.
unwords :: [String] -> String
......@@ -467,37 +530,38 @@ all :: (a -> Bool) -> [a] -> Bool
all p = and . map p
--- Element of a list?
elem :: a -> [a] -> Bool
elem x = any (x==)
elem :: Eq a => a -> [a] -> Bool
elem x = any (x ==)
--- Not element of a list?
notElem :: a -> [a] -> Bool
notElem x = all (x/=)
notElem :: Eq a => a -> [a] -> Bool
notElem x = all (x /=)
--- Looks up a key in an association list.
lookup :: a -> [(a,b)] -> Maybe b
lookup :: Eq a => a -> [(a, b)] -> Maybe b
lookup _ [] = Nothing
lookup k ((x,y):xys)
| k==x = Just y
| otherwise = lookup k xys
--- Generates an infinite sequence of ascending integers.
enumFrom :: Int -> [Int] -- [n..]
enumFrom n = n : enumFrom (n+1)
enumFrom_ :: Int -> [Int] -- [n..]
enumFrom_ n = n : enumFrom_ (n+1)
--- Generates an infinite sequence of integers with a particular in/decrement.
enumFromThen :: Int -> Int -> [Int] -- [n1,n2..]
enumFromThen n1 n2 = iterate ((n2-n1)+) n1
enumFromThen_ :: Int -> Int -> [Int] -- [n1,n2..]
enumFromThen_ n1 n2 = iterate ((n2-n1)+) n1
--- Generates a sequence of ascending integers.
enumFromTo :: Int -> Int -> [Int] -- [n..m]
enumFromTo n m = if n>m then [] else n : enumFromTo (n+1) m
enumFromTo_ :: Int -> Int -> [Int] -- [n..m]
enumFromTo_ n m = if n>m then [] else n : enumFromTo_ (n+1) m
--- Generates a sequence of integers with a particular in/decrement.
enumFromThenTo :: Int -> Int -> Int -> [Int] -- [n1,n2..m]
enumFromThenTo n1 n2 m = takeWhile p (enumFromThen n1 n2)
where p x | n2 >= n1 = (x <= m)
| otherwise = (x >= m)
enumFromThenTo_ :: Int -> Int -> Int -> [Int] -- [n1,n2..m]
enumFromThenTo_ n1 n2 m = takeWhile p (enumFromThen_ n1 n2)
where
p x | n2 >= n1 = (x <= m)
| otherwise = (x >= m)
--- Converts a character into its ASCII value.
......@@ -520,67 +584,130 @@ prim_chr external
-- Types of primitive arithmetic functions and predicates
--- Adds two integers.
(+) :: Int -> Int -> Int
(+) external
(+$) :: Int -> Int -> Int
#ifdef __PAKCS__
x +$ y = (prim_Int_plus $# y) $# x
prim_Int_plus :: Int -> Int -> Int
prim_Int_plus external
#else
(+$) external
#endif
--- Subtracts two integers.
(-) :: Int -> Int -> Int
(-) external
(-$) :: Int -> Int -> Int
#ifdef __PAKCS__
x -$ y = (prim_Int_minus $# y) $# x
prim_Int_minus :: Int -> Int -> Int
prim_Int_minus external
#else
(-$) external
#endif
--- Multiplies two integers.
(*) :: Int -> Int -> Int
(*) external
(*$) :: Int -> Int -> Int
#ifdef __PAKCS__
x *$ y = (prim_Int_times $# y) $# x
prim_Int_times :: Int -> Int -> Int
prim_Int_times external
#else
(*$) external
#endif
--- Integer division. The value is the integer quotient of its arguments
--- and always truncated towards negative infinity.
--- Thus, the value of <code>13 `div` 5</code> is <code>2</code>,
--- and the value of <code>-15 `div` 4</code> is <code>-4</code>.
div :: Int -> Int -> Int
div external
--- and the value of <code>-15 `div` 4</code> is <code>-3</code>.
div_ :: Int -> Int -> Int
#ifdef __PAKCS__
x `div_` y = (prim_Int_div $# y) $# x
prim_Int_div :: Int -> Int -> Int
prim_Int_div external
#else
div_ external
#endif
--- Integer remainder. The value is the remainder of the integer division and
--- it obeys the rule <code>x `mod` y = x - y * (x `div` y)</code>.
--- Thus, the value of <code>13 `mod` 5</code> is <code>3</code>,
--- and the value of <code>-15 `mod` 4</code> is <code>-3</code>.
mod :: Int -> Int -> Int
mod external
mod_ :: Int -> Int -> Int
#ifdef __PAKCS__
x `mod_` y = (prim_Int_mod $# y) $# x
prim_Int_mod :: Int -> Int -> Int
prim_Int_mod external
#else
mod_ external
#endif
--- Returns an integer (quotient,remainder) pair.
--- The value is the integer quotient of its arguments
--- and always truncated towards negative infinity.
divMod :: Int -> Int -> (Int, Int)
divMod external
divMod_ :: Int -> Int -> (Int, Int)
#ifdef __PAKCS__
divMod_ x y = (x `div` y, x `mod` y)
#else
divMod_ external
#endif
--- Integer division. The value is the integer quotient of its arguments
--- and always truncated towards zero.
--- Thus, the value of <code>13 `quot` 5</code> is <code>2</code>,
--- and the value of <code>-15 `quot` 4</code> is <code>-3</code>.
quot :: Int -> Int -> Int
quot external
quot_ :: Int -> Int -> Int
#ifdef __PAKCS__
x `quot_` y = (prim_Int_quot $# y) $# x
prim_Int_quot :: Int -> Int -> Int
prim_Int_quot external
#else
quot_ external
#endif
--- Integer remainder. The value is the remainder of the integer division and
--- it obeys the rule <code>x `rem` y = x - y * (x `quot` y)</code>.
--- Thus, the value of <code>13 `rem` 5</code> is <code>3</code>,
--- and the value of <code>-15 `rem` 4</code> is <code>-3</code>.
rem :: Int -> Int -> Int
rem external
rem_ :: Int -> Int -> Int
#ifdef __PAKCS__
x `rem_` y = (prim_Int_rem $# y) $# x
prim_Int_rem :: Int -> Int -> Int
prim_Int_rem external
#else
rem_ external
#endif
--- Returns an integer (quotient,remainder) pair.
--- The value is the integer quotient of its arguments
--- and always truncated towards zero.
quotRem :: Int -> Int -> (Int, Int)
quotRem external
quotRem_ :: Int -> Int -> (Int, Int)
#ifdef __PAKCS__
quotRem_ x y = (x `quot` y, x `rem` y)
#else
quotRem_ external
#endif
--- Unary minus. Usually written as "- e".
negate :: Int -> Int
negate x = 0 - x
negate_ :: Int -> Int
negate_ x = 0 - x
--- Unary minus on Floats. Usually written as "-e".
negateFloat :: Float -> Float
negateFloat external
#ifdef __PAKCS__
negateFloat x = prim_negateFloat $# x
prim_negateFloat :: Float -> Float
prim_negateFloat external
#else
negateFloat external
#endif
-- Constraints (included for backwar compatibility)
-- Constraints (included for backward compatibility)
type Success = Bool
--- The always satisfiable constraint.
......@@ -590,6 +717,7 @@ success = True
-- Maybe type
data Maybe a = Nothing | Just a
deriving (Eq, Ord, Show, Read)
maybe :: b -> (a -> b) -> Maybe a -> b
maybe n _ Nothing = n
......@@ -599,6 +727,7 @@ maybe _ f (Just x) = f x
-- Either type
data Either a b = Left a | Right b
deriving (Eq, Ord, Show, Read)
either :: (a -> c) -> (b -> c) -> Either a b -> c
either f _ (Left x) = f x
......@@ -607,34 +736,34 @@ either _ g (Right x) = g x
-- Monadic IO
data IO _ -- conceptually: World -> (a,World)
external data IO _ -- conceptually: World -> (a,World)
--- Sequential composition of actions.
--- Sequential composition of IO actions.
--- @param a - An action
--- @param fa - A function from a value into an action
--- @return An action that first performs a (yielding result r)
--- and then performs (fa r)
(>>=) :: IO a -> (a -> IO b) -> IO b
(>>=) external
(>>=$) :: IO a -> (a -> IO b) -> IO b
(>>=$) external
--- The empty action that directly returns its argument.
return :: a -> IO a
return external
--- The empty IO action that directly returns its argument.
returnIO :: a -> IO a
returnIO external
--- Sequential composition of actions.
--- @param a1 - An action
--- @param a2 - An action
--- @return An action that first performs a1 and then a2
(>>) :: IO _ -> IO b -> IO b
a >> b = a >>= (\_ -> b)
--- Sequential composition of IO actions.
--- @param a1 - An IO action
--- @param a2 - An IO action
--- @return An IO action that first performs a1 and then a2
(>>$) :: IO _ -> IO b -> IO b
a >>$ b = a >>=$ (\_ -> b)
--- The empty action that returns nothing.
done :: IO ()
done = return ()
--- The empty IO action that returns nothing.
done :: IO ()
done = return ()
--- An action that puts its character argument on standard output.
putChar :: Char -> IO ()
putChar c = prim_putChar $## c
putChar c = prim_putChar $# c
prim_putChar :: Char -> IO ()
prim_putChar external
......@@ -649,12 +778,17 @@ readFile f = prim_readFile $## f
prim_readFile :: String -> IO String
prim_readFile external
#ifdef __PAKCS__
-- for internal implementation of readFile:
prim_readFileContents :: String -> String
prim_readFileContents external
#endif
--- An action that writes a file.
--- @param filename - The name of the file to be written.
--- @param contents - The contents to be written to the file.
writeFile :: String -> String -> IO ()
writeFile f s = (prim_writeFile $## f) $## s
writeFile f s = (prim_writeFile $## f) s
prim_writeFile :: String -> String -> IO ()
prim_writeFile external
......@@ -664,7 +798,7 @@ prim_writeFile external
--- @param filename - The name of the file to be written.
--- @param contents - The contents to be appended to the file.
appendFile :: String -> String -> IO ()
appendFile f s = (prim_appendFile $## f) $## s
appendFile f s = (prim_appendFile $## f) s
prim_appendFile :: String -> String -> IO ()
prim_appendFile external
......@@ -701,6 +835,7 @@ data IOError
| UserError String -- user-specified error
| FailError String -- failing computation
| NondetError String -- non-deterministic computation
deriving (Eq,Show,Read)
--- A user error value is created by providing a description of the
--- error situation as a string.
......@@ -709,10 +844,14 @@ userError s = UserError s
--- Raises an I/O exception with a given error value.
ioError :: IOError -> IO _
#ifdef __PAKCS__
ioError err = error (showError err)
#else
ioError err = prim_ioError $## err
prim_ioError :: IOError -> IO _
prim_ioError external