Cache the RHS type

14 files changed, 42 insertions, 39 deletions

diff --git a/compiler/GHC/Core/Coercion.hs b/compiler/GHC/Core/Coercion.hs
index 698c6516b3..b6ed2b4b40 100644
--- a/compiler/GHC/Core/Coercion.hs
+++ b/compiler/GHC/Core/Coercion.hs
@@ -1608,7 +1608,7 @@ mkTransCo dco1 dco2
 mkTransCoDCo :: Coercion -> DCoercion -> Coercion
 mkTransCoDCo co1 dco2 | isReflDCo dco2 = co1
 mkTransCoDCo co1 dco2
-  = TransCoDCo co1 dco2
+  = TransCoDCo co1 dco2 (followDCo (coercionRole co1) (coercionRKind co1) dco2)
 
 
 mkNthCo :: HasDebugCallStack
@@ -1924,8 +1924,8 @@ setNominalRole_maybe r co
       = SymCo <$> setNominalRole_maybe_helper co
     setNominalRole_maybe_helper (TransCo co1 co2)
       = TransCo <$> setNominalRole_maybe_helper co1 <*> setNominalRole_maybe_helper co2
-    setNominalRole_maybe_helper (TransCoDCo co1 dco2)
-      = TransCoDCo <$> setNominalRole_maybe_helper co1 <*> setNominalRole_maybe_dco r (coercionRKind co1) dco2
+    setNominalRole_maybe_helper (TransCoDCo co1 dco2 _)
+      = mkTransCoDCo <$> setNominalRole_maybe_helper co1 <*> setNominalRole_maybe_dco r (coercionRKind co1) dco2
     setNominalRole_maybe_helper (AppCo co1 co2)
       = AppCo <$> setNominalRole_maybe_helper co1 <*> pure co2
     setNominalRole_maybe_helper (ForAllCo tv kind_co co)
@@ -2936,7 +2936,7 @@ seqCo (UnivCo p r t1 t2)        = seqProv seqCo p `seq` r `seq` seqType t1
                                                           `seq` seqType t2
 seqCo (SymCo co)                = seqCo co
 seqCo (TransCo co1 co2)         = seqCo co1 `seq` seqCo co2
-seqCo (TransCoDCo co1 dco2)     = seqCo co1 `seq` seqDCo dco2
+seqCo (TransCoDCo co1 dco2 ty)  = seqCo co1 `seq` seqDCo dco2 `seq` seqType ty
 seqCo (NthCo r n co)            = r `seq` n `seq` seqCo co
 seqCo (LRCo lr co)              = lr `seq` seqCo co
 seqCo (InstCo co arg)           = seqCo co `seq` seqCo arg
@@ -3020,7 +3020,7 @@ coercionLKind co
     go (UnivCo _ _ ty1 _)       = ty1
     go (SymCo co)               = coercionRKind co
     go (TransCo co1 _co2)       = go co1
-    go (TransCoDCo co1 _dco2)   = go co1
+    go (TransCoDCo co1 _dco2 _) = go co1
     go (LRCo lr co)             = pickLR lr (splitAppTy (go co))
     go (InstCo aco arg)         = go_app aco [go arg]
     go (KindCo co)              = typeKind (go co)
@@ -3076,7 +3076,7 @@ coercionRKind co
     go (UnivCo _ _ _ ty2)       = ty2
     go (SymCo co)               = coercionLKind co
     go (TransCo _co1 co2)       = go co2
-    go (TransCoDCo co1 dco2)    = followDCo (coercionRole co1) (coercionRKind co1) dco2 -- AMG TODO: cache me?
+    go (TransCoDCo _ _ ty)      = ty
     go (LRCo lr co)             = pickLR lr (splitAppTy (go co))
     go (InstCo aco arg)         = go_app aco [go arg]
     go (KindCo co)              = typeKind (go co)
@@ -3183,7 +3183,7 @@ coercionRole = go
     go (UnivCo _ r _ _)  = r
     go (SymCo co) = go co
     go (TransCo co1 _) = go co1
-    go (TransCoDCo co1 _) = go co1
+    go (TransCoDCo co1 _ _) = go co1
     go (NthCo r _d _co) = r
     go (LRCo {}) = Nominal
     go (InstCo co _) = go co
