-Note [Implicit parameters and ambiguity]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Only a *class* predicate can give rise to ambiguity
-An *implicit parameter* cannot. For example:
- foo :: (?x :: [a]) => Int
- foo = length ?x
-is fine. The call site will suppply a particular 'x'
-
-Furthermore, the type variables fixed by an implicit parameter
-propagate to the others. E.g.
- foo :: (Show a, ?x::[a]) => Int
- foo = show (?x++?x)
-The type of foo looks ambiguous. But it isn't, because at a call site
-we might have
- let ?x = 5::Int in foo
-and all is well. In effect, implicit parameters are, well, parameters,
-so we can take their type variables into account as part of the
-"tau-tvs" stuff. This is done in the function 'FunDeps.grow'.
-
-
-Question 2: type signatures
-~~~~~~~~~~~~~~~~~~~~~~~~~~~
-BUT WATCH OUT: When you supply a type signature, we can't force you
-to quantify over implicit parameters. For example:
-
- (?x + 1) :: Int
-
-This is perfectly reasonable. We do not want to insist on
-
- (?x + 1) :: (?x::Int => Int)
-
-That would be silly. Here, the definition site *is* the occurrence site,
-so the above strictures don't apply. Hence the difference between
-tcSimplifyCheck (which *does* allow implicit paramters to be inherited)
-and tcSimplifyCheckBind (which does not).
-
-What about when you supply a type signature for a binding?
-Is it legal to give the following explicit, user type
-signature to f, thus:
-
- f :: Int -> Int
- f x = (x::Int) + ?y
-
-At first sight this seems reasonable, but it has the nasty property
-that adding a type signature changes the dynamic semantics.
-Consider this:
-
- (let f x = (x::Int) + ?y
- in (f 3, f 3 with ?y=5)) with ?y = 6
-
- returns (3+6, 3+5)
-vs
- (let f :: Int -> Int
- f x = x + ?y
- in (f 3, f 3 with ?y=5)) with ?y = 6
-
- returns (3+6, 3+6)
-
-Indeed, simply inlining f (at the Haskell source level) would change the
-dynamic semantics.
-
-Nevertheless, as Launchbury says (email Oct 01) we can't really give the
-semantics for a Haskell program without knowing its typing, so if you
-change the typing you may change the semantics.
-
-To make things consistent in all cases where we are *checking* against
-a supplied signature (as opposed to inferring a type), we adopt the
-rule:
-
- a signature does not need to quantify over implicit params.
-
-[This represents a (rather marginal) change of policy since GHC 5.02,
-which *required* an explicit signature to quantify over all implicit
-params for the reasons mentioned above.]
-
-But that raises a new question. Consider
-
- Given (signature) ?x::Int
- Wanted (inferred) ?x::Int, ?y::Bool
-
-Clearly we want to discharge the ?x and float the ?y out. But
-what is the criterion that distinguishes them? Clearly it isn't
-what free type variables they have. The Right Thing seems to be
-to float a constraint that
- neither mentions any of the quantified type variables
- nor any of the quantified implicit parameters
-
-See the predicate isFreeWhenChecking.
-
-
-Question 3: monomorphism
-~~~~~~~~~~~~~~~~~~~~~~~~
-There's a nasty corner case when the monomorphism restriction bites:
-
- z = (x::Int) + ?y
-
-The argument above suggests that we *must* generalise
-over the ?y parameter, to get
- z :: (?y::Int) => Int,
-but the monomorphism restriction says that we *must not*, giving
- z :: Int.
-Why does the momomorphism restriction say this? Because if you have
-
- let z = x + ?y in z+z
-
-you might not expect the addition to be done twice --- but it will if
-we follow the argument of Question 2 and generalise over ?y.
-
-
-Question 4: top level
-~~~~~~~~~~~~~~~~~~~~~
-At the top level, monomorhism makes no sense at all.
-
- module Main where
- main = let ?x = 5 in print foo
-
- foo = woggle 3
-
- woggle :: (?x :: Int) => Int -> Int
- woggle y = ?x + y
-
-We definitely don't want (foo :: Int) with a top-level implicit parameter
-(?x::Int) becuase there is no way to bind it.
-
-
-Possible choices
-~~~~~~~~~~~~~~~~
-(A) Always generalise over implicit parameters
- Bindings that fall under the monomorphism restriction can't
- be generalised
-
- Consequences:
- * Inlining remains valid
- * No unexpected loss of sharing
- * But simple bindings like
- z = ?y + 1
- will be rejected, unless you add an explicit type signature
- (to avoid the monomorphism restriction)
- z :: (?y::Int) => Int
- z = ?y + 1
- This seems unacceptable
-
-(B) Monomorphism restriction "wins"
- Bindings that fall under the monomorphism restriction can't
- be generalised
- Always generalise over implicit parameters *except* for bindings
- that fall under the monomorphism restriction
-
- Consequences
- * Inlining isn't valid in general
- * No unexpected loss of sharing
- * Simple bindings like
- z = ?y + 1
- accepted (get value of ?y from binding site)
-
-(C) Always generalise over implicit parameters
- Bindings that fall under the monomorphism restriction can't
- be generalised, EXCEPT for implicit parameters
- Consequences
- * Inlining remains valid
- * Unexpected loss of sharing (from the extra generalisation)
- * Simple bindings like
- z = ?y + 1
- accepted (get value of ?y from occurrence sites)
-
-
-Discussion
-~~~~~~~~~~
-None of these choices seems very satisfactory. But at least we should
-decide which we want to do.
-
-It's really not clear what is the Right Thing To Do. If you see
-
- z = (x::Int) + ?y
-
-would you expect the value of ?y to be got from the *occurrence sites*
-of 'z', or from the valuue of ?y at the *definition* of 'z'? In the
-case of function definitions, the answer is clearly the former, but
-less so in the case of non-fucntion definitions. On the other hand,
-if we say that we get the value of ?y from the definition site of 'z',
-then inlining 'z' might change the semantics of the program.
-
-Choice (C) really says "the monomorphism restriction doesn't apply
-to implicit parameters". Which is fine, but remember that every
-innocent binding 'x = ...' that mentions an implicit parameter in
-the RHS becomes a *function* of that parameter, called at each
-use of 'x'. Now, the chances are that there are no intervening 'with'
-clauses that bind ?y, so a decent compiler should common up all
-those function calls. So I think I strongly favour (C). Indeed,
-one could make a similar argument for abolishing the monomorphism
-restriction altogether.
-
-BOTTOM LINE: we choose (B) at present. See tcSimplifyRestricted
-
-
-
-%************************************************************************
-%* *
-\subsection{tcSimplifyInfer}
-%* *
-%************************************************************************
-
-tcSimplify is called when we *inferring* a type. Here's the overall game plan:
-
- 1. Compute Q = grow( fvs(T), C )
-
- 2. Partition C based on Q into Ct and Cq. Notice that ambiguous
- predicates will end up in Ct; we deal with them at the top level
-
- 3. Try improvement, using functional dependencies
-
- 4. If Step 3 did any unification, repeat from step 1
- (Unification can change the result of 'grow'.)
-
-Note: we don't reduce dictionaries in step 2. For example, if we have
-Eq (a,b), we don't simplify to (Eq a, Eq b). So Q won't be different
-after step 2. However note that we may therefore quantify over more
-type variables than we absolutely have to.
-
-For the guts, we need a loop, that alternates context reduction and
-improvement with unification. E.g. Suppose we have
-
- class C x y | x->y where ...
-
-and tcSimplify is called with:
- (C Int a, C Int b)
-Then improvement unifies a with b, giving
- (C Int a, C Int a)
-
-If we need to unify anything, we rattle round the whole thing all over
-again.
-
-
-\begin{code}
-tcSimplifyInfer
- :: SDoc
- -> TcTyVarSet -- fv(T); type vars
- -> [Inst] -- Wanted
- -> TcM ([TcTyVar], -- Tyvars to quantify (zonked and quantified)
- [Inst], -- Dict Ids that must be bound here (zonked)
- TcDictBinds) -- Bindings
- -- Any free (escaping) Insts are tossed into the environment
-\end{code}
-
-
-\begin{code}
-tcSimplifyInfer doc tau_tvs wanted
- = do { tau_tvs1 <- zonkTcTyVarsAndFV (varSetElems tau_tvs)
- ; wanted' <- mapM zonkInst wanted -- Zonk before deciding quantified tyvars
- ; gbl_tvs <- tcGetGlobalTyVars
- ; let preds1 = fdPredsOfInsts wanted'
- gbl_tvs1 = oclose preds1 gbl_tvs
- qtvs = growInstsTyVars wanted' tau_tvs1 `minusVarSet` gbl_tvs1
- -- See Note [Choosing which variables to quantify]
-
- -- To maximise sharing, remove from consideration any
- -- constraints that don't mention qtvs at all
- ; let (free, bound) = partition (isFreeWhenInferring qtvs) wanted'
- ; extendLIEs free
-
- -- To make types simple, reduce as much as possible
- ; traceTc (text "infer" <+> (ppr preds1 $$ ppr (growInstsTyVars wanted' tau_tvs1) $$ ppr gbl_tvs $$
- ppr gbl_tvs1 $$ ppr free $$ ppr bound))
- ; (irreds1, binds1) <- tryHardCheckLoop doc bound
-
- -- Note [Inference and implication constraints]
- ; let want_dict d = tyVarsOfInst d `intersectsVarSet` qtvs
- ; (irreds2, binds2) <- approximateImplications doc want_dict irreds1
-
- -- Now work out all over again which type variables to quantify,
- -- exactly in the same way as before, but starting from irreds2. Why?
- -- a) By now improvment may have taken place, and we must *not*
- -- quantify over any variable free in the environment
- -- tc137 (function h inside g) is an example
- --
- -- b) Do not quantify over constraints that *now* do not
- -- mention quantified type variables, because they are
- -- simply ambiguous (or might be bound further out). Example:
- -- f :: Eq b => a -> (a, b)
- -- g x = fst (f x)
- -- From the RHS of g we get the MethodInst f77 :: alpha -> (alpha, beta)
- -- We decide to quantify over 'alpha' alone, but free1 does not include f77
- -- because f77 mentions 'alpha'. Then reducing leaves only the (ambiguous)
- -- constraint (Eq beta), which we dump back into the free set
- -- See test tcfail181
- --
- -- c) irreds may contain type variables not previously mentioned,
- -- e.g. instance D a x => Foo [a]
- -- wanteds = Foo [a]
- -- Then after simplifying we'll get (D a x), and x is fresh
- -- We must quantify over x else it'll be totally unbound
- ; tau_tvs2 <- zonkTcTyVarsAndFV (varSetElems tau_tvs1)
- ; gbl_tvs2 <- zonkTcTyVarsAndFV (varSetElems gbl_tvs1)
- -- Note that we start from gbl_tvs1
- -- We use tcGetGlobalTyVars, then oclose wrt preds2, because
- -- we've already put some of the original preds1 into frees
- -- E.g. wanteds = C a b (where a->b)
- -- gbl_tvs = {a}
- -- tau_tvs = {b}
- -- Then b is fixed by gbl_tvs, so (C a b) will be in free, and
- -- irreds2 will be empty. But we don't want to generalise over b!
- ; let preds2 = fdPredsOfInsts irreds2 -- irreds2 is zonked
- qtvs = growInstsTyVars irreds2 tau_tvs2 `minusVarSet` oclose preds2 gbl_tvs2
- ---------------------------------------------------
- -- BUG WARNING: there's a nasty bug lurking here
- -- fdPredsOfInsts may return preds that mention variables quantified in
- -- one of the implication constraints in irreds2; and that is clearly wrong:
- -- we might quantify over too many variables through accidental capture
- ---------------------------------------------------
- ; let (free, irreds3) = partition (isFreeWhenInferring qtvs) irreds2
- ; extendLIEs free
-
- -- Turn the quantified meta-type variables into real type variables
- ; qtvs2 <- zonkQuantifiedTyVars (varSetElems qtvs)
-
- -- We can't abstract over any remaining unsolved
- -- implications so instead just float them outwards. Ugh.
- ; let (q_dicts0, implics) = partition isAbstractableInst irreds3
- ; loc <- getInstLoc (ImplicOrigin doc)
- ; implic_bind <- bindIrreds loc qtvs2 q_dicts0 implics
-
- -- Prepare equality instances for quantification
- ; let (q_eqs0,q_dicts) = partition isEqInst q_dicts0
- ; q_eqs <- mapM finalizeEqInst q_eqs0
-
- ; return (qtvs2, q_eqs ++ q_dicts, binds1 `unionBags` binds2 `unionBags` implic_bind) }
- -- NB: when we are done, we might have some bindings, but
- -- the final qtvs might be empty. See Note [NO TYVARS] below.
-
-approximateImplications :: SDoc -> (Inst -> Bool) -> [Inst] -> TcM ([Inst], TcDictBinds)
--- Note [Inference and implication constraints]
--- Given a bunch of Dict and ImplicInsts, try to approximate the implications by
--- - fetching any dicts inside them that are free
--- - using those dicts as cruder constraints, to solve the implications
--- - returning the extra ones too
-
-approximateImplications doc want_dict irreds
- | null extra_dicts
- = return (irreds, emptyBag)
- | otherwise
- = do { extra_dicts' <- mapM cloneDict extra_dicts
- ; tryHardCheckLoop doc (extra_dicts' ++ irreds) }
- -- By adding extra_dicts', we make them
- -- available to solve the implication constraints
- where
- extra_dicts = get_dicts (filter isImplicInst irreds)
-
- get_dicts :: [Inst] -> [Inst] -- Returns only Dicts
- -- Find the wanted constraints in implication constraints that satisfy
- -- want_dict, and are not bound by forall's in the constraint itself
- get_dicts ds = concatMap get_dict ds
-
- get_dict d@(Dict {}) | want_dict d = [d]
- | otherwise = []
- get_dict (ImplicInst {tci_tyvars = tvs, tci_wanted = wanteds})
- = [ d | let tv_set = mkVarSet tvs
- , d <- get_dicts wanteds
- , not (tyVarsOfInst d `intersectsVarSet` tv_set)]
- get_dict i@(EqInst {}) | want_dict i = [i]
- | otherwise = []
- get_dict other = pprPanic "approximateImplications" (ppr other)
-\end{code}
-
-Note [Inference and implication constraints]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Suppose we have a wanted implication constraint (perhaps arising from
-a nested pattern match) like
- C a => D [a]
-and we are now trying to quantify over 'a' when inferring the type for
-a function. In principle it's possible that there might be an instance
- instance (C a, E a) => D [a]
-so the context (E a) would suffice. The Right Thing is to abstract over
-the implication constraint, but we don't do that (a) because it'll be
-surprising to programmers and (b) because we don't have the machinery to deal
-with 'given' implications.
-
-So our best approximation is to make (D [a]) part of the inferred
-context, so we can use that to discharge the implication. Hence
-the strange function get_dicts in approximateImplications.
-
-The common cases are more clear-cut, when we have things like
- forall a. C a => C b
-Here, abstracting over (C b) is not an approximation at all -- but see
-Note [Freeness and implications].
-
-See Trac #1430 and test tc228.
-
-
-\begin{code}
------------------------------------------------------------
--- tcSimplifyInferCheck is used when we know the constraints we are to simplify
--- against, but we don't know the type variables over which we are going to quantify.
--- This happens when we have a type signature for a mutually recursive group
-tcSimplifyInferCheck
- :: InstLoc
- -> TcTyVarSet -- fv(T)
- -> [Inst] -- Given
- -> [Inst] -- Wanted
- -> TcM ([TyVar], -- Fully zonked, and quantified
- TcDictBinds) -- Bindings
-
-tcSimplifyInferCheck loc tau_tvs givens wanteds
- = do { traceTc (text "tcSimplifyInferCheck <-" <+> ppr wanteds)
- ; (irreds, binds) <- gentleCheckLoop loc givens wanteds
-
- -- Figure out which type variables to quantify over
- -- You might think it should just be the signature tyvars,
- -- but in bizarre cases you can get extra ones
- -- f :: forall a. Num a => a -> a
- -- f x = fst (g (x, head [])) + 1
- -- g a b = (b,a)
- -- Here we infer g :: forall a b. a -> b -> (b,a)
- -- We don't want g to be monomorphic in b just because
- -- f isn't quantified over b.
- ; let all_tvs = varSetElems (tau_tvs `unionVarSet` tyVarsOfInsts givens)
- ; all_tvs <- zonkTcTyVarsAndFV all_tvs
- ; gbl_tvs <- tcGetGlobalTyVars
- ; let qtvs = varSetElems (all_tvs `minusVarSet` gbl_tvs)
- -- We could close gbl_tvs, but its not necessary for
- -- soundness, and it'll only affect which tyvars, not which
- -- dictionaries, we quantify over
-
- ; qtvs' <- zonkQuantifiedTyVars qtvs
-
- -- Now we are back to normal (c.f. tcSimplCheck)
- ; implic_bind <- bindIrreds loc qtvs' givens irreds
-
- ; traceTc (text "tcSimplifyInferCheck ->" <+> ppr (implic_bind))
- ; return (qtvs', binds `unionBags` implic_bind) }
-\end{code}
-
-Note [Squashing methods]
-~~~~~~~~~~~~~~~~~~~~~~~~~
-Be careful if you want to float methods more:
- truncate :: forall a. RealFrac a => forall b. Integral b => a -> b
-From an application (truncate f i) we get
- t1 = truncate at f
- t2 = t1 at i
-If we have also have a second occurrence of truncate, we get
- t3 = truncate at f
- t4 = t3 at i
-When simplifying with i,f free, we might still notice that
-t1=t3; but alas, the binding for t2 (which mentions t1)
-may continue to float out!
-
-
-Note [NO TYVARS]
-~~~~~~~~~~~~~~~~~
- class Y a b | a -> b where
- y :: a -> X b
-
- instance Y [[a]] a where
- y ((x:_):_) = X x
-
- k :: X a -> X a -> X a
-
- g :: Num a => [X a] -> [X a]
- g xs = h xs
- where
- h ys = ys ++ map (k (y [[0]])) xs
-
-The excitement comes when simplifying the bindings for h. Initially
-try to simplify {y @ [[t1]] t2, 0 @ t1}, with initial qtvs = {t2}.
-From this we get t1~t2, but also various bindings. We can't forget
-the bindings (because of [LOOP]), but in fact t1 is what g is
-polymorphic in.
-
-The net effect of [NO TYVARS]
-
-\begin{code}
-isFreeWhenInferring :: TyVarSet -> Inst -> Bool
-isFreeWhenInferring qtvs inst
- = isFreeWrtTyVars qtvs inst -- Constrains no quantified vars
- && isInheritableInst inst -- and no implicit parameter involved
- -- see Note [Inheriting implicit parameters]
-
-{- No longer used (with implication constraints)
-isFreeWhenChecking :: TyVarSet -- Quantified tyvars
- -> NameSet -- Quantified implicit parameters
- -> Inst -> Bool
-isFreeWhenChecking qtvs ips inst
- = isFreeWrtTyVars qtvs inst
- && isFreeWrtIPs ips inst
--}
-
-isFreeWrtTyVars :: VarSet -> Inst -> Bool
-isFreeWrtTyVars qtvs inst = tyVarsOfInst inst `disjointVarSet` qtvs
-isFreeWrtIPs :: NameSet -> Inst -> Bool
-isFreeWrtIPs ips inst = not (any (`elemNameSet` ips) (ipNamesOfInst inst))
-\end{code}
-
-
-%************************************************************************
-%* *
-\subsection{tcSimplifyCheck}
-%* *
-%************************************************************************
-
-@tcSimplifyCheck@ is used when we know exactly the set of variables
-we are going to quantify over. For example, a class or instance declaration.
-
-\begin{code}
------------------------------------------------------------
--- tcSimplifyCheck is used when checking expression type signatures,
--- class decls, instance decls etc.
-tcSimplifyCheck :: InstLoc
- -> [TcTyVar] -- Quantify over these
- -> [Inst] -- Given
- -> [Inst] -- Wanted
- -> TcM TcDictBinds -- Bindings
-tcSimplifyCheck loc qtvs givens wanteds
- = ASSERT( all isTcTyVar qtvs && all isSkolemTyVar qtvs )
- do { traceTc (text "tcSimplifyCheck")
- ; (irreds, binds) <- gentleCheckLoop loc givens wanteds
- ; implic_bind <- bindIrreds loc qtvs givens irreds
- ; return (binds `unionBags` implic_bind) }
-
------------------------------------------------------------
--- tcSimplifyCheckPat is used for existential pattern match
-tcSimplifyCheckPat :: InstLoc
- -> [TcTyVar] -- Quantify over these
- -> [Inst] -- Given
- -> [Inst] -- Wanted
- -> TcM TcDictBinds -- Bindings
-tcSimplifyCheckPat loc qtvs givens wanteds
- = ASSERT( all isTcTyVar qtvs && all isSkolemTyVar qtvs )
- do { traceTc (text "tcSimplifyCheckPat")
- ; (irreds, binds) <- gentleCheckLoop loc givens wanteds
- ; implic_bind <- bindIrredsR loc qtvs givens irreds
- ; return (binds `unionBags` implic_bind) }
-
------------------------------------------------------------
-bindIrreds :: InstLoc -> [TcTyVar]
- -> [Inst] -> [Inst]
- -> TcM TcDictBinds
-bindIrreds loc qtvs givens irreds
- = bindIrredsR loc qtvs givens irreds
-
-bindIrredsR :: InstLoc -> [TcTyVar] -> [Inst] -> [Inst] -> TcM TcDictBinds
--- Make a binding that binds 'irreds', by generating an implication
--- constraint for them, *and* throwing the constraint into the LIE
-bindIrredsR loc qtvs givens irreds
- | null irreds
- = return emptyBag
- | otherwise
- = do { let givens' = filter isAbstractableInst givens
- -- The givens can (redundantly) include methods
- -- We want to retain both EqInsts and Dicts
- -- There should be no implicadtion constraints
- -- See Note [Pruning the givens in an implication constraint]
-
- -- If there are no 'givens', then it's safe to
- -- partition the 'wanteds' by their qtvs, thereby trimming irreds
- -- See Note [Freeness and implications]
- ; irreds' <- if null givens'
- then do
- { let qtv_set = mkVarSet qtvs
- (frees, real_irreds) = partition (isFreeWrtTyVars qtv_set) irreds
- ; extendLIEs frees
- ; return real_irreds }
- else return irreds
-
- ; (implics, bind) <- makeImplicationBind loc qtvs givens' irreds'
- -- This call does the real work
- -- If irreds' is empty, it does something sensible
- ; extendLIEs implics
- ; return bind }
-
-
-makeImplicationBind :: InstLoc -> [TcTyVar]
- -> [Inst] -> [Inst]
- -> TcM ([Inst], TcDictBinds)
--- Make a binding that binds 'irreds', by generating an implication
--- constraint for them.
---
--- The binding looks like
--- (ir1, .., irn) = f qtvs givens
--- where f is (evidence for) the new implication constraint
--- f :: forall qtvs. givens => (ir1, .., irn)
--- qtvs includes coercion variables
---
--- This binding must line up the 'rhs' in reduceImplication
-makeImplicationBind loc all_tvs
- givens -- Guaranteed all Dicts or EqInsts
- irreds
- | null irreds -- If there are no irreds, we are done
- = return ([], emptyBag)
- | otherwise -- Otherwise we must generate a binding
- = do { uniq <- newUnique
- ; span <- getSrcSpanM
- ; let (eq_givens, dict_givens) = partition isEqInst givens
-
- -- extract equality binders
- eq_cotvs = map eqInstType eq_givens
-
- -- make the implication constraint instance
- name = mkInternalName uniq (mkVarOcc "ic") span
- implic_inst = ImplicInst { tci_name = name,
- tci_tyvars = all_tvs,
- tci_given = eq_givens ++ dict_givens,
- -- same order as binders
- tci_wanted = irreds,
- tci_loc = loc }
-
- -- create binders for the irreducible dictionaries
- dict_irreds = filter (not . isEqInst) irreds
- dict_irred_ids = map instToId dict_irreds
- lpat = mkBigLHsPatTup (map (L span . VarPat) dict_irred_ids)
-
- -- create the binding
- rhs = L span (mkHsWrap co (HsVar (instToId implic_inst)))
- co = mkWpApps (map instToId dict_givens)
- <.> mkWpTyApps eq_cotvs
- <.> mkWpTyApps (mkTyVarTys all_tvs)
- bind | [dict_irred_id] <- dict_irred_ids
- = mkVarBind dict_irred_id rhs
- | otherwise
- = L span $
- PatBind { pat_lhs = lpat
- , pat_rhs = unguardedGRHSs rhs
- , pat_rhs_ty = hsLPatType lpat
- , bind_fvs = placeHolderNames
- }
-
- ; traceTc $ text "makeImplicationBind" <+> ppr implic_inst
- ; return ([implic_inst], unitBag bind)
- }
-
------------------------------------------------------------
-tryHardCheckLoop :: SDoc
- -> [Inst] -- Wanted
- -> TcM ([Inst], TcDictBinds)
-
-tryHardCheckLoop doc wanteds
- = do { (irreds,binds) <- checkLoop (mkInferRedEnv doc try_me) wanteds
- ; return (irreds,binds)
- }
- where
- try_me _ = ReduceMe
- -- Here's the try-hard bit
-
------------------------------------------------------------
-gentleCheckLoop :: InstLoc
- -> [Inst] -- Given
- -> [Inst] -- Wanted
- -> TcM ([Inst], TcDictBinds)
-
-gentleCheckLoop inst_loc givens wanteds
- = do { (irreds,binds) <- checkLoop env wanteds
- ; return (irreds,binds)
- }
- where
- env = mkRedEnv (pprInstLoc inst_loc) try_me givens
-
- try_me inst | isMethodOrLit inst = ReduceMe
- | otherwise = Stop
- -- When checking against a given signature
- -- we MUST be very gentle: Note [Check gently]
-
-gentleInferLoop :: SDoc -> [Inst]
- -> TcM ([Inst], TcDictBinds)
-gentleInferLoop doc wanteds
- = do { (irreds, binds) <- checkLoop env wanteds
- ; return (irreds, binds) }
- where
- env = mkInferRedEnv doc try_me
- try_me inst | isMethodOrLit inst = ReduceMe
- | otherwise = Stop
-\end{code}
-
-Note [Check gently]
-~~~~~~~~~~~~~~~~~~~~
-We have to very careful about not simplifying too vigorously
-Example:
- data T a where
- MkT :: a -> T [a]
-
- f :: Show b => T b -> b
- f (MkT x) = show [x]
-
-Inside the pattern match, which binds (a:*, x:a), we know that
- b ~ [a]
-Hence we have a dictionary for Show [a] available; and indeed we
-need it. We are going to build an implication contraint
- forall a. (b~[a]) => Show [a]
-Later, we will solve this constraint using the knowledge (Show b)
-
-But we MUST NOT reduce (Show [a]) to (Show a), else the whole
-thing becomes insoluble. So we simplify gently (get rid of literals
-and methods only, plus common up equal things), deferring the real
-work until top level, when we solve the implication constraint
-with tryHardCheckLooop.
-
-
-\begin{code}
------------------------------------------------------------
-checkLoop :: RedEnv
- -> [Inst] -- Wanted
- -> TcM ([Inst], TcDictBinds)
--- Precondition: givens are completely rigid
--- Postcondition: returned Insts are zonked
-
-checkLoop env wanteds
- = go env wanteds
- where go env wanteds
- = do { -- We do need to zonk the givens; cf Note [Zonking RedEnv]
- ; env' <- zonkRedEnv env
- ; wanteds' <- zonkInsts wanteds
-
- ; (improved, tybinds, binds, irreds)
- <- reduceContext env' wanteds'
- ; execTcTyVarBinds tybinds
-
- ; if null irreds || not improved then
- return (irreds, binds)
- else do
-
- -- If improvement did some unification, we go round again.
- -- We start again with irreds, not wanteds
- -- Using an instance decl might have introduced a fresh type
- -- variable which might have been unified, so we'd get an
- -- infinite loop if we started again with wanteds!
- -- See Note [LOOP]
- { (irreds1, binds1) <- go env' irreds
- ; return (irreds1, binds `unionBags` binds1) } }
-\end{code}
-
-Note [Zonking RedEnv]
-~~~~~~~~~~~~~~~~~~~~~
-It might appear as if the givens in RedEnv are always rigid, but that is not
-necessarily the case for programs involving higher-rank types that have class
-contexts constraining the higher-rank variables. An example from tc237 in the
-testsuite is
-
- class Modular s a | s -> a
-
- wim :: forall a w. Integral a
- => a -> (forall s. Modular s a => M s w) -> w
- wim i k = error "urk"
-
- test5 :: (Modular s a, Integral a) => M s a
- test5 = error "urk"
-
- test4 = wim 4 test4'
-
-Notice how the variable 'a' of (Modular s a) in the rank-2 type of wim is
-quantified further outside. When type checking test4, we have to check
-whether the signature of test5 is an instance of
-
- (forall s. Modular s a => M s w)
-
-Consequently, we will get (Modular s t_a), where t_a is a TauTv into the
-givens.
-
-Given the FD of Modular in this example, class improvement will instantiate
-t_a to 'a', where 'a' is the skolem from test5's signatures (due to the
-Modular s a predicate in that signature). If we don't zonk (Modular s t_a) in
-the givens, we will get into a loop as improveOne uses the unification engine
-Unify.tcUnifyTys, which doesn't know about mutable type variables.
-
-
-Note [LOOP]
-~~~~~~~~~~~
- class If b t e r | b t e -> r
- instance If T t e t
- instance If F t e e
- class Lte a b c | a b -> c where lte :: a -> b -> c
- instance Lte Z b T
- instance (Lte a b l,If l b a c) => Max a b c
-
-Wanted: Max Z (S x) y
-
-Then we'll reduce using the Max instance to:
- (Lte Z (S x) l, If l (S x) Z y)
-and improve by binding l->T, after which we can do some reduction
-on both the Lte and If constraints. What we *can't* do is start again
-with (Max Z (S x) y)!
-
-
-
-%************************************************************************
-%* *
- tcSimplifySuperClasses
-%* *
-%************************************************************************
-
-Note [SUPERCLASS-LOOP 1]
-~~~~~~~~~~~~~~~~~~~~~~~~
-We have to be very, very careful when generating superclasses, lest we
-accidentally build a loop. Here's an example:
-
- class S a
projects / ghc-hetmet.git / blobdiff