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/coreSyn | |
| 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/coreSyn')
| -rw-r--r-- | compiler/coreSyn/CoreUtils.hs | 11 |
1 files changed, 7 insertions, 4 deletions
diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs index 6dfb1df462..55609cf4b1 100644 --- a/compiler/coreSyn/CoreUtils.hs +++ b/compiler/coreSyn/CoreUtils.hs @@ -1525,10 +1525,13 @@ expr_ok primop_ok (Case scrut bndr _ alts) && altsAreExhaustive alts expr_ok primop_ok other_expr - = case collectArgs other_expr of - (expr, args) | Var f <- stripTicksTopE (not . tickishCounts) expr - -> app_ok primop_ok f args - _ -> False + | (expr, args) <- collectArgs other_expr + = case stripTicksTopE (not . tickishCounts) expr of + Var f -> app_ok primop_ok f args + -- 'RubbishLit' 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( lit == rubbishLit ) True + _ -> False ----------------------------- app_ok :: (PrimOp -> Bool) -> Id -> [CoreExpr] -> Bool |