summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRichard Eisenberg <eir@cis.upenn.edu>2014-12-10 16:58:09 -0500
committerRichard Eisenberg <eir@cis.upenn.edu>2014-12-12 17:25:23 -0500
commit8a0de692bd56b255adacc869e284424becdc9902 (patch)
tree8c5c2ac35fb86c749588757fc0b098dca0919b25
parent0cc47eb90805f3e166ac4d3991e66d3346ca05e7 (diff)
downloadhaskell-8a0de692bd56b255adacc869e284424becdc9902.tar.gz
Flat constraint --> Simple constraint
-rw-r--r--compiler/typecheck/Inst.hs6
-rw-r--r--compiler/typecheck/TcCanonical.hs2
-rw-r--r--compiler/typecheck/TcDeriv.hs8
-rw-r--r--compiler/typecheck/TcErrors.hs30
-rw-r--r--compiler/typecheck/TcInteract.hs50
-rw-r--r--compiler/typecheck/TcMType.hs28
-rw-r--r--compiler/typecheck/TcRnMonad.hs12
-rw-r--r--compiler/typecheck/TcRnTypes.hs42
-rw-r--r--compiler/typecheck/TcSMonad.hs20
-rw-r--r--compiler/typecheck/TcSimplify.hs102
-rw-r--r--compiler/typecheck/TcType.hs2
-rw-r--r--compiler/typecheck/TcUnify.hs2
12 files changed, 152 insertions, 152 deletions
diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs
index 2c1c9cc90b..79f8c6b295 100644
--- a/compiler/typecheck/Inst.hs
+++ b/compiler/typecheck/Inst.hs
@@ -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
diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs
index 0cc62e40c3..cc1197d748 100644
--- a/compiler/typecheck/TcCanonical.hs
+++ b/compiler/typecheck/TcCanonical.hs
@@ -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).
diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs
index 3d3eb5075a..8b7af86126 100644
--- a/compiler/typecheck/TcDeriv.hs
+++ b/compiler/typecheck/TcDeriv.hs
@@ -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) }
diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs
index f993f60bb5..3fdf4e967b 100644
--- a/compiler/typecheck/TcErrors.hs
+++ b/compiler/typecheck/TcErrors.hs
@@ -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,
diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs
index 475e4904c7..c67e437fe9 100644
--- a/compiler/typecheck/TcInteract.hs
+++ b/compiler/typecheck/TcInteract.hs
@@ -1,8 +1,8 @@
{-# 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
diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs
index 159635fd9f..90e0762761 100644
--- a/compiler/typecheck/TcMType.hs
+++ b/compiler/typecheck/TcMType.hs
@@ -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
diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs
index 31f753cecf..013b8a4ab0 100644
--- a/compiler/typecheck/TcRnMonad.hs
+++ b/compiler/typecheck/TcRnMonad.hs
@@ -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
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index be7d44def0..7ea9ae9622 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -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 ])
diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs
index 7c410b69a5..a0dda96f84 100644
--- a/compiler/typecheck/TcSMonad.hs
+++ b/compiler/typecheck/TcSMonad.hs
@@ -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
diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs
index ffe792ff79..7e9c408045 100644
--- a/compiler/typecheck/TcSimplify.hs
+++ b/compiler/typecheck/TcSimplify.hs
@@ -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
-- of adding Derived insolubles twice; see
-- TcSMonad Note [Do not add duplicate derived insolubles]
- ; traceTcS "solveFlats {" empty
- ; solved_flats_wanteds <- solveFlats wanteds
- ; traceTcS "solveFlats end }" (ppr solved_flats_wanteds)
+ ; traceTcS "solveSimples {" empty
+ ; solved_simples_wanteds <- solveSimples wanteds
+ ; traceTcS "solveSimples end }" (ppr solved_simples_wanteds)
-- solveWanteds iterates when it is able to float equalities
-- equalities out of one or more of the implications.
- ; final_wanteds <- simpl_loop 1 solved_flats_wanteds
+ ; final_wanteds <- simpl_loop 1 solved_simples_wanteds
; bb <- getTcEvBindsMap
; traceTcS "solveWanteds }" $
@@ -779,21 +779,21 @@ solveWanteds wanteds
; return final_wanteds }
-solveFlats :: WantedConstraints -> TcS WantedConstraints
--- Solve the wc_flat and wc_insol components of the WantedConstraints
+solveSimples :: WantedConstraints -> TcS WantedConstraints
+-- Solve the wc_simple and wc_insol components of the WantedConstraints
-- Do not affect the inerts
-solveFlats (WC { wc_flat = flats, wc_insol = insols, wc_impl = implics })
+solveSimples (WC { wc_simple = simples, wc_insol = insols, wc_impl = implics })
= nestTcS $
- do { let all_flats = flats `unionBags` filterBag (not . isDerivedCt) insols
+ do { let all_simples = simples `unionBags` filterBag (not . isDerivedCt) insols
-- See Note [Dropping derived constraints] in TcRnTypes for
-- why the insolubles may have derived constraints
- ; wc <- solveFlatWanteds all_flats
+ ; wc <- solveSimpleWanteds all_simples
; return ( wc { wc_impl = implics `unionBags` wc_impl wc } ) }
simpl_loop :: Int
-> WantedConstraints
-> TcS WantedConstraints
-simpl_loop n wanteds@(WC { wc_flat = flats, wc_insol = insols, wc_impl = implics })
+simpl_loop n wanteds@(WC { wc_simple = simples, wc_insol = insols, wc_impl = implics })
| n > 10
= do { traceTcS "solveWanteds: loop!" empty
; return wanteds }
@@ -807,25 +807,25 @@ simpl_loop n wanteds@(WC { wc_flat = flats, wc_insol = insols, wc_impl = implics
else
do { -- Put floated_eqs into the current inert set before looping
- (unifs_happened, solve_flat_res)
+ (unifs_happened, solve_simple_res)
<- reportUnifications $
- solveFlats (WC { wc_flat = floated_eqs `unionBags` flats
+ solveSimples (WC { wc_simple = floated_eqs `unionBags` simples
-- Put floated_eqs first so they get solved first
- , wc_insol = emptyBag, wc_impl = emptyBag })
+ , wc_insol = emptyBag, wc_impl = emptyBag })
- ; let new_wanteds = solve_flat_res `andWC`
- WC { wc_flat = emptyBag
- , wc_insol = insols
- , wc_impl = unsolved_implics }
+ ; let new_wanteds = solve_simple_res `andWC`
+ WC { wc_simple = emptyBag
+ , wc_insol = insols
+ , wc_impl = unsolved_implics }
; if not unifs_happened -- See Note [Cutting off simpl_loop]
- && isEmptyBag (wc_impl solve_flat_res)
+ && isEmptyBag (wc_impl solve_simple_res)
then return new_wanteds
else simpl_loop (n+1) new_wanteds } }
solveNestedImplications :: Bag Implication
-> TcS (Cts, Bag Implication)
--- Precondition: the TcS inerts may contain unsolved flats which have
+-- Precondition: the TcS inerts may contain unsolved simples which have
-- to be converted to givens before we go inside a nested implication.
solveNestedImplications implics
| isEmptyBag implics
@@ -844,7 +844,7 @@ solveNestedImplications implics
<- flatMapBagPairM solveImplication implics
-- ... and we are back in the original TcS inerts
- -- Notice that the original includes the _insoluble_flats so it was safe to ignore
+ -- Notice that the original includes the _insoluble_simples so it was safe to ignore
-- them in the beginning of this function.
; traceTcS "solveNestedImplications end }" $
vcat [ text "all floated_eqs =" <+> ppr floated_eqs
@@ -870,7 +870,7 @@ solveImplication imp@(Implic { ic_tclvl = tclvl
-- Solve the nested constraints
; (no_given_eqs, residual_wanted)
<- nestImplicTcS ev_binds tclvl $
- do { solveFlatGivens (mkGivenLoc tclvl info env) givens
+ do { solveSimpleGivens (mkGivenLoc tclvl info env) givens
; residual_wanted <- solveWanteds wanteds
-- solveWanteds, *not* solveWantedsAndDrop, because
@@ -986,14 +986,14 @@ approximateWC wc
= float_wc emptyVarSet wc
where
float_wc :: TcTyVarSet -> WantedConstraints -> Cts
- float_wc trapping_tvs (WC { wc_flat = flats, wc_impl = implics })
- = filterBag is_floatable flats `unionBags`
+ float_wc trapping_tvs (WC { wc_simple = simples, wc_impl = implics })
+ = filterBag is_floatable simples `unionBags`
do_bag (float_implic new_trapping_tvs) implics
where
new_trapping_tvs = fixVarSet grow trapping_tvs
is_floatable ct = tyVarsOfCt ct `disjointVarSet` new_trapping_tvs
- grow tvs = foldrBag grow_one tvs flats
+ grow tvs = foldrBag grow_one tvs simples
grow_one ct tvs | ct_tvs `intersectsVarSet` tvs = tvs `unionVarSet` ct_tvs
| otherwise = tvs
where
@@ -1015,8 +1015,8 @@ Note [ApproximateWC]
~~~~~~~~~~~~~~~~~~~~
approximateWC takes a constraint, typically arising from the RHS of a
let-binding whose type we are *inferring*, and extracts from it some
-*flat* constraints that we might plausibly abstract over. Of course
-the top-level flat constraints are plausible, but we also float constraints
+*simple* constraints that we might plausibly abstract over. Of course
+the top-level simple constraints are plausible, but we also float constraints
out from inside, if they are not captured by skolems.
The same function is used when doing type-class defaulting (see the call
@@ -1225,7 +1225,7 @@ floatEqualities :: [TcTyVar] -> Bool
-> TcS (Cts, WantedConstraints)
-- Main idea: see Note [Float Equalities out of Implications]
--
--- Precondition: the wc_flat of the incoming WantedConstraints are
+-- Precondition: the wc_simple of the incoming WantedConstraints are
-- fully zonked, so that we can see their free variables
--
-- Postcondition: The returned floated constraints (Cts) are only
@@ -1238,7 +1238,7 @@ floatEqualities :: [TcTyVar] -> Bool
--
-- Subtleties: Note [Float equalities from under a skolem binding]
-- Note [Skolem escape]
-floatEqualities skols no_given_eqs wanteds@(WC { wc_flat = flats })
+floatEqualities skols no_given_eqs wanteds@(WC { wc_simple = simples })
| not no_given_eqs -- There are some given equalities, so don't float
= return (emptyBag, wanteds) -- Note [Float Equalities out of Implications]
| otherwise
@@ -1246,12 +1246,12 @@ floatEqualities skols no_given_eqs wanteds@(WC { wc_flat = flats })
; mapM_ (promoteTyVar outer_tclvl) (varSetElems (tyVarsOfCts float_eqs))
-- See Note [Promoting unification variables]
; traceTcS "floatEqualities" (vcat [ text "Skols =" <+> ppr skols
- , text "Flats =" <+> ppr flats
+ , text "Simples =" <+> ppr simples
, text "Floated eqs =" <+> ppr float_eqs ])
- ; return (float_eqs, wanteds { wc_flat = remaining_flats }) }
+ ; return (float_eqs, wanteds { wc_simple = remaining_simples }) }
where
skol_set = mkVarSet skols
- (float_eqs, remaining_flats) = partitionBag float_me flats
+ (float_eqs, remaining_simples) = partitionBag float_me simples
float_me :: Ct -> Bool
float_me ct -- The constraint is un-flattened and de-cannonicalised
@@ -1289,7 +1289,7 @@ twice. So we refrain from floating such equalities
Note [Float equalities from under a skolem binding]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Which of the flat equalities can we float out? Obviously, only
+Which of the simple equalities can we float out? Obviously, only
ones that don't mention the skolem-bound variables. But that is
over-eager. Consider
[2] forall a. F a beta[1] ~ gamma[2], G beta[1] gamma[2] ~ Int
@@ -1426,8 +1426,8 @@ disambigGroup (default_ty:default_tys) group
; given_ev_var <- TcS.newEvVar (mkTcEqPred (mkTyVarTy the_tv) default_ty)
; tclvl <- TcS.getTcLevel
; success <- nestImplicTcS fake_ev_binds_var (pushTcLevel tclvl) $
- do { solveFlatGivens loc [given_ev_var]
- ; residual_wanted <- solveFlatWanteds wanteds
+ do { solveSimpleGivens loc [given_ev_var]
+ ; residual_wanted <- solveSimpleWanteds wanteds
; return (isEmptyWC residual_wanted) }
; if success then
diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs
index 2da1f9f15a..7859203ad6 100644
--- a/compiler/typecheck/TcType.hs
+++ b/compiler/typecheck/TcType.hs
@@ -467,7 +467,7 @@ The same idea of only unifying touchables solves another problem.
Suppose we had
(F Int ~ uf[0]) /\ [1](forall a. C a => F Int ~ beta[1])
In this example, beta is touchable inside the implication. The
-first solveFlatWanteds step leaves 'uf' un-unified. Then we move inside
+first solveSimpleWanteds step leaves 'uf' un-unified. Then we move inside
the implication where a new constraint
uf ~ beta
emerges. If we (wrongly) spontaneously solved it to get uf := beta,
diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs
index 5c807693c1..5d8ef5d438 100644
--- a/compiler/typecheck/TcUnify.hs
+++ b/compiler/typecheck/TcUnify.hs
@@ -670,7 +670,7 @@ uType, uType_defer
uType_defer origin ty1 ty2
= do { eqv <- newEq ty1 ty2
; loc <- getCtLoc origin
- ; emitFlat $ mkNonCanonical $
+ ; emitSimple $ mkNonCanonical $
CtWanted { ctev_evar = eqv
, ctev_pred = mkTcEqPred ty1 ty2
, ctev_loc = loc }