diff --git a/compiler/GHC/Core/Coercion/Opt.hs b/compiler/GHC/Core/Coercion/Opt.hs
index c8335bc3c1..582edf6337 100644
--- a/compiler/GHC/Core/Coercion/Opt.hs
+++ b/compiler/GHC/Core/Coercion/Opt.hs
@@ -335,7 +335,7 @@ opt_co4 env sym rep r (TransCo co1 co2)
 
 opt_co4 env@(LC _ lift_co_env) sym rep r co@TransCoDCo{}
   | isEmptyVarEnv lift_co_env =
-    wrapRole rep (coercionRole co) $ wrapSym sym $ substCo (lcSubst env) co
+    wrapRole rep r $ wrapSym sym $ substCo (lcSubst env) co
   | otherwise = error "AMG TODO"
 
 opt_co4 env _sym rep r (NthCo _r n co)
diff --git a/compiler/GHC/Core/FVs.hs b/compiler/GHC/Core/FVs.hs
index 4d22605a0f..e9bf814f73 100644
--- a/compiler/GHC/Core/FVs.hs
+++ b/compiler/GHC/Core/FVs.hs
@@ -389,7 +389,7 @@ orphNamesOfCo (AxiomInstCo con _ cos) = orphNamesOfCoCon con `unionNameSet` orph
 orphNamesOfCo (UnivCo p _ t1 t2)    = orphNamesOfProv p `unionNameSet` orphNamesOfType t1 `unionNameSet` orphNamesOfType t2
 orphNamesOfCo (SymCo co)            = orphNamesOfCo co
 orphNamesOfCo (TransCo co1 co2)     = orphNamesOfCo co1 `unionNameSet` orphNamesOfCo co2
-orphNamesOfCo (TransCoDCo co1 dco2)     = orphNamesOfCo co1 `unionNameSet` orphNamesOfDCo dco2
+orphNamesOfCo (TransCoDCo co1 dco2 _) = orphNamesOfCo co1 `unionNameSet` orphNamesOfDCo dco2
 orphNamesOfCo (NthCo _ _ co)        = orphNamesOfCo co
 orphNamesOfCo (LRCo  _ co)          = orphNamesOfCo co
 orphNamesOfCo (InstCo co arg)       = orphNamesOfCo co `unionNameSet` orphNamesOfCo arg
diff --git a/compiler/GHC/Core/Lint.hs b/compiler/GHC/Core/Lint.hs
index 44d5ab808c..ada8e1bf23 100644
--- a/compiler/GHC/Core/Lint.hs
+++ b/compiler/GHC/Core/Lint.hs
@@ -2328,9 +2328,10 @@ lintCoercion co@(TransCo co1 co2)
        ; lintRole (text "lintCoercion TransCo") co (coercionRole co1) (coercionRole co2)
        ; return (TransCo co1' co2') }
 
-lintCoercion (TransCoDCo co1 dco2)
+lintCoercion (TransCoDCo co1 dco2 _)
   = do { co1' <- lintCoercion co1
        ; co2' <- lintDCoercion (coercionRole co1') (coercionRKind co1') dco2
+       -- TODO: think about lint; lint cache type?
        ; return (TransCo co1' co2') }
 
 lintCoercion the_co@(NthCo r0 n co)
diff --git a/compiler/GHC/Core/TyCo/FVs.hs b/compiler/GHC/Core/TyCo/FVs.hs
index 94fcb8b08d..86880c25c2 100644
--- a/compiler/GHC/Core/TyCo/FVs.hs
+++ b/compiler/GHC/Core/TyCo/FVs.hs
@@ -652,7 +652,7 @@ tyCoFVsOfCo (UnivCo p _ t1 t2) fv_cand in_scope acc
       `unionFV` tyCoFVsOfType t2) fv_cand in_scope acc
 tyCoFVsOfCo (SymCo co)          fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc
 tyCoFVsOfCo (TransCo co1 co2)   fv_cand in_scope acc = (tyCoFVsOfCo co1 `unionFV` tyCoFVsOfCo co2) fv_cand in_scope acc
-tyCoFVsOfCo (TransCoDCo co1 dco2) fv_cand in_scope acc = (tyCoFVsOfCo co1 `unionFV` tyCoFVsOfDCo dco2) fv_cand in_scope acc
+tyCoFVsOfCo (TransCoDCo co1 dco2 _) fv_cand in_scope acc = (tyCoFVsOfCo co1 `unionFV` tyCoFVsOfDCo dco2) fv_cand in_scope acc
 tyCoFVsOfCo (NthCo _ _ co)      fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc
 tyCoFVsOfCo (LRCo _ co)         fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc
 tyCoFVsOfCo (InstCo co arg)     fv_cand in_scope acc = (tyCoFVsOfCo co `unionFV` tyCoFVsOfCo arg) fv_cand in_scope acc
