Commit 5349d648 authored by Ryan Scott's avatar Ryan Scott Committed by Ben Gamari

Rename TH constructors for deriving strategies

After talking to Richard, he and I concluded that choosing the rather
common name `Newtype` to represent the corresponding deriving strategy
in Template Haskell was a poor choice of name. I've opted to rename it
to something less common (`NewtypeStrategy`) while we still have time. I
also renamed the corrsponding datatype in the GHC internals so as to
match it.

Reviewers: austin, goldfire, hvr, bgamari

Reviewed By: bgamari

Subscribers: thomie, mpickering

Differential Revision: https://phabricator.haskell.org/D2814

GHC Trac Issues: #10598
parent d1df8d1c
...@@ -538,18 +538,19 @@ instance Outputable Origin where ...@@ -538,18 +538,19 @@ instance Outputable Origin where
-- | Which technique the user explicitly requested when deriving an instance. -- | Which technique the user explicitly requested when deriving an instance.
data DerivStrategy data DerivStrategy
-- See Note [Deriving strategies] in TcDeriv -- See Note [Deriving strategies] in TcDeriv
= DerivStock -- ^ GHC's \"standard\" strategy, which is to implement a = StockStrategy -- ^ GHC's \"standard\" strategy, which is to implement a
-- custom instance for the data type. This only works for -- custom instance for the data type. This only works
-- certain types that GHC knows about (e.g., 'Eq', 'Show', -- for certain types that GHC knows about (e.g., 'Eq',
-- 'Functor' when @-XDeriveFunctor@ is enabled, etc.) -- 'Show', 'Functor' when @-XDeriveFunctor@ is enabled,
| DerivAnyclass -- ^ @-XDeriveAnyClass@ -- etc.)
| DerivNewtype -- ^ @-XGeneralizedNewtypeDeriving@ | AnyclassStrategy -- ^ @-XDeriveAnyClass@
| NewtypeStrategy -- ^ @-XGeneralizedNewtypeDeriving@
deriving (Eq, Data) deriving (Eq, Data)
instance Outputable DerivStrategy where instance Outputable DerivStrategy where
ppr DerivStock = text "stock" ppr StockStrategy = text "stock"
ppr DerivAnyclass = text "anyclass" ppr AnyclassStrategy = text "anyclass"
ppr DerivNewtype = text "newtype" ppr NewtypeStrategy = text "newtype"
{- {-
************************************************************************ ************************************************************************
......
...@@ -2017,9 +2017,9 @@ repDerivStrategy mds = ...@@ -2017,9 +2017,9 @@ repDerivStrategy mds =
Nothing -> nothing Nothing -> nothing
Just (L _ ds) -> Just (L _ ds) ->
case ds of case ds of
DerivStock -> just =<< dataCon stockDataConName StockStrategy -> just =<< dataCon stockStrategyDataConName
DerivAnyclass -> just =<< dataCon anyclassDataConName AnyclassStrategy -> just =<< dataCon anyclassStrategyDataConName
DerivNewtype -> just =<< dataCon newtypeDataConName NewtypeStrategy -> just =<< dataCon newtypeStrategyDataConName
where where
nothing = coreNothing derivStrategyTyConName nothing = coreNothing derivStrategyTyConName
just = coreJust derivStrategyTyConName just = coreJust derivStrategyTyConName
......
...@@ -1143,9 +1143,9 @@ cvtDerivClause (TH.DerivClause ds ctxt) ...@@ -1143,9 +1143,9 @@ cvtDerivClause (TH.DerivClause ds ctxt)
; returnL $ HsDerivingClause ds' ctxt' } ; returnL $ HsDerivingClause ds' ctxt' }
cvtDerivStrategy :: TH.DerivStrategy -> Hs.DerivStrategy cvtDerivStrategy :: TH.DerivStrategy -> Hs.DerivStrategy
cvtDerivStrategy TH.Stock = Hs.DerivStock cvtDerivStrategy TH.StockStrategy = Hs.StockStrategy
cvtDerivStrategy TH.Anyclass = Hs.DerivAnyclass cvtDerivStrategy TH.AnyclassStrategy = Hs.AnyclassStrategy
cvtDerivStrategy TH.Newtype = Hs.DerivNewtype cvtDerivStrategy TH.NewtypeStrategy = Hs.NewtypeStrategy
cvtType :: TH.Type -> CvtM (LHsType RdrName) cvtType :: TH.Type -> CvtM (LHsType RdrName)
cvtType = cvtTypeKind "type" cvtType = cvtTypeKind "type"
......
...@@ -1053,11 +1053,11 @@ overlap_pragma :: { Maybe (Located OverlapMode) } ...@@ -1053,11 +1053,11 @@ overlap_pragma :: { Maybe (Located OverlapMode) }
| {- empty -} { Nothing } | {- empty -} { Nothing }
deriv_strategy :: { Maybe (Located DerivStrategy) } deriv_strategy :: { Maybe (Located DerivStrategy) }
: 'stock' {% ajs (Just (sL1 $1 DerivStock)) : 'stock' {% ajs (Just (sL1 $1 StockStrategy))
[mj AnnStock $1] } [mj AnnStock $1] }
| 'anyclass' {% ajs (Just (sL1 $1 DerivAnyclass)) | 'anyclass' {% ajs (Just (sL1 $1 AnyclassStrategy))
[mj AnnAnyclass $1] } [mj AnnAnyclass $1] }
| 'newtype' {% ajs (Just (sL1 $1 DerivNewtype)) | 'newtype' {% ajs (Just (sL1 $1 NewtypeStrategy))
[mj AnnNewtype $1] } [mj AnnNewtype $1] }
| {- empty -} { Nothing } | {- empty -} { Nothing }
......
...@@ -126,7 +126,8 @@ templateHaskellNames = [ ...@@ -126,7 +126,8 @@ templateHaskellNames = [
overlappableDataConName, overlappingDataConName, overlapsDataConName, overlappableDataConName, overlappingDataConName, overlapsDataConName,
incoherentDataConName, incoherentDataConName,
-- DerivStrategy -- DerivStrategy
stockDataConName, anyclassDataConName, newtypeDataConName, stockStrategyDataConName, anyclassStrategyDataConName,
newtypeStrategyDataConName,
-- TExp -- TExp
tExpDataConName, tExpDataConName,
-- RuleBndr -- RuleBndr
...@@ -591,10 +592,11 @@ overlapsDataConName = thCon (fsLit "Overlaps") overlapsDataConKey ...@@ -591,10 +592,11 @@ overlapsDataConName = thCon (fsLit "Overlaps") overlapsDataConKey
incoherentDataConName = thCon (fsLit "Incoherent") incoherentDataConKey incoherentDataConName = thCon (fsLit "Incoherent") incoherentDataConKey
-- data DerivStrategy = ... -- data DerivStrategy = ...
stockDataConName, anyclassDataConName, newtypeDataConName :: Name stockStrategyDataConName, anyclassStrategyDataConName,
stockDataConName = thCon (fsLit "Stock") stockDataConKey newtypeStrategyDataConName :: Name
anyclassDataConName = thCon (fsLit "Anyclass") anyclassDataConKey stockStrategyDataConName = thCon (fsLit "StockStrategy") stockDataConKey
newtypeDataConName = thCon (fsLit "Newtype") newtypeDataConKey anyclassStrategyDataConName = thCon (fsLit "AnyclassStrategy") anyclassDataConKey
newtypeStrategyDataConName = thCon (fsLit "NewtypeStrategy") newtypeDataConKey
{- ********************************************************************* {- *********************************************************************
* * * *
......
...@@ -977,12 +977,12 @@ mkDataTypeEqn :: DynFlags ...@@ -977,12 +977,12 @@ mkDataTypeEqn :: DynFlags
mkDataTypeEqn dflags overlap_mode tvs cls cls_tys mkDataTypeEqn dflags overlap_mode tvs cls cls_tys
tycon tc_args rep_tc rep_tc_args mtheta deriv_strat tycon tc_args rep_tc rep_tc_args mtheta deriv_strat
= case deriv_strat of = case deriv_strat of
Just DerivStock -> mk_eqn_stock dflags mtheta cls cls_tys rep_tc Just StockStrategy -> mk_eqn_stock dflags mtheta cls cls_tys rep_tc
go_for_it bale_out go_for_it bale_out
Just DerivAnyclass -> mk_eqn_anyclass dflags rep_tc cls Just AnyclassStrategy -> mk_eqn_anyclass dflags rep_tc cls
go_for_it bale_out go_for_it bale_out
-- GeneralizedNewtypeDeriving makes no sense for non-newtypes -- GeneralizedNewtypeDeriving makes no sense for non-newtypes
Just DerivNewtype -> bale_out gndNonNewtypeErr Just NewtypeStrategy -> bale_out gndNonNewtypeErr
-- Lacking a user-requested deriving strategy, we will try to pick -- Lacking a user-requested deriving strategy, we will try to pick
-- between the stock or anyclass strategies -- between the stock or anyclass strategies
Nothing -> mk_eqn_no_mechanism dflags tycon mtheta cls cls_tys rep_tc Nothing -> mk_eqn_no_mechanism dflags tycon mtheta cls cls_tys rep_tc
...@@ -1100,11 +1100,11 @@ mkNewTypeEqn dflags overlap_mode tvs ...@@ -1100,11 +1100,11 @@ mkNewTypeEqn dflags overlap_mode tvs
-- Want: instance (...) => cls (cls_tys ++ [tycon tc_args]) where ... -- Want: instance (...) => cls (cls_tys ++ [tycon tc_args]) where ...
= ASSERT( length cls_tys + 1 == classArity cls ) = ASSERT( length cls_tys + 1 == classArity cls )
case deriv_strat of case deriv_strat of
Just DerivStock -> mk_eqn_stock dflags mtheta cls cls_tys rep_tycon Just StockStrategy -> mk_eqn_stock dflags mtheta cls cls_tys rep_tycon
go_for_it_other bale_out go_for_it_other bale_out
Just DerivAnyclass -> mk_eqn_anyclass dflags rep_tycon cls Just AnyclassStrategy -> mk_eqn_anyclass dflags rep_tycon cls
go_for_it_other bale_out go_for_it_other bale_out
Just DerivNewtype -> Just NewtypeStrategy ->
-- Since the user explicitly asked for GeneralizedNewtypeDeriving, we -- Since the user explicitly asked for GeneralizedNewtypeDeriving, we
-- don't need to perform all of the checks we normally would, such as -- don't need to perform all of the checks we normally would, such as
-- if the class being derived is known to produce ill-roled coercions -- if the class being derived is known to produce ill-roled coercions
......
...@@ -128,9 +128,9 @@ isDerivSpecAnyClass _ = False ...@@ -128,9 +128,9 @@ isDerivSpecAnyClass _ = False
-- A DerivSpecMechanism can be losslessly converted to a DerivStrategy. -- A DerivSpecMechanism can be losslessly converted to a DerivStrategy.
mechanismToStrategy :: DerivSpecMechanism -> DerivStrategy mechanismToStrategy :: DerivSpecMechanism -> DerivStrategy
mechanismToStrategy (DerivSpecStock{}) = DerivStock mechanismToStrategy (DerivSpecStock{}) = StockStrategy
mechanismToStrategy (DerivSpecNewtype{}) = DerivNewtype mechanismToStrategy (DerivSpecNewtype{}) = NewtypeStrategy
mechanismToStrategy (DerivSpecAnyClass{}) = DerivAnyclass mechanismToStrategy (DerivSpecAnyClass{}) = AnyclassStrategy
instance Outputable DerivSpecMechanism where instance Outputable DerivSpecMechanism where
ppr = ppr . mechanismToStrategy ppr = ppr . mechanismToStrategy
......
...@@ -380,9 +380,9 @@ ppr_dec _ (PatSynSigD name ty) ...@@ -380,9 +380,9 @@ ppr_dec _ (PatSynSigD name ty)
ppr_deriv_strategy :: DerivStrategy -> Doc ppr_deriv_strategy :: DerivStrategy -> Doc
ppr_deriv_strategy ds = text $ ppr_deriv_strategy ds = text $
case ds of case ds of
Stock -> "stock" StockStrategy -> "stock"
Anyclass -> "anyclass" AnyclassStrategy -> "anyclass"
Newtype -> "newtype" NewtypeStrategy -> "newtype"
ppr_overlap :: Overlap -> Doc ppr_overlap :: Overlap -> Doc
ppr_overlap o = text $ ppr_overlap o = text $
......
...@@ -1633,9 +1633,9 @@ data DerivClause = DerivClause (Maybe DerivStrategy) Cxt ...@@ -1633,9 +1633,9 @@ data DerivClause = DerivClause (Maybe DerivStrategy) Cxt
deriving( Show, Eq, Ord, Data, Generic ) deriving( Show, Eq, Ord, Data, Generic )
-- | What the user explicitly requests when deriving an instance. -- | What the user explicitly requests when deriving an instance.
data DerivStrategy = Stock -- ^ A \"standard\" derived instance data DerivStrategy = StockStrategy -- ^ A \"standard\" derived instance
| Anyclass -- ^ @-XDeriveAnyClass@ | AnyclassStrategy -- ^ @-XDeriveAnyClass@
| Newtype -- ^ @-XGeneralizedNewtypeDeriving@ | NewtypeStrategy -- ^ @-XGeneralizedNewtypeDeriving@
deriving( Show, Eq, Ord, Data, Generic ) deriving( Show, Eq, Ord, Data, Generic )
-- | A Pattern synonym's type. Note that a pattern synonym's *fully* -- | A Pattern synonym's type. Note that a pattern synonym's *fully*
......
...@@ -31,12 +31,12 @@ $(do fooDataName <- newName "Foo" ...@@ -31,12 +31,12 @@ $(do fooDataName <- newName "Foo"
(normalC mkFooConName (normalC mkFooConName
[ bangType (bang noSourceUnpackedness noSourceStrictness) [ bangType (bang noSourceUnpackedness noSourceStrictness)
[t| Int |] ]) [t| Int |] ])
[ derivClause (Just Stock) [ [t| Eq |] ] [ derivClause (Just StockStrategy) [ [t| Eq |] ]
, derivClause (Just Anyclass) [ [t| C |] ] , derivClause (Just AnyclassStrategy) [ [t| C |] ]
, derivClause (Just Newtype) [ [t| Read |] ] ] , derivClause (Just NewtypeStrategy) [ [t| Read |] ] ]
, standaloneDerivWithStrategyD (Just Stock) , standaloneDerivWithStrategyD (Just StockStrategy)
(cxt []) [t| Ord $(fooType) |] (cxt []) [t| Ord $(fooType) |]
, standaloneDerivWithStrategyD (Just Anyclass) , standaloneDerivWithStrategyD (Just AnyclassStrategy)
(cxt []) [t| D $(fooType) |] (cxt []) [t| D $(fooType) |]
, standaloneDerivWithStrategyD (Just Newtype) , standaloneDerivWithStrategyD (Just NewtypeStrategy)
(cxt []) [t| Show $(fooType) |] ]) (cxt []) [t| Show $(fooType) |] ])
...@@ -12,21 +12,21 @@ T10598_TH.hs:(27,3)-(42,50): Splicing declarations ...@@ -12,21 +12,21 @@ T10598_TH.hs:(27,3)-(42,50): Splicing declarations
mkFooConName mkFooConName
[bangType [bangType
(bang noSourceUnpackedness noSourceStrictness) [t| Int |]]) (bang noSourceUnpackedness noSourceStrictness) [t| Int |]])
[derivClause (Just Stock) [[t| Eq |]], [derivClause (Just StockStrategy) [[t| Eq |]],
derivClause (Just Anyclass) [[t| C |]], derivClause (Just AnyclassStrategy) [[t| C |]],
derivClause (Just Newtype) [[t| Read |]]], derivClause (Just NewtypeStrategy) [[t| Read |]]],
standaloneDerivWithStrategyD standaloneDerivWithStrategyD
(Just Stock) (Just StockStrategy)
(cxt []) (cxt [])
[t| Ord $(fooType) |] [t| Ord $(fooType) |]
pending(rn) [<splice, fooType>], pending(rn) [<splice, fooType>],
standaloneDerivWithStrategyD standaloneDerivWithStrategyD
(Just Anyclass) (Just AnyclassStrategy)
(cxt []) (cxt [])
[t| D $(fooType) |] [t| D $(fooType) |]
pending(rn) [<splice, fooType>], pending(rn) [<splice, fooType>],
standaloneDerivWithStrategyD standaloneDerivWithStrategyD
(Just Newtype) (Just NewtypeStrategy)
(cxt []) (cxt [])
[t| Show $(fooType) |] [t| Show $(fooType) |]
pending(rn) [<splice, fooType>]] pending(rn) [<splice, fooType>]]
......
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