Make dicts for arbitrary type equalities

[ghc-hetmet.git] / compiler / typecheck / Inst.lhs

diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs
index c34bf6d..49fc942 100644 (file)
--- a/compiler/typecheck/Inst.lhs
+++ b/compiler/typecheck/Inst.lhs
@@ -83,7 +83,7 @@ Selection
 ~~~~~~~~~
 \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 
@@ -329,9 +329,15 @@ mkPredName uniq loc pred_ty
   = mkInternalName uniq occ (srcSpanStart (instLocSpan loc))
   where
     occ = case pred_ty of
-           ClassP cls tys -> mkDictOcc (getOccName cls)
-           IParam ip ty   -> getOccName (ipNameName ip)
-           EqPred _ _     -> pprPanic "mkPredName" (ppr pred_ty)
+           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}
 
 %************************************************************************