{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DerivingStrategies #-}

-- | Renamer-level information about 'Name's.
--
-- Renamer equivalent of 'TyThing'.
module GHC.Types.GREInfo where

import GHC.Prelude

import GHC.Types.Basic
import GHC.Types.FieldLabel
import GHC.Types.Name
import GHC.Types.Unique
import GHC.Types.Unique.Set
import GHC.Utils.Outputable
import GHC.Utils.Panic

import Control.DeepSeq ( NFData(..), deepseq )

import Data.Data ( Data )
import Data.List.NonEmpty ( NonEmpty )
import qualified Data.List.NonEmpty as NonEmpty

{-**********************************************************************
*                                                                      *
                           GREInfo
*                                                                      *
************************************************************************

Note [GREInfo]
~~~~~~~~~~~~~~
In the renamer, we sometimes need a bit more information about a 'Name', e.g.
whether it is a type constructor, class, data constructor, record field, etc.

For example, when typechecking record construction, the renamer needs to look
up the fields of the data constructor being used (see e.g. GHC.Rename.Pat.rnHsRecFields).
Extra information also allows us to provide better error messages when a fatal
error occurs in the renamer, as it allows us to distinguish classes, type families,
type synonyms, etc.

For imported Names, we have access to the full type information in the form of
a TyThing (although see Note [Retrieving the GREInfo from interfaces]).
However, for Names in the module currently being renamed, we don't
yet have full information. Instead of using TyThing, we use the GREInfo type,
and this information gets affixed to each element in the GlobalRdrEnv.

This allows us to treat imported and local Names in a consistent manner:
always look at the GREInfo.

Note [Retrieving the GREInfo from interfaces]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If we have a TyThing, we can easily compute the corresponding GREInfo: this is
done in GHC.Types.TyThing.tyThingGREInfo.

However, one often needs to produce GlobalRdrElts (and thus their GREInfos)
directly after loading interface files, before they are typechecked. For example:

  - GHC.Tc.Module.tcRnModuleTcRnM first calls tcRnImports, which starts off
    calling rnImports which transitively calls filterImports. That function
    is responsible for coughing up GlobalRdrElts (and their GREInfos) obtained
    from interfaces, but we will only typecheck the interfaces after we have
    finished processing the imports (see e.g. the logic at the start of tcRnImports
    which sets eps_is_boot, which decides whether we should look in the boot
    or non-boot interface for any particular module).
  - GHC.Tc.Utils.Backpack.mergeSignatures first loads the relevant signature
    interfaces to merge them, but only later on does it typecheck them.

In both of these examples, what's important is that we **lazily** produce the
GREInfo: it should only be consulted once the interfaces have been typechecked,
which will add the necessary information to the type-level environment.
In particular, the respective functions 'filterImports' and 'mergeSignatures'
should NOT force the gre_info field.

We delay the loading of interfaces by making the gre_info field of 'GlobalRdrElt'
a thunk which, when forced, loads the interface, looks up the 'Name' in the type
environment to get its associated TyThing, and computes the GREInfo from that.
See 'GHC.Rename.Env.lookupGREInfo'.

A possible alternative design would be to change the AvailInfo datatype to also
store GREInfo. We currently don't do that, as this would mean that every time
an interface re-exports something it has to also provide its GREInfo, which
could lead to bloat.

Note [Forcing GREInfo]
~~~~~~~~~~~~~~~~~~~~~~
The GREInfo field of a GlobalRdrElt needs to be lazy, as explained in
Note [Retrieving the GREInfo from interfaces]. For imported things, this field
is usually a thunk which looks up the GREInfo in a type environment
(see GHC.Rename.Env.lookupGREInfo).

We thus need to be careful not to introduce space leaks: such thunks could end
up retaining old type environments, which would violate invariant (5) of
Note [GHC Heap Invariants] in GHC.Driver.Make. This can happen, for example,
when reloading in GHCi (see e.g. test T15369, which can trigger the ghci leak check
if we're not careful).

A naive approach is to simply deeply force the whole GlobalRdrEnv. However,
forcing the GREInfo thunks can force the loading of interface files which we
otherwise might not need to load, so it leads to wasted work.

Instead, whenever we are about to store the GlobalRdrEnv somewhere (such as
in ModDetails), we dehydrate it by stripping away the GREInfo field, turning it
into (). See 'forceGlobalRdrEnv' and its cousin 'hydrateGlobalRdrEnv',
as well as Note [IfGlobalRdrEnv] in GHC.Types.Name.Reader.

Search for references to this note in the code for illustration.
-}

-- | Information about a 'Name' that is pertinent to the renamer.
--
-- See Note [GREInfo]
data GREInfo
      -- | No particular information... e.g. a function
    = Vanilla
      -- | An unbound GRE... could be anything
    | UnboundGRE
      -- | 'TyCon'
    | IAmTyCon    !(TyConFlavour Name)
      -- | 'ConLike'
    | IAmConLike  !ConInfo
      -- ^ The constructor fields.
      -- See Note [Local constructor info in the renamer].
      -- | Record field
    | IAmRecField !RecFieldInfo

    deriving Typeable GREInfo
Typeable GREInfo =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> GREInfo -> c GREInfo)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c GREInfo)
-> (GREInfo -> Constr)
-> (GREInfo -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c GREInfo))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GREInfo))
-> ((forall b. Data b => b -> b) -> GREInfo -> GREInfo)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> GREInfo -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> GREInfo -> r)
-> (forall u. (forall d. Data d => d -> u) -> GREInfo -> [u])
-> (forall u.
    Arity -> (forall d. Data d => d -> u) -> GREInfo -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> GREInfo -> m GREInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> GREInfo -> m GREInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> GREInfo -> m GREInfo)
