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

6 files changed, 6 insertions, 11 deletions

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.