-- are ok; hence the assert
ispec { is_dfun = dfun, is_tvs = mkVarSet tvs, is_tys = tys }
where
- (tvs, _, tys) = tcSplitDFunTy (idType dfun)
+ (tvs, _, _, tys) = tcSplitDFunTy (idType dfun)
instanceRoughTcs :: Instance -> [Maybe Name]
instanceRoughTcs = is_tcs
pprInstanceHdr :: Instance -> SDoc
-- Prints the Instance as an instance declaration
pprInstanceHdr ispec@(Instance { is_flag = flag })
- = ptext (sLit "instance") <+> ppr flag
- <+> sep [pprThetaArrow theta, ppr res_ty]
+ = getPprStyle $ \ sty ->
+ let theta_to_print
+ | debugStyle sty = theta
+ | otherwise = drop (dfunNSilent dfun) theta
+ in ptext (sLit "instance") <+> ppr flag
+ <+> sep [pprThetaArrow theta_to_print, ppr res_ty]
where
- (_, theta, res_ty) = tcSplitSigmaTy (idType (is_dfun ispec))
+ dfun = is_dfun ispec
+ (_, theta, res_ty) = tcSplitSigmaTy (idType dfun)
-- Print without the for-all, which the programmer doesn't write
pprInstances :: [Instance] -> SDoc
pprInstances ispecs = vcat (map pprInstance ispecs)
instanceHead :: Instance -> ([TyVar], ThetaType, Class, [Type])
-instanceHead ispec
- = (tvs, theta, cls, tys)
+-- Returns the *source* theta, without the silent arguments
+instanceHead ispec
+ = (tvs, drop n_silent theta, cls, tys)
where
- (tvs, theta, tau) = tcSplitSigmaTy (idType (is_dfun ispec))
- (cls, tys) = tcSplitDFunHead tau
-
-mkLocalInstance :: DFunId -> OverlapFlag -> Instance
+ (tvs, theta, tau) = tcSplitSigmaTy (idType dfun)
+ (cls, tys) = tcSplitDFunHead tau
+ dfun = is_dfun ispec
+ n_silent = dfunNSilent dfun
+
+mkLocalInstance :: DFunId
+ -> OverlapFlag
+ -> Instance
-- Used for local instances, where we can safely pull on the DFunId
mkLocalInstance dfun oflag
= Instance { is_flag = oflag, is_dfun = dfun,
is_tvs = mkVarSet tvs, is_tys = tys,
- is_cls = className cls, is_tcs = roughMatchTcs tys }
+ is_cls = className cls, is_tcs = roughMatchTcs tys }
where
- (tvs, cls, tys) = tcSplitDFunTy (idType dfun)
+ (tvs, _, cls, tys) = tcSplitDFunTy (idType dfun)
mkImportedInstance :: Name -> [Maybe Name]
-> DFunId -> OverlapFlag -> Instance
is_tvs = mkVarSet tvs, is_tys = tys,
is_cls = cls, is_tcs = mb_tcs }
where
- (tvs, _, tys) = tcSplitDFunTy (idType dfun)
+ (tvs, _, _, tys) = tcSplitDFunTy (idType dfun)
roughMatchTcs :: [Type] -> [Maybe Name]
roughMatchTcs tys = map rough tys
-- If *not* then the common case of looking up
-- (C a b c) can fail immediately
+instance Outputable ClsInstEnv where
+ ppr (ClsIE is b) = ptext (sLit "ClsIE") <+> ppr b <+> pprInstances is
+
-- INVARIANTS:
-- * The is_tvs are distinct in each Instance
-- of a ClsInstEnv (so we can safely unify them)
find ((item, map (lookup_tv subst) dfun_tvs) : ms) us rest
-- Does not match, so next check whether the things unify
- -- See Note [overlapping instances] above
+ -- See Note [Overlapping instances] above
| Incoherent <- oflag
= find ms us rest
old_beats_new = item `beats` new_item
(instA, _) `beats` (instB, _)
- = overlap_ok &&
- isJust (tcMatchTys (is_tvs instB) (is_tys instB) (is_tys instA))
- -- A beats B if A is more specific than B, and B admits overlap
- -- I.e. if B can be instantiated to match A
- where
- overlap_ok = case is_flag instB of
- NoOverlap -> False
- _ -> True
+ = overlap_ok &&
+ isJust (tcMatchTys (is_tvs instB) (is_tys instB) (is_tys instA))
+ -- A beats B if A is more specific than B,
+ -- (ie. if B can be instantiated to match A)
+ -- and overlap is permitted
+ where
+ -- Overlap permitted if *either* instance permits overlap
+ -- This is a change (Trac #3877, Dec 10). It used to
+ -- require that instB (the less specific one) permitted overlap.
+ overlap_ok = case (is_flag instA, is_flag instB) of
+ (NoOverlap, NoOverlap) -> False
+ _ -> True
\end{code}
\begin{code}
instanceBindFun :: TyVar -> BindFlag
-instanceBindFun tv | isTcTyVar tv && isExistentialTyVar tv = Skolem
- | otherwise = BindMe
+instanceBindFun tv | isTcTyVar tv && isOverlappableTyVar tv = Skolem
+ | otherwise = BindMe
-- Note [Binding when looking up instances]
\end{code}
complain, saying that the choice of instance depended on the instantiation
of 'a'; but of course it isn't *going* to be instantiated.
-We do this only for pattern-bound skolems. For example we reject
+We do this only for isOverlappableTyVar skolems. For example we reject
g :: forall a => [a] -> Int
g x = op x
on the grounds that the correct instance depends on the instantiation of 'a'