-> Data GREInfo
GREInfo -> Constr
GREInfo -> DataType
(forall b. Data b => b -> b) -> GREInfo -> GREInfo
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Arity -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Arity -> (forall d. Data d => d -> u) -> GREInfo -> u
forall u. (forall d. Data d => d -> u) -> GREInfo -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GREInfo -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GREInfo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GREInfo -> m GREInfo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GREInfo -> m GREInfo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GREInfo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GREInfo -> c GREInfo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GREInfo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GREInfo)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GREInfo -> c GREInfo
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GREInfo -> c GREInfo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GREInfo
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GREInfo
$ctoConstr :: GREInfo -> Constr
toConstr :: GREInfo -> Constr
$cdataTypeOf :: GREInfo -> DataType
dataTypeOf :: GREInfo -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GREInfo)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GREInfo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GREInfo)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GREInfo)
$cgmapT :: (forall b. Data b => b -> b) -> GREInfo -> GREInfo
gmapT :: (forall b. Data b => b -> b) -> GREInfo -> GREInfo
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GREInfo -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GREInfo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GREInfo -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GREInfo -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> GREInfo -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> GREInfo -> [u]
$cgmapQi :: forall u. Arity -> (forall d. Data d => d -> u) -> GREInfo -> u
gmapQi :: forall u. Arity -> (forall d. Data d => d -> u) -> GREInfo -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GREInfo -> m GREInfo
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GREInfo -> m GREInfo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GREInfo -> m GREInfo
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GREInfo -> m GREInfo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GREInfo -> m GREInfo
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GREInfo -> m GREInfo
Data

instance NFData GREInfo where
  rnf :: GREInfo -> ()
rnf GREInfo
Vanilla = ()
  rnf GREInfo
UnboundGRE = ()
  rnf (IAmTyCon TyConFlavour Name
tc) = TyConFlavour Name -> ()
forall a. NFData a => a -> ()
rnf TyConFlavour Name
tc
  rnf (IAmConLike ConInfo
info) = ConInfo -> ()
forall a. NFData a => a -> ()
rnf ConInfo
info
  rnf (IAmRecField RecFieldInfo
info) = RecFieldInfo -> ()
forall a. NFData a => a -> ()
rnf RecFieldInfo
info

plusGREInfo :: GREInfo -> GREInfo -> GREInfo
plusGREInfo :: GREInfo -> GREInfo -> GREInfo
plusGREInfo GREInfo
Vanilla GREInfo
Vanilla = GREInfo
Vanilla
plusGREInfo GREInfo
UnboundGRE GREInfo
UnboundGRE = GREInfo
UnboundGRE
plusGREInfo (IAmTyCon {})    info2 :: GREInfo
info2@(IAmTyCon {}) = GREInfo
info2
plusGREInfo (IAmConLike {})  info2 :: GREInfo
info2@(IAmConLike {}) = GREInfo
info2
plusGREInfo (IAmRecField {}) info2 :: GREInfo
info2@(IAmRecField {}) = GREInfo
info2
plusGREInfo GREInfo
info1 GREInfo
info2 = String -> SDoc -> GREInfo
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"plusInfo" (SDoc -> GREInfo) -> SDoc -> GREInfo
forall a b. (a -> b) -> a -> b
$
  [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"info1:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GREInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr GREInfo
info1
       , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"info2:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GREInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr GREInfo
info2 ]

