FIX #2767 & original problem of #3208

diff --git a/compiler/deSugar/DsBinds.lhs b/compiler/deSugar/DsBinds.lhs
index 0c8e37a..7f752f8 100644 (file)
--- a/compiler/deSugar/DsBinds.lhs
+++ b/compiler/deSugar/DsBinds.lhs
@@ -262,22 +262,22 @@ dsHsBind auto_scc rest (AbsBinds all_tyvars dicts exports binds)
 
        ; poly_tup_id <- newSysLocalDs (exprType poly_tup_expr)
 
-       ; let dict_args = map Var dicts
-
-             mk_bind ((tyvars, global, local, prags), n)       -- locals !! n == local
-               =       -- Need to make fresh locals to bind in the selector, because
-                       -- some of the tyvars will be bound to 'Any'
+       ; let mk_bind ((tyvars, global, local, prags), n)  -- locals!!n == local
+               =       -- Need to make fresh locals to bind in the selector,
+                       -- because some of the tyvars will be bound to 'Any'
                  do { ty_args <- mapM mk_ty_arg all_tyvars
                     ; let substitute = substTyWith all_tyvars ty_args
                     ; locals' <- newSysLocalsDs (map substitute local_tys)
                     ; tup_id  <- newSysLocalDs  (substitute tup_ty)
-                    ; mb_specs <- mapM (dsSpec all_tyvars dicts tyvars global local core_bind) 
+                    ; mb_specs <- mapM (dsSpec all_tyvars dicts tyvars global
+                                        local core_bind) 
                                         prags
                     ; let (spec_binds, rules) = unzip (catMaybes mb_specs)
                           global' = addIdSpecialisations global rules
                           rhs = mkLams tyvars $ mkLams dicts $
                                 mkTupleSelector locals' (locals' !! n) tup_id $
-                                mkApps (mkTyApps (Var poly_tup_id) ty_args) dict_args
+                                mkVarApps (mkTyApps (Var poly_tup_id) ty_args)
+                                          dicts
                     ; return ((global', rhs) : spec_binds) }
                where
                  mk_ty_arg all_tyvar

diff --git a/compiler/deSugar/DsMonad.lhs b/compiler/deSugar/DsMonad.lhs
index 58a154a..e275cb9 100644 (file)
--- a/compiler/deSugar/DsMonad.lhs
+++ b/compiler/deSugar/DsMonad.lhs
@@ -230,7 +230,7 @@ newPredVarDs :: PredType -> DsM Var
 newPredVarDs pred
  | isEqPred pred
  = do { uniq <- newUnique; 
-      ; let name = mkSystemName uniq (mkOccNameFS tcName (fsLit "co"))
+      ; let name = mkSystemName uniq (mkOccNameFS tcName (fsLit "co_pv"))
            kind = mkPredTy pred
       ; return (mkCoVar name kind) }
  | otherwise

diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs
index 51bacba..4f2dfab 100644 (file)
--- a/compiler/typecheck/Inst.lhs
+++ b/compiler/typecheck/Inst.lhs
@@ -1173,7 +1173,7 @@ mkEqInst (EqPred ty1 ty2) co
             ; return inst
             }
        where 
-          mkName uniq src_span = mkInternalName uniq (mkVarOcc "co") src_span
+          mkName uniq src_span = mkInternalName uniq (mkVarOcc "co_ei") src_span
 mkEqInst pred _ = pprPanic "mkEqInst" (ppr pred)
 
 mkWantedEqInst :: PredType -> TcM Inst

diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs
index 030a7f6..94c2d25 100644 (file)
--- a/compiler/typecheck/TcMType.lhs
+++ b/compiler/typecheck/TcMType.lhs
@@ -415,7 +415,7 @@ occurCheckErr ty containingTy
 newCoVars :: [(TcType,TcType)] -> TcM [CoVar]
 newCoVars spec
   = do { us <- newUniqueSupply 
-       ; return [ mkCoVar (mkSysTvName uniq (fsLit "co"))
+       ; return [ mkCoVar (mkSysTvName uniq (fsLit "co_kv"))
                           (mkCoKind ty1 ty2)
                 | ((ty1,ty2), uniq) <- spec `zip` uniqsFromSupply us] }