InstEnv, emptyInstEnv, extendInstEnv,
extendInstEnvList, lookupInstEnv, instEnvElts,
- classInstances,
+ classInstances, instanceBindFun,
instanceCantMatch, roughMatchTcs
) where
import Name
import TcType
import TyCon
-import TcGadt
import Unify
import Outputable
import BasicTypes
%************************************************************************
\begin{code}
-type DFunId = Id
data Instance
= Instance { is_cls :: Name -- Class name
-- INVARIANT: is_dfun Id has type
-- forall is_tvs. (...) => is_cls is_tys
- , is_dfun :: DFunId
+ , is_dfun :: DFunId -- See Note [Haddock assumptions]
, is_flag :: OverlapFlag -- See detailed comments with
-- the decl of BasicTypes.OverlapFlag
}
(This is so that we can use the matching substitution to
instantiate the dfun's context.)
+Note [Haddock assumptions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+For normal user-written instances, Haddock relies on
+ * the SrcSpan of
+ * the Name of
+ * the is_dfun of
+ * an Instance
+
+being equal to
+
+ * the SrcSpan of
+ * the instance head type of
+ * the InstDecl used to construct the Instance.
\begin{code}
instanceDFunId :: Instance -> DFunId
setInstanceDFunId :: Instance -> DFunId -> Instance
setInstanceDFunId ispec dfun
- = ASSERT( idType dfun `tcEqType` idType (is_dfun ispec) )
+ = ASSERT( idType dfun `eqType` idType (is_dfun ispec) )
-- We need to create the cached fields afresh from
-- the new dfun id. In particular, the is_tvs in
-- the Instance must match those in the dfun!
-- Prints the Instance as an instance declaration
pprInstance ispec
= hang (pprInstanceHdr ispec)
- 2 (ptext SLIT("--") <+> pprNameLoc (getName ispec))
+ 2 (ptext (sLit "--") <+> pprNameLoc (getName ispec))
-- * pprInstanceHdr is used in VStudio to populate the ClassView tree
pprInstanceHdr :: Instance -> SDoc
-- Prints the Instance as an instance declaration
pprInstanceHdr ispec@(Instance { is_flag = flag })
- = ptext SLIT("instance") <+> ppr flag
- <+> sep [pprThetaArrow theta, pprClassPred clas tys]
+ = getPprStyle $ \ sty ->
+ let theta_to_print
+ | debugStyle sty = theta
+ | otherwise = drop (dfunNSilent dfun) theta
+ in ptext (sLit "instance") <+> ppr flag
+ <+> sep [pprThetaArrowTy theta_to_print, ppr res_ty]
where
- (_, theta, clas, tys) = instanceHead 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], [PredType], Class, [Type])
-instanceHead ispec = tcSplitDFunTy (idType (is_dfun ispec))
-
-mkLocalInstance :: DFunId -> OverlapFlag -> Instance
+instanceHead :: Instance -> ([TyVar], ThetaType, Class, [Type])
+-- Returns the *source* theta, without the silent arguments
+instanceHead ispec
+ = (tvs, drop n_silent theta, cls, tys)
+ where
+ (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)
-- 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)
%************************************************************************
%* *
-\subsection{Looking up an instance}
+ Looking up an instance
%* *
%************************************************************************
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
)
-- Unification will break badly if the variables overlap
-- They shouldn't because we allocate separate uniques for them
- case tcUnifyTys bind_fn tpl_tys tys of
+ case tcUnifyTys instanceBindFun tpl_tys tys of
Just _ -> find ms (item:us) rest
Nothing -> find ms us rest
---------------
-bind_fn :: TyVar -> BindFlag
-bind_fn tv | isTcTyVar tv && isExistentialTyVar tv = Skolem
- | otherwise = BindMe
- -- The key_tys can contain skolem constants, and we can guarantee that those
- -- are never going to be instantiated to anything, so we should not involve
- -- them in the unification test. Example:
- -- class Foo a where { op :: a -> Int }
- -- instance Foo a => Foo [a] -- NB overlap
- -- instance Foo [Int] -- NB overlap
- -- data T = forall a. Foo a => MkT a
- -- f :: T -> Int
- -- f (MkT x) = op [x,x]
- -- The op [x,x] means we need (Foo [a]). Without the filterVarSet we'd
- -- 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
- -- g :: forall a => [a] -> Int
- -- g x = op x
- -- on the grounds that the correct instance depends on the instantiation of 'a'
-
---------------
insert_overlapping :: InstMatch -> [InstMatch] -> [InstMatch]
-- Add a new solution, knocking out strictly less specific ones
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}
+
+
+%************************************************************************
+%* *
+ Binding decisions
+%* *
+%************************************************************************
+
+\begin{code}
+instanceBindFun :: TyVar -> BindFlag
+instanceBindFun tv | isTcTyVar tv && isOverlappableTyVar tv = Skolem
+ | otherwise = BindMe
+ -- Note [Binding when looking up instances]
\end{code}
+Note [Binding when looking up instances]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When looking up in the instance environment, or family-instance environment,
+we are careful about multiple matches, as described above in
+Note [Overlapping instances]
+
+The key_tys can contain skolem constants, and we can guarantee that those
+are never going to be instantiated to anything, so we should not involve
+them in the unification test. Example:
+ class Foo a where { op :: a -> Int }
+ instance Foo a => Foo [a] -- NB overlap
+ instance Foo [Int] -- NB overlap
+ data T = forall a. Foo a => MkT a
+ f :: T -> Int
+ f (MkT x) = op [x,x]
+The op [x,x] means we need (Foo [a]). Without the filterVarSet we'd
+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 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'
projects / ghc-hetmet.git / blobdiff