instance Outputable GREInfo where
  ppr :: GREInfo -> SDoc
ppr GREInfo
Vanilla = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Vanilla"
  ppr GREInfo
UnboundGRE = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"UnboundGRE"
  ppr (IAmTyCon TyConFlavour Name
flav)
    = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TyCon" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TyConFlavour Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyConFlavour Name
flav
  ppr (IAmConLike ConInfo
info)
    = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ConLike" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ConInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr ConInfo
info
  ppr (IAmRecField RecFieldInfo
info)
    = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RecField" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RecFieldInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr RecFieldInfo
info

{-**********************************************************************
*                                                                      *
                      Constructor info
*                                                                      *
************************************************************************

Note [Local constructor info in the renamer]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
As explained in Note [GREInfo], information pertinent to the renamer is
stored using the GREInfo datatype. What information do we need about constructors?

Consider the following example:

  data T = T1 { x, y :: Int }
         | T2 { x :: Int }
         | T3
         | T4 Int Bool

We need to know:
* The fields of the data constructor, so that
  - We can complain if you say `T1 { v = 3 }`, where `v` is not a field of `T1`
    See the following call stack
    * GHC.Rename.Expr.rnExpr (RecordCon case)
    * GHC.Rename.Pat.rnHsRecFields
    * GHC.Rename.Env.lookupRecFieldOcc
  - Ditto if you pattern match on `T1 { v = x }`.
    See the following call stack
    * GHC.Rename.Pat.rnHsRecPatsAndThen
    * GHC.Rename.Pat.rnHsRecFields
    * GHC.Rename.Env.lookupRecFieldOcc
  - We can fill in the dots if you say `T1 {..}` in construction or pattern matching
    See GHC.Rename.Pat.rnHsRecFields.rn_dotdot

* Whether the contructor is nullary.
  We need to know this to accept `T2 {..}`, and `T3 {..}`, but reject `T4 {..}`,
  in both construction and pattern matching.
  See GHC.Rename.Pat.rnHsRecFields.rn_dotdot
  and Note [Nullary constructors and empty record wildcards]

Note [Nullary constructors and empty record wildcards]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A nullary constructor is one with no arguments.
For example, both `data T = MkT` and `data T = MkT {}` are nullary.

For consistency and TH convenience, it was agreed that a `{..}`
match or usage on nullary constructors would be accepted.
This is done as as per https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0496-empty-record-wildcards.rst
-}

-- | Information about the record fields of a constructor.
--
-- See Note [Local constructor info in the renamer]
data ConInfo
  = ConHasRecordFields (NonEmpty FieldLabel)
  | ConHasPositionalArgs
  | ConIsNullary
  deriving stock ConInfo -> ConInfo -> Bool
(ConInfo -> ConInfo -> Bool)
-> (ConInfo -> ConInfo -> Bool) -> Eq ConInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConInfo -> ConInfo -> Bool
== :: ConInfo -> ConInfo -> Bool
$c/= :: ConInfo -> ConInfo -> Bool
/= :: ConInfo -> ConInfo -> Bool
Eq
  deriving Typeable ConInfo
Typeable ConInfo =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ConInfo -> c ConInfo)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ConInfo)
-> (ConInfo -> Constr)
-> (ConInfo -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ConInfo))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ConInfo))
-> ((forall b. Data b => b -> b) -> ConInfo -> ConInfo)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ConInfo -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ConInfo -> r)
-> (forall u. (forall d. Data d => d -> u) -> ConInfo -> [u])
-> (forall u.
    Arity -> (forall d. Data d => d -> u) -> ConInfo -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ConInfo -> m ConInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ConInfo -> m ConInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ConInfo -> m ConInfo)
