diff options
Diffstat (limited to 'compiler/GHC/Tc/Deriv/Functor.hs')
| -rw-r--r-- | compiler/GHC/Tc/Deriv/Functor.hs | 21 |
1 files changed, 12 insertions, 9 deletions
diff --git a/compiler/GHC/Tc/Deriv/Functor.hs b/compiler/GHC/Tc/Deriv/Functor.hs index bc22c6f7c9..204c8ce88d 100644 --- a/compiler/GHC/Tc/Deriv/Functor.hs +++ b/compiler/GHC/Tc/Deriv/Functor.hs @@ -149,10 +149,10 @@ is a similar algorithm for generating `p <$ x` (for some constant `p`): $(coreplace 'a '(tb -> tc) x) = \(y:tb[b/a]) -> $(coreplace 'a' 'tc' (x $(replace 'a 'tb y))) -} -gen_Functor_binds :: SrcSpan -> TyCon -> [Type] -> (LHsBinds GhcPs, BagDerivStuff) +gen_Functor_binds :: SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, BagDerivStuff) -- When the argument is phantom, we can use fmap _ = coerce -- See Note [Phantom types with Functor, Foldable, and Traversable] -gen_Functor_binds loc tycon _ +gen_Functor_binds loc (DerivInstTys{dit_rep_tc = tycon}) | Phantom <- last (tyConRoles tycon) = (unitBag fmap_bind, emptyBag) where @@ -163,7 +163,8 @@ gen_Functor_binds loc tycon _ coerce_Expr] fmap_match_ctxt = mkPrefixFunRhs fmap_name -gen_Functor_binds loc tycon tycon_args +gen_Functor_binds loc (DerivInstTys{ dit_rep_tc = tycon + , dit_rep_tc_args = tycon_args }) = (listToBag [fmap_bind, replace_bind], emptyBag) where data_cons = getPossibleDataCons tycon tycon_args @@ -783,10 +784,10 @@ could surprise users if they switch to other types, but Ryan Scott seems to think it's okay to do it for now. -} -gen_Foldable_binds :: SrcSpan -> TyCon -> [Type] -> (LHsBinds GhcPs, BagDerivStuff) +gen_Foldable_binds :: SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, BagDerivStuff) -- When the parameter is phantom, we can use foldMap _ _ = mempty -- See Note [Phantom types with Functor, Foldable, and Traversable] -gen_Foldable_binds loc tycon _ +gen_Foldable_binds loc (DerivInstTys{dit_rep_tc = tycon}) | Phantom <- last (tyConRoles tycon) = (unitBag foldMap_bind, emptyBag) where @@ -797,7 +798,8 @@ gen_Foldable_binds loc tycon _ mempty_Expr] foldMap_match_ctxt = mkPrefixFunRhs foldMap_name -gen_Foldable_binds loc tycon tycon_args +gen_Foldable_binds loc (DerivInstTys{ dit_rep_tc = tycon + , dit_rep_tc_args = tycon_args }) | null data_cons -- There's no real point producing anything but -- foldMap for a type with no constructors. = (unitBag foldMap_bind, emptyBag) @@ -1016,10 +1018,10 @@ removes all such types from consideration. See Note [Generated code for DeriveFoldable and DeriveTraversable]. -} -gen_Traversable_binds :: SrcSpan -> TyCon -> [Type] -> (LHsBinds GhcPs, BagDerivStuff) +gen_Traversable_binds :: SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, BagDerivStuff) -- When the argument is phantom, we can use traverse = pure . coerce -- See Note [Phantom types with Functor, Foldable, and Traversable] -gen_Traversable_binds loc tycon _ +gen_Traversable_binds loc (DerivInstTys{dit_rep_tc = tycon}) | Phantom <- last (tyConRoles tycon) = (unitBag traverse_bind, emptyBag) where @@ -1031,7 +1033,8 @@ gen_Traversable_binds loc tycon _ (nlHsApps pure_RDR [nlHsApp coerce_Expr z_Expr])] traverse_match_ctxt = mkPrefixFunRhs traverse_name -gen_Traversable_binds loc tycon tycon_args +gen_Traversable_binds loc (DerivInstTys{ dit_rep_tc = tycon + , dit_rep_tc_args = tycon_args }) = (unitBag traverse_bind, emptyBag) where data_cons = getPossibleDataCons tycon tycon_args |