Remove dead code in TcSimplify

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

diff --git a/compiler/typecheck/TcTyFuns.lhs b/compiler/typecheck/TcTyFuns.lhs
index dae7416..c91ac63 100644 (file)
--- a/compiler/typecheck/TcTyFuns.lhs
+++ b/compiler/typecheck/TcTyFuns.lhs
@@ -526,7 +526,12 @@ swapInst i@(EqInst {})
                -- we should swap!
              go ty1 ty2@(TyConApp tyCon _) 
                                        | isOpenSynTyCon tyCon
-                                       = do { wg_co <- eitherEqInst i
+                                       = actual_swap ty1 ty2
+             go ty1@(TyConApp _ _) ty2@(TyVarTy _)
+                                       = actual_swap ty1 ty2
+             go _ _                    = return (i,False)
+
+             actual_swap ty1 ty2 = do { wg_co <- eitherEqInst i
                                                          -- old_co := sym new_co
                                                          (\old_covar ->
                                                           do { new_cotv <- newMetaTyVar TauTv (mkCoKind ty2 ty1)
@@ -539,7 +544,6 @@ swapInst i@(EqInst {})
                                             ; new_inst <- mkEqInst (EqPred ty2 ty1) wg_co
                                             ; return (new_inst,True)
                                             }
-             go _ _                    = return (i,False)
 
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 decompInsts :: [Inst] -> TcM ([Inst],Bool)
@@ -576,7 +580,7 @@ decompInst i@(EqInst {})
                         do { cotvs <- zipWithM (\t1 t2 -> 
                                                 newMetaTyVar TauTv 
                                                              (mkCoKind t1 t2)) 
-                                               tys1' tys2'
+                                               tys1 tys2
                            ; let cos = map TyVarTy cotvs
                            ; writeMetaTyVar old_covar (TyConApp con1 cos)
                            ; return $ map mkWantedCo cotvs
@@ -584,9 +588,10 @@ decompInst i@(EqInst {})
                       -- co_i := Con_i old_co
                       (\old_co -> return $ 
                                     map mkGivenCo $
-                                        mkRightCoercions (length tys1') old_co)
-           ; insts <- zipWithM mkEqInst (zipWith EqPred tys1' tys2') cos
-           ; return (insts, not $ null insts)
+                                        mkRightCoercions (length tys1) old_co)
+           ; insts <- zipWithM mkEqInst (zipWith EqPred tys1 tys2) cos
+           ; traceTc (text "decomp identicalHead" <+> ppr insts) 
+           ; return (insts, not $ null insts) 
            }
       | con1 /= con2 && not (isOpenSynTyCon con1 || isOpenSynTyCon con2)
         -- not matching data constructors (of any flavour) are bad news