Commit 6bb32ba7 authored by Ryan Scott's avatar Ryan Scott
Browse files

Fix #10684 by processing deriving clauses with finer grain

Summary:
Previously, one could experience error cascades with deriving clauses
when one class in a set of many failed to derive, causing the other derived
classes to be skipped entirely and resulting in other errors down the line.
The solution is to process each class in a data type's set of deriving clauses
individually, and engineer it so that failure to derive an individual class
within that set doesn't cancel out the others.

Test Plan: make test TEST="T10684 T12801"

Reviewers: austin, bgamari, simonpj

Reviewed By: simonpj

Subscribers: simonpj, rwbarton, thomie

GHC Trac Issues: #10684, #12801

Differential Revision: https://phabricator.haskell.org/D3771
parent 36b270a9
......@@ -496,9 +496,21 @@ makeDerivSpecs :: Bool
-> [LDerivDecl GhcRn]
-> TcM [EarlyDerivSpec]
makeDerivSpecs is_boot deriv_infos deriv_decls
= do { eqns1 <- concatMapM (recoverM (return []) . deriveDerivInfo) deriv_infos
; eqns2 <- concatMapM (recoverM (return []) . deriveStandalone) deriv_decls
; let eqns = eqns1 ++ eqns2
= do { -- We carefully set up uses of recoverM to minimize error message
-- cascades. See Note [Flattening deriving clauses].
; eqns1 <- sequenceA
[ recoverM (pure Nothing)
(deriveClause rep_tc (fmap unLoc dcs)
pred err_ctxt)
| DerivInfo { di_rep_tc = rep_tc, di_clauses = clauses
, di_ctxt = err_ctxt } <- deriv_infos
, L _ (HsDerivingClause { deriv_clause_strategy = dcs
, deriv_clause_tys = L _ preds })
<- clauses
, pred <- preds
]
; eqns2 <- mapM (recoverM (pure Nothing) . deriveStandalone) deriv_decls
; let eqns = catMaybes (eqns1 ++ eqns2)
; if is_boot then -- No 'deriving' at all in hs-boot files
do { unless (null eqns) (add_deriv_err (head eqns))
......@@ -510,13 +522,69 @@ makeDerivSpecs is_boot deriv_infos deriv_decls
addErr (hang (text "Deriving not permitted in hs-boot file")
2 (text "Use an instance declaration instead"))
{-
Note [Flattening deriving clauses]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider what happens if you run this program (from Trac #10684) without
DeriveGeneric enabled:
data A = A deriving (Show, Generic)
data B = B A deriving (Show)
Naturally, you'd expect GHC to give an error to the effect of:
Can't make a derived instance of `Generic A':
You need -XDeriveGeneric to derive an instance for this class
And *only* that error, since the other two derived Show instances appear to be
independent of this derived Generic instance. Yet GHC also used to give this
additional error on the program above:
No instance for (Show A)
arising from the 'deriving' clause of a data type declaration
When deriving the instance for (Show B)
This was happening because when GHC encountered any error within a single
data type's set of deriving clauses, it would call recoverM and move on
to the next data type's deriving clauses. One unfortunate consequence of
this design is that if A's derived Generic instance failed, so its derived
Show instance would be skipped entirely, leading to the "No instance for
(Show A)" error cascade.
The solution to this problem is to "flatten" the set of classes that are
derived for a particular data type via deriving clauses. That is, if
you have:
newtype C = C D
deriving (E, F, G)
deriving anyclass (H, I, J)
deriving newtype (K, L, M)
Then instead of processing instances E through M under the scope of a single
recoverM, we flatten these deriving clauses into the list:
[ E (Nothing)
, F (Nothing)
, G (Nothing)
, H (Just anyclass)
, I (Just anyclass)
, J (Just anyclass)
, K (Just newtype)
, L (Just newtype)
, M (Just newtype) ]
And then process each class individually, under its own recoverM scope. That
way, failure to derive one class doesn't cancel out other classes in the
same set of clause-derived classes.
-}
------------------------------------------------------------------
-- | Process a `deriving` clause
deriveDerivInfo :: DerivInfo -> TcM [EarlyDerivSpec]
deriveDerivInfo (DerivInfo { di_rep_tc = rep_tc, di_clauses = clauses
, di_ctxt = err_ctxt })
-- | Process a single class in a `deriving` clause.
deriveClause :: TyCon -> Maybe DerivStrategy -> LHsSigType GhcRn -> SDoc
-> TcM (Maybe EarlyDerivSpec)
deriveClause rep_tc mb_strat pred err_ctxt
= addErrCtxt err_ctxt $
concatMapM (deriveForClause . unLoc) clauses
deriveTyData tvs tc tys mb_strat pred
where
tvs = tyConTyVars rep_tc
(tc, tys) = case tyConFamInstSig_maybe rep_tc of
......@@ -527,16 +595,14 @@ deriveDerivInfo (DerivInfo { di_rep_tc = rep_tc, di_clauses = clauses
_ -> (rep_tc, mkTyVarTys tvs) -- datatype
deriveForClause :: HsDerivingClause GhcRn -> TcM [EarlyDerivSpec]
deriveForClause (HsDerivingClause { deriv_clause_strategy = dcs
, deriv_clause_tys = L _ preds })
= concatMapM (deriveTyData tvs tc tys (fmap unLoc dcs)) preds
------------------------------------------------------------------
deriveStandalone :: LDerivDecl GhcRn -> TcM [EarlyDerivSpec]
-- Standalone deriving declarations
deriveStandalone :: LDerivDecl GhcRn -> TcM (Maybe EarlyDerivSpec)
-- Process a single standalone deriving declaration
-- e.g. deriving instance Show a => Show (T a)
-- Rather like tcLocalInstDecl
--
-- This returns a Maybe because the user might try to derive Typeable, which is
-- a no-op nowadays.
deriveStandalone (L loc (DerivDecl deriv_ty deriv_strat' overlap_mode))
= setSrcSpan loc $
addErrCtxt (standaloneCtxt deriv_ty) $
......@@ -567,7 +633,7 @@ deriveStandalone (L loc (DerivDecl deriv_ty deriv_strat' overlap_mode))
Just (tc, tc_args)
| className cls == typeableClassName
-> do warnUselessTypeable
return []
return Nothing
| isUnboxedTupleTyCon tc
-> bale_out $ unboxedTyConErr "tuple"
......@@ -579,7 +645,7 @@ deriveStandalone (L loc (DerivDecl deriv_ty deriv_strat' overlap_mode))
-> do { spec <- mkEqnHelp (fmap unLoc overlap_mode)
tvs cls cls_tys tc tc_args
(Just theta) deriv_strat
; return [spec] }
; return $ Just spec }
_ -> -- Complain about functions, primitive types, etc,
bale_out $
......@@ -598,9 +664,12 @@ deriveTyData :: [TyVar] -> TyCon -> [Type] -- LHS of data or data instance
-- Can be a data instance, hence [Type] args
-> Maybe DerivStrategy -- The optional deriving strategy
-> LHsSigType GhcRn -- The deriving predicate
-> TcM [EarlyDerivSpec]
-> TcM (Maybe EarlyDerivSpec)
-- The deriving clause of a data or newtype declaration
-- I.e. not standalone deriving
--
-- This returns a Maybe because the user might try to derive Typeable, which is
-- a no-op nowadays.
deriveTyData tvs tc tc_args deriv_strat deriv_pred
= setSrcSpan (getLoc (hsSigType deriv_pred)) $ -- Use loc of the 'deriving' item
do { (deriv_tvs, cls, cls_tys, cls_arg_kinds)
......@@ -619,7 +688,7 @@ deriveTyData tvs tc tc_args deriv_strat deriv_pred
; let [cls_arg_kind] = cls_arg_kinds
; if className cls == typeableClassName
then do warnUselessTypeable
return []
return Nothing
else
do { -- Given data T a b c = ... deriving( C d ),
......@@ -691,7 +760,7 @@ deriveTyData tvs tc tc_args deriv_strat deriv_pred
cls final_cls_tys tc final_tc_args
Nothing deriv_strat
; traceTc "derivTyData" (ppr spec)
; return [spec] } }
; return $ Just spec } }
{-
......
module A where
import GHC.Generics
data A = A deriving (Show, Generic)
data B = B A deriving (Show)
T10684.hs:3:28: error:
• Can't make a derived instance of ‘Generic A’:
You need DeriveGeneric to derive an instance for this class
• In the data declaration for ‘A’
data Container
= Container [Wibble Int]
deriving (Eq, Show)
data Wibble a
= Wibble a
| Wobble
deriving (Eq, Functor, Show)
T12801.hs:8:17: error:
• Can't make a derived instance of ‘Functor Wibble’:
You need DeriveFunctor to derive an instance for this class
• In the data declaration for ‘Wibble’
......@@ -60,7 +60,9 @@ test('T10598_fail3', normal, compile_fail, [''])
test('T10598_fail4', normal, compile_fail, [''])
test('T10598_fail5', normal, compile_fail, [''])
test('T10598_fail6', normal, compile_fail, [''])
test('T10684', normal, compile_fail, [''])
test('T11509_1', [when(doing_ghci(), extra_hc_opts('-fobject-code'))],
compile_fail, [''])
test('T12163', normal, compile_fail, [''])
test('T12512', omit_ways(['ghci']), compile_fail, [''])
test('T12801', normal, compile_fail, [''])
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