Don't generalize when typechecking a tuple section

The code is simpler and cleaner.

6 files changed, 19 insertions, 35 deletions

diff --git a/compiler/GHC/Builtin/Types/Prim.hs b/compiler/GHC/Builtin/Types/Prim.hs
index aa4ba96c8e..559ad3e083 100644
--- a/compiler/GHC/Builtin/Types/Prim.hs
+++ b/compiler/GHC/Builtin/Types/Prim.hs
@@ -27,7 +27,6 @@ module GHC.Builtin.Types.Prim(
         openAlphaTy, openBetaTy, openAlphaTyVar, openBetaTyVar,
 
         multiplicityTyVar,
-        multiplicityTyVarList,
 
         -- Kind constructors...
         tYPETyCon, tYPETyConName,
@@ -392,11 +391,6 @@ openBetaTy  = mkTyVarTy openBetaTyVar
 multiplicityTyVar :: TyVar
 multiplicityTyVar = mkTemplateTyVars (repeat multiplicityTy) !! 13  -- selects 'n'
 
--- Create 'count' multiplicity TyVars
-multiplicityTyVarList :: Int -> [TyVar]
-multiplicityTyVarList count = take count $
-                              drop 13 $  -- selects 'n', 'o'...
-                              mkTemplateTyVars (repeat multiplicityTy)
 {-
 ************************************************************************
 *                                                                      *
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index ffe23e5588..9f5e6a7ef2 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -740,7 +740,7 @@ type instance XPresent         (GhcPass _) = NoExtField
 
 type instance XMissing         GhcPs = NoExtField
 type instance XMissing         GhcRn = NoExtField
-type instance XMissing         GhcTc = Type
+type instance XMissing         GhcTc = Scaled Type
 
 type instance XXTupArg         (GhcPass _) = NoExtCon
 
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index f757ba6f2b..fe60d06f83 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -64,7 +64,6 @@ import GHC.Types.Basic
 import GHC.Data.Maybe
 import GHC.Types.Var.Env
 import GHC.Types.SrcLoc
-import GHC.Builtin.Types.Prim ( mkTemplateTyVars )
 import GHC.Utils.Misc
 import GHC.Data.Bag
 import GHC.Utils.Outputable as Outputable
@@ -427,26 +426,22 @@ dsExpr e@(SectionR _ op expr) = do
                                                           core_op [Var x_id, Var y_id]))
 
 dsExpr (ExplicitTuple _ tup_args boxity)
