-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
--- http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
module TcTyFuns(
-- 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)
; new_inst <- mkEqInst (EqPred ty2 ty1) wg_co
; return (new_inst,True)
}
- go _ _ = return (i,False)
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
decompInsts :: [Inst] -> TcM ([Inst],Bool)
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
-- 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