more late to catching type errors and typos

9 files changed, 26 insertions, 20 deletions

diff --git a/compiler/coreSyn/CoreFVs.hs b/compiler/coreSyn/CoreFVs.hs
index daeeaf4b66..36fcfef43a 100644
--- a/compiler/coreSyn/CoreFVs.hs
+++ b/compiler/coreSyn/CoreFVs.hs
@@ -372,7 +372,8 @@ orphNamesOfMCo MRefl    = emptyNameSet
 orphNamesOfMCo (MCo co) = orphNamesOfCo co
 
 orphNamesOfCo :: Coercion -> NameSet
-orphNamesOfCo (ErasedCoercion _r lty rty )      = orphNamesOfType lty `unionNameSet` rty
+orphNamesOfCo (ErasedCoercion _r lty rty )
+                                     = orphNamesOfType lty `unionNameSet`  orphNamesOfType rty
 orphNamesOfCo (Refl ty)             = orphNamesOfType ty
 orphNamesOfCo (GRefl _ ty mco)      = orphNamesOfType ty `unionNameSet` orphNamesOfMCo mco
 orphNamesOfCo (TyConAppCo _ tc cos) = unitNameSet (getName tc) `unionNameSet` orphNamesOfCos cos
diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs
index 02050868aa..0859ef5f96 100644
--- a/compiler/iface/IfaceSyn.hs
+++ b/compiler/iface/IfaceSyn.hs
@@ -1579,7 +1579,7 @@ freeNamesIfMCoercion (IfaceMCo co) = freeNamesIfCoercion co
 
 freeNamesIfCoercion :: IfaceCoercion -> NameSet
 freeNamesIfCoercion (IfaceErased _role ltyp rtyp)
-  = freeNamesIfType ltyp && freeNamesIfType rtyp
+  = freeNamesIfType ltyp &&& freeNamesIfType rtyp
 freeNamesIfCoercion (IfaceReflCo t) = freeNamesIfType t
 freeNamesIfCoercion (IfaceGReflCo _ t mco)
   = freeNamesIfType t &&& freeNamesIfMCoercion mco
diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs
index 39e748eff1..78aa479ba3 100644
--- a/compiler/iface/IfaceType.hs
+++ b/compiler/iface/IfaceType.hs
@@ -523,7 +523,7 @@ substIfaceType env ty
     go_co (IfaceKindCo co)           = IfaceKindCo (go_co co)
     go_co (IfaceSubCo co)            = IfaceSubCo (go_co co)
     go_co (IfaceAxiomRuleCo n cos)   = IfaceAxiomRuleCo n (go_cos cos)
-    go_co (IfaceErased role lty rty) = IfaceErased role (go_co lty rty)
+    go_co (IfaceErased role lty rty) = IfaceErased role (go lty)  (go rty)
     go_cos = map go_co
 
     go_prov IfaceUnsafeCoerceProv    = IfaceUnsafeCoerceProv
@@ -1596,7 +1596,7 @@ ppr_co ctxt_prec (IfaceSubCo co)
   = ppr_special_co ctxt_prec (text "Sub") [co]
 ppr_co ctxt_prec (IfaceKindCo co)
   = ppr_special_co ctxt_prec (text "Kind") [co]
-ppr_co ctxt_prec (IfaceErased role lty rtyp)
+ppr_co ctxt_prec (IfaceErased role lty rty)
   = maybeParen ctxt_prec appPrec $
     text "ErasedCoercion" <+> ppr role <+>
     pprParendIfaceType lty <+> pprParendIfaceType rty
@@ -1894,10 +1894,10 @@ instance Binary IfaceCoercion where
           put_ bh a
           put_ bh b
   put_ bh (IfaceErased r lty rty) = do
-          putByte bh 18
-          putByte bh r
-          putByte bh lty
-          putByte bh rty
+           putByte bh 18
+           put_ bh r
+           put_ bh lty
+           put_ bh rty
   put_ _ (IfaceFreeCoVar cv)
        = pprPanic "Can't serialise IfaceFreeCoVar" (ppr cv)
   put_ _  (IfaceHoleCo cv)
