### 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!