summaryrefslogtreecommitdiff
path: root/testsuite/tests/polykinds/T12055a.hs
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests/polykinds/T12055a.hs')
-rw-r--r--testsuite/tests/polykinds/T12055a.hs45
1 files changed, 45 insertions, 0 deletions
diff --git a/testsuite/tests/polykinds/T12055a.hs b/testsuite/tests/polykinds/T12055a.hs
new file mode 100644
index 0000000000..dab523861b
--- /dev/null
+++ b/testsuite/tests/polykinds/T12055a.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeInType #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeInType #-}
+
+{-# LANGUAGE FlexibleInstances, UndecidableInstances, FunctionalDependencies #-}
+
+-- The code from the ticket lacked necessary extension FlexibleContexts
+-- which crashed the compiler with "GHC internal error"
+-- This test case reproduces that scenario
+{- # LANGUAGE FlexibleContexts #-}
+
+module T12055a 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)