-> Data ConInfo
ConInfo -> Constr
ConInfo -> DataType
(forall b. Data b => b -> b) -> ConInfo -> ConInfo
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Arity -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Arity -> (forall d. Data d => d -> u) -> ConInfo -> u
forall u. (forall d. Data d => d -> u) -> ConInfo -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConInfo -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConInfo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ConInfo -> m ConInfo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConInfo -> m ConInfo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ConInfo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ConInfo -> c ConInfo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ConInfo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ConInfo)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ConInfo -> c ConInfo
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ConInfo -> c ConInfo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ConInfo
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ConInfo
$ctoConstr :: ConInfo -> Constr
toConstr :: ConInfo -> Constr
$cdataTypeOf :: ConInfo -> DataType
dataTypeOf :: ConInfo -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ConInfo)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ConInfo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ConInfo)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ConInfo)
$cgmapT :: (forall b. Data b => b -> b) -> ConInfo -> ConInfo
gmapT :: (forall b. Data b => b -> b) -> ConInfo -> ConInfo
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConInfo -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConInfo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConInfo -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConInfo -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ConInfo -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ConInfo -> [u]
$cgmapQi :: forall u. Arity -> (forall d. Data d => d -> u) -> ConInfo -> u
gmapQi :: forall u. Arity -> (forall d. Data d => d -> u) -> ConInfo -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ConInfo -> m ConInfo
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ConInfo -> m ConInfo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConInfo -> m ConInfo
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConInfo -> m ConInfo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConInfo -> m ConInfo
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConInfo -> m ConInfo
Data

instance NFData ConInfo where
  rnf :: ConInfo -> ()
rnf ConInfo
ConIsNullary = ()
  rnf ConInfo
ConHasPositionalArgs = ()
  rnf (ConHasRecordFields NonEmpty FieldLabel
flds) = NonEmpty FieldLabel -> ()
forall a. NFData a => a -> ()
rnf NonEmpty FieldLabel
flds

mkConInfo :: Arity -> [FieldLabel] -> ConInfo
mkConInfo :: Arity -> [FieldLabel] -> ConInfo
mkConInfo Arity
0 [FieldLabel]
_ = ConInfo
ConIsNullary
mkConInfo Arity
_ [FieldLabel]
fields = ConInfo
-> (NonEmpty FieldLabel -> ConInfo)
-> Maybe (NonEmpty FieldLabel)
-> ConInfo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ConInfo
ConHasPositionalArgs NonEmpty FieldLabel -> ConInfo
ConHasRecordFields
                   (Maybe (NonEmpty FieldLabel) -> ConInfo)
-> Maybe (NonEmpty FieldLabel) -> ConInfo
forall a b. (a -> b) -> a -> b
$ [FieldLabel] -> Maybe (NonEmpty FieldLabel)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [FieldLabel]
fields

conInfoFields :: ConInfo -> [FieldLabel]
conInfoFields :: ConInfo -> [FieldLabel]
conInfoFields (ConHasRecordFields NonEmpty FieldLabel
fields) = NonEmpty FieldLabel -> [FieldLabel]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty FieldLabel
fields
conInfoFields ConInfo
ConHasPositionalArgs = []
conInfoFields ConInfo
ConIsNullary = []

instance Outputable ConInfo where
  ppr :: ConInfo -> SDoc
ppr ConInfo
ConIsNullary = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ConIsNullary"
  ppr ConInfo
ConHasPositionalArgs = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ConHasPositionalArgs"
  ppr (ConHasRecordFields NonEmpty FieldLabel
fieldLabels) =
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ConHasRecordFields" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (NonEmpty FieldLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr NonEmpty FieldLabel
fieldLabels)

