Fix deep, dark corner of pattern synonyms

Trac #14552 showed a very obscure case where we can't infer a
good pattern-synonym type.

The error message is horrible, but at least we no longer crash
and burn.

3 files changed, 53 insertions, 0 deletions

diff --git a/testsuite/tests/patsyn/should_fail/T14552.hs b/testsuite/tests/patsyn/should_fail/T14552.hs
new file mode 100644
index 0000000000..77f08575b1
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/T14552.hs
@@ -0,0 +1,43 @@
+{-# Language RankNTypes, ViewPatterns, PatternSynonyms, TypeOperators, ScopedTypeVariables,
+             KindSignatures, PolyKinds, DataKinds, TypeFamilies, TypeInType, GADTs #-}
+
+module T14552 where
+
+import Data.Kind
+import Data.Proxy
+
+data family Sing a
+
+type a --> b = (a, b) -> Type
+
+type family F (f::a --> b) (x::a) :: b
+
+newtype Limit :: (k --> Type) -> Type where
+  Limit :: (forall xx. Proxy xx -> F f xx) -> Limit f
+
+data Exp :: [Type] -> Type -> Type where
+  TLam :: (forall aa. Proxy aa -> Exp xs (F w aa))
+        -> Exp xs (Limit w)
+
+pattern FOO f <- TLam (($ Proxy) -> f)
+
+
+{-
+TLam :: forall (xs::[Type]) (b::Type).   -- Universal
+         forall k (w :: k --> Type).      -- Existential
+         (b ~ Limit w) =>
+         => (forall (aa :: k). Proxy aa -> Exp xs (F w aa))
+         -> Exp xs b
+
+-}
+
+{-
+mfoo :: Exp xs b
+     -> (forall k (w :: k --> Type).
+         (b ~ Limit w)
+         => Exp xs (F w aa)
+         -> r)
+     -> r
+mfoo scrut k = case srcut of
+                 TLam g -> k (g Proxy)
+-}
diff --git a/testsuite/tests/patsyn/should_fail/T14552.stderr b/testsuite/tests/patsyn/should_fail/T14552.stderr
new file mode 100644
index 0000000000..1ead6443b4
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/T14552.stderr
@@ -0,0 +1,9 @@
+
+T14552.hs:22:9: error:
+    • Universal type variable ‘aa’ has existentially bound kind:
+        aa :: k
+      Existentially-bound variables:
+        k :: *
+        w :: k --> *
+      Probable fix: give the pattern synoym a type signature
+    • In the declaration for pattern synonym ‘FOO’
diff --git a/testsuite/tests/patsyn/should_fail/all.T b/testsuite/tests/patsyn/should_fail/all.T
index 4bf631f982..d2985d5e14 100644
--- a/testsuite/tests/patsyn/should_fail/all.T
+++ b/testsuite/tests/patsyn/should_fail/all.T
@@ -40,3 +40,4 @@ test('T14112', normal, compile_fail, [''])
 test('T14114', normal, compile_fail, [''])
 test('T14380', normal, compile_fail, [''])
 test('T14498', normal, compile_fail, [''])
+test('T14552', normal, compile_fail, [''])