ghc-lib-8.8.1.20191204: The GHC API, decoupled from GHC versions

Safe HaskellNone
LanguageHaskell2010

TcDerivUtils

Synopsis

Documentation

type DerivM = ReaderT DerivEnv TcRn Source #

To avoid having to manually plumb everything in DerivEnv throughout various functions in TcDeriv and TcDerivInfer, we use DerivM, which is a simple reader around TcRn.

data DerivEnv Source #

Contains all of the information known about a derived instance when determining what its EarlyDerivSpec should be.

Constructors

DerivEnv 

Fields

Instances
Outputable DerivEnv Source # 
Instance details

Defined in TcDerivUtils

data DerivSpec theta Source #

Instances
Outputable theta => Outputable (DerivSpec theta) Source # 
Instance details

Defined in TcDerivUtils

Methods

ppr :: DerivSpec theta -> SDoc #

pprPrec :: Rational -> DerivSpec theta -> SDoc #

data DerivContext Source #

Whether GHC is processing a deriving clause or a standalone deriving declaration.

Constructors

InferContext (Maybe SrcSpan)

'InferContext mb_wildcard is either:

  • A deriving clause (in which case mb_wildcard is Nothing).
  • A standalone deriving declaration with an extra-constraints wildcard as the context (in which case mb_wildcard is Just loc, where loc is the location of the wildcard.

GHC should infer the context.

SupplyContext ThetaType

SupplyContext theta is a standalone deriving declaration, where theta is the context supplied by the user.

Instances
Outputable DerivContext Source # 
Instance details

Defined in TcDerivUtils

data OriginativeDerivStatus Source #

Records whether a particular class can be derived by way of an originative deriving strategy (i.e., stock or anyclass).

See Note [Deriving strategies] in TcDeriv.

isStandaloneDeriv :: DerivM Bool Source #

Is GHC processing a standalone deriving declaration?

isStandaloneWildcardDeriv :: DerivM Bool Source #

Is GHC processing a standalone deriving declaration with an extra-constraints wildcard as the context? (e.g., deriving instance _ => Eq (Foo a))

mkDerivOrigin :: Bool -> CtOrigin Source #

mkDerivOrigin wc returns StandAloneDerivOrigin if wc is True, and DerivClauseOrigin if wc is False. Useful for error-reporting.

data PredOrigin Source #

A PredType annotated with the origin of the constraint CtOrigin, and whether or the constraint deals in types or kinds.

Instances
Outputable PredOrigin Source # 
Instance details

Defined in TcDerivUtils

data ThetaOrigin Source #

A list of wanted PredOrigin constraints (to_wanted_origins) to simplify when inferring a derived instance's context. These are used in all deriving strategies, but in the particular case of DeriveAnyClass, we need extra information. In particular, we need:

  • to_anyclass_skols, the list of type variables bound by a class method's regular type signature, which should be rigid.
  • to_anyclass_metas, the list of type variables bound by a class method's default type signature. These can be unified as necessary.
  • to_anyclass_givens, the list of constraints from a class method's regular type signature, which can be used to help solve constraints in the to_wanted_origins.

(Note that to_wanted_origins will likely contain type variables from the derived type class or data type, neither of which will appear in to_anyclass_skols or to_anyclass_metas.)

For all other deriving strategies, it is always the case that to_anyclass_skols, to_anyclass_metas, and to_anyclass_givens are empty.

Here is an example to illustrate this:

class Foo a where
  bar :: forall b. Ix b => a -> b -> String
  default bar :: forall y. (Show a, Ix y) => a -> y -> String
  bar x y = show x ++ show (range (y, y))

  baz :: Eq a => a -> a -> Bool
  default baz :: Ord a => a -> a -> Bool
  baz x y = compare x y == EQ

data Quux q = Quux deriving anyclass Foo

Then it would generate two ThetaOrigins, one for each method:

[ ThetaOrigin { to_anyclass_skols  = [b]
              , to_anyclass_metas  = [y]
              , to_anyclass_givens = [Ix b]
              , to_wanted_origins  = [ Show (Quux q), Ix y
                                     , (Quux q -> b -> String) ~
                                       (Quux q -> y -> String)
                                     ] }
, ThetaOrigin { to_anyclass_skols  = []
              , to_anyclass_metas  = []
              , to_anyclass_givens = [Eq (Quux q)]
              , to_wanted_origins  = [ Ord (Quux q)
                                     , (Quux q -> Quux q -> Bool) ~
                                       (Quux q -> Quux q -> Bool)
                                     ] }
]

(Note that the type variable q is bound by the data type Quux, and thus it appears in neither to_anyclass_skols nor to_anyclass_metas.)

See Note [Gathering and simplifying constraints for DeriveAnyClass] in TcDerivInfer for an explanation of how to_wanted_origins are determined in DeriveAnyClass, as well as how to_anyclass_skols, to_anyclass_metas, and to_anyclass_givens are used.

Instances
Outputable ThetaOrigin Source # 
Instance details

Defined in TcDerivUtils