diff options
author | Sebastian Graf <sebastian.graf@kit.edu> | 2018-10-14 20:32:40 +0200 |
---|---|---|
committer | Krzysztof Gogolewski <krz.gogolewski@gmail.com> | 2018-10-14 20:32:41 +0200 |
commit | 448b77b93b369745e9bfbc8b46a5b87bb73dd379 (patch) | |
tree | 8fd12e8698217f022651fe84a3ae9bf3d3e546a9 /compiler/basicTypes | |
parent | 68a747c702d2432cc90d2a79a6aba0e67ac3e2c0 (diff) | |
download | haskell-448b77b93b369745e9bfbc8b46a5b87bb73dd379.tar.gz |
Add RubbishLit for absent bindings of UnliftedRep
Summary:
Trac #9279 reminded us that the worker wrapper transformation copes
really badly with absent unlifted boxed bindings.
As `Note [Absent errors]` in WwLib.hs points out, we can't just use
`absentError` for unlifted bindings because there is no bottom to hide
the error in.
So instead, we synthesise a new `RubbishLit` of type
`forall (a :: TYPE 'UnliftedRep). a`, which code-gen may subsitute for
any boxed value. We choose `()`, so that there is a good chance that
the program crashes instead instead of leading to corrupt data, should
absence analysis have been too optimistic (#11126).
Reviewers: simonpj, hvr, goldfire, bgamari, simonmar
Reviewed By: simonpj
Subscribers: osa1, rwbarton, carter
GHC Trac Issues: #15627, #9279, #4306, #11126
Differential Revision: https://phabricator.haskell.org/D5153
Diffstat (limited to 'compiler/basicTypes')
-rw-r--r-- | compiler/basicTypes/Literal.hs | 87 |
1 files changed, 85 insertions, 2 deletions
diff --git a/compiler/basicTypes/Literal.hs b/compiler/basicTypes/Literal.hs index 21f4a92290..0bf3897da3 100644 --- a/compiler/basicTypes/Literal.hs +++ b/compiler/basicTypes/Literal.hs @@ -44,7 +44,7 @@ module Literal , narrow8WordLit, narrow16WordLit, narrow32WordLit , char2IntLit, int2CharLit , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit - , nullAddrLit, float2DoubleLit, double2FloatLit + , nullAddrLit, rubbishLit, float2DoubleLit, double2FloatLit ) where #include "HsVersions.h" @@ -96,6 +96,9 @@ import Numeric ( fromRat ) -- -- * The literal derived from the label mentioned in a \"foreign label\" -- declaration ('MachLabel') +-- +-- * A 'RubbishLit' to be used in place of values of 'UnliftedRep' +-- (i.e. 'MutVar#') when the the value is never used. data Literal = ------------------ -- First the primitive guys @@ -114,6 +117,12 @@ data Literal -- that can be represented as a Literal. Create -- with 'nullAddrLit' + | RubbishLit -- ^ A nonsense value, used when an unlifted + -- binding is absent and has type + -- @forall (a :: 'TYPE' 'UnliftedRep'). a@. + -- May be lowered by code-gen to any possible + -- value. Also see Note [RubbishLit] + | MachFloat Rational -- ^ @Float#@. Create with 'mkMachFloat' | MachDouble Rational -- ^ @Double#@. Create with 'mkMachDouble' @@ -195,6 +204,7 @@ instance Binary Literal where = do putByte bh 6 put_ bh nt put_ bh i + put_ bh (RubbishLit) = do putByte bh 7 get bh = do h <- getByte bh case h of @@ -217,7 +227,7 @@ instance Binary Literal where mb <- get bh fod <- get bh return (MachLabel aj mb fod) - _ -> do + 6 -> do nt <- get bh i <- get bh let t = case nt of @@ -232,6 +242,8 @@ instance Binary Literal where LitNumNatural -> panic "Evaluated the place holder for mkNatural" return (LitNumber nt i t) + _ -> do + return (RubbishLit) instance Outputable Literal where ppr lit = pprLiteral (\d -> d) lit @@ -240,6 +252,8 @@ instance Eq Literal where a == b = case (a `compare` b) of { EQ -> True; _ -> False } a /= b = case (a `compare` b) of { EQ -> False; _ -> True } +-- | Needed for the @Ord@ instance of 'AltCon', which in turn is needed in +-- 'TrieMap.CoreMap'. instance Ord Literal where a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False } a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False } @@ -518,6 +532,10 @@ double2FloatLit l = pprPanic "double2FloatLit" (ppr l) nullAddrLit :: Literal nullAddrLit = MachNullAddr +-- | A nonsense literal of type @forall (a :: 'TYPE' 'UnliftedRep'). a@. +rubbishLit :: Literal +rubbishLit = RubbishLit + {- Predicates ~~~~~~~~~~ @@ -610,10 +628,16 @@ literalType (MachFloat _) = floatPrimTy literalType (MachDouble _) = doublePrimTy literalType (MachLabel _ _ _) = addrPrimTy literalType (LitNumber _ _ t) = t +literalType (RubbishLit) = mkForAllTy a Inferred (mkTyVarTy a) + where + a = alphaTyVarUnliftedRep absentLiteralOf :: TyCon -> Maybe Literal -- Return a literal of the appropriate primitive -- TyCon, to use as a placeholder when it doesn't matter +-- RubbishLits are handled in WwLib, because +-- 1. Looking at the TyCon is not enough, we need the actual type +-- 2. This would need to return a type application to a literal absentLiteralOf tc = lookupUFM absent_lits (tyConName tc) absent_lits :: UniqFM Literal @@ -642,6 +666,7 @@ cmpLit (MachLabel a _ _) (MachLabel b _ _) = a `compare` b cmpLit (LitNumber nt1 a _) (LitNumber nt2 b _) | nt1 == nt2 = a `compare` b | otherwise = nt1 `compare` nt2 +cmpLit (RubbishLit) (RubbishLit) = EQ cmpLit lit1 lit2 | litTag lit1 < litTag lit2 = LT | otherwise = GT @@ -654,6 +679,7 @@ litTag (MachFloat _) = 4 litTag (MachDouble _) = 5 litTag (MachLabel _ _ _) = 6 litTag (LitNumber {}) = 7 +litTag (RubbishLit) = 8 {- Printing @@ -679,6 +705,7 @@ pprLiteral add_par (MachLabel l mb fod) = add_par (text "__label" <+> b <+> ppr where b = case mb of Nothing -> pprHsString l Just x -> doubleQuotes (text (unpackFS l ++ '@':show x)) +pprLiteral _ (RubbishLit) = text "__RUBBISH" pprIntegerVal :: (SDoc -> SDoc) -> Integer -> SDoc -- See Note [Printing of literals in Core]. @@ -720,4 +747,60 @@ MachFloat -1.0# MachDouble -1.0## LitInteger -1 (-1) MachLabel "__label" ... ("__label" ...) +RubbishLit "__RUBBISH" + +Note [RubbishLit] +~~~~~~~~~~~~~~~~~ +During worker/wrapper after demand analysis, where an argument +is unused (absent) we do the following w/w split (supposing that +y is absent): + + f x y z = e +===> + f x y z = $wf x z + $wf x z = let y = <absent value> + in e + +Usually the binding for y is ultimately optimised away, and +even if not it should never be evaluated -- but that's the +way the w/w split starts off. + +What is <absent value>? +* For lifted values <absent value> can be a call to 'error'. +* For primitive types like Int# or Word# we can use any random + value of that type. +* But what about /unlifted/ but /boxed/ types like MutVar# or + Array#? We need a literal value of that type. + +That is 'RubbishLit'. Since we need a rubbish literal for +many boxed, unlifted types, we say that RubbishLit has type + RubbishLit :: forall (a :: TYPE UnliftedRep). a + +So we might see a w/w split like + $wf x z = let y :: Array# Int = RubbishLit @(Array# Int) + in e + +Recall that (TYPE UnliftedRep) is the kind of boxed, unlifted +heap pointers. + +Here are the moving parts: + +* We define RubbishLit as a constructor in Literal.Literal + +* It is given its polymoprhic type by Literal.literalType + +* WwLib.mk_absent_let introduces a RubbishLit for absent + arguments of boxed, unliftd type. + +* In CoreToSTG we convert (RubishLit @t) to just (). STG is + untyped, so it doesn't matter that it points to a lifted + value. The important thing is that it is a heap pointer, + which the garbage collector can follow if it encounters it. + + We considered maintaining RubbishLit in STG, and lowering + it in the code genreators, but it seems simpler to do it + once and for all in CoreToSTG. + + In ByteCodeAsm we just lower it as a 0 literal, because + it's all boxed and lifted to the host GC anyway. -} |