-- | The 'Name' of a 'ConLike'.
--
-- Useful when we are in the renamer and don't yet have a full 'DataCon' or
-- 'PatSyn' to hand.
data ConLikeName
  = DataConName { ConLikeName -> Name
conLikeName_Name :: !Name }
  | PatSynName  { conLikeName_Name :: !Name }
  deriving (ConLikeName -> ConLikeName -> Bool
(ConLikeName -> ConLikeName -> Bool)
-> (ConLikeName -> ConLikeName -> Bool) -> Eq ConLikeName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConLikeName -> ConLikeName -> Bool
== :: ConLikeName -> ConLikeName -> Bool
$c/= :: ConLikeName -> ConLikeName -> Bool
/= :: ConLikeName -> ConLikeName -> Bool
Eq, Typeable ConLikeName
Typeable ConLikeName =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ConLikeName -> c ConLikeName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ConLikeName)
-> (ConLikeName -> Constr)
-> (ConLikeName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ConLikeName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ConLikeName))
-> ((forall b. Data b => b -> b) -> ConLikeName -> ConLikeName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ConLikeName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ConLikeName -> r)
-> (forall u. (forall d. Data d => d -> u) -> ConLikeName -> [u])
-> (forall u.
    Arity -> (forall d. Data d => d -> u) -> ConLikeName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ConLikeName -> m ConLikeName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ConLikeName -> m ConLikeName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ConLikeName -> m ConLikeName)
-> Data ConLikeName
ConLikeName -> Constr
ConLikeName -> DataType
(forall b. Data b => b -> b) -> ConLikeName -> ConLikeName
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Arity -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Arity -> (forall d. Data d => d -> u) -> ConLikeName -> u
forall u. (forall d. Data d => d -> u) -> ConLikeName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConLikeName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConLikeName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ConLikeName -> m ConLikeName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConLikeName -> m ConLikeName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ConLikeName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ConLikeName -> c ConLikeName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ConLikeName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ConLikeName)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ConLikeName -> c ConLikeName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ConLikeName -> c ConLikeName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ConLikeName
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ConLikeName
$ctoConstr :: ConLikeName -> Constr
toConstr :: ConLikeName -> Constr
$cdataTypeOf :: ConLikeName -> DataType
dataTypeOf :: ConLikeName -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ConLikeName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ConLikeName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ConLikeName)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ConLikeName)
$cgmapT :: (forall b. Data b => b -> b) -> ConLikeName -> ConLikeName
gmapT :: (forall b. Data b => b -> b) -> ConLikeName -> ConLikeName
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConLikeName -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConLikeName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConLikeName -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConLikeName -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ConLikeName -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ConLikeName -> [u]
$cgmapQi :: forall u. Arity -> (forall d. Data d => d -> u) -> ConLikeName -> u
gmapQi :: forall u. Arity -> (forall d. Data d => d -> u) -> ConLikeName -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ConLikeName -> m ConLikeName
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ConLikeName -> m ConLikeName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConLikeName -> m ConLikeName
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConLikeName -> m ConLikeName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConLikeName -> m ConLikeName
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConLikeName -> m ConLikeName
Data)

instance Outputable ConLikeName where
  ppr :: ConLikeName -> SDoc
ppr = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SDoc) -> (ConLikeName -> Name) -> ConLikeName -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConLikeName -> Name
conLikeName_Name

instance Uniquable ConLikeName where
  getUnique :: ConLikeName -> Unique
getUnique = Name -> Unique
forall a. Uniquable a => a -> Unique
getUnique (Name -> Unique) -> (ConLikeName -> Name) -> ConLikeName -> Unique
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConLikeName -> Name
conLikeName_Name

instance NFData ConLikeName where
  rnf :: ConLikeName -> ()
rnf = Name -> ()
forall a. NFData a => a -> ()
rnf (Name -> ()) -> (ConLikeName -> Name) -> ConLikeName -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConLikeName -> Name
conLikeName_Name

{-**********************************************************************
*                                                                      *
                      Record field info
*                                                                      *
**********************************************************************-}

data RecFieldInfo
  = RecFieldInfo
      { RecFieldInfo -> FieldLabel
recFieldLabel :: !FieldLabel
      , RecFieldInfo -> UniqSet ConLikeName
recFieldCons  :: !(UniqSet ConLikeName)
         -- ^ The constructors which have this field label.
         -- Always non-empty.
         --
         -- NB: these constructors will always share a single parent,
         -- as the field label disambiguates between parents in the presence
         -- of duplicate record fields.
      }
  deriving (RecFieldInfo -> RecFieldInfo -> Bool
(RecFieldInfo -> RecFieldInfo -> Bool)
-> (RecFieldInfo -> RecFieldInfo -> Bool) -> Eq RecFieldInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RecFieldInfo -> RecFieldInfo -> Bool
== :: RecFieldInfo -> RecFieldInfo -> Bool
$c/= :: RecFieldInfo -> RecFieldInfo -> Bool
/= :: RecFieldInfo -> RecFieldInfo -> Bool
Eq, Typeable RecFieldInfo
Typeable RecFieldInfo =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> RecFieldInfo -> c RecFieldInfo)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RecFieldInfo)
-> (RecFieldInfo -> Constr)
-> (RecFieldInfo -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RecFieldInfo))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RecFieldInfo))
-> ((forall b. Data b => b -> b) -> RecFieldInfo -> RecFieldInfo)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RecFieldInfo -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RecFieldInfo -> r)
-> (forall u. (forall d. Data d => d -> u) -> RecFieldInfo -> [u])
-> (forall u.
    Arity -> (forall d. Data d => d -> u) -> RecFieldInfo -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RecFieldInfo -> m RecFieldInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RecFieldInfo -> m RecFieldInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RecFieldInfo -> m RecFieldInfo)
