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