diff options
author | Ben Gamari <ben@smart-cactus.org> | 2021-11-15 23:22:06 -0500 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-11-17 05:10:27 -0500 |
commit | 083a7583d70c190b090fedcf9f955eff65d4baeb (patch) | |
tree | 8706cc9ee591bf2a05c23efcaa7251a0489e4c24 /compiler/GHC/StgToCmm | |
parent | 3e94b5a7ebddf156f00599c6bd2e9ba1af437a6c (diff) | |
download | haskell-083a7583d70c190b090fedcf9f955eff65d4baeb.tar.gz |
Increase type sharing
Fixes #20541 by making mkTyConApp do more sharing of types.
In particular, replace
* BoxedRep Lifted ==> LiftedRep
* BoxedRep Unlifted ==> UnliftedRep
* TupleRep '[] ==> ZeroBitRep
* TYPE ZeroBitRep ==> ZeroBitType
In each case, the thing on the right is a type synonym
for the thing on the left, declared in ghc-prim:GHC.Types.
See Note [Using synonyms to compress types] in GHC.Core.Type.
The synonyms for ZeroBitRep and ZeroBitType are new, but absolutely
in the same spirit as the other ones. (These synonyms are mainly
for internal use, though the programmer can use them too.)
I also renamed GHC.Core.Ty.Rep.isVoidTy to isZeroBitTy, to be
compatible with the "zero-bit" nomenclature above. See discussion
on !6806.
There is a tricky wrinkle: see GHC.Core.Types
Note [Care using synonyms to compress types]
Compiler allocation decreases by up to 0.8%.
Diffstat (limited to 'compiler/GHC/StgToCmm')
-rw-r--r-- | compiler/GHC/StgToCmm/Closure.hs | 8 | ||||
-rw-r--r-- | compiler/GHC/StgToCmm/Expr.hs | 8 |
2 files changed, 8 insertions, 8 deletions
diff --git a/compiler/GHC/StgToCmm/Closure.hs b/compiler/GHC/StgToCmm/Closure.hs index 3ff745a719..8b9e4f044b 100644 --- a/compiler/GHC/StgToCmm/Closure.hs +++ b/compiler/GHC/StgToCmm/Closure.hs @@ -151,23 +151,23 @@ instance (Outputable a) => Outputable (NonVoid a) where ppr (NonVoid a) = ppr a nonVoidIds :: [Id] -> [NonVoid Id] -nonVoidIds ids = [NonVoid id | id <- ids, not (isVoidTy (idType id))] +nonVoidIds ids = [NonVoid id | id <- ids, not (isZeroBitTy (idType id))] -- | Used in places where some invariant ensures that all these Ids are -- non-void; e.g. constructor field binders in case expressions. -- See Note [Post-unarisation invariants] in "GHC.Stg.Unarise". assertNonVoidIds :: [Id] -> [NonVoid Id] -assertNonVoidIds ids = assert (not (any (isVoidTy . idType) ids)) $ +assertNonVoidIds ids = assert (not (any (isZeroBitTy . idType) ids)) $ coerce ids nonVoidStgArgs :: [StgArg] -> [NonVoid StgArg] -nonVoidStgArgs args = [NonVoid arg | arg <- args, not (isVoidTy (stgArgType arg))] +nonVoidStgArgs args = [NonVoid arg | arg <- args, not (isZeroBitTy (stgArgType arg))] -- | Used in places where some invariant ensures that all these arguments are -- non-void; e.g. constructor arguments. -- See Note [Post-unarisation invariants] in "GHC.Stg.Unarise". assertNonVoidStgArgs :: [StgArg] -> [NonVoid StgArg] -assertNonVoidStgArgs args = assert (not (any (isVoidTy . stgArgType) args)) $ +assertNonVoidStgArgs args = assert (not (any (isZeroBitTy . stgArgType) args)) $ coerce args diff --git a/compiler/GHC/StgToCmm/Expr.hs b/compiler/GHC/StgToCmm/Expr.hs index 6355b55427..77476a4b7d 100644 --- a/compiler/GHC/StgToCmm/Expr.hs +++ b/compiler/GHC/StgToCmm/Expr.hs @@ -43,7 +43,7 @@ import GHC.Types.Id import GHC.Builtin.PrimOps import GHC.Core.TyCon import GHC.Core.Type ( isUnliftedType ) -import GHC.Types.RepType ( isVoidTy, countConRepArgs ) +import GHC.Types.RepType ( isZeroBitTy, countConRepArgs ) import GHC.Types.CostCentre ( CostCentreStack, currentCCS ) import GHC.Types.Tickish import GHC.Data.Maybe @@ -896,12 +896,12 @@ cgIdApp fun_id args = do fun = idInfoToAmode fun_info lf_info = cg_lf fun_info n_args = length args - v_args = length $ filter (isVoidTy . stgArgType) args + v_args = length $ filter (isZeroBitTy . stgArgType) args case getCallMethod call_opts fun_name fun_id lf_info n_args v_args (cg_loc fun_info) self_loop_info of -- A value in WHNF, so we can just return it. ReturnIt - | isVoidTy (idType fun_id) -> emitReturn [] - | otherwise -> emitReturn [fun] + | isZeroBitTy (idType fun_id) -> emitReturn [] + | otherwise -> emitReturn [fun] -- ToDo: does ReturnIt guarantee tagged? EnterIt -> assert (null args) $ -- Discarding arguments |