summaryrefslogtreecommitdiff
path: root/testsuite
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2016-06-13 11:56:44 +0100
committerSimon Peyton Jones <simonpj@microsoft.com>2016-06-13 11:56:44 +0100
commit921ebc9f0854d033cbafd43d3b2c5ba679c27b3c (patch)
treebca3ad8c2f9748ed1558849ae5e38b3820df7ad1 /testsuite
parente064f501d76c208ddab3c3be551ffe5167d7974f (diff)
downloadhaskell-921ebc9f0854d033cbafd43d3b2c5ba679c27b3c.tar.gz
Test Trac #12055
Diffstat (limited to 'testsuite')
-rw-r--r--testsuite/tests/polykinds/T12055.hs45
-rw-r--r--testsuite/tests/polykinds/all.T1
2 files changed, 46 insertions, 0 deletions
diff --git a/testsuite/tests/polykinds/T12055.hs b/testsuite/tests/polykinds/T12055.hs
new file mode 100644
index 0000000000..3ffc221b7b
--- /dev/null
+++ b/testsuite/tests/polykinds/T12055.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeInType #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeInType #-}
+
+-- The code from the ticket lacked these extensions,
+-- but crashed the compiler with "GHC internal error"
+-- It doesn't crash now; and in this test case I've added
+-- the extensions, which makes it compile cleanly
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances, FunctionalDependencies #-}
+
+
+module T12055 where
+
+import GHC.Base ( Constraint, Type )
+import GHC.Exts ( type (~~) )
+
+type Cat k = k -> k -> Type
+
+class Category (p :: Cat k) where
+ type Ob p :: k -> Constraint
+
+class (Category (Dom f), Category (Cod f)) => Functor (f :: j -> k) where
+ type Dom f :: Cat j
+ type Cod f :: Cat k
+ functor :: forall a b.
+ Iso Constraint (:-) (:-)
+ (Ob (Dom f) a) (Ob (Dom f) b)
+ (Ob (Cod f) (f a)) (Ob (Cod f) (f b))
+
+class (Functor f , Dom f ~ p, Cod f ~ q) =>
+ Fun (p :: Cat j) (q :: Cat k) (f :: j -> k) | f -> p q
+instance (Functor f , Dom f ~ p, Cod f ~ q) =>
+ Fun (p :: Cat j) (q :: Cat k) (f :: j -> k)
+
+data Nat (p :: Cat j) (q :: Cat k) (f :: j -> k) (g :: j -> k)
+
+type Iso k (c :: Cat k) (d :: Cat k) s t a b =
+ forall p. (Cod p ~~ Nat d (->)) => p a b -> p s t
+
+data (p :: Constraint) :- (q :: Constraint)
diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T
index 2c3d1df866..c731441679 100644
--- a/testsuite/tests/polykinds/all.T
+++ b/testsuite/tests/polykinds/all.T
@@ -148,3 +148,4 @@ test('T11648b', normal, compile_fail, [''])
test('KindVType', normal, compile_fail, [''])
test('T11821', normal, compile, [''])
test('T11640', normal, compile, [''])
+test('T12055', normal, compile, [''])