Fix instantiation of pattern synonyms

In Check.hs (pattern match ovelap checking) we to figure out the
instantiation of a pattern synonym from the type of the pattern. We
were doing this utterly wrongly.  Trac #13768 demonstrated this
bogosity.

The fix is easy; and is described in PatSyn.hs
  Note [Pattern synonym result type]

2 files changed, 34 insertions, 0 deletions

diff --git a/testsuite/tests/patsyn/should_compile/T13768.hs b/testsuite/tests/patsyn/should_compile/T13768.hs
new file mode 100644
index 0000000000..c4510bd20a
--- /dev/null
+++ b/testsuite/tests/patsyn/should_compile/T13768.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE ViewPatterns #-}
+module T13768 where
+
+data NS (f :: k -> *) (xs :: [k]) = NS Int
+
+data IsNS (f :: k -> *) (xs :: [k]) where
+  IsZ :: f x -> IsNS f (x ': xs)
+  IsS :: NS f xs -> IsNS f (x ': xs)
+
+isNS :: NS f xs -> IsNS f xs
+isNS = undefined
+
+pattern Z :: () => (xs' ~ (x ': xs)) => f x -> NS f xs'
+pattern Z x <- (isNS -> IsZ x)
+
+pattern S :: () => (xs' ~ (x ': xs)) => NS f xs -> NS f xs'
+pattern S p <- (isNS -> IsS p)
+
+{-# COMPLETE Z, S #-}
+
+data SList :: [k] -> * where
+  SNil  :: SList '[]
+  SCons :: SList (x ': xs)
+
+go :: SList ys -> NS f ys -> Int
+go SCons (Z _) = 0
+go SCons (S _) = 1
+go SNil  _     = error "inaccessible"
diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T
index 30319c7050..286f735ac6 100644
--- a/testsuite/tests/patsyn/should_compile/all.T
+++ b/testsuite/tests/patsyn/should_compile/all.T
@@ -70,3 +70,4 @@ test('T13441b', normal, compile_fail, [''])
 test('T13454', normal, compile, [''])
 test('T13752', normal, compile, [''])
 test('T13752a', normal, compile, [''])
+test('T13768', normal, compile, [''])