Allow levity-polymorpic arrows

This cures Trac #12668 (and cures the Lint errors you get from
Trac #12718).

The idea is explained in Note [Levity polymorphism], in Kind.hs

3 files changed, 47 insertions, 0 deletions

diff --git a/testsuite/tests/polykinds/T12668.hs b/testsuite/tests/polykinds/T12668.hs
new file mode 100644
index 0000000000..4640903cc5
--- /dev/null
+++ b/testsuite/tests/polykinds/T12668.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE TypeInType #-}
+{-# LANGUAGE RankNTypes #-}
+
+module T12668 where
+
+import GHC.Exts
+
+data Some r = Some (TYPE r -> TYPE r)
+
+doSomething :: forall (r :: RuntimeRep). forall (a :: TYPE r). ()
+            => Int -> (a -> Int) -> a -> a
+doSomething n f =
+    case n of
+      1 -> error "hello"
+      3 -> error "hello"
diff --git a/testsuite/tests/polykinds/T12718.hs b/testsuite/tests/polykinds/T12718.hs
new file mode 100644
index 0000000000..82d6dcd177
--- /dev/null
+++ b/testsuite/tests/polykinds/T12718.hs
@@ -0,0 +1,30 @@
+{-# Language RebindableSyntax, NoImplicitPrelude, MagicHash, RankNTypes,
+             PolyKinds, ViewPatterns, TypeInType, FlexibleInstances #-}
+
+module Main where
+
+import Prelude hiding (Eq (..), Num(..))
+import qualified Prelude as P
+import GHC.Prim
+import GHC.Types
+
+class XNum (a :: TYPE rep) where
+  (+) :: a -> a -> a
+  fromInteger :: Integer -> a
+
+instance P.Num a => XNum a where
+  (+) = (P.+)
+  fromInteger = P.fromInteger
+
+instance XNum Int# where
+  (+) = (+#)
+  fromInteger i = case fromInteger i of
+                   I# n -> n
+
+u :: Bool
+u = isTrue# v_
+  where
+    v_ :: forall rep (a :: TYPE rep). XNum a => a
+    v_ = fromInteger 10
+
+main = print u
diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T
index 6da6ae4439..6ec2a439e6 100644
--- a/testsuite/tests/polykinds/all.T
+++ b/testsuite/tests/polykinds/all.T
@@ -152,3 +152,5 @@ test('T11554', normal, compile_fail, [''])
 test('T12055', normal, compile, [''])
 test('T12055a', normal, compile_fail, [''])
 test('T12593', normal, compile_fail, [''])
+test('T12668', normal, compile, [''])
+test('T12718', normal, compile, [''])