@@ -1964,7 +1964,7 @@ instance Binary IfaceCoercion where
                   role <- get bh
                   lty  <- get bh
                   rty  <- get bh
-                  return $ IfaceErased r lty rty
+                  return $ IfaceErased role lty rty
            _ -> panic ("get IfaceCoercion " ++ show tag)
 
 instance Binary IfaceUnivCoProv where
@@ -2040,7 +2040,7 @@ instance NFData IfaceCoercion where
     IfaceSubCo f1 -> rnf f1
     IfaceFreeCoVar f1 -> f1 `seq` ()
     IfaceHoleCo f1 -> f1 `seq` ()
-    IfaceErased rl lty rty-> rnf r `seq`  rn lty `seq` rnf rty
+    IfaceErased rl lty rty-> rl `seq`  rnf lty `seq` rnf rty
 
 instance NFData IfaceUnivCoProv where
   rnf x = seq x ()
diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs
index 45445c55f0..a1d1820bf6 100644
--- a/compiler/types/Coercion.hs
+++ b/compiler/types/Coercion.hs
@@ -2190,7 +2190,7 @@ coercionLKind :: Coercion -> Type
 coercionLKind co
   = go co
   where
-    go (ErasedCoercion _role ltyp _rtyp)   = ltype
+    go (ErasedCoercion _role ltyp _rtyp)   = ltyp
     go (Refl ty)                = ty
     go (GRefl _ ty _)           = ty
     go (TyConAppCo _ tc cos)    = mkTyConApp tc (map go cos)
@@ -2245,7 +2245,8 @@ go_nth d ty
 coercionRKind :: Coercion -> Type
 coercionRKind co
   = go co
-    go (ErasedCoercion _role _ltyp rtype)   = k
+  where
+    go (ErasedCoercion _role _ltyp rtype)   = rtype
     go (Refl ty)                = ty
     go (GRefl _ ty MRefl)       = ty
     go (GRefl _ ty (MCo co1))   = mkCastTy ty co1
diff --git a/compiler/types/OptCoercion.hs b/compiler/types/OptCoercion.hs
index ca83a297fc..46a4196e4e 100644
--- a/compiler/types/OptCoercion.hs
+++ b/compiler/types/OptCoercion.hs
@@ -191,7 +191,7 @@ opt_co4_wrap env sym rep r co
     pprTrace "opt_co4_wrap }" (ppr co $$ text "---" $$ ppr result) $
     result
 -}
