summaryrefslogtreecommitdiff
path: root/testsuite/tests/dependent/should_compile/T11711.hs
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests/dependent/should_compile/T11711.hs')
-rw-r--r--testsuite/tests/dependent/should_compile/T11711.hs12
1 files changed, 8 insertions, 4 deletions
diff --git a/testsuite/tests/dependent/should_compile/T11711.hs b/testsuite/tests/dependent/should_compile/T11711.hs
index 814b2a4a68..ec33ceeb66 100644
--- a/testsuite/tests/dependent/should_compile/T11711.hs
+++ b/testsuite/tests/dependent/should_compile/T11711.hs
@@ -7,22 +7,26 @@
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
module T11711 where
-import Data.Kind (Type)
+import Data.Kind
-data (:~~:) (a :: k1) (b :: k2) where
+type (:~~:) :: k1 -> k2 -> Type
+data (:~~:) a b where
HRefl :: a :~~: a
-data TypeRep (a :: k) where
+type TypeRep :: k -> Type
+data TypeRep a where
TrTyCon :: String -> TypeRep k -> TypeRep (a :: k)
TrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1).
TypeRep (a :: k1 -> k2)
-> TypeRep (b :: k1)
-> TypeRep (a b)
-class Typeable (a :: k) where
+type Typeable :: k -> Constraint
+class Typeable a where
typeRep :: TypeRep a
data SomeTypeRep where