@@ -736,7 +736,7 @@ almost_devoid_co_var_of_co (SymCo co) cv
 almost_devoid_co_var_of_co (TransCo co1 co2) cv
   = almost_devoid_co_var_of_co co1 cv
   && almost_devoid_co_var_of_co co2 cv
-almost_devoid_co_var_of_co (TransCoDCo co1 dco2) cv
+almost_devoid_co_var_of_co (TransCoDCo co1 dco2 _) cv
   = almost_devoid_co_var_of_co co1 cv
   && almost_devoid_co_var_of_dco dco2 cv
 almost_devoid_co_var_of_co (NthCo _ _ co) cv
diff --git a/compiler/GHC/Core/TyCo/Rep.hs b/compiler/GHC/Core/TyCo/Rep.hs
index aa08f4d528..dd4ca6aa3e 100644
--- a/compiler/GHC/Core/TyCo/Rep.hs
+++ b/compiler/GHC/Core/TyCo/Rep.hs
@@ -1244,9 +1244,9 @@ data Coercion
     -- Given @co1 :: lhs ~e mid@ and @co2 :: mid ~e rhs@, the composite is
     -- @co1 ; co2 :: lhs ~e rhs@. (We use the notation @;@ instead of @`TransCo`@.)
 
-  | TransCoDCo Coercion DCoercion
+  | TransCoDCo Coercion DCoercion Type
     -- ^ Embed a directed coercion following a coercion (always an AxiomInstCo?).
-    -- TODO: should we cache the RHS?
+    -- We cache the RHS type that results from following the DCoercion.
 
   -- :: "e" -> _ -> e0 -> e (inverse of TyConAppCo, see Note [TyConAppCo roles])
   | NthCo Role Int Coercion
