diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2018-09-13 11:23:53 +0100 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2018-09-13 11:35:00 +0100 |
commit | bd76875ae6ad0cdd734564dddfb9ab88a6de9579 (patch) | |
tree | dddaeaf707a06f3e4b34d462978a20f89c12b0f6 /compiler/simplCore | |
parent | 291b0f89703f28631a381549e1838aa06195d011 (diff) | |
download | haskell-bd76875ae6ad0cdd734564dddfb9ab88a6de9579.tar.gz |
Allow (~) in the head of a quantified constraints
Since the introduction of quantified constraints, GHC has rejected
a quantified constraint with (~) in the head, thus
f :: (forall a. blah => a ~ ty) => stuff
I am frankly dubious that this is ever useful. But /is/ necessary for
Coercible (representation equality version of (~)) and it does no harm
to allow it for (~) as well. Plus, our users are asking for it
(Trac #15359, #15625).
It was really only excluded by accident, so
this patch lifts the restriction. See TcCanonical
Note [Equality superclasses in quantified constraints]
There are a number of wrinkles:
* If the context of the quantified constraint is empty, we
can get trouble when we get down to unboxed equality (a ~# b)
or (a ~R# b), as Trac #15625 showed. This is even more of
a corner case, but it produced an outright crash, so I elaborated
the superclass machinery in TcCanonical.makeStrictSuperClasses
to add a void argument in this case. See
Note [Equality superclasses in quantified constraints]
* The restriction on (~) was in TcValidity.checkValidInstHead.
In lifting the restriction I discovered an old special case for
(~), namely
| clas_nm `elem` [ heqTyConName, eqTyConName]
, nameModule clas_nm /= this_mod
This was (solely) to support the strange instance
instance a ~~ b => a ~ b
in Data.Type.Equality. But happily that is no longer
with us, since
commit f265008fb6f70830e7e92ce563f6d83833cef071
Refactor (~) to reduce the suerpclass stack
So I removed the special case.
* I found that the Core invariants on when we could have
co = <expr>
were entirely not written down. (Getting this wrong ws
the proximate source of the crash in Trac #15625. So
- Documented them better in CoreSyn
Note [CoreSyn type and coercion invariant],
- Modified CoreOpt and CoreLint to match
- Modified CoreUtils.bindNonRec to match
- Made MkCore.mkCoreLet use bindNonRec, rather
than duplicate its logic
- Made Simplify.rebuildCase case-to-let respect
Note [CoreSyn type and coercion invariant],
Diffstat (limited to 'compiler/simplCore')
-rw-r--r-- | compiler/simplCore/Simplify.hs | 26 |
1 files changed, 20 insertions, 6 deletions
diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 1041bc13cc..872973925f 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -44,6 +44,7 @@ import Demand ( mkClosedStrictSig, topDmd, exnRes ) import BasicTypes ( TopLevelFlag(..), isNotTopLevel, isTopLevel, RecFlag(..), Arity ) import MonadUtils ( mapAccumLM, liftIO ) +import Var ( isTyCoVar ) import Maybes ( orElse ) import Control.Monad import Outputable @@ -2425,9 +2426,7 @@ rebuildCase env scrut case_bndr alts@[(_, bndrs, rhs)] cont -- lifted case: the scrutinee is in HNF (or will later be demanded) -- See Note [Case to let transformation] | all_dead_bndrs - , if isUnliftedType (idType case_bndr) - then exprOkForSpeculation scrut - else exprIsHNF scrut || case_bndr_is_demanded + , doCaseToLet scrut case_bndr = do { tick (CaseElim case_bndr) ; (floats1, env') <- simplNonRecX env case_bndr scrut ; (floats2, expr') <- simplExprF env' rhs cont @@ -2446,12 +2445,27 @@ rebuildCase env scrut case_bndr alts@[(_, bndrs, rhs)] cont all_dead_bndrs = all isDeadBinder bndrs -- bndrs are [InId] is_plain_seq = all_dead_bndrs && isDeadBinder case_bndr -- Evaluation *only* for effect - case_bndr_is_demanded = isStrictDmd (idDemandInfo case_bndr) - -- See Note [Case-to-let for strictly-used binders] - rebuildCase env scrut case_bndr alts cont = reallyRebuildCase env scrut case_bndr alts cont + +doCaseToLet :: OutExpr -- Scrutinee + -> InId -- Case binder + -> Bool +-- The situation is case scrut of b { DEFAULT -> body } +-- Can we transform thus? let { b = scrut } in body +doCaseToLet scrut case_bndr + | isTyCoVar case_bndr -- Respect CoreSyn + = isTyCoArg scrut -- Note [CoreSyn type and coercion invariant] + + | isUnliftedType (idType case_bndr) + = exprOkForSpeculation scrut + + | otherwise -- Scrut has a lifted type + = exprIsHNF scrut + || isStrictDmd (idDemandInfo case_bndr) + -- See Note [Case-to-let for strictly-used binders] + -------------------------------------------------- -- 3. Catch-all case -------------------------------------------------- |