summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/basicTypes/BasicTypes.hs19
-rw-r--r--compiler/deSugar/DsMeta.hs6
-rw-r--r--compiler/hsSyn/Convert.hs6
-rw-r--r--compiler/parser/Parser.y6
-rw-r--r--compiler/prelude/THNames.hs12
-rw-r--r--compiler/typecheck/TcDeriv.hs20
-rw-r--r--compiler/typecheck/TcDerivUtils.hs6
-rw-r--r--libraries/template-haskell/Language/Haskell/TH/Ppr.hs6
-rw-r--r--libraries/template-haskell/Language/Haskell/TH/Syntax.hs6
-rw-r--r--testsuite/tests/th/T10598_TH.hs12
-rw-r--r--testsuite/tests/th/T10598_TH.stderr12
11 files changed, 57 insertions, 54 deletions
diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs
index a9f1e63e1f..92c1d1315b 100644
--- a/compiler/basicTypes/BasicTypes.hs
+++ b/compiler/basicTypes/BasicTypes.hs
@@ -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"
{-
************************************************************************
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index ee64fa73f3..1c3382996e 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -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
diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs
index 2c863c75ca..2409db856a 100644
--- a/compiler/hsSyn/Convert.hs
+++ b/compiler/hsSyn/Convert.hs
@@ -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"
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index b31ca79729..9fe8e01998 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -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 }
diff --git a/compiler/prelude/THNames.hs b/compiler/prelude/THNames.hs
index 8c184f851e..fbda099d46 100644
--- a/compiler/prelude/THNames.hs
+++ b/compiler/prelude/THNames.hs
@@ -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
{- *********************************************************************
* *
diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs
index f3b5e6a987..4fcd690809 100644
--- a/compiler/typecheck/TcDeriv.hs
+++ b/compiler/typecheck/TcDeriv.hs
@@ -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
diff --git a/compiler/typecheck/TcDerivUtils.hs b/compiler/typecheck/TcDerivUtils.hs
index c6f5fa58f4..b9931ff088 100644
--- a/compiler/typecheck/TcDerivUtils.hs
+++ b/compiler/typecheck/TcDerivUtils.hs
@@ -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
diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
index 8941a8ba81..803eaef2dc 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
@@ -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 $
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index afe961b50e..4e21e8b841 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -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*
diff --git a/testsuite/tests/th/T10598_TH.hs b/testsuite/tests/th/T10598_TH.hs
index aab8bb3aa6..600880f887 100644
--- a/testsuite/tests/th/T10598_TH.hs
+++ b/testsuite/tests/th/T10598_TH.hs
@@ -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) |] ])
diff --git a/testsuite/tests/th/T10598_TH.stderr b/testsuite/tests/th/T10598_TH.stderr
index 434138eb76..e149418bbd 100644
--- a/testsuite/tests/th/T10598_TH.stderr
+++ b/testsuite/tests/th/T10598_TH.stderr
@@ -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>]]
View Lorry Controller Status