Check for large tuples more thoroughlywip/T18723

This fixes #18723 by:

* Moving the existing `GHC.Tc.Gen.HsType.bigConstraintTuple` validity
  check to `GHC.Rename.Utils.checkCTupSize` for consistency with
  `GHC.Rename.Utils.checkTupSize`, and
* Using `check(C)TupSize` when checking tuple _types_, in addition
  to checking names, expressions, and patterns.

Note that I put as many of these checks as possible in the typechecker so
that GHC can properly distinguish between boxed and constraint tuples. The
exception to this rule is checking names, which I perform in the renamer
(in `GHC.Rename.Env`) so that we can rule out `(,, ... ,,)` and
`''(,, ... ,,)` alike in one fell swoop.

While I was in town, I also removed the `HsConstraintTuple` and
`HsBoxedTuple` constructors of `HsTupleSort`, which are functionally
unused. This requires a `haddock` submodule bump.

3 files changed, 17 insertions, 25 deletions

diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index 564ad46660..5d919280f0 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -32,6 +32,7 @@ import GHC.Prelude
 import {-# SOURCE #-}   GHC.Tc.Gen.Splice( tcSpliceExpr, tcTypedBracket, tcUntypedBracket )
 
 import GHC.Hs
+import GHC.Rename.Utils
 import GHC.Tc.Utils.Zonk
 import GHC.Tc.Utils.Monad
 import GHC.Tc.Utils.Unify
@@ -1036,7 +1037,9 @@ arithSeqEltType (Just fl) res_ty
 ----------------
 tcTupArgs :: [LHsTupArg GhcRn] -> [TcSigmaType] -> TcM [LHsTupArg GhcTc]
 tcTupArgs args tys
-  = ASSERT( equalLength args tys ) mapM go (args `zip` tys)
+  = do MASSERT( equalLength args tys )
+       checkTupSize (length args)
+       mapM go (args `zip` tys)
   where
     go (L l (Missing {}),     arg_ty) = do { mult <- newFlexiTyVarTy multiplicityTy
                                            ; return (L l (Missing (Scaled mult arg_ty))) }
diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs
index e599ad56f8..9c67345b7f 100644
--- a/compiler/GHC/Tc/Gen/HsType.hs
+++ b/compiler/GHC/Tc/Gen/HsType.hs
@@ -71,6 +71,7 @@ module GHC.Tc.Gen.HsType (
 import GHC.Prelude
 
 import GHC.Hs
+import GHC.Rename.Utils
 import GHC.Tc.Utils.Monad
 import GHC.Tc.Types.Origin
 import GHC.Core.Predicate
@@ -103,8 +104,6 @@ import GHC.Types.Var.Env
 import GHC.Builtin.Types
 import GHC.Types.Basic
 import GHC.Types.SrcLoc
-import GHC.Settings.Constants ( mAX_CTUPLE_SIZE )
-import GHC.Utils.Error( MsgDoc )
 import GHC.Types.Unique
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Set
@@ -1133,16 +1132,8 @@ tc_hs_type mode rn_ty@(HsTupleTy _ HsBoxedOrConstraintTuple hs_tys) exp_kind
        ; finish_tuple rn_ty tup_sort tys' (map (const arg_kind) tys') exp_kind }
 
 
-tc_hs_type mode rn_ty@(HsTupleTy _ hs_tup_sort tys) exp_kind
-  = tc_tuple rn_ty mode tup_sort tys exp_kind
-  where
-    tup_sort = case hs_tup_sort of  -- Fourth case dealt with above
-                  HsUnboxedTuple    -> UnboxedTuple
-                  HsBoxedTuple      -> BoxedTuple
-                  HsConstraintTuple -> ConstraintTuple
-#if __GLASGOW_HASKELL__ <= 810
-                  _                 -> panic "tc_hs_type HsTupleTy"
-#endif
+tc_hs_type mode rn_ty@(HsTupleTy _ HsUnboxedTuple tys) exp_kind
+  = tc_tuple rn_ty mode UnboxedTuple tys exp_kind
 
 tc_hs_type mode rn_ty@(HsSumTy _ hs_tys) exp_kind
   = do { let arity = length hs_tys
@@ -1173,6 +1164,7 @@ tc_hs_type mode rn_ty@(HsExplicitTupleTy _ tys) exp_kind
        ; let kind_con   = tupleTyCon           Boxed arity
              ty_con     = promotedTupleDataCon Boxed arity
              tup_k      = mkTyConApp kind_con ks
+       ; checkTupSize arity
        ; checkExpectedKind rn_ty (mkTyConApp ty_con (ks ++ taus)) tup_k exp_kind }
   where
     arity = length tys
