From d55216ad61f0bb4705c6408b59a1541460e63af3 Mon Sep 17 00:00:00 2001
From: Krzysztof Gogolewski <krz.gogolewski@gmail.com>
Date: Sat, 30 Dec 2023 17:28:21 +0100
Subject: [PATCH] Refactor: store [[PrimRep]] rather than [Type] in STG
StgConApp stored a list of types. This list was used exclusively
during unarisation of unboxed sums (mkUbxSum).
However, this is at a wrong level of abstraction:
STG shouldn't be concerned with Haskell types, only PrimReps.
Update the code to store a [[PrimRep]]. Also, there's no point in storing
this list when we're not dealing with an unboxed sum.
---
compiler/GHC/CoreToStg.hs | 17 ++++++++++++++---
compiler/GHC/Stg/Syntax.hs | 2 +-
compiler/GHC/Stg/Unarise.hs | 34 +++++++++++++++++++++++-----------
3 files changed, 38 insertions(+), 15 deletions(-)
diff --git a/compiler/GHC/CoreToStg.hs b/compiler/GHC/CoreToStg.hs
index a2d09388ec87..a61e3d2d0bfa 100644
--- a/compiler/GHC/CoreToStg.hs
+++ b/compiler/GHC/CoreToStg.hs
@@ -56,7 +56,6 @@ import GHC.Utils.Misc (HasDebugCallStack)
import GHC.Utils.Panic
import Control.Monad (ap)
-import Data.Maybe (fromMaybe)
-- Note [Live vs free]
-- ~~~~~~~~~~~~~~~~~~~
@@ -531,8 +530,10 @@ coreToStgApp f args ticks = do
res_ty = exprType (mkApps (Var f) args)
app = case idDetails f of
DataConWorkId dc
- | saturated -> StgConApp dc NoNumber args'
- (dropRuntimeRepArgs (fromMaybe [] (tyConAppArgs_maybe res_ty)))
+ | saturated -> if isUnboxedSumDataCon dc then
+ StgConApp dc NoNumber args' (sumPrimReps args)
+ else
+ StgConApp dc NoNumber args' []
-- Some primitive operator that might be implemented as a library call.
-- As noted by Note [Eta expanding primops] in GHC.Builtin.PrimOps
@@ -560,6 +561,16 @@ coreToStgApp f args ticks = do
-- profiling for #4367
app `seq` return tapp
+
+-- Given Core arguments to an unboxed sum datacon, return the 'PrimRep's
+-- of every alternative. For example, in (#_|#) @LiftedRep @IntRep @Int @Int# 0
+-- the arguments are [Type LiftedRep, Type IntRep, Type Int, Type Int#, 0]
+-- and we return the list [[LiftedRep], [IntRep]].
+-- See Note [Representations in StgConApp] in GHC.Stg.Unarise.
+sumPrimReps :: [CoreArg] -> [[PrimRep]]
+sumPrimReps (Type ty : args) | isRuntimeRepKindedTy ty
+ = runtimeRepPrimRep (text "sumPrimReps") ty : sumPrimReps args
+sumPrimReps _ = []
-- ---------------------------------------------------------------------------
-- Argument lists
-- This is the guy that turns applications into A-normal form
diff --git a/compiler/GHC/Stg/Syntax.hs b/compiler/GHC/Stg/Syntax.hs
index b7a156e88e42..7deb2363b6f4 100644
--- a/compiler/GHC/Stg/Syntax.hs
+++ b/compiler/GHC/Stg/Syntax.hs
@@ -310,7 +310,7 @@ for the details of this transformation.
| StgConApp DataCon
ConstructorNumber
[StgArg] -- Saturated. See Note [Constructor applications in STG]
- [Type] -- See Note [Types in StgConApp] in GHC.Stg.Unarise
+ [[PrimRep]] -- See Note [Representations in StgConApp] in GHC.Stg.Unarise
| StgOpApp StgOp -- Primitive op or foreign call
[StgArg] -- Saturated.
diff --git a/compiler/GHC/Stg/Unarise.hs b/compiler/GHC/Stg/Unarise.hs
index f6499dea971e..5c850db995e9 100644
--- a/compiler/GHC/Stg/Unarise.hs
+++ b/compiler/GHC/Stg/Unarise.hs
@@ -166,8 +166,8 @@ avoid #19645. Other alternatives considered include:
way to fix what is ultimately a corner-case.
-Note [Types in StgConApp]
-~~~~~~~~~~~~~~~~~~~~~~~~~
+Note [Representations in StgConApp]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Suppose we have this unboxed sum term:
(# 123 | #)
@@ -180,9 +180,21 @@ type of this term. For example, these are all valid tuples for this:
(# 1#, 123, rubbish, rubbish #)
-- when type is (# Int | (# Int, Int, Int #) #)
-So we pass type arguments of the DataCon's TyCon in StgConApp to decide what
-layout to use. Note that unlifted values can't be let-bound, so we don't need
-types in StgRhsCon.
+Therefore, in StgConApp we store a list [[PrimRep]] of representations
+to decide what layout to use.
+Given (# T_1 | ... | T_n #), this list will be
+[typePrimRep T_1, ..., typePrimRep T_n].
+For example, given type
+ (# Int | String #) we will store [[LiftedRep], [LiftedRep]]
+ (# Int | Float# #) we will store [[LiftedRep], [FloatRep]]
+ (# Int | (# Int, Int, Int #) #) we will store [[LiftedRep], [LiftedRep, LiftedRep, LiftedRep]].
+
+This field is used for unboxed sums only and it's an empty list otherwise.
+Perhaps it would be more elegant to have a separate StgUnboxedSumCon,
+but that would require duplication of code in cases where the logic is shared.
+
+Note that unlifted values can't be let-bound, so we don't need
+representations in StgRhsCon.
Note [Casting slot arguments]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -527,7 +539,7 @@ unariseExpr rho (StgConApp dc n args ty_args)
-> return $ (mkTuple args')
| otherwise =
let args' = unariseConArgs rho args in
- return $ (StgConApp dc n args' (map stgArgType args'))
+ return $ (StgConApp dc n args' [])
unariseExpr rho (StgOpApp op args ty)
= return (StgOpApp op (unariseFunArgs rho args) ty)
@@ -572,7 +584,7 @@ unariseExpr rho (StgTick tick e)
= StgTick tick <$> unariseExpr rho e
-- Doesn't return void args.
-unariseUbxSumOrTupleArgs :: UnariseEnv -> UniqSupply -> DataCon -> [InStgArg] -> [Type]
+unariseUbxSumOrTupleArgs :: UnariseEnv -> UniqSupply -> DataCon -> [InStgArg] -> [[PrimRep]]
-> ( [OutStgArg] -- Arguments representing the unboxed sum
, Maybe (StgExpr -> StgExpr)) -- Transformation to apply to the arguments, to bring them
-- into the right Rep
@@ -860,7 +872,7 @@ mkCast arg_in cast_op out_id out_ty in_rhs =
--
-- Example, for (# x | #) :: (# (# #) | Int #) we call
--
--- mkUbxSum (# _ | #) [ (# #), Int ] [ voidPrimId ]
+-- mkUbxSum (# _ | #) [ [], [LiftedRep] ] [ voidPrimId ]
--
-- which returns
--
@@ -869,7 +881,7 @@ mkCast arg_in cast_op out_id out_ty in_rhs =
mkUbxSum
:: HasDebugCallStack
=> DataCon -- Sum data con
- -> [Type] -- Type arguments of the sum data con
+ -> [[PrimRep]] -- Representations of type arguments of the sum data con
-> [OutStgArg] -- Actual arguments of the alternative.
-> UniqSupply
-> ([OutStgArg] -- Final tuple arguments
@@ -877,7 +889,7 @@ mkUbxSum
)
mkUbxSum dc ty_args args0 us
= let
- _ :| sum_slots = ubxSumRepType (map typePrimRep ty_args)
+ _ :| sum_slots = ubxSumRepType ty_args
-- drop tag slot
field_slots = (mapMaybe (repSlotTy . stgArgRep) args0)
tag = dataConTag dc
@@ -1121,7 +1133,7 @@ isUnboxedTupleBndr :: Id -> Bool
isUnboxedTupleBndr = isUnboxedTupleType . idType
mkTuple :: [StgArg] -> StgExpr
-mkTuple args = StgConApp (tupleDataCon Unboxed (length args)) NoNumber args (map stgArgType args)
+mkTuple args = StgConApp (tupleDataCon Unboxed (length args)) NoNumber args []
tagAltTy :: AltType
tagAltTy = PrimAlt IntRep
--
GitLab