Construction of EqPred dictionaries

diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs
index a5b32ed..48aa6db 100644 (file)
--- a/compiler/basicTypes/OccName.lhs
+++ b/compiler/basicTypes/OccName.lhs
@@ -31,7 +31,7 @@ module OccName (
        mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
        mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc,
        mkSuperDictSelOcc, mkLocalOcc, mkMethodOcc, mkInstTyTcOcc,
-       mkInstTyCoOcc, 
+       mkInstTyCoOcc, mkEqPredCoOcc,
 
        -- ** Deconstruction
        occNameFS, occNameString, occNameSpace, 
@@ -445,6 +445,7 @@ mkSpecOcc       = mk_simple_deriv varName  "$s"
 mkForeignExportOcc  = mk_simple_deriv varName  "$f"
 mkNewTyCoOcc        = mk_simple_deriv tcName  ":Co"
 mkInstTyCoOcc       = mk_simple_deriv tcName  ":Co"      -- derived from rep ty
+mkEqPredCoOcc      = mk_simple_deriv tcName  "$co"
 
 -- Generic derivable classes
 mkGenOcc1           = mk_simple_deriv varName  "$gfrom"

diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs
index c34bf6d..b0fe5f9 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,16 @@ 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, which must be a type
+               -- function, as the base name for an equality
+               baseOcc = case splitTyConApp_maybe ty of
+                           Nothing      -> 
+                             pprPanic "Inst.mkPredName:" (ppr ty)
+                            Just (tc, _) -> getOccName tc
 \end{code}
 
 %************************************************************************

diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
index b0ca87a..0be7724 100644 (file)
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@ -611,7 +611,7 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = VanillaInst monobinds uprags })
     newDictBndrs sc_loc sc_theta'                      `thenM` \ sc_dicts ->
     getInstLoc origin                                  `thenM` \ inst_loc -> 
     newDictBndrs inst_loc dfun_theta'                  `thenM` \ dfun_arg_dicts ->
-    newDictBndr inst_loc (mkClassPred clas inst_tys')  `thenM` \ this_dict ->
+    newDictBndr inst_loc (mkClassPred clas inst_tys')   `thenM` \ this_dict ->
                -- Default-method Ids may be mentioned in synthesised RHSs,
                -- but they'll already be in the environment.