Commit affdea82 authored by Ryan Scott's avatar Ryan Scott

Allow PartialTypeSignatures in standalone deriving contexts

Summary:
At its core, this patch is a simple tweak that allows a user
to write:

```lang=haskell
deriving instance _ => Eq (Foo a)
```

Which is functionally equivalent to:

```lang=haskell
data Foo a = ...
  deriving Eq
```

But with the added flexibility that `StandaloneDeriving` gives you
(namely, the ability to use it anywhere, not just in the same module
that `Foo` was declared in). This fixes #13324, and should hopefully
address a use case brought up in #10607.

Currently, only the use of a single, extra-constraints wildcard is
permitted in a standalone deriving declaration. Any other wildcard
is rejected, so things like
`deriving instance (Eq a, _) => Eq (Foo a)` are currently forbidden.

There are quite a few knock-on changes brought on by this change:

* The `HsSyn` type used to represent standalone-derived instances
  was previously `LHsSigType`, which isn't sufficient to hold
  wildcard types. This needed to be changed to `LHsSigWcType` as a
  result.

* Previously, `DerivContext` was a simple type synonym for
  `Maybe ThetaType`, under the assumption that you'd only ever be in
  the `Nothing` case if you were in a `deriving` clause. After this
  patch, that assumption no longer holds true, as you can also be
  in this situation with standalone deriving when an
  extra-constraints wildcard is used.

  As a result, I changed `DerivContext` to be a proper datatype that
  reflects the new wrinkle that this patch adds, and plumbed this
  through the relevant parts of `TcDeriv` and friends.

* Relatedly, the error-reporting machinery in `TcErrors` also assumed
  that if you have any unsolved constraints in a derived instance,
  then you should be able to fix it by switching over to standalone
  deriving. This was always sound advice before, but with this new
  feature, it's possible to have unsolved constraints even when
  you're standalone-deriving something!

  To rectify this, I tweaked some constructors of `CtOrigin` a bit
  to reflect this new subtlety.

This requires updating the Haddock submodule. See my fork at
https://github.com/RyanGlScott/haddock/commit/067d52fd4be15a1842cbb05f42d9d482de0ad3a7

Test Plan: ./validate

Reviewers: simonpj, goldfire, bgamari

Reviewed By: simonpj

Subscribers: goldfire, rwbarton, thomie, mpickering, carter

GHC Trac Issues: #13324

Differential Revision: https://phabricator.haskell.org/D4383
parent d5577f44
......@@ -488,7 +488,7 @@ repStandaloneDerivD (L loc (DerivDecl { deriv_strategy = strat
; repDeriv strat' cxt' inst_ty' }
; return (loc, dec) }
where
(tvs, cxt, inst_ty) = splitLHsInstDeclTy ty
(tvs, cxt, inst_ty) = splitLHsInstDeclTy (dropWildCards ty)
repTyFamInstD :: TyFamInstDecl GhcRn -> DsM (Core TH.DecQ)
repTyFamInstD decl@(TyFamInstDecl { tfid_eqn = eqn })
......
......@@ -351,7 +351,7 @@ cvtDec (TH.StandaloneDerivD ds cxt ty)
; let inst_ty' = mkHsQualTy cxt loc cxt' $ L loc ty'
; returnJustL $ DerivD $
DerivDecl { deriv_strategy = fmap (L loc . cvtDerivStrategy) ds
, deriv_type = mkLHsSigType inst_ty'
, deriv_type = mkLHsSigWcType inst_ty'
, deriv_overlap_mode = Nothing } }
cvtDec (TH.DefaultSigD nm typ)
......
......@@ -1659,7 +1659,18 @@ type LDerivDecl pass = Located (DerivDecl pass)
-- | Deriving Declaration
data DerivDecl pass = DerivDecl
{ deriv_type :: LHsSigType pass
{ deriv_type :: LHsSigWcType pass
-- ^ The instance type to derive.
--
-- It uses an 'LHsSigWcType' because the context is allowed to be a
-- single wildcard:
--
-- > deriving instance _ => Eq (Foo a)
--
-- Which signifies that the context should be inferred.
-- See Note [Inferring the instance context] in TcDerivInfer.
, deriv_strategy :: Maybe (Located DerivStrategy)
, deriv_overlap_mode :: Maybe (Located OverlapMode)
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDeriving',
......
......@@ -1376,7 +1376,8 @@ stand_alone_deriving :: { LDerivDecl GhcPs }
: 'deriving' deriv_strategy 'instance' overlap_pragma inst_type
{% do { let { err = text "in the stand-alone deriving instance"
<> colon <+> quotes (ppr $5) }
; ams (sLL $1 (hsSigType $>) (DerivDecl $5 $2 $4))
; ams (sLL $1 (hsSigType $>)
(DerivDecl (mkHsWildCardBndrs $5) $2 $4))
[mj AnnDeriving $1, mj AnnInstance $3] } }
-----------------------------------------------------------------------------
......
......@@ -945,7 +945,7 @@ rnSrcDerivDecl (DerivDecl ty deriv_strat overlap)
; unless standalone_deriv_ok (addErr standaloneDerivErr)
; failIfTc (isJust deriv_strat && not deriv_strats_ok) $
illegalDerivStrategyErr $ fmap unLoc deriv_strat
; (ty', fvs) <- rnLHsInstType (text "a deriving declaration") ty
; (ty', fvs) <- rnHsSigWcType DerivDeclCtx ty
; return (DerivDecl ty' deriv_strat overlap, fvs) }
standaloneDerivErr :: SDoc
......
......@@ -170,7 +170,7 @@ rnWcBody ctxt nwc_rdrs hs_ty
, L lx (HsWildCardTy wc) <- ignoreParens hs_ctxt_last
= do { (hs_ctxt1', fvs1) <- mapFvRn (rn_top_constraint env) hs_ctxt1
; wc' <- setSrcSpan lx $
do { checkExtraConstraintWildCard env wc
do { checkExtraConstraintWildCard env hs_ctxt1 wc
; rnAnonWildCard wc }
; let hs_ctxt' = hs_ctxt1' ++ [L lx (HsWildCardTy wc')]
; (hs_ty', fvs2) <- rnLHsTyKi env hs_ty
......@@ -188,26 +188,46 @@ rnWcBody ctxt nwc_rdrs hs_ty
rn_top_constraint env = rnLHsTyKi (env { rtke_what = RnTopConstraint })
checkExtraConstraintWildCard :: RnTyKiEnv -> HsWildCardInfo GhcPs
-> RnM ()
checkExtraConstraintWildCard
:: RnTyKiEnv -> HsContext GhcPs -> HsWildCardInfo GhcPs -> RnM ()
-- Rename the extra-constraint spot in a type signature
-- (blah, _) => type
-- Check that extra-constraints are allowed at all, and
-- if so that it's an anonymous wildcard
checkExtraConstraintWildCard env wc
checkExtraConstraintWildCard env hs_ctxt wc
= checkWildCard env mb_bad
where
mb_bad | not (extraConstraintWildCardsAllowed env)
= Just (text "Extra-constraint wildcard" <+> quotes (ppr wc)
<+> text "not allowed")
= Just base_msg
-- Currently, we do not allow wildcards in their full glory in
-- standalone deriving declarations. We only allow a single
-- extra-constraints wildcard à la:
--
-- deriving instance _ => Eq (Foo a)
--
-- i.e., we don't support things like
--
-- deriving instance (Eq a, _) => Eq (Foo a)
| DerivDeclCtx {} <- rtke_ctxt env
, not (null hs_ctxt)
= Just deriv_decl_msg
| otherwise
= Nothing
base_msg = text "Extra-constraint wildcard" <+> quotes (ppr wc)
<+> text "not allowed"
deriv_decl_msg
= hang base_msg
2 (vcat [ text "except as the sole constraint"
, nest 2 (text "e.g., deriving instance _ => Eq (Foo a)") ])
extraConstraintWildCardsAllowed :: RnTyKiEnv -> Bool
extraConstraintWildCardsAllowed env
= case rtke_ctxt env of
TypeSigCtx {} -> True
ExprWithTySigCtx {} -> True
DerivDeclCtx {} -> True
_ -> False
-- | Finds free type and kind variables in a type,
......@@ -324,7 +344,7 @@ rnImplicitBndrs bind_free_tvs doc
thing_inside vars }
rnLHsInstType :: SDoc -> LHsSigType GhcPs -> RnM (LHsSigType GhcRn, FreeVars)
-- Rename the type in an instance or standalone deriving decl
-- Rename the type in an instance.
-- The 'doc_str' is "an instance declaration" or "a VECTORISE pragma"
-- Do not try to decompose the inst_ty in case it is malformed
rnLHsInstType doc inst_ty = rnHsSigType (GenericCtx doc) inst_ty
......
This diff is collapsed.
......@@ -73,6 +73,7 @@ inferConstraints mechanism
, denv_tc_args = tc_args
, denv_cls = main_cls
, denv_cls_tys = cls_tys } <- ask
; wildcard <- isStandaloneWildcardDeriv
; let is_anyclass = isDerivSpecAnyClass mechanism
infer_constraints
| is_anyclass = inferConstraintsDAC inst_tys
......@@ -86,7 +87,8 @@ inferConstraints mechanism
cls_tvs = classTyVars main_cls
sc_constraints = ASSERT2( equalLength cls_tvs inst_tys
, ppr main_cls <+> ppr inst_tys )
[ mkThetaOrigin DerivOrigin TypeLevel [] [] $
[ mkThetaOrigin (mkDerivOrigin wildcard)
TypeLevel [] [] $
substTheta cls_subst (classSCTheta main_cls) ]
cls_subst = ASSERT( equalLength cls_tvs inst_tys )
zipTvSubst cls_tvs inst_tys
......@@ -110,6 +112,7 @@ inferConstraintsDataConArgs inst_ty inst_tys
, denv_rep_tc_args = rep_tc_args
, denv_cls = main_cls
, denv_cls_tys = cls_tys } <- ask
wildcard <- isStandaloneWildcardDeriv
let tc_binders = tyConBinders rep_tc
choose_level bndr
......@@ -134,7 +137,7 @@ inferConstraintsDataConArgs inst_ty inst_tys
-- No constraints for unlifted types
-- See Note [Deriving and unboxed types]
, not (isUnliftedType arg_ty)
, let orig = DerivOriginDC data_con arg_n
, let orig = DerivOriginDC data_con arg_n wildcard
, preds_and_mbSubst
<- get_arg_constraints orig arg_t_or_k arg_ty
]
......@@ -213,7 +216,7 @@ inferConstraintsDataConArgs inst_ty inst_tys
-- Stupid constraints
stupid_constraints
= [ mkThetaOrigin DerivOrigin TypeLevel [] [] $
= [ mkThetaOrigin deriv_origin TypeLevel [] [] $
substTheta tc_subst (tyConStupidTheta rep_tc) ]
tc_subst = -- See the comment with all_rep_tc_args for an
-- explanation of this assertion
......@@ -233,7 +236,7 @@ inferConstraintsDataConArgs inst_ty inst_tys
constrs
| main_cls `hasKey` dataClassKey
, all (isLiftedTypeKind . typeKind) rep_tc_args
= [ mk_cls_pred DerivOrigin t_or_k main_cls ty
= [ mk_cls_pred deriv_origin t_or_k main_cls ty
| (t_or_k, ty) <- zip t_or_ks rep_tc_args]
| otherwise
= []
......@@ -247,6 +250,8 @@ inferConstraintsDataConArgs inst_ty inst_tys
| otherwise = cls_tys
deriv_origin = mkDerivOrigin wildcard
if -- Generic constraints are easy
| is_generic
-> return ([], tvs, inst_tys)
......@@ -292,6 +297,7 @@ inferConstraintsDAC :: [TcType] -> DerivM ([ThetaOrigin], [TyVar], [TcType])
inferConstraintsDAC inst_tys
= do { DerivEnv { denv_tvs = tvs
, denv_cls = cls } <- ask
; wildcard <- isStandaloneWildcardDeriv
; let gen_dms = [ (sel_id, dm_ty)
| (sel_id, Just (_, GenericDM dm_ty)) <- classOpItems cls ]
......@@ -322,8 +328,9 @@ inferConstraintsDAC inst_tys
; let dm_theta' = substTheta subst dm_theta
tau_eq = mkPrimEqPred meth_tau (substTy subst dm_tau)
; return (mkThetaOrigin DerivOrigin TypeLevel
meth_tvs meth_theta (tau_eq:dm_theta')) }
; return (mkThetaOrigin (mkDerivOrigin wildcard)
TypeLevel meth_tvs meth_theta
(tau_eq:dm_theta')) }
; theta_origins <- lift $ pushTcLevelM_ (mapM do_one_meth gen_dms)
-- Yuk: the pushTcLevel is to match the one wrapping the call
......@@ -334,20 +341,28 @@ inferConstraintsDAC inst_tys
{- Note [Inferring the instance context]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
There are two sorts of 'deriving':
There are two sorts of 'deriving', as represented by the two constructors
for DerivContext:
* InferContext mb_wildcard: This can either be:
- The deriving clause for a data type.
(e.g, data T a = T1 a deriving( Eq ))
In this case, mb_wildcard = Nothing.
- A standalone declaration with an extra-constraints wildcard
(e.g., deriving instance _ => Eq (Foo a))
In this case, mb_wildcard = Just loc, where loc is the location
of the extra-constraints wildcard.
* InferTheta: the deriving clause for a data type
data T a = T1 a deriving( Eq )
Here we must infer an instance context,
and generate instance declaration
instance Eq a => Eq (T a) where ...
* CheckTheta: standalone deriving
* SupplyContext theta: standalone deriving
deriving instance Eq a => Eq (T a)
Here we only need to fill in the bindings;
the instance context is user-supplied
the instance context (theta) is user-supplied
For a deriving clause (InferTheta) we must figure out the
For the InferContext case, we must figure out the
instance context (inferConstraintsDataConArgs). Suppose we are inferring
the instance context for
C t1 .. tn (T s1 .. sm)
......@@ -539,8 +554,8 @@ See also Note [nonDetCmpType nondeterminism]
simplifyInstanceContexts :: [DerivSpec [ThetaOrigin]]
-> TcM [DerivSpec ThetaType]
-- Used only for deriving clauses (InferTheta)
-- not for standalone deriving
-- Used only for deriving clauses or standalone deriving with an
-- extra-constraints wildcard (InferContext)
-- See Note [Simplifying the instance context]
simplifyInstanceContexts [] = return []
......
This diff is collapsed.
......@@ -2779,13 +2779,18 @@ mk_dict_err ctxt@(CEC {cec_encl = implics}) (ct, (matches, unifiers, unsafe_over
= empty
drv_fixes = case orig of
DerivOrigin -> [drv_fix]
DerivOriginDC {} -> [drv_fix]
DerivOriginCoerce {} -> [drv_fix]
DerivClauseOrigin -> [drv_fix False]
StandAloneDerivOrigin -> [drv_fix True]
DerivOriginDC _ _ standalone -> [drv_fix standalone]
DerivOriginCoerce _ _ _ standalone -> [drv_fix standalone]
_ -> []
drv_fix = hang (text "use a standalone 'deriving instance' declaration,")
2 (text "so you can specify the instance context yourself")
drv_fix standalone_wildcard
| standalone_wildcard
= text "fill in the wildcard constraint yourself"
| otherwise
= hang (text "use a standalone 'deriving instance' declaration,")
2 (text "so you can specify the instance context yourself")
-- Normal overlap error
overlap_msg
......
......@@ -3359,13 +3359,24 @@ data CtOrigin
-- then TypeSize = sizeTypes [ty1, .., tyn]
-- See Note [Solving superclass constraints] in TcInstDcls
| DerivOrigin -- Typechecking deriving
| DerivOriginDC DataCon Int
-- Checking constraints arising from this data con and field index
| DerivOriginCoerce Id Type Type
| DerivClauseOrigin -- Typechecking a deriving clause (as opposed to
-- standalone deriving).
| DerivOriginDC DataCon Int Bool
-- Checking constraints arising from this data con and field index. The
-- Bool argument in DerivOriginDC and DerivOriginCoerce is True if
-- standalong deriving (with a wildcard constraint) is being used. This
-- is used to inform error messages on how to recommended fixes (e.g., if
-- the argument is True, then don't recommend "use standalone deriving",
-- but rather "fill in the wildcard constraint yourself").
-- See Note [Inferring the instance context] in TcDerivInfer
| DerivOriginCoerce Id Type Type Bool
-- DerivOriginCoerce id ty1 ty2: Trying to coerce class method `id` from
-- `ty1` to `ty2`.
| StandAloneDerivOrigin -- Typechecking stand-alone deriving
| StandAloneDerivOrigin -- Typechecking stand-alone deriving. Useful for
-- constraints coming from a wildcard constraint,
-- e.g., deriving instance _ => Eq (Foo a)
-- See Note [Inferring the instance context]
-- in TcDerivInfer
| DefaultOrigin -- Typechecking a default decl
| DoOrigin -- Arising from a do expression
| DoPatOrigin (LPat GhcRn) -- Arising from a failable pattern in
......@@ -3558,14 +3569,14 @@ pprCtOrigin (KindEqOrigin t1 Nothing _ _)
pprCtOrigin (UnboundOccurrenceOf name)
= ctoHerald <+> text "an undeclared identifier" <+> quotes (ppr name)
pprCtOrigin (DerivOriginDC dc n)
pprCtOrigin (DerivOriginDC dc n _)
= hang (ctoHerald <+> text "the" <+> speakNth n
<+> text "field of" <+> quotes (ppr dc))
2 (parens (text "type" <+> quotes (ppr ty)))
where
ty = dataConOrigArgTys dc !! (n-1)
pprCtOrigin (DerivOriginCoerce meth ty1 ty2)
pprCtOrigin (DerivOriginCoerce meth ty1 ty2 _)
= hang (ctoHerald <+> text "the coercion of the method" <+> quotes (ppr meth))
2 (sep [ text "from type" <+> quotes (ppr ty1)
, nest 2 $ text "to type" <+> quotes (ppr ty2) ])
......@@ -3627,7 +3638,7 @@ pprCtO TupleOrigin = text "a tuple"
pprCtO NegateOrigin = text "a use of syntactic negation"
pprCtO (ScOrigin n) = text "the superclasses of an instance declaration"
<> whenPprDebug (parens (ppr n))
pprCtO DerivOrigin = text "the 'deriving' clause of a data type declaration"
pprCtO DerivClauseOrigin = text "the 'deriving' clause of a data type declaration"
pprCtO StandAloneDerivOrigin = text "a 'deriving' declaration"
pprCtO DefaultOrigin = text "a 'default' declaration"
pprCtO DoOrigin = text "a do statement"
......
......@@ -21,6 +21,16 @@ Full details
Language
~~~~~~~~
- GHC now permits the use of a wildcard type as the context of a standalone
``deriving`` declaration with the use of the
:extension:`PartialTypeSignatures` language extension. For instance, this
declaration: ::
deriving instance _ => Eq (Foo a)
Denotes a derived ``Eq (Foo a)`` instance, where the context is inferred in
much the same way as ordinary ``deriving`` clauses do.
See :ref:`partial-type-signatures`.
- Data declarations with empty ``where`` clauses are no longer valid without the
extension :extension:`GADTSyntax` enabled. For instance, consider the
......
......@@ -3908,11 +3908,21 @@ number of important ways:
module as the data type declaration. (But be aware of the dangers of
orphan instances (:ref:`orphan-modules`).
- You must supply an explicit context (in the example the context is
``(Eq a)``), exactly as you would in an ordinary instance
- In most cases, you must supply an explicit context (in the example the
context is ``(Eq a)``), exactly as you would in an ordinary instance
declaration. (In contrast, in a ``deriving`` clause attached to a
data type declaration, the context is inferred.)
The exception to this rule is that the context of a standalone deriving
declaration can infer its context when a single, extra-wildcards constraint
is used as the context, such as in: ::
deriving instance _ => Eq (Foo a)
This is essentially the same as if you had written ``deriving Foo`` after
the declaration for ``data Foo a``. Using this feature requires the use of
:extension:`PartialTypeSignatures` (:ref:`partial-type-signatures`).
- Unlike a ``deriving`` declaration attached to a ``data`` declaration,
the instance can be more specific than the data type (assuming you
also use :extension:`FlexibleInstances`, :ref:`instance-rules`). Consider
......@@ -11568,6 +11578,15 @@ Anonymous wildcards are also allowed in visible type applications
argument to ``wurble``, then you can say ``wurble @_ @Int`` where the first
argument is a wildcard.
Standalone ``deriving`` declarations permit the use of a single,
extra-constraints wildcard, like so: ::
deriving instance _ => Eq (Foo a)
This denotes a derived ``Eq (Foo a)`` instance where the context is inferred,
in much the same way that ordinary ``deriving`` clauses do. Any other use of
wildcards in a standalone ``deriving`` declaration is prohibited.
In all other contexts, type wildcards are disallowed, and a named wildcard is treated
as an ordinary type variable. For example: ::
......
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE StandaloneDeriving #-}
module T13324_compile where
data Option a = None | Some a
deriving instance _ => Show (Option a)
......@@ -69,6 +69,7 @@ test('T12156', normal, compile_fail, ['-fdefer-typed-holes'])
test('T12531', normal, compile, ['-fdefer-typed-holes'])
test('T12845', normal, compile, [''])
test('T12844', normal, compile, [''])
test('T13324_compile', normal, compile, ['-Wno-partial-type-signatures'])
test('T13482', normal, compile, [''])
test('T14217', normal, compile_fail, [''])
test('T14643', normal, compile, [''])
......
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE StandaloneDeriving #-}
module T13324_fail1 where
data Option a = None | Some a
deriving instance (Eq a, _) => Eq (Option a)
deriving instance (Show _) => Show (Option a)
T13324_fail1.hs:7:26: error:
Extra-constraint wildcard ‘_’ not allowed
except as the sole constraint
e.g., deriving instance _ => Eq (Foo a)
in a deriving declaration
T13324_fail1.hs:8:25: error:
Wildcard ‘_’ not allowed
in a deriving declaration
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE StandaloneDeriving #-}
module T13324_fail2 where
newtype Foo f a = Foo (f (f a))
deriving instance _ => Eq (Foo f a)
data T a where
MkT :: T Int
deriving instance _ => Eq (T a)
T13324_fail2.hs:7:1: error:
• No instance for (Eq (f (f a)))
arising from a 'deriving' declaration
Possible fix: fill in the wildcard constraint yourself
• When deriving the instance for (Eq (Foo f a))
T13324_fail2.hs:11:1: error:
• Can't make a derived instance of ‘Eq (T a)’:
Constructor ‘MkT’ is a GADT
Possible fix: fill in the wildcard constraint yourself
• In the stand-alone deriving instance for ‘_ => Eq (T a)’
......@@ -64,6 +64,8 @@ test('PatBind3', normal, compile_fail, [''])
test('T12039', normal, compile_fail, [''])
test('T12634', normal, compile_fail, [''])
test('T12732', normal, compile_fail, ['-fobject-code -fdefer-typed-holes'])
test('T13324_fail1', normal, compile_fail, [''])
test('T13324_fail2', normal, compile_fail, [''])
test('T14040a', normal, compile_fail, [''])
test('T14449', normal, compile_fail, [''])
test('T14479', normal, compile_fail, [''])
......
Subproject commit 4804e39144dc0ded9b38dbb3442b6016ac719a1a
Subproject commit 067d52fd4be15a1842cbb05f42d9d482de0ad3a7
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