summaryrefslogtreecommitdiff
path: root/compiler/GHC/Core
diff options
context:
space:
mode:
authorSebastian Graf <sebastian.graf@kit.edu>2021-03-01 21:40:22 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-03-26 23:02:15 -0400
commit57d21e6a522f5522ba238675e74f510ab8e5d300 (patch)
tree4132fca9afc4c2ee8ca0d23266919c77fec27201 /compiler/GHC/Core
parent5741caeb0454c1bee9ca865ce6c3dfdd980ecf3e (diff)
downloadhaskell-57d21e6a522f5522ba238675e74f510ab8e5d300.tar.gz
Rubbish literals for all representations (#18983)
This patch cleans up the complexity around WW's `mk_absent_let` by broadening the scope of `LitRubbish`. Rubbish literals now store the `PrimRep` they represent and are ultimately lowered in Cmm. This in turn allows absent literals of `VecRep` or `VoidRep`. The latter allows absent literals for unlifted coercions, as requested in #18983. I took the liberty to rewrite and clean up `Note [Absent fillers]` and `Note [Rubbish values]` to account for the new implementation and to make them more orthogonal in their description. I didn't add a new regression test, as `T18982` already contains the test in the ticket and its test output changes as expected. Fixes #18983.
Diffstat (limited to 'compiler/GHC/Core')
-rw-r--r--compiler/GHC/Core/Make.hs2
-rw-r--r--compiler/GHC/Core/Opt/WorkWrap/Utils.hs222
-rw-r--r--compiler/GHC/Core/TyCon.hs86
-rw-r--r--compiler/GHC/Core/Utils.hs9
4 files changed, 177 insertions, 142 deletions
diff --git a/compiler/GHC/Core/Make.hs b/compiler/GHC/Core/Make.hs
index 42a1b78c0c..60ae13bee7 100644
--- a/compiler/GHC/Core/Make.hs
+++ b/compiler/GHC/Core/Make.hs
@@ -1024,7 +1024,7 @@ aBSENT_ERROR_ID
where
absent_ty = mkSpecForAllTys [alphaTyVar] (mkVisFunTyMany addrPrimTy alphaTy)
-- Not runtime-rep polymorphic. aBSENT_ERROR_ID is only used for
- -- lifted-type things; see Note [Absent errors] in GHC.Core.Opt.WorkWrap.Utils
+ -- lifted-type things; see Note [Absent fillers] in GHC.Core.Opt.WorkWrap.Utils
arity_info = vanillaIdInfo `setArityInfo` 1
-- NB: no bottoming strictness info, unlike other error-ids.
-- See Note [aBSENT_ERROR_ID]
diff --git a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
index 5223e66817..f51e716c38 100644
--- a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
+++ b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
@@ -20,7 +20,7 @@ import GHC.Prelude
import GHC.Core
import GHC.Core.Utils ( exprType, mkCast, mkDefaultCase, mkSingleAltCase
- , dataConRepFSInstPat )
+ , bindNonRec, dataConRepFSInstPat )
import GHC.Types.Id
import GHC.Types.Id.Info ( JoinArity )
import GHC.Core.DataCon
@@ -29,14 +29,14 @@ import GHC.Types.Cpr
import GHC.Core.Make ( mkAbsentErrorApp, mkCoreUbxTup
, mkCoreApp, mkCoreLet )
import GHC.Types.Id.Make ( voidArgId, voidPrimId )
-import GHC.Builtin.Types ( tupleDataCon, unboxedUnitTy )
-import GHC.Types.Literal ( absentLiteralOf, rubbishLit )
+import GHC.Builtin.Types ( tupleDataCon )
+import GHC.Types.Literal ( mkLitRubbish )
import GHC.Types.Var.Env ( mkInScopeSet )
import GHC.Types.Var.Set ( VarSet )
import GHC.Core.Type
import GHC.Core.Multiplicity
import GHC.Core.Predicate ( isClassPred )
-import GHC.Types.RepType ( isVoidTy, typePrimRep )
+import GHC.Types.RepType ( isVoidTy, typeMonoPrimRep_maybe )
import GHC.Core.Coercion
import GHC.Core.FamInstEnv
import GHC.Types.Basic ( Boxity(..) )
@@ -895,9 +895,9 @@ mkWWstr_one dflags fam_envs has_inlineable_prag arg
= return (False, [arg], nop_fn, nop_fn)
| isAbsDmd dmd
- , Just work_fn <- mk_absent_let dflags fam_envs arg dmd
- -- Absent case. We can't always handle absence for arbitrary
- -- unlifted types, so we need to choose just the cases we can
+ , Just work_fn <- mk_absent_let dflags arg dmd
+ -- Absent case. We can't always handle absence for rep-polymorphic
+ -- types, so we need to choose just the cases we can
-- (that's what mk_absent_let does)
= return (True, [], nop_fn, work_fn)
@@ -1281,70 +1281,74 @@ part of the function (post transformation) anyway.
* *
************************************************************************
-Note [Absent errors]
-~~~~~~~~~~~~~~~~~~~~
+Note [Absent fillers]
+~~~~~~~~~~~~~~~~~~~~~
Consider
- data T = MkT [Int] [Int] ![Int]
- f :: T -> Int# -> blah
- f ps w = case ps of MkT xs _ _ -> <body mentioning xs>
-Then f gets a strictness sig of <S(L,A,A)><A>. We make worker $wf thus:
-
-$wf :: [Int] -> blah
-$wf xs = case ps of MkT xs _ _ -> <body mentioning xs>
- where
- ys = absentError "ys :: [Int]"
- zs = LitRubbish True
- ps = MkT xs ys zs
- w = 0#
-
-We make a let-binding for Absent arguments, such as ys and w, that are not even
-passed to the worker. They should, of course, never be used. We distinguish four
-cases:
-
-1. Ordinary boxed, lifted arguments, like 'ys' We make a new binding for Ids
- that are marked absent, thus
- let ys = absentError "ys :: [Int]"
- The idea is that this binding will never be used; but if it
- buggily is used we'll get a runtime error message.
-
-2. Boxed, lifted types, with a strict demand, like 'zs'. You may ask: how the
- demand be both absent and strict? That's exactly what happens for 'zs': it
- is not used, so its demand is Absent, but then during w/w, in
- addDataConStrictness, we strictify the demand. So it gets cardinality C_10,
- the empty interval.
-
- We don't want to use an error-thunk for 'zs' because MkT's third argument has
- a bang, and hence should be always evaluated. This turned out to be
- important when fixing #16970, which establishes the invariant that strict
- constructor arguments are always evaluated. So we use LitRubbish instead
- of an error thunk -- see #19133.
-
- These first two cases are distinguished by isStrictDmd in lifted_rhs.
-
-3. Unboxed types, like 'w', with a type like Float#, Int#. Coping with absence
- for unboxed types is important; see, for example, #4306 and #15627. We
- simply find a suitable literal, using Literal.absentLiteralOf. We don't have
- literals for every primitive type, so the function is partial.
-
-4. Boxed, unlifted types, like (Array# t). We can't use absentError because
- unlifted bindings ares strict. So we use LitRubbish, which we need to apply
- to the required type.
-
-Case (2) and (4) crucially use LitRubbish as the placeholder: see Note [Rubbish
-literals] in GHC.Types.Literal. We could do that in case (1) as well, but we
-get slightly better self-checking with an error thunk.
-Suppose we use LitRubbish and absence analysis is Wrong, so that the "absent"
-value is used after all. Then in case (2) we could get a seg-fault, because we
-may have replaced, say, a [Either Int Bool] by (), and that will fail if we do
-case analysis on it. Similarly with boxed unlifted types, case (4).
-
-In case (3), if absence analysis is wrong we could conceivably get an exception,
-from a divide-by-zero with the absent value. But it's very unlikely.
+ data T = MkT [Int] [Int] ![Int] -- NB: last field is strict
+ f :: T -> Int# -> blah
+ f ps w = case ps of MkT xs ys zs -> <body mentioning xs>
-Only in case (1) can we guarantee a civilised runtime error. Not much we can do
-about this; we really rely on absence analysis to be correct.
+Then f gets a strictness sig of <S(L,A,A)><A>. We make a worker $wf thus:
+ $wf :: [Int] -> blah
+ $wf xs = case ps of MkT xs _ _ -> <body mentioning xs>
+ where
+ ys = absentError "ys :: [Int]"
+ zs = RUBBISH[LiftedRep] @[Int]
+ ps = MkT xs ys zs
+ w = RUBBISH[IntRep] @Int#
+
+The absent arguments 'ys', 'zs' and 'w' aren't even passed to the worker.
+And neither should they! They are never used, their value is irrelevant (hence
+they are *dead code*) and they are probably discarded after the next run of the
+Simplifier (when they are in fact *unreachable code*). Yet, we have to come up
+with "filler" values that we bind the absent arg Ids to.
+
+That is exactly what Note [Rubbish values] are for: A convenient way to
+conjure filler values at any type (and any representation or levity!).
+
+Needless to say, there are some wrinkles:
+
+ 1. In case we have a absent, /lazy/, and /lifted/ arg, we use an error-thunk
+ instead. If absence analysis was wrong (e.g., #11126) and the binding
+ in fact is used, then we get a nice panic message instead of undefined
+ runtime behavior (See Modes of failure from Note [Rubbish values]).
+
+ Obviously, we can't use an error-thunk if the value is of unlifted rep
+ (like 'Int#' or 'MutVar#'), because we'd immediately evaluate the panic.
+
+ 2. We also mustn't put an error-thunk (that fills in for an absent value of
+ lifted rep) in a strict field, because #16970 establishes the invariant
+ that strict fields are always evaluated, by (re-)evaluating what is put in
+ a strict field. That's the reason why 'zs' binds a rubbish literal instead
+ of an error-thunk, see #19133.
+
+ How do we detect when we are about to put an error-thunk in a strict field?
+ Ideally, we'd just look at the 'StrictnessMark' of the DataCon's field, but
+ it's quite nasty to thread the marks though 'mkWWstr' and 'mkWWstr_one'.
+ So we rather look out for a necessary condition for strict fields:
+ Note [Add demands for strict constructors] makes it so that the demand on
+ 'zs' is absent and /strict/: It will get cardinality 'C_10', the empty
+ interval, rather than 'C_00'. Hence the 'isStrictDmd' check: It guarantees
+ we never fill in an error-thunk for an absent strict field.
+ But that also means we emit a rubbish lit for other args that have
+ cardinality 'C_10' (say, the arg to a bottoming function) where we could've
+ used an error-thunk, but that's a small price to pay for simplicity.
+
+ 3. We can only emit a RubbishLit if the arg's type @arg_ty@ is mono-rep, e.g.
+ of the form @TYPE rep@ where @rep@ is not (and doesn't contain) a variable.
+ Why? Because if we don't know its representation (e.g. size in memory,
+ register class), we don't know what or how much rubbish to emit in codegen.
+ 'typeMonoPrimRep_maybe' returns 'Nothing' in this case and we simply fall
+ back to passing the original parameter to the worker.
+
+ Note that currently this case should not occur, because binders always
+ have to be representation monomorphic. But in the future, we might allow
+ levity polymorphism, e.g. a polymorphic levity variable in 'BoxedRep'.
+
+While (1) and (2) are simply an optimisation in terms of compiler debugging
+experience, (3) should be irrelevant in most programs, if not all.
Historical note: I did try the experiment of using an error thunk for unlifted
things too, relying on the simplifier to drop it as dead code. But this is
@@ -1368,66 +1372,46 @@ fragile
--
-- If @mk_absent_let _ id == Just wrap@, then @wrap e@ will wrap a let binding
-- for @id@ with that RHS around @e@. Otherwise, there could no suitable RHS be
--- found (currently only happens for bindings of 'VecRep' representation).
-mk_absent_let :: DynFlags -> FamInstEnvs -> Id -> Demand -> Maybe (CoreExpr -> CoreExpr)
-mk_absent_let dflags fam_envs arg dmd
-
- -- The lifted case: Bind 'absentError'
- -- See Note [Absent errors]
- | not (isUnliftedType arg_ty)
- = Just (Let (NonRec lifted_arg lifted_rhs))
- -- The 'UnliftedRep' (because polymorphic) case: Bind @__RUBBISH \@arg_ty@
- -- See Note [Absent errors]
-
- | [UnliftedRep] <- typePrimRep arg_ty
- = Just (Let (NonRec arg unlifted_rhs))
-
- -- The monomorphic unlifted cases: Bind to some literal, if possible
- -- See Note [Absent errors]
- | Just tc <- tyConAppTyCon_maybe nty
- , Just lit <- absentLiteralOf tc
- = Just (Let (NonRec arg (Lit lit `mkCast` mkSymCo co)))
-
- | nty `eqType` unboxedUnitTy
- = Just (Let (NonRec arg (Var voidPrimId `mkCast` mkSymCo co)))
-
- | otherwise
+-- found.
+mk_absent_let :: DynFlags -> Id -> Demand -> Maybe (CoreExpr -> CoreExpr)
+mk_absent_let dflags arg dmd
+ -- The lifted case: Bind 'absentError' for a nice panic message if we are
+ -- wrong (like we were in #11126). See (1) in Note [Absent fillers]
+ | Just [LiftedRep] <- mb_mono_prim_reps
+ , not (isStrictDmd dmd) -- See (2) in Note [Absent fillers]
+ = Just (Let (NonRec arg panic_rhs))
+
+ -- The default case for mono rep: Bind @RUBBISH[prim_reps] \@arg_ty@
+ -- See Note [Absent fillers], the main part
+ | Just prim_reps <- mb_mono_prim_reps
+ = Just (bindNonRec arg (mkTyApps (Lit (mkLitRubbish prim_reps)) [arg_ty]))
+
+ -- Catch all: Either @arg_ty@ wasn't of form @TYPE rep@ or @rep@ wasn't mono rep.
+ -- See (3) in Note [Absent fillers]
+ | Nothing <- mb_mono_prim_reps
= WARN( True, text "No absent value for" <+> ppr arg_ty )
- Nothing -- Can happen for 'State#' and things of 'VecRep'
+ Nothing
where
- lifted_arg = arg `setIdStrictness` botSig `setIdCprInfo` mkCprSig 0 botCpr
- -- Note in strictness signature that this is bottoming
- -- (for the sake of the "empty case scrutinee not known to
- -- diverge for sure lint" warning)
-
- lifted_rhs | isStrictDmd dmd = mkTyApps (Lit (rubbishLit True)) [arg_ty]
- | otherwise = mkAbsentErrorApp arg_ty msg
- unlifted_rhs = mkTyApps (Lit (rubbishLit False)) [arg_ty]
-
- arg_ty = idType arg
-
- -- Normalise the type to have best chance of finding an absent literal
- -- e.g. (#17852) data unlifted N = MkN Int#
- -- f :: N -> a -> a
- -- f _ x = x
- (co, nty) = topNormaliseType_maybe fam_envs arg_ty
- `orElse` (mkRepReflCo arg_ty, arg_ty)
-
- msg = showSDoc (gopt_set dflags Opt_SuppressUniques)
- (vcat
- [ text "Arg:" <+> ppr arg
- , text "Type:" <+> ppr arg_ty
- , file_msg
- ])
- file_msg = case outputFile dflags of
- Nothing -> empty
- Just f -> text "In output file " <+> quotes (text f)
+ arg_ty = idType arg
+ mb_mono_prim_reps = typeMonoPrimRep_maybe arg_ty
+
+ panic_rhs = mkAbsentErrorApp arg_ty msg
+
+ msg = showSDoc (gopt_set dflags Opt_SuppressUniques)
+ (vcat
+ [ text "Arg:" <+> ppr arg
+ , text "Type:" <+> ppr arg_ty
+ , file_msg
+ ])
-- We need to suppress uniques here because otherwise they'd
-- end up in the generated code as strings. This is bad for
-- determinism, because with different uniques the strings
-- will have different lengths and hence different costs for
-- the inliner leading to different inlining.
-- See also Note [Unique Determinism] in GHC.Types.Unique
+ file_msg = case outputFile dflags of
+ Nothing -> empty
+ Just f -> text "In output file " <+> quotes (text f)
ww_prefix :: FastString
ww_prefix = fsLit "ww"
diff --git a/compiler/GHC/Core/TyCon.hs b/compiler/GHC/Core/TyCon.hs
index 87b7336a76..a460116c3b 100644
--- a/compiler/GHC/Core/TyCon.hs
+++ b/compiler/GHC/Core/TyCon.hs
@@ -1,6 +1,7 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE DeriveDataTypeable #-}
{-
(c) The University of Glasgow 2006
@@ -121,6 +122,7 @@ module GHC.Core.TyCon(
-- * Primitive representations of Types
PrimRep(..), PrimElemRep(..),
+ primElemRepToPrimRep,
isVoidRep, isGcPtrRep,
primRepSizeB,
primElemRepSizeB,
@@ -1480,7 +1482,7 @@ data PrimRep
| FloatRep
| DoubleRep
| VecRep Int PrimElemRep -- ^ A vector
- deriving( Eq, Show )
+ deriving( Data.Data, Eq, Ord, Show )
data PrimElemRep
= Int8ElemRep
@@ -1493,7 +1495,7 @@ data PrimElemRep
| Word64ElemRep
| FloatElemRep
| DoubleElemRep
- deriving( Eq, Show )
+ deriving( Data.Data, Eq, Ord, Show, Enum )
instance Outputable PrimRep where
ppr r = text (show r)
@@ -1501,6 +1503,50 @@ instance Outputable PrimRep where
instance Outputable PrimElemRep where
ppr r = text (show r)
+instance Binary PrimRep where
+ put_ bh VoidRep = putByte bh 0
+ put_ bh LiftedRep = putByte bh 1
+ put_ bh UnliftedRep = 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 LiftedRep
+ 2 -> pure UnliftedRep
+ 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
@@ -1552,19 +1598,22 @@ primRepSizeB platform = \case
LiftedRep -> platformWordSizeInBytes platform
UnliftedRep -> platformWordSizeInBytes platform
VoidRep -> 0
- (VecRep len rep) -> len * primElemRepSizeB rep
-
-primElemRepSizeB :: PrimElemRep -> Int
-primElemRepSizeB Int8ElemRep = 1
-primElemRepSizeB Int16ElemRep = 2
-primElemRepSizeB Int32ElemRep = 4
-primElemRepSizeB Int64ElemRep = 8
-primElemRepSizeB Word8ElemRep = 1
-primElemRepSizeB Word16ElemRep = 2
-primElemRepSizeB Word32ElemRep = 4
-primElemRepSizeB Word64ElemRep = 8
-primElemRepSizeB FloatElemRep = 4
-primElemRepSizeB DoubleElemRep = 8
+ (VecRep len rep) -> len * primElemRepSizeB platform rep
+
+primElemRepSizeB :: Platform -> PrimElemRep -> Int
+primElemRepSizeB platform = primRepSizeB platform . primElemRepToPrimRep
+
+primElemRepToPrimRep :: PrimElemRep -> PrimRep
+primElemRepToPrimRep Int8ElemRep = Int8Rep
+primElemRepToPrimRep Int16ElemRep = Int16Rep
+primElemRepToPrimRep Int32ElemRep = Int32Rep
+primElemRepToPrimRep Int64ElemRep = Int64Rep
+primElemRepToPrimRep Word8ElemRep = Word8Rep
+primElemRepToPrimRep Word16ElemRep = Word16Rep
+primElemRepToPrimRep Word32ElemRep = Word32Rep
+primElemRepToPrimRep Word64ElemRep = Word64Rep
+primElemRepToPrimRep FloatElemRep = FloatRep
+primElemRepToPrimRep DoubleElemRep = DoubleRep
-- | Return if Rep stands for floating type,
-- returns Nothing for vector types.
@@ -1574,7 +1623,6 @@ primRepIsFloat DoubleRep = Just True
primRepIsFloat (VecRep _ _) = Nothing
primRepIsFloat _ = Just False
-
{-
************************************************************************
* *
diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs
index 3f228f747d..6b779ef1aa 100644
--- a/compiler/GHC/Core/Utils.hs
+++ b/compiler/GHC/Core/Utils.hs
@@ -1609,11 +1609,14 @@ expr_ok primop_ok (Case scrut bndr _ alts)
expr_ok primop_ok other_expr
| (expr, args) <- collectArgs other_expr
= case stripTicksTopE (not . tickishCounts) expr of
- Var f -> app_ok primop_ok f args
+ Var f -> app_ok primop_ok f args
-- 'LitRubbish' is the only literal that can occur in the head of an
-- application and will not be matched by the above case (Var /= Lit).
- Lit lit -> ASSERT( isRubbishLit lit ) True
- _ -> False
+ Lit LitRubbish{} -> True
+#if defined(DEBUG)
+ Lit _ -> pprPanic "Non-rubbish lit in app head" (ppr other_expr)
+#endif
+ _ -> False
-----------------------------
app_ok :: (PrimOp -> Bool) -> Id -> [CoreExpr] -> Bool
View Lorry Controller Status