diff options
Diffstat (limited to 'testsuite/tests/ghc-regress/indexed-types/should_compile')
149 files changed, 0 insertions, 3392 deletions
diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/ATLoop.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/ATLoop.hs deleted file mode 100644 index 19f9e5b8a2..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/ATLoop.hs +++ /dev/null @@ -1,22 +0,0 @@ -{-# OPTIONS_GHC -O2 #-}
-
--- Reading the interface file caused a black hole
--- in earlier versions of GHC
-
--- Also, foo should compile to very tight code with -O2
--- (The O2 was nothing to do with the black hole though.)
-
-module ShouldCompile where
-
-import ATLoop_help
-
-foo :: FooT Int -> Int -> Int
-foo t n = t `seq` bar n
- where
- bar 0 = 0
- bar n | even n = bar (n `div` 2)
- bar n = bar (n - int t)
-
-
-
-
diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/ATLoop_help.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/ATLoop_help.hs deleted file mode 100644 index 8814f480eb..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/ATLoop_help.hs +++ /dev/null @@ -1,10 +0,0 @@ -{-# LANGUAGE TypeFamilies #-}
-module ATLoop_help where
-
-class Foo a where
- data FooT a :: *
- int :: FooT a -> Int
-
-instance Foo Int where
- data FooT Int = FooInt !Int
- int (FooInt n) = n
diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Class1.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Class1.hs deleted file mode 100644 index 4e58e13d58..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Class1.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE TypeFamilies, FlexibleContexts #-} - --- Results in context reduction stack overflow - -module Class1 where - -class C a where - foo :: a x -> a y - -class C (T a) => D a where - type T a :: * -> * - - bar :: a -> T a x -> T a y - -instance C Maybe where - foo Nothing = Nothing - -instance D () where - type T () = Maybe - - bar x t = foo t diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Class2.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Class2.hs deleted file mode 100644 index f0d90f35f5..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Class2.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module Class2 where - -data family T a -data instance T Int = TInt Int - -data U = U (T Int) - -instance Show a => Show (T a) where - showsPrec k t = showString "T" - -instance Show U where - showsPrec k (U x) = showsPrec k x - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Class3.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Class3.hs deleted file mode 100644 index 6bea22e1a4..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Class3.hs +++ /dev/null @@ -1,11 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module Class3 where - -class C a where - foo :: a -> a -instance C () - -bar :: (a ~ ()) => a -> a -bar = foo - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Class3.stderr b/testsuite/tests/ghc-regress/indexed-types/should_compile/Class3.stderr deleted file mode 100644 index 58367939d0..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Class3.stderr +++ /dev/null @@ -1,4 +0,0 @@ - -Class3.hs:7:10: - Warning: No explicit method nor default method for `foo' - In the instance declaration for `C ()' diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/ClassEqContext.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/ClassEqContext.hs deleted file mode 100644 index 7de87362b4..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/ClassEqContext.hs +++ /dev/null @@ -1,5 +0,0 @@ -{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-} - -module ClassEqContext where - -class a ~ b => C a b diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/ClassEqContext2.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/ClassEqContext2.hs deleted file mode 100644 index a491577723..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/ClassEqContext2.hs +++ /dev/null @@ -1,6 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE MultiParamTypeClasses #-} - -module ClassEqContext where - -class (Show a,a ~ b) => C a b diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/ClassEqContext3.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/ClassEqContext3.hs deleted file mode 100644 index e2fd14515f..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/ClassEqContext3.hs +++ /dev/null @@ -1,8 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE MultiParamTypeClasses #-} - -module ClassEqContext where - -class a ~ b => C a b - -instance C Char Char diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/CoTest3.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/CoTest3.hs deleted file mode 100644 index 971a464a89..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/CoTest3.hs +++ /dev/null @@ -1,26 +0,0 @@ -{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE GADTs #-}
-
--- This test uses the PushC rule of the System FC operational semantics
--- Writen by Tom Schrijvers
-
-module CoTest3 where
-
-data T a = K (a ~ Int => a -> Int)
-
-
-{-# INLINE[2] f #-}
-f :: T s1 ~ T s2 => T s1 -> T s2
-f x = x
-
-{-# INLINE[3] test #-}
-test :: T s1 ~ T s2 => (s1 ~ Int => s1 -> Int) -> (s2 ~ Int => s2 -> Int)
-test g = case f (K g) of
- K r -> r
-e :: s ~ Int => s -> s -> Int
-e _ s = s
-
-final :: s1 ~ s2 => s1 -> (s2 ~ Int => s2 -> Int)
-final x = test (e x)
diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Col.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Col.hs deleted file mode 100644 index 62c309bd91..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Col.hs +++ /dev/null @@ -1,16 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module Col where - -type family Elem c - -type instance Elem [e] = e - -class Col c where - singleton :: Elem c -> c - add :: c -> Elem c -> c - -instance Col [e] where - singleton = \x -> [x] - add = flip (:) - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Col2.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Col2.hs deleted file mode 100644 index 97a10aef84..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Col2.hs +++ /dev/null @@ -1,14 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE FlexibleContexts #-} - -module Col where - -type family Elem c - -type instance Elem [e] = e - -class (Eq (Elem c)) => Col c where - count :: Elem c -> c -> Int - -instance Eq e => Col [e] where - count x = length . filter (==x) diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/ColGivenCheck.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/ColGivenCheck.hs deleted file mode 100644 index 288c6e0608..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/ColGivenCheck.hs +++ /dev/null @@ -1,20 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module ColInference where - -type family Elem c - -type instance Elem [e] = e - -class Col c where - isEmpty :: c -> Bool - add :: c -> Elem c -> c - headTail :: c -> (Elem c,c) - -addAll :: (Col c1, Col c2, Elem c1 ~ Elem c2) => c1 -> c2 -> c2 -addAll c1 c2 - | isEmpty c1 - = c2 - | otherwise - = let (x,c1') = headTail c1 - in addAll c1' (add c2 x) diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/ColGivenCheck2.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/ColGivenCheck2.hs deleted file mode 100644 index 2da7cb4117..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/ColGivenCheck2.hs +++ /dev/null @@ -1,31 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module ColInference where - -type family Elem c - -type instance Elem [e] = e - -class Col c where - isEmpty :: c -> Bool - add :: c -> Elem c -> c - headTail :: c -> (Elem c,c) - --- addAll :: (Col c1, Col c2, Elem c1 ~ Elem c2) => c1 -> c2 -> c2 --- addAll c1 c2 --- | isEmpty c1 --- = c2 --- | otherwise --- = let (x,c1') = headTail c1 --- in addAll c1' (add c2 x) - -sumCol :: (Col c, Elem c ~ Int) => c -> Int -sumCol c | isEmpty c - = 0 - | otherwise - = let (x,xs) = headTail c - in x + (sumCol xs) - --- data CP :: * -> * where --- CP :: (Col c1, Col c2, Elem c1 ~ Elem c2, Elem c2 ~ Int) => (c1,c2) -> CP Char - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/ColInference.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/ColInference.hs deleted file mode 100644 index a70b7dd444..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/ColInference.hs +++ /dev/null @@ -1,19 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module ColInference where - -type family Elem c - -type instance Elem [e] = e - -class Col c where - isEmpty :: c -> Bool - add :: c -> Elem c -> c - headTail :: c -> (Elem c,c) - -addAll c1 c2 - | isEmpty c1 - = c2 - | otherwise - = let (x,c1') = headTail c1 - in addAll c1' (add c2 x) diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/ColInference2.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/ColInference2.hs deleted file mode 100644 index 9785d717a7..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/ColInference2.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module ColInference where - -type family Elem c - -type instance Elem [e] = e - -class Col c where - isEmpty :: c -> Bool - add :: c -> Elem c -> c - headTail :: c -> (Elem c,c) - -sawpOne c1 c2 - = let (x,c1') = headTail c1 - (y,c2') = headTail c2 - in (add c1' y,add c2' x) diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/ColInference3.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/ColInference3.hs deleted file mode 100644 index f946e89120..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/ColInference3.hs +++ /dev/null @@ -1,44 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module Main where - -type family Elem c - -class Col c where - isEmpty :: c -> Bool - add :: c -> Elem c -> c - headTail :: c -> (Elem c,c) - --- LIST -instance Col [a] where - isEmpty = null - add = flip (:) - headTail (x:xs) = (x,xs) - -type instance Elem [a] = a - --- SEQUENCE -data Sequence a = Nil | Snoc (Sequence a) a deriving Show - -instance Col (Sequence a) where - isEmpty Nil = True - isEmpty _ = False - - add s x = Snoc s x - - headTail (Snoc s x) = (x,s) - -type instance Elem (Sequence a) = a - --- -addAll c1 c2 - | isEmpty c1 - = c2 - | otherwise - = let (x,c1') = headTail c1 - in addAll c1' (add c2 x) - --- -main = print $ addAll c1 c2 - where c1 = ['a','b','c'] - c2 = (Snoc (Snoc (Snoc Nil 'd') 'e') 'f') diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/ColInference4.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/ColInference4.hs deleted file mode 100644 index 27675b1051..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/ColInference4.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module ColInference where - -type family Elem c - -type instance Elem [e] = e - -class Col c where - isEmpty :: c -> Bool - add :: c -> Elem c -> c - headTail :: c -> (Elem c,c) - -sawpOne c1 c2 - = let (x,c1') = headTail c1 - (y,c2') = headTail c2 - in (add c1' y,add c1' x) diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/ColInference5.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/ColInference5.hs deleted file mode 100644 index b65a90092e..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/ColInference5.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module ColInference where - -type family Elem c - -type instance Elem [e] = e - -class Col c where - isEmpty :: c -> Bool - add :: c -> Elem c -> c - headTail :: c -> (Elem c,c) - -sawpOne c1 c2 - = let (x,c1') = headTail c1 - (y,c2') = headTail c2 - in (add c1' y,add c1' y) diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/ColInference6.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/ColInference6.hs deleted file mode 100644 index 9273632e2b..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/ColInference6.hs +++ /dev/null @@ -1,13 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module ColInference6 where - -type family Elem c - -type instance Elem [e] = e - -class Col c where - toList :: c -> [Elem c] - - -sumCol c = sum . toList $ c diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/DataFamDeriv.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/DataFamDeriv.hs deleted file mode 100644 index 3800b51a3f..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/DataFamDeriv.hs +++ /dev/null @@ -1,11 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} -module DataFamDeriv where - -data family Foo a -data Bar = Bar -data instance Foo Bar - = Bar1 | Bar2 | Bar3 | Bar4 | Bar5 | Bar6 | Bar7 | Bar8 | Bar9 - deriving Eq - - - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Deriving.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Deriving.hs deleted file mode 100644 index fd0eff2016..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Deriving.hs +++ /dev/null @@ -1,30 +0,0 @@ -{-# LANGUAGE TypeFamilies, StandaloneDeriving, FlexibleInstances #-} - -module ShouldCompile where - -data family T a - -data instance T Int = A | B - deriving Eq - -foo :: T Int -> Bool -foo x = x == x - -data instance T Char = C - -instance Eq (T Char) where - C == C = False - -data family R a -data instance R [a] = R - -deriving instance Eq (R [a]) - -class C a where - data S a - -instance C Int where - data S Int = SInt deriving Eq - -bar :: S Int -> Bool -bar x = x == x diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/DerivingNewType.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/DerivingNewType.hs deleted file mode 100644 index 65f3b8520d..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/DerivingNewType.hs +++ /dev/null @@ -1,14 +0,0 @@ -{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving #-} - -module ShouldCompile where - -data family S a - -newtype instance S Int = S Int - deriving Eq - -data family S2 a b - -newtype instance S2 Int b = S2 (IO b) - deriving Monad - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Exp.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Exp.hs deleted file mode 100644 index 60cb12f098..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Exp.hs +++ /dev/null @@ -1,10 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module Exp (C, C(type T), T, foo, S) -where - -class C a where - data T a :: * - foo :: a -> a - -data family S a b :: * diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT1.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT1.hs deleted file mode 100644 index 7761eafe97..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT1.hs +++ /dev/null @@ -1,27 +0,0 @@ -{-# LANGUAGE TypeFamilies, GADTs, EmptyDataDecls #-} - --- This wrongly fails with --- --- Can't construct the infinite type n = PLUS n ZERO - -module GADT1 where - -data ZERO -data SUCC n - -data Nat n where - Zero :: Nat ZERO - Succ :: Nat n -> Nat (SUCC n) - -type family PLUS m n -type instance PLUS ZERO n = n -type instance PLUS (SUCC m) n = SUCC (PLUS m n) - -data EQUIV x y where - EQUIV :: EQUIV x x - -plus_zero :: Nat n -> EQUIV (PLUS n ZERO) n -plus_zero Zero = EQUIV -plus_zero (Succ n) = case plus_zero n of - EQUIV -> EQUIV - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT10.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT10.hs deleted file mode 100644 index 76efaf1fcc..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT10.hs +++ /dev/null @@ -1,44 +0,0 @@ -{-# LANGUAGE TypeFamilies, GADTs, RankNTypes #-} - -module GADT10 where - --- [Sept 2010] Now works in GHC 7.0! - --- This fails with --- --- GADT10.hs:37:0: --- All of the type variables in the constraint `x ~ --- y' are already in scope --- (at least one must be universally quantified here) --- In the type signature for `foo': --- foo :: EQUAL x y -> ((x ~ y) => t) -> t --- --- GADT10.hs:38:4: --- Couldn't match expected type `y' against inferred type `x' --- `y' is a rigid type variable bound by --- the type signature for `foo' at GADT10.hs:8:15 --- `x' is a rigid type variable bound by --- the type signature for `foo' at GADT10.hs:8:13 --- In the pattern: EQUAL --- In the definition of `foo': foo EQUAL t = t --- --- The first error can be fixed by using FlexibleContexts but I don't think that --- should be required here. In fact, if we remove RankNTypes, we get --- --- Illegal polymorphic or qualified type: forall (co_wild_B1 :: x ~ --- y). --- t --- In the type signature for `foo': --- foo :: EQUAL x y -> ((x ~ y) => t) -> t --- --- which seems to contradict (at least sort of) the first error message. - -data EQUAL x y where - EQUAL :: EQUAL x x - -foo :: EQUAL x y -> (x~y => t) -> t -foo EQUAL t = t - -bar :: EQUAL x y -> x -> y -bar equ x = foo equ x - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT11.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT11.hs deleted file mode 100644 index 70c5d75d84..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT11.hs +++ /dev/null @@ -1,20 +0,0 @@ -{-# LANGUAGE TypeFamilies, GADTs, RankNTypes, EmptyDataDecls #-} - -module ShouldCompile where - -data Z -data S a - -type family Sum n m -type instance Sum n Z = n -type instance Sum n (S m) = S (Sum n m) - -data Nat n where - NZ :: Nat Z - NS :: (S n ~ sn) => Nat n -> Nat sn - -data EQ a b = forall q . (a ~ b) => Refl - -zerol :: Nat n -> EQ n (Sum Z n) -zerol NZ = Refl --- zerol (NS n) = case zerol n of Refl -> Refl diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT12.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT12.hs deleted file mode 100644 index 4eb5124c1d..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT12.hs +++ /dev/null @@ -1,38 +0,0 @@ -{-# LANGUAGE TypeFamilies, GADTs, ScopedTypeVariables, KindSignatures #-} -{-# LANGUAGE EmptyDataDecls #-} - --- Tests whether a type signature can refine a type --- See the definition of bug2a - -module ShouldCompile where - -data Typed -data Untyped - -type family TU a b :: * -type instance TU Typed b = b -type instance TU Untyped b = () - --- A type witness type, use eg. for pattern-matching on types -data Type a where - TypeInt :: Type Int - TypeBool :: Type Bool - TypeString :: Type String - TypeList :: Type t -> Type [t] - -data Expr :: * -> * -> * {- tu a -} where - Const :: Type a -> a -> Expr tu (TU tu a) - Var2 :: String -> TU tu (Type a) -> Expr tu (TU tu a) - -bug1 :: Expr Typed Bool -> () -bug1 (Const TypeBool False) = () - -bug2a :: Expr Typed Bool -> () -bug2a (Var2 "x" (TypeBool :: Type Bool)) = () - -bug2c :: Expr Typed Bool -> () -bug2c (Var2 "x" TypeBool) = () - -bug2b :: Expr Typed (TU Typed Bool) -> () -bug2b (Var2 "x" TypeBool) = () - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT12.stderr b/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT12.stderr deleted file mode 100644 index e69de29bb2..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT12.stderr +++ /dev/null diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT13.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT13.hs deleted file mode 100644 index b5724b2500..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT13.hs +++ /dev/null @@ -1,8 +0,0 @@ -{-# LANGUAGE TypeFamilies, GADTs #-} - -module GADT13 where - -data family HiThere a :: * - -data instance HiThere () where - HiThere :: HiThere () diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT14.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT14.hs deleted file mode 100644 index ace1de45da..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT14.hs +++ /dev/null @@ -1,11 +0,0 @@ -{-# LANGUAGE TypeFamilies, TypeOperators, GADTs, RankNTypes, FlexibleContexts #-} -module Equality( (:=:), eq_elim, eq_refl ) where - -data a:=: b where - EQUAL :: a :=: a - -eq_refl :: a :=: a -eq_refl = EQUAL - -eq_elim :: (a~b) => a :=: b -> (a~b => p) -> p -eq_elim EQUAL p = p diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT2.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT2.hs deleted file mode 100644 index eb8354ba28..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT2.hs +++ /dev/null @@ -1,14 +0,0 @@ -{-# LANGUAGE TypeFamilies, GADTs #-} - --- Fails with --- --- Couldn't match expected type `y' against inferred type `x' - -module GADT2 where - -data EQUAL x y where - EQUAL :: x~y => EQUAL x y - -foo :: EQUAL x y -> x -> y -foo EQUAL x = x - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT3.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT3.hs deleted file mode 100644 index f630ad5d22..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT3.hs +++ /dev/null @@ -1,29 +0,0 @@ -{-# LANGUAGE TypeFamilies, GADTs, EmptyDataDecls #-} - --- Panics in bind_args - -module GADT3 where - -data EQUAL x y where - EQUAL :: x~y => EQUAL x y - -data ZERO -data SUCC n - -data Nat n where - Zero :: Nat ZERO - Succ :: Nat n -> Nat (SUCC n) - -type family PLUS m n -type instance PLUS ZERO n = n - -plus_zero :: Nat n -> EQUAL (PLUS ZERO n) n -plus_zero Zero = EQUAL -plus_zero (Succ n) = EQUAL - -data FOO n where - FOO_Zero :: FOO ZERO - -foo :: Nat m -> Nat n -> FOO n -> FOO (PLUS m n) -foo Zero n s = case plus_zero n of EQUAL -> s - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT4.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT4.hs deleted file mode 100644 index 07cf492843..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT4.hs +++ /dev/null @@ -1,13 +0,0 @@ -{-# LANGUAGE TypeFamilies, GADTs #-} - -module GADT4 where - -type family F a -type instance F () = () - -data T a where - T :: T () - -foo :: T () -> T (F ()) -> () -foo T T = () - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT5.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT5.hs deleted file mode 100644 index 69a6481fd0..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT5.hs +++ /dev/null @@ -1,14 +0,0 @@ -{-# LANGUAGE TypeFamilies, GADTs #-} - -module GADT5 where - -data T a where - T :: T (a,b) - -- this works: - -- T :: p ~ (a,b) => T p - -type family F a - -bar :: T (F a) -> () -bar T = () - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT6.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT6.hs deleted file mode 100644 index 0e976b441e..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT6.hs +++ /dev/null @@ -1,12 +0,0 @@ -{-# LANGUAGE TypeFamilies, GADTs #-} - -module GADT6 where - -data Pair p where - Pair :: p~(a,b) => a -> b -> Pair p - -- this works: - -- Pair :: a -> b -> Pair (a,b) - -foo :: Pair ((), ()) -> a -foo (Pair () ()) = undefined - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT7.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT7.hs deleted file mode 100644 index 00912605b4..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT7.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE TypeFamilies, GADTs #-} - -module GADT7 where - -data Pair p where - Pair :: p~(a,b) => a -> b -> Pair p - -- this works: --- Pair :: a -> b -> Pair (a,b) - -foo :: a -foo = case Pair () () of - -- this works: --- case Pair () () :: Pair ((), ()) of - Pair x y -> undefined - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT8.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT8.hs deleted file mode 100644 index 6d9381296e..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT8.hs +++ /dev/null @@ -1,12 +0,0 @@ -{-# LANGUAGE TypeFamilies, GADTs #-} - -module GADT8 where - -data Pair p where - Pair :: p~(a,b) => a -> b -> Pair p - -- this works: - -- Pair :: a -> b -> Pair (a,b) - -foo :: Pair ((), ()) -> Pair ((), ()) -foo (Pair x y) = Pair x y - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT9.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT9.hs deleted file mode 100644 index 7ced0f76d1..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/GADT9.hs +++ /dev/null @@ -1,16 +0,0 @@ -{-# LANGUAGE TypeFamilies, GADTs #-} - --- Fails with --- --- Couldn't match expected type `z' against inferred type `y' --- --- See also GADT2 - -module GADT2 where - -data EQUAL x y where - EQUAL :: x~y => EQUAL x y - -foo :: EQUAL x y -> EQUAL y z -> x -> z -foo EQUAL EQUAL x = x - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Gentle.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Gentle.hs deleted file mode 100644 index a32ac798a0..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Gentle.hs +++ /dev/null @@ -1,50 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, - FlexibleInstances, - OverlappingInstances, UndecidableInstances #-} - --- Rather exotic example posted to Haskell mailing list 17 Oct 07 --- It concerns context reduction and functional dependencies - -module FooModule where - -class Concrete a b | a -> b where - bar :: a -> String - -instance (Show a) => Concrete a b where - bar = error "urk" - -wib :: Concrete a b => a -> String -wib x = bar x - --- Uncommenting this solves the problem: --- instance Concrete Bool Bool - -{- This is a nice example of the trickiness of functional dependencies. -Here's what is happening. - -Consider type inference for 'wib'. GHC 6.6 figures out that the call -of 'bar' gives rise to the constraint (Concrete p q), where x has type -'p'. Ah, but x must have type 'a', so the constraint is (Concrete a -q). - -Now GHC tries to satisfy (Concrete a q) from (Concrete a b). If it -applied improvement right away it'd succeed, but sadly it first looks -at instances declarations. Success: we can get (Concrete a q) from -(Show a). So it uses the instance decl and now we can't get (Show a) -from (Concrete a b). - - -OK, found that in GHC 6.6, adding - instance Concrete Bool Bool -fixed the problem. That's weird isn't it? The reason is this. When GHC looks -at the instance decls, it now sees *two* instance decls matching -(Concrete a q), and so it declines for now to use either of them -(since it's not clear which would be the right one). Once it has -finished with instance decls it tries improvement. And, yes, it now -sees that q=b, so all is well. - -You might say that GHC should use improvement more vigorously, and -perhaps you'd be right. And indeed the upcoming GHC 6.8 does exactly -that. --} - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Gentle.stderr b/testsuite/tests/ghc-regress/indexed-types/should_compile/Gentle.stderr deleted file mode 100644 index e69de29bb2..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Gentle.stderr +++ /dev/null diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/GivenCheck.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/GivenCheck.hs deleted file mode 100644 index 20320ae1c9..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/GivenCheck.hs +++ /dev/null @@ -1,12 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module GivenCheck where - -type family S x - -f :: a -> S a -f = undefined - -g :: S a ~ Char => a -> Char -g y | False = f y - | otherwise = 'a' diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/GivenCheckDecomp.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/GivenCheckDecomp.hs deleted file mode 100644 index 3d2492770d..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/GivenCheckDecomp.hs +++ /dev/null @@ -1,11 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module GivenCheckDecomp where - -type family S x - -f :: a -> S a -f = undefined - -g :: [S a] ~ [Char] => a -> Char -g y | 'a' == 'b' = f y diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/GivenCheckSwap.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/GivenCheckSwap.hs deleted file mode 100644 index 8d053f312a..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/GivenCheckSwap.hs +++ /dev/null @@ -1,12 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module GivenCheckSwapMain where - -type family S x - -f :: a -> S a -f = undefined - -g :: Char ~ S a => a -> Char -g y | False = f y - | otherwise = 'a' diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/GivenCheckTop.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/GivenCheckTop.hs deleted file mode 100644 index bc81d1acc7..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/GivenCheckTop.hs +++ /dev/null @@ -1,13 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module GivenCheckTop where - -type family S x - -type instance S [e] = e - -f :: a -> S a -f = undefined - -g :: S [a] ~ Char => a -> Char -g y = y diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/HO.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/HO.hs deleted file mode 100644 index 40d597a76f..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/HO.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE TypeFamilies, TypeOperators, RankNTypes #-} - -module HO where - -import Data.IORef - -type family SMRef (m::(* -> *)) :: * -> * -type family SMMonad (r::(* -> *)) :: * -> * - -type instance SMRef IO = IORef -type instance SMMonad IORef = IO - - -class SMMonad (SMRef m) ~ m => SM m where - new :: forall a. a -> m (SMRef m a) - read :: forall a. (SMRef m a) -> m a - write :: forall a. (SMRef m a) -> a -> m () - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Imp.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Imp.hs deleted file mode 100644 index 6ae1812083..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Imp.hs +++ /dev/null @@ -1,11 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module Imp -where - -import Exp (C, T, S) - -instance C Int where - data T Int = TInt - -data instance S Int Bool = SIntBool diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Ind2_help.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Ind2_help.hs deleted file mode 100644 index b088302fec..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Ind2_help.hs +++ /dev/null @@ -1,14 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module Ind2_help where - -class C a where - data T a :: * - unT :: T a -> a - mkT :: a -> T a - -instance (C a, C b) => C (a,b) where - data T (a,b) = TProd (T a) (T b) - unT (TProd x y) = (unT x, unT y) - mkT (x,y) = TProd (mkT x) (mkT y) - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/IndTypesPerf.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/IndTypesPerf.hs deleted file mode 100644 index 4edcd03988..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/IndTypesPerf.hs +++ /dev/null @@ -1,11 +0,0 @@ - --- This used lots of memory, and took a long time to compile, with GHC 6.12: --- http://www.haskell.org/pipermail/glasgow-haskell-users/2010-May/018835.html - -module IndTypesPerf where - -import IndTypesPerfMerge - -data Rec1 = Rec1 !Int - -mkRec1 v = mk $ merge v () where mk (Tagged i :* ()) = Rec1 i diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/IndTypesPerfMerge.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/IndTypesPerfMerge.hs deleted file mode 100644 index 18ed35bdc1..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/IndTypesPerfMerge.hs +++ /dev/null @@ -1,120 +0,0 @@ -{-# LANGUAGE EmptyDataDecls, TypeFamilies, UndecidableInstances, - ScopedTypeVariables, OverlappingInstances, TypeOperators, - FlexibleInstances, NoMonomorphismRestriction, - MultiParamTypeClasses #-} -module IndTypesPerfMerge where - -data a :* b = a :* b -infixr 6 :* - -data TRUE -data FALSE -data Zero -data Succ a - -type family Equals m n -type instance Equals Zero Zero = TRUE -type instance Equals (Succ a) Zero = FALSE -type instance Equals Zero (Succ a) = FALSE -type instance Equals (Succ a) (Succ b) = Equals a b - -type family LessThan m n -type instance LessThan Zero Zero = FALSE -type instance LessThan (Succ n) Zero = FALSE -type instance LessThan Zero (Succ n) = TRUE -type instance LessThan (Succ m) (Succ n) = LessThan m n - -newtype Tagged n a = Tagged a deriving (Show,Eq) - -type family Cond p a b - -type instance Cond TRUE a b = a -type instance Cond FALSE a b = b - -class Merger a where - type Merged a - type UnmergedLeft a - type UnmergedRight a - mkMerge :: a -> UnmergedLeft a -> UnmergedRight a -> Merged a - -class Mergeable a b where - type MergerType a b - merger :: a -> b -> MergerType a b - -merge x y = mkMerge (merger x y) x y - -data TakeRight a -data TakeLeft a -data DiscardRightHead a b c d -data LeftHeadFirst a b c d -data RightHeadFirst a b c d -data EndMerge - -instance Mergeable () () where - type MergerType () () = EndMerge - merger = undefined - -instance Mergeable () (a :* b) where - type MergerType () (a :* b) = TakeRight (a :* b) - merger = undefined -instance Mergeable (a :* b) () where - type MergerType (a :* b) () = TakeLeft (a :* b) - merger = undefined - -instance Mergeable (Tagged m a :* t1) (Tagged n b :* t2) where - type MergerType (Tagged m a :* t1) (Tagged n b :* t2) = - Cond (Equals m n) (DiscardRightHead (Tagged m a) t1 (Tagged n b) t2) - (Cond (LessThan m n) (LeftHeadFirst (Tagged m a) t1 (Tagged n b) t2) - (RightHeadFirst (Tagged m a ) t1 (Tagged n b) t2)) - merger = undefined - -instance Merger EndMerge where - type Merged EndMerge = () - type UnmergedLeft EndMerge = () - type UnmergedRight EndMerge = () - mkMerge _ () () = () - -instance Merger (TakeRight a) where - type Merged (TakeRight a) = a - type UnmergedLeft (TakeRight a) = () - type UnmergedRight (TakeRight a) = a - mkMerge _ () a = a - -instance Merger (TakeLeft a) where - type Merged (TakeLeft a) = a - type UnmergedLeft (TakeLeft a) = a - type UnmergedRight (TakeLeft a) = () - mkMerge _ a () = a - -instance - (Mergeable t1 t2, - Merger (MergerType t1 t2), - t1 ~ UnmergedLeft (MergerType t1 t2), - t2 ~ UnmergedRight (MergerType t1 t2)) => - Merger (DiscardRightHead h1 t1 h2 t2) where - type Merged (DiscardRightHead h1 t1 h2 t2) = h1 :* Merged (MergerType t1 t2) - type UnmergedLeft (DiscardRightHead h1 t1 h2 t2) = h1 :* t1 - type UnmergedRight (DiscardRightHead h1 t1 h2 t2) = h2 :* t2 - mkMerge _ (h1 :* t1) (h2 :* t2) = h1 :* mkMerge (merger t1 t2) t1 t2 - -instance - (Mergeable t1 (h2 :* t2), - Merger (MergerType t1 (h2 :* t2)), - t1 ~ UnmergedLeft (MergerType t1 (h2 :* t2)), - (h2 :* t2) ~ UnmergedRight (MergerType t1 (h2 :* t2))) => - Merger (LeftHeadFirst h1 t1 h2 t2) where - type Merged (LeftHeadFirst h1 t1 h2 t2) = h1 :* Merged (MergerType t1 (h2 :* t2)) - type UnmergedLeft (LeftHeadFirst h1 t1 h2 t2) = h1 :* t1 - type UnmergedRight (LeftHeadFirst h1 t1 h2 t2) = h2 :* t2 - mkMerge _ (h1 :* t1) (h2 :* t2) = h1 :* mkMerge (merger t1 (h2 :* t2)) t1 (h2 :* t2) - -instance - (Mergeable (h1 :* t1) t2, - Merger (MergerType (h1 :* t1) t2), - (h1 :* t1) ~ UnmergedLeft (MergerType (h1 :* t1) t2), - t2 ~ UnmergedRight (MergerType (h1 :* t1) t2)) => - Merger (RightHeadFirst h1 t1 h2 t2) where - type Merged (RightHeadFirst h1 t1 h2 t2) = h2 :* Merged (MergerType (h1 :* t1) t2) - type UnmergedLeft (RightHeadFirst h1 t1 h2 t2) = h1 :* t1 - type UnmergedRight (RightHeadFirst h1 t1 h2 t2) = h2 :* t2 - mkMerge _ (h1 :* t1) (h2 :* t2) = h2 :* mkMerge (merger (h1 :* t1) t2) (h1 :* t1) t2
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Infix.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Infix.hs deleted file mode 100644 index dee389331b..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Infix.hs +++ /dev/null @@ -1,9 +0,0 @@ -{-# LANGUAGE TypeFamilies, TypeOperators #-} - --- Test infix type constructors in type families - -module Infix where - -type family x :+: y -type instance Int :+: Int = Int - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/InstContextNorm.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/InstContextNorm.hs deleted file mode 100644 index 329756aa9c..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/InstContextNorm.hs +++ /dev/null @@ -1,36 +0,0 @@ -{-# LANGUAGE TypeFamilies, FlexibleContexts #-} -{-# LANGUAGE EmptyDataDecls, FlexibleInstances #-} - -module InstContextNorm -where - -data EX _x _y (p :: * -> *) -data ANY - -class Base p - -class Base (Def p) => Prop p where - type Def p - -instance Base () -instance Prop () where - type Def () = () - -instance (Base (Def (p ANY))) => Base (EX _x _y p) -instance (Prop (p ANY)) => Prop (EX _x _y p) where - type Def (EX _x _y p) = EX _x _y p - - -data FOO x - -instance Prop (FOO x) where - type Def (FOO x) = () - -data BAR - -instance Prop BAR where - type Def BAR = EX () () FOO - - -- Needs Base (Def BAR) - -- And (Def Bar = Ex () () FOO) - -- so we need Base (Def (Foo ANY))
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/InstEqContext.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/InstEqContext.hs deleted file mode 100644 index e178e110a5..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/InstEqContext.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module InstEqContext where - - -{- encoding of - - class C a | -> a - -} -class a ~ Int => C a - -instance C Int - -unC :: (C a) => a -> Int -unC i = undefined - -test :: Int -test = unC undefined diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/InstEqContext2.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/InstEqContext2.hs deleted file mode 100644 index c5d017a644..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/InstEqContext2.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE TypeFamilies, EmptyDataDecls #-} - -module InstEqContext2 where - -data E v a = E a -data RValue - -instance (Eq a, v ~ RValue) => Eq (E v a) where - E x == E y = x == y - -a :: E v Int -a = undefined - -foo = a == a - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/InstEqContext3.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/InstEqContext3.hs deleted file mode 100644 index 3f307f8941..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/InstEqContext3.hs +++ /dev/null @@ -1,20 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module InstEqContext where - - -{- encoding of - - class C a | -> a - - with extra indirection - -} -class a ~ Int => D a -instance D Int - -class D a => C a -instance C Int - -unC :: (C a) => a -> Int -unC i = undefined - -test :: Int -test = unC undefined diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Kind.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Kind.hs deleted file mode 100644 index 73c528df11..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Kind.hs +++ /dev/null @@ -1,10 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module Kind where - -class C (a :: * -> *) where - type T a - -foo :: a x -> T a -foo = undefined - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Makefile b/testsuite/tests/ghc-regress/indexed-types/should_compile/Makefile deleted file mode 100644 index b91348f154..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -TOP=../../../.. -include $(TOP)/mk/boilerplate.mk -include $(TOP)/mk/test.mk - -NewTyCo: - $(RM) NewTyCo1.o NewTyCo1.hi NewTyCo2.o NewTyCo2.hi - '$(TEST_HC)' $(TEST_HC_OPTS) -c NewTyCo1.hs - '$(TEST_HC)' $(TEST_HC_OPTS) -c NewTyCo2.hs - -.PHONY: IndTypesPerf -IndTypesPerf: - $(RM) IndTypesPerf.o IndTypesPerf.hi - $(RM) IndTypesPerfMerge.o IndTypesPerfMerge.hi - '$(TEST_HC)' $(TEST_HC_OPTS) -O -c IndTypesPerfMerge.hs +RTS -M20M - '$(TEST_HC)' $(TEST_HC_OPTS) -O -c IndTypesPerf.hs +RTS -M20M diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/NewTyCo1.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/NewTyCo1.hs deleted file mode 100644 index 9af6d9ee92..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/NewTyCo1.hs +++ /dev/null @@ -1,9 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module NewTyCo1 where - -data family T a -newtype instance T Int = TInt Int - -foo :: T Int -> Int -foo (TInt n) = n diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/NewTyCo2.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/NewTyCo2.hs deleted file mode 100644 index 6ff2bc1ecd..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/NewTyCo2.hs +++ /dev/null @@ -1,7 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module NewTyCo2 where - -import NewTyCo1 - -bar x = foo x + 1 diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/NonLinearLHS.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/NonLinearLHS.hs deleted file mode 100644 index dc0ae5392a..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/NonLinearLHS.hs +++ /dev/null @@ -1,38 +0,0 @@ -{-# LANGUAGE TypeFamilies, EmptyDataDecls, FlexibleContexts #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE FlexibleInstances, OverlappingInstances, UndecidableInstances #-} - -module NonLinearLHS where - -type family E a b -type instance E a a = [a] - -foo :: E [Int] (E Int Int) -> Int -foo = sum . concat - -data family F a b -data instance F a a = MkF [a] - -goo :: F Int Int -> F Bool Bool -goo (MkF xs) = MkF $ map odd xs - - --- HList-like type equality - -data True; data False; - -type family EqTy a b -type instance EqTy a a = True - -class EqTyP a b result -instance (EqTy a b ~ isEq, Proxy isEq result) => EqTyP a b result - -class Proxy inp out -instance (result ~ True) => Proxy True result -instance (result ~ False) => Proxy notTrue result - -testTrue :: EqTyP Int Int r => r -testTrue = undefined - -testFalse :: EqTyP Int Bool r => r -testFalse = undefined
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Numerals.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Numerals.hs deleted file mode 100644 index 17fb30c3ca..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Numerals.hs +++ /dev/null @@ -1,29 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE TypeOperators #-} - -module Numerals -where - -data Z -- empty data type -data S a -- empty data type - -data SNat n where -- natural numbers as singleton type - Zero :: SNat Z - Succ :: SNat n -> SNat (S n) - -zero = Zero -one = Succ zero -two = Succ one -three = Succ two --- etc...we really would like some nicer syntax here - -type family (:+:) n m :: * -type instance Z :+: m = m -type instance (S n) :+: m = S (n :+: m) - -add :: SNat n -> SNat m -> SNat (n :+: m) -add Zero m = m -add (Succ n) m = Succ (add n m) - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/OversatDecomp.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/OversatDecomp.hs deleted file mode 100644 index a93256c92c..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/OversatDecomp.hs +++ /dev/null @@ -1,12 +0,0 @@ -{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-} - -module OversatDecomp where - -class Blah f a where - blah :: a -> T f f a - -class A f where - type T f :: (* -> *) -> * -> * - -wrapper :: Blah f a => a -> T f f a -wrapper x = blah x diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/PushedInAsGivens.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/PushedInAsGivens.hs deleted file mode 100644 index 0117b81d47..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/PushedInAsGivens.hs +++ /dev/null @@ -1,24 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, TypeFamilies #-}
-module PushedInAsGivens where
-
-
-type family F a
-
-
-
-bar y = let foo :: (F Int ~ [a]) => a -> Int
- foo x = length [x,y]
- in (y,foo y)
-
-
--- This example demonstrates why we need to push in
--- an unsolved wanted as a given and not a given/solved.
--- [Wanted] F Int ~ [beta]
---- forall a. F Int ~ [a] => a ~ beta
--- We we push in the [Wanted] as given, it will interact and solve the implication
--- constraint, and finally we quantify over F Int ~ [beta]. If we push it in as
--- Given/Solved, it will be discarded when we meet the given (F Int ~ [a]) and
--- we will not be able to solve the implication constraint.
-
-
-
diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Records.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Records.hs deleted file mode 100644 index 4a08125e30..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Records.hs +++ /dev/null @@ -1,41 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - --- See Trac #1204 - -module ShouldCompile where - -data FooC = FooC - -data family T c -data instance T FooC = MkT { moo :: Int } - -t1 :: Int -> T FooC -t1 i = MkT { moo = i } - -t2 :: T FooC -> Int -t2 (MkT { moo = i }) = i - -t3 :: T FooC -> Int -t3 m = moo m - -f :: T FooC -> T FooC -f r = r { moo = 3 } - - ------------------------------------------------------------------------------- -class D c where - data D1 c - works :: Int -> D1 c -> D1 c - buggy :: Int -> D1 c -> D1 c - buggy2 :: Int -> D1 c -> D1 c - -instance D FooC where - data D1 FooC = D1F { noo :: Int } - - works x d = d -- d unchanged, so OK - - buggy x d@(D1F { noo = k }) = - d { noo = k + x } - - buggy2 x d@(D1F { noo = k }) = - (d :: D1 FooC) { noo = k + x } diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Refl.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Refl.hs deleted file mode 100644 index 0b1b1f7a36..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Refl.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module Refl where - -type family T a :: * -> * - -foo :: a x -> a y -foo = undefined - -bar :: a -> T a x -> T a y -bar x t = foo t - -{- GHC complains that it could not deduce (T a x ~ T a x) where problem is -that with -dppr-debug, we get "x{tv a7z} [sk]" on the lhs and "x{tv a7C} -[box]" on the rhs - -} - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Refl2.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Refl2.hs deleted file mode 100644 index b6f5d056b5..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Refl2.hs +++ /dev/null @@ -1,19 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module Refl2 where - -type family T (a :: * -> *) :: * -> * - -data U a x = U (T a x) - -mkU :: a x -> U a x -mkU x = U undefined - --- The first definition says "Could not deduce (T a x ~ T a x)", the other two --- work fine - -foo :: a x -> U a x -foo x = case mkU x of U t -> id (U t) --- foo x = case mkU x of U t -> id ((U :: T a x -> U a x) t) --- foo x = case mkU x of U t -> U t - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/RelaxedExamples.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/RelaxedExamples.hs deleted file mode 100644 index a58fb3da67..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/RelaxedExamples.hs +++ /dev/null @@ -1,13 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module RelaxedExamples where - -type family F1 a -type family F2 a -type family F3 a -type family F4 a - -type instance F1 x = x -type instance F2 [Bool] = F2 Char -type instance F3 (a, b) = (F3 a, F3 b) -type instance F4 x = (x, x)
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Roman1.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Roman1.hs deleted file mode 100644 index 491fee04c5..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Roman1.hs +++ /dev/null @@ -1,41 +0,0 @@ -{-# LANGUAGE TypeFamilies, Rank2Types #-} - --- This test made the type checker produce an --- ill-kinded coercion term. - -module Roman where - -import Control.Monad.ST - -type family Mut (v :: * -> *) :: * -> * -> * -type family State (m :: * -> *) -type instance State (ST s) = s - -unsafeFreeze :: Mut v (State (ST s)) a -> ST s (v a) -unsafeFreeze = undefined - -new :: (forall v s. ST s (v s a)) -> v a -new p = runST (do - mv <- p - unsafeFreeze mv) - ---------------------------------------------- --- Here's a simpler version that also failed - -type family FMut :: * -> * -- No args - -- Same thing happens with one arg - -type family FState (m :: *) -type instance FState Char = Int - -funsafeFreeze :: FMut (FState Char) -> () -funsafeFreeze = undefined - -flop :: forall mv. mv Int -flop = undefined - -noo = flop `rapp` funsafeFreeze - -rapp :: a -> (a->()) -> () -rapp arg fun = fun arg - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Rules1.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Rules1.hs deleted file mode 100644 index 497c5bbeb9..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Rules1.hs +++ /dev/null @@ -1,23 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module Rules1 where - -class C a where - data T a - -instance (C a, C b) => C (a,b) where - data T (a,b) = TPair (T a) (T b) - -mapT :: (C a, C b) => (a -> b) -> T a -> T b -mapT = undefined - -zipT :: (C a, C b) => T a -> T b -> T (a,b) -zipT = undefined - -{-# RULES - -"zipT/mapT" forall f x y. - zipT (mapT f x) y = mapT (\(x,y) -> (f x, y)) (zipT x y) - - #-} - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple1.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple1.hs deleted file mode 100644 index e442042bb1..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple1.hs +++ /dev/null @@ -1,13 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module ShouldCompile where - -class C a where - data Sd a :: * - data Sn a :: * - type St a :: * - -instance C Int where - data Sd Int = SdC Char - newtype Sn Int = SnC Char - type St Int = Char diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple10.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple10.hs deleted file mode 100644 index 2e6aacf510..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple10.hs +++ /dev/null @@ -1,10 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module Simple10 where - -type family T a - -foo, bar :: T a -> a -foo = undefined -bar x = foo x - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple11.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple11.hs deleted file mode 100644 index 2d507a728e..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple11.hs +++ /dev/null @@ -1,16 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module Simple11 where - -type family F a - -same :: a -> a -> a -same = undefined - -mkf :: a -> F a -mkf p = undefined - --- Works with explicit signature --- foo :: a -> a -> (F a, a) -foo p q = same (mkf p, p) (mkf q, q) - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple12.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple12.hs deleted file mode 100644 index c425d78db5..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple12.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module Simple12 where - -type family F a - -same :: a -> a -> a -same = undefined - -mkf :: a -> F a -mkf p = undefined - --- works with either of these signatures --- foo :: a ~ F a => a -> a --- foo :: a ~ F a => a -> F a -foo p = same p (mkf p) - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple13.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple13.hs deleted file mode 100644 index 7633f01f98..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple13.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - --- This should fail, I think, because of the loopy equality, --- but the error message is hopeless - -module Simple13 where - -type family F a - -same :: a -> a -> a -same = undefined - -mkf :: a -> [F a] -mkf p = undefined - -foo :: a ~ [F a] => a -> a -foo p = same p (mkf p) - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple14.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple14.hs deleted file mode 100644 index 16158d9714..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple14.hs +++ /dev/null @@ -1,24 +0,0 @@ -{-# LANGUAGE TypeFamilies, RankNTypes, FlexibleContexts, ScopedTypeVariables #-} - -module Simple14 where - -data EQ_ x y = EQ_ - -eqE :: EQ_ x y -> (x~y => EQ_ z z) -> p -eqE = undefined - -eqI :: EQ_ x x -eqI = undefined - -ntI :: (forall p. EQ_ x y -> p) -> EQ_ x y -ntI = undefined - -foo :: forall m n. EQ_ (Maybe m) (Maybe n) -foo = ntI (`eqE` (eqI :: EQ_ m n)) --- Alternative --- foo = ntI (\eq -> eq `eqE` (eqI :: EQ_ m n)) - --- eq :: EQ_ (Maybe m) (Maybe n) --- Need (Maybe m ~ Maybe n) => EQ_ m n ~ EQ_ zeta zeta --- which redues to (m~n) => m ~ zeta --- but then we are stuck
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple14.stderr b/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple14.stderr deleted file mode 100644 index a5250d556f..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple14.stderr +++ /dev/null @@ -1,13 +0,0 @@ - -Simple14.hs:17:12: - Couldn't match type `z0' with `n' - `z0' is untouchable - inside the constraints (Maybe m ~ Maybe n) - bound at a type expected by the context: - Maybe m ~ Maybe n => EQ_ z0 z0 - `n' is a rigid type variable bound by - the type signature for foo :: EQ_ (Maybe m) (Maybe n) - at Simple14.hs:17:1 - In the second argument of `eqE', namely `(eqI :: EQ_ m n)' - In the first argument of `ntI', namely `(`eqE` (eqI :: EQ_ m n))' - In the expression: ntI (`eqE` (eqI :: EQ_ m n)) diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple15.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple15.hs deleted file mode 100644 index 8a28d27b6f..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple15.hs +++ /dev/null @@ -1,25 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module Simple15 where - -(<$) :: p -> (p -> q) -> q -x <$ f = f x - -type family Def p - -def :: Def p -> p -def = undefined - -data EQU a b = EQU - -equ_refl :: EQU a a -equ_refl = EQU - -data FOO = FOO -type instance Def FOO = EQU () () - -foo :: FOO -foo = equ_refl <$ def --- This works: --- foo = def $ equ_refl - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple16.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple16.hs deleted file mode 100644 index f1958c3ffd..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple16.hs +++ /dev/null @@ -1,13 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} --- submitted by g9ks157k@acme.softbase.org as #1713 -module TypeFamilyBug where - -type family TestFamily a :: * - -type instance TestFamily () = [()] - -testFunction :: value -> TestFamily value -> () -testFunction = const (const ()) - -testApplication :: () -testApplication = testFunction () (return ())
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple17.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple17.hs deleted file mode 100644 index 4e812be0fe..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple17.hs +++ /dev/null @@ -1,9 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} -module Simple17 where - -foo :: Int -> Int -foo n = bar n - where - bar :: t ~ Int => Int -> t - bar n = n - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple18.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple18.hs deleted file mode 100644 index c7d94c4984..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple18.hs +++ /dev/null @@ -1,10 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module Simple18 where - -type family F a - -type instance F Int = [Int] - -foo :: F Int -foo = [1]
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple19.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple19.hs deleted file mode 100644 index d738b0bd85..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple19.hs +++ /dev/null @@ -1,10 +0,0 @@ -{-# LANGUAGE TypeFamilies, LiberalTypeSynonyms #-} - -- ^ crucial for exercising the code paths to be - -- tested here - -module ShouldCompile where - -type family Element c :: * - -f :: Element x -f = undefined diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple2.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple2.hs deleted file mode 100644 index 2dc673f58b..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple2.hs +++ /dev/null @@ -1,41 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module ShouldCompile where - -class C3 a where - data S3 a -- kind is optional - data S3n a -- kind is optional - foo3 :: a -> S3 a - foo3n :: a -> S3n a - bar3 :: S3 a -> a - bar3n :: S3n a -> a - -instance C3 Int where - data S3 Int = D3Int - newtype S3n Int = D3Intn () - foo3 _ = D3Int - foo3n _ = D3Intn () - bar3 D3Int = 1 - bar3n (D3Intn _) = 1 - -instance C3 Char where - data S3 Char = D3Char - foo3 _ = D3Char - bar3 D3Char = 'c' - -bar3' :: S3 Char -> Char -bar3' D3Char = 'a' - -instance C3 Bool where - data S3 Bool = S3_1 | S3_2 - foo3 False = S3_1 - foo3 True = S3_2 - bar3 S3_1 = False - bar3 S3_2 = True - --- It's ok to omit ATs in instances, as it is ok to omit method definitions, --- but similar to methods, "undefined" is the only inhabitant of these types, --- then. -instance C3 Float where - foo3 1.0 = undefined - bar3 _ = 1.0 diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple2.stderr b/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple2.stderr deleted file mode 100644 index e2d5ce6973..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple2.stderr +++ /dev/null @@ -1,40 +0,0 @@ - -Simple2.hs:21:1: - Warning: No explicit AT declaration for `S3n' - In the instance declaration for `C3 Char' - -Simple2.hs:21:10: - Warning: No explicit method nor default method for `foo3n' - In the instance declaration for `C3 Char' - -Simple2.hs:21:10: - Warning: No explicit method nor default method for `bar3n' - In the instance declaration for `C3 Char' - -Simple2.hs:29:1: - Warning: No explicit AT declaration for `S3n' - In the instance declaration for `C3 Bool' - -Simple2.hs:29:10: - Warning: No explicit method nor default method for `foo3n' - In the instance declaration for `C3 Bool' - -Simple2.hs:29:10: - Warning: No explicit method nor default method for `bar3n' - In the instance declaration for `C3 Bool' - -Simple2.hs:39:1: - Warning: No explicit AT declaration for `S3' - In the instance declaration for `C3 Float' - -Simple2.hs:39:1: - Warning: No explicit AT declaration for `S3n' - In the instance declaration for `C3 Float' - -Simple2.hs:39:10: - Warning: No explicit method nor default method for `foo3n' - In the instance declaration for `C3 Float' - -Simple2.hs:39:10: - Warning: No explicit method nor default method for `bar3n' - In the instance declaration for `C3 Float' diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple20.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple20.hs deleted file mode 100644 index 81a8522804..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple20.hs +++ /dev/null @@ -1,9 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module ShouldCompile where - -type family F a -type instance F [a] = [F a] - -foo :: (F [a] ~ a) => a -foo = undefined diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple20.stderr b/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple20.stderr deleted file mode 100644 index 6c8feeb75b..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple20.stderr +++ /dev/null @@ -1,4 +0,0 @@ - -Simple20.hs:9:1: - Warning: Dropping loopy given equality `[F a] ~ a' - When generalising the type(s) for `foo' diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple21.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple21.hs deleted file mode 100644 index e858ae3ba9..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple21.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module ShouldCompile where - -import Prelude hiding (foldr, foldr1) - -import Data.Maybe - -type family Elem x - -class Foldable a where - foldr :: (Elem a -> b -> b) -> b -> a -> b - - foldr1 :: (Elem a -> Elem a -> Elem a) -> a -> Elem a - foldr1 f xs = fromMaybe (error "foldr1: empty structure") - (foldr mf Nothing xs) - where mf x Nothing = Just x - mf x (Just y) = Just (f x y) diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple22.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple22.hs deleted file mode 100644 index dd0a558c4f..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple22.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module ShouldCompile where - -data X1 = X1 - -class C t where - type D t - f :: t -> D t -> () - -instance C X1 where - type D X1 = Bool -> Bool - f _ h = () - -foo = f X1 (\x -> x) diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple23.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple23.hs deleted file mode 100644 index b7d5ee4ccb..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple23.hs +++ /dev/null @@ -1,6 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module ShouldCompile where - -plus :: (a ~ (Int -> Int)) => Int -> a -plus x y = x + y diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple24.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple24.hs deleted file mode 100644 index de33458bc7..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple24.hs +++ /dev/null @@ -1,13 +0,0 @@ -{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleContexts #-} - -module Simple24 where - -linear :: HasTrie (Basis v) => (Basis v, v) -linear = basisValue - -class HasTrie a where - -type family Basis u :: * - -basisValue :: (Basis v,v) -basisValue = error "urk" diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple3.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple3.hs deleted file mode 100644 index aa37ac215d..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple3.hs +++ /dev/null @@ -1,9 +0,0 @@ -{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleInstances #-} - -module ShouldCompile where - -class C7 a b where - data S7 b :: * - -instance C7 Char (a, Bool) where - data S7 (a, Bool) = S7_1 diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple4.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple4.hs deleted file mode 100644 index bd8ae3d66a..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple4.hs +++ /dev/null @@ -1,9 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module ShouldCompile where - -class C8 a where - data S8 a :: * -> * - -instance C8 Int where - data S8 Int a = S8Int a diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple5.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple5.hs deleted file mode 100644 index ecae60d53d..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple5.hs +++ /dev/null @@ -1,16 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module ShouldCompile where - -data family C9 a b :: * -data instance C9 Int Int = C9IntInt -data instance C9 [a] Int = C9ListInt -data instance C9 [Int] [a] = C9ListList2 - -type family D a -type instance D (Int, a) = (Int, a) -type instance D (a, Int) = (Int, Int) - -type family E a -type instance E (Char, b) = ([Char], b) -type instance E (a, Int) = (String, Int) diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple6.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple6.hs deleted file mode 100644 index ead121ab2d..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple6.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module ShouldCompile where - -import Data.IORef - -data family T a -data instance T a = T - -foo :: T Int -> T Char -foo T = T - -type family S a -type instance S a = a - -type family SMRef (m:: * -> *) :: * -> * -type instance SMRef IO = IORef
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple7.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple7.hs deleted file mode 100644 index 61ba22117f..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple7.hs +++ /dev/null @@ -1,10 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module ShouldCompile where - -class C1 a where - data S1 a :: * - --- instance of data families can be data or newtypes -instance C1 Char where - newtype S1 Char = S1Char () diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple8.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple8.hs deleted file mode 100644 index f819763579..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple8.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module Simple8 where - -type family F a - --- Manuel says that duplicate instances are ok. This gives a strange error but --- works if one of the duplicates is removed. - -type instance F () = () -type instance F () = () - -foo :: F () -> () -foo x = x - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple9.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple9.hs deleted file mode 100644 index 4075d4845f..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/Simple9.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module Simple9 where - --- The test succeeds with --- --- type family F a b --- type instance F () b = Maybe b - -type family F a :: * -> * -type instance F () = Maybe - -type family G a -type instance G (Maybe a) = Int - -foo :: G (F () a) -> Int -foo x = x - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T1769.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T1769.hs deleted file mode 100644 index 57b966051b..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T1769.hs +++ /dev/null @@ -1,12 +0,0 @@ -{-# LANGUAGE TypeFamilies, StandaloneDeriving, DeriveDataTypeable, FlexibleInstances #-}
-
-module T1769 where
-
-import Data.Typeable
-
-data family T a
-deriving instance Typeable1 T
--- deriving instance Functor T
-
-data instance T [b] = T1 | T2 b
-deriving instance Eq b => Eq (T [b])
diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T1981.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T1981.hs deleted file mode 100644 index 658821ea73..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T1981.hs +++ /dev/null @@ -1,8 +0,0 @@ -{-# OPTIONS_GHC -XTypeFamilies #-} - -module ShouldCompile where - -type family T a - -f :: T a -> Int -f x = x `seq` 3 diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T2102.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T2102.hs deleted file mode 100644 index 6283b18071..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T2102.hs +++ /dev/null @@ -1,19 +0,0 @@ -{-# LANGUAGE TypeFamilies, ScopedTypeVariables #-} - -module T2102 where - -type family Cat ts0 ts -type instance Cat () ts' = ts' -type instance Cat (s, ts) ts' = (s, Cat ts ts') - -class (Cat ts () ~ ts) => Valid ts -instance Valid () -- compiles OK -instance Valid ts => Valid (s, ts) -- fails to compile - --- need to prove Cat (s, ts) () ~ (s, Cat ts ()) --- for the superclass of class Valid. --- (1) From Valid ts: Cat ts () ~ ts --- (2) Therefore: (s, Cat ts ()) ~ (s, ts) - -coerce :: forall f ts. Valid ts => f (Cat ts ()) -> f ts -coerce x = x diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T2203b.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T2203b.hs deleted file mode 100644 index 74517aeadd..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T2203b.hs +++ /dev/null @@ -1,26 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables, TypeFamilies #-} - -module T2203b where - -class Foo a where - type TheFoo a - foo :: TheFoo a -> a - foo' :: a -> Int - -class Bar b where - bar :: b -> Int - -instance (b ~ TheFoo a, Foo a) => Bar (Either a b) where - bar (Left a) = foo' a - bar (Right b) = foo' (foo b :: a) - -instance Foo Int where - type TheFoo Int = Int - foo = id - foo' = id - -val :: Either Int Int -val = Left 5 - -res :: Int -res = bar val
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T2219.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T2219.hs deleted file mode 100644 index ea7d442f74..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T2219.hs +++ /dev/null @@ -1,28 +0,0 @@ -{-# LANGUAGE TypeFamilies, GADTs, EmptyDataDecls, TypeOperators #-} - -module Test where - -data Zero -data Succ a - -data FZ -data FS fn - -data Fin n fn where - FZ :: Fin (Succ n) FZ - FS :: Fin n fn -> Fin (Succ n) (FS fn) - -data Nil -data a ::: b - -type family Lookup ts fn :: * -type instance Lookup (t ::: ts) FZ = t -type instance Lookup (t ::: ts) (FS fn) = Lookup ts fn - -data Tuple n ts where - Nil :: Tuple Zero Nil - (:::) :: t -> Tuple n ts -> Tuple (Succ n) (t ::: ts) - -proj :: Fin n fn -> Tuple n ts -> Lookup ts fn -proj FZ (v ::: _) = v -proj (FS fn) (_ ::: vs) = proj fn vs diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T2238.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T2238.hs deleted file mode 100644 index 8e77283d77..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T2238.hs +++ /dev/null @@ -1,39 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE MultiParamTypeClasses #-} - --- Trac #2238 --- Notice that class CTF has just one value field, but --- it also has an equality predicate. --- See Note [Class newtypes and equality predicates] in BuildTyCl - -module Foo where - -data A -data B - --- via functional dependencies - -class HowFD a how | a -> how - -class HowFD a how => CFD a how where - cfd :: a -> String - cfd _ = "cfd" -instance HowFD a how => CFD a how - -instance HowFD Bool A - --- via type families - -type family HowTF a - -class how ~ HowTF a => CTF a how where - ctf :: a -> String - ctf _ = "ctf" - -instance how ~ HowTF a => CTF a how - -type instance HowTF Bool = A diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T2291.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T2291.hs deleted file mode 100644 index a6832b60ad..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T2291.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} -module Small where - -class CoCCC k where - type Coexp k :: * -> * -> * - type Sum k :: * -> * -> * - coapply :: k b (Sum k (Coexp k a b) a) - cocurry :: k c (Sum k a b) -> k (Coexp k b c) a - uncocurry :: k (Coexp k b c) a -> k c (Sum k a b) - -{-# RULES -"cocurry coapply" cocurry coapply = id -"cocurry . uncocurry" cocurry . uncocurry = id -"uncocurry . cocurry" uncocurry . cocurry = id - #-} diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T2448.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T2448.hs deleted file mode 100644 index 806df3ff4c..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T2448.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE TypeFamilies, UndecidableInstances #-} - -module T2448 where - --- Demonstrates a bug in propagating type equality constraints - -class VectorSpace v where - type Scalar v :: * - -class VectorSpace v => InnerSpace v - -instance (VectorSpace u,VectorSpace v, Scalar u ~ Scalar v) => - VectorSpace (u,v) - where - type Scalar (u,v) = Scalar u - -instance (InnerSpace u,InnerSpace v, Scalar u ~ Scalar v) => InnerSpace (u,v) diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T2627.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T2627.hs deleted file mode 100644 index 6a29d611e5..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T2627.hs +++ /dev/null @@ -1,22 +0,0 @@ -{-# LANGUAGE GADTs, TypeFamilies, EmptyDataDecls #-} - -module T2627 where - -data R a b -data W a b -data Z - -type family Dual a -type instance Dual Z = Z -type instance Dual (R a b) = W a (Dual b) -type instance Dual (W a b) = R a (Dual b) - -data Comm a where - Rd :: (a -> Comm b) -> Comm (R a b) - Wr :: a -> Comm b -> Comm (W a b) - Fin :: Int -> Comm Z - -conn :: (Dual a ~ b, Dual b ~ a) => Comm a -> Comm b -> (Int, Int) -conn (Fin x) (Fin y) = (x,y) -conn (Rd k) (Wr a r) = conn (k a) r -conn (Wr a r) (Rd k) = conn r (k a)
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T2639.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T2639.hs deleted file mode 100644 index 43e6c98a1d..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T2639.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE TypeFamilies, EmptyDataDecls #-} - -module T2639 where - -data Eps - -data family Work a v -data instance Work Eps v = Eps v - -type family Dual a -type instance Dual Eps = Eps - -class Connect s where - connect :: (Dual s ~ c, Dual c ~ s) => Work s a -> Work c b -> (a,b) - -instance Connect Eps where - connect (Eps a) (Eps b) = (a,b) diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T2715.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T2715.hs deleted file mode 100644 index 0fae15eaf8..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T2715.hs +++ /dev/null @@ -1,32 +0,0 @@ -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE FlexibleContexts #-} - -module T2715 where - -data Interval v where - Intv :: (Ord v, Enum v) => (v,v) -> Interval v - -type family Domain (d :: * -> *) :: * -> * -type instance Domain Interval = Interval - -type family Value (d :: * -> *) :: * - - -class IDomain d where - empty :: (Ord (Value d), Enum (Value d)) => (Domain d) (Value d) - -class (IDomain d1) -- (IDomain d1, IDomain d2, Value d1 ~ Value d2) - => IIDomain (d1 :: * -> *) (d2 :: * -> * ) where - equals :: Domain d1 (Value d1) -> Domain d2 (Value d2) -> Bool - - -instance Ord (Value Interval) - => IDomain Interval where - empty = Intv (toEnum 1, toEnum 0) - -instance Ord (Value Interval) - => IIDomain Interval Interval where - equals (Intv ix) (Intv iy) = ix == iy diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T2767.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T2767.hs deleted file mode 100644 index 7104db2fa3..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T2767.hs +++ /dev/null @@ -1,23 +0,0 @@ -{-# LANGUAGE TypeFamilies, NoMonomorphismRestriction #-} - -module T2767a where - -main = return () - --- eval' :: Solver solver => Tree solver a -> [(Label solver,Tree solver a)] -> solver [a] -eval' (NewVar f) wl = do v <- newvarSM - eval' (f v) wl -eval' Fail wl = continue wl - --- continue :: Solver solver => [(Label solver,Tree solver a)] -> solver [a] -continue ((past,t):wl) = do gotoSM past - eval' t wl -data Tree s a - = Fail - | NewVar (Term s -> Tree s a) - -class Monad solver => Solver solver where - type Term solver :: * - type Label solver :: * - newvarSM :: solver (Term solver) - gotoSM :: Label solver -> solver () diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T2850.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T2850.hs deleted file mode 100644 index bdb423b6eb..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T2850.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, FlexibleContexts, FlexibleInstances #-}
-
-module T2850 where
-
-class K a where
- bar :: a -> a
-
-class K (B a) => M a where
- data B a :: *
- foo :: B a -> B a
-
-instance M Bool where
- data B Bool = B1Bool Bool | B2Bool Bool
- foo = id
-
-instance K (B Bool) where
- bar = id
-
-instance M Int where
- newtype B Int = BInt (B Bool) deriving K
- foo = id
diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T2944.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T2944.hs deleted file mode 100644 index 19c009b0f9..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T2944.hs +++ /dev/null @@ -1,12 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} --- Test Trac #2944 - -module T2944 where - -type family T a :: * - -f1 :: T a ~ () => a -f1 = f2 - -f2 :: T a ~ () => a -f2 = f1 diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3017.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T3017.hs deleted file mode 100644 index 8e4e5bd999..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3017.hs +++ /dev/null @@ -1,20 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - --- Trac #3017 - -module Foo where - class Coll c where - type Elem c - empty :: c - insert :: Elem c -> c -> c - - data ListColl a = L [a] - instance Coll (ListColl a) where - type Elem (ListColl a) = a - empty = L [] - insert x (L xs) = L (x:xs) - - emptyL :: ListColl a - emptyL = empty - - test2 c = insert (0, 0) c diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3017.stderr b/testsuite/tests/ghc-regress/indexed-types/should_compile/T3017.stderr deleted file mode 100644 index 5afb822c32..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3017.stderr +++ /dev/null @@ -1,19 +0,0 @@ -TYPE SIGNATURES - emptyL :: forall a. ListColl a - test2 :: forall c t t1. - (Num t, Num t1, Coll c, Elem c ~ (t, t1)) => - c -> c -TYPE CONSTRUCTORS - data ListColl a - RecFlag NonRecursive - = L :: forall a. [a] -> ListColl a Stricts: _ - FamilyInstance: none -COERCION AXIOMS - axiom Foo.TFCo:R:ElemListColl [a] - :: Elem (ListColl a) ~ Foo.R:ElemListColl a -INSTANCES - instance Coll (ListColl a) -- Defined at T3017.hs:12:11-27 -FAMILY INSTANCES - type Elem (ListColl a) -- Defined at T3017.hs:13:9-12 -Dependent modules: [] -Dependent packages: [base, ghc-prim, integer-gmp] diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3023.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T3023.hs deleted file mode 100644 index 26966daed7..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3023.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances #-} -{-# OPTIONS_GHC -fwarn-missing-signatures #-} - -module Bug where - -class C a b | a -> b, b -> a where - f :: a -> b - -instance C Int Bool where - f = undefined -instance (C a c, C b d) => C (a -> b) (c -> d) where - f = undefined - -foo :: Int -> Int -foo = undefined - -bar = f foo diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3023.stderr b/testsuite/tests/ghc-regress/indexed-types/should_compile/T3023.stderr deleted file mode 100644 index 68066bac91..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3023.stderr +++ /dev/null @@ -1,4 +0,0 @@ - -T3023.hs:17:1: - Warning: Top-level binding with no type signature: - bar :: Bool -> Bool diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3208a.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T3208a.hs deleted file mode 100644 index fded5bf55d..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3208a.hs +++ /dev/null @@ -1,14 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module T3208a where - -class SUBST s where - type STerm s - -class OBJECT o where - type OTerm o - apply :: (SUBST s, OTerm o ~ STerm s) => s -> o - -fce' f = fce . apply $ f - -fce f = fce' f diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3208b.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T3208b.hs deleted file mode 100644 index 012756abd1..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3208b.hs +++ /dev/null @@ -1,22 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - --- This should fail - -module T3208b where - -class SUBST s where - type STerm s - -class OBJECT o where - type OTerm o - apply :: (SUBST s, OTerm o ~ STerm s) => s -> o - -fce' :: (OTerm a ~ STerm a, OBJECT a, SUBST a) => a -> c -fce' f = fce (apply f) --- f :: a --- apply f :: (OBJECT a, SUBST a, OTerm o ~ STerm a) => o --- fce called with a=o, gives wanted (OTerm o ~ STerm o, OBJECT o, SUBST o) - - -fce :: (OTerm a ~ STerm a, OBJECT a, SUBST a) => a -> c -fce f = fce' f diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3208b.stderr b/testsuite/tests/ghc-regress/indexed-types/should_compile/T3208b.stderr deleted file mode 100644 index 712f732b06..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3208b.stderr +++ /dev/null @@ -1,22 +0,0 @@ - -T3208b.hs:15:10: - Could not deduce (STerm a0 ~ STerm a) - from the context (OTerm a ~ STerm a, OBJECT a, SUBST a) - bound by the type signature for - fce' :: (OTerm a ~ STerm a, OBJECT a, SUBST a) => a -> c - at T3208b.hs:15:1-22 - NB: `STerm' is a type function, and may not be injective - Expected type: STerm a0 - Actual type: OTerm a0 - In the expression: fce (apply f) - In an equation for `fce'': fce' f = fce (apply f) - -T3208b.hs:15:15: - Could not deduce (OTerm a0 ~ STerm a) - from the context (OTerm a ~ STerm a, OBJECT a, SUBST a) - bound by the type signature for - fce' :: (OTerm a ~ STerm a, OBJECT a, SUBST a) => a -> c - at T3208b.hs:15:1-22 - In the first argument of `fce', namely `(apply f)' - In the expression: fce (apply f) - In an equation for `fce'': fce' f = fce (apply f) diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3220.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T3220.hs deleted file mode 100644 index 7d6190a7fa..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3220.hs +++ /dev/null @@ -1,23 +0,0 @@ -{-# LANGUAGE TypeFamilies, ScopedTypeVariables#-} - -module T3220 where - -class Foo m where - type Bar m :: * - action :: m -> Bar m -> m - -right x m = action m (Right x) - -right' :: (Either a b ~ Bar m, Foo m) => b -> m -> m -right' x m = action m (Right x) - -instance Foo Int where - type Bar Int = Either Int Int - action m a = either (*) (+) a m - -instance Foo Float where - type Bar Float = Either Float Float - action m a = either (*) (+) a m - -foo = print $ right (1::Int) (3 :: Int) -bar = print $ right (1::Float) (3 :: Float)
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3418.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T3418.hs deleted file mode 100644 index a0ffaf0aed..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3418.hs +++ /dev/null @@ -1,4 +0,0 @@ -{-# LANGUAGE TypeFamilies, DatatypeContexts #-} -module T3418 where - -newtype (a ~ b) => S a b = S { unS :: a } diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3418.stderr b/testsuite/tests/ghc-regress/indexed-types/should_compile/T3418.stderr deleted file mode 100644 index 657e2a07b7..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3418.stderr +++ /dev/null @@ -1,3 +0,0 @@ - -T3418.hs:1:28: - Warning: -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language. diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3423.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T3423.hs deleted file mode 100644 index bbca944374..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3423.hs +++ /dev/null @@ -1,12 +0,0 @@ -{-# LANGUAGE TypeFamilies, UndecidableInstances, StandaloneDeriving #-}
-{-# LANGUAGE FlexibleInstances #-}
-
-module T3423 where
-
-newtype Trie m k a = Trie (Maybe a, m (SubKey k) (Trie m k a))
-
-type family SubKey k
-type instance SubKey [k] = k
-
-deriving instance (Eq (m k (Trie m [k] a)), Eq a)
- => Eq (Trie m [k] a)
diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3460.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T3460.hs deleted file mode 100644 index ea4f59cd6b..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3460.hs +++ /dev/null @@ -1,14 +0,0 @@ -{-# LANGUAGE TypeFamilies, FlexibleContexts #-} -module T3460 where - -class Nat n where - toInt :: n -> Int - -class (Nat (Arity f)) => Model f where - type Arity f - -ok :: Model f => f -> Arity f -> Int -ok _ n = toInt n - -bug :: (Model f, Arity f ~ n) => f -> n -> Int -bug _ n = toInt n diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3484.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T3484.hs deleted file mode 100644 index 4d1570915e..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3484.hs +++ /dev/null @@ -1,42 +0,0 @@ -{-# LANGUAGE GADTs, RankNTypes, TypeFamilies, FlexibleContexts, ScopedTypeVariables #-} -{-# OPTIONS_GHC -Wall #-} -module Absurd where - -data Z = Z -newtype S n = S n -class Nat n where - caseNat :: (n ~ Z => r) -> (forall p. (n ~ S p, Nat p) => p -> r) -> n -> r -instance Nat Z where - caseNat = error "urk1" -instance Nat n => Nat (S n) where - caseNat = error "urk2" - --- empty type -newtype Naught = Naught (forall a. a) --- types are equal! -data TEq a b where - TEq :: (a ~ b) => TEq a b - -type family NatEqProves m n -type instance NatEqProves (S m) (S n) = TEq m n - -noConf :: (Nat m, Nat n) => m -> TEq m n -> NatEqProves m n -noConf = undefined -predEq :: TEq (S a) (S b) -> TEq a b -predEq = undefined - -data IsEq a b = Yes (TEq a b) | No (TEq a b -> Naught) - -natEqDec :: forall m n. (Nat m, Nat n) => m -> n -> IsEq m n -natEqDec m n = caseNat undefined mIsS m where - mIsS :: forall pm. (m ~ S pm, Nat pm) => pm -> IsEq m n - mIsS pm = caseNat undefined nIsS n where - nIsS :: forall pn. (n ~ S pn, Nat pn) => pn -> IsEq m n - nIsS pn = case natEqDec pm pn of - Yes TEq -> Yes TEq - No contr -> No (contr . noConf m) --- No contr -> No (contr . predEq) - --- strange things: --- (1) commenting out the "Yes" case or changing it to "undefined" makes compilation succeed --- (2) replacing the "No" line with with the commented out "No" line makes compilation succeed
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3590.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T3590.hs deleted file mode 100644 index 1b4ba426aa..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3590.hs +++ /dev/null @@ -1,22 +0,0 @@ -{-# LANGUAGE TypeFamilies, FlexibleContexts #-} - --- Trac #3590: a bug in typechecking of sections - -module T3590 where - -newtype ListT m a = - ListT { runListT :: m (Maybe (a, ListT m a)) } - -class Monad (ItemM l) => List l where - type ItemM l :: * -> * - joinL :: [ItemM l (l a) -> l a] - -instance Monad m => List (ListT m) where - type ItemM (ListT m) = m - joinL = [ ListT . (>>= runListT) -- Right section - , ListT . (runListT <<=) -- Left section - ] - -(<<=) :: Monad m => (a -> m b) -> m a -> m b -(<<=) k m = m >>= k - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3787.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T3787.hs deleted file mode 100644 index 955b6a1cdd..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3787.hs +++ /dev/null @@ -1,475 +0,0 @@ -{- - Copyright 2009 Mario Blazevic - - This file is part of the Streaming Component Combinators (SCC) project. - - The SCC project is free software: you can redistribute it and/or modify it under the terms of the GNU General Public - License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later - version. - - SCC is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty - of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. - - You should have received a copy of the GNU General Public License along with SCC. If not, see - <http://www.gnu.org/licenses/>. --} - --- | Module "Trampoline" defines the trampoline computations and their basic building blocks. - -{-# LANGUAGE ScopedTypeVariables, Rank2Types, MultiParamTypeClasses, TypeFamilies, KindSignatures, - FlexibleContexts, FlexibleInstances, OverlappingInstances, UndecidableInstances - #-} - -module T3787 where - -import Control.Concurrent (forkIO) -import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar) -import Control.Monad (liftM, liftM2, when) -import Control.Monad.Identity -import Control.Monad.Trans (MonadTrans(..)) - -import Data.Foldable (toList) -import Data.Maybe (maybe) -import Data.Sequence (Seq, viewl) - -par, pseq :: a -> b -> b -par = error "urk" -pseq = error "urk" - --- | Class of monads that can perform two computations in parallel. -class Monad m => ParallelizableMonad m where - -- | Combine two computations into a single parallel computation. Default implementation of `parallelize` is - -- @liftM2 (,)@ - parallelize :: m a -> m b -> m (a, b) - parallelize = liftM2 (,) - --- | Any monad that allows the result value to be extracted, such as `Identity` or `Maybe` monad, can implement --- `parallelize` by using `par`. -instance ParallelizableMonad Identity where - parallelize ma mb = let a = runIdentity ma - b = runIdentity mb - in a `par` (b `pseq` a `pseq` Identity (a, b)) - -instance ParallelizableMonad Maybe where - parallelize ma mb = case ma `par` (mb `pseq` (ma, mb)) - of (Just a, Just b) -> Just (a, b) - _ -> Nothing - --- | IO is parallelizable by `forkIO`. -instance ParallelizableMonad IO where - parallelize ma mb = do va <- newEmptyMVar - vb <- newEmptyMVar - forkIO (ma >>= putMVar va) - forkIO (mb >>= putMVar vb) - a <- takeMVar va - b <- takeMVar vb - return (a, b) - --- | Suspending monadic computations. -newtype Trampoline s m r = Trampoline { - -- | Run the next step of a `Trampoline` computation. - bounce :: m (TrampolineState s m r) - } - -data TrampolineState s m r = - -- | Trampoline computation is finished with final value /r/. - Done r - -- | Computation is suspended, its remainder is embedded in the functor /s/. - | Suspend! (s (Trampoline s m r)) - -instance (Functor s, Monad m) => Monad (Trampoline s m) where - return x = Trampoline (return (Done x)) - t >>= f = Trampoline (bounce t >>= apply f) - where apply f (Done x) = bounce (f x) - apply f (Suspend s) = return (Suspend (fmap (>>= f) s)) - -instance (Functor s, ParallelizableMonad m) => ParallelizableMonad (Trampoline s m) where - parallelize t1 t2 = Trampoline $ liftM combine $ parallelize (bounce t1) (bounce t2) where - combine (Done x, Done y) = Done (x, y) - combine (Suspend s, Done y) = Suspend (fmap (liftM $ \x-> (x, y)) s) - combine (Done x, Suspend s) = Suspend (fmap (liftM $ (,) x) s) - combine (Suspend s1, Suspend s2) = Suspend (fmap (parallelize $ suspend s1) s2) - -instance Functor s => MonadTrans (Trampoline s) where - lift = Trampoline . liftM Done - -data Yield x y = Yield! x y -instance Functor (Yield x) where - fmap f (Yield x y) = Yield x (f y) - -data Await x y = Await! (x -> y) -instance Functor (Await x) where - fmap f (Await g) = Await (f . g) - -data EitherFunctor l r x = LeftF (l x) | RightF (r x) -instance (Functor l, Functor r) => Functor (EitherFunctor l r) where - fmap f (LeftF l) = LeftF (fmap f l) - fmap f (RightF r) = RightF (fmap f r) - -newtype NestedFunctor l r x = NestedFunctor (l (r x)) -instance (Functor l, Functor r) => Functor (NestedFunctor l r) where - fmap f (NestedFunctor lr) = NestedFunctor ((fmap . fmap) f lr) - -data SomeFunctor l r x = LeftSome (l x) | RightSome (r x) | Both (NestedFunctor l r x) -instance (Functor l, Functor r) => Functor (SomeFunctor l r) where - fmap f (LeftSome l) = LeftSome (fmap f l) - fmap f (RightSome r) = RightSome (fmap f r) - fmap f (Both lr) = Both (fmap f lr) - -type TryYield x = EitherFunctor (Yield x) (Await Bool) - -suspend :: (Monad m, Functor s) => s (Trampoline s m x) -> Trampoline s m x -suspend s = Trampoline (return (Suspend s)) - -yield :: forall m x. Monad m => x -> Trampoline (Yield x) m () -yield x = suspend (Yield x (return ())) - -await :: forall m x. Monad m => Trampoline (Await x) m x -await = suspend (Await return) - -tryYield :: forall m x. Monad m => x -> Trampoline (TryYield x) m Bool -tryYield x = suspend (LeftF (Yield x (suspend (RightF (Await return))))) - -canYield :: forall m x. Monad m => Trampoline (TryYield x) m Bool -canYield = suspend (RightF (Await return)) - -fromTrampoline :: Monad m => Trampoline s m x -> m x -fromTrampoline t = bounce t >>= \(Done x)-> return x - -runTrampoline :: Monad m => Trampoline Identity m x -> m x -runTrampoline = fromTrampoline - -pogoStick :: (Functor s, Monad m) => (s (Trampoline s m x) -> Trampoline s m x) -> Trampoline s m x -> m x -pogoStick reveal t = bounce t - >>= \s-> case s - of Done result -> return result - Suspend c -> pogoStick reveal (reveal c) - -pogoStickNested :: (Functor s1, Functor s2, Monad m) => - (s2 (Trampoline (EitherFunctor s1 s2) m x) -> Trampoline (EitherFunctor s1 s2) m x) - -> Trampoline (EitherFunctor s1 s2) m x -> Trampoline s1 m x -pogoStickNested reveal t = - Trampoline{bounce= bounce t - >>= \s-> case s - of Done result -> return (Done result) - Suspend (LeftF s) -> return (Suspend (fmap (pogoStickNested reveal) s)) - Suspend (RightF c) -> bounce (pogoStickNested reveal (reveal c)) - } - -nest :: (Functor a, Functor b) => a x -> b y -> NestedFunctor a b (x, y) -nest a b = NestedFunctor $ fmap (\x-> fmap ((,) x) b) a - --- couple :: (Monad m, Functor s1, Functor s2) => --- Trampoline s1 m x -> Trampoline s2 m y -> Trampoline (NestedFunctor s1 s2) m (x, y) --- couple t1 t2 = Trampoline{bounce= do ts1 <- bounce t1 --- ts2 <- bounce t2 --- case (ts1, ts2) of (Done x, Done y) -> return $ Done (x, y) --- (Suspend s1, Suspend s2) -> return $ Suspend $ --- fmap (uncurry couple) (nest s1 s2) --- } - -coupleAlternating :: (Monad m, Functor s1, Functor s2) => - Trampoline s1 m x -> Trampoline s2 m y -> Trampoline (SomeFunctor s1 s2) m (x, y) -coupleAlternating t1 t2 = - Trampoline{bounce= do ts1 <- bounce t1 - ts2 <- bounce t2 - case (ts1, ts2) of (Done x, Done y) -> return $ Done (x, y) - (Suspend s1, Suspend s2) -> - return $ Suspend $ fmap (uncurry coupleAlternating) (Both $ nest s1 s2) - (Done x, Suspend s2) -> - return $ Suspend $ fmap (coupleAlternating (return x)) (RightSome s2) - (Suspend s1, Done y) -> - return $ Suspend $ fmap (flip coupleAlternating (return y)) (LeftSome s1) - } - -coupleParallel :: (ParallelizableMonad m, Functor s1, Functor s2) => - Trampoline s1 m x -> Trampoline s2 m y -> Trampoline (SomeFunctor s1 s2) m (x, y) -coupleParallel t1 t2 = - Trampoline{bounce= parallelize (bounce t1) (bounce t2) - >>= \pair-> case pair - of (Done x, Done y) -> return $ Done (x, y) - (Suspend s1, Suspend s2) -> - return $ Suspend $ fmap (uncurry coupleParallel) (Both $ nest s1 s2) - (Done x, Suspend s2) -> - return $ Suspend $ fmap (coupleParallel (return x)) (RightSome s2) - (Suspend s1, Done y) -> - return $ Suspend $ fmap (flip coupleParallel (return y)) (LeftSome s1) - } - -coupleNested :: (Monad m, Functor s0, Functor s1, Functor s2) => - Trampoline (EitherFunctor s0 s1) m x -> Trampoline (EitherFunctor s0 s2) m y -> - Trampoline (EitherFunctor s0 (SomeFunctor s1 s2)) m (x, y) -coupleNested t1 t2 = - Trampoline{bounce= do ts1 <- bounce t1 - ts2 <- bounce t2 - case (ts1, ts2) of (Done x, Done y) -> return $ Done (x, y) - (Suspend (RightF s), Done y) -> - return $ Suspend $ RightF $ fmap (flip coupleNested (return y)) (LeftSome s) - (Done x, Suspend (RightF s)) -> - return $ Suspend $ RightF $ fmap (coupleNested (return x)) (RightSome s) - (Suspend (RightF s1), Suspend (RightF s2)) -> - return $ Suspend $ RightF $ fmap (uncurry coupleNested) (Both $ nest s1 s2) - (Suspend (LeftF s), Done y) -> - return $ Suspend $ LeftF $ fmap (flip coupleNested (return y)) s - (Done x, Suspend (LeftF s)) -> - return $ Suspend $ LeftF $ fmap (coupleNested (return x)) s - (Suspend (LeftF s1), Suspend (LeftF s2)) -> - return $ Suspend $ LeftF $ fmap (coupleNested $ suspend $ LeftF s1) s2 - } - -seesaw :: (Monad m, Functor s1, Functor s2) => - (forall x y s t. (s ~ SomeFunctor s1 s2, t ~ Trampoline s m (x, y)) => s t -> t) - -> Trampoline s1 m x -> Trampoline s2 m y -> m (x, y) -seesaw resolve t1 t2 = pogoStick resolve (coupleAlternating t1 t2) - -seesawParallel :: (ParallelizableMonad m, Functor s1, Functor s2) => - (forall x y s t. (s ~ SomeFunctor s1 s2, t ~ Trampoline s m (x, y)) => s t -> t) - -> Trampoline s1 m x -> Trampoline s2 m y -> m (x, y) -seesawParallel resolve t1 t2 = pogoStick resolve (coupleParallel t1 t2) - -resolveProducerConsumer :: forall a s s0 t t' m x. - (Functor s0, Monad m, s ~ SomeFunctor (TryYield a) (Await (Maybe a)), - t ~ Trampoline (EitherFunctor s0 s) m x) => - s t -> t --- Arg :: s t --- (LeftSome (LeftF ...)) : SomeFunctor (EitherFunctor .. ..) (...) t -resolveProducerConsumer (LeftSome (LeftF (Yield _ c))) = c -resolveProducerConsumer (LeftSome (RightF (Await c))) = c False -resolveProducerConsumer (RightSome (Await c)) = c Nothing -resolveProducerConsumer (Both (NestedFunctor (LeftF (Yield x (Await c))))) = c (Just x) -resolveProducerConsumer (Both (NestedFunctor (RightF (Await c)))) = suspend (RightF $ RightSome $ c True) - -couplePC :: ParallelizableMonad m => Trampoline (Yield a) m x -> Trampoline (Await (Maybe a)) m y -> m (x, y) -couplePC t1 t2 = parallelize (bounce t1) (bounce t2) - >>= \(s1, s2)-> case (s1, s2) - of (Done x, Done y) -> return (x, y) - (Suspend (Yield x c1), Suspend (Await c2)) -> couplePC c1 (c2 $ Just x) - (Suspend (Yield _ c1), Done y) -> couplePC c1 (return y) - (Done x, Suspend (Await c2)) -> couplePC (return x) (c2 Nothing) - -coupleFinite :: ParallelizableMonad m => Trampoline (TryYield a) m x -> Trampoline (Await (Maybe a)) m y -> m (x, y) -coupleFinite t1 t2 = - parallelize (bounce t1) (bounce t2) - >>= \(s1, s2)-> case (s1, s2) - of (Done x, Done y) -> return (x, y) - (Done x, Suspend (Await c2)) -> coupleFinite (return x) (c2 Nothing) - (Suspend (LeftF (Yield x c1)), Suspend (Await c2)) -> coupleFinite c1 (c2 $ Just x) - (Suspend (LeftF (Yield _ c1)), Done y) -> coupleFinite c1 (return y) - (Suspend (RightF (Await c1)), Suspend s2@Await{}) -> coupleFinite (c1 True) (suspend s2) - (Suspend (RightF (Await c1)), Done y) -> coupleFinite (c1 False) (return y) - -coupleFiniteSequential :: Monad m => Trampoline (TryYield a) m x -> Trampoline (Await (Maybe a)) m y -> m (x, y) -coupleFiniteSequential t1 t2 = - bounce t1 - >>= \s1-> bounce t2 - >>= \s2-> case (s1, s2) - of (Done x, Done y) -> return (x, y) - (Done x, Suspend (Await c2)) -> coupleFiniteSequential (return x) (c2 Nothing) - (Suspend (LeftF (Yield x c1)), Suspend (Await c2)) -> coupleFiniteSequential c1 (c2 $ Just x) - (Suspend (LeftF (Yield _ c1)), Done y) -> coupleFiniteSequential c1 (return y) - (Suspend (RightF (Await c1)), Suspend s2@Await{}) -> coupleFiniteSequential (c1 True) (suspend s2) - (Suspend (RightF (Await c1)), Done y) -> coupleFiniteSequential (c1 False) (return y) - --- coupleNested :: (Functor s, Monad m) => --- Trampoline (EitherFunctor s (Yield a)) m x --- -> Trampoline (EitherFunctor s (Await (Maybe a))) m y -> Trampoline s m (x, y) - --- coupleNested t1 t2 = --- lift (liftM2 (,) (bounce t1) (bounce t2)) --- >>= \(s1, s2)-> case (s1, s2) --- of (Done x, Done y) -> return (x, y) --- (Suspend (RightF (Yield _ c1)), Done y) -> coupleNested c1 (return y) --- (Done x, Suspend (RightF (Await c2))) -> coupleNested (return x) (c2 Nothing) --- (Suspend (RightF (Yield x c1)), Suspend (RightF (Await c2))) -> coupleNested c1 (c2 $ Just x) --- (Suspend (LeftF s), Done y) -> suspend (fmap (flip coupleNested (return y)) s) --- (Done x, Suspend (LeftF s)) -> suspend (fmap (coupleNested (return x)) s) --- (Suspend (LeftF s1), Suspend (LeftF s2)) -> suspend (fmap (coupleNested $ suspend $ LeftF s1) s2) - -coupleNestedFinite :: (Functor s, ParallelizableMonad m) => - Trampoline (SinkFunctor s a) m x -> Trampoline (SourceFunctor s a) m y -> Trampoline s m (x, y) -coupleNestedFinite t1 t2 = lift (parallelize (bounce t1) (bounce t2)) - >>= stepCouple coupleNestedFinite - -coupleNestedFiniteSequential :: (Functor s, Monad m) => - Trampoline (SinkFunctor s a) m x - -> Trampoline (SourceFunctor s a) m y - -> Trampoline s m (x, y) -coupleNestedFiniteSequential producer consumer = - pogoStickNested resolveProducerConsumer (coupleNested producer consumer) --- coupleNestedFiniteSequential t1 t2 = lift (liftM2 (,) (bounce t1) (bounce t2)) --- >>= stepCouple coupleNestedFiniteSequential - -stepCouple :: (Functor s, Monad m) => - (Trampoline (EitherFunctor s (TryYield a)) m x - -> Trampoline (EitherFunctor s (Await (Maybe a))) m y - -> Trampoline s m (x, y)) - -> (TrampolineState (EitherFunctor s (TryYield a)) m x, - TrampolineState (EitherFunctor s (Await (Maybe a))) m y) - -> Trampoline s m (x, y) -stepCouple f couple = case couple - of (Done x, Done y) -> return (x, y) - (Done x, Suspend (RightF (Await c2))) -> f (return x) (c2 Nothing) - (Suspend (RightF (LeftF (Yield _ c1))), Done y) -> f c1 (return y) - (Suspend (RightF (LeftF (Yield x c1))), Suspend (RightF (Await c2))) -> f c1 (c2 $ Just x) - (Suspend (RightF (RightF (Await c1))), Suspend s2@(RightF Await{})) -> f (c1 True) (suspend s2) - (Suspend (RightF (RightF (Await c1))), Done y) -> f (c1 False) (return y) - (Suspend (LeftF s), Done y) -> suspend (fmap (flip f (return y)) s) - (Done x, Suspend (LeftF s)) -> suspend (fmap (f (return x)) s) - (Suspend (LeftF s1), Suspend (LeftF s2)) -> suspend (fmap (f $ suspend $ LeftF s1) s2) - (Suspend (LeftF s1), Suspend (RightF s2)) -> suspend (fmap (flip f (suspend $ RightF s2)) s1) - (Suspend (RightF s1), Suspend (LeftF s2)) -> suspend (fmap (f (suspend $ RightF s1)) s2) - -local :: forall m l r x. (Functor r, Monad m) => Trampoline r m x -> Trampoline (EitherFunctor l r) m x -local (Trampoline mr) = Trampoline (liftM inject mr) - where inject :: TrampolineState r m x -> TrampolineState (EitherFunctor l r) m x - inject (Done x) = Done x - inject (Suspend r) = Suspend (RightF $ fmap local r) - -out :: forall m l r x. (Functor l, Monad m) => Trampoline l m x -> Trampoline (EitherFunctor l r) m x -out (Trampoline ml) = Trampoline (liftM inject ml) - where inject :: TrampolineState l m x -> TrampolineState (EitherFunctor l r) m x - inject (Done x) = Done x - inject (Suspend l) = Suspend (LeftF $ fmap out l) - --- | Class of functors that can be lifted. -class (Functor a, Functor d) => AncestorFunctor a d where - -- | Convert the ancestor functor into its descendant. The descendant functor typically contains the ancestor. - liftFunctor :: a x -> d x - -instance Functor a => AncestorFunctor a a where - liftFunctor = id -instance (Functor a, Functor d', Functor d, d ~ EitherFunctor d' s, AncestorFunctor a d') => AncestorFunctor a d where - liftFunctor = LeftF . (liftFunctor :: a x -> d' x) - -liftOut :: forall m a d x. (Monad m, Functor a, AncestorFunctor a d) => Trampoline a m x -> Trampoline d m x -liftOut (Trampoline ma) = Trampoline (liftM inject ma) - where inject :: TrampolineState a m x -> TrampolineState d m x - inject (Done x) = Done x - inject (Suspend a) = Suspend (liftFunctor $ fmap liftOut a) - -type SourceFunctor a x = EitherFunctor a (Await (Maybe x)) -type SinkFunctor a x = EitherFunctor a (TryYield x) - --- | A 'Sink' can be used to yield values from any nested `Trampoline` computation whose functor provably descends from --- the functor /a/. It's the write-only end of a 'Pipe' communication channel. -data Sink (m :: * -> *) a x = - Sink - { - -- | Function 'put' tries to put a value into the given `Sink`. The intervening 'Trampoline' computations suspend up - -- to the 'pipe' invocation that has created the argument sink. The result of 'put' indicates whether the operation - -- succeded. - put :: forall d. (AncestorFunctor a d) => x -> Trampoline d m Bool, - -- | Function 'canPut' checks if the argument `Sink` accepts values, i.e., whether a 'put' operation would succeed on - -- the sink. - canPut :: forall d. (AncestorFunctor a d) => Trampoline d m Bool - } - --- | A 'Source' can be used to read values into any nested `Trampoline` computation whose functor provably descends from --- the functor /a/. It's the read-only end of a 'Pipe' communication channel. -newtype Source (m :: * -> *) a x = - Source - { - -- | Function 'get' tries to get a value from the given 'Source' argument. The intervening 'Trampoline' computations - -- suspend all the way to the 'pipe' function invocation that created the source. The function returns 'Nothing' if - -- the argument source is empty. - get :: forall d. (AncestorFunctor a d) => Trampoline d m (Maybe x) - } - --- | Converts a 'Sink' on the ancestor functor /a/ into a sink on the descendant functor /d/. -liftSink :: forall m a d x. (Monad m, AncestorFunctor a d) => Sink m a x -> Sink m d x -liftSink s = Sink {put= liftOut . (put s :: x -> Trampoline d m Bool), - canPut= liftOut (canPut s :: Trampoline d m Bool)} - --- | Converts a 'Source' on the ancestor functor /a/ into a source on the descendant functor /d/. -liftSource :: forall m a d x. (Monad m, AncestorFunctor a d) => Source m a x -> Source m d x -liftSource s = Source {get= liftOut (get s :: Trampoline d m (Maybe x))} - --- | The 'pipe' function splits the computation into two concurrent parts, /producer/ and /consumer/. The /producer/ is --- given a 'Sink' to put values into, and /consumer/ a 'Source' to get those values from. Once producer and consumer --- both complete, 'pipe' returns their paired results. -pipe :: forall m a a1 a2 x r1 r2. (Monad m, Functor a, a1 ~ SinkFunctor a x, a2 ~ SourceFunctor a x) => - (Sink m a1 x -> Trampoline a1 m r1) -> (Source m a2 x -> Trampoline a2 m r2) -> Trampoline a m (r1, r2) -pipe producer consumer = coupleNestedFiniteSequential (producer sink) (consumer source) where - sink = Sink {put= liftOut . (local . tryYield :: x -> Trampoline a1 m Bool), - canPut= liftOut (local canYield :: Trampoline a1 m Bool)} :: Sink m a1 x - source = Source (liftOut (local await :: Trampoline a2 m (Maybe x))) :: Source m a2 x - --- | The 'pipeP' function is equivalent to 'pipe', except the /producer/ and /consumer/ are run in parallel. -pipeP :: forall m a a1 a2 x r1 r2. (ParallelizableMonad m, Functor a, a1 ~ SinkFunctor a x, a2 ~ SourceFunctor a x) => - (Sink m a1 x -> Trampoline a1 m r1) -> (Source m a2 x -> Trampoline a2 m r2) -> Trampoline a m (r1, r2) -pipeP producer consumer = coupleNestedFinite (producer sink) (consumer source) where - sink = Sink {put= liftOut . (local . tryYield :: x -> Trampoline a1 m Bool), - canPut= liftOut (local canYield :: Trampoline a1 m Bool)} :: Sink m a1 x - source = Source (liftOut (local await :: Trampoline a2 m (Maybe x))) :: Source m a2 x - --- | The 'pipePS' function acts either as 'pipeP' or as 'pipe', depending on the argument /parallel/. -pipePS :: forall m a a1 a2 x r1 r2. (ParallelizableMonad m, Functor a, a1 ~ SinkFunctor a x, a2 ~ SourceFunctor a x) => - Bool -> (Sink m a1 x -> Trampoline a1 m r1) -> (Source m a2 x -> Trampoline a2 m r2) -> - Trampoline a m (r1, r2) -pipePS parallel = if parallel then pipeP else pipe - -getSuccess :: forall m a d x . (Monad m, AncestorFunctor a d) - => Source m a x -> (x -> Trampoline d m ()) {- ^ Success continuation -} -> Trampoline d m () -getSuccess source succeed = get source >>= maybe (return ()) succeed - --- | Function 'get'' assumes that the argument source is not empty and returns the value the source yields. If the --- source is empty, the function throws an error. -get' :: forall m a d x . (Monad m, AncestorFunctor a d) => Source m a x -> Trampoline d m x -get' source = get source >>= maybe (error "get' failed") return - --- | 'pour' copies all data from the /source/ argument into the /sink/ argument, as long as there is anything to copy --- and the sink accepts it. -pour :: forall m a1 a2 d x . (Monad m, AncestorFunctor a1 d, AncestorFunctor a2 d) - => Source m a1 x -> Sink m a2 x -> Trampoline d m () -pour source sink = fill' - where fill' = canPut sink >>= flip when (getSuccess source (\x-> put sink x >> fill')) - --- | 'pourMap' is like 'pour' that applies the function /f/ to each argument before passing it into the /sink/. -pourMap :: forall m a1 a2 d x y . (Monad m, AncestorFunctor a1 d, AncestorFunctor a2 d) - => (x -> y) -> Source m a1 x -> Sink m a2 y -> Trampoline d m () -pourMap f source sink = loop - where loop = canPut sink >>= flip when (get source >>= maybe (return ()) (\x-> put sink (f x) >> loop)) - --- | 'pourMapMaybe' is to 'pourMap' like 'Data.Maybe.mapMaybe' is to 'Data.List.Map'. -pourMapMaybe :: forall m a1 a2 d x y . (Monad m, AncestorFunctor a1 d, AncestorFunctor a2 d) - => (x -> Maybe y) -> Source m a1 x -> Sink m a2 y -> Trampoline d m () -pourMapMaybe f source sink = loop - where loop = canPut sink >>= flip when (get source >>= maybe (return ()) (\x-> maybe (return False) (put sink) (f x) >> loop)) - --- | 'tee' is similar to 'pour' except it distributes every input value from the /source/ arguments into both /sink1/ --- and /sink2/. -tee :: forall m a1 a2 a3 d x . (Monad m, AncestorFunctor a1 d, AncestorFunctor a2 d, AncestorFunctor a3 d) - => Source m a1 x -> Sink m a2 x -> Sink m a3 x -> Trampoline d m () -tee source sink1 sink2 = distribute - where distribute = do c1 <- canPut sink1 - c2 <- canPut sink2 - when (c1 && c2) - (get source >>= maybe (return ()) (\x-> put sink1 x >> put sink2 x >> distribute)) - --- | 'putList' puts entire list into its /sink/ argument, as long as the sink accepts it. The remainder that wasn't --- accepted by the sink is the result value. -putList :: forall m a d x. (Monad m, AncestorFunctor a d) => [x] -> Sink m a x -> Trampoline d m [x] -putList [] sink = return [] -putList l@(x:rest) sink = put sink x >>= cond (putList rest sink) (return l) - --- | 'getList' returns the list of all values generated by the source. -getList :: forall m a d x. (Monad m, AncestorFunctor a d) => Source m a x -> Trampoline d m [x] -getList source = getList' return - where getList' f = get source >>= maybe (f []) (\x-> getList' (f . (x:))) - --- | 'consumeAndSuppress' consumes the entire source ignoring the values it generates. -consumeAndSuppress :: forall m a d x. (Monad m, AncestorFunctor a d) => Source m a x -> Trampoline d m () -consumeAndSuppress source = get source - >>= maybe (return ()) (const (consumeAndSuppress source)) - --- | A utility function wrapping if-then-else, useful for handling monadic truth values -cond :: a -> a -> Bool -> a -cond x y test = if test then x else y - --- | A utility function, useful for handling monadic list values where empty list means success -whenNull :: forall a m. Monad m => m [a] -> [a] -> m [a] -whenNull action list = if null list then action else return list - --- | Like 'putList', except it puts the contents of the given 'Data.Sequence.Seq' into the sink. -putQueue :: forall m a d x. (Monad m, AncestorFunctor a d) => Seq x -> Sink m a x -> Trampoline d m [x] -putQueue q sink = putList (toList (viewl q)) sink diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3826.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T3826.hs deleted file mode 100644 index 39c597f69c..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3826.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE TypeFamilies #-}
-
-module T3826 where
-
-class C a where
- type E a
- c :: E a -> a -> a
-
-data T a = T a
-
-instance C (T a) where
- type E (T a) = a
- c x (T _) = T x
-
-f t@(T x) = c x t
diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3851.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T3851.hs deleted file mode 100644 index 3b40db1bce..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T3851.hs +++ /dev/null @@ -1,24 +0,0 @@ -{-# LANGUAGE GADTs, TypeFamilies #-}
-
-module T3851 where
-
-type family TF a :: * -> *
-type instance TF () = App (Equ ())
-
-data Equ ix ix' where Refl :: Equ ix ix
-data App f x = App (f x)
-
--- does not typecheck in 6.12.1 (but works in 6.10.4)
-bar :: TF () () -> ()
-bar (App Refl) = ()
-
--- does typecheck in 6.12.1 and 6.10.4
-ar :: App (Equ ()) () -> ()
-ar (App Refl) = ()
-
-------------------
-data family DF a :: * -> *
-data instance DF () a = D (App (Equ ()) a)
-
-bar_df :: DF () () -> ()
-bar_df (D (App Refl)) = ()
diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4120.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T4120.hs deleted file mode 100644 index 57dd21a39b..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4120.hs +++ /dev/null @@ -1,26 +0,0 @@ -{-# LANGUAGE Rank2Types, TypeFamilies #-} - --- Unification yielding a coercion under a forall - -module Data.Vector.Unboxed where - -import Control.Monad.ST ( ST ) - - -data MVector s a = MV -data Vector a = V - -type family Mutable (v :: * -> *) :: * -> * -> * -type instance Mutable Vector = MVector - -create :: (forall s. MVector s a) -> Int -create = create1 --- Here we get Couldn't match expected type `forall s. MVector s a' --- with actual type `forall s. Mutable Vector s a1' --- Reason: when unifying under a for-all we don't solve type --- equalities. Think more about this. - -create1 :: (forall s. Mutable Vector s a) -> Int -create1 = error "urk" - - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4120.stderr b/testsuite/tests/ghc-regress/indexed-types/should_compile/T4120.stderr deleted file mode 100644 index d957620b78..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4120.stderr +++ /dev/null @@ -1,8 +0,0 @@ - -T4120.hs:17:10: - Couldn't match expected type `forall s. MVector s a' - with actual type `forall s. Mutable Vector s a0' - Expected type: (forall s. MVector s a) -> Int - Actual type: (forall s. Mutable Vector s a0) -> Int - In the expression: create1 - In an equation for `create': create = create1 diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4160.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T4160.hs deleted file mode 100644 index f13aafa103..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4160.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeFamilies #-} -module Foo where - -data P f g r = f r :*: g r -type family TrieMapT (f :: * -> *) :: * -> (* -> *) -> * -> * -newtype PMap m1 (m2 :: * -> (* -> *) -> * -> *) k (a :: * -> *) ix = PMap (m1 k (m2 k a) ix) -type instance TrieMapT (P f g) = PMap (TrieMapT f) (TrieMapT g) - -class TrieKeyT f m where - unionT :: (TrieMapT f ~ m) => (f k -> a ix -> a ix -> a ix) -> - m k a ix -> m k a ix -> m k a ix - sizeT :: (TrieMapT f ~ m) => m k a ix -> Int - -instance (TrieKeyT f m1, TrieKeyT g m2) => TrieKeyT (P f g) (PMap m1 m2) where - unionT f (PMap m1) (PMap m2) = PMap (uT (\ a -> unionT (\ b -> f (a :*: b))) m1 m2) - where uT = unionT - sizeT = error "urk" - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4178.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T4178.hs deleted file mode 100644 index b0a34b28e1..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4178.hs +++ /dev/null @@ -1,35 +0,0 @@ -{-# LANGUAGE - FlexibleContexts, - Rank2Types, - TypeFamilies, - MultiParamTypeClasses, - FlexibleInstances #-} - --- See Trac #4178 - -module T4178 where - -data True = T -data False = F - -class Decide tf a b where - type If tf a b - nonFunctionalIf :: tf -> a -> b -> If tf a b - -instance Decide True a b where - type If True a b = a - nonFunctionalIf T a b = a - -instance Decide False a b where - type If False a b = b - nonFunctionalIf F a b = b - -useRank2 :: (forall a . a -> b) -> b -useRank2 f = f "foo" - -hasTrouble a = nonFunctionalIf F a (2 :: Int) -blurg = useRank2 hasTrouble - -hasNoTrouble :: a -> Int -hasNoTrouble = hasTrouble -blurg2 = useRank2 hasNoTrouble diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4200.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T4200.hs deleted file mode 100644 index 0d0e23a419..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4200.hs +++ /dev/null @@ -1,12 +0,0 @@ -{-# LANGUAGE TypeFamilies #-}
-
-module T4200 where
-
-class C a where
- type In a :: *
- op :: In a -> Int
-
--- Should be ok; no -XUndecidableInstances required
-instance (In c ~ Int) => C [c] where
- type In [c] = In c
- op x = 3
diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4338.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T4338.hs deleted file mode 100644 index 6fa2ae85ac..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4338.hs +++ /dev/null @@ -1,23 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-} - -module Main where - -class (There a ~ b, BackAgain b ~ a) => Foo a b where - type There a - type BackAgain b - there :: a -> b - back :: b -> a - tickle :: b -> b - -instance Foo Char Int where - type There Char = Int - type BackAgain Int = Char - there = fromEnum - back = toEnum - tickle = (+1) - -test :: (Foo a b) => a -> a -test = back . tickle . there - -main :: IO () -main = print $ test 'F' diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4356.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T4356.hs deleted file mode 100644 index 400314eeb2..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4356.hs +++ /dev/null @@ -1,8 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} -module T4356 where - -type family T t :: * -> * -> * -type instance T Bool = (->) - -f :: T Bool Bool Bool -f = not diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4358.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T4358.hs deleted file mode 100644 index 92ac3a743b..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4358.hs +++ /dev/null @@ -1,11 +0,0 @@ -{-# LANGUAGE TypeFamilies, Rank2Types, FlexibleContexts #-} - -module T4358 where - -type family T a - -t2 :: forall a. ((T a ~ a) => a) -> a -t2 = t - -t :: forall a. ((T a ~ a) => a) -> a -t = undefined diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4484.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T4484.hs deleted file mode 100644 index 94a76ee7d4..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4484.hs +++ /dev/null @@ -1,30 +0,0 @@ -{-# LANGUAGE TypeFamilies, EmptyDataDecls, GADTs #-} - -module T4484 where - -type family F f :: * - -data Id c = Id -type instance F (Id c) = c - -data C :: * -> * where - C :: f -> C (W (F f)) - -data W :: * -> * - -fails :: C a -> C a -fails (C _) - = -- We know (W (F f) ~ a) - C Id -- We need (a ~ W (F (Id beta))) - -- ie (a ~ W beta) - -- Use the equality; we need - -- (W (F f) ~ W beta) - -- ie (F f ~ beta) - -- Solve with beta := f - -works :: C (W a) -> C (W a) -works (C _) - = -- We know (W (F f) ~ W a) - C Id -- We need (W a ~ W (F (Id beta))) - -- ie (W a ~ W beta) - -- Solve with beta := a diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4492.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T4492.hs deleted file mode 100644 index 0c01cbc973..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4492.hs +++ /dev/null @@ -1,12 +0,0 @@ -{-# LANGUAGE TypeFamilies, RankNTypes #-} - -module T4492 where - -type family F a b -type instance F (Maybe a) b = b -> F a b - -class C a where - go :: (forall a. Maybe a -> b -> a) -> a -> F a b - -instance C a => C (Maybe a) where - go f a b = go f (f a b) diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4494.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T4494.hs deleted file mode 100644 index 52e1435272..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4494.hs +++ /dev/null @@ -1,12 +0,0 @@ -{-# LANGUAGE TypeFamilies, RankNTypes, FlexibleContexts, ScopedTypeVariables #-} - -module T4494 where - -type family H s -type family F v - -bar :: (forall t. Maybe t -> a) -> H a -> Int -bar = error "urk" - -call :: F Bool -> Int -call x = bar (\_ -> x) (undefined :: H (F Bool)) diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4497.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T4497.hs deleted file mode 100644 index 57d3d48ca4..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4497.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeFamilies #-}
-
-module T4497 where
-
-norm2PropR a = twiddle (norm2 a) a
-
-twiddle :: Normed a => a -> a -> Double
-twiddle a b = undefined
-
-norm2 :: e -> RealOf e
-norm2 = undefined
-
-class (Num (RealOf t)) => Normed t
-
-type family RealOf x
diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4935.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T4935.hs deleted file mode 100644 index 2c9d16a9b8..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4935.hs +++ /dev/null @@ -1,24 +0,0 @@ -{-# LANGUAGE TypeFamilies, Rank2Types, ScopedTypeVariables #-} -module T4935 where - -import Control.Applicative - -data TFalse -data TTrue - -data Tagged b a = Tagged {at :: a} -type At b = forall a. Tagged b a -> a - -class TBool b where onTBool :: (b ~ TFalse => c) -> (b ~ TTrue => c) -> Tagged b c -instance TBool TFalse where onTBool f _ = Tagged $ f -instance TBool TTrue where onTBool _ t = Tagged $ t - -type family CondV c f t -type instance CondV TFalse f t = f -type instance CondV TTrue f t = t - -newtype Cond c f a = Cond {getCond :: CondV c a (f a)} -cond :: forall c f a g. (TBool c, Functor g) => (c ~ TFalse => g a) -> (c ~ TTrue => g (f a)) -> g (Cond c f a) -cond f t = (at :: At c) $ onTBool (fmap Cond f) (fmap Cond t) -condMap :: (TBool c, Functor f) => (a -> b) -> Cond c f a -> Cond c f b -condMap g (Cond n) = cond g (fmap g) n diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4981-V1.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T4981-V1.hs deleted file mode 100644 index 14f675ca59..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4981-V1.hs +++ /dev/null @@ -1,34 +0,0 @@ -{-# LANGUAGE CPP, TypeFamilies, FlexibleContexts #-}
-module Class ( cleverNamedResolve ) where
-
-data FL p = FL p
-
-class PatchInspect p where
-instance PatchInspect p => PatchInspect (FL p) where
-
-type family PrimOf p
-type instance PrimOf (FL p) = PrimOf p
-
-data WithName prim = WithName prim
-
-instance PatchInspect prim => PatchInspect (WithName prim) where
-
-class (PatchInspect (PrimOf p)) => Conflict p where
- resolveConflicts :: p -> PrimOf p
-
-instance Conflict p => Conflict (FL p) where
- resolveConflicts = undefined
-
-type family OnPrim p
-
-class FromPrims p where
-
-instance FromPrims (FL p) where
-
-joinPatches :: FromPrims p => p -> p
-joinPatches = id
-
-cleverNamedResolve :: (Conflict (OnPrim p)
- ,PrimOf (OnPrim p) ~ WithName (PrimOf p))
- => FL (OnPrim p) -> WithName (PrimOf p)
-cleverNamedResolve = resolveConflicts . joinPatches
diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4981-V2.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T4981-V2.hs deleted file mode 100644 index d18d67e91c..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4981-V2.hs +++ /dev/null @@ -1,31 +0,0 @@ -{-# LANGUAGE CPP, TypeFamilies, FlexibleContexts #-}
-module Class ( cleverNamedResolve ) where
-
-data FL p = FL p
-
-class PatchInspect p where
-instance PatchInspect p => PatchInspect (FL p) where
-
-type family PrimOf p
-type instance PrimOf (FL p) = PrimOf p
-
-data WithName prim = WithName prim
-
-instance PatchInspect prim => PatchInspect (WithName prim) where
-
-class (PatchInspect (PrimOf p)) => Conflict p where
- resolveConflicts :: p -> PrimOf p
-
-instance Conflict p => Conflict (FL p) where
- resolveConflicts = undefined
-
-type family OnPrim p
-
-joinPatches :: FL p -> FL p
-
-joinPatches = id
-
-cleverNamedResolve :: (Conflict (OnPrim p)
- ,PrimOf (OnPrim p) ~ WithName (PrimOf p))
- => FL (OnPrim p) -> WithName (PrimOf p)
-cleverNamedResolve = resolveConflicts . joinPatches
diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4981-V3.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T4981-V3.hs deleted file mode 100644 index 9e0eda54eb..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4981-V3.hs +++ /dev/null @@ -1,31 +0,0 @@ -{-# LANGUAGE CPP, TypeFamilies, FlexibleContexts #-}
-module Class ( cleverNamedResolve ) where
-
-data FL p = FL p
-
-class PatchInspect p where
-instance PatchInspect p => PatchInspect (FL p) where
-
-type family PrimOf p
-type instance PrimOf (FL p) = PrimOf p
-
-data WithName prim = WithName prim
-
-instance PatchInspect prim => PatchInspect (WithName prim) where
-
-class (PatchInspect (PrimOf p)) => Conflict p where
- resolveConflicts :: p -> PrimOf p
-
-instance Conflict p => Conflict (FL p) where
- resolveConflicts = undefined
-
-type family OnPrim p
-
-joinPatches :: p -> p
-
-joinPatches = id
-
-cleverNamedResolve :: (Conflict (OnPrim p)
- ,PrimOf (OnPrim p) ~ WithName (PrimOf p))
- => FL (OnPrim p) -> WithName (PrimOf p)
-cleverNamedResolve = resolveConflicts . joinPatches
diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T5002.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T5002.hs deleted file mode 100644 index cfc82d559e..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/T5002.hs +++ /dev/null @@ -1,29 +0,0 @@ -{-# LANGUAGE TypeFamilies, FlexibleInstances, UndecidableInstances, FlexibleContexts #-}
-
-class A a
-class B a where b :: a -> ()
-instance A a => B a where b = undefined
-
-newtype Y a = Y (a -> ())
-
-okIn701 :: B a => Y a
-okIn701 = wrap $ const () . b
-
-okIn702 :: B a => Y a
-okIn702 = wrap $ b
-
-okInBoth :: B a => Y a
-okInBoth = Y $ const () . b
-
-class Wrapper a where
- type Wrapped a
- wrap :: Wrapped a -> a
-instance Wrapper (Y a) where
- type Wrapped (Y a) = a -> ()
- wrap = Y
-
-fromTicket3018 :: Eq [a] => a -> ()
-fromTicket3018 x = let {g :: Int -> Int; g = [x]==[x] `seq` id} in ()
-
-main = undefined
-
diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/TF_GADT.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/TF_GADT.hs deleted file mode 100644 index 345b5748e0..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/TF_GADT.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE GADTs, TypeFamilies #-}
-
-module TF_GADT where
-
--- Check that type families can be declared in GADT syntax
--- and indeed *be* GADTs
-
-data family T a
-
-data instance T [a] where
- T1 :: a -> T [a]
-
-
-data instance T (Maybe a) where
- T3 :: Int -> T (Maybe Int)
- T4 :: a -> b -> T (Maybe (a,b))
-
-
-f :: a -> T (Maybe a) -> T (Maybe a)
-f x (T3 i) = T3 x
-f x (T4 p q) = T4 p (snd x)
diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/all.T b/testsuite/tests/ghc-regress/indexed-types/should_compile/all.T deleted file mode 100644 index 241bbe49c6..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/all.T +++ /dev/null @@ -1,184 +0,0 @@ -setTestOpts(only_compiler_types(['ghc'])) -# Keep optimised tests, so we test coercion optimisation -setTestOpts(omit_ways(['optasm', 'optllvm', 'hpc'])) - -test('Simple1', normal, compile, ['']) -test('Simple2', normal, compile, ['']) -test('Simple3', normal, compile, ['']) -test('Simple4', normal, compile, ['']) -test('Simple5', normal, compile, ['']) -test('Simple6', normal, compile, ['']) -test('Simple7', normal, compile, ['']) -test('Simple8', normal, compile, ['']) -test('Simple9', normal, compile, ['']) -test('Simple10', normal, compile, ['']) -test('Simple11', normal, compile, ['']) -test('Simple12', normal, compile, ['']) -test('Simple13', normal, compile, ['']) -test('Simple14', normal, compile_fail, ['']) -test('Simple15', normal, compile, ['']) -test('Simple16', normal, compile, ['']) -test('Simple17', normal, compile, ['']) -test('Simple18', normal, compile, ['']) -test('Simple19', normal, compile, ['']) -test('Simple20', expect_broken(4296), compile, ['']) -test('Simple21', normal, compile, ['']) -test('Simple22', normal, compile, ['']) -test('Simple23', normal, compile, ['']) -test('Simple24', normal, compile, ['']) - -test('RelaxedExamples', normal, compile, ['']) -test('NonLinearLHS', normal, compile, ['']) - -test('ind1', normal, compile, ['']) -test('ind2', - extra_clean(['Ind2_help.hi', 'Ind2_help.o']), - multimod_compile, - ['ind2', '-v0']) -test('impexp', - extra_clean(['Exp.hi', 'Exp.o', 'Imp.hi', 'Imp.o']), - multimod_compile, - ['Imp', '-w -no-hs-main -c']) - -test('ATLoop', - extra_clean(['ATLoop_help.o','ATLoop_help.hi']), - multimod_compile, - ['ATLoop.hs','-v0']) - -test('Deriving', normal, compile, ['']) -test('DerivingNewType', expect_fail, compile, ['']) -test('Records', normal, compile, ['']) - -# The point about this test is that it compiles NewTyCo1 and NewTyCo2 -# *separately* -# -test('NewTyCo', - extra_clean(['NewTyCo1.o', 'NewTyCo1.hi', 'NewTyCo2.o', 'NewTyCo2.hi']), - run_command, - ['$MAKE -s --no-print-directory NewTyCo']) - -test('Infix', normal, compile, ['']) -test('Kind', normal, compile, ['']) - -test('GADT1', normal, compile, ['']) -test('GADT2', normal, compile, ['']) -test('GADT3', normal, compile, ['']) -test('GADT4', normal, compile, ['']) -test('GADT5', normal, compile, ['']) -test('GADT6', normal, compile, ['']) -test('GADT7', normal, compile, ['']) -test('GADT8', normal, compile, ['']) -test('GADT9', normal, compile, ['']) -test('GADT10', normal, compile, ['']) -test('GADT11', normal, compile, ['']) -test('GADT12', normal, compile, ['']) -test('GADT13', normal, compile, ['']) -test('GADT14', normal, compile, ['']) - -test('Class1', normal, compile, ['']) -test('Class2', normal, compile, ['']) -test('Class3', normal, compile, ['']) - -test('Refl', normal, compile, ['']) -test('Refl2', normal, compile, ['']) - -test('Rules1', normal, compile, ['']) - -test('Numerals', normal, compile, ['']) - -test('ColInference', normal, compile, ['']) -test('ColInference2', normal, compile, ['']) -test('ColInference3', normal, compile, ['']) -test('ColInference4', normal, compile, ['']) -test('ColInference5', normal, compile, ['']) -test('ColInference6', normal, compile, ['']) - -test('Col', normal, compile, ['']) -test('Col2', normal, compile, ['']) - -test('ColGivenCheck', normal, compile, ['']) -test('ColGivenCheck2', normal, compile, ['']) - -test('InstEqContext', normal, compile, ['']) -test('InstEqContext2', normal, compile, ['']) -test('InstEqContext3', normal, compile, ['']) - -test('InstContextNorm', normal, compile, ['']) - -test('GivenCheck', normal, compile, ['']) -test('GivenCheckSwap', normal, compile, ['']) -test('GivenCheckDecomp', normal, compile, ['']) -test('GivenCheckTop', normal, compile, ['']) - -# A very delicate test -test('Gentle', normal, compile, ['']) - -test('T1981', normal, compile, ['']) -test('T2238', normal, compile, ['']) -test('OversatDecomp', normal, compile, ['']) - -test('T2219', normal, compile, ['']) -test('T2627', normal, compile, ['']) -test('T2448', normal, compile, ['']) -test('T2291', normal, compile, ['']) -test('T2639', normal, compile, ['']) -test('T2944', normal, compile, ['']) -test('T3017', normal, compile, ['-ddump-types']) -test('TF_GADT', normal, compile, ['']) -test('T2203b', normal, compile, ['']) -test('T2767', normal, compile, ['']) -test('T3208a', normal, compile, ['']) -test('T3208b', normal, compile_fail, ['']) -test('T3418', normal, compile, ['']) -test('T3423', normal, compile, ['']) -test('T2850', normal, compile, ['']) -test('T3220', normal, compile, ['']) -test('T3590', normal, compile, ['']) -test('CoTest3', normal, compile, ['']) -test('Roman1', normal, compile, ['']) -test('T4160', normal, compile, ['']) -test('IndTypesPerf', - [ # expect_broken(5224), - # unbroken temporarily: #5227 - extra_clean(['IndTypesPerf.o', 'IndTypesPerf.hi', - 'IndTypesPerfMerge.o', 'IndTypesPerfMerge.hi']) - ] , - run_command, - ['$MAKE -s --no-print-directory IndTypesPerf']) - -test('T4120', normal, compile_fail, ['']) -test('T3787', reqlib('mtl'), compile, ['']) -test('T3826', normal, compile, ['']) -test('T4200', normal, compile, ['']) -test('T3851', normal, compile, ['']) -test('T4178', normal, compile, ['']) -test('T3023', normal, compile, ['']) -test('T4358', normal, compile, ['']) -test('T4356', normal, compile, ['']) -test('T4484', normal, compile, ['']) -test('T4492', normal, compile, ['']) -test('T4494', normal, compile, ['']) -test('DataFamDeriv', normal, compile, ['']) -test('T1769', if_compiler_lt('ghc', '7.1', expect_fail), compile, ['']) -test('T4497', normal, compile, ['']) -test('T3484', normal, compile, ['']) -test('T3460', normal, compile, ['']) -test('T4935', normal, compile, ['']) - -test('T4981-V1', normal, compile, ['']) -test('T4981-V2', normal, compile, ['']) -test('T4981-V3', normal, compile, ['']) - -test('T5002', normal, compile, ['']) -test('PushedInAsGivens', normal, compile, ['']) - -# Superclass equalities -test('T4338', normal, compile, ['']) -test('T2715', normal, compile, ['']) -test('T2102', normal, compile, ['']) -test('ClassEqContext', normal, compile, ['']) -test('ClassEqContext2', normal, compile, ['']) -test('ClassEqContext3', normal, compile, ['']) -test('HO', normal, compile, ['']) - - diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/impexp.stderr b/testsuite/tests/ghc-regress/indexed-types/should_compile/impexp.stderr deleted file mode 100644 index 7ebebe9e03..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/impexp.stderr +++ /dev/null @@ -1,2 +0,0 @@ -[1 of 2] Compiling Exp ( Exp.hs, Exp.o ) -[2 of 2] Compiling Imp ( Imp.hs, Imp.o ) diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/ind1.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/ind1.hs deleted file mode 100644 index 48203a1519..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/ind1.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - --- Test type families - -module ShouldCompile where - -data family T a :: * - -data instance T Bool = TBool !Bool - -class C a where - foo :: (a -> a) -> T a -> T a - -instance C Bool where - foo f (TBool x) = TBool $ f (not x) diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/ind2.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/ind2.hs deleted file mode 100644 index de5d9d6a86..0000000000 --- a/testsuite/tests/ghc-regress/indexed-types/should_compile/ind2.hs +++ /dev/null @@ -1,9 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module ShouldCompile where - -import Ind2_help(C(..)) - -zipT :: (C a, C b) => T a -> T b -> T (a,b) -zipT x y = mkT (unT x, unT y) - |