Commit faaf3139 authored by Joachim Breitner's avatar Joachim Breitner
Browse files

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 ( ...@@ -35,7 +35,8 @@ module Demand (
vanillaCprProdRes, cprSumRes, vanillaCprProdRes, cprSumRes,
appIsBottom, isBottomingSig, pprIfaceStrictSig, appIsBottom, isBottomingSig, pprIfaceStrictSig,
trimCPRInfo, returnsCPR_maybe, trimCPRInfo, returnsCPR_maybe,
StrictSig(..), mkStrictSig, mkClosedStrictSig, nopSig, botSig, cprProdSig, StrictSig(..), mkStrictSig, mkClosedStrictSig,
nopSig, botSig, exnSig, cprProdSig,
isTopSig, hasDemandEnvSig, isTopSig, hasDemandEnvSig,
splitStrictSig, strictSigDmdEnv, splitStrictSig, strictSigDmdEnv,
increaseStrictSigArity, increaseStrictSigArity,
...@@ -1264,9 +1265,10 @@ emptyDmdEnv = emptyVarEnv ...@@ -1264,9 +1265,10 @@ emptyDmdEnv = emptyVarEnv
-- (lazy, absent, no CPR information, no termination information). -- (lazy, absent, no CPR information, no termination information).
-- Note that it is ''not'' the top of the lattice (which would be "may use everything"), -- Note that it is ''not'' the top of the lattice (which would be "may use everything"),
-- so it is (no longer) called topDmd -- so it is (no longer) called topDmd
nopDmdType, botDmdType :: DmdType nopDmdType, botDmdType, exnDmdType :: DmdType
nopDmdType = DmdType emptyDmdEnv [] topRes nopDmdType = DmdType emptyDmdEnv [] topRes
botDmdType = DmdType emptyDmdEnv [] botRes botDmdType = DmdType emptyDmdEnv [] botRes
exnDmdType = DmdType emptyDmdEnv [] exnRes
cprProdDmdType :: Arity -> DmdType cprProdDmdType :: Arity -> DmdType
cprProdDmdType arity cprProdDmdType arity
...@@ -1691,9 +1693,10 @@ isBottomingSig :: StrictSig -> Bool ...@@ -1691,9 +1693,10 @@ isBottomingSig :: StrictSig -> Bool
-- True if the signature diverges or throws an exception -- True if the signature diverges or throws an exception
isBottomingSig (StrictSig (DmdType _ _ res)) = isBotRes res isBottomingSig (StrictSig (DmdType _ _ res)) = isBotRes res
nopSig, botSig :: StrictSig nopSig, botSig, exnSig :: StrictSig
nopSig = StrictSig nopDmdType nopSig = StrictSig nopDmdType
botSig = StrictSig botDmdType botSig = StrictSig botDmdType
exnSig = StrictSig exnDmdType
cprProdSig :: Arity -> StrictSig cprProdSig :: Arity -> StrictSig
cprProdSig arity = StrictSig (cprProdDmdType arity) cprProdSig arity = StrictSig (cprProdDmdType arity)
......
...@@ -709,7 +709,7 @@ every primitive type, so the function is partial. ...@@ -709,7 +709,7 @@ every primitive type, so the function is partial.
mk_absent_let :: DynFlags -> Id -> Maybe (CoreExpr -> CoreExpr) mk_absent_let :: DynFlags -> Id -> Maybe (CoreExpr -> CoreExpr)
mk_absent_let dflags arg mk_absent_let dflags arg
| not (isUnliftedType arg_ty) | not (isUnliftedType arg_ty)
= Just (Let (NonRec arg abs_rhs)) = Just (Let (NonRec lifted_arg abs_rhs))
| Just tc <- tyConAppTyCon_maybe arg_ty | Just tc <- tyConAppTyCon_maybe arg_ty
, Just lit <- absentLiteralOf tc , Just lit <- absentLiteralOf tc
= Just (Let (NonRec arg (Lit lit))) = Just (Let (NonRec arg (Lit lit)))
...@@ -719,10 +719,14 @@ mk_absent_let dflags arg ...@@ -719,10 +719,14 @@ mk_absent_let dflags arg
= WARN( True, text "No absent value for" <+> ppr arg_ty ) = WARN( True, text "No absent value for" <+> ppr arg_ty )
Nothing Nothing
where where
arg_ty = idType arg arg_ty = idType arg
abs_rhs = mkRuntimeErrorApp aBSENT_ERROR_ID arg_ty msg abs_rhs = mkRuntimeErrorApp aBSENT_ERROR_ID arg_ty msg
msg = showSDoc (gopt_set dflags Opt_SuppressUniques) lifted_arg = arg `setIdStrictness` exnSig
(ppr arg <+> ppr (idType arg)) -- 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 -- We need to suppress uniques here because otherwise they'd
-- end up in the generated code as strings. This is bad for -- end up in the generated code as strings. This is bad for
-- determinism, because with different uniques the strings -- determinism, because with different uniques the strings
......
Supports Markdown
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