--- /dev/null
+TOP = ..
+include $(TOP)/mk/boilerplate.mk
+
+SUBDIRS = should_fail should_compile
+
+include $(TOP)/mk/target.mk
+
+
--- /dev/null
+_interface_ ClassFoo 1
+_exports_
+ClassFoo Foo(op1 op2);
+_declarations_
+1 class Foo a where { op1 :: a -> PrelBase.Int; op2 :: a -> a -> PrelBase.Int} ;
--- /dev/null
+interface M where
+class (ORD a, Text a) => EQ a where (===) :: a -> a -> Bool
+class (Num a) => ORD a
+data NUM = ONE | TWO
--- /dev/null
+TOP = ../../../..
+include $(TOP)/mk/boilerplate.mk
+
+HS_SRCS = $(wildcard *.hs)
+
+SRC_RUNTEST_OPTS += -o1 $*.stdout -o2 $*.stderr -x 0
+HC_OPTS += -noC -dcore-lint
+
+%.o : %.hs
+ $(RUNTEST) $(HC) $(RUNTEST_OPTS) -- $(HC_OPTS) -c $< -o $@
+
+all :: $(HS_OBJS)
+
+tc019_HC_OPTS = -fglasgow-exts
+tc065_HC_OPTS = -syslib ghc
+
+include $(TOP)/mk/target.mk
+
+
--- /dev/null
+interface ShouldSucceed where {
+{- TCE -}
+{- CE -}
+{- LVE -}
+a :: Num t64 => t64 -> t64
+{- GIEinst -}
+}
--- /dev/null
+_interface_ TheUtils 2
+_instance_modules_
+ArrBase IO PrelNum
+_usages_
+PrelBase 1 :: $d1 1 $d11 1 $d14 1 $d15 1 $d16 1 $d17 1 $d18 1 $d19 1 $d2 1 $d21 1 $d22 1 $d23 1 $d24 1 $d25 1 $d26 1 $d27 1 $d3 1 $d32 1 $d33 1 $d34 1 $d36 1 $d37 1 $d38 1 $d39 1 $d41 1 $d42 1 $d44 1 $d45 1 $d46 1 $d48 1 $d49 1 $d50 1 $d51 1 $d53 1 $d54 1 $d55 1 $d57 1 $d6 1 $d7 1 $d8 1 $m* 1 $m+ 1 $m++ 1 $m- 1 $m/= 1 $m< 1 $m<= 1 $m== 1 $m> 1 $m>= 1 $m>> 1 $m>>= 1 $mabs 1 $mcompare 1 $mfromInt 1 $mfromInteger 1 $mmap 1 $mmax 1 $mmin 1 $mnegate 1 $mreturn 1 $mshowList 1 $mshowsPrec 1 $msignum 1 $mzero 1 && 1 . 1 not 1 otherwise 1 show 1 || 1 Eq 1 Eval 1 Functor 1 Maybe 1 Monad 1 MonadPlus 1 MonadZero 1 Num 1 Ord 1 Ordering 1 Ordering 1 Show 1 String 1;
+PrelList 1 :: repeat 1 reverse 1 span 1 take 1;
+PrelNum 1 :: $d10 1 $d16 1 $d17 1 $d18 1 $d29 1 $d33 1 $d34 1 $d35 1;
+PrelTup 1 :: $d10 1 $d13 1 $d14 1 $d3 1 $d4 1 $d49 1 $d50 1 $d9 1;
+Pretty 1 :: $d1 1 $d2 1 hsep 1 int 1 sep 1 text 1 Doc 1;
+_exports_
+TheUtils appEager assertPanic assertPprPanic assoc assocDefault assocDefaultUsing assocUsing cmpList cmpPString endsWith equivClasses hasNoDups isIn isSingleton isn'tIn lengthExceeds mapAccumB mapAccumL mapAccumR mapAndUnzip mapAndUnzip3 mapEager nOfThem naturalMergeSortLe panic panic# pprError pprPanic pprPanic# pprTrace removeDups returnEager runEager runs sortLt startsWith thenCmp thenEager transitiveClosure unzipWith zipEqual zipLazy zipWith3Equal zipWith4Equal zipWithEqual Eager Ord3(cmp);
+_fixities_
+infixr 9 thenCmp;
+_instances_
+instance {Ord3 PrelBase.Int} = $d1;
+instance _forall_ [a] {Ord3 a} => {Ord3 (PrelBase.Maybe a)} = $d2;
+instance _forall_ [a] {Ord3 a} => {Ord3 [a]} = $d3;
+_declarations_
+2 $d1 _:_ {Ord3 PrelBase.Int} ;;
+1 $d2 _:_ _forall_ [a] {Ord3 a} => {Ord3 (PrelBase.Maybe a)} ;;
+1 $d3 _:_ _forall_ [a] {Ord3 a} => {Ord3 [a]} ;;
+1 $mcmp _:_ _forall_ [a] {Ord3 a} => a -> a -> GHC.Int# ;;
+2 type Eager rvB rvC = (rvC -> rvB) -> rvB ;
+2 class Ord3 rvx where {cmp :: rvx -> rvx -> GHC.Int#} ;
+1 appEager _:_ _forall_ [a b] => Eager b a -> (a -> b) -> b ;;
+1 assertPanic _:_ _forall_ [a] => PrelBase.String -> PrelBase.Int -> a ;;
+2 assertPprPanic _:_ _forall_ [a] => PrelBase.String -> PrelBase.Int -> Pretty.Doc -> a ;;
+1 assoc _:_ _forall_ [a b] {PrelBase.Eq a} => PrelBase.String -> [(a, b)] -> a -> b ;;
+1 assocDefault _:_ _forall_ [a b] {PrelBase.Eq a} => b -> [(a, b)] -> a -> b ;;
+1 assocDefaultUsing _:_ _forall_ [a b] => (a -> a -> PrelBase.Bool) -> b -> [(a, b)] -> a -> b ;;
+1 assocUsing _:_ _forall_ [a b] => (a -> a -> PrelBase.Bool) -> PrelBase.String -> [(a, b)] -> a -> b ;;
+1 cmpList _:_ _forall_ [a] => (a -> a -> GHC.Int#) -> [a] -> [a] -> GHC.Int# ;;
+1 endsWith _:_ PrelBase.String -> PrelBase.String -> PrelBase.Maybe PrelBase.String ;;
+1 equivClasses _:_ _forall_ [a] => (a -> a -> GHC.Int#) -> [a] -> [[a]] ;;
+1 hasNoDups _:_ _forall_ [a] {PrelBase.Eq a} => [a] -> PrelBase.Bool ;;
+1 isIn _:_ _forall_ [a] {PrelBase.Eq a} => PrelBase.String -> a -> [a] -> PrelBase.Bool ;;
+1 isSingleton _:_ _forall_ [a] => [a] -> PrelBase.Bool ;;
+1 isn'tIn _:_ _forall_ [a] {PrelBase.Eq a} => PrelBase.String -> a -> [a] -> PrelBase.Bool ;;
+1 lengthExceeds _:_ _forall_ [a] => [a] -> PrelBase.Int -> PrelBase.Bool ;;
+1 mapAccumB _:_ _forall_ [a b c d] => (b -> c -> a -> (b, c, d)) -> b -> c -> [a] -> (b, c, [d]) ;;
+1 mapAccumL _:_ _forall_ [a b c] => (b -> a -> (b, c)) -> b -> [a] -> (b, [c]) ;;
+1 mapAccumR _:_ _forall_ [a b c] => (b -> a -> (b, c)) -> b -> [a] -> (b, [c]) ;;
+1 mapAndUnzip _:_ _forall_ [a b c] => (a -> (b, c)) -> [a] -> ([b], [c]) ;;
+1 mapAndUnzip3 _:_ _forall_ [a b c d] => (a -> (b, c, d)) -> [a] -> ([b], [c], [d]) ;;
+1 mapEager _:_ _forall_ [a b c] => (a -> (c -> b) -> b) -> [a] -> ([c] -> b) -> b ;;
+1 nOfThem _:_ _forall_ [a] => PrelBase.Int -> a -> [a] ;;
+1 naturalMergeSortLe _:_ _forall_ [a] => (a -> a -> PrelBase.Bool) -> [a] -> [a] ;;
+1 panic _:_ _forall_ [a] => [PrelBase.Char] -> a ;;
+1 panic# _:_ PrelBase.String -> GHC.Int# ;;
+1 pprError _:_ _forall_ [a b] {PrelBase.Show a} => [PrelBase.Char] -> a -> b ;;
+1 pprPanic _:_ _forall_ [a b] {PrelBase.Show a} => [PrelBase.Char] -> a -> b ;;
+1 pprPanic# _:_ _forall_ [a] {PrelBase.Show a} => [PrelBase.Char] -> a -> GHC.Int# ;;
+1 pprTrace _:_ _forall_ [a b] {PrelBase.Show a} => [PrelBase.Char] -> a -> b -> b ;;
+1 removeDups _:_ _forall_ [a] => (a -> a -> GHC.Int#) -> [a] -> ([a], [[a]]) ;;
+1 returnEager _:_ _forall_ [a b] => b -> (b -> a) -> a ;;
+1 runEager _:_ _forall_ [a] => Eager a a -> a ;;
+1 runs _:_ _forall_ [a] => (a -> a -> PrelBase.Bool) -> [a] -> [[a]] ;;
+1 sortLt _:_ _forall_ [a] => (a -> a -> PrelBase.Bool) -> [a] -> [a] ;;
+1 startsWith _:_ PrelBase.String -> PrelBase.String -> PrelBase.Maybe PrelBase.String ;;
+1 thenCmp _:_ GHC.Int# -> GHC.Int# -> GHC.Int# ;;
+1 thenEager _:_ _forall_ [a b c] => Eager b a -> (a -> (c -> b) -> b) -> (c -> b) -> b ;;
+1 transitiveClosure _:_ _forall_ [a] => (a -> [a]) -> (a -> a -> PrelBase.Bool) -> [a] -> [a] ;;
+1 unzipWith _:_ _forall_ [a b c] => (a -> b -> c) -> [(a, b)] -> [c] ;;
+1 zipEqual _:_ _forall_ [a b] => PrelBase.String -> [a] -> [b] -> [(a, b)] ;;
+1 zipLazy _:_ _forall_ [a b] => [a] -> [b] -> [(a, b)] ;;
+1 zipWith3Equal _:_ _forall_ [a b c d] => PrelBase.String -> (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d] ;;
+1 zipWith4Equal _:_ _forall_ [a b c d e] => PrelBase.String -> (a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e] ;;
+1 zipWithEqual _:_ _forall_ [a b c] => PrelBase.String -> (a -> b -> c) -> [a] -> [b] -> [c] ;;
--- /dev/null
+module ShouldSucceed where
+
+a x = y+2 where y = x+3
--- /dev/null
+module ShouldSucceed where
+
+b = if True then 1 else 2
--- /dev/null
+module ShouldSucceed where
+
+-- This is a somewhat surprising program.
+-- It shows up the monomorphism restriction, *and* ambiguity resolution!
+-- The binding is a pattern binding without a signature, so it is monomorphic.
+-- Hence the types of c,d,e are not universally quantified. But then
+-- their type variables are ambiguous, so the ambiguity resolution leaps
+-- into action, and resolves them to Integer.
+
+-- That's why we check the interface file in the test suite.
+
+(c@(d,e)) = if True then (1,2) else (1,3)
--- /dev/null
+module ShouldSucceed where
+
+f x = case x of
+ True -> True
+ False -> x
--- /dev/null
+module ShouldSucceed where
+
+g ((x:z),y) = x
+g (x,y) = 2
--- /dev/null
+module ShouldSucceed where
+
+h = 1:h
--- /dev/null
+module ShouldSucceed where
+
+j = 2
+
+k = 1:j:l
+
+l = 0:k
+
+m = j+j
--- /dev/null
+module ShouldSucceed where
+
+n True = 1
+n False = 0
--- /dev/null
+module ShouldSucceed where
+
+o (True,x) = x
+o (False,y) = y+1
--- /dev/null
+module ShouldSucceed where
+
+p = [(y+2,True) | y <- [1,2]]
--- /dev/null
+module ShouldSucceed where
+
+x@_ = x
--- /dev/null
+module ShouldSucceed where
+
+q = \ y -> y
--- /dev/null
+module ShouldSucceed where
+
+(r,s) = (1,'a')
--- /dev/null
+module ShouldSucceed where
+
+t = 1+t
--- /dev/null
+module ShouldSucceed where
+
+u x = \ (y,z) -> x
--- /dev/null
+module ShouldSucceed where
+
+f x@_ y@_ = x
--- /dev/null
+module ShouldSucceed where
+
+v | True = v+1
+ | False = v
--- /dev/null
+module ShouldSucceed where
+
+w = a where a = y
+ y = 2
--- /dev/null
+module ShouldSucceed where
+
+(al:am) = [y+1 | (y,z) <- [(1,2)]]
--- /dev/null
+module ShouldSucceed where
+
+f x = a where a = x:a
--- /dev/null
+module ShouldSucceed where
+
+f x = a
+
+a = (x,x)
+
+x = x
--- /dev/null
+module ShouldSucceed where
+
+main = iD iD
+
+iD x = x
--- /dev/null
+module ShouldSucceed where
+
+main = s k k
+
+s f g x = f x (g x)
+
+k x y = x
--- /dev/null
+module ShouldSucceed where
+
+main x = s k k x
+
+s f g x = f x (g x)
+
+k x y = x
--- /dev/null
+module ShouldSucceed where
+
+g x = f (f True x) x where f x y = if x then y else (f x y)
--- /dev/null
+module ShouldSucceed where
+
+g x = f (f True x) x
+f x y = if x then y else (f x y)
--- /dev/null
+module ShouldSucceed where
+
+h x = f (f True x) x
+f x y = if x then y else (g y x)
+g y x = if x then y else (f x y)
--- /dev/null
+module ShouldSucceed where
+
+type H = (Int,Bool)
--- /dev/null
+module ShouldSucceed where
+
+type G = [Int]
+
+data K = H Bool | M G
+
--- /dev/null
+module ShouldSucceed where
+
+type H = [Bool]
+
+type G = (H,Char)
--- /dev/null
+module ShouldSucceed where
+
+data Rec = Node Int Rec
--- /dev/null
+module ShouldSucceed where
+
+data AList b = Node b [b] | Other (b,Char)
--- /dev/null
+module ShouldSucceed where
+
+data Twine = Twine2 Twist
+
+data Twist = Twist2 Twine
+
+type F = Twine
--- /dev/null
+module ShouldSucceed where
+
+data AList a = ANull | ANode a (AList a)
+
+type IntList = AList Int
+
+g (ANull) = 2
+g (ANode b (ANode c d)) | b = 3
+ | True = 4
+
+
--- /dev/null
+module ShouldSucceed where
+
+type AnnExpr a = (a,Expr a)
+
+data Expr a = Var [Char]
+ | App (AnnExpr a) (AnnExpr a)
+
+g (a,(Var name)) = [name]
+g (a,(App e1 e2)) = (g e1) ++ (g e2)
--- /dev/null
+module ShouldSucceed where
+
+class (Eq a) => A a where
+ op1 :: a -> a
--- /dev/null
+interface ShouldSucceed where {
+class Eq' a where {
+ deq :: a -> a -> Bool
+ };
+instance (Eq' a) => Eq' [a] {-# FROMMODULE ShouldSucceed #-}
+}
--- /dev/null
+module ShouldSucceed where
+
+class Eq' a where
+ deq :: a -> a -> Bool
+
+instance (Eq' a) => Eq' [a] where
+ deq [] [] = True
+ deq (x:xs) (y:ys) = if (x `deq` y) then (deq xs ys) else False
+ deq other1 other2 = False
--- /dev/null
+module ShouldSucceed where
+
+f (x:xs) = if (x == (fromInteger 2)) then xs else []
--- /dev/null
+module ShouldSucc where
+
+class (Eq a) => A a where
+ op1 :: a -> a
--- /dev/null
+interface ShouldSucceed where {
+import PreludeCore(Eq)
+f :: Eq a => a -> [a]
+}
--- /dev/null
+module ShouldSucceed where
+
+--!!! tests the deduction of contexts.
+
+f :: (Eq a) => a -> [a]
+
+f x = g x
+ where
+ g y = if (y == x) then [] else [y]
--- /dev/null
+--!!! a very simple test of class and instance declarations
+
+module ShouldSucceed where
+
+class H a where
+ op1 :: a -> a -> a
+
+instance H Bool where
+ op1 x y = y
+
+f :: Bool -> Int -> Bool
+f x y = op1 x x
--- /dev/null
+--!!! a file mailed us by Ryzard Kubiak. This provides a good test of the code
+--!!! handling type signatures and recursive data types.
+
+module ShouldSucceed where
+
+data Boolean = FF | TT
+data Pair a b = Mkpair a b
+data List alpha = Nil | Cons alpha (List alpha)
+data Nat = Zero | Succ Nat
+data Tree t = Leaf t | Node (Tree t) (Tree t)
+
+idb :: Boolean -> Boolean
+idb x = x
+
+
+swap :: Pair a b -> Pair b a
+swap t = case t of
+ Mkpair x y -> Mkpair y x
+
+neg :: Boolean -> Boolean
+neg b = case b of
+ FF -> TT
+ TT -> FF
+
+nUll :: List alpha -> Boolean
+nUll l = case l of
+ Nil -> TT
+ Cons y ys -> FF
+
+idl :: List a -> List a
+idl xs = case xs of
+ Nil -> Nil
+ Cons y ys -> Cons y (idl ys)
+
+add :: Nat -> Nat -> Nat
+add a b = case a of
+ Zero -> b
+ Succ c -> Succ (add c b)
+
+app :: List alpha -> List alpha -> List alpha
+app xs zs = case xs of
+ Nil -> zs
+ Cons y ys -> Cons y (app ys zs)
+
+lEngth :: List a -> Nat
+lEngth xs = case xs of
+ Nil -> Zero
+ Cons y ys -> Succ(lEngth ys)
+
+before :: List Nat -> List Nat
+before xs = case xs of
+ Nil -> Nil
+ Cons y ys -> case y of
+ Zero -> Nil
+ Succ n -> Cons y (before ys)
+
+rEverse :: List alpha -> List alpha
+rEverse rs = case rs of
+ Nil -> Nil
+ Cons y ys -> app (rEverse ys) (Cons y Nil)
+
+
+flatten :: Tree alpha -> List alpha
+flatten t = case t of
+ Leaf x -> Cons x Nil
+ Node l r -> app (flatten l) (flatten r)
+
+sUm :: Tree Nat -> Nat
+sUm t = case t of
+ Leaf t -> t
+ Node l r -> add (sUm l) (sUm r)
+
+
--- /dev/null
+module ShouldSucceed where
+
+--!!! another simple test of class and instance code.
+
+class A a where
+ op1 :: a
+
+instance A Int where
+ op1 = 2
+
+f x = op1
+
+class B b where
+ op2 :: b -> Int
+
+instance (B a) => B [a] where
+ op2 [] = 0
+ op2 (x:xs) = 1 + op2 xs
--- /dev/null
+-- once produced a bug, here as regression test
+
+module P where
+
+f _ | otherwise = ()
+
--- /dev/null
+module H where
+
+class C a where
+ op1 :: a -> a
+
+class (C a) => B a where
+ op2 :: a -> a -> a
+
+instance (B a) => B [a] where
+ op2 xs ys = xs
+
+instance C [a] where
+ op1 xs = xs
+
+{- This was passed by the prototype, but failed hard in the new
+typechecker with the message
+
+Fail:No match in theta_class
+-}
--- /dev/null
+module H where
+
+class C a where
+ op1 :: a -> a
+
+class (C a) => B a where
+ op2 :: a -> a -> a
+
+{- Failed hard in new tc with "No match in theta_class" -}
--- /dev/null
+module ShouldSucceed where
+
+type OL a = [a]
+
+-- produces the interface:
+-- data OL a = MkOL [a] deriving ()
+-- ranOAL :: (OL (a, a)) -> [a]
+-- this interface was produced by BOTH hbc and nhc
+
+-- the following bogus type sig. was accepted by BOTH hbc and nhc
+f x = ranOAL where -- ranOAL :: OL (a,v) -> [a]
+--ranOAL :: OL (a,v) -> [v], the right sig.
+ ranOAL ( xs) = mp sd xs
+
+
+mp f [] = []
+mp f (x:xs) = (f x) : mp f xs
+
+sd (f,s) = s
+
+
+
+
--- /dev/null
+module ShouldSucceed where
+
+data OL a = MkOL [a]
+data FG a b = MkFG (OL (a,b))
+data AFE n a b = MkAFE (OL (n,(FG a b)))
+
+--ranOAL :: OL (a,v) -> [a]
+ranOAL :: OL (a,v) -> [v]
+ranOAL (MkOL xs) = mAp sNd xs
+
+mAp f [] = []
+mAp f (x:xs) = (f x) : mAp f xs
+
+sNd (f,s) = s
+
+ranAFE :: AFE n a b -> [FG a b] -- ?
+ranAFE (MkAFE nfs) = ranOAL nfs
+
+
+
+
--- /dev/null
+module ShouldSucceed where
+
+fib n = if n <= 2 then n else fib (n-1) + fib (n-2)
+
+----------------------------------------
+
+mem x [] = False
+mem x (y:ys) = (x == y) `oR` mem x ys
+
+a `oR` b = if a then True else b
+
+----------------------------------------
+
+mem1 x [] = False
+mem1 x (y:ys) = (x == y) `oR1` mem2 x ys
+
+a `oR1` b = if a then True else b
+
+mem2 x [] = False
+mem2 x (y:ys) = (x == y) `oR` mem1 x ys
+
+---------------------------------------
+
+mem3 x [] = False
+mem3 x (y:ys) = if [x] == [y] then mem4 x ys else False
+
+mem4 y (x:xs) = mem3 y xs
+
+---------------------------------------
+
+main1 = [[(1,True)]] == [[(2,False)]]
+
+---------------------------------------
+
+main2 = "Hello" == "Goodbye"
+
+---------------------------------------
+
+main3 = [[1],[2]] == [[3]]
--- /dev/null
+module ShouldSucceed where
+
+class Foo a where
+ o_and :: a -> a -> a
+
+
+instance Foo Bool where
+ o_and False x = False
+ o_and x False = False
+ o_and True True = True
+
+
+instance Foo Int where
+ o_and x 0 = 0
+ o_and 0 x = 0
+ o_and 1 1 = 1
+
+
+f x y = o_and x False
+
+g x y = o_and x 1
+
+
--- /dev/null
+module ShouldSucceed where
+
+class Eq' a where
+ doubleeq :: a -> a -> Bool
+
+class (Eq' a) => Ord' a where
+ lt :: a -> a -> Bool
+
+instance Eq' Int where
+ doubleeq x y = True
+
+instance (Eq' a) => Eq' [a] where
+ doubleeq x y = True
+
+instance Ord' Int where
+ lt x y = True
+
+{-
+class (Ord a) => Ix a where
+ range :: (a,a) -> [a]
+
+instance Ix Int where
+ range (x,y) = [x,y]
+-}
+
+
+
+
+
+
--- /dev/null
+module ShouldSucceed where
+
+type A a = B a
+
+type B c = C
+
+type C = Int
+
--- /dev/null
+module ShouldSucceed where
+
+class Eq' a where
+ deq :: a -> a -> Bool
+
+instance Eq' Int where
+ deq x y = True
+
+instance (Eq' a) => Eq' [a] where
+ deq (a:as) (b:bs) = if (deq a b) then (deq as bs) else False
+
+f x = deq x [1]
--- /dev/null
+module ShouldSucceed where
+
+class Eq' a where
+ doubleeq :: a -> a -> Bool
+
+class (Eq' a) => Ord' a where
+ lt :: a -> a -> Bool
+
+instance Eq' Int where
+ doubleeq x y = True
+
+instance Ord' Int where
+ lt x y = True
+
+f x y | lt x 1 = True
+ | otherwise = False
--- /dev/null
+module ShouldSucceed where
+
+(x,y) = (\p -> p,\q -> q)
--- /dev/null
+--!!! Duplicate class assertion
+
+module ShouldSucceed where
+
+class Eq' a where
+ doubleeq :: a -> a -> Bool
+
+class (Eq' a) => Ord' a where
+ lt :: a -> a -> Bool
+
+instance Eq' Int where
+ doubleeq x y = True
+
+instance (Eq' a, Eq' a) => Eq' [a] where
+ doubleeq x y = True
+
+f x y = doubleeq x [1]
--- /dev/null
+interface ShouldSucceed where {
+class Eq' a where { deq }
+instance <Eq' Int>
+instance Eq' a => <Eq' [a]>
+dand :: Bool -> Bool -> Bool
+f :: Eq' t93 => t93 -> t93 -> Bool
+}
--- /dev/null
+module ShouldSucceed where
+
+-- See also tcfail060.hs
+
+class Eq' a where
+ deq :: a -> a -> Bool
+
+instance Eq' Int where
+ deq x y = True
+
+instance (Eq' a) => Eq' [a] where
+ deq (a:as) (b:bs) = dand (f a b) (f as bs)
+
+dand True True = True
+dand x y = False
+
+f :: Eq' a => a -> a -> Bool
+f p q = dand (deq p q) (deq [1::Int] [2::Int])
--- /dev/null
+module ShouldSucceed where
+
+class Eq2 a where
+ doubleeq :: a -> a -> Bool
+
+class (Eq2 a) => Ord2 a where
+ lt :: a -> a -> Bool
+
+instance Eq2 Int where
+ doubleeq x y = True
+
+instance Ord2 Int where
+ lt x y = True
+
+instance (Eq2 a,Ord2 a) => Eq2 [a] where
+ doubleeq xs ys = True
+
+f x y = doubleeq x [1]
--- /dev/null
+module ShouldSucceed where
+
+class Eq2 a where
+ deq :: a -> a -> Bool
+ foo :: a -> a
+
+instance Eq2 Int where
+ deq x y = True
+ foo x = x
+
+instance (Eq2 a) => Eq2 [a] where
+ deq (a:as) (b:bs) = if (deq a (foo b)) then (deq as (foo bs)) else False
+ foo x = x
+
+f x = deq x [1]
--- /dev/null
+module ShouldSucceed where
+
+class Eq2 a where
+ deq :: a -> a -> Bool
+
+instance (Eq2 a) => Eq2 [a] where
+ deq (a:as) (b:bs) = if (deq a b) then (deq as bs) else False
+
+
+instance Eq2 Int where
+ deq x y = True
+
--- /dev/null
+module ShouldSucceed where
+
+class Eq1 a where
+ deq :: a -> a -> Bool
+
+instance (Eq1 a) => Eq1 [a] where
+ deq (a:as) (b:bs) = deq a b
+
+instance Eq1 Int where
+ deq x y = True
+
--- /dev/null
+module ShouldSucceed where
+
+class Eq1 a where
+ deq :: a -> a -> Bool
+
+instance Eq1 Int where
+ deq x y = True
+
+instance (Eq1 a) => Eq1 [a] where
+ deq (a:as) (b:bs) = if (deq a b) then (deq as bs) else False
+
+f x (y:ys) = deq x ys
--- /dev/null
+module ShouldSucceed where
+
+data X a = Tag a
+
+class Reps r where
+ f :: r -> r -> r
+
+instance Reps (X q) where
+-- f (Tag x) (Tag y) = Tag y
+ f x y = y
+
+instance Reps Bool where
+ f True True = True
+ f x y = False
+
+g x = f x x
+
+
--- /dev/null
+module ShouldSucceed where
+
+data Boolean = FF | TT
+
+idb :: Boolean -> Boolean
+idb x = x
+
--- /dev/null
+module Digraphs where
+
+import TheUtils
+import Set
+import List (partition )
+
+data Digraph vertex = MkDigraph [vertex]
+
+type Edge vertex = (vertex, vertex)
+type Cycle vertex = [vertex]
+
+mkDigraph = MkDigraph
+
+stronglyConnComp :: Eq vertex => [Edge vertex] -> [vertex] -> [[vertex]]
+stronglyConnComp es vs
+ = snd (span_tree (new_range reversed_edges)
+ ([],[])
+ ( snd (dfs (new_range es) ([],[]) vs) )
+ )
+ where
+ reversed_edges = map swap es
+
+ swap :: Edge v -> Edge v
+ swap (x,y) = (y, x)
+
+ new_range [] w = []
+ new_range ((x,y):xys) w
+ = if x==w
+ then (y : (new_range xys w))
+ else (new_range xys w)
+
+ span_tree r (vs,ns) [] = (vs,ns)
+ span_tree r (vs,ns) (x:xs)
+ | x `elem` vs = span_tree r (vs,ns) xs
+ | otherwise = span_tree r (vs',(x:ns'):ns) xs
+ where
+ (vs',ns') = dfs r (x:vs,[]) (r x)
+
+dfs r (vs,ns) [] = (vs,ns)
+dfs r (vs,ns) (x:xs) | x `elem` vs = dfs r (vs,ns) xs
+ | otherwise = dfs r (vs',(x:ns')++ns) xs
+ where
+ (vs',ns') = dfs r (x:vs,[]) (r x)
+
+
+isCyclic :: Eq vertex => [Edge vertex] -> [vertex] -> Bool
+isCyclic edges [v] = (v,v) `elem` edges
+isCyclic edges vs = True
+
+
+topSort :: (Eq vertex) => [Edge vertex] -> [vertex]
+ -> MaybeErr [vertex] [[vertex]]
+
+
+topSort edges vertices
+ = case cycles of
+ [] -> Succeeded [v | [v] <- singletons]
+ _ -> Failed cycles
+ where
+ sccs = stronglyConnComp edges vertices
+ (cycles, singletons) = partition (isCyclic edges) sccs
+
+
+type FlattenedDependencyInfo vertex name code
+ = [(vertex, Set name, Set name, code)]
+
+mkVertices :: FlattenedDependencyInfo vertex name code -> [vertex]
+mkVertices info = [ vertex | (vertex,_,_,_) <- info]
+
+mkEdges :: (Eq vertex, Ord name) =>
+ [vertex]
+ -> FlattenedDependencyInfo vertex name code
+ -> [Edge vertex]
+
+mkEdges vertices flat_info
+ = [ (source_vertex, target_vertex)
+ | (source_vertex, _, used_names, _) <- flat_info,
+ target_name <- setToList used_names,
+ target_vertex <- vertices_defining target_name flat_info
+ ]
+ where
+ vertices_defining name flat_info
+ = [ vertex | (vertex, names_defined, _, _) <- flat_info,
+ name `elementOf` names_defined
+ ]
+
+lookupVertex :: (Eq vertex, Ord name) =>
+ FlattenedDependencyInfo vertex name code
+ -> vertex
+ -> code
+
+lookupVertex flat_info vertex
+ = head code_list
+ where
+ code_list = [ code | (vertex',_,_,code) <- flat_info, vertex == vertex']
+
+
+isRecursiveCycle :: (Eq vertex) => Cycle vertex -> [Edge vertex] -> Bool
+isRecursiveCycle [vertex] edges = (vertex, vertex) `elem` edges
+isRecursiveCycle cycle edges = True
+
+
+
+-- may go to TheUtils
+
+data MaybeErr a b = Succeeded a | Failed b
+
--- /dev/null
+module ShouldSucceed where
+
+data Pair a b = MkPair a b
+f x = [ a | (MkPair c a) <- x ]
--- /dev/null
+module ShouldSucc where
+
+f [] = []
+f (x:xs) = x : (f xs)
--- /dev/null
+module ShouldSucc where
+
+data T a = D (B a) | C
+data B b = X | Y b
+
+instance (Eq a) => Eq (T a) where
+ (D x) == (D y) = x == y
+ C == C = True
+ a == b = False
+
+ a /= b = not (a == b)
+
+instance (Eq b) => Eq (B b) where
+ X == X = True
+ (Y a) == (Y b) = a == b
+ a == b = False
+
+ a /= b = not (a == b)
--- /dev/null
+module ShouldSucceed where
+
+x = 'a'
+(y:ys) = ['a','b','c'] where p = x
--- /dev/null
+module ShouldSucceed where
+
+
+data Boolean = FF | TT
+
+
+idb :: Boolean -> Boolean
+idb x = x
+
--- /dev/null
+
+module ShouldSucc where
+
+f [] = []
+f (x:xs) = x : (f xs)
--- /dev/null
+module ShouldSucc where
+
+data T a = D (B a) | C
+data B b = X | Y b
+
+instance (Eq a) => Eq (T a) where
+ (D x) == (D y) = x == y
+ C == C = True
+ a == b = False
+
+ a /= b = not (a == b)
+
+instance (Eq b) => Eq (B b) where
+ X == X = True
+ (Y a) == (Y b) = a == b
+ a == b = False
+
+ a /= b = not (a == b)
--- /dev/null
+--!!! scoping in list comprehensions right way 'round?
+-- a bug reported by Jon Hill
+--
+module ShouldSucceed where
+
+x = [[True]]
+xs :: [Bool]
+xs = [x | x <- x, x <- x]
--- /dev/null
+--!!! make sure context of EQ is minimised in interface file.
+--
+module M where
+
+data NUM = ONE | TWO
+class (Num a) => ORD a
+
+class (ORD a, Show a) => EQ a where
+ (===) :: a -> a -> Bool
--- /dev/null
+--!!! instance decls with no binds
+--
+module M where
+
+data Bar a = MkBar Int a
+
+instance Eq a => Eq (Bar a)
+instance Ord a => Ord (Bar a)
--- /dev/null
+--!!! small class decl with local polymorphism;
+--!!! "easy" to check default methods and such...
+--!!! (this is the example given in TcClassDcl)
+--
+module Test where
+
+class Foo a where
+ op1 :: a -> Bool
+ op2 :: Ord b => a -> b -> b -> b
+
+ op1 x = True
+ op2 x y z = if (op1 x) && (y < z) then y else z
+
+instance Foo Int where {}
+
+instance Foo a => Foo [a] where {}
--- /dev/null
+--module Parse(Parse(..),whiteSpace,seperatedBy) where
+--import StdLib
+class Parse a where
+ parseFile :: String -> [a]
+ parseFile string | all forced x = x
+ where x = map parseLine (lines' string)
+ parseLine :: String -> a
+ parseLine = pl.parse where pl (a,_) = a
+ parse :: String -> (a,String)
+ parse = parseType.whiteSpace
+ parseType :: String -> (a,String)
+ forced :: a -> Bool
+ forced x = True
+
+instance Parse Int where
+ parseType str = pl (span' isDigit str)
+ where pl (l,r) = (strToInt l,r)
+ forced n | n>=0 = True
+
+instance Parse Char where
+ parseType (ch:str) = (ch,str)
+ forced n = True
+
+instance (Parse a) => Parse [a] where
+ parseType more = (map parseLine (seperatedBy ',' (l++",")),out)
+ where (l,']':out) = span' (\x->x/=']') (tail more)
+ forced = all forced
+
+seperatedBy :: Char -> String -> [String]
+seperatedBy ch [] = []
+seperatedBy ch xs = twaddle ch (span' (\x->x/=ch) xs)
+ where twaddle ch (l,_:r) = l:seperatedBy ch r
+
+whiteSpace :: String -> String
+whiteSpace = dropWhile isSpace
+
+span' :: (a->Bool) -> [a] -> ([a],[a])
+span' p [] = ([],[])
+span' p (x:xs') | p x = fixLeak x (span' p xs') where fixLeak x (xs,ys) = (x:xs,ys)
+span' _ xs = ([],xs)
+
+lines' :: [Char] -> [[Char]]
+lines' "" = []
+lines' s = plumb (span' ((/=) '\n') s)
+ where plumb (l,s') = l:if null s' then [] else lines' (tail s')
+
+strToInt :: String -> Int
+strToInt x = strToInt' (length x-1) x
+ where strToInt' _ [] = 0
+ strToInt' x (a:l) = (charToInt a)*(10^x) + (strToInt' (x-1) l)
+
+charToInt :: Char -> Int
+charToInt x = (ord x - ord '0')
--- /dev/null
+--!!! an example Simon made up
+--
+module ShouldSucceed where
+
+f x = (x+1, x<3, g True, g 'c')
+ where
+ g y = if x>2 then [] else [y]
+{-
+Here the type-check of g will yield an LIE with an Ord dict
+for x. g still has type forall a. a -> [a]. The dictionary is
+free, bound by the x.
+
+It should be ok to add the signature:
+-}
+
+f2 x = (x+1, x<3, g2 True, g2 'c')
+ where
+ -- NB: this sig:
+ g2 :: a -> [a]
+ g2 y = if x>2 then [] else [y]
+{-
+or to write:
+-}
+
+f3 x = (x+1, x<3, g3 True, g3 'c')
+ where
+ -- NB: this line:
+ g3 = (\ y -> if x>2 then [] else [y])::(a -> [a])
--- /dev/null
+--!!! tc082: an instance for functions
+--
+module N where
+
+class Normal a
+ where
+ normal :: a -> Bool
+
+instance Normal ( a -> b ) where
+ normal _ = True
+
+f x = normal id
--- /dev/null
+--!!! instances with no binds;
+--!!! be sure we get a legit .hi file
+--
+module Bar where
+
+import ClassFoo
+
+instance Foo Int
+
+instance Foo a => Foo [a]
--- /dev/null
+{- This program shows up a bug in the handling of
+ the monomorphism restriction in an earlier version of
+ ghc. With ghc 0.18 and before, f gets a type with
+ an unbound type variable, which shows up in the
+ interface file. Reason: it was being monomorphised.
+
+ Simon PJ
+-}
+
+module Foo where
+
+
+g :: Num a => Bool -> a -> b -> a
+g b x y = if b then x+x else x-x
+
+-- Everything is ok if this signature is put in
+-- but the program should be perfectly legal without it.
+-- f :: Num a => a -> b -> a
+f = g True
+
+h y x = f (x::Int) y
+ -- This use of f binds the overloaded monomorphic
+ -- type to Int
--- /dev/null
+--!!! From a bug report from Satnam.
+--!!! To do with re-exporting importees from PreludeGla* modules.
+module Foo ( module GlaExts, module Foo ) where
+
+--OLD: import PreludeGlaIO
+import GlaExts
+
+type FooType = Int
+data FooData = FooData
--- /dev/null
+{-
+ From: Marc van Dongen <dongen@cs.ucc.ie>
+ Date: Sat, 31 May 1997 19:57:46 +0100 (BST)
+
+ panic! (the `impossible' happened):
+ tcLookupTyVar:a_r6F
+
+ Please report it as a compiler bug to glasgow-haskell-bugs@dcs.gla.ac.uk.
+
+
+If the instance definition for (*) at the end of this toy module
+is replaced by the definition that is commented, this all compiles
+fine. Strange, because the two implementations are equivalent modulo
+the theory {(*) = multiply}.
+
+Remove the `multiply :: a -> a -> a' part, and it compiles without
+problems.
+
+
+SPJ note: the type signature on "multiply" should be
+ multiply :: Group a => a -> a -> a
+
+-}
+
+module Rings( Group, Ring ) where
+
+import qualified Prelude( Ord(..), Eq(..), Num(..) )
+import Prelude hiding( Ord(..), Eq(..), Num(..), MonadZero( zero ) )
+
+class Group a where
+ compare :: a -> a -> Prelude.Ordering
+ fromInteger :: Integer -> a
+ (+) :: a -> a -> a
+ (-) :: a -> a -> a
+ zero :: a
+ one :: a
+ zero = fromInteger 0
+ one = fromInteger 1
+
+-- class (Group a) => Ring a where
+-- (*) :: a -> a -> a
+-- (*) a b =
+-- case (compare a zero) of
+-- EQ -> zero
+-- LT -> zero - ((*) (zero - a) b)
+-- GT -> case compare a one of
+-- EQ -> b
+-- _ -> b + ((*) (a - one) b)
+
+class (Group a) => Ring a where
+ (*) :: a -> a -> a
+ (*) a b = multiply a b
+ where multiply :: Group a => a -> a ->a
+ multiply a b
+ = case (compare a zero) of
+ EQ -> zero
+ LT -> zero - (multiply (zero - a) b)
+ GT -> case compare a one of
+ EQ -> b
+ _ -> b + (multiply (a - one) b)
--- /dev/null
+module SOL where
+
+import GlaExts
+
+data SeqView t a = Null
+ | Cons a (t a)
+
+class PriorityQueue q where
+ empty :: (Ord a) => q a
+ single :: (Ord a) => a -> q a
+ insert :: (Ord a) => a -> q a -> q a
+ meld :: (Ord a) => q a -> q a -> q a
+ splitMin :: (Ord a) => q a -> SeqView q a
+ insert a q = single a `meld` q
+
+toOrderedList q = case splitMin q of
+ Null -> []
+ Cons a q -> a : toOrderedList q
+
+insertMany x q = foldr insert q x
+pqSort q x = toOrderedList (insertMany x q)
+
+check :: (PriorityQueue q) => (Ord a => q a) -> IO ()
+check empty = do
+ putStr "*** sorting\n"
+ out (pqSort empty [1 .. 99])
+ out (pqSort empty [1.0, 1.1 ..99.9])
+
+out :: (Num a) => [a] -> IO ()
+out x | sum x == 0 = putStr "ok\n"
+ | otherwise = putStr "ok\n"
+
--- /dev/null
+-- Check that "->" is an instance of Eval
+
+module Foo where
+
+instance (Eq b) => Eq (a -> b) where
+ (==) f g = error "attempt to compare functions"
+
+ -- Since Eval is a superclass of Num this fails
+ -- unless -> is an instance of Eval
+instance (Num b) => Num (a -> b) where
+ f + g = \a -> f a + g a
+ f - g = \a -> f a - g a
+ f * g = \a -> f a * g a
+ negate f = \a -> negate (f a)
+ abs f = \a -> abs (f a)
+ signum f = \a -> signum (f a)
+ fromInteger n = \a -> fromInteger n
+ fromInt n = \a -> fromInt n
--- /dev/null
+--!!! Stress test for type checker
+
+module Prims where
+
+import Prelude hiding (head)
+
+one = one
+
+head (x:xs) = x
+
+bottom = head
+
+absIf a b c = a
+
+absAnd a b = head [a,b]
+
+fac_rec fac0 n a
+ = (absIf (absAnd (s_3_0 n) one)
+ (s_2_0 a)
+ (fac0 (absAnd (s_3_2 n) one) (absAnd (s_3_1 n) (s_2_1 a))))
+
+f_rec f0 a
+ = (f0 (s_1_0 a))
+
+g_rec g0 g1 x y z p
+ = (absIf (absAnd (s_3_0 p) one)
+ (absAnd (s_1_0 x) (s_3_0 z))
+ (absAnd
+ (g0 (s_1_0 y) one one (absAnd (s_3_1 p) one))
+ (g1 (s_3_2 z) (s_3_1 z) one (absAnd (s_3_2 p) one))))
+
+s_2_0 (v0,v1) = v0
+s_2_1 (v0,v1) = v1
+s_1_0 v0 = v0
+s_3_0 (v0,v1,v2) = v0
+s_3_1 (v0,v1,v2) = v1
+s_3_2 (v0,v1,v2) = v2
+
+fac n a
+ = (fac_rec fac_rec4 n a)
+
+fac_rec4 n a = (fac_rec fac_rec3 n a)
+fac_rec3 n a = (fac_rec fac_rec2 n a)
+fac_rec2 n a = (fac_rec fac_rec1 n a)
+fac_rec1 n a = (fac_rec fac_rec0 n a)
+fac_rec0 n a = (bottom [n,a])
+
+f a
+ = (f_rec f_rec2 a)
+
+f_rec2 a = (f_rec f_rec1 a)
+f_rec1 a = (f_rec f_rec0 a)
+f_rec0 a = (bottom [a])
+
+g x y z p = (g_rec g_rec8 g_rec8 x y z p)
+
+{-
+g x y z p = (g_rec g_rec16 g_rec16 x y z p)
+
+g_rec16 x y z p = (g_rec g_rec15 g_rec15 x y z p)
+g_rec15 x y z p = (g_rec g_rec14 g_rec14 x y z p)
+g_rec14 x y z p = (g_rec g_rec13 g_rec13 x y z p)
+g_rec13 x y z p = (g_rec g_rec12 g_rec12 x y z p)
+g_rec12 x y z p = (g_rec g_rec11 g_rec11 x y z p)
+g_rec11 x y z p = (g_rec g_rec10 g_rec10 x y z p)
+g_rec10 x y z p = (g_rec g_rec9 g_rec9 x y z p)
+g_rec9 x y z p = (g_rec g_rec8 g_rec8 x y z p)
+-}
+
+g_rec8 x y z p = (g_rec g_rec7 g_rec7 x y z p)
+g_rec7 x y z p = (g_rec g_rec6 g_rec6 x y z p)
+g_rec6 x y z p = (g_rec g_rec5 g_rec5 x y z p)
+g_rec5 x y z p = (g_rec g_rec4 g_rec4 x y z p)
+g_rec4 x y z p = (g_rec g_rec3 g_rec3 x y z p)
+g_rec3 x y z p = (g_rec g_rec2 g_rec2 x y z p)
+g_rec2 x y z p = (g_rec g_rec1 g_rec1 x y z p)
+g_rec1 x y z p = (g_rec g_rec0 g_rec0 x y z p)
+g_rec0 x y z p = (bottom [x,y,z,p])
--- /dev/null
+{- This module tests that we can ge polymorphic recursion
+ of overloaded functions. GHC 2.02 produced the following
+ bogus error:
+
+ tmp.lhs:1: A group of type signatures have mismatched contexts
+ Abf.a :: (PrelBase.Ord f{-aX6-}) => ...
+ Abf.b :: (PrelBase.Ord f{-aX2-}) => ...
+
+ This was due to having more than one type signature for one
+ group of recursive functions.
+-}
+
+
+module Foo where
+
+a :: (Ord f) => f
+a = b
+
+b :: (Ord f) => f
+b = a
+
+
--- /dev/null
+--!!! Test polymorphic recursion
+
+
+-- With polymorphic recursion this one becomes legal
+-- SLPJ June 97.
+
+{-
+To: Lennart Augustsson <augustss@cs.chalmers.se>
+Cc: partain@dcs.gla.ac.uk, John Peterson (Yale) <peterson-john@cs.yale.edu>,
+ simonpj@dcs.gla.ac.uk
+Subject: Type checking matter
+Date: Fri, 23 Oct 92 15:28:38 +0100
+From: Simon L Peyton Jones <simonpj@dcs.gla.ac.uk>
+
+
+I've looked at the enclosed again. It seems to me that
+since "s" includes a recursive call to "sort", inside the body
+of "sort", then "sort" is monomorphic, and hence so is "s";
+hence the type signature (which claims full polymorphism) is
+wrong.
+
+[Lennart says he can't see any free variables inside "s", but there
+is one, namely "sort"!]
+
+Will: one for the should-fail suite?
+
+Simon
+
+
+------- Forwarded Message
+
+
+From: Lennart Augustsson <augustss@cs.chalmers.se>
+To: partain
+Subject: Re: just to show you I'm a nice guy...
+Date: Tue, 26 May 92 17:30:12 +0200
+
+> Here's a fairly simple module from our compiler, which includes what
+> we claim is an illegal type signature (grep ILLEGAL ...).
+> Last time I checked, hbc accepted this module.
+
+Not that I don't believe you, but why is this illegal?
+As far as I can see there are no free variables in the function s,
+which makes me believe that it can typechecked like a top level
+definition. And for a top level defn the signature should be
+all right.
+
+ -- Lennart
+- ------- End of forwarded message -------
+-}
+module ShouldFail where
+
+sort :: Ord a => [a] -> [a]
+sort xs = s xs (length xs)
+ where
+ s :: Ord b => [b] -> Int -> [b] -- This signature is WRONG
+ s xs k = if k <= 1 then xs
+ else merge (sort ys) (sort zs)
+ where (ys,zs) = init_last xs (k `div` (2::Int))
+
+-- Defns of merge and init_last are just dummies with the correct types
+merge :: Ord a => [a] -> [a] -> [a]
+merge xs ys = xs
+
+init_last :: [a] -> Int -> ([a],[a])
+init_last a b = (a,a)
+
--- /dev/null
+--!!! trying to have a polymorphic type sig where inappropriate
+--
+module Digraph where
+
+data MaybeErr val err = Succeeded val | Failed err deriving ()
+
+type Edge vertex = (vertex, vertex)
+type Cycle vertex = [vertex]
+
+stronglyConnComp :: Eq vertex => [Edge vertex] -> [vertex] -> [[vertex]]
+
+stronglyConnComp es vs
+ = snd (span_tree (new_range reversed_edges)
+ ([],[])
+ ( snd (dfs (new_range es) ([],[]) vs) )
+ )
+ where
+ -- *********** the offending type signature **************
+ reversed_edges :: Eq v => [Edge v]
+ reversed_edges = map swap es
+
+ -- WRONGOLA: swap :: Eq v => Edge v -> Edge v
+ swap (x,y) = (y, x)
+
+ -- WRONGOLA?: new_range :: Eq v => [Edge v] -> v -> [v]
+
+ new_range [] w = []
+ new_range ((x,y):xys) w
+ = if x==w
+ then (y : (new_range xys w))
+ else (new_range xys w)
+
+ {- WRONGOLA?:
+ span_tree :: Eq v => (v -> [v])
+ -> ([v], [[v]])
+ -> [v]
+ -> ([v], [[v]])
+ -}
+
+ span_tree r (vs,ns) [] = (vs,ns)
+ span_tree r (vs,ns) (x:xs)
+ | x `elem` vs = span_tree r (vs,ns) xs
+ | otherwise = span_tree r (vs',(x:ns'):ns) xs
+ where
+ (vs',ns') = dfs r (x:vs,[]) (r x)
+
+dfs :: Eq v => (v -> [v])
+ -> ([v], [v])
+ -> [v]
+ -> ([v], [v])
+
+dfs r (vs,ns) [] = (vs,ns)
+dfs r (vs,ns) (x:xs) | x `elem` vs = dfs r (vs,ns) xs
+ | otherwise = dfs r (vs',(x:ns')++ns) xs
+ where
+ (vs',ns') = dfs r (x:vs,[]) (r x)
--- /dev/null
+
+Digraph.hs:19: A type signature is more polymorphic than the inferred type
+ Some type variables in the inferred type can't be forall'd, namely:
+ `taXO'
+ Possible cause: the RHS mentions something subject to the monomorphism restriction
+ When checking signature for `reversed_edges'
+ In an equation for function `stronglyConnComp':
+ `stronglyConnComp es vs
+ = PrelTup.snd (span_tree (new_range reversed_edges)
+ (PrelBase.[], (PrelBase.[]))
+ (PrelTup.snd (dfs (new_range es)
+ (PrelBase.[], (PrelBase.[]))
+ vs)))
+ where
+ span_tree r (vs, ns) PrelBase.[] = (vs, (ns))
+ span_tree r (vs, ns) (x PrelBase.: xs)
+ | [x PrelList.elem vs] = span_tree r (vs, (ns)) xs
+ | [PrelBase.otherwise]
+ = span_tree r (vs', ((x PrelBase.: ns') PrelBase.: ns)) xs
+ where
+ (vs', ns')
+ = dfs r (x PrelBase.: vs, (PrelBase.[])) (r x)
+ new_range PrelBase.[] w = PrelBase.[]
+ new_range ((x, y) PrelBase.: xys) w
+ = if x PrelBase.== w then
+ (y PrelBase.: (new_range xys w))
+ else
+ (new_range xys w)
+ swap (x, y) = (y, (x))
+ reversed_edges :: _forall_ [v] (PrelBase.Eq v) => [Edge v]
+ reversed_edges = PrelBase.map swap es'
+
+
+Compilation had errors
--- /dev/null
+TOP = ../../../..
+include $(TOP)/mk/boilerplate.mk
+
+HS_SRCS = $(wildcard *.hs)
+
+SRC_RUNTEST_OPTS += -o1 $*.stdout -o2 $*.stderr -x 1
+HC_OPTS += -noC -ddump-tc
+
+%.o : %.hs
+ $(RUNTEST) $(HC) $(RUNTEST_OPTS) -- $(HC_OPTS) -c $< -o $@
+
+all :: $(HS_OBJS)
+
+tcfail045_HC_OPTS = -fglasgow-exts
+tcfail059_HC_OPTS = -hi
+tcfail060_HC_OPTS = -hi
+tcfail061_HC_OPTS = -hi
+tcfail062_HC_OPTS = -hi
+tcfail063_HC_OPTS = -hi
+tcfail064_HC_OPTS = -hi
+tcfail065_HC_OPTS = -hi
+tcfail066_HC_OPTS = -hi
+tcfail067_HC_OPTS = -hi
+tcfail068_HC_OPTS = -fglasgow-exts
+
+include $(TOP)/mk/target.mk
--- /dev/null
+--!!! This should fail with a type error: the instance method
+--!!! has a function type when it should have the type [a].
+module Test where
+
+class A a where
+ op :: a
+
+instance (A a, A a) => A [a] where
+ op [] = []
--- /dev/null
+
+tcfail001.hs:9:warning:
+ Duplicated class assertion `A a' in context: `(A a, A a)'
+
+tcfail001.hs:9: Couldn't match the type
+ `PrelBase.[]' against `GHC.-> [takw]'
+ Expected: `[takv]'
+ Inferred: `[takw] -> [takx]'
+ In an equation for function `op': `op PrelBase.[] = PrelBase.[]'
+
+
+Compilation had errors
--- /dev/null
+module ShouldFail where
+
+c (x:y) = x
+c z = z
--- /dev/null
+
+tcfail002.hs:4: Cannot construct the infinite type (occur check)
+ `tak5' = `[tak5]'
+ Expected: `[tak5] -> tak5'
+ Inferred: `[tak5] -> [tak5]'
+ In an equation for function `c': `c z = z'
+
+
+Compilation had errors
--- /dev/null
+module ShouldFail where
+
+(d:e) = [1,'a']
--- /dev/null
+
+tcfail003.hs:3: No instance for: `PrelBase.Num PrelBase.Char'
+ arising from the literal 1 at tcfail003.hs:3
+
+
+Compilation had errors
--- /dev/null
+module ShouldFail where
+
+(f,g) = (1,2,3)
--- /dev/null
+
+tcfail004.hs:3: Couldn't match the type
+ `PrelTup.(,)' against `PrelTup.(,,) taRU'
+ Expected: `(taRO, taRR)'
+ Inferred: `(taRU, taRX, taS0)'
+ In a pattern binding: `(f, g) = (1, 2, 3)'
+
+
+Compilation had errors
--- /dev/null
+module ShouldFail where
+
+(h:i) = (1,'a')
--- /dev/null
+
+tcfail005.hs:3: Couldn't match the type
+ `PrelBase.[]' against `PrelTup.(,) taR8'
+ Expected: `[taR4]'
+ Inferred: `(taR8, PrelBase.Char)'
+ In a pattern binding: `(h PrelBase.: i) = (1, ('a'))'
+
+
+Compilation had errors
--- /dev/null
+module ShouldFail where
+
+(j,k) = case (if True then True else False) of
+ True -> (True,1)
+ False -> (1,True)
--- /dev/null
+
+tcfail006.hs:4: No instance for: `PrelBase.Num PrelBase.Bool'
+ arising from the literal 1 at tcfail006.hs:4
+
+
+Compilation had errors
--- /dev/null
+module ShouldFail where
+
+n x | True = x+1
+ | False = True
--- /dev/null
+
+tcfail007.hs:4: No instance for: `PrelBase.Num PrelBase.Bool'
+ arising from use of `PrelBase.+' at tcfail007.hs:4
+
+
+Compilation had errors
--- /dev/null
+module ShouldFail where
+
+o = 1:2
--- /dev/null
+
+tcfail008.hs:3: No instance for: `PrelBase.Num [taBA]'
+ arising from the literal 2 at tcfail008.hs:3
+
+tcfail008.hs:3: No instance for: `PrelBase.Num [taBA]'
+ arising from the literal 2 at tcfail008.hs:3
+
+tcfail008.hs:3: No instance for: `PrelBase.Num [PrelBase.Int]'
+ arising from the literal 2 at tcfail008.hs:3
+
+
+Compilation had errors
--- /dev/null
+module ShouldFail where
+
+p = [(1::Int)..(2::Integer)]
--- /dev/null
+
+tcfail009.hs:3: Couldn't match the type
+ `PrelBase.Integer' against `PrelBase.Int'
+ Expected: `PrelBase.Int'
+ Inferred: `PrelBase.Integer'
+ In an arithmetic sequence:
+ `[(1 :: PrelBase.Int) .. (2 :: PrelBase.Integer)]'
+
+
+Compilation had errors
--- /dev/null
+module ShouldFail where
+
+q = \ (y:z) -> z+2
--- /dev/null
+
+tcfail010.hs:3: No instance for: `PrelBase.Num [taBD]'
+ arising from use of `PrelBase.+' at tcfail010.hs:3
+
+tcfail010.hs:3: No instance for: `PrelBase.Num [taBD]'
+ arising from use of `PrelBase.+' at tcfail010.hs:3
+
+
+Compilation had errors
--- /dev/null
+module ShouldFail where
+
+z = \y -> x x where x = y
--- /dev/null
+
+tcfail011.hs:3: Value not in scope: `y'
+
+
+Compilation had errors
--- /dev/null
+module ShouldFail where
+
+True = []
--- /dev/null
+
+tcfail012.hs:3: Couldn't match the type
+ `PrelBase.Bool' against `[tajU]'
+ Expected: `PrelBase.Bool'
+ Inferred: `[tajU]'
+ In a pattern binding: `PrelBase.True = PrelBase.[]'
+
+
+Compilation had errors
--- /dev/null
+module ShouldFail where
+
+f [] = 1
+f True = 2
--- /dev/null
+
+tcfail013.hs:4: Couldn't match the type
+ `[taBB]' against `PrelBase.Bool'
+ Expected: `[taBB] -> taBD'
+ Inferred: `PrelBase.Bool -> taBG'
+ In an equation for function `f': `f PrelBase.True = 2'
+
+
+Compilation had errors
--- /dev/null
+module ShouldFail where
+
+f x = g+1
+ where g y = h+2
+ where h z = z z
--- /dev/null
+
+tcfail014.hs:5: Cannot construct the infinite type (occur check)
+ `oaBR' = `oaBR -> oaCz'
+ Expected: `oaBR'
+ Inferred: `oaBR -> oaCz'
+ In the first argument of `z', namely `z'
+ In an equation for function `h': `h z = z z'
+ In an equation for function `g':
+ `g y
+ = h PrelBase.+ 2
+ where
+ h z = z z'
+
+tcfail014.hs:5: No instance for: `PrelBase.Num (taCk -> taCl)'
+ arising from use of `PrelBase.+' at tcfail014.hs:5
+
+
+Compilation had errors
--- /dev/null
+module ShouldFail where
+
+data AList a = ANull | ANode a (AList a)
+
+type IntList = AList Int
+
+g (ANull) = 2
+g (ANode b (ANode c d)) | b = c+1
+ | otherwise = 4
--- /dev/null
+
+tcfail015.hs:7: No instance for: `PrelBase.Num PrelBase.Bool'
+ arising from the literal 2 at tcfail015.hs:7
+
+
+Compilation had errors
--- /dev/null
+module ShouldFail where
+
+type AnnExpr a = (a,Expr a)
+
+data Expr a = Var [Char]
+ | App (AnnExpr a) (AnnExpr a)
+
+g (Var name) = [name]
+g (App e1 e2) = (g e1)++(g e2)
--- /dev/null
+
+tcfail016.hs:9: Couldn't match the type
+ `PrelTup.(,) taRi' against `Expr'
+ Expected: `Expr taRd'
+ Inferred: `AnnExpr taRi'
+ In the first argument of `g', namely `e1'
+ In the first argument of `PrelBase.++', namely `(g e1)'
+ In an equation for function `g':
+ `g (App e1 e2) = (g e1) PrelBase.++ (g e2)'
+
+
+Compilation had errors
--- /dev/null
+
+module ShouldFail where
+
+class C a where
+ op1 :: a -> a
+
+class (C a) => B a where
+ op2 :: a -> a -> a
+
+instance (B a) => B [a] where
+ op2 xs ys = xs
+
+
--- /dev/null
+
+tcfail017.hs:11: No instance for: `C [takz]'
+ arising from an instance declaration at tcfail017.hs:11
+ When checking superclass constraints of an instance declaration
+
+
+Compilation had errors
--- /dev/null
+
+
+module ShouldSucc where
+
+(a:[]) = 1
--- /dev/null
+
+tcfail018.hs:5: No instance for: `PrelBase.Num [taBB]'
+ arising from the literal 1 at tcfail018.hs:5
+
+tcfail018.hs:5: No instance for: `PrelBase.Num [taBB]'
+ arising from the literal 1 at tcfail018.hs:5
+
+
+Compilation had errors
--- /dev/null
+
+module P where
+
+class A a where
+ p1 :: a -> a
+ p2 :: a -> a -> a
+
+class (A b) => B b where
+ p3 :: b
+ p4 :: b -> b
+
+class (A c) => C c where
+ p5 :: c -> c
+ p6 :: c -> Int
+
+class (B d,C d) => D d where
+ p7 :: d -> d
+
+instance D [a] where
+ p7 l = []
+
--- /dev/null
+
+tcfail019.hs:20: No instance for: `B [tal6]'
+ arising from an instance declaration at tcfail019.hs:20
+ When checking methods of an instance declaration
+
+tcfail019.hs:20: No instance for: `C [tal6]'
+ arising from an instance declaration at tcfail019.hs:20
+ When checking methods of an instance declaration
+
+tcfail019.hs:20: No instance for: `B [tal6]'
+ arising from an instance declaration at tcfail019.hs:20
+ When checking superclass constraints of an instance declaration
+
+tcfail019.hs:20: No instance for: `C [tal6]'
+ arising from an instance declaration at tcfail019.hs:20
+ When checking superclass constraints of an instance declaration
+
+
+Compilation had errors
--- /dev/null
+
+module P where
+
+class A a where
+ p1 :: a -> a
+ p2 :: a -> a -> a
+
+class (A b) => B b where
+ p3 :: b
+
+instance (A a) => B [a] where
+ p3 = []
+
+data X = XC --, causes stack dump
+
+--instance B Bool where
+-- p3 = True
--- /dev/null
+
+tcfail020.hs:12: No instance for: `A [taBn]'
+ arising from an instance declaration at tcfail020.hs:12
+ When checking superclass constraints of an instance declaration
+
+
+Compilation had errors
--- /dev/null
+--!!! Illegally giving methods in a pattern binding (for no v good reason...)
+
+module ShouldFail where
+
+data Foo = MkFoo Int
+
+instance Eq Foo where
+ ((==), (/=)) = (\x -> \y -> True, \x -> \y -> False)
--- /dev/null
+
+data B = C
+
+class A a where
+ op :: a -> a
+
+instance A B where
+ op C = True
+
+instance A B where
+ op C = True
+
+
--- /dev/null
+
+tcfail023.hs:2: Duplicate or overlapping instance declarations
+ for `A B' at tcfail023.hs:8 and tcfail023.hs:11
+
+tcfail023.hs:11: Couldn't match the type
+ `B' against `PrelBase.Bool'
+ Expected: `B'
+ Inferred: `PrelBase.Bool'
+ In an equation for function `op': `op C = PrelBase.True'
+
+tcfail023.hs:8: Couldn't match the type `B' against `PrelBase.Bool'
+ Expected: `B'
+ Inferred: `PrelBase.Bool'
+ In an equation for function `op': `op C = PrelBase.True'
+
+tcfail023.hs:2: Module Main must include a definition for `Main.main'
+
+
+Compilation had errors
--- /dev/null
+
+tcfail025.hs:2:
+ Conflicting exports for local name: A
+ module Main
+ module Main
+
+
+Compilation had errors
--- /dev/null
+
+tcfail026.hs:2:
+ Conflicting exports for local name: A
+ module Main
+ module Main
+
+tcfail026.hs:6:
+ Class type variable ``a'' does not appear in method signature:
+ op2 ::
+ `b' -> `b'
+
+
+Compilation had errors
--- /dev/null
+--!!! tests for CycleErr in classes
+
+class (B a) => A a where
+ op1 :: a -> a
+
+class (A a) => B a where
+ op2 :: a -> a -> a
--- /dev/null
+
+tcfail027.hs:3: Cycle in class declarations ...
+ `A' tcfail027.hs:4
+ `B' tcfail027.hs:7
+
+
+Compilation had errors
--- /dev/null
+--!!! tests for ArityErr
+
+data A a b = B (A a)
--- /dev/null
+
+tcfail028.hs:4: Couldn't match the kind `ka2534 -> *' against `*'
+ When unifying two kinds `ka2534 -> *' and `*'
+ In the data declaration for `A'
+
+
+Compilation had errors
--- /dev/null
+--!!! tests for InstOpErr
+module ShouldFail where
+
+data Foo = Bar | Baz
+
+f x = x > Bar
--- /dev/null
+
+tcfail029.hs:6: No instance for: `PrelBase.Ord Foo'
+ arising from use of `PrelBase.>' at tcfail029.hs:6
+
+
+Compilation had errors
--- /dev/null
+--!!! empty file
--- /dev/null
+
+tcfail030.hs:0: Module Main must include a definition for `Main.main'
+
+
+Compilation had errors
--- /dev/null
+module ShouldFail where
+
+f x = if 'a' then 1 else 2
--- /dev/null
+
+tcfail031.hs:3: Couldn't match the type
+ `PrelBase.Bool' against `PrelBase.Char'
+ Expected: `PrelBase.Bool'
+ Inferred: `PrelBase.Char'
+ In the predicate expression `'a''
+ In an equation for function `f': `f x = if 'a' then 1 else 2'
+
+
+Compilation had errors
--- /dev/null
+{- This test gives the following not-very-wonderful error message.
+
+ "tc_sig.hs", line 3: Type signature does not match the inferred type:
+ Signature: t76 -> Int
+ Inferred type: t75
+
+It *is* an error, because x does not have the polytype
+ forall a. Eq a => a -> Int
+becuase it is monomorphic, but the error message isn't very illuminating.
+-}
+
+module TcSig where
+
+f x = (x :: (Eq a) => a -> Int)
+
+
--- /dev/null
+
+tcfail032.hs:14: A type signature is more polymorphic than the inferred type
+ Some type variables in the inferred type can't be forall'd, namely:
+ `taAx'
+ Possible cause: the RHS mentions something subject to the monomorphism restriction
+ In an expression with a type signature:
+ `x :: _forall_ [a] (PrelBase.Eq a) => a -> PrelBase.Int'
+
+
+Compilation had errors
--- /dev/null
+-- from Jon Hill
+module ShouldFail where
+
+buglet = [ x | (x,y) <- buglet ]
--- /dev/null
+
+tcfail033.hs:4: Cannot construct the infinite type (occur check)
+ `taGt' = `(taGt, taGw)'
+ Expected: `aaGy (taGt, taGw)'
+ Inferred: `aaGy taGt'
+ In a pattern binding: `buglet = [ x | (x, y) <- buglet ]'
+
+
+Compilation had errors
--- /dev/null
+{-
+From: Jon Hill <hilly@dcs.qmw.ac.uk@jess.gla.ac.uk@pp.dcs.glasgow.ac.uk>
+To: glasgow-haskell-bugs
+Subject: Unfriendly error message
+Date: Thu, 25 Jun 1992 09:22:55 +0100
+
+Hello again,
+
+I came across a rather nasty error message when I gave a function an
+incorrect type signature (the context is wrong). I can remember reading
+in the source about this problem - I just thought I'd let you know anyway :-)
+-}
+module ShouldSucceed where
+
+
+test::(Num a, Eq a) => a -> Bool
+test x = (x `mod` 3) == 0
+
+{-
+granite> ndph bug002.ldh
+Data Parallel Haskell Compiler, version 0.01 (Glasgow 0.07)
+
+
+"<unknown>", line <unknown>: Cannot express dicts in terms of dictionaries available:
+dicts_encl:
+ "<built-in>", line : dict.87 :: <Num a>
+ "<built-in>", line : dict.88 :: <Eq a>
+dicts_encl':
+ "<built-in>", line : dict.87 :: <Num a>
+ "<built-in>", line : dict.88 :: <Eq a>
+dicts:
+ "<built-in>", line : dict.87 :: <Num a>
+ "<built-in>", line : dict.88 :: <Eq a>
+super_class_dict: "<built-in>", line : dict.80 :: <Integral a>
+Fail: Compilation errors found
+
+dph: execution of the Haskell compiler had trouble
+
+-}
--- /dev/null
+
+tcfail034.hs:13: Context `{PrelNum.Integral taTL}'
+ required by inferred type, but missing on a type signature
+ `PrelNum.Integral' `taTL' arising from use of `PrelNum.mod' at tcfail034.hs:17
+ When checking signature(s) for: `test'
+
+
+Compilation had errors
--- /dev/null
+--!!! instances with empty where parts: duplicate
+--
+module M where
+
+data NUM = ONE | TWO
+instance Num NUM
+instance Num NUM
+instance Eq NUM
+instance Show NUM
--- /dev/null
+
+tcfail035.hs:3: Duplicate or overlapping instance declarations
+ for `PrelBase.Num NUM' at tcfail035.hs:6 and tcfail035.hs:7
+
+tcfail035.hs:9: No explicit method nor default method for `PrelBase.showsPrec'
+ in an instance declaration for `PrelBase.Show'
+
+tcfail035.hs:8: No explicit method nor default method for `PrelBase.=='
+ in an instance declaration for `PrelBase.Eq'
+
+tcfail035.hs:7: No explicit method nor default method for `PrelBase.+'
+ in an instance declaration for `PrelBase.Num'
+
+tcfail035.hs:7: No explicit method nor default method for `PrelBase.*'
+ in an instance declaration for `PrelBase.Num'
+
+tcfail035.hs:7: No explicit method nor default method for `PrelBase.negate'
+ in an instance declaration for `PrelBase.Num'
+
+tcfail035.hs:7: No explicit method nor default method for `PrelBase.abs'
+ in an instance declaration for `PrelBase.Num'
+
+tcfail035.hs:7: No explicit method nor default method for `PrelBase.signum'
+ in an instance declaration for `PrelBase.Num'
+
+tcfail035.hs:7: No explicit method nor default method for `PrelBase.fromInteger'
+ in an instance declaration for `PrelBase.Num'
+
+tcfail035.hs:6: No explicit method nor default method for `PrelBase.+'
+ in an instance declaration for `PrelBase.Num'
+
+tcfail035.hs:6: No explicit method nor default method for `PrelBase.*'
+ in an instance declaration for `PrelBase.Num'
+
+tcfail035.hs:6: No explicit method nor default method for `PrelBase.negate'
+ in an instance declaration for `PrelBase.Num'
+
+tcfail035.hs:6: No explicit method nor default method for `PrelBase.abs'
+ in an instance declaration for `PrelBase.Num'
+
+tcfail035.hs:6: No explicit method nor default method for `PrelBase.signum'
+ in an instance declaration for `PrelBase.Num'
+
+tcfail035.hs:6: No explicit method nor default method for `PrelBase.fromInteger'
+ in an instance declaration for `PrelBase.Num'
+
+Compilation had errors
--- /dev/null
+--!!! prelude class name in an instance-tycon position
+--
+module M where
+
+data NUM = ONE | TWO
+instance Num NUM
+ where ONE + ONE = TWO
+instance Num NUM
+instance Eq Num
+--instance Text Num
--- /dev/null
+
+tcfail036.hs:9: Class used as a type constructor: `PrelBase.Num'
+
+tcfail036.hs:3: Duplicate or overlapping instance declarations
+ for `PrelBase.Num NUM' at tcfail036.hs:7 and tcfail036.hs:8
+
+tcfail036.hs:8: No instance for: `PrelBase.Eq NUM'
+ arising from an instance declaration at tcfail036.hs:8
+ When checking methods of an instance declaration
+
+tcfail036.hs:8: No instance for: `PrelBase.Show NUM'
+ arising from an instance declaration at tcfail036.hs:8
+ When checking methods of an instance declaration
+
+tcfail036.hs:8: No instance for: `PrelBase.Eq NUM'
+ arising from an instance declaration at tcfail036.hs:8
+ When checking superclass constraints of an instance declaration
+
+tcfail036.hs:8: No instance for: `PrelBase.Show NUM'
+ arising from an instance declaration at tcfail036.hs:8
+ When checking superclass constraints of an instance declaration
+
+tcfail036.hs:7: No instance for: `PrelBase.Eq NUM'
+ arising from an instance declaration at tcfail036.hs:7
+ When checking methods of an instance declaration
+
+tcfail036.hs:7: No instance for: `PrelBase.Show NUM'
+ arising from an instance declaration at tcfail036.hs:7
+ When checking methods of an instance declaration
+
+tcfail036.hs:7: No instance for: `PrelBase.Eq NUM'
+ arising from an instance declaration at tcfail036.hs:7
+ When checking superclass constraints of an instance declaration
+
+tcfail036.hs:7: No instance for: `PrelBase.Show NUM'
+ arising from an instance declaration at tcfail036.hs:7
+ When checking superclass constraints of an instance declaration
+
+tcfail036.hs:8: No explicit method nor default method for `PrelBase.+'
+ in an instance declaration for `PrelBase.Num'
+
+tcfail036.hs:8: No explicit method nor default method for `PrelBase.*'
+ in an instance declaration for `PrelBase.Num'
+
+tcfail036.hs:8: No explicit method nor default method for `PrelBase.negate'
+ in an instance declaration for `PrelBase.Num'
+
+tcfail036.hs:8: No explicit method nor default method for `PrelBase.abs'
+ in an instance declaration for `PrelBase.Num'
+
+tcfail036.hs:8: No explicit method nor default method for `PrelBase.signum'
+ in an instance declaration for `PrelBase.Num'
+
+tcfail036.hs:8: No explicit method nor default method for `PrelBase.fromInteger'
+ in an instance declaration for `PrelBase.Num'
+
+tcfail036.hs:7: No explicit method nor default method for `PrelBase.*'
+ in an instance declaration for `PrelBase.Num'
+
+tcfail036.hs:7: No explicit method nor default method for `PrelBase.negate'
+ in an instance declaration for `PrelBase.Num'
+
+tcfail036.hs:7: No explicit method nor default method for `PrelBase.abs'
+ in an instance declaration for `PrelBase.Num'
+
+tcfail036.hs:7: No explicit method nor default method for `PrelBase.signum'
+ in an instance declaration for `PrelBase.Num'
+
+tcfail036.hs:7: No explicit method nor default method for `PrelBase.fromInteger'
+ in an instance declaration for `PrelBase.Num'
+
+Compilation had errors
--- /dev/null
+--!!! PreludeCore entities cannot be redefined at the top-level
+--
+module M where
+
+data NUM = ONE | TWO
+
+f a b = a + b
+f :: NUM -> NUM -> NUM
+
+ONE + ONE = TWO
+
--- /dev/null
+
+tcfail037.hs:3:
+ Conflicting definitions for: `+'
+ Imported from Prelude at tcfail037.hs:3
+ Defined at tcfail037.hs:10
+
+
+Compilation had errors
--- /dev/null
+--!!! duplicate class-method declarations
+
+module M where
+
+data NUM = ONE | TWO
+instance Eq NUM where
+ a == b = True
+ a /= b = False
+ a == b = False
+ a /= b = True
+
--- /dev/null
+
+tcfail038.hs:8:
+ Conflicting definitions for `/=' in the bindings in an instance declaration
+
+tcfail038.hs:7:
+ Conflicting definitions for `==' in the bindings in an instance declaration
+
+
+Compilation had errors
--- /dev/null
+--!!! bogus re-use of prelude class-method name (==)
+--
+module M where
+
+data NUM = ONE | TWO
+class EQ a where
+ (==) :: a -> a -> Bool
+
+instance EQ NUM
+-- a /= b = False
+-- a == b = True
+-- a /= b = False
--- /dev/null
+
+tcfail039.hs:3:
+ Conflicting definitions for: `=='
+ Imported from Prelude at tcfail039.hs:3
+ Defined at tcfail039.hs:7
+
+
+Compilation had errors
--- /dev/null
+--!!! instances of functions
+--
+module M where
+
+data NUM = ONE | TWO
+
+class EQ a where
+ (===) :: a -> a -> Bool
+
+class ORD a where
+ (<<) :: a -> a -> Bool
+ a << b = True
+
+instance EQ (a -> b) where
+ f === g = True
+
+instance ORD (a -> b)
+
+f = (<<) === (<<)
+--f :: (EQ a,Num a) => a -> a -> Bool
+
+
+{-
+instance EQ NUM where
+-- a /= b = False
+ a === b = True
+-- a /= b = False
+
+-}
--- /dev/null
+
+tcfail040.hs:3: Ambiguous context `{ORD taBu}'
+ `ORD' `taBu' arising from use of `<<' at tcfail040.hs:19
+
+
+Compilation had errors
--- /dev/null
+--!!! weird class/instance examples off the haskell list
+--
+
+class Foo a where foo :: a -> a
+class Foo a => Bar a where bar :: a -> a
+
+
+instance Num a => Foo [a] where
+ foo [] = []
+ foo (x:xs) = map (x+) xs
+
+
+instance (Eq a, Show a) => Bar [a] where
+ bar [] = []
+ bar (x:xs) = foo xs where u = x==x
+ v = show x
+
+------------------------------------------
+
+{-
+class Foo a => Bar2 a where bar2 :: a -> a
+
+instance (Eq a, Show a) => Foo [a]
+
+instance Num a => Bar2 [a]
+
+data X a = X a
+-}
--- /dev/null
+
+tcfail042.hs:16: Context `{PrelBase.Num taHh}'
+ required by inferred type, but missing on a type signature
+ `PrelBase.Num' `taHh' arising from an instance declaration at tcfail042.hs:16
+ When checking superclass constraints of an instance declaration
+
+tcfail042.hs:4: Module Main must include a definition for `Main.main'
+
+
+Compilation had errors
--- /dev/null
+-- The translation of this program should assign only one dictionary to
+-- the function search (an Ord dictionary). Instead, it assigns two.
+-- The output produced currently displays this.
+
+-- 10/12/92: This program is actually erroneous. The pattern-binding for
+-- search falls under the monomorphism restriction, and there is no
+-- call to search which might fix its type. So there should be a complaint.
+-- But the actual error message is horrible:
+--
+-- "bug001.hs", line 26: Ambiguous overloading:
+-- class "Ord_", type "a" (at a use of an overloaded identifier: gt)
+-- class "Eq_", type "a" (at a use of an overloaded identifier: eq)
+
+
+
+class Eq_ a where
+ eq :: a -> a -> Bool
+
+instance Eq_ Int where
+ eq = eqIntEq
+
+instance (Eq_ a) => Eq_ [a] where
+ eq = \ xs ys ->
+ if (null xs)
+ then (null ys)
+ else if (null ys)
+ then False
+ else and (eq (hd xs) (hd ys)) (eq (tl xs) (tl ys))
+
+class (Eq_ a) => Ord_ a where
+ gt :: a -> a -> Bool
+
+instance Ord_ Int where
+ gt = ordIntGt
+
+search
+ = \ a bs -> if gt (hd bs) a
+ then False
+ else if eq a (hd bs) then True else search a (tl bs)
+
+and :: Bool -> Bool -> Bool
+and True True = True
+
+hd :: [a] -> a
+hd (a:as) = a
+
+tl :: [a] -> [a]
+tl (a:as) = as
+
+ordIntGt :: Int -> Int -> Bool
+ordIntGt 2 3 = True
+
+eqIntEq :: Int -> Int -> Bool
+eqIntEq 2 3 = True
+
+null :: [a] -> Bool
+null [] = True
+
+
+
+{-
+
+===============================================
+Main.Eq__INST_PreludeBuiltin.Int =
+ let
+ AbsBinds [] [] [(eq, eq)]
+ {- nonrec -}
+ {-# LINE 2 "test3.hs" -}
+
+ eq :: PreludeBuiltin.Int -> PreludeBuiltin.Int -> PreludeCore.Bool
+ eq = Main.eqIntEq
+ in ({-dict-} [] [eq])
+
+Main.Eq__INST_PreludeBuiltin.List =
+ /\ t135 ->
+ \{-dict-} _dict138 ->
+ let
+ {- nonrec -}
+ _dict136 = {-singleDict-} _dict138
+ {- nonrec -}
+ _dict129 = {-singleDict-} _dict136
+ AbsBinds [] [] [(eq, eq)]
+ {- nonrec -}
+
+ _dict133 =
+ Main.Eq__INST_PreludeBuiltin.List
+ [t135] [{-singleDict-} _dict136]
+ {- nonrec -}
+ {-# LINE 5 "test3.hs" -}
+
+ eq :: [t135] -> [t135] -> PreludeCore.Bool
+ eq = \ xs ys ->
+
+if (Main.null t135) xs then
+ (Main.null t135) ys
+ else
+
+ if (Main.null t135) ys then
+ PreludeCore.False
+ else
+
+ Main.and
+
+
+ ((Main.Eq_.eq t135 _dict129)
+
+
+ ((Main.hd t135) xs)
+ ((Main.hd t135) ys))
+
+
+
+
+
+
+(Main.Eq_.eq [t135] _dict133)
+
+
+
+ ((Main.tl t135) xs)
+ ((Main.tl t135) ys))
+ in ({-dict-} [] [eq])
+Main.Ord__INST_PreludeBuiltin.Int =
+ let
+ {- nonrec -}
+ _dict142 = Main.Eq__INST_PreludeBuiltin.Int [] []
+ AbsBinds [] [] [(gt, gt)]
+ {- nonrec -}
+ {-# LINE 16 "test3.hs" -}
+
+ gt :: PreludeBuiltin.Int -> PreludeBuiltin.Int -> PreludeCore.Bool
+ gt = Main.ordIntGt
+ in ({-dict-} [_dict142] [gt])
+
+Main.Eq_.eq = /\ a -> \{-classdict-} [] [eq] -> eq
+
+Main.Ord_.gt = /\ a -> \{-classdict-} [_dict56] [gt] -> gt
+
+Main.Ord__TO_Main.Eq_ = /\ a -> \{-classdict-} [_dict58] [gt] -> ???_dict58???
+
+AbsBinds [t60] [] [(hd, Main.hd)]
+ {- nonrec -}
+
+
+
+ hd :: [t60] -> t60
+ hd (a PreludeBuiltin.: as)
+ = a
+
+AbsBinds [t68] [] [(tl, Main.tl)]
+ {- nonrec -}
+
+
+
+
+ tl :: [t68] -> [t68]
+ tl (a PreludeBuiltin.: as)
+ = as
+
+
+AbsBinds [t91] [_dict85, _dict88] [(search, Main.search)]
+ {- rec -}
+ {-# LINE 19 "test3.hs" -}
+
+
+ search :: t91 -> [t91] -> PreludeCore.Bool
+ search
+ = \ a bs ->
+
+
+if (Main.Ord_.gt t91 _dict85) ((Main.hd t91) bs) a then
+ PreludeCore.False
+ else
+
+ if (Main.Eq_.eq t91 _dict88) a ((Main.hd t91) bs) then
+ PreludeCore.True
+ else
+
+ search a ((Main.tl t91) bs)
+AbsBinds [] [] [(and, Main.and)]
+ {- nonrec -}
+ and :: PreludeCore.Bool -> PreludeCore.Bool -> PreludeCore.Bool
+ and PreludeCore.True PreludeCore.True
+ = PreludeCore.True
+AbsBinds [] [] [(ordIntGt, Main.ordIntGt)]
+ {- nonrec -}
+ _dict97 = PreludeCore.Num_INST_PreludeBuiltin.Int [] []
+ {- nonrec -}
+ _dict98 = PreludeCore.Eq_INST_PreludeBuiltin.Int [] []
+ {- nonrec -}
+ _dict100 = PreludeCore.Num_INST_PreludeBuiltin.Int [] []
+ {- nonrec -}
+ _dict101 = PreludeCore.Eq_INST_PreludeBuiltin.Int [] []
+ {- nonrec -}
+
+
+
+ ordIntGt :: PreludeBuiltin.Int -> PreludeBuiltin.Int -> PreludeCore.Bool
+ ordIntGt
+ 2 3 = PreludeCore.True
+AbsBinds [] [] [(eqIntEq, Main.eqIntEq)]
+ {- nonrec -}
+ _dict105 = PreludeCore.Num_INST_PreludeBuiltin.Int [] []
+ {- nonrec -}
+ _dict106 = PreludeCore.Eq_INST_PreludeBuiltin.Int [] []
+ {- nonrec -}
+ _dict108 = PreludeCore.Num_INST_PreludeBuiltin.Int [] []
+ {- nonrec -}
+ _dict109 = PreludeCore.Eq_INST_PreludeBuiltin.Int [] []
+ {- nonrec -}
+
+ eqIntEq :: PreludeBuiltin.Int -> PreludeBuiltin.Int -> PreludeCore.Bool
+ eqIntEq
+ 2 3 = PreludeCore.True
+
+
+AbsBinds [t112] [] [(null, Main.null)]
+ {- nonrec -}
+
+ null :: [t112] -> PreludeCore.Bool
+ null [] = PreludeCore.True
+-}
--- /dev/null
+
+tcfail043.hs:16:
+ Conflicting definitions for: `and'
+ Imported from Prelude at tcfail043.hs:16
+ Defined at tcfail043.hs:42
+
+tcfail043.hs:16:
+ Conflicting definitions for: `null'
+ Imported from Prelude at tcfail043.hs:16
+ Defined at tcfail043.hs:57
+
+
+Compilation had errors
--- /dev/null
+--!!! tcfail044: duplicated type variable in instance decls
+--
+module Main where
+
+instance (Eq a) => Eq (a->a)
+
+
+instance (Num a) => Num (a->a) where
+ f + g = \x -> f x + g x
+ negate f = \x -> - (f x)
+ f * g = \x -> f x * g x
+ fromInteger n = \x -> fromInteger n
+
+ss :: Float -> Float
+cc :: Float -> Float
+tt :: Float -> Float
+
+ss = sin * sin
+cc = cos * cos
+tt = ss + cc
+
+main = putStr ((show (tt 0.4))++ " "++(show (tt 1.652)))
--- /dev/null
+
+tcfail044.hs:12: The type `a
+ -> a' cannot be used as an instance type
+
+tcfail044.hs:5: The type `a
+ -> a' cannot be used as an instance type
+
+tcfail044.hs:20: No instance for:
+ `PrelBase.Num (PrelBase.Float -> PrelBase.Float)'
+ arising from use of `PrelBase.+' at tcfail044.hs:20
+
+
+Compilation had errors
--- /dev/null
+--!!! a bad _CCallable thing (from a bug from Satnam)
+--
+module ShouldSucceed where
+
+import Foreign
+
+data Socket = Socket# Addr
+instance CCallable Socket
+
+f :: Socket -> PrimIO ()
+f x = _ccall_ foo x
--- /dev/null
+
+tcfail045.hs:10: Type constructor or class not in scope: `PrimIO'
+
+
+Compilation had errors
--- /dev/null
+--!! function types in deriving Eq things
+-- From a bug report by Dave Harrison <D.A.Harrison@newcastle.ac.uk>
+
+module Simulation(Process,
+ Status,
+ Pid,
+ Time,
+ Continuation,
+ Message,
+ MessList ) where
+
+type Process a = Pid -> Time -> Message a -> ( MessList a,
+ Continuation a)
+
+data Continuation a = Do (Process a) deriving Eq
+
+
+type ProcList a = [ (Pid, Status, Process a) ]
+data Status = Active | Passive | Busy Integer | Terminated
+ deriving Eq
+
+
+data Message a = Create (Process a) | Created Pid | Activate Pid |
+ Passivate Pid | Terminate Pid | Wait Pid Time |
+ Query Pid a | Data Pid a | Event |
+ Output Pid String
+ deriving Eq
+
+type MessList a = [ Message a ]
+
+type Pid = Integer
+type Time = Integer
--- /dev/null
+
+tcfail046.hs:4: No instance for class
+ `PrelBase.Eq'
+ at type
+ `Process a'
+
+tcfail046.hs:4: No instance for class
+ `PrelBase.Eq'
+ at type
+ `Process a'
+
+tcfail046.hs:4: No instance for class
+ `PrelBase.Eq'
+ at type
+ `Process a'
+
+tcfail046.hs:4: No instance for class
+ `PrelBase.Eq'
+ at type
+ `Process a'
+
+tcfail046.hs:23: No instance for: `PrelBase.Eq (Process taVO)'
+ arising from use of `PrelBase.==' at tcfail046.hs:23
+ When checking methods of an instance declaration
+
+tcfail046.hs:15: No instance for: `PrelBase.Eq (Process taZ8)'
+ arising from use of `PrelBase.==' at tcfail046.hs:15
+ When checking methods of an instance declaration
+
+
+Compilation had errors
--- /dev/null
+
+class A a where
+ op1 :: a -> a
+
+instance A (a,(b,c)) where
+ op1 a = a
--- /dev/null
+
+tcfail047.hs:6: The type `(a, (b, c))' cannot be used as an instance type
+
+tcfail047.hs:2: Module Main must include a definition for `Main.main'
+
+
+Compilation had errors
--- /dev/null
+module ShouldFail where
+
+class (B a) => C a where
+ op1 :: a -> a
--- /dev/null
+
+tcfail048.hs:4: Type constructor or class not in scope: `B'
+
+
+Compilation had errors
--- /dev/null
+module ShouldFail where
+
+f x = g x
--- /dev/null
+
+tcfail049.hs:3: Value not in scope: `g'
+
+
+Compilation had errors
--- /dev/null
+module ShouldFail where
+
+f x = B x
--- /dev/null
+
+tcfail050.hs:3: Data constructor not in scope: `B'
+
+
+Compilation had errors
--- /dev/null
+module ShouldFail where
+
+instance B Bool where
+ op1 a = a
--- /dev/null
+
+tcfail051.hs:4: Type constructor or class not in scope: `B'
+
+
+Compilation had errors
--- /dev/null
+module ShouldFail where
+
+data C a = B a c
--- /dev/null
+
+tcfail052.hs:4: Type variable not in scope: `c'
+
+
+Compilation had errors
--- /dev/null
+
+data B = C A
--- /dev/null
+
+tcfail053.hs:3: Type constructor or class not in scope: `A'
+
+
+Compilation had errors
--- /dev/null
+module ShouldFail where
+
+f (B a) = True
--- /dev/null
+
+tcfail054.hs:3: Data constructor not in scope: `B'
+
+
+Compilation had errors
--- /dev/null
+module ShouldFail where
+
+f x = (x + 1 :: Int) :: Float
--- /dev/null
+
+tcfail055.hs:3: Couldn't match the type
+ `PrelBase.Int' against `PrelBase.Float'
+ Expected: `PrelBase.Float'
+ Inferred: `PrelBase.Int'
+ In an expression with a type signature:
+ `(x PrelBase.+ 1 :: PrelBase.Int) :: PrelBase.Float'
+
+
+Compilation had errors
--- /dev/null
+module ShouldFail where
+
+data Foo = MkFoo Bool
+
+instance Eq Foo where
+ (MkFoo x) == (MkFoo y) = x == y
+
+instance Eq Foo where
+ -- forgot to type "Ord" above
+ (MkFoo x) <= (MkFoo y) = x <= y
+
--- /dev/null
+
+tcfail056.hs:1: Duplicate or overlapping instance declarations
+ for `PrelBase.Eq Foo' at tcfail056.hs:6 and tcfail056.hs:10
+
+tcfail056.hs:10: Class `PrelBase.Eq' does not have a method `<='
+
+tcfail056.hs:10: No explicit method nor default method for `PrelBase.=='
+ in an instance declaration for `PrelBase.Eq'
+
+Compilation had errors
--- /dev/null
+module ShouldFail where
+
+--!!! inadvertently using -> instead of =>
+
+f :: (RealFrac a) -> a -> a
+f x = x
--- /dev/null
+
+tcfail057.hs:5: Class used as a type constructor: `PrelNum.RealFrac'
+
+
+Compilation had errors
--- /dev/null
+module ShouldFail where
+import Array
+
+--!!! inadvertently using => instead of ->
+
+f :: (Array a) => a -> b
+f x = x
--- /dev/null
+
+tcfail058.hs:6: Type constructor used as a class: `ArrBase.Array'
+
+
+Compilation had errors
--- /dev/null
+--!! signature bugs exposed by Sigbjorne Finne
+--
+module ShouldFail where
+
+type Flarp a = (b,b)
+
+--More fun can be had if we change the signature slightly
+
+type Bob a = a
+
+type Flarp2 a = Bob (b,b)
--- /dev/null
+
+tcfail061.hs:11: Type variable not in scope: `b'
+
+tcfail061.hs:11: Type variable not in scope: `b'
+
+tcfail061.hs:5: Type variable not in scope: `b'
+
+tcfail061.hs:5: Type variable not in scope: `b'
+
+
+Compilation had errors
--- /dev/null
+--!!! bug report from Satnam
+--
+module RubyAST
+where
+
+type Module = (String,[Declaration])
+
+data Declaration
+ = Architecture String StructuralExpression |
+ Behaviour String Parameter Parameter BehaviouralExpression
+ deriving (Eq, Show)
+
+data Parameter = ParameterVariable String | ParameterList [Parameter]
+ deriving (Eq, Show)
+
+nameOfModule :: Module -> String
+nameOfModule (name, _) = name
+
+data StructuralExpression
+ = Variable String |
+ Serial StructuralExpression StructuralExpression |
+ Par [StructuralExpression]
+ deriving (Eq, Show)
+
+data BehaviouralExpression
+ = BehaviouralVariable String
+ | AndExpr BehaviouralExpression BehaviouralExpression
+ | OrExpr BehaviouralExpression BehaviouralExpression
+ | NotExpr BehaviouralExpression
+ deriving (Eq, Show)
+
+
+type BehaviouralRelation
+ = (behaviouralExpression, behaviouralExpression)
+-----^ typo ----------------^ typo (but so what?)
+
+type BehaviouralRelationList = [BehaviouralRelation]
--- /dev/null
+
+tcfail062.hs:33:
+ Type variable not in scope: `behaviouralExpression'
+
+tcfail062.hs:33:
+ Type variable not in scope: `behaviouralExpression'
+
+
+Compilation had errors
--- /dev/null
+--!!! no type variable on a context
+--!!! reported by Sigbjorn Finne
+
+moby :: Num => Int -> a -> Int
+moby x y = x+y
--- /dev/null
+tcfail063.hs:5:1: is_context_format: variable missing after class name on input: "moby"
--- /dev/null
+
+tcfail064.hs:0: Module Main must include a definition for `Main.main'
+
+
+Compilation had errors
--- /dev/null
+{-
+
+------- Forwarded Message
+
+Date: Wed, 30 Nov 1994 16:34:18 +0100
+From: John Hughes <rjmh@cs.chalmers.se>
+To: augustss@cs.chalmers.se, simonpj@dcs.gla.ac.uk
+Subject: Nice little program
+
+
+Lennart, Simon,
+
+You might like to look at the fun little program below.
+
+THUMBS DOWN to hbc for compiling it (it prints [72, 101, 108, 108, 111])
+THUMBS UP to ghc for rejecting it --- but what an error message!
+nhc and gofer both reject it with the right error message.
+I haven't tried Yale Haskell.
+
+Enjoy!
+- ----------------------------
+-}
+
+class HasX a where
+ setX :: x->a->a
+
+data X x = X x
+instance HasX (X x) where
+ setX x (X _) = X x
+
+changetype x = case setX x (X (error "change type!")) of X y->y
+
+main = print (changetype "Hello" :: [Int])
+
+{-
+------- End of Forwarded Message
+-}
--- /dev/null
+
+<NoSrcLoc>: A type signature is more polymorphic than the inferred type
+ Some type variables in the inferred type can't be forall'd, namely:
+ `taHR'
+ Possible cause: the RHS mentions something subject to the monomorphism restriction
+ When checking signature for `setX'
+
+
+Compilation had errors
--- /dev/null
+module SubRange where
+
+infixr 1 `rangeOf`
+
+
+data Ord a => SubRange a = SubRange (a, a) a
+
+type IntSubRange = SubRange Int
+
+
+subRangeValue :: SubRange a -> a
+subRangeValue (SubRange (lower, upper) value) = value
+
+subRange :: SubRange a -> (a, a)
+subRange (SubRange r value) = r
+
+newRange :: (Ord a, Show a) => (a, a) -> a -> SubRange a
+newRange r value = checkRange (SubRange r value)
+
+
+checkRange :: (Ord a, Show a) => SubRange a -> SubRange a
+checkRange (SubRange (lower, upper) value)
+ = if (value < lower) || (value > upper) then
+ error ("### sub range error. range = " ++ show lower ++
+ ".." ++ show upper ++ " value = " ++ show value ++ "\n")
+ else
+ SubRange (lower, upper) value
+
+
+instance Eq a => Eq (SubRange a) where
+ (==) a b = subRangeValue a == subRangeValue b
+
+instance (Ord a) => Ord (SubRange a) where
+ (<) = relOp (<)
+ (<=) = relOp (<=)
+ (>=) = relOp (>=)
+ (>) = relOp (>)
+
+relOp :: Ord a => (a->a->Bool) -> SubRange a -> SubRange a -> Bool
+relOp op a b = (subRangeValue a) `op` (subRangeValue b)
+
+rangeOf :: (Ord a, Show a) => SubRange a -> SubRange a -> SubRange a
+rangeOf a b = checkRange (SubRange (subRange b) (subRangeValue a))
+
+showRange :: Show a => SubRange a -> String
+showRange (SubRange (lower, upper) value)
+ = show value ++ " :" ++ show lower ++ ".." ++ show upper
+
+showRangePair :: (Show a, Show b) => (SubRange a, SubRange b) -> String
+showRangePair (a, b)
+ = "(" ++ showRange a ++ ", " ++ showRange b ++ ")"
+
+showRangeTriple :: (Show a, Show b, Show c) =>
+ (SubRange a, SubRange b, SubRange c) -> String
+showRangeTriple (a, b, c)
+ = "(" ++ showRange a ++ ", " ++ showRange b ++ ", " ++ showRange c ++ ")"
+
+
+
+instance Num a => Num (SubRange a) where
+ negate = numSubRangeNegate
+ (+) = numSubRangeAdd
+ (-) = numSubRangeSubtract
+ (*) = numSubRangeMultiply
+ fromInteger a = SubRange (fromInteger a, fromInteger a) (fromInteger a)
+
+numSubRangeNegate :: (Ord a, Num a) => SubRange a -> SubRange a
+numSubRangeNegate (SubRange (lower, upper) value)
+ = checkRange (SubRange (lower, upper) (-value))
+
+numSubRangeBinOp :: Num a => (a -> a -> a) ->
+ SubRange a -> SubRange a -> SubRange a
+numSubRangeBinOp op a b
+ = SubRange (result, result) result
+ where
+ result = (subRangeValue a) `op` (subRangeValue b)
+
+-- partain:
+numSubRangeAdd, numSubRangeSubtract, numSubRangeMultiply :: Num a => SubRange a -> SubRange a -> SubRange a
+
+numSubRangeAdd = numSubRangeBinOp (+)
+numSubRangeSubtract = numSubRangeBinOp (-)
+numSubRangeMultiply = numSubRangeBinOp (*)
+
+unsignedBits :: Int -> (Int, Int)
+unsignedBits n = (0, 2^n-1)
+
+signedBits :: Int -> (Int, Int)
+signedBits n = (-2^(n-1), 2^(n-1)-1)
+
+
+si_n :: Int -> Int -> IntSubRange
+si_n bits value = SubRange (signedBits bits) value
+
+si8, si10, si16 :: Int -> IntSubRange
+si8 = si_n 8
+si10 = si_n 10
+si16 = si_n 16
--- /dev/null
+
+tcfail067.hs:1: Context `{PrelBase.Ord ta17k}'
+ required by inferred type, but missing on a type signature
+ `PrelBase.Ord' `ta17k' arising from use of `SubRange' at tcfail067.hs:76
+ When checking signature(s) for: `numSubRangeBinOp'
+
+tcfail067.hs:65: Context `{PrelBase.Ord ta18S}'
+ required by inferred type, but missing on a type signature
+ `PrelBase.Ord' `ta18S' arising from use of `numSubRangeNegate' at tcfail067.hs:61
+ When checking methods of an instance declaration
+
+tcfail067.hs:65: No explicit method nor default method for `PrelBase.abs'
+ in an instance declaration for `PrelBase.Num'
+
+tcfail067.hs:65: No explicit method nor default method for `PrelBase.signum'
+ in an instance declaration for `PrelBase.Num'
+
+Compilation had errors
--- /dev/null
+--!! Make sure that state threads don't escape
+--!! (example from Neil Ashton at York)
+--
+module IndTree(IndTree(..), itgen, itiap, itrap, itrapstate) where
+
+import GlaExts
+import ST
+
+type IndTree s t = MutableArray s (Int,Int) t
+
+itgen :: Constructed a => (Int,Int) -> a -> IndTree s a
+itgen n x =
+ runST (
+ newArray ((1,1),n) x)
+
+itiap :: Constructed a => (Int,Int) -> (a->a) -> IndTree s a -> IndTree s a
+itiap i f arr =
+ runST (
+ readArray arr i `thenStrictlyST` \val ->
+ writeArray arr i (f val) `seqStrictlyST`
+ returnStrictlyST arr)
+
+itrap :: Constructed a => ((Int,Int),(Int,Int)) -> (a->a) -> IndTree s a -> IndTree s a
+itrap ((i,k),(j,l)) f arr = runST(itrap' i k)
+ where
+ itrap' i k = if k > l then returnStrictlyST arr
+ else (itrapsnd i k `seqStrictlyST`
+ itrap' i (k+1))
+ itrapsnd i k = if i > j then returnStrictlyST arr
+ else (readArray arr (i,k) `thenStrictlyST` \val ->
+ writeArray arr (i,k) (f val) `seqStrictlyST`
+ itrapsnd (i+1) k)
+
+itrapstate :: Constructed b => ((Int,Int),(Int,Int)) -> (a->b->(a,b)) -> ((Int,Int)->c->a) ->
+ (a->c) -> c -> IndTree s b -> (c, IndTree s b)
+itrapstate ((i,k),(j,l)) f c d s arr = runST(itrapstate' i k s)
+ where
+ itrapstate' i k s = if k > l then returnStrictlyST (s,arr)
+ else (itrapstatesnd i k s `thenStrictlyST` \(s,arr) ->
+ itrapstate' i (k+1) s)
+ itrapstatesnd i k s = if i > j then returnStrictlyST (s,arr)
+ else (readArray arr (i,k) `thenStrictlyST` \val ->
+ let (newstate, newval) = f (c (i,k) s) val
+ in writeArray arr (i,k) newval `seqStrictlyST`
+ itrapstatesnd (i+1) k (d newstate))
+
+-- stuff from Auxiliary: copied here (partain)
+
+sap :: (a->b) -> (c,a) -> (c,b)
+sap f (x,y) = (x, f y)
+
+fap :: (a->b) -> (a,c) -> (b,c)
+fap f (x,y) = (f x, y)
+
+nonempty :: [a] -> Bool
+nonempty [] = False
+nonempty (_:_) = True
+
+-- const :: a -> b -> a
+-- const k x = k
+
+-- id :: a -> a
+-- id x = x
+
+compose :: [a->a] -> a -> a
+compose = foldr (.) id
+
+data Maybe t = Just t | Nothing
+
+class Constructed a where
+ normal :: a -> Bool
+
+instance Constructed Bool where
+ normal True = True
+ normal False = True
+
+instance Constructed Int where
+ normal 0 = True
+ normal n = True
+
+instance (Constructed a, Constructed b) => Constructed (a,b) where
+ normal (x,y) = normal x && normal y
+
+-- pair :: (Constructed a, Constructed b) => a -> b -> (a,b)
+-- pair x y | normal x && normal y = (x,y)
+
+instance Constructed (Maybe a) where
+ normal Nothing = True
+ normal (Just _) = True
+
+just :: Constructed a => a -> Maybe a
+just x | normal x = Just x
--- /dev/null
+
+tcfail068.hs:4:
+ Conflicting definitions for: `Just'
+ Imported from Prelude at tcfail068.hs:4
+ Defined at tcfail068.hs:68
+
+tcfail068.hs:4:
+ Conflicting definitions for: `Nothing'
+ Imported from Prelude at tcfail068.hs:4
+ Defined at tcfail068.hs:70
+
+tcfail068.hs:4:
+ Conflicting definitions for: `Maybe'
+ Imported from Prelude at tcfail068.hs:4
+ Defined at tcfail068.hs:68
+
+tcfail068.hs:19: Value not in scope: `returnStrictlyST'
+
+tcfail068.hs:19: Value not in scope: `seqStrictlyST'
+
+tcfail068.hs:21: Value not in scope: `thenStrictlyST'
+
+tcfail068.hs:26: Value not in scope: `returnStrictlyST'
+
+tcfail068.hs:26: Value not in scope: `seqStrictlyST'
+
+tcfail068.hs:29: Value not in scope: `returnStrictlyST'
+
+tcfail068.hs:30: Value not in scope: `seqStrictlyST'
+
+tcfail068.hs:29: Value not in scope: `thenStrictlyST'
+
+tcfail068.hs:38: Value not in scope: `returnStrictlyST'
+
+tcfail068.hs:38: Value not in scope: `thenStrictlyST'
+
+tcfail068.hs:41: Value not in scope: `returnStrictlyST'
+
+tcfail068.hs:42: Value not in scope: `seqStrictlyST'
+
+tcfail068.hs:41: Value not in scope: `thenStrictlyST'
+
+
+Compilation had errors
--- /dev/null
+{-
+From: Marc van Dongen <dongen@cs.ucc.ie>
+Date: Wed, 9 Apr 1997 14:06:39 +0100 (BST)
+
+I just wanted to report that the erroneous and tiny
+program added below can not be compiled within 6MB of
+heap (Admitted it can be compiled with a bigger heap).
+It was part of a bigger program that could not be
+compiled within 20MB of heap.
+
+[GHC 2.03 and earlier.] Turned out to be a bug in the
+error recovery mechanism.
+
+-}
+
+module Too_Kuch( too_much ) where
+
+too_much :: [Int] -> [(Int,Int)] -> [(Int,[Int])] -> Bool
+too_much ds ((k,m):q1) s0
+ = case (list1,list2) of
+ [] -> error "foo" -- too_much ds q2m s2m
+ where list1 = ds
+ list2 = ds
+ {-
+ list1 = [k' | k' <- ds, k == k']
+ list2 = [k' | k' <- ds, m == k']
+ s1 = aas s0 k
+ raM = []
+ raKM = listUnion (\a b -> a) [] []
+ s1k = s1
+ q1k = raM
+ s2k = s1
+ q2k = raM
+ s2m = s1
+ q2m = raM
+ s2km = foldr (flip aas) s1 raKM
+ q2km = raKM
+ -}
+
+listUnion :: (v -> v -> Bool) -> [v] -> [v] -> [v]
+listUnion _ _ _
+ = []
+
+aas :: (a,b) -> a -> (a,b)
+aas s _
+ = s
+
+
--- /dev/null
+
+tcfail069.hs:21: Couldn't match the type
+ `PrelBase.[]' against `PrelTup.(,) [PrelBase.Int]'
+ Expected: `[taCf]'
+ Inferred: `([PrelBase.Int], [PrelBase.Int])'
+ In a "case" branch: `PrelBase.[]' -> `IOBase.error "foo"'
+ In the case expression
+ `case (list1, (list2)) of PrelBase.[] -> IOBase.error "foo"'
+ In an equation for function `too_much':
+ `too_much ds ((k, m) PrelBase.: q1) s0
+ = case (list1, (list2)) of PrelBase.[] -> IOBase.error "foo"
+ where
+ list2 = ds
+ list1 = ds'
+
+
+Compilation had errors
--- /dev/null
+{-
+From: Wolfgang Drotschmann <drotschm@athene.informatik.uni-bonn.de>
+Resent-Date: Thu, 15 May 1997 17:23:09 +0100
+
+I'm still using the old ghc-2.01. In one program I ran into a problem
+I couldn't fix. But I played around with it, I found a small little
+script which reproduces it very well:
+
+panic! (the `impossible' happened):
+ tlist
+-}
+
+type State = ([Int] Bool)
+
--- /dev/null
+
+tcfail070.hs:13: Couldn't match the kind `*' against `* -> ka1921'
+ When unifying two kinds `*' and `* -> ka1921'
+ In the type declaration for `State'
+
+
+Compilation had errors
--- /dev/null
+--!!! Mis-matched contexts in a mutually recursive group
+
+module Foo7( f ) where
+
+f :: (Ord c) => c -> c
+f c = g c
+
+g :: c -> c
+g c = c
+ where p = foldr (f c) [] []
--- /dev/null
+
+tcfail071.hs:10: Couldn't match the signature/existential type variable
+ `taCF' with the type `taCR -> taCS -> taCS'
+ Expected: `taCR -> taCS -> taCS'
+ Inferred: `taCF'
+ In the first argument of `PrelBase.foldr', namely `(f c)'
+ In an equation for function `g':
+ `g c
+ = c
+ where
+ p = PrelBase.foldr (f c) PrelBase.[] PrelBase.[]'
+
+tcfail071.hs:8: Mismatched contexts
+ When matching the contexts of the signatures for `f' and `g'
+ (the signature contexts in a mutually recursive group should all be identical)
+
+
+Compilation had errors
--- /dev/null
+{- This program crashed GHC 2.03
+
+ From: Marc van Dongen <dongen@cs.ucc.ie>
+ Date: Sat, 31 May 1997 14:35:40 +0100 (BST)
+
+ zonkIdOcc: g_aoQ
+
+ panic! (the `impossible' happened):
+ lookupBindC:no info!
+ for: g_aoQ
+ (probably: data dependencies broken by an optimisation pass)
+ static binds for:
+ Tmp.$d1{-rmM,x-}
+ local binds for:
+-}
+
+module Tmp( g ) where
+
+data AB p q = A
+ | B p q
+
+g :: (Ord p,Ord q) => (AB p q) -> Bool
+g (B _ _) = g A
+
--- /dev/null
+-- what error do you get if you redefined PreludeCore instances?
+
+module Test where
+
+f x@(a,b) y@(c,d) = x == y
+
+instance Eq (a,b) where
+ (m,n) == (o,p) = m == o
--- /dev/null
+{- SHOULD FAIL
+
+ GHC 2.02 failed to realise that this bogus
+ program didn't have the right type for main
+-}
+
+main = 2
+main = putStrLn "hello world"
--- /dev/null
+--!! Test top-level unboxed types
+
+{-# OPTIONS -fglasgow-exts #-}
+
+module Main where
+
+x = 1#
+
+y :: Int#
+y = x +# 1#
+
+main = let
+ z = x -# y
+ in
+ if z ># 3# then putStrLn "Yes"
+ else putStrLn "No"
--- /dev/null
+TOP = ../../../..
+include $(TOP)/mk/boilerplate.mk
+
+HS_SRCS = $(wildcard *.hs)
+BINS = $(patsubst %.o,%,$(HS_OBJS))
+
+SRC_RUNTEST_OPTS += -o1 $*.stdout -o2 $*.stderr -x 0
+HC_OPTS += -noC -dcore-lint
+
+all :: $(BINS)
+
+%.o : %
+ $(HC) $(HC_OPTS) $< -o $@
+
+
+include $(TOP)/mk/target.mk
--- /dev/null
+--!! Test for (->) instances
+
+module Main where
+
+class Flob k where
+ twice :: k a a -> k a a
+
+instance Flob (->) where
+ twice f = f . f
+
+inc :: Int -> Int
+inc x = x+1
+
+main = print (twice inc 2)
+
+
projects / ghc-hetmet.git / commitdiff