Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/eacd73a1c87b189f0b441f3cf4525997acf11c21 >--------------------------------------------------------------- commit eacd73a1c87b189f0b441f3cf4525997acf11c21 Author: Jose Pedro Magalhaes <[email protected]> Date: Mon Nov 28 08:45:14 2011 +0000 Add a test by Julien >--------------------------------------------------------------- tests/polykinds/PolyKinds12.hs | 40 ++++++++++++++++++++++++++++++++++++++++ tests/polykinds/all.T | 2 ++ 2 files changed, 42 insertions(+), 0 deletions(-) diff --git a/tests/polykinds/PolyKinds12.hs b/tests/polykinds/PolyKinds12.hs new file mode 100644 index 0000000..736f584 --- /dev/null +++ b/tests/polykinds/PolyKinds12.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE PolyKinds, TypeFamilies, GADTs #-} + +module PolyKinds12 where + +type family If1 b t f +type instance If1 True t f = t +type instance If1 False t f = f + +type family If2 (b :: Bool) t f +type instance If2 True t f = t +type instance If2 False t f = f + +data SBool b where + STrue :: SBool True + SFalse :: SBool False + +test1 :: SBool b -> If1 b Int Char +test1 STrue = 42 +test1 SFalse = 'H' + +test2 :: SBool b -> If2 b Int Char +test2 STrue = 42 +test2 SFalse = 'H' + +type family Apply f x +type instance Apply f x = f x + +-- Does not work because we do not abstract the return kind of type families +-- Currently If1 returns kind *, which is too restrictive +higher1v1 :: SBool b -> (If1 b Maybe []) Char +higher1v1 STrue = Just 'H' +higher1v1 SFalse = "Hello" + +higher1v2 :: SBool b -> Apply (If1 b Maybe []) Char +higher1v2 STrue = Just 'H' +higher1v2 SFalse = "Hello" + +-- higher2 :: SBool b -> (If2 b Maybe []) Int +-- higher2 STrue = Just 42 +-- higher2 SFalse = "Hello" diff --git a/tests/polykinds/all.T b/tests/polykinds/all.T index 9af577a..8b7be52 100644 --- a/tests/polykinds/all.T +++ b/tests/polykinds/all.T @@ -13,3 +13,5 @@ test('PolyKinds02', normal, compile_fail, ['']) test('PolyKinds04', normal, compile_fail, ['']) test('PolyKinds06', normal, compile_fail, ['']) test('PolyKinds07', normal, compile_fail, ['']) + +test('PolyKinds12', expect_fail, compile, ['']) _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
