\begin{code}
module TcSimplify (
- tcSimplifyInfer, tcSimplifyInferCheck,
+ tcSimplifyInfer, tcSimplifyInferCheck,
tcSimplifyCheck, tcSimplifyRestricted,
- tcSimplifyToDicts, tcSimplifyIPs, tcSimplifyTop,
+ tcSimplifyToDicts, tcSimplifyIPs, tcSimplifyTop,
tcSimplifyThetas, tcSimplifyCheckThetas,
bindInstsOfLocalFuns
#include "HsVersions.h"
import HsSyn ( MonoBinds(..), HsExpr(..), andMonoBinds, andMonoBindList )
-import TcHsSyn ( TcExpr, TcId,
+import TcHsSyn ( TcExpr, TcId,
TcMonoBinds, TcDictBinds
)
getDictClassTys, isTyVarDict,
instLoc, pprInst, zonkInst, tidyInsts,
Inst, LIE, pprInsts, pprInstsInFull,
- mkLIE, lieToList
+ mkLIE, lieToList
)
import TcEnv ( tcGetGlobalTyVars, tcGetInstEnv )
import InstEnv ( lookupInstEnv, classInstEnv, InstLookupResult(..) )
%* *
%************************************************************************
- --------------------------------------
+ --------------------------------------
Notes on quantification
- --------------------------------------
+ --------------------------------------
Suppose we are about to do a generalisation step.
We have in our hand
forall Q. Cq => T
-and float the constraints Ct further outwards.
+and float the constraints Ct further outwards.
Here are the things that *must* be true:
using the functional dependencies from C
grow(vs,C) The result of extend the set of tyvars vs
- using all conceivable links from C.
+ using all conceivable links from C.
E.g. vs = {a}, C = {H [a] b, K (b,Int) c, Eq e}
Then grow(vs,C) = {a,b,c}
Note that grow(vs,C) `superset` grow(vs,simplify(C))
That is, simplfication can only shrink the result of grow.
-Notice that
+Notice that
oclose is conservative one way: v `elem` oclose(vs,C) => v is definitely fixed by vs
grow is conservative the other way: if v might be fixed by vs => v `elem` grow(vs,C)
Why grow( fv(T), C ) rather than fv(T)? Consider
class H x y | x->y where ...
-
+
T = c->c
C = (H c d)
forall c. H c d => c -> b
- And then if the fn was called at several different c's, each of
+ And then if the fn was called at several different c's, each of
which fixed d differently, we'd get a unification error, because
d isn't quantified. Solution: quantify d. So we must quantify
everything that might be influenced by c.
- --------------------------------------
- Notes on ambiguity
- --------------------------------------
+ --------------------------------------
+ Notes on ambiguity
+ --------------------------------------
It's very hard to be certain when a type is ambiguous. Consider
(all tested before quantification).
That is, all the type variables in Cq must be fixed by the the variables
-in the environment, or by the variables in the type.
+in the environment, or by the variables in the type.
Notice that we union before calling oclose. Here's an example:
forall b c. (J a b c) => b -> b
Only if we union {a} from G with {b} from T before using oclose,
-do we see that c is fixed.
+do we see that c is fixed.
-It's a bit vague exactly which C we should use for this oclose call. If we
+It's a bit vague exactly which C we should use for this oclose call. If we
don't fix enough variables we might complain when we shouldn't (see
the above nasty example). Nothing will be perfect. That's why we can
only issue a warning.
c in C such that fv(c) intersect (fv(G) union fv(T)) = EMPTY
-then c is a "bubble"; there's no way it can ever improve, and it's
+then c is a "bubble"; there's no way it can ever improve, and it's
certainly ambiguous. UNLESS it is a constant (sigh). And what about
the nasty example?
(which squashes out the constants, like Eq (T a) above)
- --------------------------------------
+ --------------------------------------
Notes on principal types
- --------------------------------------
+ --------------------------------------
class C a where
op :: a -> a
-
+
f x = let g y = op (y::Int) in True
Here the principal type of f is (forall a. a->a)
f :: forall a. C Int => a -> a
- --------------------------------------
+ --------------------------------------
Notes on implicit parameters
- --------------------------------------
+ --------------------------------------
Question 1: can we "inherit" implicit parameters
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Question 2: type signatures
~~~~~~~~~~~~~~~~~~~~~~~~~~~
-OK, so it it legal to give an explicit, user type signature to f, thus:
+OK, so is it legal to give an explicit, user type signature to f, thus:
f :: Int -> Int
f x = (x::Int) + ?y
over the ?y parameter, to get
z :: (?y::Int) => Int,
but the monomorphism restriction says that we *must not*, giving
- z :: Int.
+ z :: Int.
Why does the momomorphism restriction say this? Because if you have
let z = x + ?y in z+z
be generalised
Consequences:
- * Inlning remains valid
+ * Inlining remains valid
* No unexpected loss of sharing
* But simple bindings like
z = ?y + 1
BOTTOM LINE: we choose (B) at present. See tcSimplifyRestricted
-
+
%************************************************************************
%* *
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
+
+ 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
+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.
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.
+again.
\begin{code}
tcSimplifyInfer
- :: SDoc
- -> TcTyVarSet -- fv(T); type vars
+ :: SDoc
+ -> TcTyVarSet -- fv(T); type vars
-> LIE -- Wanted
-> TcM ([TcTyVar], -- Tyvars to quantify (zonked)
LIE, -- Free
\begin{code}
tcSimplifyInfer doc tau_tvs wanted_lie
- = inferLoop doc (varSetElems tau_tvs)
+ = inferLoop doc (varSetElems tau_tvs)
(lieToList wanted_lie) `thenTc` \ (qtvs, frees, binds, irreds) ->
-- Check for non-generalisable insts
let
preds = predsOfInsts wanteds'
qtvs = grow preds tau_tvs' `minusVarSet` oclose preds gbl_tvs
-
- try_me inst
+
+ try_me inst
| isFreeAndInheritable qtvs inst = Free
| isClassDict inst = DontReduceUnlessConstant -- Dicts
| otherwise = ReduceMe -- Lits and Methods
in
-- Step 2
reduceContext doc try_me [] wanteds' `thenTc` \ (no_improvement, frees, binds, irreds) ->
-
+
-- Step 3
if no_improvement then
returnTc (varSetElems qtvs, frees, binds, irreds)
inferLoop doc tau_tvs (irreds ++ frees) `thenTc` \ (qtvs1, frees1, binds1, irreds1) ->
returnTc (qtvs1, frees1, binds `AndMonoBinds` binds1, irreds1)
-\end{code}
+\end{code}
Example [LOOP]
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
+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)!
&& all inheritablePred (predsOfInst inst) -- And no implicit parameter involved
-- (see "Notes on implicit parameters")
-isFree qtvs inst
+isFree qtvs inst
= not (tyVarsOfInst inst `intersectsVarSet` qtvs)
\end{code}
\begin{code}
tcSimplifyCheck
- :: SDoc
+ :: SDoc
-> [TcTyVar] -- Quantify over these
-> [Inst] -- Given
-> LIE -- Wanted
-> TcM (LIE, -- Free
TcDictBinds) -- Bindings
--- tcSimplifyCheck is used when checking exprssion type signatures,
+-- tcSimplifyCheck is used when checking exprssion type signatures,
-- class decls, instance decls etc.
-- Note that we psss isFree (not isFreeAndInheritable) to tcSimplCheck
-- It's important that we can float out non-inheritable predicates
-- 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
- :: SDoc
+ :: SDoc
-> TcTyVarSet -- fv(T)
-> [Inst] -- Given
-> LIE -- Wanted
let
qtvs = 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
+ -- soundness, and it'll only affect which tyvars, not which
-- dictionaries, we quantify over
in
returnNF_Tc qtvs
Here is the workhorse function for all three wrappers.
-\begin{code}
+\begin{code}
tcSimplCheck doc is_free get_qtvs givens wanted_lie
= check_loop givens (lieToList wanted_lie) `thenTc` \ (qtvs, frees, binds, irreds) ->
= -- Step 1
mapNF_Tc zonkInst givens `thenNF_Tc` \ givens' ->
mapNF_Tc zonkInst wanteds `thenNF_Tc` \ wanteds' ->
- get_qtvs `thenNF_Tc` \ qtvs' ->
-
+ get_qtvs `thenNF_Tc` \ qtvs' ->
+
-- Step 2
let
-- When checking against a given signature we always reduce
-- until we find a match against something given, or can't reduce
try_me inst | is_free qtvs' inst = Free
- | otherwise = ReduceMe
+ | otherwise = ReduceMe
in
reduceContext doc try_me givens' wanteds' `thenTc` \ (no_improvement, frees, binds, irreds) ->
-
+
-- Step 3
if no_improvement then
returnTc (varSetElems qtvs', frees, binds, irreds)
returnTc ()
where
given_dicts = filter isDict givens
- -- Filter out methods, which are only added to
+ -- Filter out methods, which are only added to
-- the given set as an optimisation
\end{code}
\begin{code}
tcSimplifyRestricted -- Used for restricted binding groups
-- i.e. ones subject to the monomorphism restriction
- :: SDoc
+ :: SDoc
-> TcTyVarSet -- Free in the type of the RHSs
-> LIE -- Free in the RHSs
-> TcM ([TcTyVar], -- Tyvars to quantify (zonked)
tcSimplifyRestricted doc tau_tvs wanted_lie
= -- First squash out all methods, to find the constrained tyvars
- -- We can't just take the free vars of wanted_lie because that'll
+ -- We can't just take the free vars of wanted_lie because that'll
-- have methods that may incidentally mention entirely unconstrained variables
-- e.g. a call to f :: Eq a => a -> b -> b
-- Here, b is unconstrained. A good example would be
-- necessary, so try again, this time knowing the exact
-- set of type variables to quantify over.
--
- -- We quantify only over constraints that are captured by qtvs;
+ -- We quantify only over constraints that are captured by qtvs;
-- these will just be a subset of non-dicts. This in contrast
- -- to normal inference (using isFreeAndInheritable) in which we quantify over
- -- all *non-inheritable* constraints too. This implements choice
+ -- to normal inference (using isFreeAndInheritable) in which we quantify over
+ -- all *non-inheritable* constraints too. This implements choice
-- (B) under "implicit parameter and monomorphism" above.
mapNF_Tc zonkInst (lieToList wanted_lie) `thenNF_Tc` \ wanteds' ->
let
as the available stuff for the RHS of the rule.
The same thing is used for specialise pragmas. Consider
-
+
f :: Num a => a -> a
{-# SPECIALISE f :: Int -> Int #-}
f = ...
f_spec = _inline_me_ (f Int dNumInt)
-But that means that we must simplify the Method for f to (f Int dNumInt)!
+But that means that we must simplify the Method for f to (f Int dNumInt)!
So tcSimplifyToDicts squeezes out all Methods.
IMPORTANT NOTE: we *don't* want to do superclass commoning up. Consider
fromIntegral :: (Integral a, Num b) => a -> b
{-# RULES "foo" fromIntegral = id :: Int -> Int #-}
-Here, a=b=Int, and Num Int is a superclass of Integral Int. But we *dont*
+Here, a=b=Int, and Num Int is a superclass of Integral Int. But we *dont*
want to get
forall dIntegralInt.
tcSimplifyToDicts :: LIE -> TcM ([Inst], TcDictBinds)
tcSimplifyToDicts wanted_lie
= simpleReduceLoop doc try_me wanteds `thenTc` \ (frees, binds, irreds) ->
- -- Since try_me doesn't look at types, we don't need to
+ -- Since try_me doesn't look at types, we don't need to
-- do any zonking, so it's safe to call reduceContext directly
ASSERT( null frees )
returnTc (irreds, binds)
let ?x = R in B
we must discharge all the ?x constraints from B. We also do an improvement
-step; if we have ?x::t1 and ?x::t2 we must unify t1, t2.
+step; if we have ?x::t1 and ?x::t2 we must unify t1, t2.
Actually, the constraints from B might improve the types in ?x. For example
f :: (?x::Int) => Char -> Char
let ?x = 3 in f 'c'
-then the constraint (?x::Int) arising from the call to f will
+then the constraint (?x::Int) arising from the call to f will
force the binding for ?x to be of type Int.
\begin{code}
wanteds = lieToList wanted_lie
ip_names = map instName given_ips
ip_set = mkNameSet ip_names
-
+
-- Simplify any methods that mention the implicit parameter
try_me inst | inst `instMentionsIPs` ip_set = ReduceMe
| otherwise = Free
simpl_loop givens wanteds
= mapNF_Tc zonkInst givens `thenNF_Tc` \ givens' ->
mapNF_Tc zonkInst wanteds `thenNF_Tc` \ wanteds' ->
-
+
reduceContext doc try_me givens' wanteds' `thenTc` \ (no_improvement, frees, binds, irreds) ->
if no_improvement then
bindInstsOfLocalFuns :: LIE -> [TcId] -> TcM (LIE, TcMonoBinds)
bindInstsOfLocalFuns init_lie local_ids
- | null overloaded_ids
+ | null overloaded_ids
-- Common case
= returnTc (init_lie, EmptyMonoBinds)
| otherwise
- = simpleReduceLoop doc try_me wanteds `thenTc` \ (frees, binds, irreds) ->
+ = simpleReduceLoop doc try_me wanteds `thenTc` \ (frees, binds, irreds) ->
ASSERT( null irreds )
returnTc (mkLIE frees, binds)
where
is_overloaded id = isOverloadedTy (idType id)
overloaded_set = mkVarSet overloaded_ids -- There can occasionally be a lot of them
- -- so it's worth building a set, so that
+ -- so it's worth building a set, so that
-- lookup (in isMethodFor) is faster
try_me inst | isMethodFor overloaded_set inst = ReduceMe
The main control over context reduction is here
\begin{code}
-data WhatToDo
+data WhatToDo
= ReduceMe -- Try to reduce this
-- If there's no instance, behave exactly like
- -- DontReduce: add the inst to
- -- the irreductible ones, but don't
+ -- DontReduce: add the inst to
+ -- the irreductible ones, but don't
-- produce an error message of any kind.
-- It might be quite legitimate such as (Eq a)!
- | DontReduce WantSCs -- Return as irreducible
+ | DontReduce WantSCs -- Return as irreducible
| DontReduceUnlessConstant -- Return as irreducible unless it can
-- be reduced to a constant in one step
| NoRhs -- Used for Insts like (CCallable f)
-- where no witness is required.
- | Rhs -- Used when there is a RHS
+ | Rhs -- Used when there is a RHS
TcExpr -- The RHS
[Inst] -- Insts free in the RHS; we need these too
else
simpleReduceLoop doc try_me (irreds ++ frees) `thenTc` \ (frees1, binds1, irreds1) ->
returnTc (frees1, binds `AndMonoBinds` binds1, irreds1)
-\end{code}
+\end{code}
doc,
text "given" <+> ppr givens,
text "wanted" <+> ppr wanteds,
- text "----",
+ text "----",
text "avails" <+> pprAvails avails,
text "frees" <+> ppr frees,
text "no_improvement =" <+> ppr no_improvement,
Free return this in "frees"
wanteds: The list of insts to reduce
- state: An accumulating parameter of type RedState
+ state: An accumulating parameter of type RedState
that contains the state of the algorithm
-
+
It returns a RedState.
-The (n,stack) pair is just used for error reporting.
+The (n,stack) pair is just used for error reporting.
n is always the depth of the stack.
The stack is the stack of Insts being reduced: to produce X
I had to produce Y, to produce Y I had to produce Z, and so on.
; ReduceMe -> -- It should be reduced
lookupInst wanted `thenNF_Tc` \ lookup_result ->
case lookup_result of
- GenInst wanteds' rhs -> reduceList stack try_me wanteds' state `thenTc` \ state' ->
+ GenInst wanteds' rhs -> reduceList stack try_me wanteds' state `thenTc` \ state' ->
addWanted state' wanted rhs wanteds'
SimpleInst rhs -> addWanted state wanted rhs []
- NoInstance -> -- No such instance!
+ NoInstance -> -- No such instance!
-- Add it and its superclasses
addIrred AddSCs state wanted
isAvailable :: RedState -> Inst -> Bool
isAvailable (avails, _) wanted = wanted `elemFM` avails
-- NB: the Ord instance of Inst compares by the class/type info
- -- *not* by unique. So
+ -- *not* by unique. So
-- d1::C Int == d2::C Int
-------------------------
-- NB1: do *not* add superclasses. If we have
-- df::Floating a
-- dn::Num a
- -- but a is not bound here, then we *don't* want to derive
+ -- but a is not bound here, then we *don't* want to derive
-- dn from df here lest we lose sharing.
--
-- NB2: do *not* add the Inst to avails at all if it's a method.
-- The following situation shows why this is bad:
-- truncate :: forall a. RealFrac a => forall b. Integral b => a -> b
-- From an application (truncate f i) we get
- -- t1 = truncate at f
+ -- t1 = truncate at f
-- t2 = t1 at i
-- If we have also have a second occurrence of truncate, we get
-- t3 = truncate at f
addWanted :: RedState -> Inst -> TcExpr -> [Inst] -> NF_TcM RedState
addWanted state@(avails, frees) wanted rhs_expr wanteds
-- Do *not* add superclasses as well. Here's an example of why not
--- class Eq a => Foo a b
+-- class Eq a => Foo a b
-- instance Eq a => Foo [a] a
-- If we are reducing
-- (Foo [t] t)
--- we'll first deduce that it holds (via the instance decl). We
+-- we'll first deduce that it holds (via the instance decl). We
-- must not then overwrite the Eq t constraint with a superclass selection!
-- ToDo: this isn't entirely unsatisfactory, because
-- we may also lose some entirely-legitimate sharing this way
= ASSERT( not (isAvailable state wanted) )
returnNF_Tc (addToFM avails wanted avail, frees)
- where
+ where
avail | instBindingRequired wanted = Rhs rhs_expr wanteds
| otherwise = ASSERT( null wanteds ) NoRhs
class Ord a => C a where
instance Ord a => C [a] where ...
-Then we'll use the instance decl to deduce C [a] and then add the
+Then we'll use the instance decl to deduce C [a] and then add the
superclasses of C [a] to avails. But we must not overwrite the binding
for d1:Ord a (which is given) with a superclass selection or we'll just
build a loop! Hence looking for BoundTo. Crudely, BoundTo is cheaper
instance Num a => Num (Foo a b) where ...
and @tcSimplifyTop@ is given a constraint (Num (Foo x y)). Then it'll simplify
-to (Num x), and default x to Int. But what about y??
+to (Num x), and default x to Int. But what about y??
It's OK: the final zonking stage should zap y to (), which is fine.
let
-- All the non-std ones are definite errors
(stds, non_stds) = partition isStdClassTyVarDict irreds
-
+
-- Group by type variable
std_groups = equivClasses cmp_by_tyvar stds
-- Pick the ones which its worth trying to disambiguate
(std_oks, std_bads) = partition worth_a_try std_groups
- -- Have a try at disambiguation
+ -- Have a try at disambiguation
-- if the type variable isn't bound
-- up with one of the non-standard classes
worth_a_try group@(d:_) = not (non_std_tyvars `intersectsVarSet` tyVarsOfInst d)
mapTc disambigGroup std_oks `thenTc` \ binds_ambig ->
-- And complain about the ones that don't
- -- This group includes both non-existent instances
+ -- This group includes both non-existent instances
-- e.g. Num (IO a) and Eq (Int -> Int)
-- and ambiguous dictionaries
-- e.g. Num a
disambigGroup dicts
| any isNumericClass classes -- Guaranteed all standard classes
- -- see comment at the end of function for reasons as to
+ -- see comment at the end of function for reasons as to
-- why the defaulting mechanism doesn't apply to groups that
-- include CCallable or CReturnable dicts.
&& not (any isCcallishClass classes)
in
-- See if any default works, and if so bind the type variable to it
-- If not, add an AmbigErr
- recoverTc (addAmbigErrs dicts `thenNF_Tc_`
+ recoverTc (addAmbigErrs dicts `thenNF_Tc_`
returnTc EmptyMonoBinds) $
try_default default_tys `thenTc` \ chosen_default_ty ->
returnTc binds
| all isCreturnableClass classes
- = -- Default CCall stuff to (); we don't even both to check that () is an
+ = -- Default CCall stuff to (); we don't even both to check that () is an
-- instance of CReturnable, because we know it is.
unifyTauTy (mkTyVarTy tyvar) unitTy `thenTc_`
returnTc EmptyMonoBinds
-
+
| otherwise -- No defaults
= addAmbigErrs dicts `thenNF_Tc_`
returnTc EmptyMonoBinds
results) of a restricted set of 'native' types. This is
implemented via the help of the pseudo-type classes,
@CReturnable@ (CR) and @CCallable@ (CC.)
-
+
The interaction between the defaulting mechanism for numeric
values and CC & CR can be a bit puzzling to the user at times.
For example,
of (Integer, Double), 'x' has type Double, since Integer
is not an instance of CR. If the default list is equal to
Haskell 1.4's default-default of (Int, Double), 'x' has type
-Int.
+Int.
To try to minimise the potential for surprises here, the
defaulting mechanism is turned off in the presence of
-- we expect an instance here
-- For Haskell 98, check that all the constraints are of the form C a,
-- where a is a type variable
- bad_guys | glaExts = [pred | pred <- irreds,
+ bad_guys | glaExts = [pred | pred <- irreds,
isEmptyVarSet (tyVarsOfPred pred)]
- | otherwise = [pred | pred <- irreds,
+ | otherwise = [pred | pred <- irreds,
not (isTyVarClassPred pred)]
in
if null bad_guys then
\begin{code}
type AvailsSimple = FiniteMap PredType Bool
- -- True => irreducible
+ -- True => irreducible
-- False => given, or can be derived from a given or from an irreducible
reduceSimple :: ThetaType -- Given
Just False -> -- Already done
givens
-
+
\end{code}
| otherwise = addAmbigErr tidy_env d
addTopIPErr tidy_env tidy_dict
- = addInstErrTcM (instLoc tidy_dict)
- (tidy_env,
+ = addInstErrTcM (instLoc tidy_dict)
+ (tidy_env,
ptext SLIT("Unbound implicit parameter") <+> quotes (pprInst tidy_dict))
-- Used for top-level irreducibles
addTopInstanceErr tidy_env tidy_dict
- = addInstErrTcM (instLoc tidy_dict)
- (tidy_env,
+ = addInstErrTcM (instLoc tidy_dict)
+ (tidy_env,
ptext SLIT("No instance for") <+> quotes (pprInst tidy_dict))
addAmbigErrs dicts
-- Tidy them first
(_, tidy_dicts) = tidyInsts dicts
get_loc i = case instLoc i of { (_,loc,_) -> loc }
- warn_msg = vcat [ptext SLIT("Defaulting the following constraint(s) to type") <+>
+ warn_msg = vcat [ptext SLIT("Defaulting the following constraint(s) to type") <+>
quotes (ppr default_ty),
pprInstsInFull tidy_dicts]
ptext SLIT("Probable fix:"),
nest 4 fix1,
nest 4 fix2]
-
+
herald = ptext SLIT("Could not") <+> unambig_doc <+> ptext SLIT("deduce")
- unambig_doc | ambig_overlap = ptext SLIT("unambiguously")
+ unambig_doc | ambig_overlap = ptext SLIT("unambiguously")
| otherwise = empty
-
- ambig_doc
+
+ ambig_doc
| not ambig_overlap = empty
- | otherwise
+ | otherwise
= vcat [ptext SLIT("The choice of (overlapping) instance declaration"),
- nest 4 (ptext SLIT("depends on the instantiation of") <+>
+ nest 4 (ptext SLIT("depends on the instantiation of") <+>
quotes (pprWithCommas ppr (varSetElems (tyVarsOfInst tidy_dict))))]
-
+
fix1 = sep [ptext SLIT("Add") <+> quotes (pprInst tidy_dict),
ptext SLIT("to the") <+> what_doc]
-
- fix2 | isTyVarDict dict
+
+ fix2 | isTyVarDict dict
|| not (isClassDict dict) -- Don't suggest adding instance declarations for implicit parameters
- || ambig_overlap
+ || ambig_overlap
= empty
| otherwise
= ptext SLIT("Or add an instance declaration for") <+> quotes (pprInst tidy_dict)
-
+
(tidy_env, tidy_dict:tidy_givens) = tidyInsts (dict:givens)
-
+
-- Checks for the ambiguous case when we have overlapping instances
ambig_overlap | isClassDict dict
= case lookupInstEnv inst_env clas tys of
-----------------------------------------------
addCantGenErr inst
- = addErrTc (sep [ptext SLIT("Cannot generalise these overloadings (in a _ccall_):"),
+ = addErrTc (sep [ptext SLIT("Cannot generalise these overloadings (in a _ccall_):"),
nest 4 (ppr inst <+> pprInstLoc (instLoc inst))])
\end{code}
projects / ghc-hetmet.git / commitdiff