Commit 8a0de692 authored by eir@cis.upenn.edu's avatar eir@cis.upenn.edu
Browse files

Flat constraint --> Simple constraint

parent 0cc47eb9
......@@ -74,7 +74,7 @@ emitWanted :: CtOrigin -> TcPredType -> TcM EvVar
emitWanted origin pred
= do { loc <- getCtLoc origin
; ev <- newEvVar pred
; emitFlat $ mkNonCanonical $
; emitSimple $ mkNonCanonical $
CtWanted { ctev_pred = pred, ctev_evar = ev, ctev_loc = loc }
; return ev }
......@@ -600,8 +600,8 @@ tyVarsOfCts = foldrBag (unionVarSet . tyVarsOfCt) emptyVarSet
tyVarsOfWC :: WantedConstraints -> TyVarSet
-- Only called on *zonked* things, hence no need to worry about flatten-skolems
tyVarsOfWC (WC { wc_flat = flat, wc_impl = implic, wc_insol = insol })
= tyVarsOfCts flat `unionVarSet`
tyVarsOfWC (WC { wc_simple = simple, wc_impl = implic, wc_insol = insol })
= tyVarsOfCts simple `unionVarSet`
tyVarsOfBag tyVarsOfImplic implic `unionVarSet`
tyVarsOfCts insol
......
......@@ -50,7 +50,7 @@ import FastString
Note [Canonicalization]
~~~~~~~~~~~~~~~~~~~~~~~
Canonicalization converts a flat constraint to a canonical form. It is
Canonicalization converts a simple constraint to a canonical form. It is
unary (i.e. treats individual constraints one at a time), does not do
any zonking, but lives in TcS monad because it needs to create fresh
variables (for flattening) and consult the inerts (for efficiency).
......
......@@ -1857,15 +1857,15 @@ simplifyDeriv pred tvs theta
skol_set = mkVarSet tvs_skols
doc = ptext (sLit "deriving") <+> parens (ppr pred)
; wanted <- mapM (\(PredOrigin t o) -> newFlatWanted o (substTy skol_subst t)) theta
; wanted <- mapM (\(PredOrigin t o) -> newSimpleWanted o (substTy skol_subst t)) theta
; traceTc "simplifyDeriv" $
vcat [ pprTvBndrs tvs $$ ppr theta $$ ppr wanted, doc ]
; (residual_wanted, _ev_binds1)
<- solveWantedsTcM (mkFlatWC wanted)
<- solveWantedsTcM (mkSimpleWC wanted)
-- Post: residual_wanted are already zonked
; let (good, bad) = partitionBagWith get_good (wc_flat residual_wanted)
; let (good, bad) = partitionBagWith get_good (wc_simple residual_wanted)
-- See Note [Exotic derived instance contexts]
get_good :: Ct -> Either PredType Ct
get_good ct | validDerivPred skol_set p
......@@ -1880,7 +1880,7 @@ simplifyDeriv pred tvs theta
-- constraints. They'll come up again when we typecheck the
-- generated instance declaration
; defer <- goptM Opt_DeferTypeErrors
; unless defer (reportAllUnsolved (residual_wanted { wc_flat = bad }))
; unless defer (reportAllUnsolved (residual_wanted { wc_simple = bad }))
; let min_theta = mkMinimalBySCs (bagToList good)
; return (substTheta subst_skol min_theta) }
......
......@@ -195,8 +195,8 @@ Specifically (see reportWanteds)
* If there are insoluble Givens, then we are in unreachable code and all bets
are off. So don't report any further errors.
* If there are any insolubles (eg Int~Bool), here or in a nested implication,
then suppress errors from the flat constraints here. Sometimes the
flat-constraint errors are a knock-on effect of the insolubles.
then suppress errors from the simple constraints here. Sometimes the
simple-constraint errors are a knock-on effect of the insolubles.
-}
reportImplic :: ReportErrCtxt -> Implication -> TcM ()
......@@ -224,11 +224,11 @@ reportImplic ctxt implic@(Implic { ic_skols = tvs, ic_given = given
Just {} -> Just evb }
reportWanteds :: ReportErrCtxt -> WantedConstraints -> TcM ()
reportWanteds ctxt wanted@(WC { wc_flat = flats, wc_insol = insols, wc_impl = implics })
= do { reportFlats ctxt (mapBag (tidyCt env) insol_given)
; reportFlats ctxt1 (mapBag (tidyCt env) insol_wanted)
; reportFlats ctxt2 (mapBag (tidyCt env) flats)
-- All the Derived ones have been filtered out of flats
reportWanteds ctxt wanted@(WC { wc_simple = simples, wc_insol = insols, wc_impl = implics })
= do { reportSimples ctxt (mapBag (tidyCt env) insol_given)
; reportSimples ctxt1 (mapBag (tidyCt env) insol_wanted)
; reportSimples ctxt2 (mapBag (tidyCt env) simples)
-- All the Derived ones have been filtered out of simples
-- by the constraint solver. This is ok; we don't want
-- to report unsolved Derived goals as errors
-- See Note [Do not report derived but soluble errors]
......@@ -247,10 +247,10 @@ reportWanteds ctxt wanted@(WC { wc_flat = flats, wc_insol = insols, wc_impl = im
ctxt1 = ctxt { cec_suppress = suppress1 }
ctxt2 = ctxt { cec_suppress = suppress2 }
reportFlats :: ReportErrCtxt -> Cts -> TcM ()
reportFlats ctxt flats -- Here 'flats' includes insolble goals
= traceTc "reportFlats" (vcat [ ptext (sLit "Flats =") <+> ppr flats
, ptext (sLit "Suppress =") <+> ppr (cec_suppress ctxt)])
reportSimples :: ReportErrCtxt -> Cts -> TcM ()
reportSimples ctxt simples -- Here 'simples' includes insolble goals
= traceTc "reportSimples" (vcat [ ptext (sLit "Simples =") <+> ppr simples
, ptext (sLit "Suppress =") <+> ppr (cec_suppress ctxt)])
>> tryReporters
[ -- First deal with things that are utterly wrong
-- Like Int ~ Bool (incl nullary TyCons)
......@@ -270,7 +270,7 @@ reportFlats ctxt flats -- Here 'flats' includes insolble goals
, ("Irreds", is_irred, False, mkGroupReporter mkIrredErr)
, ("Dicts", is_dict, False, mkGroupReporter mkDictErr)
]
panicReporter ctxt (bagToList flats)
panicReporter ctxt (bagToList simples)
-- TuplePreds should have been expanded away by the constraint
-- simplifier, so they shouldn't show up at this point
where
......@@ -331,7 +331,7 @@ type ReporterSpec
panicReporter :: Reporter
panicReporter _ cts
| null cts = return ()
| otherwise = pprPanic "reportFlats" (ppr cts)
| otherwise = pprPanic "reportSimples" (ppr cts)
mkSkolReporter :: Reporter
-- Suppress duplicates with the same LHS
......@@ -510,7 +510,7 @@ is perhaps a bit *over*-consistent! Again, an easy choice to change.
Note [Do not report derived but soluble errors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The wc_flats include Derived constraints that have not been solved, but are
The wc_simples include Derived constraints that have not been solved, but are
not insoluble (in that case they'd be in wc_insols). We do not want to report
these as errors:
......@@ -536,7 +536,7 @@ these as errors:
Here we get [G] C Int b, [W] C Int a, hence [D] a~b.
But again f (MkT True True) is a legitimate call.
(We leave the Deriveds in wc_flat until reportErrors, so that we don't lose
(We leave the Deriveds in wc_simple until reportErrors, so that we don't lose
derived superclasses between iterations of the solver.)
For functional dependencies, here is a real example,
......
{-# LANGUAGE CPP #-}
module TcInteract (
solveFlatGivens, -- Solves [EvVar],GivenLoc
solveFlatWanteds -- Solves Cts
solveSimpleGivens, -- Solves [EvVar],GivenLoc
solveSimpleWanteds -- Solves Cts
) where
#include "HsVersions.h"
......@@ -75,12 +75,12 @@ Note [Basic Simplifier Plan]
If in Step 1 no such element exists, we have exceeded our context-stack
depth and will simply fail.
Note [Unflatten after solving the flat wanteds]
Note [Unflatten after solving the simple wanteds]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We unflatten after solving the wc_flats of an implication, and before attempting
We unflatten after solving the wc_simples of an implication, and before attempting
to float. This means that
* The fsk/fmv flatten-skolems only survive during solveFlats. We don't
* The fsk/fmv flatten-skolems only survive during solveSimples. We don't
need to worry about then across successive passes over the constraint tree.
(E.g. we don't need the old ic_fsk field of an implication.
......@@ -96,7 +96,7 @@ to float. This means that
(c ~ False) => b ~ gamma
Obviously this is soluble with gamma := F c a b, and unflattening
will do exactly that after solving the flat constraints and before
will do exactly that after solving the simple constraints and before
attempting the implications. Before, when we were not unflattening,
we had to push Wanted funeqs in as new givens. Yuk!
......@@ -110,8 +110,8 @@ to float. This means that
Note [Running plugins on unflattened wanteds]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
There is an annoying mismatch between solveFlatGivens and
solveFlatWanteds, because the latter needs to fiddle with the inert
There is an annoying mismatch between solveSimpleGivens and
solveSimpleWanteds, because the latter needs to fiddle with the inert
set, unflatten and and zonk the wanteds. It passes the zonked wanteds
to runTcPluginsWanteds, which produces a replacement set of wanteds,
some additional insolubles and a flag indicating whether to go round
......@@ -121,8 +121,8 @@ that prepareInertsForImplications will discard the insolubles, so we
must keep track of them separately.
-}
solveFlatGivens :: CtLoc -> [EvVar] -> TcS ()
solveFlatGivens loc givens
solveSimpleGivens :: CtLoc -> [EvVar] -> TcS ()
solveSimpleGivens loc givens
| null givens -- Shortcut for common case
= return ()
| otherwise
......@@ -131,42 +131,42 @@ solveFlatGivens loc givens
mk_given_ct ev_id = mkNonCanonical (CtGiven { ctev_evtm = EvId ev_id
, ctev_pred = evVarPred ev_id
, ctev_loc = loc })
go givens = do { solveFlats (listToBag givens)
go givens = do { solveSimples (listToBag givens)
; new_givens <- runTcPluginsGiven
; when (notNull new_givens) (go new_givens)
}
solveFlatWanteds :: Cts -> TcS WantedConstraints
solveFlatWanteds = go emptyBag
solveSimpleWanteds :: Cts -> TcS WantedConstraints
solveSimpleWanteds = go emptyBag
where
go insols0 wanteds
= do { solveFlats wanteds
= do { solveSimples wanteds
; (implics, tv_eqs, fun_eqs, insols, others) <- getUnsolvedInerts
; unflattened_eqs <- unflatten tv_eqs fun_eqs
-- See Note [Unflatten after solving the flat wanteds]
-- See Note [Unflatten after solving the simple wanteds]
; zonked <- zonkFlats (others `andCts` unflattened_eqs)
-- Postcondition is that the wl_flats are zonked
; zonked <- zonkSimples (others `andCts` unflattened_eqs)
-- Postcondition is that the wl_simples are zonked
; (wanteds', insols', rerun) <- runTcPluginsWanted zonked
-- See Note [Running plugins on unflattened wanteds]
; let all_insols = insols0 `unionBags` insols `unionBags` insols'
; if rerun then do { updInertTcS prepareInertsForImplications
; go all_insols wanteds' }
else return (WC { wc_flat = wanteds'
, wc_insol = all_insols
, wc_impl = implics }) }
else return (WC { wc_simple = wanteds'
, wc_insol = all_insols
, wc_impl = implics }) }
-- The main solver loop implements Note [Basic Simplifier Plan]
---------------------------------------------------------------
solveFlats :: Cts -> TcS ()
solveSimples :: Cts -> TcS ()
-- Returns the final InertSet in TcS
-- Has no effect on work-list or residual-iplications
-- The constraints are initially examined in left-to-right order
solveFlats cts
= {-# SCC "solveFlats" #-}
solveSimples cts
= {-# SCC "solveSimples" #-}
do { dyn_flags <- getDynFlags
; updWorkListTcS (\wl -> foldrBag extendWorkListCt wl cts)
; solve_loop (maxSubGoalDepth dyn_flags) }
......@@ -185,7 +185,7 @@ solveFlats cts
-- | Extract the (inert) givens and invoke the plugins on them.
-- Remove solved givens from the inert set and emit insolubles, but
-- return new work produced so that 'solveFlatGivens' can feed it back
-- return new work produced so that 'solveSimpleGivens' can feed it back
-- into the main solver.
runTcPluginsGiven :: TcS [Ct]
runTcPluginsGiven = do
......@@ -202,7 +202,7 @@ runTcPluginsGiven = do
-- | Given a bag of (flattened, zonked) wanteds, invoke the plugins on
-- them and produce an updated bag of wanteds (possibly with some new
-- work) and a bag of insolubles. The boolean indicates whether
-- 'solveFlatWanteds' should feed the updated wanteds back into the
-- 'solveSimpleWanteds' should feed the updated wanteds back into the
-- main solver.
runTcPluginsWanted :: Cts -> TcS (Cts, Cts, Bool)
runTcPluginsWanted zonked_wanteds
......
......@@ -30,7 +30,7 @@ module TcMType (
-- Creating new evidence variables
newEvVar, newEvVars, newEq, newDict,
newTcEvBinds, addTcEvBind,
newFlatWanted, newFlatWanteds,
newSimpleWanted, newSimpleWanteds,
--------------------------------
-- Instantiation
......@@ -53,7 +53,7 @@ module TcMType (
zonkTcTyVarBndr, zonkTcType, zonkTcTypes, zonkTcThetaType,
zonkTcKind, defaultKindVarToStar,
zonkEvVar, zonkWC, zonkFlats, zonkId, zonkCt, zonkSkolemInfo,
zonkEvVar, zonkWC, zonkSimples, zonkId, zonkCt, zonkSkolemInfo,
tcGetGlobalTyVars,
......@@ -155,8 +155,8 @@ predTypeOccName ty = case classifyPredType ty of
*********************************************************************************
-}
newFlatWanted :: CtOrigin -> PredType -> TcM Ct
newFlatWanted orig pty
newSimpleWanted :: CtOrigin -> PredType -> TcM Ct
newSimpleWanted orig pty
= do loc <- getCtLoc orig
v <- newEvVar pty
return $ mkNonCanonical $
......@@ -164,8 +164,8 @@ newFlatWanted orig pty
, ctev_pred = pty
, ctev_loc = loc }
newFlatWanteds :: CtOrigin -> ThetaType -> TcM [Ct]
newFlatWanteds orig = mapM (newFlatWanted orig)
newSimpleWanteds :: CtOrigin -> ThetaType -> TcM [Ct]
newSimpleWanteds orig = mapM (newSimpleWanted orig)
{-
************************************************************************
......@@ -769,16 +769,16 @@ zonkWC :: WantedConstraints -> TcM WantedConstraints
zonkWC wc = zonkWCRec wc
zonkWCRec :: WantedConstraints -> TcM WantedConstraints
zonkWCRec (WC { wc_flat = flat, wc_impl = implic, wc_insol = insol })
= do { flat' <- zonkFlats flat
zonkWCRec (WC { wc_simple = simple, wc_impl = implic, wc_insol = insol })
= do { simple' <- zonkSimples simple
; implic' <- flatMapBagM zonkImplication implic
; insol' <- zonkFlats insol
; return (WC { wc_flat = flat', wc_impl = implic', wc_insol = insol' }) }
; insol' <- zonkSimples insol
; return (WC { wc_simple = simple', wc_impl = implic', wc_insol = insol' }) }
zonkFlats :: Cts -> TcM Cts
zonkFlats cts = do { cts' <- mapBagM zonkCt' cts
; traceTc "zonkFlats done:" (ppr cts')
; return cts' }
zonkSimples :: Cts -> TcM Cts
zonkSimples cts = do { cts' <- mapBagM zonkCt' cts
; traceTc "zonkSimples done:" (ppr cts')
; return cts' }
zonkCt' :: Ct -> TcM Ct
zonkCt' ct = zonkCt ct
......
......@@ -1105,15 +1105,15 @@ emitConstraints ct
= do { lie_var <- getConstraintVar ;
updTcRef lie_var (`andWC` ct) }
emitFlat :: Ct -> TcM ()
emitFlat ct
emitSimple :: Ct -> TcM ()
emitSimple ct
= do { lie_var <- getConstraintVar ;
updTcRef lie_var (`addFlats` unitBag ct) }
updTcRef lie_var (`addSimples` unitBag ct) }
emitFlats :: Cts -> TcM ()
emitFlats cts
emitSimples :: Cts -> TcM ()
emitSimples cts
= do { lie_var <- getConstraintVar ;
updTcRef lie_var (`addFlats` cts) }
updTcRef lie_var (`addSimples` cts) }
emitImplication :: Implication -> TcM ()
emitImplication ct
......
......@@ -56,7 +56,7 @@ module TcRnTypes(
ctEvTerm, ctEvCoercion, ctEvId, ctEvCheckDepth,
WantedConstraints(..), insolubleWC, emptyWC, isEmptyWC,
andWC, unionsWC, addFlats, addImplics, mkFlatWC, addInsols,
andWC, unionsWC, addSimples, addImplics, mkSimpleWC, addInsols,
dropDerivedWC,
Implication(..),
......@@ -1188,8 +1188,8 @@ ctEqRel = ctEvEqRel . ctEvidence
dropDerivedWC :: WantedConstraints -> WantedConstraints
-- See Note [Dropping derived constraints]
dropDerivedWC wc@(WC { wc_flat = flats })
= wc { wc_flat = filterBag isWantedCt flats }
dropDerivedWC wc@(WC { wc_simple = simples })
= wc { wc_simple = filterBag isWantedCt simples }
-- The wc_impl implications are already (recursively) filtered
{-
......@@ -1330,22 +1330,22 @@ v%************************************************************************
-}
data WantedConstraints
= WC { wc_flat :: Cts -- Unsolved constraints, all wanted
, wc_impl :: Bag Implication
, wc_insol :: Cts -- Insoluble constraints, can be
= WC { wc_simple :: Cts -- Unsolved constraints, all wanted
, wc_impl :: Bag Implication
, wc_insol :: Cts -- Insoluble constraints, can be
-- wanted, given, or derived
-- See Note [Insoluble constraints]
}
emptyWC :: WantedConstraints
emptyWC = WC { wc_flat = emptyBag, wc_impl = emptyBag, wc_insol = emptyBag }
emptyWC = WC { wc_simple = emptyBag, wc_impl = emptyBag, wc_insol = emptyBag }
mkFlatWC :: [Ct] -> WantedConstraints
mkFlatWC cts
= WC { wc_flat = listToBag cts, wc_impl = emptyBag, wc_insol = emptyBag }
mkSimpleWC :: [Ct] -> WantedConstraints
mkSimpleWC cts
= WC { wc_simple = listToBag cts, wc_impl = emptyBag, wc_insol = emptyBag }
isEmptyWC :: WantedConstraints -> Bool
isEmptyWC (WC { wc_flat = f, wc_impl = i, wc_insol = n })
isEmptyWC (WC { wc_simple = f, wc_impl = i, wc_insol = n })
= isEmptyBag f && isEmptyBag i && isEmptyBag n
insolubleWC :: WantedConstraints -> Bool
......@@ -1357,18 +1357,18 @@ insolubleWC wc = not (isEmptyBag (filterBag (not . isPartialTypeSigCt)
|| anyBag ic_insol (wc_impl wc)
andWC :: WantedConstraints -> WantedConstraints -> WantedConstraints
andWC (WC { wc_flat = f1, wc_impl = i1, wc_insol = n1 })
(WC { wc_flat = f2, wc_impl = i2, wc_insol = n2 })
= WC { wc_flat = f1 `unionBags` f2
, wc_impl = i1 `unionBags` i2
, wc_insol = n1 `unionBags` n2 }
andWC (WC { wc_simple = f1, wc_impl = i1, wc_insol = n1 })
(WC { wc_simple = f2, wc_impl = i2, wc_insol = n2 })
= WC { wc_simple = f1 `unionBags` f2
, wc_impl = i1 `unionBags` i2
, wc_insol = n1 `unionBags` n2 }
unionsWC :: [WantedConstraints] -> WantedConstraints
unionsWC = foldr andWC emptyWC
addFlats :: WantedConstraints -> Bag Ct -> WantedConstraints
addFlats wc cts
= wc { wc_flat = wc_flat wc `unionBags` cts }
addSimples :: WantedConstraints -> Bag Ct -> WantedConstraints
addSimples wc cts
= wc { wc_simple = wc_simple wc `unionBags` cts }
addImplics :: WantedConstraints -> Bag Implication -> WantedConstraints
addImplics wc implic = wc { wc_impl = wc_impl wc `unionBags` implic }
......@@ -1378,9 +1378,9 @@ addInsols wc cts
= wc { wc_insol = wc_insol wc `unionBags` cts }
instance Outputable WantedConstraints where
ppr (WC {wc_flat = f, wc_impl = i, wc_insol = n})
ppr (WC {wc_simple = s, wc_impl = i, wc_insol = n})
= ptext (sLit "WC") <+> braces (vcat
[ ppr_bag (ptext (sLit "wc_flat")) f
[ ppr_bag (ptext (sLit "wc_simple")) s
, ppr_bag (ptext (sLit "wc_insol")) n
, ppr_bag (ptext (sLit "wc_impl")) i ])
......
......@@ -73,7 +73,7 @@ module TcSMonad (
TcLevel, isTouchableMetaTyVarTcS,
isFilledMetaTyVar_maybe, isFilledMetaTyVar,
zonkTyVarsAndFV, zonkTcType, zonkTcTyVar, zonkFlats,
zonkTyVarsAndFV, zonkTcType, zonkTcTyVar, zonkSimples,
-- References
newTcRef, readTcRef, updTcRef,
......@@ -1285,7 +1285,7 @@ dictionaries from the thing_inside.
Consider
Eq [a]
forall b. empty => Eq [a]
We solve the flat (Eq [a]), under nestTcS, and then turn our attention to
We solve the simple (Eq [a]), under nestTcS, and then turn our attention to
the implications. It's definitely fine to use the solved dictionaries on
the inner implications, and it can make a signficant performance difference
if you do so.
......@@ -1465,8 +1465,8 @@ zonkTcType ty = wrapTcS (TcM.zonkTcType ty)
zonkTcTyVar :: TcTyVar -> TcS TcType
zonkTcTyVar tv = wrapTcS (TcM.zonkTcTyVar tv)
zonkFlats :: Cts -> TcS Cts
zonkFlats cts = wrapTcS (TcM.zonkFlats cts)
zonkSimples :: Cts -> TcS Cts
zonkSimples cts = wrapTcS (TcM.zonkSimples cts)
{-
Note [Do not add duplicate derived insolubles]
......@@ -1498,11 +1498,11 @@ Example of (b): assume a top-level class and instance declaration:
Assume we have started with an implication:
forall c. Eq c => { wc_flat = D [c] c [W] }
forall c. Eq c => { wc_simple = D [c] c [W] }
which we have simplified to:
forall c. Eq c => { wc_flat = D [c] c [W]
forall c. Eq c => { wc_simple = D [c] c [W]
, wc_insols = (c ~ [c]) [D] }
For some reason, e.g. because we floated an equality somewhere else,
......@@ -1515,7 +1515,7 @@ constraints the second time:
which will result in two Deriveds to end up in the insoluble set:
wc_flat = D [c] c [W]
wc_simple = D [c] c [W]
wc_insols = (c ~ [c]) [D], (c ~ [c]) [D]
-}
......@@ -1786,9 +1786,9 @@ deferTcSForAllEq role loc (tvs1,body1) (tvs2,body2)
new_ct = mkNonCanonical ctev
new_co = ctEvCoercion ctev
new_tclvl = pushTcLevel (tcl_tclvl env)
; let wc = WC { wc_flat = singleCt new_ct
, wc_impl = emptyBag
, wc_insol = emptyCts }
; let wc = WC { wc_simple = singleCt new_ct
, wc_impl = emptyBag
, wc_insol = emptyCts }
imp = Implic { ic_tclvl = new_tclvl
, ic_skols = skol_tvs
, ic_no_eqs = True
......
......@@ -149,7 +149,7 @@ Note [Top-level Defaulting Plan]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We have considered two design choices for where/when to apply defaulting.
(i) Do it in SimplCheck mode only /whenever/ you try to solve some
flat constraints, maybe deep inside the context of implications.
simple constraints, maybe deep inside the context of implications.
This used to be the case in GHC 7.4.1.
(ii) Do it in a tight loop at simplifyTop, once all other constraint has
finished. This is the current story.
......@@ -173,8 +173,8 @@ Option (i) had many disadvantages:
Instead our new defaulting story is to pull defaulting out of the solver loop and
go with option (i), implemented at SimplifyTop. Namely:
- First have a go at solving the residual constraint of the whole program
- Try to approximate it with a flat constraint
- Figure out derived defaulting equations for that flat constraint
- Try to approximate it with a simple constraint
- Figure out derived defaulting equations for that simple constraint
- Go round the loop again if you did manage to get some equations
Now, that has to do with class defaulting. However there exists type variable /kind/
......@@ -216,8 +216,8 @@ simplifyDefault :: ThetaType -- Wanted; has no type variables in it
-> TcM () -- Succeeds iff the constraint is soluble
simplifyDefault theta
= do { traceTc "simplifyInteractive" empty
; wanted <- newFlatWanteds DefaultOrigin theta
; (unsolved, _binds) <- solveWantedsTcM (mkFlatWC wanted)
; wanted <- newSimpleWanteds DefaultOrigin theta
; (unsolved, _binds) <- solveWantedsTcM (mkSimpleWC wanted)
; traceTc "reportUnsolved {" empty
-- See Note [Deferring coercion errors to runtime]
......@@ -328,14 +328,14 @@ simplifyInfer rhs_tclvl apply_mr name_taus wanteds
-- pick that up later.
; WC { wc_flat = flats }
; WC { wc_simple = simples }
<- setTcLevel rhs_tclvl $
runTcSWithEvBinds null_ev_binds_var $
do { mapM_ (promoteAndDefaultTyVar rhs_tclvl gbl_tvs) meta_tvs
-- See Note [Promote _and_ default when inferring]
; solveFlatWanteds quant_cand }
; solveSimpleWanteds quant_cand }
; return [ ctEvPred ev | ct <- bagToList flats
; return [ ctEvPred ev | ct <- bagToList simples
, let ev = ctEvidence ct
, isWanted ev ] }
......@@ -350,15 +350,15 @@ simplifyInfer rhs_tclvl apply_mr name_taus wanteds
; runTcSWithEvBinds null_ev_binds_var $ -- runTcS just to get the types right :-(
mapM_ (promoteTyVar outer_tclvl) (varSetElems promote_tvs)
; let minimal_flat_preds = mkMinimalBySCs bound
; let minimal_simple_preds = mkMinimalBySCs bound
-- See Note [Minimize by Superclasses]
skol_info = InferSkol [ (name, mkSigmaTy [] minimal_flat_preds ty)
skol_info = InferSkol [ (name, mkSigmaTy [] minimal_simple_preds ty)
| (name, ty) <- name_taus ]
-- Don't add the quantified variables here, because
-- they are also bound in ic_skols and we want them to be
-- tidied uniformly
; minimal_bound_ev_vars <- mapM TcM.newEvVar minimal_flat_preds
; minimal_bound_ev_vars <- mapM TcM.newEvVar minimal_simple_preds
; let implic = Implic { ic_tclvl = rhs_tclvl
, ic_skols = qtvs
, ic_no_eqs = False
......@@ -642,8 +642,8 @@ simplifyRule name lhs_wanted rhs_wanted
(resid_wanted, _) <- solveWantedsTcM (lhs_wanted `andWC` rhs_wanted)
-- Post: these are zonked and unflattened
; zonked_lhs_flats <- TcM.zonkFlats (wc_flat lhs_wanted)
; let (q_cts, non_q_cts) = partitionBag quantify_me zonked_lhs_flats
; zonked_lhs_simples <- TcM.zonkSimples (wc_simple lhs_wanted)
; let (q_cts, non_q_cts) = partitionBag quantify_me zonked_lhs_simples
quantify_me -- Note [RULE quantification over equalities]
| insolubleWC resid_wanted = quantify_insol
| otherwise = quantify_normal
......@@ -658,12 +658,12 @@ simplifyRule name lhs_wanted rhs_wanted
; traceTc "simplifyRule" $
vcat [ ptext (sLit "LHS of rule") <+> doubleQuotes (ftext name)
, text "zonked_lhs_flats" <+> ppr zonked_lhs_flats
, text "zonked_lhs_simples" <+> ppr zonked_lhs_simples
, text "q_cts" <+> ppr q_cts
, text "non_q_cts" <+> ppr non_q_cts ]
; return ( map (ctEvId . ctEvidence) (bagToList q_cts)
, lhs_wanted { wc_flat = non_q_cts }) }
, lhs_wanted { wc_simple = non_q_cts }) }
{-
*********************************************************************************
......@@ -755,22 +755,22 @@ solveWantedsAndDrop wanted = do { wc <- solveWanteds wanted
solveWanteds :: WantedConstraints -> TcS WantedConstraints
-- so that the inert set doesn't mindlessly propagate.
-- NB: wc_flats may be wanted /or/ derived now
-- NB: wc_simples may be wanted /or/ derived now
solveWanteds wanteds
= do { traceTcS "solveWanteds {" (ppr wanteds)
-- Try the flat bit, including insolubles. Solving insolubles a
-- Try the simple bit, including insolubles. Solving insolubles a
-- second time round is a bit of a waste; but the code is simple
-- and the program is wrong anyway, and we don't run the danger