-opt_co4 _lc _sym _rp _role e@(ErasedCoercion) = e
+opt_co4 _lc _sym _rp _role e@(ErasedCoercion _ _ _) = e
 opt_co4 env _   rep r (Refl ty)
   = ASSERT2( r == Nominal, text "Expected role:" <+> ppr r    $$
                            text "Found role:" <+> ppr Nominal $$
diff --git a/compiler/types/TyCoFVs.hs b/compiler/types/TyCoFVs.hs
index 442b37c5fd..58068c0c29 100644
--- a/compiler/types/TyCoFVs.hs
+++ b/compiler/types/TyCoFVs.hs
@@ -210,7 +210,7 @@ ty_co_vars_of_co :: Coercion -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet
 ty_co_vars_of_co (ErasedCoercion _r lty rty) is acc =  ty_co_vars_of_type rty is $
                                                        ty_co_vars_of_type lty is acc
 ty_co_vars_of_co (Refl ty)            is acc = ty_co_vars_of_type ty is acc
-ty_co_vars_of_co (GRefl _ ty mco)     is acc = ty_co_vars_of_type ty is acc $
+ty_co_vars_of_co (GRefl _ ty mco)     is acc = ty_co_vars_of_type ty is $
                                                ty_co_vars_of_mco mco is acc
 ty_co_vars_of_co (TyConAppCo _ _ cos) is acc = ty_co_vars_of_cos cos is acc
 ty_co_vars_of_co (AppCo co arg)       is acc = ty_co_vars_of_co co is $
diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs
index d5c7b647ea..484e776a6d 100644
--- a/compiler/types/TyCoRep.hs
+++ b/compiler/types/TyCoRep.hs
@@ -1068,7 +1068,7 @@ data Coercion
 
   | HoleCo CoercionHole              -- ^ See Note [Coercion holes]
                                      -- Only present during typechecking
-  | ErasedCoercion -- ^ optimization hack because cast terms blowup fusion heavy
+  | ErasedCoercion Role Type Type-- ^ optimization hack because cast terms blowup fusion heavy
                    -- code, implied whenever corelint isn't enabled
   deriving Data.Data
 
diff --git a/compiler/types/TyCoSubst.hs b/compiler/types/TyCoSubst.hs
index 8d37d1c24f..3b6535091f 100644
--- a/compiler/types/TyCoSubst.hs
+++ b/compiler/types/TyCoSubst.hs
@@ -791,7 +791,7 @@ subst_co subst co
     go_mco (MCo co) = MCo (go co)
 
     go :: Coercion -> Coercion
-    go (ErasedCoercion r lty rty ) = ErasedCoercion  r $! (go_ty lty) $! (go_ty rty)
+    go (ErasedCoercion r lty rty ) = (ErasedCoercion  r   $! (go_ty lty)) $! (go_ty rty)
     go (Refl ty)             = mkNomReflCo $! (go_ty ty)
     go (GRefl r ty mco)      = (mkGReflCo r $! (go_ty ty)) $! (go_mco mco)
     go (TyConAppCo r tc args)= let args' = map go args
diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index e95d93bfac..22100d1756 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -424,7 +424,8 @@ expandTypeSynonyms ty
     go_mco _     MRefl    = MRefl
     go_mco subst (MCo co) = MCo (go_co subst co)
 
-    go_co _ ErasedCoercion = panic "go_co for expand type synonyms pandic on erased coercions"
+    go_co subst (ErasedCoercion r lty rty)
+      = ErasedCoercion r (go subst lty) (go subst rty)
     go_co subst (Refl ty)
       = mkNomReflCo (go subst ty)
     go_co subst (GRefl r ty mco)
@@ -658,7 +659,8 @@ mapCoercion mapper@(TyCoMapper { tcm_covar = covar
     go_mco MRefl    = return MRefl
     go_mco (MCo co) = MCo <$> (go co)
 
-    go (ErasedCoercion) = return ErasedCoercion
+    go (ErasedCoercion r lty rty )
+      = ErasedCoercion r <$> mapType mapper env lty <*>  mapType mapper env rty
     go (Refl ty) = Refl <$> mapType mapper env ty
     go (GRefl r ty mco) = mkGReflCo r <$> mapType mapper env ty <*> (go_mco mco)
     go (TyConAppCo r tc args)
@@ -2683,7 +2685,9 @@ occCheckExpand vs_to_avoid ty
     go_mco ctx (MCo co) = MCo <$> go_co ctx co
 
     ------------------
-    go_co _  ErasedCoercion = Nothing
+    go_co ctx  (ErasedCoercion r lty rty ) = do { lty' <- go ctx lty
+                                              ; rty' <- go ctx rty
+                                              ; return $ ErasedCoercion  r lty' rty' }
     go_co cxt (Refl ty)                 = do { ty' <- go cxt ty
                                              ; return (mkNomReflCo ty') }
     go_co cxt (GRefl r ty mco)          = do { mco' <- go_mco cxt mco
@@ -2771,7 +2775,7 @@ tyConsOfType ty
      go (CastTy ty co)              = go ty `unionUniqSets` go_co co
      go (CoercionTy co)             = go_co co
 
-     go_co (ErasedCoercion)        = emptyUniqSet
+     go_co (ErasedCoercion r lty rty ) =  go lty `unionUniqSets` go rty
      go_co (Refl ty)               = go ty
      go_co (GRefl _ ty mco)        = go ty `unionUniqSets` go_mco mco
      go_co (TyConAppCo _ tc args)  = go_tc tc `unionUniqSets` go_cos args