Fix unboxed tuple size limit (#17837)

3 files changed, 55 insertions, 3 deletions

diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index 82681a9206..964b49412a 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -65,7 +65,7 @@ import DataCon
 import TyCon
 import ErrUtils         ( MsgDoc )
 import PrelNames        ( rOOT_MAIN )
-import BasicTypes       ( pprWarningTxtForMsg, TopLevelFlag(..))
+import BasicTypes       ( pprWarningTxtForMsg, TopLevelFlag(..), TupleSort(..) )
 import SrcLoc
 import Outputable
 import UniqSet          ( uniqSetAny )
@@ -298,8 +298,13 @@ lookupExactOcc_either name
                     ATyCon tc                 -> Just tc
                     AConLike (RealDataCon dc) -> Just (dataConTyCon dc)
                     _                         -> Nothing
-  , isTupleTyCon tycon
-  = do { checkTupSize (tyConArity tycon)
+  , Just tupleSort <- tyConTuple_maybe tycon
+  = do { let tupArity = case tupleSort of
+               -- Unboxed tuples have twice as many arguments because of the
+               -- 'RuntimeRep's (#17837)
+               UnboxedTuple -> tyConArity tycon `div` 2
+               _ -> tyConArity tycon
+       ; checkTupSize tupArity
        ; return (Right name) }
 
   | isExternalName name
diff --git a/testsuite/tests/rename/should_compile/T17837.hs b/testsuite/tests/rename/should_compile/T17837.hs
new file mode 100644
index 0000000000..2bc3dfbe61
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T17837.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE UnboxedTuples #-}
+
+module T17837 where
+
+type UTup62 = (#,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,#)
+
+makeUTup62
+  :: t00 -> t01 -> t02 -> t03 -> t04 -> t05 -> t06 -> t07 -> t08 -> t09
+  -> t10 -> t11 -> t12 -> t13 -> t14 -> t15 -> t16 -> t17 -> t18 -> t19
+  -> t20 -> t21 -> t22 -> t23 -> t24 -> t25 -> t26 -> t27 -> t28 -> t29
+  -> t30 -> t31 -> t32 -> t33 -> t34 -> t35 -> t36 -> t37 -> t38 -> t39
+  -> t40 -> t41 -> t42 -> t43 -> t44 -> t45 -> t46 -> t47 -> t48 -> t49
+  -> t50 -> t51 -> t52 -> t53 -> t54 -> t55 -> t56 -> t57 -> t58 -> t59
+  -> t60 -> t61
+  -> (# t00,t01,t02,t03,t04,t05,t06,t07,t08,t09,t10,t11,t12,t13,t14,t15,
+        t16,t17,t18,t19,t20,t21,t22,t23,t24,t25,t26,t27,t28,t29,t30,t31,
+        t32,t33,t34,t35,t36,t37,t38,t39,t40,t41,t42,t43,t44,t45,t46,t47,
+        t48,t49,t50,t51,t52,t53,t54,t55,t56,t57,t58,t59,t60,t61 #)
+makeUTup62
+  x00 x01 x02 x03 x04 x05 x06 x07 x08 x09 x10 x11 x12 x13 x14 x15
+  x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 x29 x30 x31
+  x32 x33 x34 x35 x36 x37 x38 x39 x40 x41 x42 x43 x44 x45 x46 x47
+  x48 x49 x50 x51 x52 x53 x54 x55 x56 x57 x58 x59 x60 x61 =
+  (# x00,x01,x02,x03,x04,x05,x06,x07,x08,x09,x10,x11,x12,x13,x14,x15,
+     x16,x17,x18,x19,x20,x21,x22,x23,x24,x25,x26,x27,x28,x29,x30,x31,
+     x32,x33,x34,x35,x36,x37,x38,x39,x40,x41,x42,x43,x44,x45,x46,x47,
+     x48,x49,x50,x51,x52,x53,x54,x55,x56,x57,x58,x59,x60,x61 #)
+
+uTup62id
+  :: (# t00,t01,t02,t03,t04,t05,t06,t07,t08,t09,t10,t11,t12,t13,t14,t15,
+        t16,t17,t18,t19,t20,t21,t22,t23,t24,t25,t26,t27,t28,t29,t30,t31,
+        t32,t33,t34,t35,t36,t37,t38,t39,t40,t41,t42,t43,t44,t45,t46,t47,
+        t48,t49,t50,t51,t52,t53,t54,t55,t56,t57,t58,t59,t60,t61 #)
+  -> (# t00,t01,t02,t03,t04,t05,t06,t07,t08,t09,t10,t11,t12,t13,t14,t15,
+        t16,t17,t18,t19,t20,t21,t22,t23,t24,t25,t26,t27,t28,t29,t30,t31,
+        t32,t33,t34,t35,t36,t37,t38,t39,t40,t41,t42,t43,t44,t45,t46,t47,
+        t48,t49,t50,t51,t52,t53,t54,t55,t56,t57,t58,t59,t60,t61 #)
+uTup62id
+  (# x00,x01,x02,x03,x04,x05,x06,x07,x08,x09,x10,x11,x12,x13,x14,x15,
+     x16,x17,x18,x19,x20,x21,x22,x23,x24,x25,x26,x27,x28,x29,x30,x31,
+     x32,x33,x34,x35,x36,x37,x38,x39,x40,x41,x42,x43,x44,x45,x46,x47,
+     x48,x49,x50,x51,x52,x53,x54,x55,x56,x57,x58,x59,x60,x61 #) =
+  (# x00,x01,x02,x03,x04,x05,x06,x07,x08,x09,x10,x11,x12,x13,x14,x15,
+     x16,x17,x18,x19,x20,x21,x22,x23,x24,x25,x26,x27,x28,x29,x30,x31,
+     x32,x33,x34,x35,x36,x37,x38,x39,x40,x41,x42,x43,x44,x45,x46,x47,
+     x48,x49,x50,x51,x52,x53,x54,x55,x56,x57,x58,x59,x60,x61 #)
diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T
index b461d09076..4c295b20a3 100644
--- a/testsuite/tests/rename/should_compile/all.T
+++ b/testsuite/tests/rename/should_compile/all.T
@@ -172,3 +172,4 @@ test('T15957', normal, compile, ['-Werror -Wredundant-record-wildcards -Wunused-
 test('T17244A', normal, compile, ['-Wno-error=compat-unqualified-imports'])
 test('T17244B', normal, compile, [''])
 test('T17244C', normal, compile, [''])
+test('T17837', normal, compile, [''])