Commit a26498da authored by Brandon Chinn's avatar Brandon Chinn Committed by Marge Bot

Pass tc_args to gen_fn

parent a61411ca
......@@ -151,10 +151,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 -> (LHsBinds GhcPs, BagDerivStuff)
gen_Functor_binds :: SrcSpan -> TyCon -> [Type] -> (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 tycon _
| Phantom <- last (tyConRoles tycon)
= (unitBag fmap_bind, emptyBag)
where
......@@ -165,7 +165,7 @@ gen_Functor_binds loc tycon
coerce_Expr]
fmap_match_ctxt = mkPrefixFunRhs fmap_name
gen_Functor_binds loc tycon
gen_Functor_binds loc tycon _
= (listToBag [fmap_bind, replace_bind], emptyBag)
where
data_cons = tyConDataCons tycon
......@@ -787,10 +787,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 -> (LHsBinds GhcPs, BagDerivStuff)
gen_Foldable_binds :: SrcSpan -> TyCon -> [Type] -> (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 tycon _
| Phantom <- last (tyConRoles tycon)
= (unitBag foldMap_bind, emptyBag)
where
......@@ -801,7 +801,7 @@ gen_Foldable_binds loc tycon
mempty_Expr]
foldMap_match_ctxt = mkPrefixFunRhs foldMap_name
gen_Foldable_binds loc tycon
gen_Foldable_binds loc tycon _
| null data_cons -- There's no real point producing anything but
-- foldMap for a type with no constructors.
= (unitBag foldMap_bind, emptyBag)
......@@ -1016,10 +1016,10 @@ removes all such types from consideration.
See Note [Generated code for DeriveFoldable and DeriveTraversable].
-}
gen_Traversable_binds :: SrcSpan -> TyCon -> (LHsBinds GhcPs, BagDerivStuff)
gen_Traversable_binds :: SrcSpan -> TyCon -> [Type] -> (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 tycon _
| Phantom <- last (tyConRoles tycon)
= (unitBag traverse_bind, emptyBag)
where
......@@ -1031,7 +1031,7 @@ gen_Traversable_binds loc tycon
(nlHsApps pure_RDR [nlHsApp coerce_Expr z_Expr])]
traverse_match_ctxt = mkPrefixFunRhs traverse_name
gen_Traversable_binds loc tycon
gen_Traversable_binds loc tycon _
= (unitBag traverse_bind, emptyBag)
where
data_cons = tyConDataCons tycon
......
......@@ -212,8 +212,8 @@ for the instance decl, which it probably wasn't, so the decls
produced don't get through the typechecker.
-}
gen_Eq_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff)
gen_Eq_binds loc tycon = do
gen_Eq_binds :: SrcSpan -> TyCon -> [Type] -> TcM (LHsBinds GhcPs, BagDerivStuff)
gen_Eq_binds loc tycon _ = do
-- See Note [Auxiliary binders]
con2tag_RDR <- new_con2tag_rdr_name loc tycon
......@@ -396,8 +396,8 @@ gtResult OrdGE = true_Expr
gtResult OrdGT = true_Expr
------------
gen_Ord_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff)
gen_Ord_binds loc tycon = do
gen_Ord_binds :: SrcSpan -> TyCon -> [Type] -> TcM (LHsBinds GhcPs, BagDerivStuff)
gen_Ord_binds loc tycon _ = do
-- See Note [Auxiliary binders]
con2tag_RDR <- new_con2tag_rdr_name loc tycon
......@@ -646,8 +646,8 @@ instance ... Enum (Foo ...) where
For @enumFromTo@ and @enumFromThenTo@, we use the default methods.
-}
gen_Enum_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff)
gen_Enum_binds loc tycon = do
gen_Enum_binds :: SrcSpan -> TyCon -> [Type] -> TcM (LHsBinds GhcPs, BagDerivStuff)
gen_Enum_binds loc tycon _ = do
-- See Note [Auxiliary binders]
con2tag_RDR <- new_con2tag_rdr_name loc tycon
tag2con_RDR <- new_tag2con_rdr_name loc tycon
......@@ -738,8 +738,8 @@ gen_Enum_binds loc tycon = do
************************************************************************
-}
gen_Bounded_binds :: SrcSpan -> TyCon -> (LHsBinds GhcPs, BagDerivStuff)
gen_Bounded_binds loc tycon
gen_Bounded_binds :: SrcSpan -> TyCon -> [Type] -> (LHsBinds GhcPs, BagDerivStuff)
gen_Bounded_binds loc tycon _
| isEnumerationTyCon tycon
= (listToBag [ min_bound_enum, max_bound_enum ], emptyBag)
| otherwise
......@@ -825,9 +825,9 @@ we follow the scheme given in Figure~19 of the Haskell~1.2 report
(p.~147).
-}
gen_Ix_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff)
gen_Ix_binds :: SrcSpan -> TyCon -> [Type] -> TcM (LHsBinds GhcPs, BagDerivStuff)
gen_Ix_binds loc tycon = do
gen_Ix_binds loc tycon _ = do
-- See Note [Auxiliary binders]
con2tag_RDR <- new_con2tag_rdr_name loc tycon
tag2con_RDR <- new_tag2con_rdr_name loc tycon
......@@ -1028,10 +1028,10 @@ These instances are also useful for Read (Either Int Emp), where
we want to be able to parse (Left 3) just fine.
-}
gen_Read_binds :: (Name -> Fixity) -> SrcSpan -> TyCon
gen_Read_binds :: (Name -> Fixity) -> SrcSpan -> TyCon -> [Type]
-> (LHsBinds GhcPs, BagDerivStuff)
gen_Read_binds get_fixity loc tycon
gen_Read_binds get_fixity loc tycon _
= (listToBag [read_prec, default_readlist, default_readlistprec], emptyBag)
where
-----------------------------------------------------------------------
......@@ -1212,10 +1212,10 @@ Example
-- the most tightly-binding operator
-}
gen_Show_binds :: (Name -> Fixity) -> SrcSpan -> TyCon
gen_Show_binds :: (Name -> Fixity) -> SrcSpan -> TyCon -> [Type]
-> (LHsBinds GhcPs, BagDerivStuff)
gen_Show_binds get_fixity loc tycon
gen_Show_binds get_fixity loc tycon _
= (unitBag shows_prec, emptyBag)
where
data_cons = tyConDataCons tycon
......@@ -1385,9 +1385,10 @@ we generate
gen_Data_binds :: SrcSpan
-> TyCon -- For data families, this is the
-- *representation* TyCon
-> [Type]
-> TcM (LHsBinds GhcPs, -- The method bindings
BagDerivStuff) -- Auxiliary bindings
gen_Data_binds loc rep_tc
gen_Data_binds loc rep_tc _
= do { -- See Note [Auxiliary binders]
dataT_RDR <- new_dataT_rdr_name loc rep_tc
; dataC_RDRs <- traverse (new_dataC_rdr_name loc) data_cons
......@@ -1616,8 +1617,8 @@ Example:
-}
gen_Lift_binds :: SrcSpan -> TyCon -> (LHsBinds GhcPs, BagDerivStuff)
gen_Lift_binds loc tycon = (listToBag [lift_bind, liftTyped_bind], emptyBag)
gen_Lift_binds :: SrcSpan -> TyCon -> [Type] -> (LHsBinds GhcPs, BagDerivStuff)
gen_Lift_binds loc tycon _ = (listToBag [lift_bind, liftTyped_bind], emptyBag)
where
lift_bind = mkFunBindEC 1 loc lift_RDR (nlHsApp pure_Expr)
(map (pats_etc mk_exp) data_cons)
......
......@@ -590,21 +590,21 @@ hasStockDeriving clas
, (genClassKey, generic (gen_Generic_binds Gen0))
, (gen1ClassKey, generic (gen_Generic_binds Gen1)) ]
simple gen_fn loc tc _ _
= let (binds, deriv_stuff) = gen_fn loc tc
simple gen_fn loc tc tc_args _
= let (binds, deriv_stuff) = gen_fn loc tc tc_args
in return (binds, deriv_stuff, [])
-- Like `simple`, but monadic. The only monadic thing that these functions
-- do is allocate new Uniques, which are used for generating the names of
-- auxiliary bindings.
-- See Note [Auxiliary binders] in GHC.Tc.Deriv.Generate.
simpleM gen_fn loc tc _ _
= do { (binds, deriv_stuff) <- gen_fn loc tc
simpleM gen_fn loc tc tc_args _
= do { (binds, deriv_stuff) <- gen_fn loc tc tc_args
; return (binds, deriv_stuff, []) }
read_or_show gen_fn loc tc _ _
read_or_show gen_fn loc tc tc_args _
= do { fix_env <- getDataConFixityFun tc
; let (binds, deriv_stuff) = gen_fn fix_env loc tc
; let (binds, deriv_stuff) = gen_fn fix_env loc tc tc_args
field_names = all_field_names tc
; return (binds, deriv_stuff, field_names) }
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment