X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FInst.lhs;h=49fc942b8c91e709ecfa5f4b0e2558b64ed5bc7d;hb=02c48cf14cd8c7771dfb41089412f35e1eaeedd5;hp=c34bf6d2409d8d21dc6ad99fe438b482b72b4dc5;hpb=ea2d0a53ff4ca7e6331d09225ad84ec9c9efe6d8;p=ghc-hetmet.git

diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs
index c34bf6d..49fc942 100644
--- 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}
 
 %************************************************************************