~~~~~~~~~
\begin{code}
instName :: Inst -> Name
-instName inst = idName (instToId inst)
+instName inst = Var.varName (instToVar inst)
instToId :: Inst -> TcId
instToId inst = ASSERT2( isId id, ppr inst ) id
(tci_wanted imp)
mkImplicTy tvs givens wanteds -- The type of an implication constraint
- = -- pprTrace "mkImplicTy" (ppr givens) $
+ = ASSERT( all isDict givens )
+ -- pprTrace "mkImplicTy" (ppr givens) $
mkForAllTys tvs $
mkPhiTy (map dictPred givens) $
if isSingleton wanteds then
= mkInternalName uniq occ (srcSpanStart (instLocSpan loc))
where
occ = case pred_ty of
- ClassP cls tys -> mkDictOcc (getOccName cls)
- IParam ip ty -> getOccName (ipNameName ip)
+ ClassP cls _ -> mkDictOcc (getOccName cls)
+ IParam ip _ -> getOccName (ipNameName ip)
+ EqPred ty _ -> mkEqPredCoOcc baseOcc
+ where
+ -- we use the outermost tycon of the lhs, if there is one, to
+ -- improve readability of Core code
+ baseOcc = case splitTyConApp_maybe ty of
+ Nothing -> mkOccName tcName "$"
+ Just (tc, _) -> getOccName tc
\end{code}
%************************************************************************
(theta, _) = tcSplitPhiTy dfun_rho
src_loc = instLocSpan loc
dfun = HsVar dfun_id
- tys = map (substTyVar tenv') tyvars
+ tys = substTyVars tenv' tyvars
; if null theta then
returnM (GenInst [] (L src_loc $ HsWrap (mkWpTyApps tys) dfun))
else do