-> Data RecFieldInfo
RecFieldInfo -> Constr
RecFieldInfo -> DataType
(forall b. Data b => b -> b) -> RecFieldInfo -> RecFieldInfo
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Arity -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Arity -> (forall d. Data d => d -> u) -> RecFieldInfo -> u
forall u. (forall d. Data d => d -> u) -> RecFieldInfo -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecFieldInfo -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecFieldInfo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RecFieldInfo -> m RecFieldInfo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RecFieldInfo -> m RecFieldInfo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecFieldInfo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RecFieldInfo -> c RecFieldInfo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RecFieldInfo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RecFieldInfo)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RecFieldInfo -> c RecFieldInfo
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RecFieldInfo -> c RecFieldInfo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecFieldInfo
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecFieldInfo
$ctoConstr :: RecFieldInfo -> Constr
toConstr :: RecFieldInfo -> Constr
$cdataTypeOf :: RecFieldInfo -> DataType
dataTypeOf :: RecFieldInfo -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RecFieldInfo)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RecFieldInfo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RecFieldInfo)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RecFieldInfo)
$cgmapT :: (forall b. Data b => b -> b) -> RecFieldInfo -> RecFieldInfo
gmapT :: (forall b. Data b => b -> b) -> RecFieldInfo -> RecFieldInfo
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecFieldInfo -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecFieldInfo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecFieldInfo -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecFieldInfo -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RecFieldInfo -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> RecFieldInfo -> [u]
$cgmapQi :: forall u.
Arity -> (forall d. Data d => d -> u) -> RecFieldInfo -> u
gmapQi :: forall u.
Arity -> (forall d. Data d => d -> u) -> RecFieldInfo -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RecFieldInfo -> m RecFieldInfo
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RecFieldInfo -> m RecFieldInfo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RecFieldInfo -> m RecFieldInfo
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RecFieldInfo -> m RecFieldInfo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RecFieldInfo -> m RecFieldInfo
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RecFieldInfo -> m RecFieldInfo
Data)

instance NFData RecFieldInfo where
  rnf :: RecFieldInfo -> ()
rnf (RecFieldInfo FieldLabel
lbl UniqSet ConLikeName
cons)
    = FieldLabel -> ()
forall a. NFData a => a -> ()
rnf FieldLabel
lbl () -> () -> ()
forall a b. a -> b -> b
`seq` (ConLikeName -> () -> ()) -> () -> UniqSet ConLikeName -> ()
forall elt a. (elt -> a -> a) -> a -> UniqSet elt -> a
nonDetStrictFoldUniqSet ConLikeName -> () -> ()
forall a b. NFData a => a -> b -> b
deepseq () UniqSet ConLikeName
cons

instance Outputable RecFieldInfo where
  ppr :: RecFieldInfo -> SDoc
ppr (RecFieldInfo { recFieldLabel :: RecFieldInfo -> FieldLabel
recFieldLabel = FieldLabel
fl, recFieldCons :: RecFieldInfo -> UniqSet ConLikeName
recFieldCons = UniqSet ConLikeName
cons })
    = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RecFieldInfo" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces
      (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"recFieldLabel:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FieldLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr FieldLabel
fl SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
      SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"recFieldCons:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (ConLikeName -> SDoc) -> [ConLikeName] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas ConLikeName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (UniqSet ConLikeName -> [ConLikeName]
forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet UniqSet ConLikeName
cons))