diff options
23 files changed, 77 insertions, 213 deletions
diff --git a/compiler/GHC/Builtin/Types.hs b/compiler/GHC/Builtin/Types.hs index 3339e0a020..d06bc4a12b 100644 --- a/compiler/GHC/Builtin/Types.hs +++ b/compiler/GHC/Builtin/Types.hs @@ -170,7 +170,6 @@ import GHC.Types.Var (VarBndr (Bndr)) import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE ) import GHC.Unit.Module ( Module ) import GHC.Core.Type -import qualified GHC.Core.TyCo.Rep as TyCoRep (Type(TyConApp)) import GHC.Types.RepType import GHC.Core.DataCon import GHC.Core.ConLike @@ -689,9 +688,8 @@ constraintKindTyCon :: TyCon -- 'TyCon.isConstraintKindCon' assumes that this is an AlgTyCon! constraintKindTyCon = pcTyCon constraintKindTyConName Nothing [] [] --- See Note [Prefer Type over TYPE 'LiftedRep] in GHC.Core.TyCo.Rep. liftedTypeKind, typeToTypeKind, constraintKind :: Kind -liftedTypeKind = TyCoRep.TyConApp liftedTypeKindTyCon [] +liftedTypeKind = tYPE liftedRepTy typeToTypeKind = liftedTypeKind `mkVisFunTyMany` liftedTypeKind constraintKind = mkTyConApp constraintKindTyCon [] @@ -1412,12 +1410,11 @@ runtimeRepTy :: Type runtimeRepTy = mkTyConTy runtimeRepTyCon -- Type synonyms; see Note [TYPE and RuntimeRep] in GHC.Builtin.Types.Prim --- and Note [Prefer Type over TYPE 'LiftedRep] in GHC.Core.TyCo.Rep. -- type Type = tYPE 'LiftedRep liftedTypeKindTyCon :: TyCon liftedTypeKindTyCon = buildSynTyCon liftedTypeKindTyConName - [] liftedTypeKind [] rhs - where rhs = TyCoRep.TyConApp tYPETyCon [liftedRepTy] + [] liftedTypeKind [] + (tYPE liftedRepTy) runtimeRepTyCon :: TyCon runtimeRepTyCon = pcTyCon runtimeRepTyConName Nothing [] diff --git a/compiler/GHC/Builtin/Types/Prim.hs b/compiler/GHC/Builtin/Types/Prim.hs index 61f341a0bb..fc74596e45 100644 --- a/compiler/GHC/Builtin/Types/Prim.hs +++ b/compiler/GHC/Builtin/Types/Prim.hs @@ -551,6 +551,10 @@ mkPrimTcName built_in_syntax occ key tycon = mkWiredInName gHC_PRIM (mkTcOccFS occ) key (mkATyCon tycon) built_in_syntax ----------------------------- +-- | Given a RuntimeRep, applies TYPE to it. +-- see Note [TYPE and RuntimeRep] +tYPE :: Type -> Type +tYPE rr = TyConApp tYPETyCon [rr] -- Given a Multiplicity, applies FUN to it. functionWithMultiplicity :: Type -> Type diff --git a/compiler/GHC/Builtin/Types/Prim.hs-boot b/compiler/GHC/Builtin/Types/Prim.hs-boot deleted file mode 100644 index 28326fcc8b..0000000000 --- a/compiler/GHC/Builtin/Types/Prim.hs-boot +++ /dev/null @@ -1,5 +0,0 @@ -module GHC.Builtin.Types.Prim where - -import GHC.Core.TyCon - -tYPETyCon :: TyCon diff --git a/compiler/GHC/Core/TyCo/Rep.hs b/compiler/GHC/Core/TyCo/Rep.hs index be7bdb3aef..0be6824b9d 100644 --- a/compiler/GHC/Core/TyCo/Rep.hs +++ b/compiler/GHC/Core/TyCo/Rep.hs @@ -52,7 +52,6 @@ module GHC.Core.TyCo.Rep ( mkVisFunTyMany, mkVisFunTysMany, mkInvisFunTyMany, mkInvisFunTysMany, mkTyConApp, - tYPE, -- * Functions over binders TyCoBinder(..), TyCoVarBinder, TyBinder, @@ -91,9 +90,8 @@ import GHC.Core.TyCon import GHC.Core.Coercion.Axiom -- others -import GHC.Builtin.Names ( liftedTypeKindTyConKey, liftedRepDataConKey, manyDataConKey, tYPETyConKey ) -import {-# SOURCE #-} GHC.Builtin.Types ( liftedTypeKindTyCon, liftedTypeKind, manyDataConTy ) -import {-# SOURCE #-} GHC.Builtin.Types.Prim ( tYPETyCon ) +import GHC.Builtin.Names ( liftedTypeKindTyConKey, manyDataConKey ) +import {-# SOURCE #-} GHC.Builtin.Types ( liftedTypeKindTyCon, manyDataConTy ) import GHC.Types.Basic ( LeftOrRight(..), pickLR ) import GHC.Types.Unique ( hasKey, Uniquable(..) ) import GHC.Utils.Outputable @@ -1011,7 +1009,7 @@ mkTyConApp tycon tys -- The FunTyCon (->) is always a visible one = FunTy { ft_af = VisArg, ft_mult = w, ft_arg = ty1, ft_res = ty2 } - -- See Note [Prefer Type over TYPE 'LiftedRep] + -- Note [mkTyConApp and Type] | tycon `hasKey` liftedTypeKindTyConKey = ASSERT2( null tys, ppr tycon $$ ppr tys ) liftedTypeKindTyConApp @@ -1020,21 +1018,21 @@ mkTyConApp tycon tys -- avoid reboxing every time `mkTyConApp` is called. = ASSERT2( null tys, ppr tycon $$ ppr tys ) manyDataConTy - -- See Note [Prefer Type over TYPE 'LiftedRep]. - | tycon `hasKey` tYPETyConKey - , [rep] <- tys - = tYPE rep - -- The catch-all case | 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 [Prefer Type over TYPE 'LiftedRep] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The Core of nearly any program will have numerous occurrences of -@TYPE 'LiftedRep@ (and, equivalently, 'Type') floating about. Concretely, while -investigating #17292 we found that these constituting a majority of TyConApp -constructors on the heap: +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) @@ -1048,59 +1046,12 @@ constructors on the heap: 0x45e68fd - 538 - `TYPE ...` ``` -Consequently, we try hard to ensure that operations on such types are -efficient. Specifically, we strive to - - a. Avoid heap allocation of such types - b. Use a small (shallow in the tree-depth sense) representation - for such types - -Goal (b) is particularly useful as it makes traversals (e.g. free variable -traversal, substitution, and comparison) more efficient. -Comparison in particular takes special advantage of nullary type synonym -applications (e.g. things like @TyConApp typeTyCon []@), Note [Comparing -nullary type synonyms] in "GHC.Core.Type". - -To accomplish these we use a number of tricks: - - 1. Instead of representing the lifted kind as - @TyConApp tYPETyCon [liftedRepDataCon]@ we rather prefer to - use the 'GHC.Types.Type' type synonym (represented as a nullary TyConApp). - This serves goal (b) since there are no applied type arguments to traverse, - e.g., during comparison. - - 2. We have a top-level binding to represent `TyConApp GHC.Types.Type []` - (namely 'GHC.Builtin.Types.Prim.liftedTypeKind'), ensuring that we - don't need to allocate such types (goal (a)). - - 3. To avoid allocating 'TyConApp' constructors the - 'GHC.Builtin.Types.Prim.tYPE' function catches the lifted case and returns - `liftedTypeKind` instead of building an application (goal (a)). - - 4. Similarly, 'Type.mkTyConApp' catches applications of `TYPE` and - handles them using 'GHC.Builtin.Types.Prim.tYPE', ensuring - that it benefits from the optimisation described above (goal (a)). - -Note that it's quite important that we do not define 'liftedTypeKind' in terms -of 'mkTyConApp' since this tricks (1) and (4) would then result in a loop. - -See #17958. +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. -} --- | Given a RuntimeRep, applies TYPE to it. --- See Note [TYPE and RuntimeRep] in GHC.Builtin.Types.Prim. -tYPE :: Type -> Type -tYPE (TyConApp tc []) - -- See Note [Prefer Type of TYPE 'LiftedRep] - | tc `hasKey` liftedRepDataConKey = liftedTypeKind -- TYPE 'LiftedRep -tYPE rr = TyConApp tYPETyCon [rr] - --- This is a single, global definition of the type `Type` --- Defined here so it is only allocated once. --- See Note [Prefer Type over TYPE 'LiftedRep] in this module. -liftedTypeKindTyConApp :: Type -liftedTypeKindTyConApp = TyConApp liftedTypeKindTyCon [] - {- %************************************************************************ %* * diff --git a/compiler/GHC/Core/TyCo/Subst.hs b/compiler/GHC/Core/TyCo/Subst.hs index bc6632f1bf..64e0c9ccbb 100644 --- a/compiler/GHC/Core/TyCo/Subst.hs +++ b/compiler/GHC/Core/TyCo/Subst.hs @@ -424,7 +424,6 @@ zipTCvSubst tcvs tys -- | Generates the in-scope set for the 'TCvSubst' from the types in the -- incoming environment. No CoVars, please! mkTvSubstPrs :: [(TyVar, Type)] -> TCvSubst -mkTvSubstPrs [] = emptyTCvSubst mkTvSubstPrs prs = ASSERT2( onlyTyVarsAndNoCoercionTy, text "prs" <+> ppr prs ) mkTvSubst in_scope tenv @@ -742,8 +741,7 @@ subst_ty subst ty go (TyConApp tc tys) = (mkTyConApp $! tc) $! strictMap go tys -- NB: mkTyConApp, not TyConApp. -- mkTyConApp has optimizations. - -- See Note [Prefer Type over TYPE 'LiftedRep] - -- in GHC.Core.TyCo.Rep + -- 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 diff --git a/compiler/GHC/Core/TyCon.hs b/compiler/GHC/Core/TyCon.hs index a038fd646c..198b66959b 100644 --- a/compiler/GHC/Core/TyCon.hs +++ b/compiler/GHC/Core/TyCon.hs @@ -2327,14 +2327,12 @@ expandSynTyCon_maybe -- ^ Expand a type synonym application, if any expandSynTyCon_maybe tc tys | SynonymTyCon { tyConTyVars = tvs, synTcRhs = rhs, tyConArity = arity } <- tc - = case tys of - [] -> Just ([], rhs, []) -- Avoid a bit of work in the case of nullary synonyms - _ -> case tys `listLengthCmp` arity of - GT -> Just (tvs `zip` tys, rhs, drop arity tys) - EQ -> Just (tvs `zip` tys, rhs, []) - LT -> Nothing - | otherwise - = Nothing + = case tys `listLengthCmp` arity of + GT -> Just (tvs `zip` tys, rhs, drop arity tys) + EQ -> Just (tvs `zip` tys, rhs, []) + LT -> Nothing + | otherwise + = Nothing ---------------- diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs index e5d0da93fd..3164e2626b 100644 --- a/compiler/GHC/Core/Type.hs +++ b/compiler/GHC/Core/Type.hs @@ -383,28 +383,34 @@ how roles in kinds might work out. -} -- | Gives the typechecker view of a type. This unwraps synonyms but --- leaves 'Constraint' alone. c.f. 'coreView', which turns 'Constraint' into --- 'Type'. Returns 'Nothing' if no unwrapping happens. +-- leaves 'Constraint' alone. c.f. coreView, which turns Constraint into +-- TYPE LiftedRep. Returns Nothing if no unwrapping happens. -- See also Note [coreView vs tcView] +{-# INLINE tcView #-} tcView :: Type -> Maybe Type -tcView (TyConApp tc tys) - | res@(Just _) <- expandSynTyConApp_maybe tc tys - = res +tcView (TyConApp tc tys) | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys + = Just (mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys') + -- The free vars of 'rhs' should all be bound by 'tenv', so it's + -- ok to use 'substTy' here. + -- See also Note [The substitution invariant] in GHC.Core.TyCo.Subst. + -- Its important to use mkAppTys, rather than (foldl AppTy), + -- because the function part might well return a + -- partially-applied type constructor; indeed, usually will! tcView _ = Nothing --- See Note [Inlining coreView]. -{-# INLINE tcView #-} +{-# INLINE coreView #-} coreView :: Type -> Maybe Type --- ^ This function strips off the /top layer only/ of a type synonym +-- ^ This function Strips off the /top layer only/ of a type synonym -- application (if any) its underlying representation type. --- Returns 'Nothing' if there is nothing to look through. --- This function considers 'Constraint' to be a synonym of @Type@. +-- Returns Nothing if there is nothing to look through. +-- This function considers 'Constraint' to be a synonym of @TYPE LiftedRep@. -- -- By being non-recursive and inlined, this case analysis gets efficiently -- joined onto the case analysis that the caller is already doing coreView ty@(TyConApp tc tys) - | res@(Just _) <- expandSynTyConApp_maybe tc tys - = res + | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys + = Just (mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys') + -- This equation is exactly like tcView -- At the Core level, Constraint = Type -- See Note [coreView vs tcView] @@ -413,48 +419,8 @@ coreView ty@(TyConApp tc tys) Just liftedTypeKind coreView _ = Nothing --- See Note [Inlining coreView]. -{-# INLINE coreView #-} - ------------------------------------------------ - --- | @expandSynTyConApp_maybe tc tys@ expands the RHS of type synonym @tc@ --- instantiated at arguments @tys@, or returns 'Nothing' if @tc@ is not a --- synonym. -expandSynTyConApp_maybe :: TyCon -> [Type] -> Maybe Type -expandSynTyConApp_maybe tc tys - | Just (tvs, rhs) <- synTyConDefn_maybe tc - , tys `lengthAtLeast` arity - = Just (expand_syn arity tvs rhs tys) - | otherwise - = Nothing - where - arity = tyConArity tc --- Without this INLINE the call to expandSynTyConApp_maybe in coreView --- will result in an avoidable allocation. -{-# INLINE expandSynTyConApp_maybe #-} - --- | A helper for 'expandSynTyConApp_maybe' to avoid inlining this cold path --- into call-sites. -expand_syn :: Int -- ^ the arity of the synonym - -> [TyVar] -- ^ the variables bound by the synonym - -> Type -- ^ the RHS of the synonym - -> [Type] -- ^ the type arguments the synonym is instantiated at. - -> Type -expand_syn arity tvs rhs tys - | tys `lengthExceeds` arity = mkAppTys rhs' (drop arity tys) - | otherwise = rhs' - where - rhs' = substTy (mkTvSubstPrs (tvs `zip` tys)) rhs - -- The free vars of 'rhs' should all be bound by 'tenv', so it's - -- ok to use 'substTy' here (which is what expandSynTyConApp_maybe does). - -- See also Note [The substitution invariant] in GHC.Core.TyCo.Subst. - -- Its important to use mkAppTys, rather than (foldl AppTy), - -- because the function part might well return a - -- partially-applied type constructor; indeed, usually will! --- We never want to inline this cold-path. -{-# INLINE expand_syn #-} +{-# INLINE coreFullView #-} coreFullView :: Type -> Type -- ^ Iterates 'coreView' until there is no more to synonym to expand. -- See Note [Inlining coreView]. @@ -466,7 +432,6 @@ coreFullView ty@(TyConApp tc _) | otherwise = ty coreFullView ty = ty -{-# INLINE coreFullView #-} {- Note [Inlining coreView] in GHC.Core.Type ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2242,36 +2207,6 @@ But the left is an AppTy while the right is a TyConApp. The solution is to use repSplitAppTy_maybe to break up the TyConApp into its pieces and then continue. Easy to do, but also easy to forget to do. - -Note [Comparing nullary type synonyms] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider the task of testing equality between two 'Type's of the form - - TyConApp tc [] - -where @tc@ is a type synonym. A naive way to perform this comparison these -would first expand the synonym and then compare the resulting expansions. - -However, this is obviously wasteful and the RHS of @tc@ may be large; it is -much better to rather compare the TyCons directly. Consequently, before -expanding type synonyms in type comparisons we first look for a nullary -TyConApp and simply compare the TyCons if we find one. Of course, if we find -that the TyCons are *not* equal then we still need to perform the expansion as -their RHSs may still be equal. - -We perform this optimisation in a number of places: - - * GHC.Core.Types.eqType - * GHC.Core.Types.nonDetCmpType - * GHC.Core.Unify.unify_ty - * TcCanonical.can_eq_nc' - * TcUnify.uType - -This optimisation is especially helpful for the ubiquitous GHC.Types.Type, -since GHC prefers to use the type synonym over @TYPE 'LiftedRep@ applications -whenever possible. See [Prefer Type over TYPE 'LiftedRep] in -GHC.Core.TyCo.Rep for details. - -} eqType :: Type -> Type -> Bool @@ -2383,10 +2318,6 @@ nonDetCmpTypeX env orig_t1 orig_t2 = -- Returns both the resulting ordering relation between the two types -- and whether either contains a cast. go :: RnEnv2 -> Type -> Type -> TypeOrdering - -- See Note [Comparing nullary type synonyms]. - go _ (TyConApp tc1 []) (TyConApp tc2 []) - | tc1 == tc2 - = TEQ go env t1 t2 | Just t1' <- coreView t1 = go env t1' t2 | Just t2' <- coreView t2 = go env t1 t2' diff --git a/compiler/GHC/Core/Unify.hs b/compiler/GHC/Core/Unify.hs index 29d2ae975c..709ccf10b4 100644 --- a/compiler/GHC/Core/Unify.hs +++ b/compiler/GHC/Core/Unify.hs @@ -957,12 +957,7 @@ unify_ty :: UMEnv -- Respects newtypes, PredTypes unify_ty env ty1 ty2 kco - -- See Note [Comparing nullary type synonyms] in GHC.Core.Type. - | TyConApp tc1 [] <- ty1 - , TyConApp tc2 [] <- ty2 - , tc1 == tc2 = return () - - -- TODO: More commentary needed here + -- Use tcView, not coreView. See Note [coreView vs tcView] in GHC.Core.Type. | Just ty1' <- tcView ty1 = unify_ty env ty1' ty2 kco | Just ty2' <- tcView ty2 = unify_ty env ty1 ty2' kco | CastTy ty1' co <- ty1 = if um_unif env diff --git a/compiler/GHC/Tc/Solver/Canonical.hs b/compiler/GHC/Tc/Solver/Canonical.hs index ce8bf24632..fd608c3314 100644 --- a/compiler/GHC/Tc/Solver/Canonical.hs +++ b/compiler/GHC/Tc/Solver/Canonical.hs @@ -956,11 +956,6 @@ can_eq_nc' -> Type -> Type -- RHS, after and before type-synonym expansion, resp -> TcS (StopOrContinue Ct) --- See Note [Comparing nullary type synonyms] in GHC.Core.Type. -can_eq_nc' _flat _rdr_env _envs ev eq_rel ty1@(TyConApp tc1 []) _ps_ty1 (TyConApp tc2 []) _ps_ty2 - | tc1 == tc2 - = canEqReflexive ev eq_rel ty1 - -- Expand synonyms first; see Note [Type synonyms and canonicalization] can_eq_nc' rewritten rdr_env envs ev eq_rel ty1 ps_ty1 ty2 ps_ty2 | Just ty1' <- tcView ty1 = can_eq_nc' rewritten rdr_env envs ev eq_rel ty1' ps_ty1 ty2 ps_ty2 diff --git a/compiler/GHC/Tc/Utils/TcMType.hs b/compiler/GHC/Tc/Utils/TcMType.hs index e688dd5685..ccb9152e01 100644 --- a/compiler/GHC/Tc/Utils/TcMType.hs +++ b/compiler/GHC/Tc/Utils/TcMType.hs @@ -120,6 +120,7 @@ import GHC.Types.Id as Id import GHC.Types.Name import GHC.Types.Var.Set import GHC.Builtin.Types +import GHC.Builtin.Types.Prim import GHC.Types.Var.Env import GHC.Types.Name.Env import GHC.Utils.Misc diff --git a/compiler/GHC/Tc/Utils/TcType.hs b/compiler/GHC/Tc/Utils/TcType.hs index 6e4eea8f19..3e52419772 100644 --- a/compiler/GHC/Tc/Utils/TcType.hs +++ b/compiler/GHC/Tc/Utils/TcType.hs @@ -1581,11 +1581,6 @@ tc_eq_type keep_syns vis_only orig_ty1 orig_ty2 = go orig_env orig_ty1 orig_ty2 where go :: RnEnv2 -> Type -> Type -> Bool - -- See Note [Comparing nullary type synonyms] in GHC.Core.Type. - go _ (TyConApp tc1 []) (TyConApp tc2 []) - | tc1 == tc2 - = True - go env t1 t2 | not keep_syns, Just t1' <- tcView t1 = go env t1' t2 go env t1 t2 | not keep_syns, Just t2' <- tcView t2 = go env t1 t2' diff --git a/testsuite/tests/deSugar/should_compile/T2431.stderr b/testsuite/tests/deSugar/should_compile/T2431.stderr index 6e7df6c5de..86d74c2d35 100644 --- a/testsuite/tests/deSugar/should_compile/T2431.stderr +++ b/testsuite/tests/deSugar/should_compile/T2431.stderr @@ -1,9 +1,9 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 63, types: 39, coercions: 1, joins: 0/0} + = {terms: 63, types: 43, coercions: 1, joins: 0/0} --- RHS size: {terms: 2, types: 3, coercions: 1, joins: 0/0} +-- RHS size: {terms: 2, types: 4, coercions: 1, joins: 0/0} T2431.$WRefl [InlPrag=INLINE[final] CONLIKE] :: forall a. a :~: a [GblId[DataConWrapper], Caf=NoCafRefs, @@ -15,7 +15,7 @@ T2431.$WRefl [InlPrag=INLINE[final] CONLIKE] :: forall a. a :~: a T2431.$WRefl = \ (@a) -> T2431.Refl @a @a @~(<a>_N :: a GHC.Prim.~# a) --- RHS size: {terms: 4, types: 7, coercions: 0, joins: 0/0} +-- RHS size: {terms: 4, types: 8, coercions: 0, joins: 0/0} absurd :: forall a. (Int :~: Bool) -> a [GblId, Arity=1, Str=<U>b, Cpr=b, Unf=OtherCon []] absurd = \ (@a) (x :: Int :~: Bool) -> case x of { } diff --git a/testsuite/tests/deriving/should_compile/T14578.stderr b/testsuite/tests/deriving/should_compile/T14578.stderr index d93f12c34c..0018ebe569 100644 --- a/testsuite/tests/deriving/should_compile/T14578.stderr +++ b/testsuite/tests/deriving/should_compile/T14578.stderr @@ -16,12 +16,13 @@ Derived class instances: = GHC.Prim.coerce @(T14578.App (Data.Functor.Compose.Compose f g) a -> T14578.App (Data.Functor.Compose.Compose f g) a - -> T14578.App (Data.Functor.Compose.Compose f g) a) + -> T14578.App (Data.Functor.Compose.Compose f g) a) @(T14578.Wat f g a -> T14578.Wat f g a -> T14578.Wat f g a) ((GHC.Base.<>) @(T14578.App (Data.Functor.Compose.Compose f g) a)) GHC.Base.sconcat = GHC.Prim.coerce - @(GHC.Base.NonEmpty (T14578.App (Data.Functor.Compose.Compose f g) a) + @(GHC.Base.NonEmpty + (T14578.App (Data.Functor.Compose.Compose f g) a) -> T14578.App (Data.Functor.Compose.Compose f g) a) @(GHC.Base.NonEmpty (T14578.Wat f g a) -> T14578.Wat f g a) (GHC.Base.sconcat @@ -30,7 +31,7 @@ Derived class instances: = GHC.Prim.coerce @(b -> T14578.App (Data.Functor.Compose.Compose f g) a - -> T14578.App (Data.Functor.Compose.Compose f g) a) + -> T14578.App (Data.Functor.Compose.Compose f g) a) @(b -> T14578.Wat f g a -> T14578.Wat f g a) (GHC.Base.stimes @(T14578.App (Data.Functor.Compose.Compose f g) a)) diff --git a/testsuite/tests/plugins/plugins09.stdout b/testsuite/tests/plugins/plugins09.stdout index 61f96283ff..0401941734 100644 --- a/testsuite/tests/plugins/plugins09.stdout +++ b/testsuite/tests/plugins/plugins09.stdout @@ -3,5 +3,6 @@ interfacePlugin: Prelude interfacePlugin: GHC.Float interfacePlugin: GHC.Base typeCheckPlugin (rn) +interfacePlugin: GHC.Types typeCheckPlugin (tc) interfacePlugin: GHC.Num.BigNat diff --git a/testsuite/tests/plugins/plugins10.stdout b/testsuite/tests/plugins/plugins10.stdout index 37f424b076..ed31df86f1 100644 --- a/testsuite/tests/plugins/plugins10.stdout +++ b/testsuite/tests/plugins/plugins10.stdout @@ -6,6 +6,7 @@ interfacePlugin: GHC.Float interfacePlugin: GHC.Base interfacePlugin: Language.Haskell.TH.Syntax typeCheckPlugin (rn) +interfacePlugin: GHC.Types typeCheckPlugin (tc) interfacePlugin: GHC.Num.BigNat parsePlugin(a) diff --git a/testsuite/tests/plugins/plugins11.stdout b/testsuite/tests/plugins/plugins11.stdout index 6bab3559b1..b273bc7a10 100644 --- a/testsuite/tests/plugins/plugins11.stdout +++ b/testsuite/tests/plugins/plugins11.stdout @@ -3,5 +3,6 @@ interfacePlugin: Prelude interfacePlugin: GHC.Float interfacePlugin: GHC.Base typeCheckPlugin (rn) +interfacePlugin: GHC.Types typeCheckPlugin (tc) interfacePlugin: GHC.Num.BigNat diff --git a/testsuite/tests/plugins/static-plugins.stdout b/testsuite/tests/plugins/static-plugins.stdout index 032992824f..632af0076c 100644 --- a/testsuite/tests/plugins/static-plugins.stdout +++ b/testsuite/tests/plugins/static-plugins.stdout @@ -5,11 +5,11 @@ interfacePlugin: GHC.Float interfacePlugin: GHC.Base interfacePlugin: System.IO typeCheckPlugin (rn) -interfacePlugin: GHC.Types +interfacePlugin: GHC.Prim interfacePlugin: GHC.Show +interfacePlugin: GHC.Types interfacePlugin: GHC.TopHandler typeCheckPlugin (tc) -interfacePlugin: GHC.Prim interfacePlugin: GHC.CString interfacePlugin: GHC.Num.BigNat ==pure.1 diff --git a/testsuite/tests/printer/T18052a.stderr b/testsuite/tests/printer/T18052a.stderr index 28c96670cd..582a14a32c 100644 --- a/testsuite/tests/printer/T18052a.stderr +++ b/testsuite/tests/printer/T18052a.stderr @@ -10,9 +10,9 @@ Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.8.0] ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 24, types: 52, coercions: 0, joins: 0/0} + = {terms: 24, types: 61, coercions: 0, joins: 0/0} --- RHS size: {terms: 7, types: 6, coercions: 0, joins: 0/0} +-- RHS size: {terms: 7, types: 8, coercions: 0, joins: 0/0} T18052a.$b:||: :: forall {a} {b}. a -> b -> (a, b) [GblId, Arity=2, Unf=OtherCon []] T18052a.$b:||: = \ (@a) (@b) (x :: a) (y :: b) -> (x, y) @@ -22,7 +22,7 @@ T18052a.$b:||: = \ (@a) (@b) (x :: a) (y :: b) -> (x, y) [GblId] (+++) = ++ --- RHS size: {terms: 13, types: 18, coercions: 0, joins: 0/0} +-- RHS size: {terms: 13, types: 20, coercions: 0, joins: 0/0} T18052a.$m:||: :: forall {rep :: GHC.Types.RuntimeRep} {r :: TYPE rep} {a} {b}. (a, b) -> (a -> b -> r) -> ((# #) -> r) -> r diff --git a/testsuite/tests/simplCore/should_compile/T13143.stderr b/testsuite/tests/simplCore/should_compile/T13143.stderr index c2bc42a872..44ab565425 100644 --- a/testsuite/tests/simplCore/should_compile/T13143.stderr +++ b/testsuite/tests/simplCore/should_compile/T13143.stderr @@ -1,17 +1,17 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 71, types: 40, coercions: 0, joins: 0/0} + = {terms: 71, types: 44, coercions: 0, joins: 0/0} Rec { --- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0} +-- RHS size: {terms: 4, types: 4, coercions: 0, joins: 0/0} T13143.$wf [InlPrag=NOINLINE, Occ=LoopBreaker] :: forall {a}. (# #) -> a [GblId, Arity=1, Str=<B>b, Cpr=b, Unf=OtherCon []] T13143.$wf = \ (@a) _ [Occ=Dead] -> T13143.$wf @a GHC.Prim.(##) end Rec } --- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0} +-- RHS size: {terms: 4, types: 4, coercions: 0, joins: 0/0} f [InlPrag=[final]] :: forall a. Int -> a [GblId, Arity=1, diff --git a/testsuite/tests/simplCore/should_compile/T18013.stderr b/testsuite/tests/simplCore/should_compile/T18013.stderr index 20cb606cb4..51e30a9f75 100644 --- a/testsuite/tests/simplCore/should_compile/T18013.stderr +++ b/testsuite/tests/simplCore/should_compile/T18013.stderr @@ -129,9 +129,9 @@ Rule fired: Class op fmap (BUILTIN) ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 52, types: 101, coercions: 17, joins: 0/1} + = {terms: 52, types: 106, coercions: 17, joins: 0/1} --- RHS size: {terms: 37, types: 84, coercions: 17, joins: 0/1} +-- RHS size: {terms: 37, types: 87, coercions: 17, joins: 0/1} mapMaybeRule :: forall a b. Rule IO a b -> Rule IO (Maybe a) (Maybe b) [GblId, diff --git a/testsuite/tests/simplCore/should_compile/T7360.stderr b/testsuite/tests/simplCore/should_compile/T7360.stderr index 21fe15d4f5..73bafb04f6 100644 --- a/testsuite/tests/simplCore/should_compile/T7360.stderr +++ b/testsuite/tests/simplCore/should_compile/T7360.stderr @@ -1,7 +1,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 106, types: 45, coercions: 0, joins: 0/0} + = {terms: 106, types: 47, coercions: 0, joins: 0/0} -- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} T7360.$WFoo3 [InlPrag=INLINE[final] CONLIKE] :: Int %1 -> Foo @@ -31,7 +31,7 @@ T7360.fun4 :: () WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 20 0}] T7360.fun4 = fun1 T7360.Foo1 --- RHS size: {terms: 11, types: 7, coercions: 0, joins: 0/0} +-- RHS size: {terms: 11, types: 8, coercions: 0, joins: 0/0} fun2 :: forall {a}. [a] -> ((), Int) [GblId, Arity=1, diff --git a/testsuite/tests/typecheck/should_compile/T13032.stderr b/testsuite/tests/typecheck/should_compile/T13032.stderr index 3855f728c5..596d09a927 100644 --- a/testsuite/tests/typecheck/should_compile/T13032.stderr +++ b/testsuite/tests/typecheck/should_compile/T13032.stderr @@ -1,9 +1,9 @@ ==================== Desugar (after optimization) ==================== Result size of Desugar (after optimization) - = {terms: 13, types: 18, coercions: 0, joins: 0/0} + = {terms: 13, types: 24, coercions: 0, joins: 0/0} --- RHS size: {terms: 6, types: 8, coercions: 0, joins: 0/0} +-- RHS size: {terms: 6, types: 11, coercions: 0, joins: 0/0} f :: forall a b. (a ~ b) => a -> b -> Bool [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, diff --git a/utils/haddock b/utils/haddock -Subproject 48c4982646b7fe6343ccdf1581c97a7735fe894 +Subproject acf235d607879eb9542127eb0ddb42a250b5b85 |