summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRyan Scott <ryan.gl.scott@gmail.com>2020-04-21 16:47:12 -0400
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-04-22 23:16:12 -0400
commitc409961aea59d2fe2ae71036a1ae6d94c4ee05c8 (patch)
treed1a5e5accfe68387a20d27fa8b5e430646542698
parent831b66425aa3a24e769ace8d4649299ade021717 (diff)
downloadhaskell-c409961aea59d2fe2ae71036a1ae6d94c4ee05c8.tar.gz
Update commentary and slightly refactor GHC.Tc.Deriv.Infer
There was some out-of-date commentary in `GHC.Tc.Deriv.Infer` that has been modernized. Along the way, I removed the `bad` constraints in `simplifyDeriv`, which did not serve any useful purpose (besides being printed in debugging output). Fixes #18073.
-rw-r--r--compiler/GHC/Tc/Deriv/Infer.hs27
1 files changed, 17 insertions, 10 deletions
diff --git a/compiler/GHC/Tc/Deriv/Infer.hs b/compiler/GHC/Tc/Deriv/Infer.hs
index a5351fcf86..849f0bf2a9 100644
--- a/compiler/GHC/Tc/Deriv/Infer.hs
+++ b/compiler/GHC/Tc/Deriv/Infer.hs
@@ -803,28 +803,31 @@ simplifyDeriv pred tvs thetas
; solved_wanteds <- zonkWC solved_wanteds
-- See [STEP DAC HOIST]
- -- Split the resulting constraints into bad and good constraints,
- -- building an @unsolved :: WantedConstraints@ representing all
- -- the constraints we can't just shunt to the predicates.
- -- See Note [Exotic derived instance contexts]
+ -- From the simplified constraints extract a subset 'good' that will
+ -- become the context 'min_theta' for the derived instance.
; let residual_simple = approximateWC True solved_wanteds
- (bad, good) = partitionBagWith get_good residual_simple
-
- get_good :: Ct -> Either Ct PredType
+ good = mapMaybeBag get_good residual_simple
+
+ -- Returns @Just p@ (where @p@ is the type of the Ct) if a Ct is
+ -- suitable to be inferred in the context of a derived instance.
+ -- Returns @Nothing@ if the Ct is too exotic.
+ -- See Note [Exotic derived instance contexts] for what
+ -- constitutes an exotic constraint.
+ get_good :: Ct -> Maybe PredType
get_good ct | validDerivPred skol_set p
, isWantedCt ct
- = Right p
+ = Just p
-- TODO: This is wrong
-- NB re 'isWantedCt': residual_wanted may contain
-- unsolved CtDerived and we stick them into the
-- bad set so that reportUnsolved may decide what
-- to do with them
| otherwise
- = Left ct
+ = Nothing
where p = ctPred ct
; traceTc "simplifyDeriv outputs" $
- vcat [ ppr tvs_skols, ppr residual_simple, ppr good, ppr bad ]
+ vcat [ ppr tvs_skols, ppr residual_simple, ppr good ]
-- Return the good unsolved constraints (unskolemizing on the way out.)
; let min_theta = mkMinimalBySCs id (bagToList good)
@@ -838,6 +841,10 @@ simplifyDeriv pred tvs thetas
-- The reverse substitution (sigh)
-- See [STEP DAC RESIDUAL]
+ -- Ensure that min_theta is enough to solve /all/ the constraints in
+ -- solved_wanteds, by solving the implication constraint
+ --
+ -- forall tvs. min_theta => solved_wanteds
; min_theta_vars <- mapM newEvVar min_theta
; (leftover_implic, _)
<- buildImplicationFor tc_lvl skol_info tvs_skols