@@ -2158,7 +2158,7 @@ foldTyCo (TyCoFolder { tcf_view       = view
                                           `mappend` go_ty env t2
     go_co env (SymCo co)              = go_co env co
     go_co env (TransCo co1 co2)       = go_co env co1 `mappend` go_co env co2
-    go_co env (TransCoDCo co1 dco2)       = go_co env co1 `mappend` go_dco env dco2
+    go_co env (TransCoDCo co1 dco2 _) = go_co env co1 `mappend` go_dco env dco2
     go_co env (AxiomRuleCo _ cos)     = go_cos env cos
     go_co env (NthCo _ _ co)          = go_co env co
     go_co env (LRCo _ co)             = go_co env co
@@ -2246,7 +2246,7 @@ coercionSize (AxiomInstCo _ _ args) = 1 + sum (map coercionSize args)
 coercionSize (UnivCo p _ t1 t2)  = 1 + provSize coercionSize p + typeSize t1 + typeSize t2
 coercionSize (SymCo co)          = 1 + coercionSize co
 coercionSize (TransCo co1 co2)   = 1 + coercionSize co1 + coercionSize co2
-coercionSize (TransCoDCo co1 dco2)   = 1 + coercionSize co1 + dcoercionSize dco2
+coercionSize (TransCoDCo co1 dco2 ty) = 1 + coercionSize co1 + dcoercionSize dco2 + typeSize ty -- should we measure cached type?
 coercionSize (NthCo _ _ co)      = 1 + coercionSize co
 coercionSize (LRCo  _ co)        = 1 + coercionSize co
 coercionSize (InstCo co arg)     = 1 + coercionSize co + coercionSize arg
diff --git a/compiler/GHC/Core/TyCo/Subst.hs b/compiler/GHC/Core/TyCo/Subst.hs
index 902dcd78ba..40f69f6f7e 100644
--- a/compiler/GHC/Core/TyCo/Subst.hs
+++ b/compiler/GHC/Core/TyCo/Subst.hs
@@ -922,7 +922,7 @@ subst_co_dco subst = (go, go_dco)
                                 (go_ty t1)) $! (go_ty t2)
     go (SymCo co)            = mkSymCo $! (go co)
     go (TransCo co1 co2)     = (mkTransCo $! go co1) $! go co2
-    go (TransCoDCo co1 dco2) = (mkTransCoDCo $! go co1) $! go_dco dco2
+    go (TransCoDCo co1 dco2 _) = (mkTransCoDCo $! go co1) $! go_dco dco2
     go (NthCo r d co)        = mkNthCo r d $! (go co)
     go (LRCo lr co)          = mkLRCo lr $! (go co)
     go (InstCo co arg)       = (mkInstCo $! (go co)) $! go arg
diff --git a/compiler/GHC/Core/TyCo/Tidy.hs b/compiler/GHC/Core/TyCo/Tidy.hs
index fca710b0d9..4b5fb366bc 100644
--- a/compiler/GHC/Core/TyCo/Tidy.hs
+++ b/compiler/GHC/Core/TyCo/Tidy.hs
@@ -20,6 +20,7 @@ module GHC.Core.TyCo.Tidy
 import GHC.Prelude
 import GHC.Data.Maybe ( orElse )
 
+import {-# SOURCE #-} GHC.Core.Coercion ( mkTransCoDCo )
 import GHC.Core.TyCo.Rep
 import GHC.Core.TyCo.FVs (tyCoVarsOfTypesWellScoped, tyCoVarsOfTypeList)
 
@@ -247,7 +248,7 @@ tidyCoDCo env@(_, subst) = (go, go_dco)
                                 tidyType env t1) $! tidyType env t2
     go (SymCo co)            = SymCo $! go co
     go (TransCo co1 co2)     = (TransCo $! go co1) $! go co2
-    go (TransCoDCo co1 dco2) = (TransCoDCo $! go co1) $! go_dco dco2
+    go (TransCoDCo co1 dco2 _) = (mkTransCoDCo $! go co1) $! go_dco dco2
     go (NthCo r d co)        = NthCo r d $! go co
     go (LRCo lr co)          = LRCo lr $! go co
     go (InstCo co ty)        = (InstCo $! go co) $! go ty
diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs
index 2b29198cc2..7adda6c214 100644
--- a/compiler/GHC/Core/Type.hs
+++ b/compiler/GHC/Core/Type.hs
@@ -278,6 +278,7 @@ import {-# SOURCE #-} GHC.Core.Coercion
    , mkTyConAppCo, mkAppCo, mkCoVarCo, mkAxiomRuleCo
    , mkForAllCo, mkFunCo, mkAxiomInstCo, mkUnivCo
    , mkSymCo, mkTransCo, mkNthCo, mkLRCo, mkInstCo
+   , mkTransCoDCo
    , mkKindCo, mkSubCo
    , mkTyConAppDCo
    , mkAppDCo
@@ -622,8 +623,8 @@ expandTypeSynonyms ty
       = mkSymCo (go_co subst co)
     go_co subst (TransCo co1 co2)
       = mkTransCo (go_co subst co1) (go_co subst co2)
-    go_co subst (TransCoDCo co1 dco2)
-      = TransCoDCo (go_co subst co1) (go_dco subst dco2)
+    go_co subst (TransCoDCo co1 dco2 _)
+      = mkTransCoDCo (go_co subst co1) (go_dco subst dco2)
     go_co subst (NthCo r n co)
       = mkNthCo r n (go_co subst co)
     go_co subst (LRCo lr co)
@@ -997,7 +998,7 @@ mapTyCoX (TyCoMapper { tcm_tyvar = tyvar
                                     <*> go_ty env t1 <*> go_ty env t2
     go_co env (SymCo co)          = mkSymCo <$> go_co env co
     go_co env (TransCo c1 c2)     = mkTransCo <$> go_co env c1 <*> go_co env c2
-    go_co env (TransCoDCo c1 c2)  = TransCoDCo <$> go_co env c1 <*> go_dco env c2
+    go_co env (TransCoDCo c1 c2 _)  = mkTransCoDCo <$> go_co env c1 <*> go_dco env c2
     go_co env (AxiomRuleCo r cos) = AxiomRuleCo r <$> go_cos env cos
     go_co env (NthCo r i co)      = mkNthCo r i <$> go_co env co
     go_co env (LRCo lr co)        = mkLRCo lr <$> go_co env co
@@ -3472,9 +3473,9 @@ occCheckExpand vs_to_avoid ty
     go_co cxt (TransCo co1 co2)         = do { co1' <- go_co cxt co1
                                              ; co2' <- go_co cxt co2
                                              ; return (mkTransCo co1' co2') }
-    go_co cxt (TransCoDCo co1 dco2)     = do { co1' <- go_co cxt co1
+    go_co cxt (TransCoDCo co1 dco2 _)   = do { co1' <- go_co cxt co1
                                              ; dco2' <- go_dco cxt dco2
-                                             ; return (TransCoDCo co1' dco2') }
+                                             ; return (mkTransCoDCo co1' dco2') }
     go_co cxt (NthCo r n co)            = do { co' <- go_co cxt co
                                              ; return (mkNthCo r n co') }
     go_co cxt (LRCo lr co)              = do { co' <- go_co cxt co
@@ -3567,7 +3568,7 @@ tyConsOfType ty
      go_co (HoleCo {})             = emptyUniqSet
      go_co (SymCo co)              = go_co co
      go_co (TransCo co1 co2)       = go_co co1 `unionUniqSets` go_co co2
-     go_co (TransCoDCo co1 dco2)   = go_co co1 `unionUniqSets` go_dco dco2
+     go_co (TransCoDCo co1 dco2 _) = go_co co1 `unionUniqSets` go_dco dco2
      go_co (NthCo _ _ co)          = go_co co
      go_co (LRCo _ co)             = go_co co
      go_co (InstCo co arg)         = go_co co `unionUniqSets` go_co arg
diff --git a/compiler/GHC/CoreToIface.hs b/compiler/GHC/CoreToIface.hs
index 1e0b0d542c..a5ecc6e945 100644
--- a/compiler/GHC/CoreToIface.hs
+++ b/compiler/GHC/CoreToIface.hs
@@ -296,7 +296,7 @@ toIfaceCoercionDCoercion fr = (go, go_dco)
     go (AppCo co1 co2)      = IfaceAppCo  (go co1) (go co2)
     go (SymCo co)           = IfaceSymCo (go co)
     go (TransCo co1 co2)    = IfaceTransCo (go co1) (go co2)
-    go (TransCoDCo co1 dco2)    = IfaceTransCoDCo (go co1) (go_dco dco2)
+    go (TransCoDCo co1 dco2 _) = IfaceTransCoDCo (go co1) (go_dco dco2)
     go (NthCo _r d co)      = IfaceNthCo d (go co)
     go (LRCo lr co)         = IfaceLRCo lr (go co)
     go (InstCo co arg)      = IfaceInstCo (go co) (go arg)
diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs
index d440aabbcc..14d39dfd5a 100644
--- a/compiler/GHC/IfaceToCore.hs
+++ b/compiler/GHC/IfaceToCore.hs
@@ -1466,7 +1466,7 @@ tcIfaceCo = go
                                           <*> tcIfaceType t1 <*> tcIfaceType t2
     go (IfaceSymCo c)            = SymCo    <$> go c
     go (IfaceTransCo co1 co2)    = TransCo <$> go co1 <*> go co2
-    go (IfaceTransCoDCo co1 dco2) = TransCoDCo <$> go co1 <*> tcIfaceDCo dco2
+    go (IfaceTransCoDCo co1 dco2) = mkTransCoDCo <$> go co1 <*> tcIfaceDCo dco2
     go (IfaceInstCo c1 t2)       = InstCo   <$> go c1
                                             <*> go t2
     go (IfaceNthCo d c)          = do { c' <- go c
diff --git a/compiler/GHC/Tc/Solver/Rewrite.hs b/compiler/GHC/Tc/Solver/Rewrite.hs
index 962c390a8d..72a4b65a68 100644
--- a/compiler/GHC/Tc/Solver/Rewrite.hs
+++ b/compiler/GHC/Tc/Solver/Rewrite.hs
@@ -571,28 +571,28 @@ rewrite_reduction (Reduction co xi)
 
 
 mkTransRednAlt :: Coercion -> Reduction -> Reduction
-mkTransRednAlt co1 redn@(Reduction co2 _)
-  = redn { reductionCoercion = co1 `mkTransCoAlt` co2 }
+mkTransRednAlt co1 redn@(Reduction co2 xi)
+  = redn { reductionCoercion = mkTransCoAlt co1 co2 xi }
 {-# INLINE mkTransRednAlt #-}
 
 -- | Create a new 'Coercion' by composing the two given 'Coercion's transitively.
 --   (co1 ; co2)
-mkTransCoAlt :: Coercion -> Coercion -> Coercion
-mkTransCoAlt co1 co2
+mkTransCoAlt :: Coercion -> Coercion -> Type -> Coercion
+mkTransCoAlt co1 co2 _xi
   | isReflCo co1 = co2
   | isReflCo co2 = co1
-mkTransCoAlt (GRefl r t1 (MCo co1)) (GRefl _ _ (MCo co2))
+mkTransCoAlt (GRefl r t1 (MCo co1)) (GRefl _ _ (MCo co2)) _xi
   = GRefl r t1 (MCo $ mkTransCo co1 co2)
-mkTransCoAlt co1@AxiomInstCo{} co2 = TransCoDCo co1 (dehydrateCo co2)
-mkTransCoAlt (TransCo co1 co2) co3 = TransCo co1 (mkTransCoAlt co2 co3)
-mkTransCoAlt co1 co2
-  = pprTrace "mkTransCoAlt" (ppr co1 $$ ppr co2) $ TransCo co1 co2
+mkTransCoAlt co1@AxiomInstCo{} co2 xi = TransCoDCo co1 (dehydrateCo co2) xi
+mkTransCoAlt (TransCo co1 co2) co3 xi = TransCo co1 (mkTransCoAlt co2 co3 xi)
+mkTransCoAlt co1 co2 xi
+  = pprTrace "AMG mkTransCoAlt" (ppr co1 $$ ppr co2 $$ ppr xi) $ TransCo co1 co2
 
 dehydrateCo :: Coercion -> DCoercion
 dehydrateCo co | isReflCo co = ReflDCo
 dehydrateCo (TyConAppCo _ _ cos) = TyConAppDCo (map dehydrateCo cos)
 dehydrateCo (TransCo co1 co2) = TransDCo (dehydrateCo co1) (dehydrateCo co2)
-dehydrateCo (TransCoDCo co1@AxiomInstCo{} dco2) = TransDCo (splat co1) dco2
+dehydrateCo (TransCoDCo co1@AxiomInstCo{} dco2 _) = TransDCo (splat co1) dco2
 dehydrateCo co = DehydrateCo co
 
 -- Relies on invariant that LHS of TransCoDCo is always an AxiomInstCo with
diff --git a/compiler/GHC/Tc/TyCl/Utils.hs b/compiler/GHC/Tc/TyCl/Utils.hs
index f94fc518a5..7459f4f957 100644
--- a/compiler/GHC/Tc/TyCl/Utils.hs
+++ b/compiler/GHC/Tc/TyCl/Utils.hs
@@ -146,7 +146,7 @@ synonymTyConsOfType ty
      go_co (UnivCo p _ ty ty')    = go_prov go_co p `plusNameEnv` go ty `plusNameEnv` go ty'
      go_co (SymCo co)             = go_co co
      go_co (TransCo co1 co2)      = go_co co1 `plusNameEnv` go_co co2
-     go_co (TransCoDCo co1 dco2)  = go_co co1 `plusNameEnv` go_dco dco2
+     go_co (TransCoDCo co1 dco2 _)  = go_co co1 `plusNameEnv` go_dco dco2
      go_co (NthCo _ _ co)         = go_co co
      go_co (LRCo _ co)            = go_co co
      go_co (InstCo co co')        = go_co co `plusNameEnv` go_co co'
diff --git a/compiler/GHC/Tc/Utils/TcMType.hs b/compiler/GHC/Tc/Utils/TcMType.hs
index af05566229..1d6b53dac7 100644
--- a/compiler/GHC/Tc/Utils/TcMType.hs
+++ b/compiler/GHC/Tc/Utils/TcMType.hs
@@ -1529,8 +1529,8 @@ collect_cand_qtvs_co_dco orig_ty bound dv = (go_co dv, go_dco dv)
                                         collect_cand_qtvs orig_ty True bound dv2 t2
     go_co dv (SymCo co)            = go_co dv co
     go_co dv (TransCo co1 co2)     = foldlM go_co dv [co1, co2]
-    go_co dv (TransCoDCo co1 dco2) = do dv <- go_co dv co1
-                                        go_dco dv dco2
+    go_co dv (TransCoDCo co1 dco2 _) = do dv <- go_co dv co1
+                                          go_dco dv dco2
     go_co dv (NthCo _ _ co)        = go_co dv co
     go_co dv (LRCo _ co)           = go_co dv co
     go_co dv (InstCo co1 co2)      = foldlM go_co dv [co1, co2]