Rip out 9-year-old pattern variable hack (#17007)

GHC had an ad hoc validity check in place to rule out pattern
variables bound by type synonyms, such as in the following example:

```hs
type ItemColID a b = Int  -- Discards a,b

get :: ItemColID a b -> ItemColID a b
get (x :: ItemColID a b) = x :: ItemColID a b
```

This hack is wholly unnecessary nowadays, since OutsideIn(X) is more
than capable of instantiating `a` and `b` to `Any`. In light of this,
let's rip out this validity check.

Fixes #17007.

4 files changed, 23 insertions, 37 deletions

diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs
index f067236be6..dd6357ef68 100644
--- a/compiler/typecheck/TcHsType.hs
+++ b/compiler/typecheck/TcHsType.hs
@@ -2787,17 +2787,6 @@ tcPatSig in_pat_bind sig res_ty
                 -- than in the renamer
         { when in_pat_bind (addErr (patBindSigErr sig_tvs))
 
-                -- Check that all newly-in-scope tyvars are in fact
-                -- constrained by the pattern.  This catches tiresome
-                -- cases like
-                --      type T a = Int
-                --      f :: Int -> Int
-                --      f (x :: T a) = ...
-                -- Here 'a' doesn't get a binding.  Sigh
-        ; let bad_tvs = filterOut (`elemVarSet` exactTyCoVarsOfType sig_ty)
-                                  (tyCoVarsOfTypeList sig_ty)
-        ; checkTc (null bad_tvs) (badPatTyVarTvs sig_ty bad_tvs)
-
         -- Now do a subsumption check of the pattern signature against res_ty
         ; wrap <- addErrCtxtM (mk_msg sig_ty) $
                   tcSubTypeET PatSigOrigin PatSigCtxt res_ty sig_ty
@@ -3003,23 +2992,6 @@ promotionErr name err
 {-
 ************************************************************************
 *                                                                      *
-                Scoped type variables
-*                                                                      *
-************************************************************************
--}
-
-badPatTyVarTvs :: TcType -> [TyVar] -> SDoc
-badPatTyVarTvs sig_ty bad_tvs
-  = vcat [ fsep [text "The type variable" <> plural bad_tvs,
-                 quotes (pprWithCommas ppr bad_tvs),
-                 text "should be bound by the pattern signature" <+> quotes (ppr sig_ty),
-                 text "but are actually discarded by a type synonym" ]
-         , text "To fix this, expand the type synonym"
-         , text "[Note: I hope to lift this restriction in due course]" ]
-
-{-
-************************************************************************
-*                                                                      *
           Error messages and such
 *                                                                      *
 ************************************************************************
diff --git a/testsuite/tests/typecheck/should_compile/T17007.hs b/testsuite/tests/typecheck/should_compile/T17007.hs
new file mode 100644
index 0000000000..21b7639dd0
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T17007.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+module T17007 where
+
+type ItemColID a b = Int  -- Discards a,b
+
+get :: ItemColID a b -> ItemColID a b
+get (x :: ItemColID a b) = x :: ItemColID a b
+
+type family ItemColID' a b where ItemColID' a b = Int  -- Discards a,b
+
+get' :: ItemColID' a b -> ItemColID' a b
+get' (x :: ItemColID' a b) = x :: ItemColID' a b
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 9e9d48659d..e393fe41c7 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -685,3 +685,4 @@ test('UnliftedNewtypesLPFamily', normal, compile, [''])
 test('UnliftedNewtypesDifficultUnification', normal, compile, [''])
 test('T16832', normal, ghci_script, ['T16832.script'])
 test('T16946', normal, compile, [''])
+test('T17007', normal, compile, [''])
diff --git a/testsuite/tests/typecheck/should_fail/T3406.stderr b/testsuite/tests/typecheck/should_fail/T3406.stderr
index 4525bba5d6..69834d15f6 100644
--- a/testsuite/tests/typecheck/should_fail/T3406.stderr
+++ b/testsuite/tests/typecheck/should_fail/T3406.stderr
@@ -1,10 +1,10 @@
 
-T3406.hs:11:6:
-    The type variables ‘a, b’
-    should be bound by the pattern signature ‘ItemColID a b’
-    but are actually discarded by a type synonym
-    To fix this, expand the type synonym
-    [Note: I hope to lift this restriction in due course]
-    In the pattern: x :: ItemColID a b
-    In an equation for ‘get’:
-        get (x :: ItemColID a b) = x :: ItemColID a b
+T3406.hs:11:28: error:
+    • Couldn't match type ‘Int’ with ‘a -> ItemColID a b’
+      Expected type: a -> ItemColID a b
+        Actual type: ItemColID a1 b1
+    • In the expression: x :: ItemColID a b
+      In an equation for ‘get’:
+          get (x :: ItemColID a b) = x :: ItemColID a b
+    • Relevant bindings include
+        get :: ItemColID a b -> a -> ItemColID a b (bound at T3406.hs:11:1)