diff --git a/compiler/GHC/Builtin/PrimOps.hs b/compiler/GHC/Builtin/PrimOps.hs
index 842246df28b9f8ce0de9a18197aa16823549dac0..564c7e949356c3ce8b84ef0d0a6ae7663419d825 100644
--- a/compiler/GHC/Builtin/PrimOps.hs
+++ b/compiler/GHC/Builtin/PrimOps.hs
@@ -44,7 +44,7 @@ import GHC.Types.Demand
import GHC.Types.Id
import GHC.Types.Id.Info
import GHC.Types.Name
-import GHC.Types.RepType ( tyConPrimRep1 )
+import GHC.Types.RepType ( tyConPrimRep )
import GHC.Types.Basic
import GHC.Types.Fixity ( Fixity(..), FixityDirection(..) )
import GHC.Types.SrcLoc ( wiredInSrcSpan )
@@ -857,7 +857,8 @@ primOpSig op
GenPrimOp _occ tyvars arg_tys res_ty -> (tyvars, arg_tys, res_ty )
data PrimOpResultInfo
- = ReturnsPrim PrimRep
+ = ReturnsVoid
+ | ReturnsPrim PrimRep
| ReturnsTuple
-- Some PrimOps need not return a manifest primitive or algebraic value
@@ -867,8 +868,11 @@ data PrimOpResultInfo
getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
getPrimOpResultInfo op
= case (primOpInfo op) of
- Compare _ _ -> ReturnsPrim (tyConPrimRep1 intPrimTyCon)
- GenPrimOp _ _ _ ty | isPrimTyCon tc -> ReturnsPrim (tyConPrimRep1 tc)
+ Compare _ _ -> ReturnsPrim IntRep
+ GenPrimOp _ _ _ ty | isPrimTyCon tc -> case tyConPrimRep tc of
+ [] -> ReturnsVoid
+ [rep] -> ReturnsPrim rep
+ _ -> pprPanic "getPrimOpResultInfo" (ppr op)
| isUnboxedTupleTyCon tc -> ReturnsTuple
| otherwise -> pprPanic "getPrimOpResultInfo" (ppr op)
where
diff --git a/compiler/GHC/ByteCode/InfoTable.hs b/compiler/GHC/ByteCode/InfoTable.hs
index 4a11ee4b567bd9761b54512d32baebaf826ef775..3f1b14651898dbdc5117f5628d8c85a93c1a51f4 100644
--- a/compiler/GHC/ByteCode/InfoTable.hs
+++ b/compiler/GHC/ByteCode/InfoTable.hs
@@ -25,7 +25,7 @@ import GHC.Core.TyCon ( TyCon, tyConFamilySize, isDataTyCon, tyConDataCons
import GHC.Core.Multiplicity ( scaledThing )
import GHC.StgToCmm.Layout ( mkVirtConstrSizes )
-import GHC.StgToCmm.Closure ( tagForCon, NonVoid (..) )
+import GHC.StgToCmm.Closure ( tagForCon )
import GHC.Utils.Misc
import GHC.Utils.Panic
@@ -61,7 +61,7 @@ make_constr_itbls interp profile cons =
where
mk_itbl :: DataCon -> Int -> IO (Name,ItblPtr)
mk_itbl dcon conNo = do
- let rep_args = [ NonVoid prim_rep
+ let rep_args = [ prim_rep
| arg <- dataConRepArgTys dcon
, prim_rep <- typePrimRep (scaledThing arg) ]
diff --git a/compiler/GHC/Cmm/Utils.hs b/compiler/GHC/Cmm/Utils.hs
index e0de7e7cc5ab37df7c242cc5604db1558ec64711..b99f391f2be2c58dfee0289b59799e877766b886 100644
--- a/compiler/GHC/Cmm/Utils.hs
+++ b/compiler/GHC/Cmm/Utils.hs
@@ -70,7 +70,7 @@ module GHC.Cmm.Utils(
import GHC.Prelude
import GHC.Core.TyCon ( PrimRep(..), PrimElemRep(..) )
-import GHC.Types.RepType ( UnaryType, SlotTy (..), typePrimRep1 )
+import GHC.Types.RepType ( NvUnaryType, SlotTy (..), typePrimRepU )
import GHC.Platform
import GHC.Runtime.Heap.Layout
@@ -97,7 +97,6 @@ import GHC.Cmm.Dataflow.Collections
primRepCmmType :: Platform -> PrimRep -> CmmType
primRepCmmType platform = \case
- VoidRep -> panic "primRepCmmType:VoidRep"
BoxedRep _ -> gcWord platform
IntRep -> bWord platform
WordRep -> bWord platform
@@ -136,11 +135,10 @@ primElemRepCmmType Word64ElemRep = b64
primElemRepCmmType FloatElemRep = f32
primElemRepCmmType DoubleElemRep = f64
-typeCmmType :: Platform -> UnaryType -> CmmType
-typeCmmType platform ty = primRepCmmType platform (typePrimRep1 ty)
+typeCmmType :: Platform -> NvUnaryType -> CmmType
+typeCmmType platform ty = primRepCmmType platform (typePrimRepU ty)
primRepForeignHint :: PrimRep -> ForeignHint
-primRepForeignHint VoidRep = panic "primRepForeignHint:VoidRep"
primRepForeignHint (BoxedRep _) = AddrHint
primRepForeignHint IntRep = SignedHint
primRepForeignHint Int8Rep = SignedHint
@@ -157,8 +155,8 @@ primRepForeignHint FloatRep = NoHint
primRepForeignHint DoubleRep = NoHint
primRepForeignHint (VecRep {}) = NoHint
-typeForeignHint :: UnaryType -> ForeignHint
-typeForeignHint = primRepForeignHint . typePrimRep1
+typeForeignHint :: NvUnaryType -> ForeignHint
+typeForeignHint = primRepForeignHint . typePrimRepU
---------------------------------------------------
--
diff --git a/compiler/GHC/Core/TyCon.hs b/compiler/GHC/Core/TyCon.hs
index 830873a81f006b0cff88dc3c1c7d14ec2e8cd7ca..80d60728fc5fbcef37bf922c914c387ef9446ec4 100644
--- a/compiler/GHC/Core/TyCon.hs
+++ b/compiler/GHC/Core/TyCon.hs
@@ -126,8 +126,9 @@ module GHC.Core.TyCon(
-- * Primitive representations of Types
PrimRep(..), PrimElemRep(..), Levity(..),
+ PrimOrVoidRep(..),
primElemRepToPrimRep,
- isVoidRep, isGcPtrRep,
+ isGcPtrRep,
primRepSizeB, primRepSizeW64_B,
primElemRepSizeB, primElemRepSizeW64_B,
primRepIsFloat,
@@ -1532,17 +1533,18 @@ See Note [RuntimeRep and PrimRep] in GHC.Types.RepType.
-}
--- | A 'PrimRep' is an abstraction of a type. It contains information that
--- the code generator needs in order to pass arguments, return results,
+-- | A 'PrimRep' is an abstraction of a /non-void/ type.
+-- (Use 'PrimRepOrVoidRep' if you want void types too.)
+-- It contains information that the code generator needs
+-- in order to pass arguments, return results,
-- and store values of this type. See also Note [RuntimeRep and PrimRep] in
-- "GHC.Types.RepType" and Note [VoidRep] in "GHC.Types.RepType".
data PrimRep
- = VoidRep
-- Unpacking of sum types is only supported since 9.6.1
#if MIN_VERSION_GLASGOW_HASKELL(9,6,0,0)
- | BoxedRep {-# UNPACK #-} !(Maybe Levity) -- ^ Boxed, heap value
+ = BoxedRep {-# UNPACK #-} !(Maybe Levity) -- ^ Boxed, heap value
#else
- | BoxedRep !(Maybe Levity) -- ^ Boxed, heap value
+ = BoxedRep !(Maybe Levity) -- ^ Boxed, heap value
#endif
| Int8Rep -- ^ Signed, 8-bit value
| Int16Rep -- ^ Signed, 16-bit value
@@ -1560,6 +1562,9 @@ data PrimRep
| VecRep Int PrimElemRep -- ^ A vector
deriving( Data.Data, Eq, Ord, Show )
+data PrimOrVoidRep = VoidRep | NVRep PrimRep
+ -- See Note [VoidRep] in GHC.Types.RepType
+
data PrimElemRep
= Int8ElemRep
| Int16ElemRep
@@ -1580,58 +1585,52 @@ instance Outputable PrimElemRep where
ppr r = text (show r)
instance Binary PrimRep where
- put_ bh VoidRep = putByte bh 0
put_ bh (BoxedRep ml) = case ml of
-- cheaper storage of the levity than using
-- the Binary (Maybe Levity) instance
- Nothing -> putByte bh 1
- Just Lifted -> putByte bh 2
- Just Unlifted -> putByte bh 3
- put_ bh Int8Rep = putByte bh 4
- put_ bh Int16Rep = putByte bh 5
- put_ bh Int32Rep = putByte bh 6
- put_ bh Int64Rep = putByte bh 7
- put_ bh IntRep = putByte bh 8
- put_ bh Word8Rep = putByte bh 9
- put_ bh Word16Rep = putByte bh 10
- put_ bh Word32Rep = putByte bh 11
- put_ bh Word64Rep = putByte bh 12
- put_ bh WordRep = putByte bh 13
- put_ bh AddrRep = putByte bh 14
- put_ bh FloatRep = putByte bh 15
- put_ bh DoubleRep = putByte bh 16
- put_ bh (VecRep n per) = putByte bh 17 *> put_ bh n *> put_ bh per
+ Nothing -> putByte bh 0
+ Just Lifted -> putByte bh 1
+ Just Unlifted -> putByte bh 2
+ put_ bh Int8Rep = putByte bh 3
+ put_ bh Int16Rep = putByte bh 4
+ put_ bh Int32Rep = putByte bh 5
+ put_ bh Int64Rep = putByte bh 6
+ put_ bh IntRep = putByte bh 7
+ put_ bh Word8Rep = putByte bh 8
+ put_ bh Word16Rep = putByte bh 9
+ put_ bh Word32Rep = putByte bh 10
+ put_ bh Word64Rep = putByte bh 11
+ put_ bh WordRep = putByte bh 12
+ put_ bh AddrRep = putByte bh 13
+ put_ bh FloatRep = putByte bh 14
+ put_ bh DoubleRep = putByte bh 15
+ put_ bh (VecRep n per) = putByte bh 16 *> put_ bh n *> put_ bh per
get bh = do
h <- getByte bh
case h of
- 0 -> pure VoidRep
- 1 -> pure $ BoxedRep Nothing
- 2 -> pure $ BoxedRep (Just Lifted)
- 3 -> pure $ BoxedRep (Just Unlifted)
- 4 -> pure Int8Rep
- 5 -> pure Int16Rep
- 6 -> pure Int32Rep
- 7 -> pure Int64Rep
- 8 -> pure IntRep
- 9 -> pure Word8Rep
- 10 -> pure Word16Rep
- 11 -> pure Word32Rep
- 12 -> pure Word64Rep
- 13 -> pure WordRep
- 14 -> pure AddrRep
- 15 -> pure FloatRep
- 16 -> pure DoubleRep
- 17 -> VecRep <$> get bh <*> get bh
+ 0 -> pure $ BoxedRep Nothing
+ 1 -> pure $ BoxedRep (Just Lifted)
+ 2 -> pure $ BoxedRep (Just Unlifted)
+ 3 -> pure Int8Rep
+ 4 -> pure Int16Rep
+ 5 -> pure Int32Rep
+ 6 -> pure Int64Rep
+ 7 -> pure IntRep
+ 8 -> pure Word8Rep
+ 9 -> pure Word16Rep
+ 10 -> pure Word32Rep
+ 11 -> pure Word64Rep
+ 12 -> pure WordRep
+ 13 -> pure AddrRep
+ 14 -> pure FloatRep
+ 15 -> pure DoubleRep
+ 16 -> VecRep <$> get bh <*> get bh
_ -> pprPanic "Binary:PrimRep" (int (fromIntegral h))
instance Binary PrimElemRep where
put_ bh per = putByte bh (fromIntegral (fromEnum per))
get bh = toEnum . fromIntegral <$> getByte bh
-isVoidRep :: PrimRep -> Bool
-isVoidRep VoidRep = True
-isVoidRep _other = False
-
isGcPtrRep :: PrimRep -> Bool
isGcPtrRep (BoxedRep _) = True
isGcPtrRep _ = False
@@ -1676,7 +1675,6 @@ primRepSizeB platform = \case
DoubleRep -> dOUBLE_SIZE
AddrRep -> platformWordSizeInBytes platform
BoxedRep _ -> platformWordSizeInBytes platform
- VoidRep -> 0
(VecRep len rep) -> len * primElemRepSizeB platform rep
-- | Like primRepSizeB but assumes pointers/words are 8 words wide.
@@ -1699,7 +1697,6 @@ primRepSizeW64_B = \case
DoubleRep -> dOUBLE_SIZE
AddrRep -> 8
BoxedRep{} -> 8
- VoidRep -> 0
(VecRep len rep) -> len * primElemRepSizeW64_B rep
primElemRepSizeB :: Platform -> PrimElemRep -> Int
diff --git a/compiler/GHC/HsToCore/Foreign/Utils.hs b/compiler/GHC/HsToCore/Foreign/Utils.hs
index d86988f229bfd899487f52796d353f4db00bf19c..d8279f46e39872b38167ffe41744e740b9b0f205 100644
--- a/compiler/GHC/HsToCore/Foreign/Utils.hs
+++ b/compiler/GHC/HsToCore/Foreign/Utils.hs
@@ -57,7 +57,7 @@ primTyDescChar :: Platform -> Type -> Char
primTyDescChar !platform ty
| ty `eqType` unitTy = 'v'
| otherwise
- = case typePrimRep1 (getPrimTyOf ty) of
+ = case typePrimRepU (getPrimTyOf ty) of
IntRep -> signed_word
WordRep -> unsigned_word
Int8Rep -> 'B'
diff --git a/compiler/GHC/Stg/Lift/Analysis.hs b/compiler/GHC/Stg/Lift/Analysis.hs
index cf3db0b752942e56becc1498a820979e3179ebbe..3dbf84a5766714d720cadee7bbab2c5513a2d85c 100644
--- a/compiler/GHC/Stg/Lift/Analysis.hs
+++ b/compiler/GHC/Stg/Lift/Analysis.hs
@@ -418,7 +418,7 @@ closureSize profile ids = words + pc_STD_HDR_SIZE (platformConstants (profilePla
-- | The number of words a single 'Id' adds to a closure's size.
-- Note that this can't handle unboxed tuples (which may still be present in
-- let-no-escapes, even after Unarise), in which case
--- @'GHC.StgToCmm.Closure.idPrimRep'@ will crash.
+-- @'GHC.StgToCmm.ArgRep.idArgRep'@ will crash.
idClosureFootprint:: Platform -> Id -> WordOff
idClosureFootprint platform
= StgToCmm.ArgRep.argRepSizeW platform
diff --git a/compiler/GHC/Stg/Lint.hs b/compiler/GHC/Stg/Lint.hs
index 3a6c45b9918e1a1fada492846e6d53353bbb42ef..8e35d4f3642407453e8d5787e954e2bccf656c56 100644
--- a/compiler/GHC/Stg/Lint.hs
+++ b/compiler/GHC/Stg/Lint.hs
@@ -377,16 +377,10 @@ lintStgAppReps fun args = do
match_args (Nothing:_) _ = return ()
match_args (_) (Nothing:_) = return ()
match_args (Just actual_rep:actual_reps_left) (Just expected_rep:expected_reps_left)
- -- Common case, reps are exactly the same
+ -- Common case, reps are exactly the same (perhaps void)
| actual_rep == expected_rep
= match_args actual_reps_left expected_reps_left
- -- Check for void rep (empty list)
- -- Note typePrimRep_maybe will never return a result containing VoidRep.
- -- We should refactor to make this obvious from the types.
- | isVoidRep actual_rep && isVoidRep expected_rep
- = match_args actual_reps_left expected_reps_left
-
-- Some reps are compatible *even* if they are not the same. E.g. IntRep and WordRep.
-- We check for that here with primRepCompatible
| primRepsCompatible platform actual_rep expected_rep
@@ -409,8 +403,6 @@ lintStgAppReps fun args = do
-- text "expected reps:" <> ppr arg_ty_reps $$
text "unarised?:" <> ppr (lf_unarised lf))
where
- isVoidRep [] = True
- isVoidRep _ = False
-- Try to strip one non-void arg rep from the current argument type returning
-- the remaining list of arguments. We return Nothing for invalid input which
-- will result in a lint failure in match_args.
diff --git a/compiler/GHC/Stg/Syntax.hs b/compiler/GHC/Stg/Syntax.hs
index 7deb2363b6f4db13557b7e64624fb28d78632edd..33087dea30b2243613e789459d88b6af66e0efdd 100644
--- a/compiler/GHC/Stg/Syntax.hs
+++ b/compiler/GHC/Stg/Syntax.hs
@@ -58,6 +58,7 @@ module GHC.Stg.Syntax (
stgArgType,
stgArgRep,
stgArgRep1,
+ stgArgRepU,
stgArgRep_maybe,
stgCaseBndrInScope,
@@ -80,7 +81,7 @@ import GHC.Types.CostCentre ( CostCentreStack )
import GHC.Core ( AltCon )
import GHC.Core.DataCon
-import GHC.Core.TyCon ( PrimRep(..), TyCon )
+import GHC.Core.TyCon ( PrimRep(..), PrimOrVoidRep(..), TyCon )
import GHC.Core.Type ( Type )
import GHC.Core.Ppr( {- instances -} )
@@ -90,7 +91,7 @@ import GHC.Types.Name ( isDynLinkName )
import GHC.Types.Tickish ( StgTickish )
import GHC.Types.Var.Set
import GHC.Types.Literal ( Literal, literalType )
-import GHC.Types.RepType ( typePrimRep1, typePrimRep, typePrimRep_maybe )
+import GHC.Types.RepType ( typePrimRep, typePrimRep1, typePrimRepU, typePrimRep_maybe )
import GHC.Unit.Module ( Module )
import GHC.Utils.Outputable
@@ -177,10 +178,10 @@ isDllConApp platform ext_dyn_refs this_mod con args
-- $WT1 = T1 Int (Coercion (Refl Int))
--
-- The coercion argument here gets VoidRep
-isAddrRep :: PrimRep -> Bool
-isAddrRep AddrRep = True
-isAddrRep (BoxedRep _) = True -- FIXME: not true for JavaScript
-isAddrRep _ = False
+isAddrRep :: PrimOrVoidRep -> Bool
+isAddrRep (NVRep AddrRep) = True
+isAddrRep (NVRep (BoxedRep _)) = True -- FIXME: not true for JavaScript
+isAddrRep _ = False
-- | Type of an @StgArg@
--
@@ -199,11 +200,17 @@ stgArgRep ty = typePrimRep (stgArgType ty)
stgArgRep_maybe :: StgArg -> Maybe [PrimRep]
stgArgRep_maybe ty = typePrimRep_maybe (stgArgType ty)
--- | Assumes that the argument has one PrimRep, which holds after unarisation.
+-- | Assumes that the argument has at most one PrimRep, which holds after unarisation.
-- See Note [Post-unarisation invariants] in GHC.Stg.Unarise.
-stgArgRep1 :: StgArg -> PrimRep
+-- See Note [VoidRep] in GHC.Types.RepType.
+stgArgRep1 :: StgArg -> PrimOrVoidRep
stgArgRep1 ty = typePrimRep1 (stgArgType ty)
+-- | Assumes that the argument has exactly one PrimRep.
+-- See Note [VoidRep] in GHC.Types.RepType.
+stgArgRepU :: StgArg -> PrimRep
+stgArgRepU ty = typePrimRepU (stgArgType ty)
+
-- | Given an alt type and whether the program is unarised, return whether the
-- case binder is in scope.
--
diff --git a/compiler/GHC/Stg/Unarise.hs b/compiler/GHC/Stg/Unarise.hs
index 886f4796f5d5a7c23613d9bbfc38246c05793b72..d4c789ce6acee5988f40d57bde737f142e71fd18 100644
--- a/compiler/GHC/Stg/Unarise.hs
+++ b/compiler/GHC/Stg/Unarise.hs
@@ -373,6 +373,7 @@ STG programs after unarisation have these invariants:
2. No unboxed tuple binders. Tuples only appear in return position.
3. Binders and literals always have zero (for void arguments) or one PrimRep.
+ (i.e. typePrimRep1 won't crash; see Note [VoidRep] in GHC.Types.RepType.)
4. DataCon applications (StgRhsCon and StgConApp) don't have void arguments.
This means that it's safe to wrap `StgArg`s of DataCon applications with
@@ -607,13 +608,12 @@ unariseUbxSumOrTupleArgs rho us dc args ty_args
-- See also Note [Rubbish literals] in GHC.Types.Literal.
unariseLiteral_maybe :: Literal -> Maybe [OutStgArg]
unariseLiteral_maybe (LitRubbish torc rep)
- | [prep] <- preps
- , assert (not (isVoidRep prep)) True
- = Nothing -- Single, non-void PrimRep. Nothing to do!
+ | [_] <- preps
+ = Nothing -- Single PrimRep. Nothing to do!
- | otherwise -- Multiple reps, possibly with VoidRep. Eliminate via elimCase
+ | otherwise -- Multiple reps, or zero. Eliminate via elimCase
= Just [ StgLitArg (LitRubbish torc (primRepToRuntimeRep prep))
- | prep <- preps, assert (not (isVoidRep prep)) True ]
+ | prep <- preps ]
where
preps = runtimeRepPrimRep (text "unariseLiteral_maybe") rep
@@ -814,7 +814,7 @@ mapSumIdBinders alt_bndr args rhs rho0
mkCastInput :: (Id,PrimRep,UniqSupply) -> ([(PrimOp,Type,Unique)],Id,Id)
mkCastInput (id,rep,bndr_us) =
- let (ops,types) = unzip $ getCasts (typePrimRep1 $ idType id) rep
+ let (ops,types) = unzip $ getCasts (typePrimRepU $ idType id) rep
cst_opts = zip3 ops types $ uniqsFromSupply bndr_us
out_id = case cst_opts of
[] -> id
@@ -860,7 +860,7 @@ mkCastVar uq ty = mkSysLocal (fsLit "cst_sum") uq ManyTy ty
mkCast :: StgArg -> PrimOp -> OutId -> Type -> StgExpr -> StgExpr
mkCast arg_in cast_op out_id out_ty in_rhs =
- let r2 = typePrimRep1 out_ty
+ let r2 = typePrimRepU out_ty
scrut = StgOpApp (StgPrimOp cast_op) [arg_in] out_ty
alt = GenStgAlt { alt_con = DEFAULT, alt_bndrs = [], alt_rhs = in_rhs}
alt_ty = PrimAlt r2
@@ -922,8 +922,8 @@ mkUbxSum dc ty_args args0 us
castArg :: UniqSupply -> SlotTy -> StgArg -> Maybe (StgArg,UniqSupply,StgExpr -> StgExpr)
castArg us slot_ty arg
-- Cast the argument to the type of the slot if required
- | slotPrimRep slot_ty /= stgArgRep1 arg
- , (ops,types) <- unzip $ getCasts (stgArgRep1 arg) $ slotPrimRep slot_ty
+ | slotPrimRep slot_ty /= stgArgRepU arg
+ , (ops,types) <- unzip $ getCasts (stgArgRepU arg) $ slotPrimRep slot_ty
, not . null $ ops
= let (us1,us2) = splitUniqSupply us
cast_uqs = uniqsFromSupply us1
diff --git a/compiler/GHC/StgToByteCode.hs b/compiler/GHC/StgToByteCode.hs
index 25a08dcf121d8a0469b193d105079e1bf6f659fb..35a688107d9d03ff7075c94efa902eb7e5e09a8a 100644
--- a/compiler/GHC/StgToByteCode.hs
+++ b/compiler/GHC/StgToByteCode.hs
@@ -57,7 +57,7 @@ import GHC.Builtin.Uniques
import GHC.Data.FastString
import GHC.Utils.Panic
import GHC.Utils.Exception (evaluate)
-import GHC.StgToCmm.Closure ( NonVoid(..), fromNonVoid, idPrimRep,
+import GHC.StgToCmm.Closure ( NonVoid(..), fromNonVoid, idPrimRepU,
addIdReps, addArgReps,
nonVoidIds, nonVoidStgArgs )
import GHC.StgToCmm.Layout
@@ -529,7 +529,7 @@ returnUnboxedTuple
returnUnboxedTuple d s p es = do
profile <- getProfile
let platform = profilePlatform profile
- arg_ty e = primRepCmmType platform (stgArgRep1 e)
+ arg_ty e = primRepCmmType platform (stgArgRepU e)
(call_info, tuple_components) = layoutNativeCall profile
NativeTupleReturn
d
@@ -540,12 +540,14 @@ returnUnboxedTuple d s p es = do
massert (off == dd + szb)
go (dd + szb) (push:pushes) cs
pushes <- go d [] tuple_components
- let non_void VoidRep = False
- non_void _ = True
+ let rep_to_maybe :: PrimOrVoidRep -> Maybe PrimRep
+ rep_to_maybe VoidRep = Nothing
+ rep_to_maybe (NVRep rep) = Just rep
+
ret <- returnUnliftedReps d
s
(wordsToBytes platform $ nativeCallSize call_info)
- (filter non_void $ map stgArgRep1 es)
+ (mapMaybe (rep_to_maybe . stgArgRep1) es)
return (mconcat pushes `appOL` ret)
-- Compile code to apply the given expression to the remaining args
@@ -928,7 +930,7 @@ doCase d s p scrut bndr alts
rhs_code <- schemeE d_alts s p_alts rhs
return (my_discr alt, rhs_code)
| isUnboxedTupleType bndr_ty || isUnboxedSumType bndr_ty =
- let bndr_ty = primRepCmmType platform . idPrimRep
+ let bndr_ty = primRepCmmType platform . idPrimRepU
tuple_start = d_bndr
(call_info, args_offsets) =
layoutNativeCall profile
@@ -944,7 +946,7 @@ doCase d s p scrut bndr alts
wordsToBytes platform (nativeCallSize call_info) +
offset)
| (arg, offset) <- args_offsets
- , not (isVoidRep $ idPrimRep arg)]
+ , not (isZeroBitTy $ idType arg)]
p_alts
in do
rhs_code <- schemeE stack_bot s p' rhs
@@ -1378,10 +1380,10 @@ generatePrimCall d s p target _mb_unit _result_ty args
layoutNativeCall profile
NativePrimCall
0
- (primRepCmmType platform . stgArgRep1)
+ (primRepCmmType platform . stgArgRepU)
nv_args
- prim_args_offsets = mapFst stgArgRep1 args_offsets
+ prim_args_offsets = mapFst stgArgRepU args_offsets
shifted_args_offsets = mapSnd (+ d) args_offsets
push_target = PUSH_UBX (LitLabel target Nothing IsFunction) 1
@@ -1457,7 +1459,7 @@ generateCCall d0 s p (CCallSpec target cconv safety) result_ty args
-- ArgRep of what was actually pushed.
pargs
- :: ByteOff -> [StgArg] -> BcM [(BCInstrList, PrimRep)]
+ :: ByteOff -> [StgArg] -> BcM [(BCInstrList, PrimOrVoidRep)]
pargs _ [] = return []
pargs d (aa@(StgVarArg a):az)
| Just t <- tyConAppTyCon_maybe (idType a)
@@ -1470,7 +1472,7 @@ generateCCall d0 s p (CCallSpec target cconv safety) result_ty args
-- The ptr points at the header. Advance it over the
-- header and then pretend this is an Addr#.
let code = push_fo `snocOL` SWIZZLE 0 (fromIntegral hdr_sz)
- return ((code, AddrRep) : rest)
+ return ((code, NVRep AddrRep) : rest)
pargs d (aa:az) = do (code_a, sz_a) <- pushAtom d p aa
rest <- pargs (d + sz_a) az
return ((code_a, stgArgRep1 aa) : rest)
@@ -1483,8 +1485,7 @@ generateCCall d0 s p (CCallSpec target cconv safety) result_ty args
push_args = concatOL pushs_arg
!d_after_args = d0 + wordsToBytes platform a_reps_sizeW
a_reps_pushed_RAW
- | x:xs <- a_reps_pushed_r_to_l
- , isVoidRep x
+ | VoidRep:xs <- a_reps_pushed_r_to_l
= reverse xs
| otherwise
= panic "GHC.StgToByteCode.generateCCall: missing or invalid World token?"
@@ -1494,10 +1495,7 @@ generateCCall d0 s p (CCallSpec target cconv safety) result_ty args
-- d_after_args is the stack depth once the args are on.
-- Get the result rep.
- (returns_void, r_rep)
- = case maybe_getCCallReturnRep result_ty of
- Nothing -> (True, VoidRep)
- Just rr -> (False, rr)
+ r_rep = maybe_getCCallReturnRep result_ty
{-
Because the Haskell stack grows down, the a_reps refer to
lowest to highest addresses in that order. The args for the call
@@ -1570,10 +1568,9 @@ generateCCall d0 s p (CCallSpec target cconv safety) result_ty args
-- this is a V (tag).
r_sizeW = repSizeWords platform r_rep
d_after_r = d_after_Addr + wordsToBytes platform r_sizeW
- push_r =
- if returns_void
- then nilOL
- else unitOL (PUSH_UBX (mkDummyLiteral platform r_rep) (r_sizeW))
+ push_r = case r_rep of
+ VoidRep -> nilOL
+ NVRep r -> unitOL (PUSH_UBX (mkDummyLiteral platform r) r_sizeW)
-- generate the marshalling code we're going to call
@@ -1611,17 +1608,17 @@ generateCCall d0 s p (CCallSpec target cconv safety) result_ty args
-- slide and return
d_after_r_min_s = bytesToWords platform (d_after_r - s)
wrapup = mkSlideW r_sizeW (d_after_r_min_s - r_sizeW)
- `snocOL` RETURN (toArgRep platform r_rep)
+ `snocOL` RETURN (toArgRepOrV platform r_rep)
--trace (show (arg1_offW, args_offW , (map argRepSizeW a_reps) )) $
return (
push_args `appOL`
push_Addr `appOL` push_r `appOL` do_call `appOL` wrapup
)
-primRepToFFIType :: Platform -> PrimRep -> FFIType
-primRepToFFIType platform r
+primRepToFFIType :: Platform -> PrimOrVoidRep -> FFIType
+primRepToFFIType _ VoidRep = FFIVoid
+primRepToFFIType platform (NVRep r)
= case r of
- VoidRep -> FFIVoid
IntRep -> signed_word
WordRep -> unsigned_word
Int8Rep -> FFISInt8
@@ -1668,7 +1665,7 @@ mkDummyLiteral platform pr
-- GHC.Prim.Char# -> GHC.Prim.State# GHC.Prim.RealWorld
-- -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #)
--
--- to Just IntRep
+-- to NVRep IntRep
-- and check that an unboxed pair is returned wherein the first arg is V'd.
--
-- Alternatively, for call-targets returning nothing, convert
@@ -1676,16 +1673,16 @@ mkDummyLiteral platform pr
-- GHC.Prim.Char# -> GHC.Prim.State# GHC.Prim.RealWorld
-- -> (# GHC.Prim.State# GHC.Prim.RealWorld #)
--
--- to Nothing
+-- to VoidRep
-maybe_getCCallReturnRep :: Type -> Maybe PrimRep
+maybe_getCCallReturnRep :: Type -> PrimOrVoidRep
maybe_getCCallReturnRep fn_ty
= let
(_a_tys, r_ty) = splitFunTys (dropForAlls fn_ty)
in
case typePrimRep r_ty of
- [] -> Nothing
- [rep] -> Just rep
+ [] -> VoidRep
+ [rep] -> NVRep rep
-- if it was, it would be impossible to create a
-- valid return value placeholder on the stack
@@ -2131,10 +2128,10 @@ idSizeCon platform var
wordsToBytes platform .
WordOff . sum . map (argRepSizeW platform . toArgRep platform) .
typePrimRep . idType $ var
- | otherwise = ByteOff (primRepSizeB platform (idPrimRep var))
+ | otherwise = ByteOff (primRepSizeB platform (idPrimRepU var))
-repSizeWords :: Platform -> PrimRep -> WordOff
-repSizeWords platform rep = WordOff $ argRepSizeW platform (toArgRep platform rep)
+repSizeWords :: Platform -> PrimOrVoidRep -> WordOff
+repSizeWords platform rep = WordOff $ argRepSizeW platform (toArgRepOrV platform rep)
isFollowableArg :: ArgRep -> Bool
isFollowableArg P = True
@@ -2171,7 +2168,7 @@ mkSlideW !n !ws
atomRep :: Platform -> StgArg -> ArgRep
-atomRep platform e = toArgRep platform (stgArgRep1 e)
+atomRep platform e = toArgRepOrV platform (stgArgRep1 e)
-- | Let szsw be the sizes in bytes of some items pushed onto the stack, which
-- has initial depth @original_depth@. Return the values which the stack
diff --git a/compiler/GHC/StgToCmm.hs b/compiler/GHC/StgToCmm.hs
index f50d591f802542ebda33cd9f0c21503e393e13e4..884a876c683f090cd58077d2b4064678e3408afe 100644
--- a/compiler/GHC/StgToCmm.hs
+++ b/compiler/GHC/StgToCmm.hs
@@ -253,8 +253,8 @@ cgDataCon mn data_con
-- We're generating info tables, so we don't know and care about
-- what the actual arguments are. Using () here as the place holder.
- arg_reps :: [NonVoid PrimRep]
- arg_reps = [ NonVoid rep_ty
+ arg_reps :: [PrimRep]
+ arg_reps = [ rep_ty
| ty <- dataConRepArgTys data_con
, rep_ty <- typePrimRep (scaledThing ty)
]
diff --git a/compiler/GHC/StgToCmm/ArgRep.hs b/compiler/GHC/StgToCmm/ArgRep.hs
index 773195b6db43e6ed9e32515841e444930829f928..3440d15ac25aad73164b33dc1457d86c2e2f34b8 100644
--- a/compiler/GHC/StgToCmm/ArgRep.hs
+++ b/compiler/GHC/StgToCmm/ArgRep.hs
@@ -9,7 +9,7 @@
{-# LANGUAGE LambdaCase #-}
module GHC.StgToCmm.ArgRep (
- ArgRep(..), toArgRep, argRepSizeW,
+ ArgRep(..), toArgRep, toArgRepOrV, argRepSizeW,
argRepString, isNonV, idArgRep,
@@ -20,10 +20,10 @@ module GHC.StgToCmm.ArgRep (
import GHC.Prelude
import GHC.Platform
-import GHC.StgToCmm.Closure ( idPrimRep )
+import GHC.StgToCmm.Closure ( idPrimRep1 )
import GHC.Runtime.Heap.Layout ( WordOff )
import GHC.Types.Id ( Id )
-import GHC.Core.TyCon ( PrimRep(..), primElemRepSizeB )
+import GHC.Core.TyCon ( PrimRep(..), PrimOrVoidRep(..), primElemRepSizeB )
import GHC.Types.Basic ( RepArity )
import GHC.Settings.Constants ( wORD64_SIZE, dOUBLE_SIZE )
@@ -68,7 +68,6 @@ argRepString V64 = "V64"
toArgRep :: Platform -> PrimRep -> ArgRep
toArgRep platform rep = case rep of
- VoidRep -> V
BoxedRep _ -> P
IntRep -> N
WordRep -> N
@@ -93,6 +92,10 @@ toArgRep platform rep = case rep of
64 -> V64
_ -> error "toArgRep: bad vector primrep"
+toArgRepOrV :: Platform -> PrimOrVoidRep -> ArgRep
+toArgRepOrV _ VoidRep = V
+toArgRepOrV platform (NVRep rep) = toArgRep platform rep
+
isNonV :: ArgRep -> Bool
isNonV V = False
isNonV _ = True
@@ -112,7 +115,7 @@ argRepSizeW platform = \case
ws = platformWordSizeInBytes platform
idArgRep :: Platform -> Id -> ArgRep
-idArgRep platform = toArgRep platform . idPrimRep
+idArgRep platform = toArgRepOrV platform . idPrimRep1
-- This list of argument patterns should be kept in sync with at least
-- the following:
diff --git a/compiler/GHC/StgToCmm/Bind.hs b/compiler/GHC/StgToCmm/Bind.hs
index 60857e294e6d72d0ae46286f7a4ee604776bf450..e7c3d3781b5034dedd73dd63fdea028d7532fc0d 100644
--- a/compiler/GHC/StgToCmm/Bind.hs
+++ b/compiler/GHC/StgToCmm/Bind.hs
@@ -382,7 +382,7 @@ mkRhsClosure profile use_std_ap check_tags bndr _cc
-- args are all distinct local variables
-- The "-1" is for fun_id
-- Missed opportunity: (f x x) is not detected
- , all (isGcPtrRep . idPrimRep . fromNonVoid) fvs
+ , all (isGcPtrRep . idPrimRepU . fromNonVoid) fvs
, isUpdatable upd_flag
, n_fvs <= pc_MAX_SPEC_AP_SIZE (profileConstants profile)
, not (profileIsProfiling profile)
diff --git a/compiler/GHC/StgToCmm/Closure.hs b/compiler/GHC/StgToCmm/Closure.hs
index 84c6e28b76df66134cd6291695b7333086aa5edc..ad7377da48733e7a41755050c03f1f42964aa02a 100644
--- a/compiler/GHC/StgToCmm/Closure.hs
+++ b/compiler/GHC/StgToCmm/Closure.hs
@@ -18,7 +18,7 @@
module GHC.StgToCmm.Closure (
DynTag, tagForCon, isSmallFamily,
- idPrimRep, isVoidRep, isGcPtrRep, addIdReps, addArgReps,
+ idPrimRep1, idPrimRepU, isGcPtrRep, addIdReps, addArgReps,
NonVoid(..), fromNonVoid, nonVoidIds, nonVoidStgArgs,
assertNonVoidIds, assertNonVoidStgArgs,
@@ -176,24 +176,27 @@ assertNonVoidStgArgs args = assert (not (any (null . stgArgRep) args)) $
-- Why are these here?
--- | Assumes that there is precisely one 'PrimRep' of the type. This assumption
+-- | Assumes that there is at most one 'PrimRep' of the type. This assumption
-- holds after unarise.
-- See Note [Post-unarisation invariants] in GHC.Stg.Unarise.
-idPrimRep :: Id -> PrimRep
-idPrimRep id = typePrimRep1 (idType id)
- -- See also Note [VoidRep] in GHC.Types.RepType
+-- See Note [VoidRep] in GHC.Types.RepType.
+idPrimRep1 :: Id -> PrimOrVoidRep
+idPrimRep1 id = typePrimRep1 (idType id)
+
+idPrimRepU :: Id -> PrimRep
+idPrimRepU id = typePrimRepU (idType id)
-- | Assumes that Ids have one PrimRep, which holds after unarisation.
-- See Note [Post-unarisation invariants] in GHC.Stg.Unarise.
addIdReps :: [NonVoid Id] -> [NonVoid (PrimRep, Id)]
addIdReps = map (\id -> let id' = fromNonVoid id
- in NonVoid (idPrimRep id', id'))
+ in NonVoid (idPrimRepU id', id'))
-- | Assumes that arguments have one PrimRep, which holds after unarisation.
-- See Note [Post-unarisation invariants] in GHC.Stg.Unarise.
addArgReps :: [NonVoid StgArg] -> [NonVoid (PrimRep, StgArg)]
addArgReps = map (\arg -> let arg' = fromNonVoid arg
- in NonVoid (stgArgRep1 arg', arg'))
+ in NonVoid (stgArgRepU arg', arg'))
------------------------------------------------------
-- Building LambdaFormInfo
diff --git a/compiler/GHC/StgToCmm/Env.hs b/compiler/GHC/StgToCmm/Env.hs
index afa313b2252d663bb99b07b92cdbe2fa00fcd8b3..d027a154bacb476b64b44ef07a3bcfef9ca8c167 100644
--- a/compiler/GHC/StgToCmm/Env.hs
+++ b/compiler/GHC/StgToCmm/Env.hs
@@ -205,4 +205,4 @@ idToReg :: Platform -> NonVoid Id -> LocalReg
-- about accidental collision
idToReg platform (NonVoid id)
= LocalReg (idUnique id)
- (primRepCmmType platform (idPrimRep id))
+ (primRepCmmType platform (idPrimRepU id))
diff --git a/compiler/GHC/StgToCmm/Expr.hs b/compiler/GHC/StgToCmm/Expr.hs
index ca5b4b43fdcfb55bad3c9a0959c64babc8ac5252..3e581c9981cdcdafdcbbc31c99899f48f134b60f 100644
--- a/compiler/GHC/StgToCmm/Expr.hs
+++ b/compiler/GHC/StgToCmm/Expr.hs
@@ -488,7 +488,7 @@ accurate update would complexify the implementation and doesn't seem worth it.
-}
cgCase (StgApp v []) _ (PrimAlt _) alts
- | isVoidRep (idPrimRep v) -- See Note [Scrutinising VoidRep]
+ | isZeroBitTy (idType v) -- See Note [Scrutinising VoidRep]
, [GenStgAlt{alt_con=DEFAULT, alt_bndrs=_, alt_rhs=rhs}] <- alts
= cgExpr rhs
@@ -522,9 +522,9 @@ cgCase (StgApp v []) bndr alt_type@(PrimAlt _) alts
; _ <- bindArgToReg (NonVoid bndr)
; cgAlts (NoGcInAlts,AssignedDirectly) (NonVoid bndr) alt_type alts }
where
- reps_compatible platform = primRepCompatible platform (idPrimRep v) (idPrimRep bndr)
+ reps_compatible platform = primRepCompatible platform (idPrimRepU v) (idPrimRepU bndr)
- pp_bndr id = ppr id <+> dcolon <+> ppr (idType id) <+> parens (ppr (idPrimRep id))
+ pp_bndr id = ppr id <+> dcolon <+> ppr (idType id) <+> parens (ppr (idPrimRepU id))
{- Note [Dodgy unsafeCoerce 2, #3132]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/GHC/StgToCmm/Layout.hs b/compiler/GHC/StgToCmm/Layout.hs
index 58b1add95d41c4f9773f0f7fdfc5542305f9c291..c2993fa3526c1f3e2fd52658b07a61cafe105a37 100644
--- a/compiler/GHC/StgToCmm/Layout.hs
+++ b/compiler/GHC/StgToCmm/Layout.hs
@@ -26,7 +26,7 @@ module GHC.StgToCmm.Layout (
mkVirtConstrSizes,
getHpRelOffset,
- ArgRep(..), toArgRep, idArgRep, argRepSizeW, -- re-exported from GHC.StgToCmm.ArgRep
+ ArgRep(..), toArgRep, toArgRepOrV, idArgRep, argRepSizeW, -- re-exported from GHC.StgToCmm.ArgRep
getArgAmode, getNonVoidArgAmodes
) where
@@ -50,7 +50,7 @@ import GHC.Cmm.Info
import GHC.Cmm.CLabel
import GHC.Stg.Syntax
import GHC.Types.Id
-import GHC.Core.TyCon ( PrimRep(..), primRepSizeB )
+import GHC.Core.TyCon ( PrimRep(..), PrimOrVoidRep(..), primRepSizeB )
import GHC.Types.Basic ( RepArity )
import GHC.Platform
import GHC.Platform.Profile
@@ -330,8 +330,8 @@ getArgRepsAmodes args = do
where getArgRepAmode platform arg
= case stgArgRep1 arg of
VoidRep -> return (V, Nothing)
- rep -> do expr <- getArgAmode (NonVoid arg)
- return (toArgRep platform rep, Just expr)
+ NVRep rep -> do expr <- getArgAmode (NonVoid arg)
+ return (toArgRep platform rep, Just expr)
nonVArgs :: [(ArgRep, Maybe CmmExpr)] -> [CmmExpr]
nonVArgs [] = []
@@ -438,7 +438,6 @@ mkVirtHeapOffsetsWithPadding
-- than the unboxed things
mkVirtHeapOffsetsWithPadding profile header things =
- assert (not (any (isVoidRep . fst . fromNonVoid) things))
( tot_wds
, bytesToWordsRoundUp platform bytes_of_ptrs
, concat (ptrs_w_offsets ++ non_ptrs_w_offsets) ++ final_pad
@@ -520,13 +519,13 @@ mkVirtConstrOffsets profile = mkVirtHeapOffsets profile StdHeader
-- | Just like mkVirtConstrOffsets, but used when we don't have the actual
-- arguments. Useful when e.g. generating info tables; we just need to know
-- sizes of pointer and non-pointer fields.
-mkVirtConstrSizes :: Profile -> [NonVoid PrimRep] -> (WordOff, WordOff)
+mkVirtConstrSizes :: Profile -> [PrimRep] -> (WordOff, WordOff)
mkVirtConstrSizes profile field_reps
= (tot_wds, ptr_wds)
where
(tot_wds, ptr_wds, _) =
mkVirtConstrOffsets profile
- (map (\nv_rep -> NonVoid (fromNonVoid nv_rep, ())) field_reps)
+ (map (\nv_rep -> NonVoid (nv_rep, ())) field_reps)
-------------------------------------------------------------------------
--
diff --git a/compiler/GHC/StgToCmm/Lit.hs b/compiler/GHC/StgToCmm/Lit.hs
index 3615e65d489adc0b7371139c98bb70bbf36b9ae3..f4815c56caf0935ee22ccbe986eb2a28dd8a29ba 100644
--- a/compiler/GHC/StgToCmm/Lit.hs
+++ b/compiler/GHC/StgToCmm/Lit.hs
@@ -52,7 +52,6 @@ cgLit (LitString s) =
-- not unpackFS; we want the UTF-8 byte stream.
cgLit (LitRubbish _ rep) =
case expectOnly "cgLit" prim_reps of -- Note [Post-unarisation invariants]
- VoidRep -> panic "cgLit:VoidRep" -- ditto
BoxedRep _ -> idInfoToAmode <$> getCgIdInfo unitDataConId
AddrRep -> cgLit LitNullAddr
VecRep n elem -> do
diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs
index e6fff4da1a9b4897e53c6d43f9a5adfc54dd4dd7..e30d95f2d444c083590e178f239a7207e2d77a68 100644
--- a/compiler/GHC/StgToCmm/Prim.hs
+++ b/compiler/GHC/StgToCmm/Prim.hs
@@ -1812,7 +1812,7 @@ emitPrimOp cfg primop =
-> PrimopCmmEmit
opIntoRegs f = PrimopCmmEmit_Internal $ \res_ty -> do
regs <- case result_info of
- ReturnsPrim VoidRep -> pure []
+ ReturnsVoid -> pure []
ReturnsPrim rep
-> do reg <- newTemp (primRepCmmType platform rep)
pure [reg]
diff --git a/compiler/GHC/StgToCmm/Ticky.hs b/compiler/GHC/StgToCmm/Ticky.hs
index f3cd7dc327c6de96284a016ea15511b28296ca2c..14822e544b96c7fe71cb4f0868f350a44663ce33 100644
--- a/compiler/GHC/StgToCmm/Ticky.hs
+++ b/compiler/GHC/StgToCmm/Ticky.hs
@@ -118,7 +118,7 @@ import GHC.Prelude
import GHC.Platform
import GHC.Platform.Profile
-import GHC.StgToCmm.ArgRep ( slowCallPattern , toArgRep , argRepString )
+import GHC.StgToCmm.ArgRep ( slowCallPattern, toArgRepOrV, argRepString )
import GHC.StgToCmm.Closure
import GHC.StgToCmm.Config
import {-# SOURCE #-} GHC.StgToCmm.Foreign ( emitPrimCall )
@@ -615,7 +615,7 @@ tickySlowCall lf_info args = do
tickySlowCallPat :: [StgArg] -> FCode ()
tickySlowCallPat args = ifTicky $ do
platform <- profilePlatform <$> getProfile
- let argReps = map (toArgRep platform . stgArgRep1) args
+ let argReps = map (toArgRepOrV platform . stgArgRep1) args
(_, n_matched) = slowCallPattern argReps
if n_matched > 0 && args `lengthIs` n_matched
then bumpTickyLbl $ mkRtsSlowFastTickyCtrLabel $ concatMap (map Data.Char.toLower . argRepString) argReps
diff --git a/compiler/GHC/StgToJS/Arg.hs b/compiler/GHC/StgToJS/Arg.hs
index 2259935d40e702dfa89981c37f1cbd429d2dc74b..9c64a3c32dfc848dedc5adb624ab8f03d7faf140 100644
--- a/compiler/GHC/StgToJS/Arg.hs
+++ b/compiler/GHC/StgToJS/Arg.hs
@@ -120,7 +120,7 @@ genStaticArg a = case a of
Nothing -> reg
Just expr -> unfloated expr
where
- r = primRepToJSRep $ stgArgRep1 a
+ r = primOrVoidRepToJSRep $ stgArgRep1 a
reg
| isVoid r =
return []
@@ -162,7 +162,7 @@ genArg a = case a of
where
-- if our argument is a joinid, it can be an unboxed tuple
r :: HasDebugCallStack => JSRep
- r = primRepToJSRep $ stgArgRep1 a
+ r = primOrVoidRepToJSRep $ stgArgRep1 a
unfloated :: HasDebugCallStack => CgStgExpr -> G [JStgExpr]
unfloated = \case
diff --git a/compiler/GHC/StgToJS/Expr.hs b/compiler/GHC/StgToJS/Expr.hs
index c379295d93f80d62cfd422b30ae55c05324b909d..6c46421c17e842cf216f4eb00f09104f92096b8c 100644
--- a/compiler/GHC/StgToJS/Expr.hs
+++ b/compiler/GHC/StgToJS/Expr.hs
@@ -351,7 +351,7 @@ genBody ctx startReg args e typ = do
--
-- Se we're left to use the applied arguments to peel the type (unwrapped) one
-- arg at a time. But passed args are args after unarisation so we need to
--- unarise every argument type that we peel (using typePrimRepArgs) to get the
+-- unarise every argument type that we peel (using typePrimRep) to get the
-- number of passed args consumed by each type arg.
--
-- In case of failure to determine the type, we default to LiftedRep as it's
diff --git a/compiler/GHC/StgToJS/Utils.hs b/compiler/GHC/StgToJS/Utils.hs
index 73500c584aaa12bd5b3f2398a23b263965145e70..411450e36a5a03d840462feb479fd49b081e9105 100644
--- a/compiler/GHC/StgToJS/Utils.hs
+++ b/compiler/GHC/StgToJS/Utils.hs
@@ -20,6 +20,7 @@ module GHC.StgToJS.Utils
, typeJSRep
, unaryTypeJSRep
, primRepToJSRep
+ , primOrVoidRepToJSRep
, stackSlotType
, primRepSize
, mkArityTag
@@ -196,10 +197,9 @@ typeJSRep t = map primRepToJSRep (typePrimRep t)
-- only use if you know it's not an unboxed tuple
unaryTypeJSRep :: HasDebugCallStack => UnaryType -> JSRep
-unaryTypeJSRep ut = primRepToJSRep (typePrimRep1 ut)
+unaryTypeJSRep ut = primOrVoidRepToJSRep (typePrimRep1 ut)
primRepToJSRep :: HasDebugCallStack => PrimRep -> JSRep
-primRepToJSRep VoidRep = VoidV
primRepToJSRep (BoxedRep _) = PtrV
primRepToJSRep IntRep = IntV
primRepToJSRep Int8Rep = IntV
@@ -216,6 +216,10 @@ primRepToJSRep FloatRep = DoubleV
primRepToJSRep DoubleRep = DoubleV
primRepToJSRep (VecRep{}) = error "primRepToJSRep: vector types are unsupported"
+primOrVoidRepToJSRep :: HasDebugCallStack => PrimOrVoidRep -> JSRep
+primOrVoidRepToJSRep VoidRep = VoidV
+primOrVoidRepToJSRep (NVRep rep) = primRepToJSRep rep
+
dataConType :: DataCon -> Type
dataConType dc = idType (dataConWrapId dc)
diff --git a/compiler/GHC/Types/Id/Make.hs b/compiler/GHC/Types/Id/Make.hs
index d2cb4dea6c5ffab3207f4ef3eb4a19d85abf73f0..6969bfb091d9561fd0eea1de0325fb89a219f16f 100644
--- a/compiler/GHC/Types/Id/Make.hs
+++ b/compiler/GHC/Types/Id/Make.hs
@@ -1525,7 +1525,6 @@ shouldUnpackArgTy bang_opts prag fam_envs arg_ty
-- and tells us if they can fit into 8 bytes. See Note [Unpack one-wide fields]
is_small_rep =
let -- Neccesary to look through unboxed tuples.
- -- Note typePrimRep never returns VoidRep
prim_reps = concatMap (typePrimRep . scaledThing . fst) $ rep_tys
-- And then get the actual size of the unpacked constructor.
rep_size = sum $ map primRepSizeW64_B prim_reps
diff --git a/compiler/GHC/Types/RepType.hs b/compiler/GHC/Types/RepType.hs
index 7a31b650d57a8e7ac587a1c6dd080c90534c39fd..9b82fed1d45605d3d520fe9fe4c9d5746ac6e212 100644
--- a/compiler/GHC/Types/RepType.hs
+++ b/compiler/GHC/Types/RepType.hs
@@ -11,11 +11,11 @@ module GHC.Types.RepType
isZeroBitTy,
-- * Type representation for the code generator
- typePrimRep, typePrimRep1,
- runtimeRepPrimRep, typePrimRepArgs,
+ typePrimRep, typePrimRep1, typePrimRepU,
+ runtimeRepPrimRep,
PrimRep(..), primRepToRuntimeRep, primRepToType,
countFunRepArgs, countConRepArgs, dataConRuntimeRepStrictness,
- tyConPrimRep, tyConPrimRep1,
+ tyConPrimRep,
runtimeRepPrimRep_maybe, kindPrimRep_maybe, typePrimRep_maybe,
-- * Unboxed sum representation type
@@ -38,7 +38,7 @@ import GHC.Core.TyCo.Rep
import GHC.Core.Type
import {-# SOURCE #-} GHC.Builtin.Types ( anyTypeOfKind
, vecRepDataConTyCon
- , liftedRepTy, unliftedRepTy, zeroBitRepTy
+ , liftedRepTy, unliftedRepTy
, intRepDataConTy
, int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy
, wordRepDataConTy
@@ -80,15 +80,6 @@ isNvUnaryRep :: [PrimRep] -> Bool
isNvUnaryRep [_] = True
isNvUnaryRep _ = False
--- INVARIANT: the result list is never empty.
-typePrimRepArgs :: HasDebugCallStack => Type -> NonEmpty PrimRep
-typePrimRepArgs ty
- = case reps of
- [] -> VoidRep :| []
- (x:xs) -> x :| xs
- where
- reps = typePrimRep ty
-
-- | Gets rid of the stuff that prevents us from understanding the
-- runtime representation of a type. Including:
-- 1. Casts
@@ -129,7 +120,10 @@ countFunRepArgs 0 _
= 0
countFunRepArgs n ty
| FunTy _ _ arg res <- unwrapType ty
- = length (typePrimRepArgs arg) + countFunRepArgs (n - 1) res
+ = (length (typePrimRep arg) `max` 1)
+ + countFunRepArgs (n - 1) res
+ -- If typePrimRep returns [] that means a void arg,
+ -- and we count 1 for that
| otherwise
= pprPanic "countFunRepArgs: arity greater than type can handle" (ppr (n, ty, typePrimRep ty))
@@ -308,7 +302,6 @@ repSlotTy reps = case reps of
_ -> pprPanic "repSlotTy" (ppr reps)
primRepSlot :: PrimRep -> SlotTy
-primRepSlot VoidRep = pprPanic "primRepSlot" (text "No slot for VoidRep")
primRepSlot (BoxedRep mlev) = case mlev of
Nothing -> panic "primRepSlot: levity polymorphic BoxedRep"
Just Lifted -> PtrLiftedSlot
@@ -391,8 +384,7 @@ needed and how many bits are required. The data type GHC.Core.TyCon.PrimRep
enumerates all the possibilities.
data PrimRep
- = VoidRep -- See Note [VoidRep]
- | LiftedRep -- ^ Lifted pointer
+ = LiftedRep -- ^ Lifted pointer
| UnliftedRep -- ^ Unlifted pointer
| Int8Rep -- ^ Signed, 8-bit value
| Int16Rep -- ^ Signed, 16-bit value
@@ -441,18 +433,37 @@ See also Note [Getting from RuntimeRep to PrimRep] and Note [VoidRep].
Note [VoidRep]
~~~~~~~~~~~~~~
-PrimRep contains a constructor VoidRep, while RuntimeRep does
-not. Yet representations are often characterised by a list of PrimReps,
-where a void would be denoted as []. (See also Note [RuntimeRep and PrimRep].)
+PrimRep is used to denote one primitive representation.
+Because of unboxed tuples and sums, the representation of a value
+in general is a list of PrimReps. (See also Note [RuntimeRep and PrimRep].)
+
+For example:
+ typePrimRep Int# = [IntRep]
+ typePrimRep Int = [LiftedRep]
+ typePrimRep (# Int#, Int# #) = [IntRep,IntRep]
+ typePrimRep (# #) = []
+ typePrimRep (State# s) = []
+
+After the unariser, all identifiers have at most one PrimRep
+(that is, the [PrimRep] for each identifier is empty or a singleton list).
+More precisely: typePrimRep1 will succeed (not crash) on every binder
+and argument type.
+(See Note [Post-unarisation invariants] in GHC.Stg.Unarise.)
-However, after the unariser, all identifiers have exactly one PrimRep, but
-void arguments still exist. Thus, PrimRep includes VoidRep to describe these
-binders. Perhaps post-unariser representations (which need VoidRep) should be
-a different type than pre-unariser representations (which use a list and do
-not need VoidRep), but we have what we have.
+Thus, we have
-RuntimeRep instead uses TupleRep '[] to denote a void argument. When
-converting a TupleRep '[] into a list of PrimReps, we get an empty list.
+1. typePrimRep :: Type -> [PrimRep]
+ which returns the list
+
+2. typePrimRepU :: Type -> PrimRep
+ which asserts that the type has exactly one PrimRep and returns it
+
+3. typePrimRep1 :: Type -> PrimOrVoidRep
+ data PrimOrVoidRep = VoidRep | NVRep PrimRep
+ which asserts that the type either has exactly one PrimRep or is void.
+
+Likewise, we have idPrimRepU and idPrimRep1, stgArgRepU and stgArgRep1,
+which have analogous preconditions.
Note [Getting from RuntimeRep to PrimRep]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -546,17 +557,22 @@ typePrimRep ty = kindPrimRep (text "typePrimRep" <+>
typePrimRep_maybe :: Type -> Maybe [PrimRep]
typePrimRep_maybe ty = kindPrimRep_maybe (typeKind ty)
--- | Like 'typePrimRep', but assumes that there is precisely one 'PrimRep' output;
+-- | Like 'typePrimRep', but assumes that there is at most one 'PrimRep' output;
-- an empty list of PrimReps becomes a VoidRep.
-- This assumption holds after unarise, see Note [Post-unarisation invariants].
-- Before unarise it may or may not hold.
-- See also Note [RuntimeRep and PrimRep] and Note [VoidRep]
-typePrimRep1 :: HasDebugCallStack => UnaryType -> PrimRep
+typePrimRep1 :: HasDebugCallStack => UnaryType -> PrimOrVoidRep
typePrimRep1 ty = case typePrimRep ty of
[] -> VoidRep
- [rep] -> rep
+ [rep] -> NVRep rep
_ -> pprPanic "typePrimRep1" (ppr ty $$ ppr (typePrimRep ty))
+typePrimRepU :: HasDebugCallStack => NvUnaryType -> PrimRep
+typePrimRepU ty = case typePrimRep ty of
+ [rep] -> rep
+ _ -> pprPanic "typePrimRepU" (ppr ty $$ ppr (typePrimRep ty))
+
-- | Find the runtime representation of a 'TyCon'. Defined here to
-- avoid module loops. Returns a list of the register shapes necessary.
-- See also Note [Getting from RuntimeRep to PrimRep]
@@ -567,15 +583,6 @@ tyConPrimRep tc
where
res_kind = tyConResKind tc
--- | Like 'tyConPrimRep', but assumed that there is precisely zero or
--- one 'PrimRep' output
--- See also Note [Getting from RuntimeRep to PrimRep] and Note [VoidRep]
-tyConPrimRep1 :: HasDebugCallStack => TyCon -> PrimRep
-tyConPrimRep1 tc = case tyConPrimRep tc of
- [] -> VoidRep
- [rep] -> rep
- _ -> pprPanic "tyConPrimRep1" (ppr tc $$ ppr (tyConPrimRep tc))
-
-- | Take a kind (of shape @TYPE rr@) and produce the 'PrimRep's
-- of values of types of this kind.
-- See also Note [Getting from RuntimeRep to PrimRep]
@@ -603,8 +610,6 @@ kindPrimRep_maybe ki
-- | Take a type of kind RuntimeRep and extract the list of 'PrimRep' that
-- it encodes. See also Note [Getting from RuntimeRep to PrimRep].
-- The @[PrimRep]@ is the final runtime representation /after/ unarisation.
---
--- The result does not contain any VoidRep.
runtimeRepPrimRep :: HasDebugCallStack => SDoc -> RuntimeRepType -> [PrimRep]
runtimeRepPrimRep doc rr_ty
| Just rr_ty' <- coreView rr_ty
@@ -617,8 +622,7 @@ runtimeRepPrimRep doc rr_ty
-- | Take a type of kind RuntimeRep and extract the list of 'PrimRep' that
-- it encodes. See also Note [Getting from RuntimeRep to PrimRep].
--- The @[PrimRep]@ is the final runtime representation /after/ unarisation
--- and does not contain VoidRep.
+-- The @[PrimRep]@ is the final runtime representation /after/ unarisation.
--
-- Returns @Nothing@ if rep can't be determined. Eg. levity polymorphic types.
runtimeRepPrimRep_maybe :: Type -> Maybe [PrimRep]
@@ -634,7 +638,6 @@ runtimeRepPrimRep_maybe rr_ty
-- | Convert a 'PrimRep' to a 'Type' of kind RuntimeRep
primRepToRuntimeRep :: PrimRep -> RuntimeRepType
primRepToRuntimeRep rep = case rep of
- VoidRep -> zeroBitRepTy
BoxedRep mlev -> case mlev of
Nothing -> panic "primRepToRuntimeRep: levity polymorphic BoxedRep"
Just Lifted -> liftedRepTy