-  = do { let go (lam_vars, args, usedmults, mult:mults) (L _ (Missing ty))
+  = do { let go (lam_vars, args) (L _ (Missing (Scaled mult ty)))
                     -- For every missing expression, we need
-                    -- another lambda in the desugaring. This lambda is linear
-                    -- since tuples are linear
-               = do { lam_var <- newSysLocalDsNoLP (mkTyVarTy mult) ty
-                    ; return (lam_var : lam_vars, Var lam_var : args, mult:usedmults, mults) }
-             go (lam_vars, args, missing, mults) (L _ (Present _ expr))
+                    -- another lambda in the desugaring.
+               = do { lam_var <- newSysLocalDsNoLP mult ty
+                    ; return (lam_var : lam_vars, Var lam_var : args) }
+             go (lam_vars, args) (L _ (Present _ expr))
                     -- Expressions that are present don't generate
                     -- lambdas, just arguments.
                = do { core_expr <- dsLExprNoLP expr
-                    ; return (lam_vars, core_expr : args, missing, mults) }
-             go (lam_vars, args, missing, mults) _ = pprPanic "dsExpr" (ppr lam_vars <+> ppr args <+> ppr missing <+> ppr mults)
+                    ; return (lam_vars, core_expr : args) }
 
-       ; let multiplicityVars = mkTemplateTyVars (repeat multiplicityTy)
-       ; dsWhenNoErrs (foldM go ([], [], [], multiplicityVars) (reverse tup_args))
+       ; dsWhenNoErrs (foldM go ([], []) (reverse tup_args))
                 -- The reverse is because foldM goes left-to-right
-                      (\(lam_vars, args, usedmults, _) ->
-                      mkCoreLams usedmults $
+                      (\(lam_vars, args) ->
                         mkCoreLams lam_vars $
-                                            mkCoreTupBoxity boxity args) }
+                          mkCoreTupBoxity boxity args) }
                         -- See Note [Don't flatten tuples from HsSyn] in GHC.Core.Make
 
 dsExpr (ExplicitSum types alt arity expr)
diff --git a/compiler/GHC/HsToCore/Match.hs b/compiler/GHC/HsToCore/Match.hs
index dc8f87b91d..6bff5e826f 100644
--- a/compiler/GHC/HsToCore/Match.hs
+++ b/compiler/GHC/HsToCore/Match.hs
@@ -1109,7 +1109,7 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2
 
     ---------
     tup_arg (L _ (Present _ e1)) (L _ (Present _ e2)) = lexp e1 e2
-    tup_arg (L _ (Missing t1))   (L _ (Missing t2))   = eqType t1 t2
+    tup_arg (L _ (Missing (Scaled _ t1)))   (L _ (Missing (Scaled _ t2)))   = eqType t1 t2
     tup_arg _ _ = False
 
     ---------
diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index 954403f7ae..d970b3e0b2 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -71,7 +71,6 @@ import GHC.Core.Type
 import GHC.Tc.Types.Evidence
 import GHC.Types.Var.Set
 import GHC.Builtin.Types
-import GHC.Builtin.Types.Prim( multiplicityTyVarList )
 import GHC.Builtin.PrimOps( tagToEnumKey )
 import GHC.Builtin.Names
 import GHC.Driver.Session
@@ -500,22 +499,17 @@ tcExpr expr@(ExplicitTuple x tup_args boxity) res_ty
        -- Handle tuple sections where
        ; tup_args1 <- tcTupArgs tup_args arg_tys
 
-       ; let expr'      = ExplicitTuple x tup_args1 boxity
+       ; let expr'       = ExplicitTuple x tup_args1 boxity
+             missing_tys = [Scaled mult ty | (L _ (Missing (Scaled mult _)), ty) <- zip tup_args1 arg_tys]
 
-             missing_tys = [ty | (ty, L _ (Missing _)) <- zip arg_tys tup_args]
-             w_tyvars = multiplicityTyVarList (length missing_tys)
-               -- See Note [Linear fields generalization]
-             w_tvb = map (mkTyVarBinder Inferred) w_tyvars
+             -- See Note [Linear fields generalization]
              act_res_ty
-                 =  mkForAllTys w_tvb $
-                    mkVisFunTys [ mkScaled (mkTyVarTy w_ty) ty |
-                              (ty, w_ty) <- zip missing_tys w_tyvars]
-                            (mkTupleTy1 boxity arg_tys)
+                 = mkVisFunTys missing_tys (mkTupleTy1 boxity arg_tys)
                    -- See Note [Don't flatten tuples from HsSyn] in GHC.Core.Make
 
        ; traceTc "ExplicitTuple" (ppr act_res_ty $$ ppr res_ty)
 
-       ; tcWrapResult expr expr' act_res_ty res_ty }
+       ; tcWrapResultMono expr expr' act_res_ty res_ty }
 
 tcExpr (ExplicitSum _ alt arity expr) res_ty
   = do { let sum_tc = sumTyCon arity
@@ -1557,7 +1551,8 @@ tcTupArgs :: [LHsTupArg GhcRn] -> [TcSigmaType] -> TcM [LHsTupArg GhcTc]
 tcTupArgs args tys
   = ASSERT( equalLength args tys ) mapM go (args `zip` tys)
   where
-    go (L l (Missing {}),   arg_ty) = return (L l (Missing arg_ty))
+    go (L l (Missing {}),   arg_ty) = do { mult <- newFlexiTyVarTy multiplicityTy
+                                         ; return (L l (Missing (Scaled mult arg_ty))) }
     go (L l (Present x expr), arg_ty) = do { expr' <- tcCheckPolyExpr expr arg_ty
                                            ; return (L l (Present x expr')) }
 
diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs
index a65cf6564e..c23d1a9e21 100644
--- a/compiler/GHC/Tc/Utils/Zonk.hs
+++ b/compiler/GHC/Tc/Utils/Zonk.hs
@@ -811,7 +811,7 @@ zonkExpr env (ExplicitTuple x tup_args boxed)
   where
     zonk_tup_arg (L l (Present x e)) = do { e' <- zonkLExpr env e
                                           ; return (L l (Present x e')) }
-    zonk_tup_arg (L l (Missing t)) = do { t' <- zonkTcTypeToTypeX env t
+    zonk_tup_arg (L l (Missing t)) = do { t' <- zonkScaledTcTypeToTypeX env t
                                         ; return (L l (Missing t')) }