From 8ddee6152c215e8e8ee1cbfff3481ea5bc062305 Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Thu, 23 Sep 2010 10:57:32 +0000
Subject: [PATCH] Rejig the absent-arg stuff for unlifted types

This is what was giving the "absent entered" messages
See Note [Absent errors] in WwLib.  We now return a
suitable literal for absent values of unlifted type.
---
 compiler/basicTypes/Literal.lhs |   22 ++++++++++++++++--
 compiler/stranal/WwLib.lhs      |   49 +++++++++++++++++++++++++--------------
 2 files changed, 52 insertions(+), 19 deletions(-)

diff --git a/compiler/basicTypes/Literal.lhs b/compiler/basicTypes/Literal.lhs
index a03e1c1..0ebf5bf 100644
--- a/compiler/basicTypes/Literal.lhs
+++ b/compiler/basicTypes/Literal.lhs
@@ -27,6 +27,7 @@ module Literal
 	-- ** Operations on Literals
 	, literalType
 	, hashLiteral
+        , absentLiteralOf
 
         -- ** Predicates on Literals and their contents
 	, litIsDupable, litIsTrivial
@@ -44,19 +45,21 @@ module Literal
 	) where
 
 import TysPrim
+import PrelNames
 import Type
+import TyCon
 import Outputable
 import FastTypes
 import FastString
 import BasicTypes
 import Binary
 import Constants
-
+import UniqFM
 import Data.Int
 import Data.Ratio
 import Data.Word
 import Data.Char
-import Data.Data
+import Data.Data( Data, Typeable )
 \end{code}
 
 
@@ -326,6 +329,21 @@ literalType (MachWord64  _) = word64PrimTy
 literalType (MachFloat _)   = floatPrimTy
 literalType (MachDouble _)  = doublePrimTy
 literalType (MachLabel _ _ _) = addrPrimTy
+
+absentLiteralOf :: TyCon -> Maybe Literal
+-- Return a literal of the appropriate primtive
+-- TyCon, to use as a placeholder when it doesn't matter
+absentLiteralOf tc = lookupUFM absent_lits (tyConName tc)
+
+absent_lits :: UniqFM Literal
+absent_lits = listToUFM [ (addrPrimTyConKey,    MachNullAddr)
+            		, (charPrimTyConKey,    MachChar 'x')
+            		, (intPrimTyConKey,     MachInt 0)
+            		, (int64PrimTyConKey,   MachInt 0)
+            		, (floatPrimTyConKey,   MachFloat 0)
+            		, (doublePrimTyConKey,  MachDouble 0)
+            		, (wordPrimTyConKey,    MachWord 0)
+            		, (word64PrimTyConKey,  MachWord64 0) ]
 \end{code}
 
 
diff --git a/compiler/stranal/WwLib.lhs b/compiler/stranal/WwLib.lhs
index faffff2..7d78416 100644
--- a/compiler/stranal/WwLib.lhs
+++ b/compiler/stranal/WwLib.lhs
@@ -24,6 +24,7 @@ import TysWiredIn	( tupleCon )
 import Type
 import Coercion         ( mkSymCoercion, splitNewTypeRepCo_maybe )
 import BasicTypes	( Boxity(..) )
+import Literal		( absentLiteralOf )
 import Var              ( Var )
 import UniqSupply
 import Unique
@@ -343,10 +344,11 @@ mkWWstr_one arg
   | otherwise
   = case idDemandInfo arg of
 
-	-- Absent case.  We don't deal with absence for unlifted types,
-	-- though, because it's not so easy to manufacture a placeholder
-	-- We'll see if this turns out to be a problem
-      Abs -> return ([], nop_fn, mk_absent_let arg) 
+	-- Absent case.  We can't always handle absence for arbitrary
+        -- unlifted types, so we need to choose just the cases we can
+	-- (that's what mk_absent_let does)
+      Abs | Just work_fn <- mk_absent_let arg
+          -> return ([], nop_fn, work_fn)
 
 	-- Unpack case
       Eval (Prod cs)
@@ -492,26 +494,39 @@ workerCase bndr e args con body = mkUnpackCase bndr e args con body
 %*									*
 %************************************************************************
 
-
-Note [Absent error Id]
-~~~~~~~~~~~~~~~~~~~~~~
+Note [Absent errors]
+~~~~~~~~~~~~~~~~~~~~
 We make a new binding for Ids that are marked absent, thus
    let x = absentError "x :: Int"
 The idea is that this binding will never be used; but if it 
 buggily is used we'll get a runtime error message.
 
-We do this even for *unlifted* types (e.g. Int#).  We define
-absentError to *not* be a bottoming Id, and we treat it as
-"ok for speculation" (see CoreUtils.okForSpeculation). That
-means that the let won't get turned into a case, and will
-be discarded if (as we fully expect) x turns out to be dead.
-Coping with absence for unlifted types is important; see, for
-example, Trac #4306.
+Coping with absence for *unlifted* types is important; see, for
+example, Trac #4306.  For these we find a suitable literal,
+using Literal.absentLiteralOf.  We don't have literals for
+every primitive type, so the function is partial.
+
+    [I did try the experiment of using an error thunk for unlifted
+    things too, relying on the simplifier to drop it as dead code,
+    by making absentError 
+      (a) *not* be a bottoming Id, 
+      (b) be "ok for speculation"
+    But that relies on the simplifier finding that it really
+    is dead code, which is fragile, and indeed failed when 
+    profiling is on, which disables various optimisations.  So
+    using a literal will do.]
 
 \begin{code}
-mk_absent_let :: Id -> CoreExpr -> CoreExpr
-mk_absent_let arg body
-  = Let (NonRec arg abs_rhs) body
+mk_absent_let :: Id -> Maybe (CoreExpr -> CoreExpr)
+mk_absent_let arg 
+  | not (isUnLiftedType arg_ty)
+  = Just (Let (NonRec arg abs_rhs))
+  | Just (tc, _) <- splitTyConApp_maybe arg_ty
+  , Just lit <- absentLiteralOf tc
+  = Just (Let (NonRec arg (Lit lit)))
+  | otherwise
+  = WARN( True, ptext (sLit "No asbent value for") <+> ppr arg_ty )
+    Nothing
   where
     arg_ty  = idType arg
     abs_rhs = mkRuntimeErrorApp aBSENT_ERROR_ID arg_ty msg
-- 
1.7.10.4