Commit faaf3139 authored by Joachim Breitner's avatar Joachim Breitner

WwLib: Add strictness signature to "let x = absentError …"

indicating that it is bottom. This should help making the "empty cases"
lint error give less false alarms.
parent ec7fcfdd
......@@ -35,7 +35,8 @@ module Demand (
vanillaCprProdRes, cprSumRes,
appIsBottom, isBottomingSig, pprIfaceStrictSig,
trimCPRInfo, returnsCPR_maybe,
StrictSig(..), mkStrictSig, mkClosedStrictSig, nopSig, botSig, cprProdSig,
StrictSig(..), mkStrictSig, mkClosedStrictSig,
nopSig, botSig, exnSig, cprProdSig,
isTopSig, hasDemandEnvSig,
splitStrictSig, strictSigDmdEnv,
increaseStrictSigArity,
......@@ -1264,9 +1265,10 @@ emptyDmdEnv = emptyVarEnv
-- (lazy, absent, no CPR information, no termination information).
-- Note that it is ''not'' the top of the lattice (which would be "may use everything"),
-- so it is (no longer) called topDmd
nopDmdType, botDmdType :: DmdType
nopDmdType, botDmdType, exnDmdType :: DmdType
nopDmdType = DmdType emptyDmdEnv [] topRes
botDmdType = DmdType emptyDmdEnv [] botRes
exnDmdType = DmdType emptyDmdEnv [] exnRes
cprProdDmdType :: Arity -> DmdType
cprProdDmdType arity
......@@ -1691,9 +1693,10 @@ isBottomingSig :: StrictSig -> Bool
-- True if the signature diverges or throws an exception
isBottomingSig (StrictSig (DmdType _ _ res)) = isBotRes res
nopSig, botSig :: StrictSig
nopSig, botSig, exnSig :: StrictSig
nopSig = StrictSig nopDmdType
botSig = StrictSig botDmdType
exnSig = StrictSig exnDmdType
cprProdSig :: Arity -> StrictSig
cprProdSig arity = StrictSig (cprProdDmdType arity)
......
......@@ -709,7 +709,7 @@ every primitive type, so the function is partial.
mk_absent_let :: DynFlags -> Id -> Maybe (CoreExpr -> CoreExpr)
mk_absent_let dflags arg
| not (isUnliftedType arg_ty)
= Just (Let (NonRec arg abs_rhs))
= Just (Let (NonRec lifted_arg abs_rhs))
| Just tc <- tyConAppTyCon_maybe arg_ty
, Just lit <- absentLiteralOf tc
= Just (Let (NonRec arg (Lit lit)))
......@@ -719,10 +719,14 @@ mk_absent_let dflags arg
= WARN( True, text "No absent value for" <+> ppr arg_ty )
Nothing
where
arg_ty = idType arg
abs_rhs = mkRuntimeErrorApp aBSENT_ERROR_ID arg_ty msg
msg = showSDoc (gopt_set dflags Opt_SuppressUniques)
(ppr arg <+> ppr (idType arg))
arg_ty = idType arg
abs_rhs = mkRuntimeErrorApp aBSENT_ERROR_ID arg_ty msg
lifted_arg = arg `setIdStrictness` exnSig
-- Note in strictness signature that this is bottoming
-- (for the sake of the "empty case scrutinee not known to
-- diverge for sure lint" warning)
msg = showSDoc (gopt_set dflags Opt_SuppressUniques)
(ppr arg <+> ppr (idType arg))
-- 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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment