Commit 43a31683 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Reset cc_pend_sc flag in dropDerivedCt

I'd forgotten to reset this flag to True when dropping Derived
constraints, which led to Trac #13662.  Easily fixed.
parent cb5ca5f3
......@@ -161,18 +161,19 @@ canClass ev cls tys pend_sc
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We need to add superclass constraints for two reasons:
* For givens, they give us a route to to proof. E.g.
* For givens [G], they give us a route to to proof. E.g.
f :: Ord a => a -> Bool
f x = x == x
We get a Wanted (Eq a), which can only be solved from the superclass
of the Given (Ord a).
* For wanteds, they may give useful functional dependencies. E.g.
* For wanteds [W], and deriveds [WD], [D], they may give useful
functional dependencies. E.g.
class C a b | a -> b where ...
class C a b => D a b where ...
Now a Wanted constraint (D Int beta) has (C Int beta) as a superclass
Now a [W] constraint (D Int beta) has (C Int beta) as a superclass
and that might tell us about beta, via C's fundeps. We can get this
by generateing a Derived (C Int beta) constraint. It's derived because
by generating a [D] (C Int beta) constraint. It's derived because
we don't actually have to cough up any evidence for it; it's only there
to generate fundep equalities.
......@@ -227,12 +228,20 @@ So here's the plan:
4. Go round to (2) again. This loop (2,3,4) is implemented
in TcSimplify.simpl_loop.
We try to terminate the loop by flagging which class constraints
(given or wanted) are potentially un-expanded. This is what the
cc_pend_sc flag is for in CDictCan. So in Step 3 we only expand
superclasses for constraints with cc_pend_sc set to true (i.e.
The cc_pend_sc flag in a CDictCan records whether the superclasses of
this constraint have been expanded. Specifically, in Step 3 we only
expand superclasses for constraints with cc_pend_sc set to true (i.e.
isPendingScDict holds).
Why do we do this? Two reasons:
* To avoid repeated work, by repeatedly expanding the superclasses of
same constraint,
* To terminate the above loop, at least in the -XNoRecursiveSuperClasses
case. If there are recursive superclasses we could, in principle,
expand forever, always encountering new constraints.
When we take a CNonCanonical or CIrredCan, but end up classifying it
as a CDictCan, we set the cc_pend_sc flag to False.
......
......@@ -1523,14 +1523,14 @@ data Ct
-- Atomic canonical constraints
= CDictCan { -- e.g. Num xi
cc_ev :: CtEvidence, -- See Note [Ct/evidence invariant]
cc_class :: Class,
cc_tyargs :: [Xi], -- cc_tyargs are function-free, hence Xi
cc_pend_sc :: Bool -- True <=> (a) cc_class has superclasses
-- (b) we have not (yet) added those
-- superclasses as Givens
-- NB: cc_pend_sc is used for G/W/D. For W/D the reason
-- we need superclasses is to expose possible improvement
-- via fundeps
cc_tyargs :: [Xi], -- cc_tyargs are function-free, hence Xi
cc_pend_sc :: Bool -- See Note [The superclass story] in TcCanonical
-- True <=> (a) cc_class has superclasses
-- (b) we have not (yet) added those
-- superclasses as Givens
}
| CIrredEvCan { -- These stand for yet-unusable predicates
......@@ -1608,9 +1608,8 @@ holeOcc :: Hole -> OccName
holeOcc (ExprHole uv) = unboundVarOcc uv
holeOcc (TypeHole occ) = occ
{-
Note [Hole constraints]
~~~~~~~~~~~~~~~~~~~~~~~
{- Note [Hole constraints]
~~~~~~~~~~~~~~~~~~~~~~~~~~
CHoleCan constraints are used for two kinds of holes,
distinguished by cc_hole:
......@@ -1805,13 +1804,25 @@ dropDerivedSimples simples = mapMaybeBag dropDerivedCt simples
dropDerivedCt :: Ct -> Maybe Ct
dropDerivedCt ct
= case ctEvFlavour ev of
Wanted WOnly -> Just (ct { cc_ev = ev_wd })
Wanted _ -> Just ct
Wanted WOnly -> Just (ct' { cc_ev = ev_wd })
Wanted _ -> Just ct'
_ -> ASSERT( isDerivedCt ct ) Nothing
-- simples are all Wanted or Derived
where
ev = ctEvidence ct
ev_wd = ev { ctev_nosh = WDeriv }
ct' = setPendingScDict ct -- See Note [Resetting cc_pend_sc]
{- Note [Resetting cc_pend_sc]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
When we discard Derived constraints, in dropDerivedSimples, we must
set the cc_pend_sc flag to True, so that if we re-process this
CDictCan we will re-generate its derived superclasses. Otherwise
we might miss some fundeps. Trac #13662 showed this up.
See Note [The superclass story] in TcCanonical.
-}
dropDerivedInsols :: Cts -> Cts
-- See Note [Dropping derived constraints]
......@@ -2011,6 +2022,12 @@ isPendingScDict ct@(CDictCan { cc_pend_sc = True })
= Just (ct { cc_pend_sc = False })
isPendingScDict _ = Nothing
setPendingScDict :: Ct -> Ct
-- Set the cc_pend_sc flag to True
setPendingScDict ct@(CDictCan { cc_pend_sc = False })
= ct { cc_pend_sc = True }
setPendingScDict ct = ct
superClassesMightHelp :: Ct -> Bool
-- ^ True if taking superclasses of givens, or of wanteds (to perhaps
-- expose more equalities or functional dependencies) might help to
......
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module T13662 (run) where
newtype Value a = Value a
type family Repr (f :: * -> *) a :: *
type instance Repr f Int = f Int
class (Repr Value i ~ Value ir) => Native i ir where
instance Native Int Int where
fromInt :: (Native i ir) => i -> a
fromInt = undefined
apply :: (Int -> a -> a) -> a -> a
apply weight = id
run :: Float -> Float
run =
let weight = \clip v -> fromInt clip * v
in apply weight
......@@ -263,3 +263,4 @@ test('T12538', normal, compile_fail, [''])
test('T13244', normal, compile, [''])
test('T13398a', normal, compile, [''])
test('T13398b', normal, compile, [''])
test('T13662', normal, compile, [''])
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