@@ -1327,33 +1319,28 @@ finish_tuple rn_ty tup_sort tau_tys tau_kinds exp_kind = do
          -- Drop any uses of 1-tuple constraints here.
          -- See Note [Ignore unary constraint tuples]
       -> check_expected_kind tau_ty constraintKind
-      |  arity > mAX_CTUPLE_SIZE
-      -> failWith (bigConstraintTuple arity)
       |  otherwise
-      -> let tycon = cTupleTyCon arity in
-         check_expected_kind (mkTyConApp tycon tau_tys) constraintKind
+      -> do let tycon = cTupleTyCon arity
+            checkCTupSize arity
+            check_expected_kind (mkTyConApp tycon tau_tys) constraintKind
     BoxedTuple -> do
       let tycon = tupleTyCon Boxed arity
+      checkTupSize arity
       checkWiredInTyCon tycon
       check_expected_kind (mkTyConApp tycon tau_tys) liftedTypeKind
-    UnboxedTuple ->
+    UnboxedTuple -> do
       let tycon    = tupleTyCon Unboxed arity
           tau_reps = map kindRep tau_kinds
           -- See also Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon
           arg_tys  = tau_reps ++ tau_tys
-          res_kind = unboxedTupleKind tau_reps in
+          res_kind = unboxedTupleKind tau_reps
+      checkTupSize arity
       check_expected_kind (mkTyConApp tycon arg_tys) res_kind
   where
     arity = length tau_tys
     check_expected_kind ty act_kind =
       checkExpectedKind rn_ty ty act_kind exp_kind
 
-bigConstraintTuple :: Arity -> MsgDoc
-bigConstraintTuple arity
-  = hang (text "Constraint tuple arity too large:" <+> int arity
-          <+> parens (text "max arity =" <+> int mAX_CTUPLE_SIZE))
-       2 (text "Instead, use a nested tuple")
-
 {-
 Note [Ignore unary constraint tuples]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/GHC/Tc/Gen/Pat.hs b/compiler/GHC/Tc/Gen/Pat.hs
index 4ee4480c60..dba5bf5874 100644
--- a/compiler/GHC/Tc/Gen/Pat.hs
+++ b/compiler/GHC/Tc/Gen/Pat.hs
@@ -32,6 +32,7 @@ import GHC.Prelude
 import {-# SOURCE #-}   GHC.Tc.Gen.Expr( tcSyntaxOp, tcSyntaxOpGen, tcInferRho )
 
 import GHC.Hs
+import GHC.Rename.Utils
 import GHC.Tc.Utils.Zonk
 import GHC.Tc.Gen.Sig( TcPragEnv, lookupPragEnv, addInlinePrags )
 import GHC.Tc.Utils.Monad
@@ -509,6 +510,7 @@ Fortunately that's what matchExpectedFunTySigma returns anyway.
               tc = tupleTyCon boxity arity
               -- NB: tupleTyCon does not flatten 1-tuples
               -- See Note [Don't flatten tuples from HsSyn] in GHC.Core.Make
+        ; checkTupSize arity
         ; (coi, arg_tys) <- matchExpectedPatTy (matchExpectedTyConApp tc)
                                                penv (scaledThing pat_ty)
                      -- Unboxed tuples have RuntimeRep vars, which we discard: