Various performance improvements

This implements several general performance improvements to GHC,
to offset the effect of the linear types change.

General optimisations:
- Add a `coreFullView` function which iterates `coreView` on the
  head. This avoids making function recursive solely because the
  iterate `coreView` themselves. As a consequence, this functions can
  be inlined, and trigger case-of-known constructor (_e.g._
  `kindRep_maybe`, `isLiftedRuntimeRep`, `isMultiplicityTy`,
  `getTyVar_maybe`, `splitAppTy_maybe`, `splitFunType_maybe`,
  `tyConAppTyCon_maybe`). The common pattern about all these functions
  is that they are almost always used as views, and immediately
  consumed by a case expression. This commit also mark them asx `INLINE`.
- In `subst_ty` add a special case for nullary `TyConApp`, which avoid
  allocations altogether.
- Use `mkTyConApp` in `subst_ty` for the general `TyConApp`. This
  required quite a bit of module shuffling.
  case. `myTyConApp` enforces crucial sharing, which was lost during
  substitution. See also !2952 .
- Make `subst_ty` stricter.
- In `eqType` (specifically, in `nonDetCmpType`), add a special case,
  tested first, for the very common case of nullary `TyConApp`.
  `nonDetCmpType` has been made `INLINE` otherwise it is actually a
  regression. This is similar to the optimisations in !2952.

Linear-type specific optimisations:
- Use `tyConAppTyCon_maybe` instead of the more complex `eqType` in
  the definition of the pattern synonyms `One` and `Many`.
- Break the `hs-boot` cycles between `Multiplicity.hs` and `Type.hs`:
  `Multiplicity` now import `Type` normally, rather than from the
  `hs-boot`. This way `tyConAppTyCon_maybe` can inline properly in the
  `One` and `Many` pattern synonyms.
- Make `updateIdTypeAndMult` strict in its type and multiplicity
- The `scaleIdBy` gets a specialised definition rather than being an
  alias to `scaleVarBy`
- `splitFunTy_maybe` is given the type `Type -> Maybe (Mult, Type,
  Type)` instead of `Type -> Maybe (Scaled Type, Type)`
- Remove the `MultMul` pattern synonym in favour of a view `isMultMul`
  because pattern synonyms appear not to inline well.
- in `eqType`, in a `FunTy`, compare multiplicities last: they are
  almost always both `Many`, so it helps failing faster.
- Cache `manyDataConTy` in `mkTyConApp`, to make sure that all the
  instances of `TyConApp ManyDataConTy []` are physically the same.

This commit has been authored by
* Richard Eisenberg
* Krzysztof Gogolewski
* Arnaud Spiwack

Metric Decrease:
    haddock.base
    T12227
    T12545
    T12990
    T1969
    T3064
    T5030
    T9872b

Metric Increase:
    haddock.base
    haddock.Cabal
    haddock.compiler
    T12150
    T12234
    T12425
    T12707
    T13035
    T13056
    T15164
    T16190
    T18304
    T1969
    T3064
    T3294
    T5631
    T5642
    T5837
    T6048
    T9020
    T9233
    T9675
    T9872a
    T9961
    WWRec

66 files changed, 612 insertions, 559 deletions

