Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/d16800962aed7da3e57fb8b8c7c5302d51d80825 >--------------------------------------------------------------- commit d16800962aed7da3e57fb8b8c7c5302d51d80825 Author: Jose Pedro Magalhaes <[email protected]> Date: Wed Nov 16 16:09:10 2011 +0000 Add kind annotations This is now necessary because previously we were being too liberal in figuring out the kinds of phantom type variables. >--------------------------------------------------------------- .../indexed-types/should_compile/OversatDecomp.hs | 2 +- tests/simplCore/should_compile/T4903a.hs | 2 +- tests/simplCore/should_compile/T5303.hs | 2 +- tests/typecheck/should_compile/T1470.hs | 4 ++-- tests/typecheck/should_compile/T3018.hs | 2 +- tests/typecheck/should_compile/T4969.hs | 5 +++-- 6 files changed, 9 insertions(+), 8 deletions(-) diff --git a/tests/indexed-types/should_compile/OversatDecomp.hs b/tests/indexed-types/should_compile/OversatDecomp.hs index a93256c..898c4d8 100644 --- a/tests/indexed-types/should_compile/OversatDecomp.hs +++ b/tests/indexed-types/should_compile/OversatDecomp.hs @@ -5,7 +5,7 @@ module OversatDecomp where class Blah f a where blah :: a -> T f f a -class A f where +class A (f :: * -> *) where type T f :: (* -> *) -> * -> * wrapper :: Blah f a => a -> T f f a diff --git a/tests/simplCore/should_compile/T4903a.hs b/tests/simplCore/should_compile/T4903a.hs index e78859c..8c87000 100644 --- a/tests/simplCore/should_compile/T4903a.hs +++ b/tests/simplCore/should_compile/T4903a.hs @@ -14,7 +14,7 @@ class El phi ix where class Fam phi where from :: phi ix -> ix -> PF phi I0 ix -type family PF phi :: (* -> *) -> * -> * +type family PF (phi :: * -> *) :: (* -> *) -> * -> * data I0 a = I0 a diff --git a/tests/simplCore/should_compile/T5303.hs b/tests/simplCore/should_compile/T5303.hs index b19eb22..18a4f98 100644 --- a/tests/simplCore/should_compile/T5303.hs +++ b/tests/simplCore/should_compile/T5303.hs @@ -4,7 +4,7 @@ module T5303( showContextSeries ) where import Control.Monad.State.Strict( StateT ) import Control.Monad.Trans ( lift ) -data Tree m = Tree {} +data Tree (m :: * -> *) = Tree {} data FL (a :: * -> * -> *) x z where (:>:) :: a x y -> FL a y z -> FL a x z diff --git a/tests/typecheck/should_compile/T1470.hs b/tests/typecheck/should_compile/T1470.hs index 8419a94..d466e48 100644 --- a/tests/typecheck/should_compile/T1470.hs +++ b/tests/typecheck/should_compile/T1470.hs @@ -1,11 +1,11 @@ -{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, OverlappingInstances, UndecidableInstances #-} +{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, OverlappingInstances, UndecidableInstances, KindSignatures #-} -- Trac #1470 module Foo where class Sat a -class Data ctx a +class Data (ctx :: * -> *) a instance Sat (ctx Char) => Data ctx Char instance (Sat (ctx [a]), Data ctx a) => Data ctx [a] diff --git a/tests/typecheck/should_compile/T3018.hs b/tests/typecheck/should_compile/T3018.hs index 9ef5b56..ffecfc2 100644 --- a/tests/typecheck/should_compile/T3018.hs +++ b/tests/typecheck/should_compile/T3018.hs @@ -8,7 +8,7 @@ module T3018 where import Control.Monad -- minimal Data/Rep classes -data Rep ctx a +data Rep (ctx :: * -> *) a class Data (ctx :: * -> *) a where rep :: Rep ctx a diff --git a/tests/typecheck/should_compile/T4969.hs b/tests/typecheck/should_compile/T4969.hs index 084420e..ce2e820 100644 --- a/tests/typecheck/should_compile/T4969.hs +++ b/tests/typecheck/should_compile/T4969.hs @@ -1,7 +1,8 @@ {-# OPTIONS_GHC -w #-} {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts, FlexibleInstances, - OverlappingInstances, UndecidableInstances #-} + OverlappingInstances, UndecidableInstances, + KindSignatures #-} -- Cut down from a larger core-lint error @@ -26,7 +27,7 @@ data FreshThings = Fresh newtype NewName a = NewName a newtype LetDef = LetDef NiceDeclaration -newtype TCMT m a = TCM () +newtype TCMT (m :: * -> *) a = TCM () localToAbstract :: ToAbstract c a => c -> (a -> TCMT IO b) -> TCMT IO b localToAbstract = undefined _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
