Rename TH constructors for deriving strategies
authorRyan Scott <ryan.gl.scott@gmail.com>
Fri, 9 Dec 2016 20:44:15 +0000 (15:44 -0500)
committerBen Gamari <ben@smart-cactus.org>
Fri, 9 Dec 2016 21:38:46 +0000 (16:38 -0500)
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

compiler/basicTypes/BasicTypes.hs
compiler/deSugar/DsMeta.hs
compiler/hsSyn/Convert.hs
compiler/parser/Parser.y
compiler/prelude/THNames.hs
compiler/typecheck/TcDeriv.hs
compiler/typecheck/TcDerivUtils.hs
libraries/template-haskell/Language/Haskell/TH/Ppr.hs
libraries/template-haskell/Language/Haskell/TH/Syntax.hs
testsuite/tests/th/T10598_TH.hs
testsuite/tests/th/T10598_TH.stderr

index a9f1e63..92c1d13 100644 (file)
@@ -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"
 
 {-
 ************************************************************************
index ee64fa7..1c33829 100644 (file)
@@ -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
index 2c863c7..2409db8 100644 (file)
@@ -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"
index b31ca79..9fe8e01 100644 (file)
@@ -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 }
 
index 8c184f8..fbda099 100644 (file)
@@ -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
 
 {- *********************************************************************
 *                                                                      *
index f3b5e6a..4fcd690 100644 (file)
@@ -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
index c6f5fa5..b9931ff 100644 (file)
@@ -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
index 8941a8b..803eaef 100644 (file)
@@ -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 $
index afe961b..4e21e8b 100644 (file)
@@ -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*
index aab8bb3..600880f 100644 (file)
@@ -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) |] ])
index 434138e..e149418 100644 (file)
@@ -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>]]