diff --git a/compiler/GHC/Builtin/Types.hs b/compiler/GHC/Builtin/Types.hs
index 37d47e735d..8d4b576993 100644
--- a/compiler/GHC/Builtin/Types.hs
+++ b/compiler/GHC/Builtin/Types.hs
@@ -161,7 +161,6 @@ import GHC.Core.DataCon
 import {-# SOURCE #-} GHC.Core.ConLike
 import GHC.Core.TyCon
 import GHC.Core.Class     ( Class, mkClass )
-import GHC.Core.Multiplicity
 import GHC.Types.Name.Reader
 import GHC.Types.Name as Name
 import GHC.Types.Name.Env ( NameEnv, mkNameEnv, lookupNameEnv, lookupNameEnv_NF )
diff --git a/compiler/GHC/Core/Coercion.hs b/compiler/GHC/Core/Coercion.hs
index 6b28adf371..03e0d59f38 100644
--- a/compiler/GHC/Core/Coercion.hs
+++ b/compiler/GHC/Core/Coercion.hs
@@ -134,6 +134,7 @@ import GHC.Core.TyCo.Tidy
 import GHC.Core.Type
 import GHC.Core.TyCon
 import GHC.Core.Coercion.Axiom
+import {-# SOURCE #-} GHC.Core.Utils ( mkFunctionType )
 import GHC.Types.Var
 import GHC.Types.Var.Env
 import GHC.Types.Var.Set
@@ -149,7 +150,6 @@ import GHC.Builtin.Types.Prim
 import GHC.Data.List.SetOps
 import GHC.Data.Maybe
 import GHC.Types.Unique.FM
-import GHC.Core.Multiplicity
 
 import Control.Monad (foldM, zipWithM)
 import Data.Function ( on )
@@ -397,8 +397,8 @@ decomposePiCos orig_co (Pair orig_k1 orig_k2) orig_args
         in
         go (arg_co : acc_arg_cos) (subst1', t1) res_co (subst2', t2) tys
 
-      | Just (_s1, t1) <- splitFunTy_maybe k1
-      , Just (_s2, t2) <- splitFunTy_maybe k2
+      | Just (_w1, _s1, t1) <- splitFunTy_maybe k1
+      , Just (_w1, _s2, t2) <- splitFunTy_maybe k2
         -- know     co :: (s1 -> t1) ~ (s2 -> t2)
         --    function :: s1 -> t1
         --          ty :: s2
diff --git a/compiler/GHC/Core/DataCon.hs-boot b/compiler/GHC/Core/DataCon.hs-boot
index 70c8328da1..831392e9ba 100644
--- a/compiler/GHC/Core/DataCon.hs-boot
+++ b/compiler/GHC/Core/DataCon.hs-boot
@@ -8,8 +8,7 @@ import GHC.Types.FieldLabel ( FieldLabel )
 import GHC.Types.Unique ( Uniquable )
 import GHC.Utils.Outputable ( Outputable, OutputableBndr )
 import GHC.Types.Basic (Arity)
-import {-# SOURCE #-} GHC.Core.TyCo.Rep ( Type, ThetaType )
-import GHC.Core.Multiplicity (Scaled)
+import {-# SOURCE #-} GHC.Core.TyCo.Rep ( Type, ThetaType, Scaled )
 
 data DataCon
 data DataConRep
diff --git a/compiler/GHC/Core/FVs.hs b/compiler/GHC/Core/FVs.hs
index 5d65eec042..700f961b9a 100644
--- a/compiler/GHC/Core/FVs.hs
+++ b/compiler/GHC/Core/FVs.hs
@@ -76,7 +76,6 @@ import GHC.Core.TyCo.FVs
 import GHC.Core.TyCon
 import GHC.Core.Coercion.Axiom
 import GHC.Core.FamInstEnv
-import GHC.Core.Multiplicity
 import GHC.Builtin.Types( unrestrictedFunTyConName )
 import GHC.Builtin.Types.Prim( funTyConName )
 import GHC.Data.Maybe( orElse )
diff --git a/compiler/GHC/Core/FamInstEnv.hs b/compiler/GHC/Core/FamInstEnv.hs
index 81221c25ed..a35f49b78f 100644
--- a/compiler/GHC/Core/FamInstEnv.hs
+++ b/compiler/GHC/Core/FamInstEnv.hs
@@ -1418,7 +1418,7 @@ normalise_type ty
     go ty@(FunTy { ft_mult = w, ft_arg = ty1, ft_res = ty2 })
       = do { (co1, nty1) <- go ty1
            ; (co2, nty2) <- go ty2
-           ; (wco, wty) <- go w
+           ; (wco, wty) <- withRole Nominal $ go w
            ; r <- getRole
            ; return (mkFunCo r wco co1 co2, ty { ft_mult = wty, ft_arg = nty1, ft_res = nty2 }) }
     go (ForAllTy (Bndr tcvar vis) ty)
diff --git a/compiler/GHC/Core/Lint.hs b/compiler/GHC/Core/Lint.hs
index 43c93595df..d14bc633fe 100644
--- a/compiler/GHC/Core/Lint.hs
+++ b/compiler/GHC/Core/Lint.hs
@@ -1277,7 +1277,7 @@ lintTyApp fun_ty arg_ty
 -- application.
 lintValApp :: CoreExpr -> LintedType -> LintedType -> UsageEnv -> UsageEnv -> LintM (LintedType, UsageEnv)
 lintValApp arg fun_ty arg_ty fun_ue arg_ue
-  | Just (Scaled w arg_ty', res_ty') <- splitFunTy_maybe fun_ty
+  | Just (w, arg_ty', res_ty') <- splitFunTy_maybe fun_ty
   = do { ensureEqTys arg_ty' arg_ty err1
        ; let app_ue =  addUE fun_ue (scaleUE w arg_ue)
        ; return (res_ty', app_ue) }
@@ -2743,17 +2743,18 @@ ensureSubMult actual_usage described_usage err_msg = do
     flags <- getLintFlags
     when (lf_check_linearity flags) $ case actual_usage' `submult` described_usage' of
       Submult -> return ()
-      Unknown -> case actual_usage' of
-                     MultMul m1 m2 -> ensureSubMult m1 described_usage' err_msg >>
+      Unknown -> case isMultMul actual_usage' of
+                     Just (m1, m2) -> ensureSubMult m1 described_usage' err_msg >>
                                       ensureSubMult m2 described_usage' err_msg
-                     _ -> when (not (actual_usage' `eqType` described_usage')) (addErrL err_msg)
+                     Nothing -> when (not (actual_usage' `eqType` described_usage')) (addErrL err_msg)
 
    where actual_usage' = normalize actual_usage
          described_usage' = normalize described_usage
 
          normalize :: Mult -> Mult
-         normalize (MultMul m1 m2) = mkMultMul (normalize m1) (normalize m2)
-         normalize m = m
+         normalize m = case isMultMul m of
+                         Just (m1, m2) -> mkMultMul (normalize m1) (normalize m2)
+                         Nothing -> m
 
 lintRole :: Outputable thing
           => thing     -- where the role appeared
diff --git a/compiler/GHC/Core/Make.hs b/compiler/GHC/Core/Make.hs
index 9ea1ed85e0..40911f2a89 100644
--- a/compiler/GHC/Core/Make.hs
+++ b/compiler/GHC/Core/Make.hs
@@ -165,9 +165,9 @@ mkCoreAppTyped _ (fun, fun_ty) (Coercion co)
   = (App fun (Coercion co), funResultTy fun_ty)
 mkCoreAppTyped d (fun, fun_ty) arg
   = ASSERT2( isFunTy fun_ty, ppr fun $$ ppr arg $$ d )
-    (mkValApp fun arg arg_ty res_ty, res_ty)
+    (mkValApp fun arg (Scaled mult arg_ty) res_ty, res_ty)
   where
-    (arg_ty, res_ty) = splitFunTy fun_ty
+    (mult, arg_ty, res_ty) = splitFunTy fun_ty
 
 mkValApp :: CoreExpr -> CoreExpr -> Scaled Type -> Type -> CoreExpr
 -- Build an application (e1 e2),
diff --git a/compiler/GHC/Core/Multiplicity.hs b/compiler/GHC/Core/Multiplicity.hs
index a4203fa6e0..81e84e9936 100644
--- a/compiler/GHC/Core/Multiplicity.hs
+++ b/compiler/GHC/Core/Multiplicity.hs
@@ -14,7 +14,7 @@ module GHC.Core.Multiplicity
   ( Mult
   , pattern One
   , pattern Many
-  , pattern MultMul
+  , isMultMul
   , mkMultAdd
   , mkMultMul
   , mkMultSup
@@ -34,11 +34,10 @@ module GHC.Core.Multiplicity
 
 import GHC.Prelude
 
-import Data.Data
 import GHC.Utils.Outputable
-import {-# SOURCE #-} GHC.Core.TyCo.Rep (Type)
-import {-# SOURCE #-} GHC.Builtin.Types ( oneDataConTy, manyDataConTy, multMulTyCon )
-import {-# SOURCE #-} GHC.Core.Type( eqType, splitTyConApp_maybe, mkTyConApp )
+import GHC.Core.TyCo.Rep
+import {-# SOURCE #-} GHC.Builtin.Types ( multMulTyCon )
+import GHC.Core.Type
 import GHC.Builtin.Names (multMulTyConKey)
 import GHC.Types.Unique (hasKey)
 
@@ -271,45 +270,11 @@ To add a new multiplicity, you need to:
   and Zero
 -}
 
---
--- * Core properties of multiplicities
---
-
-{-
-Note [Mult is type]
-~~~~~~~~~~~~~~~~~~~
-Mult is a type alias for Type.
-
-Mult must contain Type because multiplicity variables are mere type variables
-(of kind Multiplicity) in Haskell. So the simplest implementation is to make
-Mult be Type.
-
-Multiplicities can be formed with:
-- One: GHC.Types.One (= oneDataCon)
-- Many: GHC.Types.Many (= manyDataCon)
-- Multiplication: GHC.Types.MultMul (= multMulTyCon)
-
-So that Mult feels a bit more structured, we provide pattern synonyms and smart
-constructors for these.
--}
-type Mult = Type
-
-pattern One :: Mult
-pattern One <- (eqType oneDataConTy -> True)
-  where One = oneDataConTy
-
-pattern Many :: Mult
-pattern Many <- (eqType manyDataConTy -> True)
-  where Many = manyDataConTy
-
 isMultMul :: Mult -> Maybe (Mult, Mult)
 isMultMul ty | Just (tc, [x, y]) <- splitTyConApp_maybe ty
              , tc `hasKey` multMulTyConKey = Just (x, y)
              | otherwise = Nothing
 
-pattern MultMul :: Mult -> Mult -> Mult
-pattern MultMul p q <- (isMultMul -> Just (p,q))
-
 {-
 Note [Overapproximating multiplicities]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -341,6 +306,9 @@ mkMultMul Many _ = Many
 mkMultMul _ Many = Many
 mkMultMul p q = mkTyConApp multMulTyCon [p, q]
 
+scaleScaled :: Mult -> Scaled a -> Scaled a
+scaleScaled m' (Scaled m t) = Scaled (m' `mkMultMul` m) t
+
 -- See Note [Joining usages]
 -- | @mkMultSup w1 w2@ returns a multiplicity such that @mkMultSup w1
 -- w2 >= w1@ and @mkMultSup w1 w2 >= w2@. See Note [Overapproximating multiplicities].
@@ -368,43 +336,3 @@ submult One   One  = Submult
 -- The 1 <= p rule
 submult One   _    = Submult
 submult _     _    = Unknown
-
---
--- * Utilities
---
-
--- | A shorthand for data with an attached 'Mult' element (the multiplicity).
-data Scaled a = Scaled Mult a
-  deriving (Data)
-
-scaledMult :: Scaled a -> Mult
-scaledMult (Scaled m _) = m
-
-scaledThing :: Scaled a -> a
-scaledThing (Scaled _ t) = t
-
-unrestricted, linear, tymult :: a -> Scaled a
-unrestricted = Scaled Many
-linear = Scaled One
-
--- Used for type arguments in core
-tymult = Scaled Many
-
-irrelevantMult :: Scaled a -> a
-irrelevantMult = scaledThing
-
-mkScaled :: Mult -> a -> Scaled a
-mkScaled = Scaled
-
-instance (Outputable a) => Outputable (Scaled a) where
-   ppr (Scaled _cnt t) = ppr t
-     -- Do not print the multiplicity here because it tends to be too verbose
-
-scaledSet :: Scaled a -> b -> Scaled b
-scaledSet (Scaled m _) b = Scaled m b
-
-scaleScaled :: Mult -> Scaled a -> Scaled a
-scaleScaled m' (Scaled m t) = Scaled (m' `mkMultMul` m) t
-
-mapScaledType :: (Type -> Type) -> Scaled Type -> Scaled Type
-mapScaledType f (Scaled m t) = Scaled (f m) (f t)
diff --git a/compiler/GHC/Core/Opt/Arity.hs b/compiler/GHC/Core/Opt/Arity.hs
index 44505ef0b6..5df571ee1c 100644
--- a/compiler/GHC/Core/Opt/Arity.hs
+++ b/compiler/GHC/Core/Opt/Arity.hs
@@ -125,8 +125,8 @@ typeArity ty
       | Just (_, ty')  <- splitForAllTy_maybe ty
       = go rec_nts ty'
 
-      | Just (arg,res) <- splitFunTy_maybe ty
-      = typeOneShot (scaledThing arg) : go rec_nts res
+      | Just (_,arg,res) <- splitFunTy_maybe ty
+      = typeOneShot arg : go rec_nts res
 
       | Just (tc,tys) <- splitTyConApp_maybe ty
       , Just (ty', _) <- instNewTyCon_maybe tc tys
@@ -1090,17 +1090,18 @@ mkEtaWW orig_n ppr_orig_expr in_scope orig_ty
                --   lambda \co:ty. e co. In this case we generate a new variable
                --   of the coercion type, update the scope, and reduce n by 1.
                | isTyVar tcv = ((subst', tcv'), n)
-               | otherwise   = (freshEtaId n subst' (varScaledType tcv'), n-1)
+                    -- covar case:
+               | otherwise   = (freshEtaId n subst' (unrestricted (varType tcv')), n-1)
            -- Avoid free vars of the original expression
          in go n_n n_subst ty' (EtaVar n_tcv : eis)
 
        ----------- Function types  (t1 -> t2)
-       | Just (arg_ty, res_ty) <- splitFunTy_maybe ty
-       , not (isTypeLevPoly (scaledThing arg_ty))
+       | Just (mult, arg_ty, res_ty) <- splitFunTy_maybe ty
+       , not (isTypeLevPoly arg_ty)
           -- See Note [Levity polymorphism invariants] in GHC.Core
           -- See also test case typecheck/should_run/EtaExpandLevPoly
 
-       , let (subst', eta_id') = freshEtaId n subst arg_ty
+       , let (subst', eta_id') = freshEtaId n subst (Scaled mult arg_ty)
            -- Avoid free vars of the original expression
        = go (n-1) subst' res_ty (EtaVar eta_id' : eis)
 
@@ -1183,8 +1184,8 @@ etaBodyForJoinPoint need_args body
       | Just (tv, res_ty) <- splitForAllTy_maybe ty
       , let (subst', tv') = Type.substVarBndr subst tv
       = go (n-1) res_ty subst' (tv' : rev_bs) (e `App` varToCoreExpr tv')
-      | Just (arg_ty, res_ty) <- splitFunTy_maybe ty
-      , let (subst', b) = freshEtaId n subst arg_ty
+      | Just (mult, arg_ty, res_ty) <- splitFunTy_maybe ty
+      , let (subst', b) = freshEtaId n subst (Scaled mult arg_ty)
       = go (n-1) res_ty subst' (b : rev_bs) (e `App` Var b)
       | otherwise
       = pprPanic "etaBodyForJoinPoint" $ int need_args $$
diff --git a/compiler/GHC/Core/Opt/CSE.hs b/compiler/GHC/Core/Opt/CSE.hs
index 16a0137a4c..d6f37f6eb5 100644
--- a/compiler/GHC/Core/Opt/CSE.hs
+++ b/compiler/GHC/Core/Opt/CSE.hs
@@ -16,7 +16,7 @@ module GHC.Core.Opt.CSE (cseProgram, cseOneExpr) where
 import GHC.Prelude
 
 import GHC.Core.Subst
-import GHC.Types.Var    ( Var, varMultMaybe )
+import GHC.Types.Var    ( Var )
 import GHC.Types.Var.Env ( mkInScopeSet )
 import GHC.Types.Id     ( Id, idType, idHasRules
                         , idInlineActivation, setInlineActivation
@@ -33,7 +33,6 @@ import GHC.Types.Basic
 import GHC.Core.Map
 import GHC.Utils.Misc   ( filterOut, equalLength, debugIsOn )
 import Data.List        ( mapAccumL )
-import GHC.Core.Multiplicity
 
 {-
                         Simple common sub-expression
@@ -450,34 +449,8 @@ noCSE id =  not (isAlwaysActive (idInlineActivation id)) &&
              -- See Note [CSE for INLINE and NOINLINE]
          || isAnyInlinePragma (idInlinePragma id)
              -- See Note [CSE for stable unfoldings]
-         || not (multiplicityOkForCSE id)
          || isJoinId id
              -- See Note [CSE for join points?]
-  where
-    -- It doesn't make sense to do CSE for a binding which can't be freely
-    -- shared or dropped. In particular linear bindings, but this is true for
-    -- any binding whose multiplicity contains a variable.
-    --
-    -- This shows up, in particular, when performing a substitution
-    --
-    --   CSE[let x # 'One = y in x]
-    --   ==> let x # 'One = y in CSE[x[x\y]]
-    --   ==> let x # 'One = y in y
-    --
-    -- Here @x@ doesn't appear in the body, but it is required by linearity!
-    -- Also @y@ appears shared, while we expect it to be a linear variable.
-    --
-    -- This is usually not a problem with let-binders because they are aliases.
-    -- But we don't have such luxury for case binders. Still, substitution of
-    -- the case binder by the scrutinee happens routinely in CSE to discover
-    -- more CSE opportunities (see Note [CSE for case expressions]).
-    --
-    -- It's alright, though! Because there is never a need to share linear
-    -- definitions.
-    multiplicityOkForCSE v = case varMultMaybe v of
-                                Just Many -> True
-                                Just _ -> False
-                                Nothing -> True
 
 
 {- Note [Take care with literal strings]
diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs
index 6ca8efce2e..b0a83e5edb 100644
--- a/compiler/GHC/Core/Opt/ConstantFold.hs
+++ b/compiler/GHC/Core/Opt/ConstantFold.hs
@@ -1557,10 +1557,10 @@ match_inline _ = Nothing
 -- for a description of what is going on here.
 match_magicDict :: [Expr CoreBndr] -> Maybe (Expr CoreBndr)
 match_magicDict [Type _, Var wrap `App` Type a `App` Type _ `App` f, x, y ]
-  | Just (fieldTy, _)   <- splitFunTy_maybe $ dropForAlls $ idType wrap
-  , Just (dictTy, _)    <- splitFunTy_maybe (scaledThing fieldTy)
-  , Just dictTc         <- tyConAppTyCon_maybe (scaledThing dictTy)
-  , Just (_,_,co)       <- unwrapNewTyCon_maybe dictTc
+  | Just (_, fieldTy, _)  <- splitFunTy_maybe $ dropForAlls $ idType wrap
+  , Just (_, dictTy, _)   <- splitFunTy_maybe fieldTy
+  , Just dictTc           <- tyConAppTyCon_maybe dictTy
+  , Just (_,_,co)         <- unwrapNewTyCon_maybe dictTc
   = Just
   $ f `App` Cast x (mkSymCo (mkUnbranchedAxInstCo Representational co [a] []))
       `App` y
@@ -1580,7 +1580,7 @@ match_WordToInteger :: RuleFun
 match_WordToInteger _ id_unf id [xl]
   | Just (LitNumber LitNumWord x _) <- exprIsLiteral_maybe id_unf xl
   = case splitFunTy_maybe (idType id) of
-    Just (_, integerTy) ->
+    Just (_, _, integerTy) ->
         Just (Lit (mkLitInteger x integerTy))
     _ ->
         panic "match_WordToInteger: Id has the wrong type"
@@ -1590,7 +1590,7 @@ match_Int64ToInteger :: RuleFun
 match_Int64ToInteger _ id_unf id [xl]
   | Just (LitNumber LitNumInt64 x _) <- exprIsLiteral_maybe id_unf xl
   = case splitFunTy_maybe (idType id) of
-    Just (_, integerTy) ->
+    Just (_, _, integerTy) ->
         Just (Lit (mkLitInteger x integerTy))
     _ ->
         panic "match_Int64ToInteger: Id has the wrong type"
@@ -1600,7 +1600,7 @@ match_Word64ToInteger :: RuleFun
 match_Word64ToInteger _ id_unf id [xl]
   | Just (LitNumber LitNumWord64 x _) <- exprIsLiteral_maybe id_unf xl
   = case splitFunTy_maybe (idType id) of
-    Just (_, integerTy) ->
+    Just (_, _, integerTy) ->
         Just (Lit (mkLitInteger x integerTy))
     _ ->
         panic "match_Word64ToInteger: Id has the wrong type"
@@ -1610,7 +1610,7 @@ match_NaturalToInteger :: RuleFun
 match_NaturalToInteger _ id_unf id [xl]
   | Just (LitNumber LitNumNatural x _) <- exprIsLiteral_maybe id_unf xl
   = case splitFunTy_maybe (idType id) of
-    Just (_, naturalTy) ->
+    Just (_, _, naturalTy) ->
         Just (Lit (LitNumber LitNumInteger x naturalTy))
     _ ->
         panic "match_NaturalToInteger: Id has the wrong type"
@@ -1621,7 +1621,7 @@ match_NaturalFromInteger _ id_unf id [xl]
   | Just (LitNumber LitNumInteger x _) <- exprIsLiteral_maybe id_unf xl
   , x >= 0
   = case splitFunTy_maybe (idType id) of
-    Just (_, naturalTy) ->
+    Just (_, _, naturalTy) ->
         Just (Lit (LitNumber LitNumNatural x naturalTy))
     _ ->
         panic "match_NaturalFromInteger: Id has the wrong type"
@@ -1631,7 +1631,7 @@ match_WordToNatural :: RuleFun
 match_WordToNatural _ id_unf id [xl]
   | Just (LitNumber LitNumWord x _) <- exprIsLiteral_maybe id_unf xl
   = case splitFunTy_maybe (idType id) of
-    Just (_, naturalTy) ->
+    Just (_, _, naturalTy) ->
         Just (Lit (LitNumber LitNumNatural x naturalTy))
     _ ->
         panic "match_WordToNatural: Id has the wrong type"
@@ -1666,7 +1666,7 @@ match_bitInteger env id_unf fn [arg]
     -- would be a bad idea (#14959)
   , let x_int = fromIntegral x :: Int
   = case splitFunTy_maybe (idType fn) of
-    Just (_, integerTy)
+    Just (_, _, integerTy)
       -> Just (Lit (LitNumber LitNumInteger (bit x_int) integerTy))
     _ -> panic "match_IntToInteger_unop: Id has the wrong type"
 
@@ -1692,7 +1692,7 @@ match_IntToInteger_unop :: (Integer -> Integer) -> RuleFun
 match_IntToInteger_unop unop _ id_unf fn [xl]
   | Just (LitNumber LitNumInt x _) <- exprIsLiteral_maybe id_unf xl
   = case splitFunTy_maybe (idType fn) of
-    Just (_, integerTy) ->
+    Just (_, _, integerTy) ->
         Just (Lit (LitNumber LitNumInteger (unop x) integerTy))
     _ ->
         panic "match_IntToInteger_unop: Id has the wrong type"
@@ -1803,7 +1803,7 @@ match_decodeDouble :: RuleFun
 match_decodeDouble env id_unf fn [xl]
   | Just (LitDouble x) <- exprIsLiteral_maybe id_unf xl
   = case splitFunTy_maybe (idType fn) of
-    Just (_, res)
+    Just (_, _, res)
       | Just [_lev1, _lev2, integerTy, intHashTy] <- tyConAppArgs_maybe res
       -> case decodeFloat (fromRational x :: Double) of
            (y, z) ->
diff --git a/compiler/GHC/Core/Opt/Exitify.hs b/compiler/GHC/Core/Opt/Exitify.hs
index 5aa893e7b6..7372b79ebc 100644
--- a/compiler/GHC/Core/Opt/Exitify.hs
+++ b/compiler/GHC/Core/Opt/Exitify.hs
@@ -50,7 +50,6 @@ import GHC.Types.Var.Env
 import GHC.Core.FVs
 import GHC.Data.FastString
 import GHC.Core.Type
-import GHC.Core.Multiplicity ( pattern Many )
 import GHC.Utils.Misc( mapSnd )
 
 import Data.Bifunctor
diff --git a/compiler/GHC/Core/Opt/FloatIn.hs b/compiler/GHC/Core/Opt/FloatIn.hs
index 03a84b872c..896507d77a 100644
--- a/compiler/GHC/Core/Opt/FloatIn.hs
+++ b/compiler/GHC/Core/Opt/FloatIn.hs
@@ -36,9 +36,7 @@ import GHC.Types.Var.Set
 import GHC.Utils.Misc
 import GHC.Driver.Session
 import GHC.Utils.Outputable
--- import Data.List        ( mapAccumL )
 import GHC.Types.Basic      ( RecFlag(..), isRec )
-import GHC.Core.Multiplicity
 
 {-
 Top-level interface function, @floatInwards@.  Note that we do not
@@ -202,12 +200,12 @@ fiExpr platform to_drop ann_expr@(_,AnnApp {})
       = (piResultTy fun_ty ty, extra_fvs)
 
     add_arg (fun_ty, extra_fvs) (arg_fvs, arg)
-      | noFloatIntoArg arg (irrelevantMult arg_ty)
+      | noFloatIntoArg arg arg_ty
       = (res_ty, extra_fvs `unionDVarSet` arg_fvs)
       | otherwise
       = (res_ty, extra_fvs)
       where
-       (arg_ty, res_ty) = splitFunTy fun_ty
+       (_, arg_ty, res_ty) = splitFunTy fun_ty
 
 {- Note [Dead bindings]
 ~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/GHC/Core/Opt/SetLevels.hs b/compiler/GHC/Core/Opt/SetLevels.hs
index bdd28d6a2f..91e9f6ec34 100644
--- a/compiler/GHC/Core/Opt/SetLevels.hs
+++ b/compiler/GHC/Core/Opt/SetLevels.hs
@@ -84,6 +84,7 @@ import GHC.Core.Utils   ( exprType, exprIsHNF
                         , exprIsTopLevelBindable
                         , isExprLevPoly
                         , collectMakeStaticArgs
+                        , mkLamTypes
                         )
 import GHC.Core.Opt.Arity   ( exprBotStrictness_maybe )
 import GHC.Core.FVs     -- all of it
@@ -103,7 +104,7 @@ import GHC.Types.Cpr          ( mkCprSig, botCpr )
 import GHC.Types.Name         ( getOccName, mkSystemVarName )
 import GHC.Types.Name.Occurrence ( occNameString )
 import GHC.Types.Unique       ( hasKey )
-import GHC.Core.Type    ( Type, mkLamTypes, splitTyConApp_maybe, tyCoVarsOfType
+import GHC.Core.Type    ( Type, splitTyConApp_maybe, tyCoVarsOfType
                         , mightBeUnliftedType, closeOverKindsDSet )
 import GHC.Core.Multiplicity     ( pattern Many )
 import GHC.Types.Basic  ( Arity, RecFlag(..), isRec )
diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs
index bf75a9de38..81cf962d91 100644
--- a/compiler/GHC/Core/Opt/Simplify.hs
+++ b/compiler/GHC/Core/Opt/Simplify.hs
@@ -1035,8 +1035,16 @@ simplExprF1 env (App fun arg) cont
                                 , sc_hole_ty = hole'
                                 , sc_cont    = cont } }
       _       ->
+          -- crucially, these are /lazy/ bindings. They will
+          -- be forced only if we need to run contHoleType.
+          -- When these are forced, we might get quadratic behavior;
+          -- this quadratic blowup could be avoided by drilling down
+          -- to the function and getting its multiplicities all at once
+          -- (instead of one-at-a-time). But in practice, we have not
+          -- observed the quadratic behavior, so this extra entanglement
+          -- seems not worthwhile.
         let fun_ty = exprType fun
-            (Scaled m _, _) = splitFunTy fun_ty
+            (m, _, _) = splitFunTy fun_ty
         in
                 simplExprF env fun $
                  ApplyToVal { sc_arg = arg, sc_env = env
@@ -1148,7 +1156,7 @@ simplJoinRhs env bndr expr cont
   | Just arity <- isJoinId_maybe bndr
   =  do { let (join_bndrs, join_body) = collectNBinders arity expr
               mult = contHoleScaling cont
-        ; (env', join_bndrs') <- simplLamBndrs env (map (scaleIdBy mult) join_bndrs)
+        ; (env', join_bndrs') <- simplLamBndrs env (map (scaleVarBy mult) join_bndrs)
         ; join_body' <- simplExprC env' join_body cont
         ; return $ mkLams join_bndrs' join_body' }
 
@@ -2665,7 +2673,7 @@ rebuildCase env scrut case_bndr alts cont
     -- they are aliases anyway.
     scale_float (GHC.Core.Make.FloatCase scrut case_bndr con vars) =
       let
-        scale_id id = scaleIdBy holeScaling id
+        scale_id id = scaleVarBy holeScaling id
       in
       GHC.Core.Make.FloatCase scrut (scale_id case_bndr) con (map scale_id vars)
     scale_float f = f
diff --git a/compiler/GHC/Core/Opt/Simplify/Env.hs b/compiler/GHC/Core/Opt/Simplify/Env.hs
index 5c8e0f21c2..71658c1295 100644
--- a/compiler/GHC/Core/Opt/Simplify/Env.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Env.hs
@@ -63,7 +63,6 @@ import qualified GHC.Core.Type as Type
 import GHC.Core.Type hiding     ( substTy, substTyVar, substTyVarBndr, extendTvSubst, extendCvSubst )
 import qualified GHC.Core.Coercion as Coercion
 import GHC.Core.Coercion hiding ( substCo, substCoVar, substCoVarBndr )
-import GHC.Core.Multiplicity
 import GHC.Types.Basic
 import GHC.Utils.Monad
 import GHC.Utils.Outputable
diff --git a/compiler/GHC/Core/Opt/Simplify/Monad.hs b/compiler/GHC/Core/Opt/Simplify/Monad.hs
index b84ed1028f..5c111374c8 100644
--- a/compiler/GHC/Core/Opt/Simplify/Monad.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Monad.hs
@@ -27,9 +27,10 @@ import GHC.Types.Var       ( Var, isId, mkLocalVar )
 import GHC.Types.Name      ( mkSystemVarName )
 import GHC.Types.Id        ( Id, mkSysLocalOrCoVar )
 import GHC.Types.Id.Info   ( IdDetails(..), vanillaIdInfo, setArityInfo )
-import GHC.Core.Type       ( Type, mkLamTypes, Mult )
+import GHC.Core.Type       ( Type, Mult )
 import GHC.Core.FamInstEnv ( FamInstEnv )
 import GHC.Core            ( RuleEnv(..) )
+import GHC.Core.Utils      ( mkLamTypes )
 import GHC.Types.Unique.Supply
 import GHC.Driver.Session
 import GHC.Core.Opt.Monad
diff --git a/compiler/GHC/Core/Opt/Simplify/Utils.hs b/compiler/GHC/Core/Opt/Simplify/Utils.hs
index c1cb4c9f3f..5f2db4508d 100644
--- a/compiler/GHC/Core/Opt/Simplify/Utils.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Utils.hs
@@ -546,7 +546,7 @@ mkArgInfo env fun rules n_val_args call_cont
 
     add_type_str _ [] = []
     add_type_str fun_ty all_strs@(str:strs)
-      | Just (Scaled _ arg_ty, fun_ty') <- splitFunTy_maybe fun_ty        -- Add strict-type info
+      | Just (_, arg_ty, fun_ty') <- splitFunTy_maybe fun_ty        -- Add strict-type info
       = (str || Just False == isLiftedType_maybe arg_ty)
         : add_type_str fun_ty' strs
           -- If the type is levity-polymorphic, we can't know whether it's
diff --git a/compiler/GHC/Core/Opt/StaticArgs.hs b/compiler/GHC/Core/Opt/StaticArgs.hs
index dd015924e3..d4b76dc0d8 100644
--- a/compiler/GHC/Core/Opt/StaticArgs.hs
+++ b/compiler/GHC/Core/Opt/StaticArgs.hs
@@ -56,7 +56,6 @@ import GHC.Prelude
 import GHC.Types.Var
 import GHC.Core
 import GHC.Core.Utils
-import GHC.Core.Multiplicity ( pattern Many )
 import GHC.Core.Type
 import GHC.Core.Coercion
 import GHC.Types.Id
diff --git a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
index 9da3065bed..2357c4e3e3 100644
--- a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
+++ b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
@@ -186,7 +186,7 @@ mkWwBodies dflags fam_envs rhs_fvs fun_id demands cpr_info
     -- Note [Do not split void functions]
     only_one_void_argument
       | [d] <- demands
-      , Just (Scaled _ arg_ty1, _) <- splitFunTy_maybe fun_ty
+      , Just (_, arg_ty1, _) <- splitFunTy_maybe fun_ty
       , isAbsDmd d && isVoidTy arg_ty1
       = True
       | otherwise
@@ -422,9 +422,9 @@ mkWWargs subst fun_ty demands
   = return ([], id, id, substTy subst fun_ty)
 
   | (dmd:demands') <- demands
-  , Just (arg_ty, fun_ty') <- splitFunTy_maybe fun_ty
+  , Just (mult, arg_ty, fun_ty') <- splitFunTy_maybe fun_ty
   = do  { uniq <- getUniqueM
-        ; let arg_ty' = substScaledTy subst arg_ty
+        ; let arg_ty' = substScaledTy subst (Scaled mult arg_ty)
               id = mk_wrap_arg uniq arg_ty' dmd
         ; (wrap_args, wrap_fn_args, work_fn_args, res_ty)
               <- mkWWargs subst fun_ty' demands'
@@ -1021,7 +1021,7 @@ findTypeShape fam_envs ty
        -- to look deep into such products -- see #18034
   where
     go rec_tc ty
-       | Just (_, res) <- splitFunTy_maybe ty
+       | Just (_, _, res) <- splitFunTy_maybe ty
        = TsFun (go rec_tc res)
 
        | Just (tc, tc_args)  <- splitTyConApp_maybe ty
diff --git a/compiler/GHC/Core/PatSyn.hs b/compiler/GHC/Core/PatSyn.hs
index 6f88fd897d..3902bb6b18 100644
--- a/compiler/GHC/Core/PatSyn.hs
+++ b/compiler/GHC/Core/PatSyn.hs
@@ -33,7 +33,6 @@ import GHC.Types.Name
 import GHC.Utils.Outputable
 import GHC.Types.Unique
 import GHC.Utils.Misc
-import GHC.Core.Multiplicity
 import GHC.Types.Basic
 import GHC.Types.Var
 import GHC.Types.FieldLabel
diff --git a/compiler/GHC/Core/SimpleOpt.hs b/compiler/GHC/Core/SimpleOpt.hs
index b0b6416c0b..4833d1e499 100644
--- a/compiler/GHC/Core/SimpleOpt.hs
+++ b/compiler/GHC/Core/SimpleOpt.hs
@@ -1429,8 +1429,8 @@ pushCoercionIntoLambda
 pushCoercionIntoLambda in_scope x e co
     | ASSERT(not (isTyVar x) && not (isCoVar x)) True
     , Pair s1s2 t1t2 <- coercionKind co
-    , Just (_s1,_s2) <- splitFunTy_maybe s1s2
-    , Just (Scaled w1 t1,_t2) <- splitFunTy_maybe t1t2
+    , Just (_, _s1,_s2) <- splitFunTy_maybe s1s2
+    , Just (w1, t1,_t2) <- splitFunTy_maybe t1t2
     , (co_mult, co1, co2) <- decomposeFunCo Representational co
     , isReflexiveCo co_mult
       -- We can't push the coercion in the case where co_mult isn't
diff --git a/compiler/GHC/Core/TyCo/Ppr.hs b/compiler/GHC/Core/TyCo/Ppr.hs
index c6bf57e6d2..44899be2ac 100644
--- a/compiler/GHC/Core/TyCo/Ppr.hs
+++ b/compiler/GHC/Core/TyCo/Ppr.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE PatternSynonyms #-}
+
 -- | Pretty-printing types and coercions.
 module GHC.Core.TyCo.Ppr
   (
@@ -34,10 +36,8 @@ import {-# SOURCE #-} GHC.CoreToIface
 import {-# SOURCE #-} GHC.Core.DataCon
    ( dataConFullSig , dataConUserTyVarBinders
    , DataCon )
-import GHC.Core.Multiplicity
 
-import {-# SOURCE #-} GHC.Core.Type
-   ( isLiftedTypeKind )
+import GHC.Core.Type ( isLiftedTypeKind, pattern One, pattern Many )
 
 import GHC.Core.TyCon
 import GHC.Core.TyCo.Rep
diff --git a/compiler/GHC/Core/TyCo/Ppr.hs-boot b/compiler/GHC/Core/TyCo/Ppr.hs-boot
index 8e89c334ea..2b1a787f1f 100644
--- a/compiler/GHC/Core/TyCo/Ppr.hs-boot
+++ b/compiler/GHC/Core/TyCo/Ppr.hs-boot
@@ -1,10 +1,11 @@
 module GHC.Core.TyCo.Ppr where
 
+import {-# SOURCE #-} GHC.Types.Var ( TyVar )
 import {-# SOURCE #-} GHC.Core.TyCo.Rep (Type, Kind, Coercion, TyLit)
-import GHC.Utils.Outputable
+import GHC.Utils.Outputable ( SDoc )
 
 pprType :: Type -> SDoc
 pprKind :: Kind -> SDoc
 pprCo :: Coercion -> SDoc
 pprTyLit :: TyLit -> SDoc
-
+pprTyVar :: TyVar -> SDoc
diff --git a/compiler/GHC/Core/TyCo/Rep.hs b/compiler/GHC/Core/TyCo/Rep.hs
index e201dcfea3..e72284477a 100644
--- a/compiler/GHC/Core/TyCo/Rep.hs
+++ b/compiler/GHC/Core/TyCo/Rep.hs
@@ -25,10 +25,7 @@ module GHC.Core.TyCo.Rep (
         TyThing(..), tyThingCategory, pprTyThingCategory, pprShortTyThing,
 
         -- * Types
-        Type( TyVarTy, AppTy, TyConApp, ForAllTy
-            , LitTy, CastTy, CoercionTy
-            , FunTy, ft_mult, ft_arg, ft_res, ft_af
-            ),  -- Export the type synonym FunTy too
+        Type(..),
 
         TyLit(..),
         KindOrType, Kind,
@@ -53,6 +50,7 @@ module GHC.Core.TyCo.Rep (
         mkScaledFunTy,
         mkVisFunTyMany, mkVisFunTysMany,
         mkInvisFunTyMany, mkInvisFunTysMany,
+        mkTyConApp,
 
         -- * Functions over binders
         TyCoBinder(..), TyCoVarBinder, TyBinder,
@@ -69,7 +67,10 @@ module GHC.Core.TyCo.Rep (
         TyCoFolder(..), foldTyCo,
 
         -- * Sizes
-        typeSize, coercionSize, provSize
+        typeSize, coercionSize, provSize,
+
+        -- * Multiplicities
+        Scaled(..), scaledMult, scaledThing, mapScaledType, Mult
     ) where
 
 #include "HsVersions.h"
@@ -87,12 +88,14 @@ import GHC.Iface.Type
 import GHC.Types.Var
 import GHC.Types.Var.Set
 import GHC.Types.Name hiding ( varName )
-import GHC.Core.Multiplicity
 import GHC.Core.TyCon
 import GHC.Core.Coercion.Axiom
 
 -- others
+import GHC.Builtin.Names ( liftedTypeKindTyConKey, manyDataConKey )
+import {-# SOURCE #-} GHC.Builtin.Types ( liftedTypeKindTyCon, manyDataConTy )
 import GHC.Types.Basic ( LeftOrRight(..), pickLR )
+import GHC.Types.Unique ( hasKey )
 import GHC.Utils.Outputable
 import GHC.Data.FastString
 import GHC.Utils.Misc
@@ -1003,14 +1006,14 @@ mkVisFunTy   = mkFunTy VisArg
 mkInvisFunTy = mkFunTy InvisArg
 
 mkFunTyMany :: AnonArgFlag -> Type -> Type -> Type
-mkFunTyMany af = mkFunTy af Many
+mkFunTyMany af = mkFunTy af manyDataConTy
 
 -- | Special, common, case: Arrow type with mult Many
 mkVisFunTyMany :: Type -> Type -> Type
-mkVisFunTyMany = mkVisFunTy Many
+mkVisFunTyMany = mkVisFunTy manyDataConTy
 
 mkInvisFunTyMany :: Type -> Type -> Type
-mkInvisFunTyMany = mkInvisFunTy Many
+mkInvisFunTyMany = mkInvisFunTy manyDataConTy
 
 -- | Make nested arrow types
 mkVisFunTys :: [Scaled Type] -> Type -> Type
@@ -1046,6 +1049,58 @@ mkPiTys tbs ty = foldr mkPiTy ty tbs
 mkTyConTy :: TyCon -> Type
 mkTyConTy tycon = TyConApp tycon []
 
+-- | A key function: builds a 'TyConApp' or 'FunTy' as appropriate to
+-- its arguments.  Applies its arguments to the constructor from left to right.
+mkTyConApp :: TyCon -> [Type] -> Type
+mkTyConApp tycon tys
+  | isFunTyCon tycon
+  , [w, _rep1,_rep2,ty1,ty2] <- tys
+  -- The FunTyCon (->) is always a visible one
+  = FunTy { ft_af = VisArg, ft_mult = w, ft_arg = ty1, ft_res = ty2 }
+
+  -- Note [mkTyConApp and Type]
+  | tycon `hasKey` liftedTypeKindTyConKey
+  = ASSERT2( null tys, ppr tycon $$ ppr tys )
+    liftedTypeKindTyConApp
+  | tycon `hasKey` manyDataConKey
+  -- There are a lot of occurrences of 'Many' so it's a small optimisation to
+  -- avoid reboxing every time `mkTyConApp` is called.
+  = ASSERT2( null tys, ppr tycon $$ ppr tys )
+    manyDataConTy
+  | otherwise
+  = TyConApp tycon tys
+
+-- This is a single, global definition of the type `Type`
+-- Defined here so it is only allocated once.
+-- See Note [mkTyConApp and Type]
+liftedTypeKindTyConApp :: Type
+liftedTypeKindTyConApp = TyConApp liftedTypeKindTyCon []
+
+{-
+Note [mkTyConApp and Type]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+Whilst benchmarking it was observed in #17292 that GHC allocated a lot
+of `TyConApp` constructors. Upon further inspection a large number of these
+TyConApp constructors were all duplicates of `Type` applied to no arguments.
+
+```
+(From a sample of 100000 TyConApp closures)
+0x45f3523    - 28732 - `Type`
+0x420b840702 - 9629  - generic type constructors
+0x42055b7e46 - 9596
+0x420559b582 - 9511
+0x420bb15a1e - 9509
+0x420b86c6ba - 9501
+0x42055bac1e - 9496
+0x45e68fd    - 538 - `TYPE ...`
+```
+
+Therefore in `mkTyConApp` we have a special case for `Type` to ensure that
+only one `TyConApp 'Type []` closure is allocated during the course of
+compilation. In order to avoid a potentially expensive series of checks in
+`mkTyConApp` only this egregious case is special cased at the moment.
+-}
+
 {-
 %************************************************************************
 %*                                                                      *
@@ -1954,3 +2009,50 @@ provSize :: UnivCoProvenance -> Int
 provSize (PhantomProv co)    = 1 + coercionSize co
 provSize (ProofIrrelProv co) = 1 + coercionSize co
 provSize (PluginProv _)      = 1
+
+{-
+************************************************************************
+*                                                                      *
+                    Multiplicities
+*                                                                      *
+************************************************************************
+
+These definitions are here to avoid module loops, and to keep
+GHC.Core.Multiplicity above this module.
+
+-}
+
+-- | A shorthand for data with an attached 'Mult' element (the multiplicity).
+data Scaled a = Scaled Mult a
+  deriving (Data.Data)
+
+instance (Outputable a) => Outputable (Scaled a) where
+   ppr (Scaled _cnt t) = ppr t
+     -- Do not print the multiplicity here because it tends to be too verbose
+
+scaledMult :: Scaled a -> Mult
+scaledMult (Scaled m _) = m
+
+scaledThing :: Scaled a -> a
+scaledThing (Scaled _ t) = t
+
+-- | Apply a function to both the Mult and the Type in a 'Scaled Type'
+mapScaledType :: (Type -> Type) -> Scaled Type -> Scaled Type
+mapScaledType f (Scaled m t) = Scaled (f m) (f t)
+
+{- |
+Mult is a type alias for Type.
+
+Mult must contain Type because multiplicity variables are mere type variables
+(of kind Multiplicity) in Haskell. So the simplest implementation is to make
+Mult be Type.
+
+Multiplicities can be formed with:
+- One: GHC.Types.One (= oneDataCon)
+- Many: GHC.Types.Many (= manyDataCon)
+- Multiplication: GHC.Types.MultMul (= multMulTyCon)
+
+So that Mult feels a bit more structured, we provide pattern synonyms and smart
+constructors for these.
+-}
+type Mult = Type
diff --git a/compiler/GHC/Core/TyCo/Rep.hs-boot b/compiler/GHC/Core/TyCo/Rep.hs-boot
index 25a22435cf..7bc1eb4f81 100644
--- a/compiler/GHC/Core/TyCo/Rep.hs-boot
+++ b/compiler/GHC/Core/TyCo/Rep.hs-boot
@@ -12,6 +12,9 @@ data TyLit
 data TyCoBinder
 data MCoercion
 
+data Scaled a
+type Mult = Type
+
 type PredType = Type
 type Kind = Type
 type ThetaType = [PredType]
diff --git a/compiler/GHC/Core/TyCo/Subst.hs b/compiler/GHC/Core/TyCo/Subst.hs
index 88799c2414..b3f51739b5 100644
--- a/compiler/GHC/Core/TyCo/Subst.hs
+++ b/compiler/GHC/Core/TyCo/Subst.hs
@@ -65,11 +65,10 @@ import {-# SOURCE #-} GHC.Core.Coercion
    , mkInstCo, mkLRCo, mkTyConAppCo
    , mkCoercionType
    , coercionKind, coercionLKind, coVarKindsTypesRole )
+import {-# SOURCE #-} GHC.Core.TyCo.Ppr ( pprTyVar )
 
 import GHC.Core.TyCo.Rep
 import GHC.Core.TyCo.FVs
-import GHC.Core.TyCo.Ppr
-import GHC.Core.Multiplicity
 
 import GHC.Types.Var
 import GHC.Types.Var.Set
@@ -733,12 +732,15 @@ subst_ty subst ty
    = go ty
   where
     go (TyVarTy tv)      = substTyVar subst tv
-    go (AppTy fun arg)   = mkAppTy (go fun) $! (go arg)
+    go (AppTy fun arg)   = (mkAppTy $! (go fun)) $! (go arg)
                 -- The mkAppTy smart constructor is important
                 -- we might be replacing (a Int), represented with App
                 -- by [Int], represented with TyConApp
-    go (TyConApp tc tys) = let args = map go tys
-                           in  args `seqList` TyConApp tc args
+    go ty@(TyConApp tc []) = tc `seq` ty  -- avoid allocation in this common case
+    go (TyConApp tc tys) = (mkTyConApp $! tc) $! strictMap go tys
+                               -- NB: mkTyConApp, not TyConApp.
+                               -- mkTyConApp has optimizations.
+                               -- See Note [mkTyConApp and Type] in GHC.Core.TyCo.Rep
     go ty@(FunTy { ft_mult = mult, ft_arg = arg, ft_res = res })
       = let !mult' = go mult
             !arg' = go arg
@@ -846,7 +848,7 @@ subst_co subst co
 
     -- See Note [Substituting in a coercion hole]
     go_hole h@(CoercionHole { ch_co_var = cv })
-      = h { ch_co_var = updateVarTypeAndMult go_ty cv }
+      = h { ch_co_var = updateVarType go_ty cv }
 
 substForAllCoBndr :: TCvSubst -> TyCoVar -> KindCoercion
                   -> (TCvSubst, TyCoVar, Coercion)
diff --git a/compiler/GHC/Core/TyCo/Tidy.hs b/compiler/GHC/Core/TyCo/Tidy.hs
index bc586d77c8..dd07a2775f 100644
--- a/compiler/GHC/Core/TyCo/Tidy.hs
+++ b/compiler/GHC/Core/TyCo/Tidy.hs
@@ -52,7 +52,7 @@ tidyVarBndr tidy_env@(occ_env, subst) var
       (occ_env', occ') -> ((occ_env', subst'), var')
         where
           subst' = extendVarEnv subst var var'
-          var'   = updateVarTypeAndMult (tidyType tidy_env) (setVarName var name')
+          var'   = updateVarType (tidyType tidy_env) (setVarName var name')
           name'  = tidyNameOcc name occ'
           name   = varName var
 
@@ -119,7 +119,7 @@ tidyOpenTyCoVar env@(_, subst) tyvar
 tidyTyCoVarOcc :: TidyEnv -> TyCoVar -> TyCoVar
 tidyTyCoVarOcc env@(_, subst) tv
   = case lookupVarEnv subst tv of
-        Nothing  -> updateVarTypeAndMult (tidyType env) tv
+        Nothing  -> updateVarType (tidyType env) tv
         Just tv' -> tv'
 
 ---------------
diff --git a/compiler/GHC/Core/TyCon.hs b/compiler/GHC/Core/TyCon.hs
index eac2d8b109..20d789bd74 100644
--- a/compiler/GHC/Core/TyCon.hs
+++ b/compiler/GHC/Core/TyCon.hs
@@ -1872,6 +1872,7 @@ isVanillaAlgTyCon (AlgTyCon { algTcParent = VanillaAlgTyCon _ }) = True
 isVanillaAlgTyCon _                                              = False
 
 -- | Returns @True@ for the 'TyCon' of the 'Constraint' kind.
+{-# INLINE isConstraintKindCon #-} -- See Note [Inlining coreView] in GHC.Core.Type
 isConstraintKindCon :: TyCon -> Bool
 -- NB: We intentionally match on AlgTyCon, because 'constraintKindTyCon' is
 -- always an AlgTyCon (see 'pcTyCon' in TysWiredIn) and the record selector
@@ -2032,6 +2033,7 @@ arguments are simply value arguments, and should not get in the way.
 
 
 -- | Is this a 'TyCon' representing a regular H98 type synonym (@type@)?
+{-# INLINE isTypeSynonymTyCon #-}  -- See Note [Inlining coreView] in GHC.Core.Type
 isTypeSynonymTyCon :: TyCon -> Bool
 isTypeSynonymTyCon (SynonymTyCon {}) = True
 isTypeSynonymTyCon _                 = False
@@ -2308,8 +2310,8 @@ expandSynTyCon_maybe tc tys
         GT -> Just (tvs `zip` tys, rhs, drop arity tys)
         EQ -> Just (tvs `zip` tys, rhs, [])
         LT -> Nothing
-   | otherwise
-   = Nothing
+  | otherwise
+  = Nothing
 
 ----------------
 
diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs
index bdf9ba21da..e853bdd2e5 100644
--- a/compiler/GHC/Core/Type.hs
+++ b/compiler/GHC/Core/Type.hs
@@ -3,7 +3,7 @@
 --
 -- Type - public interface
 
-{-# LANGUAGE CPP, FlexibleContexts, PatternSynonyms #-}
+{-# LANGUAGE CPP, FlexibleContexts, PatternSynonyms, ViewPatterns #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
 
@@ -56,7 +56,6 @@ module GHC.Core.Type (
         splitPiTy_maybe, splitPiTy, splitPiTys,
         mkTyConBindersPreferAnon,
         mkPiTy, mkPiTys,
-        mkLamType, mkLamTypes, mkFunctionType,
         piResultTy, piResultTys,
         applyTysX, dropForAlls,
         mkFamilyTyConApp,
@@ -133,9 +132,13 @@ module GHC.Core.Type (
         dropRuntimeRepArgs,
         getRuntimeRep,
 
-        -- Multiplicity
+        -- * Multiplicity
 
         isMultiplicityTy, isMultiplicityVar,
+        unrestricted, linear, tymult,
+        mkScaled, irrelevantMult, scaledSet,
+        pattern One, pattern Many,
+        isOneDataConTy, isManyDataConTy,
         isLinearType,
 
         -- * Main data types representing Kinds
@@ -244,7 +247,6 @@ import GHC.Core.TyCo.Rep
 import GHC.Core.TyCo.Subst
 import GHC.Core.TyCo.Tidy
 import GHC.Core.TyCo.FVs
-import GHC.Core.Multiplicity
 
 -- friends:
 import GHC.Types.Var
@@ -257,9 +259,9 @@ import GHC.Builtin.Types.Prim
 import {-# SOURCE #-} GHC.Builtin.Types
                                  ( listTyCon, typeNatKind
                                  , typeSymbolKind, liftedTypeKind
-                                 , liftedTypeKindTyCon
                                  , constraintKind
-                                 , unrestrictedFunTyCon )
+                                 , unrestrictedFunTyCon
+                                 , manyDataConTy, oneDataConTy )
 import GHC.Types.Name( Name )
 import GHC.Builtin.Names
 import GHC.Core.Coercion.Axiom
@@ -282,7 +284,7 @@ import GHC.Data.Pair
 import GHC.Data.List.SetOps
 import GHC.Types.Unique ( nonDetCmpUnique )
 
-import GHC.Data.Maybe   ( orElse )
+import GHC.Data.Maybe   ( orElse, expectJust )
 import Data.Maybe       ( isJust, mapMaybe )
 import Control.Monad    ( guard )
 
@@ -402,6 +404,37 @@ coreView ty@(TyConApp tc tys)
 
 coreView _ = Nothing
 
+{-# INLINE coreFullView #-}
+coreFullView :: Type -> Type
+-- ^ Iterates 'coreView' until there is no more to synonym to expand.
+-- See Note [Inlining coreView].
+coreFullView ty@(TyConApp tc _)
+  | isTypeSynonymTyCon tc || isConstraintKindCon tc = go ty
+  where
+    go ty
+      | Just ty' <- coreView ty = go ty'
+      | otherwise = ty
+
+coreFullView ty = ty
+
+{- Note [Inlining coreView] in GHC.Core.Type
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+It is very common to have a function
+
+  f :: Type -> ...
+  f ty | Just ty' <- coreView ty = f ty'
+  f (TyVarTy ...) = ...
+  f ...           = ...
+
+If f is not otherwise recursive, the initial call to coreView
+causes f to become recursive, which kills the possibility of
+inlining. Instead, for non-recursive functions, we prefer to
+use coreFullView, which guarantees to unwrap top-level type
+synonyms. It can be inlined and is efficient and non-allocating
+in its fast path. For this to really be fast, all calls made
+on its fast path must also be inlined, linked back to this Note.
+-}
+
 -----------------------------------------------
 expandTypeSynonyms :: Type -> Type
 -- ^ Expand out all type synonyms.  Actually, it'd suffice to expand out
@@ -511,8 +544,7 @@ kindRep k = case kindRep_maybe k of
 -- Treats * and Constraint as the same
 kindRep_maybe :: HasDebugCallStack => Kind -> Maybe Type
 kindRep_maybe kind
-  | Just kind' <- coreView kind = kindRep_maybe kind'
-  | TyConApp tc [arg] <- kind
+  | TyConApp tc [arg] <- coreFullView kind
   , tc `hasKey` tYPETyConKey    = Just arg
   | otherwise                   = Nothing
 
@@ -530,8 +562,7 @@ isLiftedRuntimeRep :: Type -> Bool
 -- False of type variables (a :: RuntimeRep)
 --   and of other reps e.g. (IntRep :: RuntimeRep)
 isLiftedRuntimeRep rep
-  | Just rep' <- coreView rep          = isLiftedRuntimeRep rep'
-  | TyConApp rr_tc args <- rep
+  | TyConApp rr_tc args <- coreFullView rep
   , rr_tc `hasKey` liftedRepDataConKey = ASSERT( null args ) True
   | otherwise                          = False
 
@@ -549,9 +580,8 @@ isUnliftedRuntimeRep :: Type -> Bool
 -- False of           (LiftedRep :: RuntimeRep)
 --   and of variables (a :: RuntimeRep)
 isUnliftedRuntimeRep rep
-  | Just rep' <- coreView rep = isUnliftedRuntimeRep rep'
-  | TyConApp rr_tc _ <- rep   -- NB: args might be non-empty
-                              --     e.g. TupleRep [r1, .., rn]
+  | TyConApp rr_tc _ <- coreFullView rep   -- NB: args might be non-empty
+                                           --     e.g. TupleRep [r1, .., rn]
   = isPromotedDataCon rr_tc && not (rr_tc `hasKey` liftedRepDataConKey)
         -- Avoid searching all the unlifted RuntimeRep type cons
         -- In the RuntimeRep data type, only LiftedRep is lifted
@@ -561,10 +591,11 @@ isUnliftedRuntimeRep rep
 
 -- | Is this the type 'RuntimeRep'?
 isRuntimeRepTy :: Type -> Bool
-isRuntimeRepTy ty | Just ty' <- coreView ty = isRuntimeRepTy ty'
-isRuntimeRepTy (TyConApp tc args)
-  | tc `hasKey` runtimeRepTyConKey = ASSERT( null args ) True
-isRuntimeRepTy _ = False
+isRuntimeRepTy ty
+  | TyConApp tc args <- coreFullView ty
+  , tc `hasKey` runtimeRepTyConKey = ASSERT( null args ) True
+
+  | otherwise = False
 
 -- | Is a tyvar of type 'RuntimeRep'?
 isRuntimeRepVar :: TyVar -> Bool
@@ -572,27 +603,14 @@ isRuntimeRepVar = isRuntimeRepTy . tyVarKind
 
 -- | Is this the type 'Multiplicity'?
 isMultiplicityTy :: Type -> Bool
-isMultiplicityTy ty | Just ty' <- coreView ty = isMultiplicityTy ty'
-isMultiplicityTy (TyConApp tc []) = tc `hasKey` multiplicityTyConKey
-isMultiplicityTy _ = False
+isMultiplicityTy ty
+  | TyConApp tc [] <- coreFullView ty = tc `hasKey` multiplicityTyConKey
+  | otherwise                         = False
 
 -- | Is a tyvar of type 'Multiplicity'?
 isMultiplicityVar :: TyVar -> Bool
 isMultiplicityVar = isMultiplicityTy . tyVarKind
 
-isLinearType :: Type -> Bool
--- ^ @isLinear t@ returns @True@ of a if @t@ is a type of (curried) function
--- where at least one argument is linear (or otherwise non-unrestricted). We use
--- this function to check whether it is safe to eta reduce an Id in CorePrep. It
--- is always safe to return 'True', because 'True' deactivates the optimisation.
-isLinearType ty = case ty of
-                      FunTy _ Many _ res -> isLinearType res
-                      FunTy _ _ _ _ -> True
-                      ForAllTy _ res -> isLinearType res
-                      _
-                        | Just ty' <- coreView ty -> isLinearType ty'
-                        | otherwise -> False
-
 {- *********************************************************************
 *                                                                      *
                mapType
@@ -780,17 +798,15 @@ isTyVarTy ty = isJust (getTyVar_maybe ty)
 
 -- | Attempts to obtain the type variable underlying a 'Type'
 getTyVar_maybe :: Type -> Maybe TyVar
-getTyVar_maybe ty | Just ty' <- coreView ty = getTyVar_maybe ty'
-                  | otherwise               = repGetTyVar_maybe ty
+getTyVar_maybe = repGetTyVar_maybe . coreFullView
 
 -- | If the type is a tyvar, possibly under a cast, returns it, along
 -- with the coercion. Thus, the co is :: kind tv ~N kind ty
 getCastedTyVar_maybe :: Type -> Maybe (TyVar, CoercionN)
-getCastedTyVar_maybe ty | Just ty' <- coreView ty = getCastedTyVar_maybe ty'
-getCastedTyVar_maybe (CastTy (TyVarTy tv) co)     = Just (tv, co)
-getCastedTyVar_maybe (TyVarTy tv)
-  = Just (tv, mkReflCo Nominal (tyVarKind tv))
-getCastedTyVar_maybe _                            = Nothing
+getCastedTyVar_maybe ty = case coreFullView ty of
+  CastTy (TyVarTy tv) co -> Just (tv, co)
+  TyVarTy tv             -> Just (tv, mkReflCo Nominal (tyVarKind tv))
+  _                      -> Nothing
 
 -- | Attempts to obtain the type variable underlying a 'Type', without
 -- any expansion
@@ -869,9 +885,7 @@ splitAppTy_maybe :: Type -> Maybe (Type, Type)
 -- ^ Attempt to take a type application apart, whether it is a
 -- function, type constructor, or plain type application. Note
 -- that type family applications are NEVER unsaturated by this!
-splitAppTy_maybe ty | Just ty' <- coreView ty
-                    = splitAppTy_maybe ty'
-splitAppTy_maybe ty = repSplitAppTy_maybe ty
+splitAppTy_maybe = repSplitAppTy_maybe . coreFullView
 
 -------------
 repSplitAppTy_maybe :: HasDebugCallStack => Type -> Maybe (Type,Type)
@@ -978,24 +992,24 @@ mkNumLitTy n = LitTy (NumTyLit n)
 
 -- | Is this a numeric literal. We also look through type synonyms.
 isNumLitTy :: Type -> Maybe Integer
-isNumLitTy ty | Just ty1 <- coreView ty = isNumLitTy ty1
-isNumLitTy (LitTy (NumTyLit n)) = Just n
-isNumLitTy _                    = Nothing
+isNumLitTy ty
+  | LitTy (NumTyLit n) <- coreFullView ty = Just n
+  | otherwise                             = Nothing
 
 mkStrLitTy :: FastString -> Type
 mkStrLitTy s = LitTy (StrTyLit s)
 
 -- | Is this a symbol literal. We also look through type synonyms.
 isStrLitTy :: Type -> Maybe FastString
-isStrLitTy ty | Just ty1 <- coreView ty = isStrLitTy ty1
-isStrLitTy (LitTy (StrTyLit s)) = Just s
-isStrLitTy _                    = Nothing
+isStrLitTy ty
+  | LitTy (StrTyLit s) <- coreFullView ty = Just s
+  | otherwise                             = Nothing
 
 -- | Is this a type literal (symbol or numeric).
 isLitTy :: Type -> Maybe TyLit
-isLitTy ty | Just ty1 <- coreView ty = isLitTy ty1
-isLitTy (LitTy l)                    = Just l
-isLitTy _                            = Nothing
+isLitTy ty
+  | LitTy l <- coreFullView ty = Just l
+  | otherwise                  = Nothing
 
 -- | Is this type a custom user error?
 -- If so, give us the kind and the error message.
@@ -1073,37 +1087,37 @@ In the compiler we maintain the invariant that all saturated applications of
 See #11714.
 -}
 
-splitFunTy :: Type -> (Scaled Type, Type)
+splitFunTy :: Type -> (Type, Type, Type)
 -- ^ Attempts to extract the argument and result types from a type, and
 -- panics if that is not possible. See also 'splitFunTy_maybe'
-splitFunTy ty | Just ty' <- coreView ty = splitFunTy ty'
-splitFunTy (FunTy _ w arg res) = (Scaled w arg, res)
-splitFunTy other           = pprPanic "splitFunTy" (ppr other)
+splitFunTy = expectJust "splitFunTy" . splitFunTy_maybe
 
-splitFunTy_maybe :: Type -> Maybe (Scaled Type, Type)
+{-# INLINE splitFunTy_maybe #-}
+splitFunTy_maybe :: Type -> Maybe (Type, Type, Type)
 -- ^ Attempts to extract the argument and result types from a type
-splitFunTy_maybe ty | Just ty' <- coreView ty = splitFunTy_maybe ty'
-splitFunTy_maybe (FunTy _ w arg res) = Just (Scaled w arg, res)
-splitFunTy_maybe _               = Nothing
+splitFunTy_maybe ty
+  | FunTy _ w arg res <- coreFullView ty = Just (w, arg, res)
+  | otherwise                            = Nothing
 
 splitFunTys :: Type -> ([Scaled Type], Type)
 splitFunTys ty = split [] ty ty
   where
-    split args orig_ty ty | Just ty' <- coreView ty = split args orig_ty ty'
+      -- common case first
     split args _       (FunTy _ w arg res) = split ((Scaled w arg):args) res res
+    split args orig_ty ty | Just ty' <- coreView ty = split args orig_ty ty'
     split args orig_ty _                   = (reverse args, orig_ty)
 
 funResultTy :: Type -> Type
 -- ^ Extract the function result type and panic if that is not possible
-funResultTy ty | Just ty' <- coreView ty = funResultTy ty'
-funResultTy (FunTy { ft_res = res }) = res
-funResultTy ty                       = pprPanic "funResultTy" (ppr ty)
+funResultTy ty
+  | FunTy { ft_res = res } <- coreFullView ty = res
+  | otherwise                                 = pprPanic "funResultTy" (ppr ty)
 
 funArgTy :: Type -> Type
 -- ^ Extract the function argument type and panic if that is not possible
-funArgTy ty | Just ty' <- coreView ty = funArgTy ty'
-funArgTy (FunTy { ft_arg = arg })    = arg
-funArgTy ty                           = pprPanic "funArgTy" (ppr ty)
+funArgTy ty
+  | FunTy { ft_arg = arg } <- coreFullView ty = arg
+  | otherwise                                 = pprPanic "funArgTy" (ppr ty)
 
 -- ^ Just like 'piResultTys' but for a single argument
 -- Try not to iterate 'piResultTy', because it's inefficient to substitute
@@ -1116,19 +1130,15 @@ piResultTy ty arg = case piResultTy_maybe ty arg of
 piResultTy_maybe :: Type -> Type -> Maybe Type
 -- We don't need a 'tc' version, because
 -- this function behaves the same for Type and Constraint
-piResultTy_maybe ty arg
-  | Just ty' <- coreView ty = piResultTy_maybe ty' arg
+piResultTy_maybe ty arg = case coreFullView ty of
+  FunTy { ft_res = res } -> Just res
 
-  | FunTy { ft_res = res } <- ty
-  = Just res
+  ForAllTy (Bndr tv _) res
+    -> let empty_subst = mkEmptyTCvSubst $ mkInScopeSet $
+                         tyCoVarsOfTypes [arg,res]
+       in Just (substTy (extendTCvSubst empty_subst tv arg) res)
 
-  | ForAllTy (Bndr tv _) res <- ty
-  = let empty_subst = mkEmptyTCvSubst $ mkInScopeSet $
-                      tyCoVarsOfTypes [arg,res]
-    in Just (substTy (extendTCvSubst empty_subst tv arg) res)
-
-  | otherwise
-  = Nothing
+  _ -> Nothing
 
 -- | (piResultTys f_ty [ty1, .., tyn]) gives the type of (f ty1 .. tyn)
 --   where f :: f_ty
@@ -1154,15 +1164,15 @@ piResultTy_maybe ty arg
 piResultTys :: HasDebugCallStack => Type -> [Type] -> Type
 piResultTys ty [] = ty
 piResultTys ty orig_args@(arg:args)
-  | Just ty' <- coreView ty
-  = piResultTys ty' orig_args
-
   | FunTy { ft_res = res } <- ty
   = piResultTys res args
 
   | ForAllTy (Bndr tv _) res <- ty
   = go (extendTCvSubst init_subst tv arg) res args
 
+  | Just ty' <- coreView ty
+  = piResultTys ty' orig_args
+
   | otherwise
   = pprPanic "piResultTys1" (ppr ty $$ ppr orig_args)
   where
@@ -1172,15 +1182,15 @@ piResultTys ty orig_args@(arg:args)
     go subst ty [] = substTyUnchecked subst ty
 
     go subst ty all_args@(arg:args)
-      | Just ty' <- coreView ty
-      = go subst ty' all_args
-
       | FunTy { ft_res = res } <- ty
       = go subst res args
 
       | ForAllTy (Bndr tv _) res <- ty
       = go (extendTCvSubst subst tv arg) res args
 
+      | Just ty' <- coreView ty
+      = go subst ty' all_args
+
       | not (isEmptyTCvSubst subst)  -- See Note [Care with kind instantiation]
       = go init_subst
           (substTy subst ty)
@@ -1234,58 +1244,11 @@ So again we must instantiate.
 
 The same thing happens in GHC.CoreToIface.toIfaceAppArgsX.
 
---------------------------------------
-Note [mkTyConApp and Type]
-
-Whilst benchmarking it was observed in #17292 that GHC allocated a lot
-of `TyConApp` constructors. Upon further inspection a large number of these
-TyConApp constructors were all duplicates of `Type` applied to no arguments.
-
-```
-(From a sample of 100000 TyConApp closures)
-0x45f3523    - 28732 - `Type`
-0x420b840702 - 9629  - generic type constructors
-0x42055b7e46 - 9596
-0x420559b582 - 9511
-0x420bb15a1e - 9509
-0x420b86c6ba - 9501
-0x42055bac1e - 9496
-0x45e68fd    - 538 - `TYPE ...`
-```
-
-Therefore in `mkTyConApp` we have a special case for `Type` to ensure that
-only one `TyConApp 'Type []` closure is allocated during the course of
-compilation. In order to avoid a potentially expensive series of checks in
-`mkTyConApp` only this egregious case is special cased at the moment.
-
-
 ---------------------------------------------------------------------
                                 TyConApp
                                 ~~~~~~~~
 -}
 
--- | A key function: builds a 'TyConApp' or 'FunTy' as appropriate to
--- its arguments.  Applies its arguments to the constructor from left to right.
-mkTyConApp :: TyCon -> [Type] -> Type
-mkTyConApp tycon tys
-  | isFunTyCon tycon
-  , [w, _rep1,_rep2,ty1,ty2] <- tys
-  -- The FunTyCon (->) is always a visible one
-  = FunTy { ft_af = VisArg, ft_mult = w, ft_arg = ty1, ft_res = ty2 }
-
-  -- Note [mkTyConApp and Type]
-  | tycon == liftedTypeKindTyCon
-  = ASSERT2( null tys, ppr tycon $$ ppr tys )
-    liftedTypeKindTyConApp
-  | otherwise
-  = TyConApp tycon tys
-
--- This is a single, global definition of the type `Type`
--- Defined here so it is only allocated once.
--- See Note [mkTyConApp and Type]
-liftedTypeKindTyConApp :: Type
-liftedTypeKindTyConApp = TyConApp liftedTypeKindTyCon []
-
 -- splitTyConApp "looks through" synonyms, because they don't
 -- mean a distinct type, but all other type-constructor applications
 -- including functions are returned as Just ..
@@ -1299,24 +1262,25 @@ tyConAppTyConPicky_maybe _               = Nothing
 
 
 -- | The same as @fst . splitTyConApp@
+{-# INLINE tyConAppTyCon_maybe #-}
 tyConAppTyCon_maybe :: Type -> Maybe TyCon
-tyConAppTyCon_maybe ty | Just ty' <- coreView ty = tyConAppTyCon_maybe ty'
-tyConAppTyCon_maybe (TyConApp tc _) = Just tc
-tyConAppTyCon_maybe (FunTy {})      = Just funTyCon
-tyConAppTyCon_maybe _               = Nothing
+tyConAppTyCon_maybe ty = case coreFullView ty of
+  TyConApp tc _ -> Just tc
+  FunTy {}      -> Just funTyCon
+  _             -> Nothing
 
 tyConAppTyCon :: Type -> TyCon
 tyConAppTyCon ty = tyConAppTyCon_maybe ty `orElse` pprPanic "tyConAppTyCon" (ppr ty)
 
 -- | The same as @snd . splitTyConApp@
 tyConAppArgs_maybe :: Type -> Maybe [Type]
-tyConAppArgs_maybe ty | Just ty' <- coreView ty = tyConAppArgs_maybe ty'
-tyConAppArgs_maybe (TyConApp _ tys) = Just tys
-tyConAppArgs_maybe (FunTy _ w arg res)
-  | Just rep1 <- getRuntimeRep_maybe arg
-  , Just rep2 <- getRuntimeRep_maybe res
-  = Just [w, rep1, rep2, arg, res]
-tyConAppArgs_maybe _  = Nothing
+tyConAppArgs_maybe ty = case coreFullView ty of
+  TyConApp _ tys -> Just tys
+  FunTy _ w arg res
+    | Just rep1 <- getRuntimeRep_maybe arg
+    , Just rep2 <- getRuntimeRep_maybe res
+    -> Just [w, rep1, rep2, arg, res]
+  _ -> Nothing
 
 tyConAppArgs :: Type -> [Type]
 tyConAppArgs ty = tyConAppArgs_maybe ty `orElse` pprPanic "tyConAppArgs" (ppr ty)
@@ -1339,8 +1303,7 @@ splitTyConApp ty = case splitTyConApp_maybe ty of
 -- | Attempts to tease a type apart into a type constructor and the application
 -- of a number of arguments to that constructor
 splitTyConApp_maybe :: HasDebugCallStack => Type -> Maybe (TyCon, [Type])
-splitTyConApp_maybe ty | Just ty' <- coreView ty = splitTyConApp_maybe ty'
-splitTyConApp_maybe ty                           = repSplitTyConApp_maybe ty
+splitTyConApp_maybe = repSplitTyConApp_maybe . coreFullView
 
 -- | Split a type constructor application into its type constructor and
 -- applied types. Note that this may fail in the case of a 'FunTy' with an
@@ -1398,9 +1361,9 @@ A casted type has its *kind* casted into something new.
 -}
 
 splitCastTy_maybe :: Type -> Maybe (Type, Coercion)
-splitCastTy_maybe ty | Just ty' <- coreView ty = splitCastTy_maybe ty'
-splitCastTy_maybe (CastTy ty co)               = Just (ty, co)
-splitCastTy_maybe _                            = Nothing
+splitCastTy_maybe ty
+  | CastTy ty' co <- coreFullView ty = Just (ty', co)
+  | otherwise                        = Nothing
 
 -- | Make a 'CastTy'. The Coercion must be nominal. Checks the
 -- Coercion for reflexivity, dropping it if it's reflexive.
@@ -1543,41 +1506,6 @@ mkVisForAllTys tvs = ASSERT( all isTyVar tvs )
                      -- covar is always Inferred, so all inputs should be tyvar
                      mkForAllTys [ Bndr tv Required | tv <- tvs ]
 
-mkLamType  :: Var -> Type -> Type
--- ^ Makes a @(->)@ type or an implicit forall type, depending
--- on whether it is given a type variable or a term variable.
--- This is used, for example, when producing the type of a lambda.
--- Always uses Inferred binders.
-mkLamTypes :: [Var] -> Type -> Type
--- ^ 'mkLamType' for multiple type or value arguments
-
-mkLamTypes vs ty = foldr mkLamType ty vs
-
-mkLamType v body_ty
-   | isTyVar v
-   = ForAllTy (Bndr v Inferred) body_ty
-
-   | isCoVar v
-   , v `elemVarSet` tyCoVarsOfType body_ty
-   = ForAllTy (Bndr v Required) body_ty
-
-   | otherwise
-   = mkFunctionType arg_mult arg_ty body_ty
-   where
-    Scaled arg_mult arg_ty = varScaledType v
-
-
-mkFunctionType :: Mult -> Type -> Type -> Type
--- This one works out the AnonArgFlag from the argument type
--- See GHC.Types.Var Note [AnonArgFlag]
-mkFunctionType mult arg_ty res_ty
-   | isPredTy arg_ty -- See GHC.Types.Var Note [AnonArgFlag]
-   = ASSERT(eqType mult Many)
-     mkInvisFunTy mult arg_ty res_ty
-
-   | otherwise
-   = mkVisFunTy mult arg_ty res_ty
-
 -- | Given a list of type-level vars and the free vars of a result kind,
 -- makes TyCoBinders, preferring anonymous binders
 -- if the variable is, in fact, not dependent.
@@ -1609,8 +1537,8 @@ mkTyConBindersPreferAnon vars inner_tkvs = ASSERT( all isTyVar vars)
 splitForAllTys :: Type -> ([TyCoVar], Type)
 splitForAllTys ty = split ty ty []
   where
-    split orig_ty ty tvs | Just ty' <- coreView ty = split orig_ty ty' tvs
     split _       (ForAllTy (Bndr tv _) ty)    tvs = split ty ty (tv:tvs)
+    split orig_ty ty tvs | Just ty' <- coreView ty = split orig_ty ty' tvs
     split orig_ty _                            tvs = (reverse tvs, orig_ty)
 
 -- | Like 'splitForAllTys', but only splits a 'ForAllTy' if @argf_pred argf@
@@ -1620,9 +1548,9 @@ splitForAllTys ty = split ty ty []
 splitSomeForAllTys :: (ArgFlag -> Bool) -> Type -> ([TyCoVarBinder], Type)
 splitSomeForAllTys argf_pred ty = split ty ty []
   where
-    split orig_ty ty tvs | Just ty' <- coreView ty = split orig_ty ty' tvs
     split _       (ForAllTy tvb@(Bndr _ argf) ty) tvs
       | argf_pred argf                             = split ty ty (tvb:tvs)
+    split orig_ty ty tvs | Just ty' <- coreView ty = split orig_ty ty' tvs
     split orig_ty _                            tvs = (reverse tvs, orig_ty)
 
 -- | Like 'splitForAllTys', but only splits 'ForAllTy's with 'Required' type
@@ -1660,40 +1588,46 @@ splitForAllTysInvis ty =
 splitTyVarForAllTys :: Type -> ([TyVar], Type)
 splitTyVarForAllTys ty = split ty ty []
   where
-    split orig_ty ty tvs | Just ty' <- coreView ty     = split orig_ty ty' tvs
     split _ (ForAllTy (Bndr tv _) ty) tvs | isTyVar tv = split ty ty (tv:tvs)
+    split orig_ty ty tvs | Just ty' <- coreView ty     = split orig_ty ty' tvs
     split orig_ty _                   tvs              = (reverse tvs, orig_ty)
 
 -- | Checks whether this is a proper forall (with a named binder)
 isForAllTy :: Type -> Bool
-isForAllTy ty | Just ty' <- coreView ty = isForAllTy ty'
-isForAllTy (ForAllTy {}) = True
-isForAllTy _             = False
+isForAllTy ty
+  | ForAllTy {} <- coreFullView ty = True
+  | otherwise                      = False
 
 -- | Like `isForAllTy`, but returns True only if it is a tyvar binder
 isForAllTy_ty :: Type -> Bool
-isForAllTy_ty ty | Just ty' <- coreView ty = isForAllTy_ty ty'
-isForAllTy_ty (ForAllTy (Bndr tv _) _) | isTyVar tv = True
-isForAllTy_ty _             = False
+isForAllTy_ty ty
+  | ForAllTy (Bndr tv _) _ <- coreFullView ty
+  , isTyVar tv
+  = True
+
+  | otherwise = False
 
 -- | Like `isForAllTy`, but returns True only if it is a covar binder
 isForAllTy_co :: Type -> Bool
-isForAllTy_co ty | Just ty' <- coreView ty = isForAllTy_co ty'
-isForAllTy_co (ForAllTy (Bndr tv _) _) | isCoVar tv = True
-isForAllTy_co _             = False
+isForAllTy_co ty
+  | ForAllTy (Bndr tv _) _ <- coreFullView ty
+  , isCoVar tv
+  = True
+
+  | otherwise = False
 
 -- | Is this a function or forall?
 isPiTy :: Type -> Bool
-isPiTy ty | Just ty' <- coreView ty = isPiTy ty'
-isPiTy (ForAllTy {}) = True
-isPiTy (FunTy {})    = True
-isPiTy _             = False
+isPiTy ty = case coreFullView ty of
+  ForAllTy {} -> True
+  FunTy {}    -> True
+  _           -> False
 
 -- | Is this a function?
 isFunTy :: Type -> Bool
-isFunTy ty | Just ty' <- coreView ty = isFunTy ty'
-isFunTy (FunTy {}) = True
-isFunTy _          = False
+isFunTy ty
+  | FunTy {} <- coreFullView ty = True
+  | otherwise                   = False
 
 -- | Take a forall type apart, or panics if that is not possible.
 splitForAllTy :: Type -> (TyCoVar, Type)
@@ -1705,45 +1639,44 @@ splitForAllTy ty
 dropForAlls :: Type -> Type
 dropForAlls ty = go ty
   where
-    go ty | Just ty' <- coreView ty = go ty'
     go (ForAllTy _ res)            = go res
+    go ty | Just ty' <- coreView ty = go ty'
     go res                         = res
 
 -- | Attempts to take a forall type apart, but only if it's a proper forall,
 -- with a named binder
 splitForAllTy_maybe :: Type -> Maybe (TyCoVar, Type)
-splitForAllTy_maybe ty = go ty
-  where
-    go ty | Just ty' <- coreView ty = go ty'
-    go (ForAllTy (Bndr tv _) ty)    = Just (tv, ty)
-    go _                            = Nothing
+splitForAllTy_maybe ty
+  | ForAllTy (Bndr tv _) inner_ty <- coreFullView ty = Just (tv, inner_ty)
+  | otherwise                                        = Nothing
 
 -- | Like splitForAllTy_maybe, but only returns Just if it is a tyvar binder.
 splitForAllTy_ty_maybe :: Type -> Maybe (TyCoVar, Type)
-splitForAllTy_ty_maybe ty = go ty
-  where
-    go ty | Just ty' <- coreView ty = go ty'
-    go (ForAllTy (Bndr tv _) ty) | isTyVar tv = Just (tv, ty)
-    go _                            = Nothing
+splitForAllTy_ty_maybe ty
+  | ForAllTy (Bndr tv _) inner_ty <- coreFullView ty
+  , isTyVar tv
+  = Just (tv, inner_ty)
+
+  | otherwise = Nothing
 
 -- | Like splitForAllTy_maybe, but only returns Just if it is a covar binder.
 splitForAllTy_co_maybe :: Type -> Maybe (TyCoVar, Type)
-splitForAllTy_co_maybe ty = go ty
-  where
-    go ty | Just ty' <- coreView ty = go ty'
-    go (ForAllTy (Bndr tv _) ty) | isCoVar tv = Just (tv, ty)
-    go _                            = Nothing
+splitForAllTy_co_maybe ty
+  | ForAllTy (Bndr tv _) inner_ty <- coreFullView ty
+  , isCoVar tv
+  = Just (tv, inner_ty)
+
+  | otherwise = Nothing
 
 -- | Attempts to take a forall type apart; works with proper foralls and
 -- functions
+{-# INLINE splitPiTy_maybe #-}  -- callers will immediately deconstruct
 splitPiTy_maybe :: Type -> Maybe (TyCoBinder, Type)
-splitPiTy_maybe ty = go ty
-  where
-    go ty | Just ty' <- coreView ty = go ty'
-    go (ForAllTy bndr ty) = Just (Named bndr, ty)
-    go (FunTy { ft_af = af, ft_mult = w, ft_arg = arg, ft_res = res})
-                          = Just (Anon af (mkScaled w arg), res)
-    go _                  = Nothing
+splitPiTy_maybe ty = case coreFullView ty of
+  ForAllTy bndr ty -> Just (Named bndr, ty)
+  FunTy { ft_af = af, ft_mult = w, ft_arg = arg, ft_res = res}
+                   -> Just (Anon af (mkScaled w arg), res)
+  _                -> Nothing
 
 -- | Takes a forall type apart, or panics
 splitPiTy :: Type -> (TyCoBinder, Type)
@@ -1756,10 +1689,10 @@ splitPiTy ty
 splitPiTys :: Type -> ([TyCoBinder], Type)
 splitPiTys ty = split ty ty []
   where
-    split orig_ty ty bs | Just ty' <- coreView ty = split orig_ty ty' bs
     split _       (ForAllTy b res) bs = split res res (Named b  : bs)
     split _       (FunTy { ft_af = af, ft_mult = w, ft_arg = arg, ft_res = res }) bs
                                       = split res res (Anon af (Scaled w arg) : bs)
+    split orig_ty ty bs | Just ty' <- coreView ty = split orig_ty ty' bs
     split orig_ty _                bs = (reverse bs, orig_ty)
 
 -- | Like 'splitPiTys' but split off only /named/ binders
@@ -1784,13 +1717,13 @@ invisibleTyBndrCount ty = length (fst (splitPiTysInvisible ty))
 splitPiTysInvisible :: Type -> ([TyCoBinder], Type)
 splitPiTysInvisible ty = split ty ty []
    where
-    split orig_ty ty bs
-      | Just ty' <- coreView ty  = split orig_ty ty' bs
     split _ (ForAllTy b res) bs
       | Bndr _ vis <- b
       , isInvisibleArgFlag vis   = split res res (Named b  : bs)
     split _ (FunTy { ft_af = InvisArg, ft_mult = mult, ft_arg = arg, ft_res = res })  bs
                                  = split res res (Anon InvisArg (mkScaled mult arg) : bs)
+    split orig_ty ty bs
+      | Just ty' <- coreView ty  = split orig_ty ty' bs
     split orig_ty _          bs  = (reverse bs, orig_ty)
 
 splitPiTysInvisibleN :: Int -> Type -> ([TyCoBinder], Type)
@@ -2048,12 +1981,10 @@ buildSynTyCon name binders res_kind roles rhs
 -- levity polymorphic), and panics if the kind does not have the shape
 -- TYPE r.
 isLiftedType_maybe :: HasDebugCallStack => Type -> Maybe Bool
-isLiftedType_maybe ty = go (getRuntimeRep ty)
-  where
-    go rr | Just rr' <- coreView rr = go rr'
-          | isLiftedRuntimeRep rr  = Just True
-          | TyConApp {} <- rr      = Just False  -- Everything else is unlifted
-          | otherwise              = Nothing     -- levity polymorphic
+isLiftedType_maybe ty = case coreFullView (getRuntimeRep ty) of
+  ty' | isLiftedRuntimeRep ty'  -> Just True
+  TyConApp {}                   -> Just False  -- Everything else is unlifted
+  _                             -> Nothing     -- levity polymorphic
 
 -- | See "Type#type_classification" for what an unlifted type is.
 -- Panics on levity polymorphic types; See 'mightBeUnliftedType' for
@@ -2179,7 +2110,7 @@ isValidJoinPointType arity ty
       = tvs `disjointVarSet` tyCoVarsOfType ty
       | Just (t, ty') <- splitForAllTy_maybe ty
       = valid_under (tvs `extendVarSet` t) (arity-1) ty'
-      | Just (_, res_ty) <- splitFunTy_maybe ty
+      | Just (_, _, res_ty) <- splitFunTy_maybe ty
       = valid_under tvs (arity-1) res_ty
       | otherwise
       = False
@@ -2309,11 +2240,14 @@ See Note [Unique Determinism] for more details.
 -}
 
 nonDetCmpType :: Type -> Type -> Ordering
+nonDetCmpType (TyConApp tc1 []) (TyConApp tc2 []) | tc1 == tc2
+  = EQ
 nonDetCmpType t1 t2
   -- we know k1 and k2 have the same kind, because they both have kind *.
   = nonDetCmpTypeX rn_env t1 t2
   where
     rn_env = mkRnEnv2 (mkInScopeSet (tyCoVarsOfTypes [t1, t2]))
+{-# INLINE nonDetCmpType #-}
 
 nonDetCmpTypes :: [Type] -> [Type] -> Ordering
 nonDetCmpTypes ts1 ts2 = nonDetCmpTypesX rn_env ts1 ts2
@@ -2382,8 +2316,8 @@ nonDetCmpTypeX env orig_t1 orig_t2 =
       | Just (s1, t1) <- repSplitAppTy_maybe ty1
       = go env s1 s2 `thenCmpTy` go env t1 t2
     go env (FunTy _ w1 s1 t1) (FunTy _ w2 s2 t2)
-      = go env w1 w2 `thenCmpTy`
-        go env s1 s2 `thenCmpTy` go env t1 t2
+      = go env s1 s2 `thenCmpTy` go env t1 t2 `thenCmpTy` go env w1 w2
+        -- Comparing multiplicities last because the test is usually true
     go env (TyConApp tc1 tys1) (TyConApp tc2 tys2)
       = liftOrdering (tc1 `nonDetCmpTc` tc2) `thenCmpTy` gos env tys1 tys2
     go _   (LitTy l1)          (LitTy l2)          = liftOrdering (compare l1 l2)
@@ -2775,7 +2709,7 @@ occCheckExpand vs_to_avoid ty
                                 ; return (mkCoercionTy co') }
 
     ------------------
-    go_var cxt v = updateVarTypeAndMultM (go cxt) v
+    go_var cxt v = updateVarTypeM (go cxt) v
            -- Works for TyVar and CoVar
            -- See Note [Occurrence checking: look inside kinds]
 
@@ -3320,3 +3254,66 @@ be reified as:
 So the kind of G isn't ambiguous anymore due to the explicit kind annotation
 on its argument. See #8953 and test th/T8953.
 -}
+
+{-
+************************************************************************
+*                                                                      *
+        Multiplicities
+*                                                                      *
+************************************************************************
+
+These functions would prefer to be in GHC.Core.Multiplicity, but
+they some are used elsewhere in this module, and wanted to bring
+their friends here with them.
+-}
+
+unrestricted, linear, tymult :: a -> Scaled a
+
+-- | Scale a payload by Many
+unrestricted = Scaled Many
+
+-- | Scale a payload by One
+linear = Scaled One
+
+-- | Scale a payload by Many; used for type arguments in core
+tymult = Scaled Many
+
+irrelevantMult :: Scaled a -> a
+irrelevantMult = scaledThing
+
+mkScaled :: Mult -> a -> Scaled a
+mkScaled = Scaled
+
+scaledSet :: Scaled a -> b -> Scaled b
+scaledSet (Scaled m _) b = Scaled m b
+
+pattern One :: Mult
+pattern One <- (isOneDataConTy -> True)
+  where One = oneDataConTy
+
+pattern Many :: Mult
+pattern Many <- (isManyDataConTy -> True)
+  where Many = manyDataConTy
+
+isManyDataConTy :: Mult -> Bool
+isManyDataConTy ty
+  | Just tc <- tyConAppTyCon_maybe ty
+  = tc `hasKey` manyDataConKey
+isManyDataConTy _ = False
+
+isOneDataConTy :: Mult -> Bool
+isOneDataConTy ty
+  | Just tc <- tyConAppTyCon_maybe ty
+  = tc `hasKey` oneDataConKey
+isOneDataConTy _ = False
+
+isLinearType :: Type -> Bool
+-- ^ @isLinear t@ returns @True@ of a if @t@ is a type of (curried) function
+-- where at least one argument is linear (or otherwise non-unrestricted). We use
+-- this function to check whether it is safe to eta reduce an Id in CorePrep. It
+-- is always safe to return 'True', because 'True' deactivates the optimisation.
+isLinearType ty = case ty of
+                      FunTy _ Many _ res -> isLinearType res
+                      FunTy _ _ _ _ -> True
+                      ForAllTy _ res -> isLinearType res
+                      _ -> False
diff --git a/compiler/GHC/Core/Type.hs-boot b/compiler/GHC/Core/Type.hs-boot
index 1faf4304ab..bada997f3b 100644
--- a/compiler/GHC/Core/Type.hs-boot
+++ b/compiler/GHC/Core/Type.hs-boot
@@ -14,8 +14,6 @@ mkAppTy    :: Type -> Type -> Type
 mkCastTy   :: Type -> Coercion -> Type
 piResultTy :: HasDebugCallStack => Type -> Type -> Type
 
-eqType :: Type -> Type -> Bool
-
 coreView :: Type -> Maybe Type
 tcView :: Type -> Maybe Type
 isRuntimeRepTy :: Type -> Bool
@@ -23,7 +21,6 @@ isMultiplicityTy :: Type -> Bool
 isLiftedTypeKind :: Type -> Bool
 
 splitTyConApp_maybe :: HasDebugCallStack => Type -> Maybe (TyCon, [Type])
-
-mkTyConApp :: TyCon -> [Type] -> Type
+tyConAppTyCon_maybe :: Type -> Maybe TyCon
 
 partitionInvisibleTypes :: TyCon -> [Type] -> ([Type], [Type])
diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs
index 9748dd2753..65ded60520 100644
--- a/compiler/GHC/Core/Utils.hs
+++ b/compiler/GHC/Core/Utils.hs
@@ -23,7 +23,9 @@ module GHC.Core.Utils (
         scaleAltsBy,
 
         -- * Properties of expressions
-        exprType, coreAltType, coreAltsType, isExprLevPoly,
+        exprType, coreAltType, coreAltsType, mkLamType, mkLamTypes,
+        mkFunctionType,
+        isExprLevPoly,
         exprIsDupable, exprIsTrivial, getIdFromTrivialExpr, exprIsDeadEnd,
         getIdFromTrivialExpr_maybe,
         exprIsCheap, exprIsExpandable, exprIsCheapX, CheapAppFun,
@@ -151,6 +153,38 @@ coreAltsType :: [CoreAlt] -> Type
 coreAltsType (alt:_) = coreAltType alt
 coreAltsType []      = panic "corAltsType"
 
+mkLamType  :: Var -> Type -> Type
+-- ^ Makes a @(->)@ type or an implicit forall type, depending
+-- on whether it is given a type variable or a term variable.
+-- This is used, for example, when producing the type of a lambda.
+-- Always uses Inferred binders.
+mkLamTypes :: [Var] -> Type -> Type
+-- ^ 'mkLamType' for multiple type or value arguments
+
+mkLamType v body_ty
+   | isTyVar v
+   = mkForAllTy v Inferred body_ty
+
+   | isCoVar v
+   , v `elemVarSet` tyCoVarsOfType body_ty
+   = mkForAllTy v Required body_ty
+
+   | otherwise
+   = mkFunctionType (varMult v) (varType v) body_ty
+
+mkFunctionType :: Mult -> Type -> Type -> Type
+-- This one works out the AnonArgFlag from the argument type
+-- See GHC.Types.Var Note [AnonArgFlag]
+mkFunctionType mult arg_ty res_ty
+   | isPredTy arg_ty -- See GHC.Types.Var Note [AnonArgFlag]
+   = ASSERT(eqType mult Many)
+     mkInvisFunTy mult arg_ty res_ty
+
+   | otherwise
+   = mkVisFunTy mult arg_ty res_ty
+
+mkLamTypes vs ty = foldr mkLamType ty vs
+
 -- | Is this expression levity polymorphic? This should be the
 -- same as saying (isKindLevPoly . typeKind . exprType) but
 -- much faster.
@@ -237,7 +271,7 @@ applyTypeToArgs e op_ty args
     go op_ty []                   = op_ty
     go op_ty (Type ty : args)     = go_ty_args op_ty [ty] args
     go op_ty (Coercion co : args) = go_ty_args op_ty [mkCoercionTy co] args
-    go op_ty (_ : args)           | Just (_, res_ty) <- splitFunTy_maybe op_ty
+    go op_ty (_ : args)           | Just (_, _, res_ty) <- splitFunTy_maybe op_ty
                                   = go res_ty args
     go _ args = pprPanic "applyTypeToArgs" (panic_msg args)
 
@@ -944,7 +978,7 @@ scaleAltsBy w alts = map scaleAlt alts
     scaleAlt (con, bndrs, rhs) = (con, map scaleBndr bndrs, rhs)
 
     scaleBndr :: CoreBndr -> CoreBndr
-    scaleBndr = scaleVarBy w
+    scaleBndr b = scaleVarBy w b
 
 
 {- *********************************************************************
@@ -2454,13 +2488,13 @@ tryEtaReduce bndrs body
     ok_arg bndr (Var v) co fun_ty
        | bndr == v
        , let mult = idMult bndr
-       , Just (Scaled fun_mult _, _) <- splitFunTy_maybe fun_ty
+       , Just (fun_mult, _, _) <- splitFunTy_maybe fun_ty
        , mult `eqType` fun_mult -- There is no change in multiplicity, otherwise we must abort
        = let reflCo = mkRepReflCo (idType bndr)
          in Just (mkFunCo Representational (multToCo mult) reflCo co, [])
     ok_arg bndr (Cast e co_arg) co fun_ty
        | (ticks, Var v) <- stripTicksTop tickishFloatable e
-       , Just (Scaled fun_mult _, _) <- splitFunTy_maybe fun_ty
+       , Just (fun_mult, _, _) <- splitFunTy_maybe fun_ty
        , bndr == v
        , fun_mult `eqType` idMult bndr
        = Just (mkFunCo Representational (multToCo fun_mult) (mkSymCo co_arg) co, ticks)
diff --git a/compiler/GHC/Core/Utils.hs-boot b/compiler/GHC/Core/Utils.hs-boot
new file mode 100644
index 0000000000..6dab0d5963
--- /dev/null
+++ b/compiler/GHC/Core/Utils.hs-boot
@@ -0,0 +1,6 @@
+module GHC.Core.Utils where
+
+import GHC.Core.Multiplicity
+import GHC.Core.Type
+
+mkFunctionType :: Mult -> Type -> Type -> Type
diff --git a/compiler/GHC/CoreToByteCode.hs b/compiler/GHC/CoreToByteCode.hs
index 5c6b034360..a24fc52c69 100644
--- a/compiler/GHC/CoreToByteCode.hs
+++ b/compiler/GHC/CoreToByteCode.hs
@@ -29,7 +29,6 @@ import GHC.Platform
 import GHC.Types.Name
 import GHC.Types.Id.Make
 import GHC.Types.Id
-import GHC.Types.Var ( updateVarTypeButNotMult )
 import GHC.Types.ForeignCall
 import GHC.Driver.Types
 import GHC.Core.Utils
@@ -38,7 +37,6 @@ import GHC.Core.Ppr
 import GHC.Types.Literal
 import GHC.Builtin.PrimOps
 import GHC.Core.FVs
-import GHC.Core.Multiplicity ( pattern Many )
 import GHC.Core.Type
 import GHC.Types.RepType
 import GHC.Core.DataCon
@@ -710,7 +708,7 @@ protectNNLJoinPointBind x rhs@(fvs, _)
 protectNNLJoinPointId :: Id -> Id
 protectNNLJoinPointId x
   = ASSERT( isNNLJoinPoint x )
-    updateVarTypeButNotMult (voidPrimTy `mkVisFunTyMany`) x
+    updateIdTypeButNotMult (voidPrimTy `mkVisFunTyMany`) x
 
 {-
    Ticked Expressions
diff --git a/compiler/GHC/CoreToStg/Prep.hs b/compiler/GHC/CoreToStg/Prep.hs
index e846e29ecf..e4139139a8 100644
--- a/compiler/GHC/CoreToStg/Prep.hs
+++ b/compiler/GHC/CoreToStg/Prep.hs
@@ -33,7 +33,6 @@ import GHC.Core.Lint    ( endPassIO )
 import GHC.Core
 import GHC.Core.Make hiding( FloatBind(..) )   -- We use our own FloatBind here
 import GHC.Core.Type
-import GHC.Core.Multiplicity
 import GHC.Types.Literal
 import GHC.Core.Coercion
 import GHC.Tc.Utils.Env
@@ -917,11 +916,11 @@ cpeApp top_env expr
                    (_   : ss_rest, True)  -> (topDmd, ss_rest)
                    (ss1 : ss_rest, False) -> (ss1,    ss_rest)
                    ([],            _)     -> (topDmd, [])
-            (arg_ty, res_ty) =
+            (_, arg_ty, res_ty) =
               case splitFunTy_maybe fun_ty of
                 Just as -> as
                 Nothing -> pprPanic "cpeBody" (ppr fun_ty $$ ppr expr)
-        (fs, arg') <- cpeArg top_env ss1 arg (scaledThing arg_ty)
+        (fs, arg') <- cpeArg top_env ss1 arg arg_ty
         rebuild_app as (App fun' arg') res_ty (fs `appendFloats` floats) ss_rest
       CpeCast co ->
         let ty2 = coercionRKind co
diff --git a/compiler/GHC/HsToCore.hs b/compiler/GHC/HsToCore.hs
index 9297d1e4a0..af67088e51 100644
--- a/compiler/GHC/HsToCore.hs
+++ b/compiler/GHC/HsToCore.hs
@@ -43,7 +43,6 @@ import GHC.HsToCore.Monad
 import GHC.HsToCore.Expr
 import GHC.HsToCore.Binds
 import GHC.HsToCore.Foreign.Decl
-import GHC.Core.Multiplicity
 import GHC.Builtin.Names
 import GHC.Builtin.Types.Prim
 import GHC.Core.Coercion
diff --git a/compiler/GHC/HsToCore/Binds.hs b/compiler/GHC/HsToCore/Binds.hs
index dd4b76f945..f904bc2616 100644
--- a/compiler/GHC/HsToCore/Binds.hs
+++ b/compiler/GHC/HsToCore/Binds.hs
@@ -1267,8 +1267,8 @@ ds_ev_typeable ty (EvTypeableTyApp ev1 ev2)
        ; mkTrApp <- dsLookupGlobalId mkTrAppName
                     -- mkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1).
                     --            TypeRep a -> TypeRep b -> TypeRep (a b)
-       ; let (Scaled _ k1, k2) = splitFunTy (typeKind t1)  -- drop the multiplicity,
-                                                           -- since it's a kind
+       ; let (_, k1, k2) = splitFunTy (typeKind t1)  -- drop the multiplicity,
+                                                     -- since it's a kind
        ; let expr =  mkApps (mkTyApps (Var mkTrApp) [ k1, k2, t1, t2 ])
                             [ e1, e2 ]
        -- ; pprRuntimeTrace "Trace mkTrApp" (ppr expr) expr
@@ -1276,7 +1276,7 @@ ds_ev_typeable ty (EvTypeableTyApp ev1 ev2)
        }
 
 ds_ev_typeable ty (EvTypeableTrFun evm ev1 ev2)
-  | Just (Scaled m t1,t2) <- splitFunTy_maybe ty
+  | Just (m,t1,t2) <- splitFunTy_maybe ty
   = do { e1 <- getRep ev1 t1
        ; e2 <- getRep ev2 t2
        ; em <- getRep evm m
diff --git a/compiler/GHC/HsToCore/ListComp.hs b/compiler/GHC/HsToCore/ListComp.hs
index 05b1ce73fe..be8a2236d1 100644
--- a/compiler/GHC/HsToCore/ListComp.hs
+++ b/compiler/GHC/HsToCore/ListComp.hs
@@ -30,7 +30,6 @@ import GHC.Driver.Session
 import GHC.Core.Utils
 import GHC.Types.Id
 import GHC.Core.Type
-import GHC.Core.Multiplicity
 import GHC.Builtin.Types
 import GHC.HsToCore.Match
 import GHC.Builtin.Names
diff --git a/compiler/GHC/HsToCore/Match/Literal.hs b/compiler/GHC/HsToCore/Match/Literal.hs
index eb8f865aa1..3052ff18af 100644
--- a/compiler/GHC/HsToCore/Match/Literal.hs
+++ b/compiler/GHC/HsToCore/Match/Literal.hs
@@ -39,7 +39,6 @@ import GHC.Core
 import GHC.Core.Make
 import GHC.Core.TyCon
 import GHC.Core.DataCon
-import GHC.Core.Multiplicity
 import GHC.Tc.Utils.Zonk ( shortCutLit )
 import GHC.Tc.Utils.TcType
 import GHC.Types.Name
@@ -149,7 +148,7 @@ warnAboutIdentities :: DynFlags -> CoreExpr -> Type -> DsM ()
 warnAboutIdentities dflags (Var conv_fn) type_of_conv
   | wopt Opt_WarnIdentities dflags
   , idName conv_fn `elem` conversionNames
-  , Just (Scaled _ arg_ty, res_ty) <- splitFunTy_maybe type_of_conv
+  , Just (_, arg_ty, res_ty) <- splitFunTy_maybe type_of_conv
   , arg_ty `eqType` res_ty  -- So we are converting  ty -> ty
   = warnDs (Reason Opt_WarnIdentities)
            (vcat [ text "Call of" <+> ppr conv_fn <+> dcolon <+> ppr type_of_conv
diff --git a/compiler/GHC/HsToCore/PmCheck.hs b/compiler/GHC/HsToCore/PmCheck.hs
index 4e96ce35f7..67667ab90f 100644
--- a/compiler/GHC/HsToCore/PmCheck.hs
+++ b/compiler/GHC/HsToCore/PmCheck.hs
@@ -57,7 +57,6 @@ import GHC.Data.IOEnv (unsafeInterleaveM)
 import GHC.Data.OrdList
 import GHC.Core.TyCo.Rep
 import GHC.Core.Type
-import GHC.Core.Multiplicity
 import GHC.HsToCore.Utils       (isTrueLHsExpr)
 import GHC.Data.Maybe
 import qualified GHC.LanguageExtensions as LangExt
diff --git a/compiler/GHC/HsToCore/PmCheck/Oracle.hs b/compiler/GHC/HsToCore/PmCheck/Oracle.hs
index db1975e807..c16a1f1d95 100644
--- a/compiler/GHC/HsToCore/PmCheck/Oracle.hs
+++ b/compiler/GHC/HsToCore/PmCheck/Oracle.hs
@@ -68,7 +68,6 @@ import GHC.Utils.Monad hiding (foldlM)
 import GHC.HsToCore.Monad hiding (foldlM)
 import GHC.Tc.Instance.Family
 import GHC.Core.FamInstEnv
-import GHC.Core.Multiplicity
 
 import Control.Monad (guard, mzero, when)
 import Control.Monad.Trans.Class (lift)
diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs
index 709a3a1698..d29afc5b8d 100644
--- a/compiler/GHC/HsToCore/Utils.hs
+++ b/compiler/GHC/HsToCore/Utils.hs
@@ -66,7 +66,6 @@ import GHC.Core.TyCon
 import GHC.Core.DataCon
 import GHC.Core.PatSyn
 import GHC.Core.Type
-import GHC.Core.Multiplicity
 import GHC.Core.Coercion
 import GHC.Builtin.Types.Prim
 import GHC.Builtin.Types
@@ -142,7 +141,7 @@ selectMatchVar _w (VarPat _ var)  = return (localiseId (unLoc var))
                                   -- multiplicity stored within the variable
                                   -- itself. It's easier to pull it from the
                                   -- variable, so we ignore the multiplicity.
-selectMatchVar _w (AsPat _ var _) = return (unLoc var)
+selectMatchVar _w (AsPat _ var _) = ASSERT( isManyDataConTy _w ) (return (unLoc var))
 selectMatchVar w other_pat     = newSysLocalDsNoLP w (hsPatType other_pat)
 
 {- Note [Localise pattern binders]
@@ -371,7 +370,7 @@ mkDataConCase var ty alts@(alt1 :| _)
           Just (DCB boxer) -> do
             us <- newUniqueSupply
             let (rep_ids, binds) = initUs_ us (boxer ty_args args)
-            let rep_ids' = map (scaleIdBy (idMult var)) rep_ids
+            let rep_ids' = map (scaleVarBy (idMult var)) rep_ids
               -- Upholds the invariant that the binders of a case expression
               -- must be scaled by the case multiplicity. See Note [Case
               -- expression invariants] in CoreSyn.
diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs
index 1b0eb0d604..060a27297f 100644
--- a/compiler/GHC/IfaceToCore.hs
+++ b/compiler/GHC/IfaceToCore.hs
@@ -78,7 +78,6 @@ import GHC.Data.FastString
 import GHC.Types.Basic hiding ( SuccessFlag(..) )
 import GHC.Data.List.SetOps
 import GHC.Fingerprint
-import GHC.Core.Multiplicity
 import qualified GHC.Data.BooleanFormula as BF
 
 import Control.Monad
diff --git a/compiler/GHC/Runtime/Eval.hs b/compiler/GHC/Runtime/Eval.hs
index e33c8329d4..3755d8d84f 100644
--- a/compiler/GHC/Runtime/Eval.hs
+++ b/compiler/GHC/Runtime/Eval.hs
@@ -63,7 +63,6 @@ import GHC.Iface.Env       ( newInteractiveBinder )
 import GHC.Core.FamInstEnv ( FamInst )
 import GHC.Core.FVs        ( orphNamesOfFamInst )
 import GHC.Core.TyCon
-import GHC.Core.Multiplicity ( irrelevantMult )
 import GHC.Core.Type       hiding( typeKind )
 import qualified GHC.Core.Type as Type
 import GHC.Types.RepType
@@ -1101,9 +1100,9 @@ findMatchingInstances ty = do
     k -> Constraint where k is the type of the queried type.
   -}
   try_cls ies cls
-    | Just (arg_kind, res_kind) <- splitFunTy_maybe (tyConKind $ classTyCon cls)
+    | Just (_, arg_kind, res_kind) <- splitFunTy_maybe (tyConKind $ classTyCon cls)
     , tcIsConstraintKind res_kind
-    , Type.typeKind ty `eqType` irrelevantMult arg_kind
+    , Type.typeKind ty `eqType` arg_kind
     , (matches, _, _) <- lookupInstEnv True ies cls [ty]
     = matches
     | otherwise
diff --git a/compiler/GHC/Runtime/Heap/Inspect.hs b/compiler/GHC/Runtime/Heap/Inspect.hs
index debcc68f29..f3a6122144 100644
--- a/compiler/GHC/Runtime/Heap/Inspect.hs
+++ b/compiler/GHC/Runtime/Heap/Inspect.hs
@@ -1264,8 +1264,8 @@ congruenceNewtypes lhs rhs = go lhs rhs >>= \rhs' -> return (lhs,rhs')
                           ppr tv, equals, ppr ty_v]
          go ty_v r
 -- FunTy inductive case
-    | Just (Scaled w1 l1,l2) <- splitFunTy_maybe l
-    , Just (Scaled w2 r1,r2) <- splitFunTy_maybe r
+    | Just (w1,l1,l2) <- splitFunTy_maybe l
+    , Just (w2,r1,r2) <- splitFunTy_maybe r
     , w1 `eqType` w2
     = do r2' <- go l2 r2
          r1' <- go l1 r1
@@ -1334,8 +1334,8 @@ isMonomorphicOnNonPhantomArgs ty
   , concrete_args <- [ arg | (tyv,arg) <- tyConTyVars tc `zip` all_args
                            , tyv `notElem` phantom_vars]
   = all isMonomorphicOnNonPhantomArgs concrete_args
-  | Just (ty1, ty2) <- splitFunTy_maybe ty
-  = all isMonomorphicOnNonPhantomArgs [scaledThing ty1,ty2]
+  | Just (_, ty1, ty2) <- splitFunTy_maybe ty
+  = all isMonomorphicOnNonPhantomArgs [ty1,ty2]
   | otherwise = isMonomorphic ty
 
 tyConPhantomTyVars :: TyCon -> [TyVar]
diff --git a/compiler/GHC/Stg/Lift/Monad.hs b/compiler/GHC/Stg/Lift/Monad.hs
index 21097cc59f..dcfa0ce644 100644
--- a/compiler/GHC/Stg/Lift/Monad.hs
+++ b/compiler/GHC/Stg/Lift/Monad.hs
@@ -34,7 +34,7 @@ import GHC.Utils.Outputable
 import GHC.Data.OrdList
 import GHC.Stg.Subst
 import GHC.Stg.Syntax
-import GHC.Core.Type
+import GHC.Core.Utils
 import GHC.Types.Unique.Supply
 import GHC.Utils.Misc
 import GHC.Types.Var.Env
diff --git a/compiler/GHC/Stg/Unarise.hs b/compiler/GHC/Stg/Unarise.hs
index 3e5d2f3101..e78a58894d 100644
--- a/compiler/GHC/Stg/Unarise.hs
+++ b/compiler/GHC/Stg/Unarise.hs
@@ -220,7 +220,6 @@ import GHC.Builtin.Types
 import GHC.Types.Unique.Supply
 import GHC.Utils.Misc
 import GHC.Types.Var.Env
-import GHC.Core.Multiplicity ( pattern Many )
 
 import Data.Bifunctor (second)
 import Data.Maybe (mapMaybe)
diff --git a/compiler/GHC/Tc/Deriv/Functor.hs b/compiler/GHC/Tc/Deriv/Functor.hs
index a1af9166fe..3ccfb83cf7 100644
--- a/compiler/GHC/Tc/Deriv/Functor.hs
+++ b/compiler/GHC/Tc/Deriv/Functor.hs
@@ -40,7 +40,6 @@ import GHC.Tc.Utils.TcType
 import GHC.Core.TyCon
 import GHC.Core.TyCo.Rep
 import GHC.Core.Type
-import GHC.Core.Multiplicity
 import GHC.Utils.Misc
 import GHC.Types.Var
 import GHC.Types.Var.Set
diff --git a/compiler/GHC/Tc/Deriv/Infer.hs b/compiler/GHC/Tc/Deriv/Infer.hs
index 17eff9a74b..f110b8c7f2 100644
--- a/compiler/GHC/Tc/Deriv/Infer.hs
+++ b/compiler/GHC/Tc/Deriv/Infer.hs
@@ -41,7 +41,6 @@ import GHC.Tc.Utils.TcType
 import GHC.Core.TyCon
 import GHC.Core.TyCo.Ppr (pprTyVars)
 import GHC.Core.Type
-import GHC.Core.Multiplicity
 import GHC.Tc.Solver
 import GHC.Tc.Validity (validDerivPred)
 import GHC.Tc.Utils.Unify (buildImplicationFor, checkConstraints)
diff --git a/compiler/GHC/Tc/Errors/Hole.hs b/compiler/GHC/Tc/Errors/Hole.hs
index 2edce28eac..ebfe1e3003 100644
--- a/compiler/GHC/Tc/Errors/Hole.hs
+++ b/compiler/GHC/Tc/Errors/Hole.hs
@@ -462,7 +462,7 @@ pprHoleFit (HFDC sWrp sWrpVars sTy sProv sMs) (HoleFit {..}) =
            -- into [m, a]
            unwrapTypeVars :: Type -> [TyCoVarBinder]
            unwrapTypeVars t = vars ++ case splitFunTy_maybe unforalled of
-                               Just (_, unfunned) -> unwrapTypeVars unfunned
+                               Just (_, _, unfunned) -> unwrapTypeVars unfunned
                                _ -> []
              where (vars, unforalled) = splitForAllVarBndrs t
        holeVs = sep $ map (parens . (text "_" <+> dcolon <+>) . ppr) hfMatches
diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs
index fecd8b9b2e..d0da974326 100644
--- a/compiler/GHC/Tc/Gen/HsType.hs
+++ b/compiler/GHC/Tc/Gen/HsType.hs
@@ -88,7 +88,6 @@ import GHC.Core.TyCo.Ppr
 import GHC.Tc.Errors      ( reportAllUnsolved )
 import GHC.Tc.Utils.TcType
 import GHC.Tc.Utils.Instantiate ( tcInstInvisibleTyBinders, tcInstInvisibleTyBinder )
-import GHC.Core.Multiplicity
 import GHC.Core.Type
 import GHC.Builtin.Types.Prim
 import GHC.Types.Name.Reader( lookupLocalRdrOcc )
diff --git a/compiler/GHC/Tc/Gen/Rule.hs b/compiler/GHC/Tc/Gen/Rule.hs
index 49de48cebd..723c07ec50 100644
--- a/compiler/GHC/Tc/Gen/Rule.hs
+++ b/compiler/GHC/Tc/Gen/Rule.hs
@@ -28,7 +28,6 @@ import GHC.Tc.Utils.Unify( buildImplicationFor )
 import GHC.Tc.Types.Evidence( mkTcCoVarCo )
 import GHC.Core.Type
 import GHC.Core.TyCon( isTypeFamilyTyCon )
-import GHC.Core.Multiplicity
 import GHC.Types.Id
 import GHC.Types.Var( EvVar )
 import GHC.Types.Var.Set
diff --git a/compiler/GHC/Tc/Instance/Class.hs b/compiler/GHC/Tc/Instance/Class.hs
index 642e303442..f2f4065bc0 100644
--- a/compiler/GHC/Tc/Instance/Class.hs
+++ b/compiler/GHC/Tc/Instance/Class.hs
@@ -32,7 +32,6 @@ import GHC.Builtin.Names
 
 import GHC.Types.Id
 import GHC.Core.Type
-import GHC.Core.Multiplicity
 import GHC.Core.Make ( mkStringExprFS, mkNaturalExpr )
 
 import GHC.Types.Name   ( Name, pprDefinedAt )
@@ -423,7 +422,7 @@ matchTypeable clas [k,t]  -- clas = Typeable
   | k `eqType` typeNatKind                 = doTyLit knownNatClassName         t
   | k `eqType` typeSymbolKind              = doTyLit knownSymbolClassName      t
   | tcIsConstraintKind t                   = doTyConApp clas t constraintKindTyCon []
-  | Just (arg,ret) <- splitFunTy_maybe t   = doFunTy    clas t arg ret
+  | Just (mult,arg,ret) <- splitFunTy_maybe t   = doFunTy    clas t mult arg ret
   | Just (tc, ks) <- splitTyConApp_maybe t -- See Note [Typeable (T a b c)]
   , onlyNamedBndrsApplied tc ks            = doTyConApp clas t tc ks
   | Just (f,kt)   <- splitAppTy_maybe t    = doTyApp    clas t f kt
@@ -431,8 +430,8 @@ matchTypeable clas [k,t]  -- clas = Typeable
 matchTypeable _ _ = return NoInstance
 
 -- | Representation for a type @ty@ of the form @arg -> ret@.
-doFunTy :: Class -> Type -> Scaled Type -> Type -> TcM ClsInstResult
-doFunTy clas ty (Scaled mult arg_ty) ret_ty
+doFunTy :: Class -> Type -> Mult -> Type -> Type -> TcM ClsInstResult
+doFunTy clas ty mult arg_ty ret_ty
   = return $ OneInst { cir_new_theta = preds
                      , cir_mk_ev     = mk_ev
                      , cir_what      = BuiltinInstance }
diff --git a/compiler/GHC/Tc/Instance/Typeable.hs b/compiler/GHC/Tc/Instance/Typeable.hs
index a7b3d83e09..bed5779a8d 100644
--- a/compiler/GHC/Tc/Instance/Typeable.hs
+++ b/compiler/GHC/Tc/Instance/Typeable.hs
@@ -34,7 +34,6 @@ import GHC.Types.Id
 import GHC.Core.Type
 import GHC.Core.TyCon
 import GHC.Core.DataCon
-import GHC.Core.Multiplicity
 import GHC.Unit.Module
 import GHC.Hs
 import GHC.Driver.Session
diff --git a/compiler/GHC/Tc/Solver/Canonical.hs b/compiler/GHC/Tc/Solver/Canonical.hs
index 79b42d29d5..cf0255b6c5 100644
--- a/compiler/GHC/Tc/Solver/Canonical.hs
+++ b/compiler/GHC/Tc/Solver/Canonical.hs
@@ -2526,7 +2526,7 @@ unify_derived loc role    orig_ty1 orig_ty2
     go (FunTy _ w1 s1 t1) (FunTy _ w2 s2 t2)
       = do { unify_derived loc role s1 s2
            ; unify_derived loc role t1 t2
-           ; unify_derived loc role w1 w2 }
+           ; unify_derived loc Nominal w1 w2 }
     go (TyConApp tc1 tys1) (TyConApp tc2 tys2)
       | tc1 == tc2, tys1 `equalLength` tys2
       , isInjectiveTyCon tc1 role
diff --git a/compiler/GHC/Tc/Solver/Flatten.hs b/compiler/GHC/Tc/Solver/Flatten.hs
index 48249caa5c..2c3f020f68 100644
--- a/compiler/GHC/Tc/Solver/Flatten.hs
+++ b/compiler/GHC/Tc/Solver/Flatten.hs
@@ -39,8 +39,6 @@ import Data.Foldable ( foldrM )
 
 import Control.Arrow ( first )
 
-import GHC.Core.Multiplicity
-
 {-
 Note [The flattening story]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1180,7 +1178,7 @@ flatten_one (TyConApp tc tys)
 flatten_one ty@(FunTy { ft_mult = mult, ft_arg = ty1, ft_res = ty2 })
   = do { (xi1,co1) <- flatten_one ty1
        ; (xi2,co2) <- flatten_one ty2
-       ; (xi3,co3) <- flatten_one mult
+       ; (xi3,co3) <- setEqRel NomEq $ flatten_one mult
        ; role <- getRole
        ; return (ty { ft_mult = xi3, ft_arg = xi1, ft_res = xi2 }
                 , mkFunCo role co3 co1 co2) }
@@ -1921,12 +1919,14 @@ Flatten using the fun-eqs first.
 split_pi_tys' :: Type -> ([TyCoBinder], Type, Bool)
 split_pi_tys' ty = split ty ty
   where
-  split orig_ty ty | Just ty' <- coreView ty = split orig_ty ty'
+     -- put common cases first
   split _       (ForAllTy b res) = let (bs, ty, _) = split res res
                                    in  (Named b : bs, ty, True)
   split _       (FunTy { ft_af = af, ft_mult = w, ft_arg = arg, ft_res = res })
                                  = let (bs, ty, named) = split res res
                                    in  (Anon af (mkScaled w arg) : bs, ty, named)
+
+  split orig_ty ty | Just ty' <- coreView ty = split orig_ty ty'
   split orig_ty _                = ([], orig_ty, False)
 {-# INLINE split_pi_tys' #-}
 
diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs
index a4a56c0a14..edf7456b2c 100644
--- a/compiler/GHC/Tc/TyCl.hs
+++ b/compiler/GHC/Tc/TyCl.hs
@@ -824,9 +824,9 @@ swizzleTcTyConBndrs tc_infos
     swizzle_var :: Var -> Var
     swizzle_var v
       | Just nm <- lookupVarEnv swizzle_env v
-      = updateVarTypeAndMult swizzle_ty (v `setVarName` nm)
+      = updateVarType swizzle_ty (v `setVarName` nm)
       | otherwise
-      = updateVarTypeAndMult swizzle_ty v
+      = updateVarType swizzle_ty v
 
     (map_type, _, _, _) = mapTyCo swizzleMapper
     swizzle_ty ty = runIdentity (map_type ty)
@@ -4563,7 +4563,7 @@ checkValidRoles tc
       >> check_ty_roles env Nominal ty2
 
     check_ty_roles env role (FunTy _ w ty1 ty2)
-      =  check_ty_roles env role w
+      =  check_ty_roles env Nominal w
       >> check_ty_roles env role ty1
       >> check_ty_roles env role ty2
 
diff --git a/compiler/GHC/Tc/TyCl/Utils.hs b/compiler/GHC/Tc/TyCl/Utils.hs
index b49e81ddd2..a9557a2351 100644
--- a/compiler/GHC/Tc/TyCl/Utils.hs
+++ b/compiler/GHC/Tc/TyCl/Utils.hs
@@ -600,7 +600,7 @@ irType = go
                                           lcls' = extendVarSet lcls tv
                                     ; markNominal lcls (tyVarKind tv)
                                     ; go lcls' ty }
-    go lcls (FunTy _ w arg res)  = go lcls w >> go lcls arg >> go lcls res
+    go lcls (FunTy _ w arg res)  = markNominal lcls w >> go lcls arg >> go lcls res
     go _    (LitTy {})         = return ()
       -- See Note [Coercions in role inference]
     go lcls (CastTy ty _)      = go lcls ty
diff --git a/compiler/GHC/Tc/Utils/Env.hs b/compiler/GHC/Tc/Utils/Env.hs
index 55c0ad4e67..eebe9eb8ed 100644
--- a/compiler/GHC/Tc/Utils/Env.hs
+++ b/compiler/GHC/Tc/Utils/Env.hs
@@ -113,7 +113,6 @@ import GHC.Data.Bag
 import GHC.Data.List.SetOps
 import GHC.Utils.Error
 import GHC.Data.Maybe( MaybeErr(..), orElse )
-import GHC.Core.Multiplicity
 import qualified GHC.LanguageExtensions as LangExt
 import GHC.Utils.Misc ( HasDebugCallStack )
 
diff --git a/compiler/GHC/Tc/Utils/TcMType.hs b/compiler/GHC/Tc/Utils/TcMType.hs
index c33c335ac7..d2afbfb4ca 100644
--- a/compiler/GHC/Tc/Utils/TcMType.hs
+++ b/compiler/GHC/Tc/Utils/TcMType.hs
@@ -127,7 +127,6 @@ import GHC.Data.FastString
 import GHC.Data.Bag
 import GHC.Data.Pair
 import GHC.Types.Unique.Set
-import GHC.Core.Multiplicity
 import GHC.Driver.Session
 import qualified GHC.LanguageExtensions as LangExt
 import GHC.Types.Basic ( TypeOrKind(..) )
@@ -2040,7 +2039,7 @@ zonkImplication implic@(Implic { ic_skols  = skols
                         , ic_info   = info' }) }
 
 zonkEvVar :: EvVar -> TcM EvVar
-zonkEvVar var = updateVarTypeAndMultM zonkTcType var
+zonkEvVar var = updateIdTypeAndMultM zonkTcType var
 
 
 zonkWC :: WantedConstraints -> TcM WantedConstraints
@@ -2315,7 +2314,7 @@ tidyHole env h@(Hole { hole_ty = ty }) = h { hole_ty = tidyType env ty }
 
 ----------------
 tidyEvVar :: TidyEnv -> EvVar -> EvVar
-tidyEvVar env var = updateVarTypeAndMult (tidyType env) var
+tidyEvVar env var = updateIdTypeAndMult (tidyType env) var
 
 ----------------
 tidySkolemInfo :: TidyEnv -> SkolemInfo -> SkolemInfo
diff --git a/compiler/GHC/Tc/Utils/TcType.hs b/compiler/GHC/Tc/Utils/TcType.hs
index f06cdd7d31..da6e71547f 100644
--- a/compiler/GHC/Tc/Utils/TcType.hs
+++ b/compiler/GHC/Tc/Utils/TcType.hs
@@ -200,7 +200,6 @@ import GHC.Core.TyCo.Subst ( mkTvSubst, substTyWithCoVars )
 import GHC.Core.TyCo.FVs
 import GHC.Core.TyCo.Ppr
 import GHC.Core.Class
-import GHC.Core.Multiplicity
 import GHC.Types.Var
 import GHC.Types.ForeignCall
 import GHC.Types.Var.Set
@@ -869,7 +868,7 @@ anyRewritableTyVar ignore_cos role pred ty
     go rl bvs (TyConApp tc tys)  = go_tc rl bvs tc tys
     go rl bvs (AppTy fun arg)    = go rl bvs fun || go NomEq bvs arg
     go rl bvs (FunTy _ w arg res)  = go NomEq bvs arg_rep || go NomEq bvs res_rep ||
-                                     go rl bvs arg || go rl bvs res || go rl bvs w
+                                     go rl bvs arg || go rl bvs res || go NomEq bvs w
       where arg_rep = getRuntimeRep arg -- forgetting these causes #17024
             res_rep = getRuntimeRep res
     go rl bvs (ForAllTy tv ty)   = go rl (bvs `extendVarSet` binderVar tv) ty
diff --git a/compiler/GHC/Tc/Utils/Unify.hs b/compiler/GHC/Tc/Utils/Unify.hs
index a6711abcc1..75f4e83979 100644
--- a/compiler/GHC/Tc/Utils/Unify.hs
+++ b/compiler/GHC/Tc/Utils/Unify.hs
@@ -622,7 +622,7 @@ tc_sub_type unify inst_orig ctxt ty_actual ty_expected
   where
     possibly_poly ty
       | isForAllTy ty                        = True
-      | Just (_, res) <- splitFunTy_maybe ty = possibly_poly res
+      | Just (_, _, res) <- splitFunTy_maybe ty = possibly_poly res
       | otherwise                            = False
       -- NB *not* tcSplitFunTy, because here we want
       -- to decompose type-class arguments too
@@ -746,7 +746,8 @@ to a UserTypeCtxt of GenSigCtxt.  Why?
 -- only produce trivial evidence, then this check would happen in the constraint
 -- solver.
 tcSubMult :: CtOrigin -> Mult -> Mult -> TcM HsWrapper
-tcSubMult origin (MultMul w1 w2) w_expected =
+tcSubMult origin w_actual w_expected
+  | Just (w1, w2) <- isMultMul w_actual =
   do { w1 <- tcSubMult origin w1 w_expected
      ; w2 <- tcSubMult origin w2 w_expected
      ; return (w1 <.> w2) }
diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs
index 05eb4d9ba4..6dd6026841 100644
--- a/compiler/GHC/Tc/Utils/Zonk.hs
+++ b/compiler/GHC/Tc/Utils/Zonk.hs
@@ -402,7 +402,7 @@ zonkEvBndr :: ZonkEnv -> EvVar -> TcM EvVar
 -- Works for dictionaries and coercions
 -- Does not extend the ZonkEnv
 zonkEvBndr env var
-  = updateVarTypeAndMultM ({-# SCC "zonkEvBndr_zonkTcTypeToType" #-} zonkTcTypeToTypeX env) var
+  = updateIdTypeAndMultM ({-# SCC "zonkEvBndr_zonkTcTypeToType" #-} zonkTcTypeToTypeX env) var
 
 {-
 zonkEvVarOcc :: ZonkEnv -> EvVar -> TcM EvTerm
@@ -583,7 +583,7 @@ zonk_bind env (AbsBinds { abs_tvs = tyvars, abs_ev_vars = evs
       , (L loc bind@(FunBind { fun_id      = (L mloc mono_id)
                              , fun_matches = ms
                              , fun_ext     = co_fn })) <- lbind
-      = do { new_mono_id <- updateVarTypeAndMultM (zonkTcTypeToTypeX env) mono_id
+      = do { new_mono_id <- updateIdTypeAndMultM (zonkTcTypeToTypeX env) mono_id
                             -- Specifically /not/ zonkIdBndr; we do not
                             -- want to complain about a levity-polymorphic binder
            ; (env', new_co_fn) <- zonkCoFn env co_fn
diff --git a/compiler/GHC/Types/Id.hs b/compiler/GHC/Types/Id.hs
index 010100e98e..ac903fa021 100644
--- a/compiler/GHC/Types/Id.hs
+++ b/compiler/GHC/Types/Id.hs
@@ -49,14 +49,14 @@ module GHC.Types.Id (
 
         -- ** Modifying an Id
         setIdName, setIdUnique, GHC.Types.Id.setIdType, setIdMult,
-        updateIdTypeAndMult, updateIdTypeAndMultM,
+        updateIdTypeButNotMult, updateIdTypeAndMult, updateIdTypeAndMultM,
         setIdExported, setIdNotExported,
         globaliseId, localiseId,
         setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
         zapLamIdInfo, zapIdDemandInfo, zapIdUsageInfo, zapIdUsageEnvInfo,
         zapIdUsedOnceInfo, zapIdTailCallInfo,
         zapFragileIdInfo, zapIdStrictness, zapStableUnfolding,
-        transferPolyIdInfo, scaleIdBy,
+        transferPolyIdInfo, scaleIdBy, scaleVarBy,
 
         -- ** Predicates on Ids
         isImplicitId, isDeadBinder,
@@ -135,7 +135,8 @@ import GHC.Types.Var( Id, CoVar, JoinId,
             InId,  InVar,
             OutId, OutVar,
             idInfo, idDetails, setIdDetails, globaliseId,
-            isId, isLocalId, isGlobalId, isExportedId )
+            isId, isLocalId, isGlobalId, isExportedId,
+            setIdMult, updateIdTypeAndMult, updateIdTypeButNotMult, updateIdTypeAndMultM)
 import qualified GHC.Types.Var as Var
 
 import GHC.Core.Type
@@ -201,10 +202,14 @@ idScaledType :: Id -> Scaled Type
 idScaledType id = Scaled (idMult id) (idType id)
 
 scaleIdBy :: Mult -> Id -> Id
-scaleIdBy = Var.scaleVarBy
+scaleIdBy m id = setIdMult id (m `mkMultMul` idMult id)
 
-setIdMult :: Id -> Mult -> Id
-setIdMult = Var.setVarMult
+-- | Like 'scaleIdBy', but skips non-Ids. Useful for scaling
+-- a mixed list of ids and tyvars.
+scaleVarBy :: Mult -> Var -> Var
+scaleVarBy m id
+  | isId id   = scaleIdBy m id
+  | otherwise = id
 
 setIdName :: Id -> Name -> Id
 setIdName = Var.setVarName
@@ -217,12 +222,6 @@ setIdUnique = Var.setVarUnique
 setIdType :: Id -> Type -> Id
 setIdType id ty = seqType ty `seq` Var.setVarType id ty
 
-updateIdTypeAndMult :: (Type -> Type) -> Id -> Id
-updateIdTypeAndMult = Var.updateVarTypeAndMult
-
-updateIdTypeAndMultM :: Monad m => (Type -> m Type) -> Id -> m Id
-updateIdTypeAndMultM = Var.updateVarTypeAndMultM
-
 setIdExported :: Id -> Id
 setIdExported = Var.setIdExported
 
diff --git a/compiler/GHC/Types/Var.hs b/compiler/GHC/Types/Var.hs
index dfc9cfc0dd..8baa5750f1 100644
--- a/compiler/GHC/Types/Var.hs
+++ b/compiler/GHC/Types/Var.hs
@@ -5,7 +5,8 @@
 \section{@Vars@: Variables}
 -}
 
-{-# LANGUAGE CPP, FlexibleContexts, MultiWayIf, FlexibleInstances, DeriveDataTypeable, PatternSynonyms #-}
+{-# LANGUAGE CPP, FlexibleContexts, MultiWayIf, FlexibleInstances, DeriveDataTypeable,
+             PatternSynonyms, BangPatterns #-}
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns   #-}
 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
 
@@ -46,19 +47,18 @@ module GHC.Types.Var (
         -- ** Taking 'Var's apart
         varName, varUnique, varType,
         varMult, varMultMaybe,
-        varScaledType,
 
         -- ** Modifying 'Var's
         setVarName, setVarUnique, setVarType,
-        scaleVarBy, setVarMult,
-        updateVarTypeButNotMult,
-        updateVarTypeAndMult, updateVarTypeAndMultM,
+        updateVarType, updateVarTypeM,
 
         -- ** Constructing, taking apart, modifying 'Id's
         mkGlobalVar, mkLocalVar, mkExportedLocalVar, mkCoVar,
         idInfo, idDetails,
         lazySetIdInfo, setIdDetails, globaliseId,
-        setIdExported, setIdNotExported,
+        setIdExported, setIdNotExported, setIdMult,
+        updateIdTypeButNotMult,
+        updateIdTypeAndMult, updateIdTypeAndMultM,
 
         -- ** Predicates
         isId, isTyVar, isTcTyVar,
@@ -97,13 +97,12 @@ module GHC.Types.Var (
 
 import GHC.Prelude
 
-import {-# SOURCE #-}   GHC.Core.TyCo.Rep( Type, Kind )
+import {-# SOURCE #-}   GHC.Core.TyCo.Rep( Type, Kind, Mult )
 import {-# SOURCE #-}   GHC.Core.TyCo.Ppr( pprKind )
 import {-# SOURCE #-}   GHC.Tc.Utils.TcType( TcTyVarDetails, pprTcTyVarDetails, vanillaSkolemTv )
 import {-# SOURCE #-}   GHC.Types.Id.Info( IdDetails, IdInfo, coVarDetails, isCoVarDetails,
                                            vanillaIdInfo, pprIdDetails )
-import GHC.Core.Multiplicity
-
+import {-# SOURCE #-}   GHC.Builtin.Types ( manyDataConTy )
 import GHC.Types.Name hiding (varName)
 import GHC.Types.Unique ( Uniquable, Unique, getKey, getUnique
                         , mkUniqueGrimily, nonDetCmpUnique )
@@ -385,6 +384,10 @@ instance HasOccName Var where
 varUnique :: Var -> Unique
 varUnique var = mkUniqueGrimily (realUnique var)
 
+varMultMaybe :: Id -> Maybe Mult
+varMultMaybe (Id { varMult = mult }) = Just mult
+varMultMaybe _ = Nothing
+
 setVarUnique :: Var -> Unique -> Var
 setVarUnique var uniq
   = var { realUnique = getKey uniq,
@@ -395,42 +398,39 @@ setVarName var new_name
   = var { realUnique = getKey (getUnique new_name),
           varName = new_name }
 
-setVarType :: Id -> Type -> Id
+setVarType :: Var -> Type -> Var
 setVarType id ty = id { varType = ty }
 
-updateVarTypeButNotMult :: (Type -> Type) -> Id -> Id
-updateVarTypeButNotMult f id = id { varType = f (varType id) }
-
-updateVarTypeAndMult :: (Type -> Type) -> Id -> Id
-updateVarTypeAndMult f id = let id' = id { varType = f (varType id) }
-                            in case varMultMaybe id' of
-                                      Just w -> setVarMult id' (f w)
-                                      Nothing -> id'
-
-updateVarTypeAndMultM :: Monad m => (Type -> m Type) -> Id -> m Id
-updateVarTypeAndMultM f id = do { ty' <- f (varType id)
-                                ; let id' = setVarType id ty'
-                                ; case varMultMaybe id of
-                                    Just w -> do w' <- f w
-                                                 return $ setVarMult id' w'
-                                    Nothing -> return id'
-                                }
-
-varMultMaybe :: Id -> Maybe Mult
-varMultMaybe (Id { varMult = mult }) = Just mult
-varMultMaybe _ = Nothing
-
-varScaledType :: Id -> Scaled Kind
-varScaledType var = Scaled (varMult var) (varType var)
-
-scaleVarBy :: Mult -> Id -> Id
-scaleVarBy m id@(Id { varMult = w }) =
-  id { varMult = m `mkMultMul` w }
-scaleVarBy _ id = id
-
-setVarMult :: Id -> Mult -> Id
-setVarMult id r | isId id = id { varMult = r }
-                | otherwise = pprPanic "setVarMult" (ppr id <+> ppr r)
+-- | Update a 'Var's type. Does not update the /multiplicity/
+-- stored in an 'Id', if any. Because of the possibility for
+-- abuse, ASSERTs that there is no multiplicity to update.
+updateVarType :: (Type -> Type) -> Var -> Var
+updateVarType upd var
+  | debugIsOn
+  = case var of
+      Id { id_details = details } -> ASSERT( isCoVarDetails details )
+                                     result
+      _ -> result
+  | otherwise
+  = result
+  where
+    result = var { varType = upd (varType var) }
+
+-- | Update a 'Var's type monadically. Does not update the /multiplicity/
+-- stored in an 'Id', if any. Because of the possibility for
+-- abuse, ASSERTs that there is no multiplicity to update.
+updateVarTypeM :: Monad m => (Type -> m Type) -> Var -> m Var
+updateVarTypeM upd var
+  | debugIsOn
+  = case var of
+      Id { id_details = details } -> ASSERT( isCoVarDetails details )
+                                     result
+      _ -> result
+  | otherwise
+  = result
+  where
+    result = do { ty' <- upd (varType var)
+                ; return (var { varType = ty' }) }
 
 {- *********************************************************************
 *                                                                      *
@@ -548,7 +548,7 @@ where isPredTy is defined in GHC.Core.Type, and sees if t1's
 kind is Constraint.  See GHC.Core.TyCo.Rep
 Note [Types for coercions, predicates, and evidence]
 
-GHC.Core.Type.mkFunctionType :: Type -> Type -> Type
+GHC.Core.Utils.mkFunctionType :: Mult -> Type -> Type -> Type
 uses isPredTy to decide the AnonArgFlag for the FunTy.
 
 The term (Lam b e), and coercion (FunCo co1 co2) don't carry
@@ -766,7 +766,7 @@ idDetails other                         = pprPanic "idDetails" (ppr other)
 -- Ids, because "GHC.Types.Id" uses 'mkGlobalId' etc with different types
 mkGlobalVar :: IdDetails -> Name -> Type -> IdInfo -> Id
 mkGlobalVar details name ty info
-  = mk_id name Many ty GlobalId details info
+  = mk_id name manyDataConTy ty GlobalId details info
   -- There is no support for linear global variables yet. They would require
   -- being checked at link-time, which can be useful, but is not a priority.
 
@@ -776,16 +776,16 @@ mkLocalVar details name w ty info
 
 mkCoVar :: Name -> Type -> CoVar
 -- Coercion variables have no IdInfo
-mkCoVar name ty = mk_id name Many ty (LocalId NotExported) coVarDetails vanillaIdInfo
+mkCoVar name ty = mk_id name manyDataConTy ty (LocalId NotExported) coVarDetails vanillaIdInfo
 
 -- | Exported 'Var's will not be removed as dead code
 mkExportedLocalVar :: IdDetails -> Name -> Type -> IdInfo -> Id
 mkExportedLocalVar details name ty info
-  = mk_id name Many ty (LocalId Exported) details info
+  = mk_id name manyDataConTy ty (LocalId Exported) details info
   -- There is no support for exporting linear variables. See also [mkGlobalVar]
 
 mk_id :: Name -> Mult -> Type -> IdScope -> IdDetails -> IdInfo -> Id
-mk_id name w ty scope details info
+mk_id name !w ty scope details info
   = Id { varName    = name,
          realUnique = getKey (nameUnique name),
          varMult    = w,
@@ -817,6 +817,33 @@ setIdNotExported :: Id -> Id
 setIdNotExported id = ASSERT( isLocalId id )
                       id { idScope = LocalId NotExported }
 
+-----------------------
+updateIdTypeButNotMult :: (Type -> Type) -> Id -> Id
+updateIdTypeButNotMult f id = id { varType = f (varType id) }
+
+
+updateIdTypeAndMult :: (Type -> Type) -> Id -> Id
+updateIdTypeAndMult f id@(Id { varType = ty
+                             , varMult = mult })
+  = id { varType = ty'
+       , varMult = mult' }
+  where
+    !ty'   = f ty
+    !mult' = f mult
+updateIdTypeAndMult _ other = pprPanic "updateIdTypeAndMult" (ppr other)
+
+updateIdTypeAndMultM :: Monad m => (Type -> m Type) -> Id -> m Id
+updateIdTypeAndMultM f id@(Id { varType = ty
+                              , varMult = mult })
+  = do { !ty' <- f ty
+       ; !mult' <- f mult
+       ; return (id { varType = ty', varMult = mult' }) }
+updateIdTypeAndMultM _ other = pprPanic "updateIdTypeAndMultM" (ppr other)
+
+setIdMult :: Id -> Mult -> Id
+setIdMult id r | isId id = id { varMult = r }
+               | otherwise = pprPanic "setIdMult" (ppr id <+> ppr r)
+
 {-
 ************************************************************************
 *                                                                      *
diff --git a/compiler/GHC/Types/Var.hs-boot b/compiler/GHC/Types/Var.hs-boot
index 6ea03efd91..78c748f7ec 100644
--- a/compiler/GHC/Types/Var.hs-boot
+++ b/compiler/GHC/Types/Var.hs-boot
@@ -1,14 +1,13 @@
 module GHC.Types.Var where
 
 import GHC.Prelude ()
-  -- We compile this module with -XNoImplicitPrelude (for some
-  -- reason), so if there are no imports it does not seem to
-  -- depend on anything.  But it does! We must, for example,
-  -- compile GHC.Types in the ghc-prim library first.
-  -- So this otherwise-unnecessary import tells the build system
-  -- that this module depends on GHC.Prelude, which ensures
-  -- that GHC.Type is built first.
+  -- We compile this GHC with -XNoImplicitPrelude, so if there are no imports
+  -- it does not seem to depend on anything. But it does! We must, for
+  -- example, compile GHC.Types in the ghc-prim library first. So this
+  -- otherwise-unnecessary import tells the build system that this module
+  -- depends on GhcPrelude, which ensures that GHC.Type is built first.
 
 data ArgFlag
 data AnonArgFlag
 data Var
+type TyVar = Var