    {-# LANGUAGE CPP                 #-}
    {-# LANGUAGE FlexibleContexts    #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeFamilies        #-}

    {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

    {-
    (c) The University of Glasgow 2011

    -}

    -- | The deriving code for the Generic class
    module GHC.Tc.Deriv.Generics
       (canDoGenerics
       , canDoGenerics1
       , GenericKind(..)
       , gen_Generic_binds
       , get_gen1_constrained_tys
       )
    where

    import GHC.Prelude

    import GHC.Hs
    import GHC.Core.Type
    import GHC.Tc.Utils.TcType
    import GHC.Tc.Deriv.Generate
    import GHC.Tc.Deriv.Functor
    import GHC.Core.DataCon
    import GHC.Core.TyCon
    import GHC.Core.FamInstEnv ( FamInst, FamFlavor(..), mkSingleCoAxiom )
    import GHC.Core.Multiplicity
    import GHC.Tc.Instance.Family
    import GHC.Unit.Module ( moduleName, moduleNameFS
                            , moduleUnit, unitFS, getModule )
    import GHC.Iface.Env    ( newGlobalBinder )
    import GHC.Types.Name hiding ( varName )
    import GHC.Types.Name.Reader
    import GHC.Types.Fixity.Env
    import GHC.Types.SourceText
    import GHC.Types.Fixity
    import GHC.Types.Basic
    import GHC.Builtin.Types.Prim
    import GHC.Builtin.Types
    import GHC.Builtin.Names
    import GHC.Tc.Utils.Env
    import GHC.Tc.Utils.Monad
    import GHC.Driver.Session
    import GHC.Utils.Error( Validity(..), andValid )
    import GHC.Types.SrcLoc
    import GHC.Data.Bag
    import GHC.Types.Var.Env
    import GHC.Types.Var.Set (elemVarSet)
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Data.FastString
    import GHC.Utils.Misc

    import Control.Monad (mplus)
    import Data.List (zip4, partition)
    import Data.Maybe (isJust)

    #include "HsVersions.h"

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Bindings for the new generic deriving mechanism}
    *                                                                      *
    ************************************************************************

    For the generic representation we need to generate:
    \begin{itemize}
    \item A Generic instance
    \item A Rep type instance
    \item Many auxiliary datatypes and instances for them (for the meta-information)
    \end{itemize}
    -}

    gen_Generic_binds :: GenericKind -> TyCon -> [Type]
                     -> TcM (LHsBinds GhcPs, [LSig GhcPs], FamInst)
    gen_Generic_binds :: GenericKind
    -> TyCon -> [Type] -> TcM (LHsBinds GhcPs, [LSig GhcPs], FamInst)
    gen_Generic_binds GenericKind
    gk TyCon
    tc [Type]
    inst_tys = do
      DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
      FamInst
    repTyInsts <- GenericKind -> TyCon -> [Type] -> TcM FamInst
    tc_mkRepFamInsts GenericKind
    gk TyCon
    tc [Type]
    inst_tys
      let (LHsBinds GhcPs
    binds, [LSig GhcPs]
    sigs) = DynFlags -> GenericKind -> TyCon -> (LHsBinds GhcPs, [LSig GhcPs])
    mkBindsRep DynFlags
    dflags GenericKind
    gk TyCon
    tc
      forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsBinds GhcPs
    binds, [LSig GhcPs]
    sigs, FamInst
    repTyInsts)

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Generating representation types}
    *                                                                      *
    ************************************************************************
    -}

    get_gen1_constrained_tys :: TyVar -> Type -> [Type]
    -- called by GHC.Tc.Deriv.Infer.inferConstraints; generates a list of
    -- types, each of which must be a Functor in order for the Generic1 instance to
    -- work.
    get_gen1_constrained_tys :: TyVar -> Type -> [Type]
    get_gen1_constrained_tys TyVar
    argVar
      = forall a. TyVar -> ArgTyAlg a -> Type -> a
    argTyFold TyVar
    argVar forall a b. (a -> b) -> a -> b
    $ ArgTyAlg { ata_rec0 :: Type -> [Type]
    ata_rec0 = forall a b. a -> b -> a
    const []
                                    , ata_par1 :: [Type]
    ata_par1 = [], ata_rec1 :: Type -> [Type]
    ata_rec1 = forall a b. a -> b -> a
    const []
                                    , ata_comp :: Type -> [Type] -> [Type]
    ata_comp = (:) }

    {-

    Note [Requirements for deriving Generic and Rep]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    In the following, T, Tfun, and Targ are "meta-variables" ranging over type
    expressions.

    (Generic T) and (Rep T) are derivable for some type expression T if the
    following constraints are satisfied.

      (a) D is a type constructor *value*. In other words, D is either a type
          constructor or it is equivalent to the head of a data family instance (up to
          alpha-renaming).

      (b) D cannot have a "stupid context".

      (c) The right-hand side of D cannot include existential types, universally
          quantified types, or "exotic" unlifted types. An exotic unlifted type
          is one which is not listed in the definition of allowedUnliftedTy
          (i.e., one for which we have no representation type).
          See Note [Generics and unlifted types]

      (d) T :: *.

    (Generic1 T) and (Rep1 T) are derivable for some type expression T if the
    following constraints are satisfied.

      (a),(b),(c) As above.

      (d) T must expect arguments, and its last parameter must have kind *.

          We use `a' to denote the parameter of D that corresponds to the last
          parameter of T.

      (e) For any type-level application (Tfun Targ) in the right-hand side of D
          where the head of Tfun is not a tuple constructor:

          (b1) `a' must not occur in Tfun.

          (b2) If `a' occurs in Targ, then Tfun :: * -> *.

    -}

    canDoGenerics :: TyCon -> Validity
    -- canDoGenerics determines if Generic/Rep can be derived.
    --
    -- Check (a) from Note [Requirements for deriving Generic and Rep] is taken
    -- care of because canDoGenerics is applied to rep tycons.
    --
    -- It returns IsValid if deriving is possible. It returns (NotValid reason)
    -- if not.
    canDoGenerics :: TyCon -> Validity
    canDoGenerics TyCon
    tc
      = [Validity] -> Validity
    mergeErrors (
              -- Check (b) from Note [Requirements for deriving Generic and Rep].
                  (if (Bool -> Bool
    not (forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (TyCon -> [Type]
    tyConStupidTheta TyCon
    tc)))
                    then (SDoc -> Validity
    NotValid (SDoc
    tc_name SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "must not have a datatype context"))
                    else Validity
    IsValid)
              -- See comment below
                forall a. a -> [a] -> [a]
    : (forall a b. (a -> b) -> [a] -> [b]
    map DataCon -> Validity
    bad_con (TyCon -> [DataCon]
    tyConDataCons TyCon
    tc)))
      where
        -- The tc can be a representation tycon. When we want to display it to the
        -- user (in an error message) we should print its parent
        tc_name :: SDoc
    tc_name = forall a. Outputable a => a -> SDoc
    ppr forall a b. (a -> b) -> a -> b
    $ case TyCon -> Maybe (TyCon, [Type])
    tyConFamInst_maybe TyCon
    tc of
            Just (TyCon
    ptc, [Type]
    _) -> TyCon
    ptc
            Maybe (TyCon, [Type])
    _             -> TyCon
    tc

            -- Check (c) from Note [Requirements for deriving Generic and Rep].
            --
            -- If any of the constructors has an exotic unlifted type as argument,
            -- then we can't build the embedding-projection pair, because
            -- it relies on instantiating *polymorphic* sum and product types
            -- at the argument types of the constructors
        bad_con :: DataCon -> Validity
    bad_con DataCon
    dc = if (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Type -> Bool
    bad_arg_type (forall a b. (a -> b) -> [a] -> [b]
    map forall a. Scaled a -> a
    scaledThing forall a b. (a -> b) -> a -> b
    $ DataCon -> [Scaled Type]
    dataConOrigArgTys DataCon
    dc))
                      then (SDoc -> Validity
    NotValid (forall a. Outputable a => a -> SDoc
    ppr DataCon
    dc SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text
                        String
    "must not have exotic unlifted or polymorphic arguments"))
                      else (if (Bool -> Bool
    not (DataCon -> Bool
    isVanillaDataCon DataCon
    dc))
                              then (SDoc -> Validity
    NotValid (forall a. Outputable a => a -> SDoc
    ppr DataCon
    dc SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "must be a vanilla data constructor"))
                              else Validity
    IsValid)

            -- Nor can we do the job if it's an existential data constructor,
            -- Nor if the args are polymorphic types (I don't think)
        bad_arg_type :: Type -> Bool
    bad_arg_type Type
    ty = (HasDebugCallStack => Type -> Bool
    isUnliftedType Type
    ty Bool -> Bool -> Bool
    && Bool -> Bool
    not (Type -> Bool
    allowedUnliftedTy Type
    ty))
                          Bool -> Bool -> Bool
    || Bool -> Bool
    not (Type -> Bool
    isTauTy Type
    ty)

    -- Returns True the Type argument is an unlifted type which has a
    -- corresponding generic representation type. For example,
    -- (allowedUnliftedTy Int#) would return True since there is the UInt
    -- representation type.
    allowedUnliftedTy :: Type -> Bool
    allowedUnliftedTy :: Type -> Bool
    allowedUnliftedTy = forall a. Maybe a -> Bool
    isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> Maybe (RdrName, RdrName)
    unboxedRepRDRs

    mergeErrors :: [Validity] -> Validity
    mergeErrors :: [Validity] -> Validity
    mergeErrors []             = Validity
    IsValid
    mergeErrors (NotValid SDoc
    s:[Validity]
    t) = case [Validity] -> Validity
    mergeErrors [Validity]
    t of
      Validity
    IsValid     -> SDoc -> Validity
    NotValid SDoc
    s
      NotValid SDoc
    s' -> SDoc -> Validity
    NotValid (SDoc
    s SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    ", and" SDoc -> SDoc -> SDoc
    $$ SDoc
    s')
    mergeErrors (Validity
    IsValid : [Validity]
    t) = [Validity] -> Validity
    mergeErrors [Validity]
    t

    -- A datatype used only inside of canDoGenerics1. It's the result of analysing
    -- a type term.
    data Check_for_CanDoGenerics1 = CCDG1
      { Check_for_CanDoGenerics1 -> Bool
    _ccdg1_hasParam :: Bool       -- does the parameter of interest occurs in
                                      -- this type?
      , Check_for_CanDoGenerics1 -> Validity
    _ccdg1_errors   :: Validity   -- errors generated by this type
      }

    {-

    Note [degenerate use of FFoldType]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    We use foldDataConArgs here only for its ability to treat tuples
    specially. foldDataConArgs also tracks covariance (though it assumes all
    higher-order type parameters are covariant) and has hooks for special handling
    of functions and polytypes, but we do *not* use those.

    The key issue is that Generic1 deriving currently offers no sophisticated
    support for functions. For example, we cannot handle

      data F a = F ((a -> Int) -> Int)

    even though a is occurring covariantly.

    In fact, our rule is harsh: a is simply not allowed to occur within the first
    argument of (->). We treat (->) the same as any other non-tuple tycon.

    Unfortunately, this means we have to track "the parameter occurs in this type"
    explicitly, even though foldDataConArgs is also doing this internally.

    -}

    -- canDoGenerics1 determines if a Generic1/Rep1 can be derived.
    --
    -- Checks (a) through (c) from Note [Requirements for deriving Generic and Rep]
    -- are taken care of by the call to canDoGenerics.
    --
    -- It returns IsValid if deriving is possible. It returns (NotValid reason)
    -- if not.
    canDoGenerics1 :: TyCon -> Validity
    canDoGenerics1 :: TyCon -> Validity
    canDoGenerics1 TyCon
    rep_tc =
      TyCon -> Validity
    canDoGenerics TyCon
    rep_tc Validity -> Validity -> Validity
    `andValid` Validity
    additionalChecks
      where
        additionalChecks :: Validity
    additionalChecks
            -- check (d) from Note [Requirements for deriving Generic and Rep]
          | forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (TyCon -> [TyVar]
    tyConTyVars TyCon
    rep_tc) = SDoc -> Validity
    NotValid forall a b. (a -> b) -> a -> b
    $
              String -> SDoc
    text String
    "Data type" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (forall a. Outputable a => a -> SDoc
    ppr TyCon
    rep_tc)
          SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "must have some type parameters"

          | Bool
    otherwise = [Validity] -> Validity
    mergeErrors forall a b. (a -> b) -> a -> b
    $ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap DataCon -> [Validity]
    check_con [DataCon]
    data_cons

        data_cons :: [DataCon]
    data_cons = TyCon -> [DataCon]
    tyConDataCons TyCon
    rep_tc
        check_con :: DataCon -> [Validity]
    check_con DataCon
    con = case DataCon -> Validity
    check_vanilla DataCon
    con of
          j :: Validity
    j@(NotValid {}) -> [Validity
    j]
          Validity
    IsValid -> Check_for_CanDoGenerics1 -> Validity
    _ccdg1_errors forall a b. (a -> b) -> [a] -> [b]
    `map` forall a. FFoldType a -> DataCon -> [a]
    foldDataConArgs (DataCon -> FFoldType Check_for_CanDoGenerics1
    ft_check DataCon
    con) DataCon
    con

        bad :: DataCon -> SDoc -> SDoc
        bad :: DataCon -> SDoc -> SDoc
    bad DataCon
    con SDoc
    msg = String -> SDoc
    text String
    "Constructor" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (forall a. Outputable a => a -> SDoc
    ppr DataCon
    con) SDoc -> SDoc -> SDoc
    <+> SDoc
    msg

        check_vanilla :: DataCon -> Validity
        check_vanilla :: DataCon -> Validity
    check_vanilla DataCon
    con | DataCon -> Bool
    isVanillaDataCon DataCon
    con = Validity
    IsValid
                          | Bool
    otherwise            = SDoc -> Validity
    NotValid (DataCon -> SDoc -> SDoc
    bad DataCon
    con SDoc
    existential)

        bmzero :: Check_for_CanDoGenerics1
    bmzero      = Bool -> Validity -> Check_for_CanDoGenerics1
    CCDG1 Bool
    False Validity
    IsValid
        bmbad :: DataCon -> SDoc -> Check_for_CanDoGenerics1
    bmbad DataCon
    con SDoc
    s = Bool -> Validity -> Check_for_CanDoGenerics1
    CCDG1 Bool
    True forall a b. (a -> b) -> a -> b
    $ SDoc -> Validity
    NotValid forall a b. (a -> b) -> a -> b
    $ DataCon -> SDoc -> SDoc
    bad DataCon
    con SDoc
    s
        bmplus :: Check_for_CanDoGenerics1
    -> Check_for_CanDoGenerics1 -> Check_for_CanDoGenerics1
    bmplus (CCDG1 Bool
    b1 Validity
    m1) (CCDG1 Bool
    b2 Validity
    m2) = Bool -> Validity -> Check_for_CanDoGenerics1
    CCDG1 (Bool
    b1 Bool -> Bool -> Bool
    || Bool
    b2) (Validity
    m1 Validity -> Validity -> Validity
    `andValid` Validity
    m2)

        -- check (e) from Note [Requirements for deriving Generic and Rep]
        -- See also Note [degenerate use of FFoldType]
        ft_check :: DataCon -> FFoldType Check_for_CanDoGenerics1
        ft_check :: DataCon -> FFoldType Check_for_CanDoGenerics1
    ft_check DataCon
    con = FT
          { ft_triv :: Check_for_CanDoGenerics1
    ft_triv = Check_for_CanDoGenerics1
    bmzero

          , ft_var :: Check_for_CanDoGenerics1
    ft_var = Check_for_CanDoGenerics1
    caseVar, ft_co_var :: Check_for_CanDoGenerics1
    ft_co_var = Check_for_CanDoGenerics1
    caseVar

          -- (component_0,component_1,...,component_n)
          , ft_tup :: TyCon -> [Check_for_CanDoGenerics1] -> Check_for_CanDoGenerics1
    ft_tup = \TyCon
    _ [Check_for_CanDoGenerics1]
    components -> if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Check_for_CanDoGenerics1 -> Bool
    _ccdg1_hasParam (forall a. [a] -> [a]
    init [Check_for_CanDoGenerics1]
    components)
                                      then DataCon -> SDoc -> Check_for_CanDoGenerics1
    bmbad DataCon
    con SDoc
    wrong_arg
                                      else forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Check_for_CanDoGenerics1
    -> Check_for_CanDoGenerics1 -> Check_for_CanDoGenerics1
    bmplus Check_for_CanDoGenerics1
    bmzero [Check_for_CanDoGenerics1]
    components

          -- (dom -> rng), where the head of ty is not a tuple tycon
          , ft_fun :: Check_for_CanDoGenerics1
    -> Check_for_CanDoGenerics1 -> Check_for_CanDoGenerics1
    ft_fun = \Check_for_CanDoGenerics1
    dom Check_for_CanDoGenerics1
    rng -> -- cf #8516
              if Check_for_CanDoGenerics1 -> Bool
    _ccdg1_hasParam Check_for_CanDoGenerics1
    dom
              then DataCon -> SDoc -> Check_for_CanDoGenerics1
    bmbad DataCon
    con SDoc
    wrong_arg
              else Check_for_CanDoGenerics1
    -> Check_for_CanDoGenerics1 -> Check_for_CanDoGenerics1
    bmplus Check_for_CanDoGenerics1
    dom Check_for_CanDoGenerics1
    rng

          -- (ty arg), where head of ty is neither (->) nor a tuple constructor and
          -- the parameter of interest does not occur in ty
          , ft_ty_app :: Type
    -> Type -> Check_for_CanDoGenerics1 -> Check_for_CanDoGenerics1
    ft_ty_app = \Type
    _ Type
    _ Check_for_CanDoGenerics1
    arg -> Check_for_CanDoGenerics1
    arg

          , ft_bad_app :: Check_for_CanDoGenerics1
    ft_bad_app = DataCon -> SDoc -> Check_for_CanDoGenerics1
    bmbad DataCon
    con SDoc
    wrong_arg
          , ft_forall :: TyVar -> Check_for_CanDoGenerics1 -> Check_for_CanDoGenerics1
    ft_forall  = \TyVar
    _ Check_for_CanDoGenerics1
    body -> Check_for_CanDoGenerics1
    body -- polytypes are handled elsewhere
          }
          where
            caseVar :: Check_for_CanDoGenerics1
    caseVar = Bool -> Validity -> Check_for_CanDoGenerics1
    CCDG1 Bool
    True Validity
    IsValid

        existential :: SDoc
    existential = String -> SDoc
    text String
    "must not have existential arguments"
        wrong_arg :: SDoc
    wrong_arg   = String -> SDoc
    text String
    "applies a type to an argument involving the last parameter"
                   SDoc -> SDoc -> SDoc
    $$ String -> SDoc
    text String
    "but the applied type is not of kind * -> *"

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Generating the RHS of a generic default method}
    *                                                                      *
    ************************************************************************
    -}

    type US = Int   -- Local unique supply, just a plain Int
    type Alt = (LPat GhcPs, LHsExpr GhcPs)

    -- GenericKind serves to mark if a datatype derives Generic (Gen0) or
    -- Generic1 (Gen1).
    data GenericKind = Gen0 | Gen1

    -- as above, but with a payload of the TyCon's name for "the" parameter
    data GenericKind_ = Gen0_ | Gen1_ TyVar

    -- as above, but using a single datacon's name for "the" parameter
    data GenericKind_DC = Gen0_DC | Gen1_DC TyVar

    forgetArgVar :: GenericKind_DC -> GenericKind
    forgetArgVar :: GenericKind_DC -> GenericKind
    forgetArgVar GenericKind_DC
    Gen0_DC   = GenericKind
    Gen0
    forgetArgVar Gen1_DC{} = GenericKind
    Gen1

    -- When working only within a single datacon, "the" parameter's name should
    -- match that datacon's name for it.
    gk2gkDC :: GenericKind_ -> DataCon -> GenericKind_DC
    gk2gkDC :: GenericKind_ -> DataCon -> GenericKind_DC
    gk2gkDC GenericKind_
    Gen0_   DataCon
    _ = GenericKind_DC
    Gen0_DC
    gk2gkDC Gen1_{} DataCon
    d = TyVar -> GenericKind_DC
    Gen1_DC forall a b. (a -> b) -> a -> b
    $ forall a. [a] -> a
    last forall a b. (a -> b) -> a -> b
    $ DataCon -> [TyVar]
    dataConUnivTyVars DataCon
    d

    -- Bindings for the Generic instance
    mkBindsRep :: DynFlags -> GenericKind -> TyCon -> (LHsBinds GhcPs, [LSig GhcPs])
    mkBindsRep :: DynFlags -> GenericKind -> TyCon -> (LHsBinds GhcPs, [LSig GhcPs])
    mkBindsRep DynFlags
    dflags GenericKind
    gk TyCon
    tycon = (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
    binds, [GenLocated SrcSpanAnnA (Sig GhcPs)]
    sigs)
          where
            binds :: Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
    binds = forall a. a -> Bag a
    unitBag (LocatedN RdrName -> [LMatch GhcPs (LHsExpr GhcPs)] -> LHsBind GhcPs
    mkRdrFunBind (forall l e. l -> e -> GenLocated l e
    L SrcSpanAnn' (EpAnn NameAnn)
    loc' RdrName
    from01_RDR) [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsExpr GhcPs)))
    from_eqn])
                  forall a. Bag a -> Bag a -> Bag a
    `unionBags`
                    forall a. a -> Bag a
    unitBag (LocatedN RdrName -> [LMatch GhcPs (LHsExpr GhcPs)] -> LHsBind GhcPs
    mkRdrFunBind (forall l e. l -> e -> GenLocated l e
    L SrcSpanAnn' (EpAnn NameAnn)
    loc' RdrName
    to01_RDR) [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsExpr GhcPs)))
    to_eqn])

            -- See Note [Generics performance tricks]
            sigs :: [GenLocated SrcSpanAnnA (Sig GhcPs)]
    sigs = if     GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_InlineGenericsAggressively DynFlags
    dflags
                      Bool -> Bool -> Bool
    || (GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_InlineGenerics DynFlags
    dflags Bool -> Bool -> Bool
    && Bool
    inlining_useful)
                   then [RdrName -> GenLocated SrcSpanAnnA (Sig GhcPs)
    inline1 RdrName
    from01_RDR, RdrName -> GenLocated SrcSpanAnnA (Sig GhcPs)
    inline1 RdrName
    to01_RDR]
                   else []
             where
               inlining_useful :: Bool
    inlining_useful
                 | US
    cons forall a. Ord a => a -> a -> Bool
    <= US
    1  = Bool
    True
                 | US
    cons forall a. Ord a => a -> a -> Bool
    <= US
    4  = US
    max_fields forall a. Ord a => a -> a -> Bool
    <= US
    5
                 | US
    cons forall a. Ord a => a -> a -> Bool
    <= US
    8  = US
    max_fields forall a. Ord a => a -> a -> Bool
    <= US
    2
                 | US
    cons forall a. Ord a => a -> a -> Bool
    <= US
    16 = US
    max_fields forall a. Ord a => a -> a -> Bool
    <= US
    1
                 | US
    cons forall a. Ord a => a -> a -> Bool
    <= US
    24 = US
    max_fields forall a. Eq a => a -> a -> Bool
    == US
    0
                 | Bool
    otherwise  = Bool
    False
                 where
                   cons :: US
    cons       = forall (t :: * -> *) a. Foldable t => t a -> US
    length [DataCon]
    datacons
                   max_fields :: US
    max_fields = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum forall a b. (a -> b) -> a -> b
    $ forall a b. (a -> b) -> [a] -> [b]
    map DataCon -> US
    dataConSourceArity [DataCon]
    datacons

               inline1 :: RdrName -> GenLocated SrcSpanAnnA (Sig GhcPs)
    inline1 RdrName
    f = forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    loc'' forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall pass.
    XInlineSig pass -> LIdP pass -> InlinePragma -> Sig pass
    InlineSig forall a. EpAnn a
    noAnn (forall l e. l -> e -> GenLocated l e
    L SrcSpanAnn' (EpAnn NameAnn)
    loc' RdrName
    f)
                         forall a b. (a -> b) -> a -> b
    $ InlinePragma
    alwaysInlinePragma { inl_act :: Activation
    inl_act = SourceText -> US -> Activation
    ActiveAfter SourceText
    NoSourceText US
    1 }

            -- The topmost M1 (the datatype metadata) has the exact same type
            -- across all cases of a from/to definition, and can be factored out
            -- to save some allocations during typechecking.
            -- See Note [Generics compilation speed tricks]
            from_eqn :: LMatch GhcPs (LocatedA (HsExpr GhcPs))
    from_eqn = forall (p :: Pass) (body :: * -> *).
    (Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ SrcSpan,
     Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
     ~ SrcSpanAnnA) =>
    LPat (GhcPass p)
    -> LocatedA (body (GhcPass p))
    -> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
    mkHsCaseAlt LPat GhcPs
    x_Pat forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcPs -> LHsExpr GhcPs
    mkM1_E
                                           forall a b. (a -> b) -> a -> b
    $ forall (id :: Pass). LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsPar forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcPs -> [LMatch GhcPs (LHsExpr GhcPs)] -> LHsExpr GhcPs
    nlHsCase LHsExpr GhcPs
    x_Expr [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsExpr GhcPs)))]
    from_matches
            to_eqn :: LMatch GhcPs (LocatedA (HsExpr GhcPs))
    to_eqn   = forall (p :: Pass) (body :: * -> *).
    (Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ SrcSpan,
     Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
     ~ SrcSpanAnnA) =>
    LPat (GhcPass p)
    -> LocatedA (body (GhcPass p))
    -> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
    mkHsCaseAlt (LPat GhcPs -> LPat GhcPs
    mkM1_P LPat GhcPs
    x_Pat) forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcPs -> [LMatch GhcPs (LHsExpr GhcPs)] -> LHsExpr GhcPs
    nlHsCase LHsExpr GhcPs
    x_Expr [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsExpr GhcPs)))]
    to_matches

            from_matches :: [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsExpr GhcPs)))]
    from_matches  = [forall (p :: Pass) (body :: * -> *).
    (Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ SrcSpan,
     Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
     ~ SrcSpanAnnA) =>
    LPat (GhcPass p)
    -> LocatedA (body (GhcPass p))
    -> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
    mkHsCaseAlt GenLocated SrcSpanAnnA (Pat GhcPs)
    pat LocatedA (HsExpr GhcPs)
    rhs | (GenLocated SrcSpanAnnA (Pat GhcPs)
    pat,LocatedA (HsExpr GhcPs)
    rhs) <- [Alt]
    from_alts]
            to_matches :: [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA (HsExpr GhcPs)))]
    to_matches    = [forall (p :: Pass) (body :: * -> *).
    (Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ SrcSpan,
     Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
     ~ SrcSpanAnnA) =>
    LPat (GhcPass p)
    -> LocatedA (body (GhcPass p))
    -> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
    mkHsCaseAlt GenLocated SrcSpanAnnA (Pat GhcPs)
    pat LocatedA (HsExpr GhcPs)
    rhs | (GenLocated SrcSpanAnnA (Pat GhcPs)
    pat,LocatedA (HsExpr GhcPs)
    rhs) <- [Alt]
    to_alts  ]
            loc :: SrcSpan
    loc           = SrcLoc -> SrcSpan
    srcLocSpan (forall a. NamedThing a => a -> SrcLoc
    getSrcLoc TyCon
    tycon)
            loc' :: SrcSpanAnn' (EpAnn NameAnn)
    loc'          = forall ann. SrcSpan -> SrcAnn ann
    noAnnSrcSpan SrcSpan
    loc
            loc'' :: SrcSpanAnnA
    loc''         = forall ann. SrcSpan -> SrcAnn ann
    noAnnSrcSpan SrcSpan
    loc
            datacons :: [DataCon]
    datacons      = TyCon -> [DataCon]
    tyConDataCons TyCon
    tycon

            (RdrName
    from01_RDR, RdrName
    to01_RDR) = case GenericKind
    gk of
                                       GenericKind
    Gen0 -> (RdrName
    from_RDR,  RdrName
    to_RDR)
                                       GenericKind
    Gen1 -> (RdrName
    from1_RDR, RdrName
    to1_RDR)

            -- Recurse over the sum first
            from_alts, to_alts :: [Alt]
            ([(GenLocated SrcSpanAnnA (Pat GhcPs), LocatedA (HsExpr GhcPs))]
    [Alt]
    from_alts, [(GenLocated SrcSpanAnnA (Pat GhcPs), LocatedA (HsExpr GhcPs))]
    [Alt]
    to_alts) = GenericKind_ -> US -> [DataCon] -> ([Alt], [Alt])
    mkSum GenericKind_
    gk_ (US
    1 :: US) [DataCon]
    datacons
              where gk_ :: GenericKind_
    gk_ = case GenericKind
    gk of
                      GenericKind
    Gen0 -> GenericKind_
    Gen0_
                      GenericKind
    Gen1 -> ASSERT(tyvars `lengthAtLeast` 1)
                              TyVar -> GenericKind_
    Gen1_ (forall a. [a] -> a
    last [TyVar]
    tyvars)
                        where tyvars :: [TyVar]
    tyvars = TyCon -> [TyVar]
    tyConTyVars TyCon
    tycon

    --------------------------------------------------------------------------------
    -- The type synonym instance and synonym
    --       type instance Rep (D a b) = Rep_D a b
    --       type Rep_D a b = ...representation type for D ...
    --------------------------------------------------------------------------------

    tc_mkRepFamInsts :: GenericKind   -- Gen0 or Gen1
                     -> TyCon         -- The type to generate representation for
                     -> [Type]        -- The type(s) to which Generic(1) is applied
                                      -- in the generated instance
                     -> TcM FamInst   -- Generated representation0 coercion
    tc_mkRepFamInsts :: GenericKind -> TyCon -> [Type] -> TcM FamInst
    tc_mkRepFamInsts GenericKind
    gk TyCon
    tycon [Type]
    inst_tys =
           -- Consider the example input tycon `D`, where data D a b = D_ a
           -- Also consider `R:DInt`, where { data family D x y :: * -> *
           --                               ; data instance D Int a b = D_ a }
      do { -- `rep` = GHC.Generics.Rep or GHC.Generics.Rep1 (type family)
           TyCon
    fam_tc <- case GenericKind
    gk of
             GenericKind
    Gen0 -> Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupTyCon Name
    repTyConName
             GenericKind
    Gen1 -> Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupTyCon Name
    rep1TyConName

         ; FamInstEnvs
    fam_envs <- TcM FamInstEnvs
    tcGetFamInstEnvs

         ; let -- If the derived instance is
               --   instance Generic (Foo x)
               -- then:
               --   `arg_ki` = *, `inst_ty` = Foo x :: *
               --
               -- If the derived instance is
               --   instance Generic1 (Bar x :: k -> *)
               -- then:
               --   `arg_k` = k, `inst_ty` = Bar x :: k -> *
               (Type
    arg_ki, Type
    inst_ty) = case (GenericKind
    gk, [Type]
    inst_tys) of
                 (GenericKind
    Gen0, [Type
    inst_t])        -> (Type
    liftedTypeKind, Type
    inst_t)
                 (GenericKind
    Gen1, [Type
    arg_k, Type
    inst_t]) -> (Type
    arg_k,          Type
    inst_t)
                 (GenericKind, [Type])
    _ -> forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tc_mkRepFamInsts" (forall a. Outputable a => a -> SDoc
    ppr [Type]
    inst_tys)

         ; let mbFamInst :: Maybe (TyCon, [Type])
    mbFamInst         = TyCon -> Maybe (TyCon, [Type])
    tyConFamInst_maybe TyCon
    tycon
               -- If we're examining a data family instance, we grab the parent
               -- TyCon (ptc) and use it to determine the type arguments
               -- (inst_args) for the data family *instance*'s type variables.
               ptc :: TyCon
    ptc               = forall b a. b -> (a -> b) -> Maybe a -> b
    maybe TyCon
    tycon forall a b. (a, b) -> a
    fst Maybe (TyCon, [Type])
    mbFamInst
               (TyCon
    _, [Type]
    inst_args, Coercion
    _) = FamInstEnvs -> TyCon -> [Type] -> (TyCon, [Type], Coercion)
    tcLookupDataFamInst FamInstEnvs
    fam_envs TyCon
    ptc forall a b. (a -> b) -> a -> b
    $ forall a b. (a, b) -> b
    snd
                                     forall a b. (a -> b) -> a -> b
    $ Type -> (TyCon, [Type])
    tcSplitTyConApp Type
    inst_ty

         ; let -- `tyvars` = [a,b]
               ([TyVar]
    tyvars, GenericKind_
    gk_) = case GenericKind
    gk of
                 GenericKind
    Gen0 -> ([TyVar]
    all_tyvars, GenericKind_
    Gen0_)
                 GenericKind
    Gen1 -> ASSERT(not $ null all_tyvars)
                         (forall a. [a] -> [a]
    init [TyVar]
    all_tyvars, TyVar -> GenericKind_
    Gen1_ forall a b. (a -> b) -> a -> b
    $ forall a. [a] -> a
    last [TyVar]
    all_tyvars)
                 where all_tyvars :: [TyVar]
    all_tyvars = TyCon -> [TyVar]
    tyConTyVars TyCon
    tycon

           -- `repTy` = D1 ... (C1 ... (S1 ... (Rec0 a))) :: * -> *
         ; Type
    repTy <- GenericKind_ -> TyCon -> Type -> TcM Type
    tc_mkRepTy GenericKind_
    gk_ TyCon
    tycon Type
    arg_ki

           -- `rep_name` is a name we generate for the synonym
         ; Module
    mod <- forall (m :: * -> *). HasModule m => m Module
    getModule
         ; SrcSpan
    loc <- TcRn SrcSpan
    getSrcSpanM
         ; let tc_occ :: OccName
    tc_occ  = Name -> OccName
    nameOccName (TyCon -> Name
    tyConName TyCon
    tycon)
               rep_occ :: OccName
    rep_occ = case GenericKind
    gk of GenericKind
    Gen0 -> OccName -> OccName
    mkGenR OccName
    tc_occ; GenericKind
    Gen1 -> OccName -> OccName
    mkGen1R OccName
    tc_occ
         ; Name
    rep_name <- forall a b. Module -> OccName -> SrcSpan -> TcRnIf a b Name
    newGlobalBinder Module
    mod OccName
    rep_occ SrcSpan
    loc

           -- We make sure to substitute the tyvars with their user-supplied
           -- type arguments before generating the Rep/Rep1 instance, since some
           -- of the tyvars might have been instantiated when deriving.
           -- See Note [Generating a correctly typed Rep instance].
         ; let ([TyVar]
    env_tyvars, [Type]
    env_inst_args)
                 = case GenericKind_
    gk_ of
                     GenericKind_
    Gen0_ -> ([TyVar]
    tyvars, [Type]
    inst_args)
                     Gen1_ TyVar
    last_tv
                              -- See the "wrinkle" in
                              -- Note [Generating a correctly typed Rep instance]
                           -> ( TyVar
    last_tv forall a. a -> [a] -> [a]
    : [TyVar]
    tyvars
                              , Type -> Type
    anyTypeOfKind (TyVar -> Type
    tyVarKind TyVar
    last_tv) forall a. a -> [a] -> [a]
    : [Type]
    inst_args )
               env :: TvSubstEnv
    env        = HasDebugCallStack => [TyVar] -> [Type] -> TvSubstEnv
    zipTyEnv [TyVar]
    env_tyvars [Type]
    env_inst_args
               in_scope :: InScopeSet
    in_scope   = VarSet -> InScopeSet
    mkInScopeSet ([Type] -> VarSet
    tyCoVarsOfTypes [Type]
    inst_tys)
               subst :: TCvSubst
    subst      = InScopeSet -> TvSubstEnv -> TCvSubst
    mkTvSubst InScopeSet
    in_scope TvSubstEnv
    env
               repTy' :: Type
    repTy'     = TCvSubst -> Type -> Type
    substTyUnchecked  TCvSubst
    subst Type
    repTy
               tcv' :: [TyVar]
    tcv'       = Type -> [TyVar]
    tyCoVarsOfTypeList Type
    inst_ty
               ([TyVar]
    tv', [TyVar]
    cv') = forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition TyVar -> Bool
    isTyVar [TyVar]
    tcv'
               tvs' :: [TyVar]
    tvs'       = [TyVar] -> [TyVar]
    scopedSort [TyVar]
    tv'
               cvs' :: [TyVar]
    cvs'       = [TyVar] -> [TyVar]
    scopedSort [TyVar]
    cv'
               axiom :: CoAxiom Unbranched
    axiom      = Role
    -> Name
    -> [TyVar]
    -> [TyVar]
    -> [TyVar]
    -> TyCon
    -> [Type]
    -> Type
    -> CoAxiom Unbranched
    mkSingleCoAxiom Role
    Nominal Name
    rep_name [TyVar]
    tvs' [] [TyVar]
    cvs'
                                            TyCon
    fam_tc [Type]
    inst_tys Type
    repTy'

         ; FamFlavor -> CoAxiom Unbranched -> TcM FamInst
    newFamInst FamFlavor
    SynFamilyInst CoAxiom Unbranched
    axiom  }

    --------------------------------------------------------------------------------
    -- Type representation
    --------------------------------------------------------------------------------

    -- | See documentation of 'argTyFold'; that function uses the fields of this
    -- type to interpret the structure of a type when that type is considered as an
    -- argument to a constructor that is being represented with 'Rep1'.
    data ArgTyAlg a = ArgTyAlg
      { forall a. ArgTyAlg a -> Type -> a
    ata_rec0 :: (Type -> a)
      , forall a. ArgTyAlg a -> a
    ata_par1 :: a, forall a. ArgTyAlg a -> Type -> a
    ata_rec1 :: (Type -> a)
      , forall a. ArgTyAlg a -> Type -> a -> a
    ata_comp :: (Type -> a -> a)
      }

    -- | @argTyFold@ implements a generalised and safer variant of the @arg@
    -- function from Figure 3 in <http://dreixel.net/research/pdf/gdmh.pdf>. @arg@
    -- is conceptually equivalent to:
    --
    -- > arg t = case t of
    -- >   _ | isTyVar t         -> if (t == argVar) then Par1 else Par0 t
    -- >   App f [t'] |
    -- >     representable1 f &&
    -- >     t' == argVar        -> Rec1 f
    -- >   App f [t'] |
    -- >     representable1 f &&
    -- >     t' has tyvars       -> f :.: (arg t')
    -- >   _                     -> Rec0 t
    --
    -- where @argVar@ is the last type variable in the data type declaration we are
    -- finding the representation for.
    --
    -- @argTyFold@ is more general than @arg@ because it uses 'ArgTyAlg' to
    -- abstract out the concrete invocations of @Par0@, @Rec0@, @Par1@, @Rec1@, and
    -- @:.:@.
    --
    -- @argTyFold@ is safer than @arg@ because @arg@ would lead to a GHC panic for
    -- some data types. The problematic case is when @t@ is an application of a
    -- non-representable type @f@ to @argVar@: @App f [argVar]@ is caught by the
    -- @_@ pattern, and ends up represented as @Rec0 t@. This type occurs /free/ in
    -- the RHS of the eventual @Rep1@ instance, which is therefore ill-formed. Some
    -- representable1 checks have been relaxed, and others were moved to
    -- @canDoGenerics1@.
    argTyFold :: forall a. TyVar -> ArgTyAlg a -> Type -> a
    argTyFold :: forall a. TyVar -> ArgTyAlg a -> Type -> a
    argTyFold TyVar
    argVar (ArgTyAlg {ata_rec0 :: forall a. ArgTyAlg a -> Type -> a
    ata_rec0 = Type -> a
    mkRec0,
                                ata_par1 :: forall a. ArgTyAlg a -> a
    ata_par1 = a
    mkPar1, ata_rec1 :: forall a. ArgTyAlg a -> Type -> a
    ata_rec1 = Type -> a
    mkRec1,
                                ata_comp :: forall a. ArgTyAlg a -> Type -> a -> a
    ata_comp = Type -> a -> a
    mkComp}) =
      -- mkRec0 is the default; use it if there is no interesting structure
      -- (e.g. occurrences of parameters or recursive occurrences)
      \Type
    t -> forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Type -> a
    mkRec0 Type
    t) forall a. a -> a
    id forall a b. (a -> b) -> a -> b
    $ Type -> Maybe a
    go Type
    t where
      go :: Type -> -- type to fold through
            Maybe a -- the result (e.g. representation type), unless it's trivial
      go :: Type -> Maybe a
    go Type
    t = Maybe a
    isParam forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` Maybe a
    isApp where

        isParam :: Maybe a
    isParam = do -- handles parameters
          TyVar
    t' <- Type -> Maybe TyVar
    getTyVar_maybe Type
    t
          forall a. a -> Maybe a
    Just forall a b. (a -> b) -> a -> b
    $ if TyVar
    t' forall a. Eq a => a -> a -> Bool
    == TyVar
    argVar then a
    mkPar1 -- moreover, it is "the" parameter
                 else Type -> a
    mkRec0 Type
    t -- NB mkRec0 instead of the conventional mkPar0

        isApp :: Maybe a
    isApp = do -- handles applications
          (Type
    phi, Type
    beta) <- Type -> Maybe (Type, Type)
    tcSplitAppTy_maybe Type
    t

          let interesting :: Bool
    interesting = TyVar
    argVar TyVar -> VarSet -> Bool
    `elemVarSet` Type -> VarSet
    exactTyCoVarsOfType Type
    beta

          -- Does it have no interesting structure to represent?
          if Bool -> Bool
    not Bool
    interesting then forall a. Maybe a
    Nothing
            else -- Is the argument the parameter? Special case for mkRec1.
              if forall a. a -> Maybe a
    Just TyVar
    argVar forall a. Eq a => a -> a -> Bool
    == Type -> Maybe TyVar
    getTyVar_maybe Type
    beta then forall a. a -> Maybe a
    Just forall a b. (a -> b) -> a -> b
    $ Type -> a
    mkRec1 Type
    phi
                else Type -> a -> a
    mkComp Type
    phi forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Type -> Maybe a
    go Type
    beta -- It must be a composition.

    tc_mkRepTy ::  -- Gen0_ or Gen1_, for Rep or Rep1
                   GenericKind_
                  -- The type to generate representation for
                -> TyCon
                  -- The kind of the representation type's argument
                  -- See Note [Handling kinds in a Rep instance]
                -> Kind
                   -- Generated representation0 type
                -> TcM Type
    tc_mkRepTy :: GenericKind_ -> TyCon -> Type -> TcM Type
    tc_mkRepTy GenericKind_
    gk_ TyCon
    tycon Type
    k =
      do
        TyCon
    d1      <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupTyCon Name
    d1TyConName
        TyCon
    c1      <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupTyCon Name
    c1TyConName
        TyCon
    s1      <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupTyCon Name
    s1TyConName
        TyCon
    rec0    <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupTyCon Name
    rec0TyConName
        TyCon
    rec1    <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupTyCon Name
    rec1TyConName
        TyCon
    par1    <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupTyCon Name
    par1TyConName
        TyCon
    u1      <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupTyCon Name
    u1TyConName
        TyCon
    v1      <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupTyCon Name
    v1TyConName
        TyCon
    plus    <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupTyCon Name
    sumTyConName
        TyCon
    times   <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupTyCon Name
    prodTyConName
        TyCon
    comp    <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupTyCon Name
    compTyConName
        TyCon
    uAddr   <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupTyCon Name
    uAddrTyConName
        TyCon
    uChar   <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupTyCon Name
    uCharTyConName
        TyCon
    uDouble <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupTyCon Name
    uDoubleTyConName
        TyCon
    uFloat  <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupTyCon Name
    uFloatTyConName
        TyCon
    uInt    <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupTyCon Name
    uIntTyConName
        TyCon
    uWord   <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupTyCon Name
    uWordTyConName

        let tcLookupPromDataCon :: Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupPromDataCon = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DataCon -> TyCon
    promoteDataCon forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> TcM DataCon
    tcLookupDataCon

        TyCon
    md         <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupPromDataCon Name
    metaDataDataConName
        TyCon
    mc         <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupPromDataCon Name
    metaConsDataConName
        TyCon
    ms         <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupPromDataCon Name
    metaSelDataConName
        TyCon
    pPrefix    <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupPromDataCon Name
    prefixIDataConName
        TyCon
    pInfix     <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupPromDataCon Name
    infixIDataConName
        TyCon
    pLA        <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupPromDataCon Name
    leftAssociativeDataConName
        TyCon
    pRA        <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupPromDataCon Name
    rightAssociativeDataConName
        TyCon
    pNA        <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupPromDataCon Name
    notAssociativeDataConName
        TyCon
    pSUpk      <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupPromDataCon Name
    sourceUnpackDataConName
        TyCon
    pSNUpk     <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupPromDataCon Name
    sourceNoUnpackDataConName
        TyCon
    pNSUpkness <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupPromDataCon Name
    noSourceUnpackednessDataConName
        TyCon
    pSLzy      <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupPromDataCon Name
    sourceLazyDataConName
        TyCon
    pSStr      <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupPromDataCon Name
    sourceStrictDataConName
        TyCon
    pNSStrness <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupPromDataCon Name
    noSourceStrictnessDataConName
        TyCon
    pDLzy      <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupPromDataCon Name
    decidedLazyDataConName
        TyCon
    pDStr      <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupPromDataCon Name
    decidedStrictDataConName
        TyCon
    pDUpk      <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TyCon
    tcLookupPromDataCon Name
    decidedUnpackDataConName

        FixityEnv
    fix_env <- TcRn FixityEnv
    getFixityEnv

        let mkSum' :: Type -> Type -> Type
    mkSum' Type
    a Type
    b = TyCon -> [Type] -> Type
    mkTyConApp TyCon
    plus  [Type
    k,Type
    a,Type
    b]
            mkProd :: Type -> Type -> Type
    mkProd Type
    a Type
    b = TyCon -> [Type] -> Type
    mkTyConApp TyCon
    times [Type
    k,Type
    a,Type
    b]
            mkRec0 :: Type -> Type
    mkRec0 Type
    a   = TyCon
    -> TyCon
    -> TyCon
    -> TyCon
    -> TyCon
    -> TyCon
    -> TyCon
    -> Type
    -> Type
    -> Type
    mkBoxTy TyCon
    uAddr TyCon
    uChar TyCon
    uDouble TyCon
    uFloat TyCon
    uInt TyCon
    uWord TyCon
    rec0 Type
    k Type
    a
            mkRec1 :: Type -> Type
    mkRec1 Type
    a   = TyCon -> [Type] -> Type
    mkTyConApp TyCon
    rec1  [Type
    k,Type
    a]
            mkPar1 :: Type
    mkPar1     = TyCon -> Type
    mkTyConTy  TyCon
    par1
            mkD :: TyCon -> Type
    mkD    TyCon
    a   = TyCon -> [Type] -> Type
    mkTyConApp TyCon
    d1 [ Type
    k, Type
    metaDataTy, [DataCon] -> Type
    sumP (TyCon -> [DataCon]
    tyConDataCons TyCon
    a) ]
            mkC :: DataCon -> Type
    mkC      DataCon
    a = TyCon -> [Type] -> Type
    mkTyConApp TyCon
    c1 [ Type
    k
                                       , DataCon -> Type
    metaConsTy DataCon
    a
                                       , [Type] -> [HsSrcBang] -> [HsImplBang] -> [FieldLabel] -> Type
    prod (forall a b. (a -> b) -> [a] -> [b]
    map forall a. Scaled a -> a
    scaledThing forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DataCon -> [Type] -> [Scaled Type]
    dataConInstOrigArgTys DataCon
    a
                                                forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [TyVar] -> [Type]
    mkTyVarTys forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TyCon -> [TyVar]
    tyConTyVars forall a b. (a -> b) -> a -> b
    $ TyCon
    tycon)
                                              (DataCon -> [HsSrcBang]
    dataConSrcBangs    DataCon
    a)
                                              (DataCon -> [HsImplBang]
    dataConImplBangs   DataCon
    a)
                                              (DataCon -> [FieldLabel]
    dataConFieldLabels DataCon
    a)]
            mkS :: Maybe FieldLabel
    -> SrcUnpackedness -> SrcStrictness -> HsImplBang -> Type -> Type
    mkS Maybe FieldLabel
    mlbl SrcUnpackedness
    su SrcStrictness
    ss HsImplBang
    ib Type
    a = TyCon -> [Type] -> Type
    mkTyConApp TyCon
    s1 [Type
    k, Maybe FieldLabel
    -> SrcUnpackedness -> SrcStrictness -> HsImplBang -> Type
    metaSelTy Maybe FieldLabel
    mlbl SrcUnpackedness
    su SrcStrictness
    ss HsImplBang
    ib, Type
    a]

            -- Sums and products are done in the same way for both Rep and Rep1
            sumP :: [DataCon] -> Type
    sumP [DataCon]
    l = forall a. (a -> a -> a) -> a -> [a] -> a
    foldBal Type -> Type -> Type
    mkSum' (TyCon -> [Type] -> Type
    mkTyConApp TyCon
    v1 [Type
    k]) forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall a b. (a -> b) -> [a] -> [b]
    map DataCon -> Type
    mkC forall a b. (a -> b) -> a -> b
    $ [DataCon]
    l
            -- The Bool is True if this constructor has labelled fields
            prod :: [Type] -> [HsSrcBang] -> [HsImplBang] -> [FieldLabel] -> Type
            prod :: [Type] -> [HsSrcBang] -> [HsImplBang] -> [FieldLabel] -> Type
    prod [Type]
    l [HsSrcBang]
    sb [HsImplBang]
    ib [FieldLabel]
    fl = forall a. (a -> a -> a) -> a -> [a] -> a
    foldBal Type -> Type -> Type
    mkProd (TyCon -> [Type] -> Type
    mkTyConApp TyCon
    u1 [Type
    k])
                                      [ ASSERT(null fl || lengthExceeds fl j)
                                        Type -> HsSrcBang -> HsImplBang -> Maybe FieldLabel -> Type
    arg Type
    t HsSrcBang
    sb' HsImplBang
    ib' (if forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [FieldLabel]
    fl
                                                          then forall a. Maybe a
    Nothing
                                                          else forall a. a -> Maybe a
    Just ([FieldLabel]
    fl forall a. [a] -> US -> a
    !! US
    j))
                                      | (Type
    t,HsSrcBang
    sb',HsImplBang
    ib',US
    j) <- forall a b c d. [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]
    zip4 [Type]
    l [HsSrcBang]
    sb [HsImplBang]
    ib [US
    0..] ]

            arg :: Type -> HsSrcBang -> HsImplBang -> Maybe FieldLabel -> Type
            arg :: Type -> HsSrcBang -> HsImplBang -> Maybe FieldLabel -> Type
    arg Type
    t (HsSrcBang SourceText
    _ SrcUnpackedness
    su SrcStrictness
    ss) HsImplBang
    ib Maybe FieldLabel
    fl = Maybe FieldLabel
    -> SrcUnpackedness -> SrcStrictness -> HsImplBang -> Type -> Type
    mkS Maybe FieldLabel
    fl SrcUnpackedness
    su SrcStrictness
    ss HsImplBang
    ib forall a b. (a -> b) -> a -> b
    $ case GenericKind_
    gk_ of
                -- Here we previously used Par0 if t was a type variable, but we
                -- realized that we can't always guarantee that we are wrapping-up
                -- all type variables in Par0. So we decided to stop using Par0
                -- altogether, and use Rec0 all the time.
                          GenericKind_
    Gen0_        -> Type -> Type
    mkRec0 Type
    t
                          Gen1_ TyVar
    argVar -> TyVar -> Type -> Type
    argPar TyVar
    argVar Type
    t
              where
                -- Builds argument representation for Rep1 (more complicated due to
                -- the presence of composition).
                argPar :: TyVar -> Type -> Type
    argPar TyVar
    argVar = forall a. TyVar -> ArgTyAlg a -> Type -> a
    argTyFold TyVar
    argVar forall a b. (a -> b) -> a -> b
    $ ArgTyAlg
                  {ata_rec0 :: Type -> Type
    ata_rec0 = Type -> Type
    mkRec0, ata_par1 :: Type
    ata_par1 = Type
    mkPar1,
                   ata_rec1 :: Type -> Type
    ata_rec1 = Type -> Type
    mkRec1, ata_comp :: Type -> Type -> Type
    ata_comp = TyCon -> Type -> Type -> Type -> Type
    mkComp TyCon
    comp Type
    k}

            tyConName_user :: Name
    tyConName_user = case TyCon -> Maybe (TyCon, [Type])
    tyConFamInst_maybe TyCon
    tycon of
                               Just (TyCon
    ptycon, [Type]
    _) -> TyCon -> Name
    tyConName TyCon
    ptycon
                               Maybe (TyCon, [Type])
    Nothing          -> TyCon -> Name
    tyConName TyCon
    tycon

            dtName :: Type
    dtName  = FastString -> Type
    mkStrLitTy forall b c a. (b -> c) -> (a -> b) -> a -> c
    . OccName -> FastString
    occNameFS forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> OccName
    nameOccName forall a b. (a -> b) -> a -> b
    $ Name
    tyConName_user
            mdName :: Type
    mdName  = FastString -> Type
    mkStrLitTy forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModuleName -> FastString
    moduleNameFS forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall unit. GenModule unit -> ModuleName
    moduleName
                    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HasDebugCallStack => Name -> Module
    nameModule forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TyCon -> Name
    tyConName forall a b. (a -> b) -> a -> b
    $ TyCon
    tycon
            pkgName :: Type
    pkgName = FastString -> Type
    mkStrLitTy forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall u. IsUnitId u => u -> FastString
    unitFS forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall unit. GenModule unit -> unit
    moduleUnit
                    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HasDebugCallStack => Name -> Module
    nameModule forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TyCon -> Name
    tyConName forall a b. (a -> b) -> a -> b
    $ TyCon
    tycon
            isNT :: Type
    isNT    = TyCon -> Type
    mkTyConTy forall a b. (a -> b) -> a -> b
    $ if TyCon -> Bool
    isNewTyCon TyCon
    tycon
                                  then TyCon
    promotedTrueDataCon
                                  else TyCon
    promotedFalseDataCon

            ctName :: DataCon -> Type
    ctName = FastString -> Type
    mkStrLitTy forall b c a. (b -> c) -> (a -> b) -> a -> c
    . OccName -> FastString
    occNameFS forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> OccName
    nameOccName forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DataCon -> Name
    dataConName
            ctFix :: DataCon -> Type
    ctFix DataCon
    c
                | DataCon -> Bool
    dataConIsInfix DataCon
    c
                = case FixityEnv -> Name -> Fixity
    lookupFixity FixityEnv
    fix_env (DataCon -> Name
    dataConName DataCon
    c) of
                       Fixity SourceText
    _ US
    n FixityDirection
    InfixL -> US -> TyCon -> Type
    buildFix US
    n TyCon
    pLA
                       Fixity SourceText
    _ US
    n FixityDirection
    InfixR -> US -> TyCon -> Type
    buildFix US
    n TyCon
    pRA
                       Fixity SourceText
    _ US
    n FixityDirection
    InfixN -> US -> TyCon -> Type
    buildFix US
    n TyCon
    pNA
                | Bool
    otherwise = TyCon -> Type
    mkTyConTy TyCon
    pPrefix
            buildFix :: US -> TyCon -> Type
    buildFix US
    n TyCon
    assoc = TyCon -> [Type] -> Type
    mkTyConApp TyCon
    pInfix [ TyCon -> Type
    mkTyConTy TyCon
    assoc
                                                 , Integer -> Type
    mkNumLitTy (forall a b. (Integral a, Num b) => a -> b
    fromIntegral US
    n)]

            isRec :: DataCon -> Type
    isRec DataCon
    c = TyCon -> Type
    mkTyConTy forall a b. (a -> b) -> a -> b
    $ if DataCon -> [FieldLabel]
    dataConFieldLabels DataCon
    c forall a. [a] -> US -> Bool
    `lengthExceeds` US
    0
                                  then TyCon
    promotedTrueDataCon
                                  else TyCon
    promotedFalseDataCon

            selName :: FieldLabel -> Type
    selName = FastString -> Type
    mkStrLitTy forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FieldLabel -> FastString
    flLabel

            mbSel :: Maybe FieldLabel -> Type
    mbSel Maybe FieldLabel
    Nothing  = TyCon -> [Type] -> Type
    mkTyConApp TyCon
    promotedNothingDataCon [Type
    typeSymbolKind]
            mbSel (Just FieldLabel
    s) = TyCon -> [Type] -> Type
    mkTyConApp TyCon
    promotedJustDataCon
                                        [Type
    typeSymbolKind, FieldLabel -> Type
    selName FieldLabel
    s]

            metaDataTy :: Type
    metaDataTy   = TyCon -> [Type] -> Type
    mkTyConApp TyCon
    md [Type
    dtName, Type
    mdName, Type
    pkgName, Type
    isNT]
            metaConsTy :: DataCon -> Type
    metaConsTy DataCon
    c = TyCon -> [Type] -> Type
    mkTyConApp TyCon
    mc [DataCon -> Type
    ctName DataCon
    c, DataCon -> Type
    ctFix DataCon
    c, DataCon -> Type
    isRec DataCon
    c]
            metaSelTy :: Maybe FieldLabel
    -> SrcUnpackedness -> SrcStrictness -> HsImplBang -> Type
    metaSelTy Maybe FieldLabel
    mlbl SrcUnpackedness
    su SrcStrictness
    ss HsImplBang
    ib =
                TyCon -> [Type] -> Type
    mkTyConApp TyCon
    ms [Maybe FieldLabel -> Type
    mbSel Maybe FieldLabel
    mlbl, Type
    pSUpkness, Type
    pSStrness, Type
    pDStrness]
              where
                pSUpkness :: Type
    pSUpkness = TyCon -> Type
    mkTyConTy forall a b. (a -> b) -> a -> b
    $ case SrcUnpackedness
    su of
                                             SrcUnpackedness
    SrcUnpack   -> TyCon
    pSUpk
                                             SrcUnpackedness
    SrcNoUnpack -> TyCon
    pSNUpk
                                             SrcUnpackedness
    NoSrcUnpack -> TyCon
    pNSUpkness

                pSStrness :: Type
    pSStrness = TyCon -> Type
    mkTyConTy forall a b. (a -> b) -> a -> b
    $ case SrcStrictness
    ss of
                                             SrcStrictness
    SrcLazy     -> TyCon
    pSLzy
                                             SrcStrictness
    SrcStrict   -> TyCon
    pSStr
                                             SrcStrictness
    NoSrcStrict -> TyCon
    pNSStrness

                pDStrness :: Type
    pDStrness = TyCon -> Type
    mkTyConTy forall a b. (a -> b) -> a -> b
    $ case HsImplBang
    ib of
                                             HsImplBang
    HsLazy      -> TyCon
    pDLzy
                                             HsImplBang
    HsStrict    -> TyCon
    pDStr
                                             HsUnpack{}  -> TyCon
    pDUpk

        forall (m :: * -> *) a. Monad m => a -> m a
    return (TyCon -> Type
    mkD TyCon
    tycon)

    mkComp :: TyCon -> Kind -> Type -> Type -> Type
    mkComp :: TyCon -> Type -> Type -> Type -> Type
    mkComp TyCon
    comp Type
    k Type
    f Type
    g
      | Bool
    k1_first  = TyCon -> [Type] -> Type
    mkTyConApp TyCon
    comp  [Type
    k,Type
    liftedTypeKind,Type
    f,Type
    g]
      | Bool
    otherwise = TyCon -> [Type] -> Type
    mkTyConApp TyCon
    comp  [Type
    liftedTypeKind,Type
    k,Type
    f,Type
    g]
      where
        -- Which of these is the case?
        --     newtype (:.:) {k1} {k2} (f :: k2->*) (g :: k1->k2) (p :: k1) = ...
        -- or  newtype (:.:) {k2} {k1} (f :: k2->*) (g :: k1->k2) (p :: k1) = ...
        -- We want to instantiate with k1=k, and k2=*
        --    Reason for k2=*: see Note [Handling kinds in a Rep instance]
        -- But we need to know which way round!
        k1_first :: Bool
    k1_first = TyVar
    k_first forall a. Eq a => a -> a -> Bool
    == TyVar
    p_kind_var
        [TyVar
    k_first,TyVar
    _,TyVar
    _,TyVar
    _,TyVar
    p] = TyCon -> [TyVar]
    tyConTyVars TyCon
    comp
        Just TyVar
    p_kind_var = Type -> Maybe TyVar
    getTyVar_maybe (TyVar -> Type
    tyVarKind TyVar
    p)

    -- Given the TyCons for each URec-related type synonym, check to see if the
    -- given type is an unlifted type that generics understands. If so, return
    -- its representation type. Otherwise, return Rec0.
    -- See Note [Generics and unlifted types]
    mkBoxTy :: TyCon -- UAddr
            -> TyCon -- UChar
            -> TyCon -- UDouble
            -> TyCon -- UFloat
            -> TyCon -- UInt
            -> TyCon -- UWord
            -> TyCon -- Rec0
            -> Kind  -- What to instantiate Rec0's kind variable with
            -> Type
            -> Type
    mkBoxTy :: TyCon
    -> TyCon
    -> TyCon
    -> TyCon
    -> TyCon
    -> TyCon
    -> TyCon
    -> Type
    -> Type
    -> Type
    mkBoxTy TyCon
    uAddr TyCon
    uChar TyCon
    uDouble TyCon
    uFloat TyCon
    uInt TyCon
    uWord TyCon
    rec0 Type
    k Type
    ty
      | Type
    ty Type -> Type -> Bool
    `eqType` Type
    addrPrimTy   = TyCon -> [Type] -> Type
    mkTyConApp TyCon
    uAddr   [Type
    k]
      | Type
    ty Type -> Type -> Bool
    `eqType` Type
    charPrimTy   = TyCon -> [Type] -> Type
    mkTyConApp TyCon
    uChar   [Type
    k]
      | Type
    ty Type -> Type -> Bool
    `eqType` Type
    doublePrimTy = TyCon -> [Type] -> Type
    mkTyConApp TyCon
    uDouble [Type
    k]
      | Type
    ty Type -> Type -> Bool
    `eqType` Type
    floatPrimTy  = TyCon -> [Type] -> Type
    mkTyConApp TyCon
    uFloat  [Type
    k]
      | Type
    ty Type -> Type -> Bool
    `eqType` Type
    intPrimTy    = TyCon -> [Type] -> Type
    mkTyConApp TyCon
    uInt    [Type
    k]
      | Type
    ty Type -> Type -> Bool
    `eqType` Type
    wordPrimTy   = TyCon -> [Type] -> Type
    mkTyConApp TyCon
    uWord   [Type
    k]
      | Bool
    otherwise                = TyCon -> [Type] -> Type
    mkTyConApp TyCon
    rec0    [Type
    k,Type
    ty]

    --------------------------------------------------------------------------------
    -- Dealing with sums
    --------------------------------------------------------------------------------

    mkSum :: GenericKind_ -- Generic or Generic1?
          -> US          -- Base for generating unique names
          -> [DataCon]   -- The data constructors
          -> ([Alt],     -- Alternatives for the T->Trep "from" function
              [Alt])     -- Alternatives for the Trep->T "to" function

    -- Datatype without any constructors
    mkSum :: GenericKind_ -> US -> [DataCon] -> ([Alt], [Alt])
    mkSum GenericKind_
    _ US
    _ [] = ([(GenLocated SrcSpanAnnA (Pat GhcPs), LocatedA (HsExpr GhcPs))
    from_alt], [(GenLocated SrcSpanAnnA (Pat GhcPs), LocatedA (HsExpr GhcPs))
    to_alt])
      where
        from_alt :: (GenLocated SrcSpanAnnA (Pat GhcPs), LocatedA (HsExpr GhcPs))
    from_alt = (LPat GhcPs
    x_Pat, LHsExpr GhcPs -> [LMatch GhcPs (LHsExpr GhcPs)] -> LHsExpr GhcPs
    nlHsCase LHsExpr GhcPs
    x_Expr [])
        to_alt :: (GenLocated SrcSpanAnnA (Pat GhcPs), LocatedA (HsExpr GhcPs))
    to_alt   = (LPat GhcPs
    x_Pat, LHsExpr GhcPs -> [LMatch GhcPs (LHsExpr GhcPs)] -> LHsExpr GhcPs
    nlHsCase LHsExpr GhcPs
    x_Expr [])
                   -- These M1s are meta-information for the datatype

    -- Datatype with at least one constructor
    mkSum GenericKind_
    gk_ US
    us [DataCon]
    datacons =
      -- switch the payload of gk_ to be datacon-centric instead of tycon-centric
     forall a b. [(a, b)] -> ([a], [b])
    unzip [ GenericKind_DC -> US -> US -> US -> DataCon -> (Alt, Alt)
    mk1Sum (GenericKind_ -> DataCon -> GenericKind_DC
    gk2gkDC GenericKind_
    gk_ DataCon
    d) US
    us US
    i (forall (t :: * -> *) a. Foldable t => t a -> US
    length [DataCon]
    datacons) DataCon
    d
               | (DataCon
    d,US
    i) <- forall a b. [a] -> [b] -> [(a, b)]
    zip [DataCon]
    datacons [US
    1..] ]

    -- Build the sum for a particular constructor
    mk1Sum :: GenericKind_DC -- Generic or Generic1?
           -> US        -- Base for generating unique names
           -> Int       -- The index of this constructor
           -> Int       -- Total number of constructors
           -> DataCon   -- The data constructor
           -> (Alt,     -- Alternative for the T->Trep "from" function
               Alt)     -- Alternative for the Trep->T "to" function
    mk1Sum :: GenericKind_DC -> US -> US -> US -> DataCon -> (Alt, Alt)
    mk1Sum GenericKind_DC
    gk_ US
    us US
    i US
    n DataCon
    datacon = ((GenLocated SrcSpanAnnA (Pat GhcPs), LocatedA (HsExpr GhcPs))
    from_alt, (GenLocated SrcSpanAnnA (Pat GhcPs), LocatedA (HsExpr GhcPs))
    to_alt)
      where
        gk :: GenericKind
    gk = GenericKind_DC -> GenericKind
    forgetArgVar GenericKind_DC
    gk_

        -- Existentials already excluded
        argTys :: [Scaled Type]
    argTys = DataCon -> [Scaled Type]
    dataConOrigArgTys DataCon
    datacon
        n_args :: US
    n_args = DataCon -> US
    dataConSourceArity DataCon
    datacon

        datacon_varTys :: [(RdrName, Type)]
    datacon_varTys = forall a b. [a] -> [b] -> [(a, b)]
    zip (forall a b. (a -> b) -> [a] -> [b]
    map US -> RdrName
    mkGenericLocal [US
    us .. US
    usforall a. Num a => a -> a -> a
    +US
    n_argsforall a. Num a => a -> a -> a
    -US
    1]) (forall a b. (a -> b) -> [a] -> [b]
    map forall a. Scaled a -> a
    scaledThing [Scaled Type]
    argTys)
        datacon_vars :: [RdrName]
    datacon_vars = forall a b. (a -> b) -> [a] -> [b]
    map forall a b. (a, b) -> a
    fst [(RdrName, Type)]
    datacon_varTys

        datacon_rdr :: RdrName
    datacon_rdr  = forall thing. NamedThing thing => thing -> RdrName
    getRdrName DataCon
    datacon

        from_alt :: (GenLocated SrcSpanAnnA (Pat GhcPs), LocatedA (HsExpr GhcPs))
    from_alt     = (RdrName -> [RdrName] -> LPat GhcPs
    nlConVarPat RdrName
    datacon_rdr [RdrName]
    datacon_vars, LHsExpr GhcPs
    from_alt_rhs)
        from_alt_rhs :: LHsExpr GhcPs
    from_alt_rhs = US -> US -> LHsExpr GhcPs -> LHsExpr GhcPs
    genLR_E US
    i US
    n (GenericKind_DC -> [(RdrName, Type)] -> LHsExpr GhcPs
    mkProd_E GenericKind_DC
    gk_ [(RdrName, Type)]
    datacon_varTys)

        to_alt :: (GenLocated SrcSpanAnnA (Pat GhcPs), LocatedA (HsExpr GhcPs))
    to_alt     = ( US -> US -> LPat GhcPs -> LPat GhcPs
    genLR_P US
    i US
    n (GenericKind -> [(RdrName, Type)] -> LPat GhcPs
    mkProd_P GenericKind
    gk [(RdrName, Type)]
    datacon_varTys)
                     , LHsExpr GhcPs
    to_alt_rhs
                     ) -- These M1s are meta-information for the datatype
        to_alt_rhs :: LHsExpr GhcPs
    to_alt_rhs = case GenericKind_DC
    gk_ of
          GenericKind_DC
    Gen0_DC        -> forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
    nlHsVarApps RdrName
    datacon_rdr [RdrName]
    datacon_vars
          Gen1_DC TyVar
    argVar -> forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
    nlHsApps RdrName
    datacon_rdr forall a b. (a -> b) -> a -> b
    $ forall a b. (a -> b) -> [a] -> [b]
    map (RdrName, Type) -> LHsExpr GhcPs
    argTo [(RdrName, Type)]
    datacon_varTys
            where
              argTo :: (RdrName, Type) -> LHsExpr GhcPs
    argTo (RdrName
    var, Type
    ty) = Type -> LocatedA (HsExpr GhcPs)
    converter Type
    ty forall (id :: Pass).
    IsPass id =>
    LHsExpr (GhcPass id)
    -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
    `nlHsApp` forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> LHsExpr (GhcPass p)
    nlHsVar RdrName
    var where
                converter :: Type -> LocatedA (HsExpr GhcPs)
    converter = forall a. TyVar -> ArgTyAlg a -> Type -> a
    argTyFold TyVar
    argVar forall a b. (a -> b) -> a -> b
    $ ArgTyAlg
                  {ata_rec0 :: Type -> LocatedA (HsExpr GhcPs)
    ata_rec0 = forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> LHsExpr (GhcPass p)
    nlHsVar forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> RdrName
    unboxRepRDR,
                   ata_par1 :: LocatedA (HsExpr GhcPs)
    ata_par1 = forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> LHsExpr (GhcPass p)
    nlHsVar RdrName
    unPar1_RDR,
                   ata_rec1 :: Type -> LocatedA (HsExpr GhcPs)
    ata_rec1 = forall a b. a -> b -> a
    const forall a b. (a -> b) -> a -> b
    $ forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> LHsExpr (GhcPass p)
    nlHsVar RdrName
    unRec1_RDR,
                   ata_comp :: Type -> LocatedA (HsExpr GhcPs) -> LocatedA (HsExpr GhcPs)
    ata_comp = \Type
    _ LocatedA (HsExpr GhcPs)
    cnv -> (forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> LHsExpr (GhcPass p)
    nlHsVar RdrName
    fmap_RDR forall (id :: Pass).
    IsPass id =>
    LHsExpr (GhcPass id)
    -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
    `nlHsApp` LocatedA (HsExpr GhcPs)
    cnv)
                                        LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
    `nlHsCompose` forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> LHsExpr (GhcPass p)
    nlHsVar RdrName
    unComp1_RDR}

    -- Generates the L1/R1 sum pattern
    genLR_P :: Int -> Int -> LPat GhcPs -> LPat GhcPs
    genLR_P :: US -> US -> LPat GhcPs -> LPat GhcPs
    genLR_P US
    i US
    n LPat GhcPs
    p
      | US
    n forall a. Eq a => a -> a -> Bool
    == US
    0       = forall a. HasCallStack => String -> a
    error String
    "impossible"
      | US
    n forall a. Eq a => a -> a -> Bool
    == US
    1       = LPat GhcPs
    p
      | US
    i forall a. Ord a => a -> a -> Bool
    <= forall a. Integral a => a -> a -> a
    div US
    n US
    2 = forall (name :: Pass). LPat (GhcPass name) -> LPat (GhcPass name)
    nlParPat forall a b. (a -> b) -> a -> b
    $ RdrName -> [LPat GhcPs] -> LPat GhcPs
    nlConPat RdrName
    l1DataCon_RDR [US -> US -> LPat GhcPs -> LPat GhcPs
    genLR_P US
    i     (forall a. Integral a => a -> a -> a
    div US
    n US
    2) LPat GhcPs
    p]
      | Bool
    otherwise    = forall (name :: Pass). LPat (GhcPass name) -> LPat (GhcPass name)
    nlParPat forall a b. (a -> b) -> a -> b
    $ RdrName -> [LPat GhcPs] -> LPat GhcPs
    nlConPat RdrName
    r1DataCon_RDR [US -> US -> LPat GhcPs -> LPat GhcPs
    genLR_P (US
    iforall a. Num a => a -> a -> a
    -US
    m) (US
    nforall a. Num a => a -> a -> a
    -US
    m)     LPat GhcPs
    p]
                         where m :: US
    m = forall a. Integral a => a -> a -> a
    div US
    n US
    2

    -- Generates the L1/R1 sum expression
    genLR_E :: Int -> Int -> LHsExpr GhcPs -> LHsExpr GhcPs
    genLR_E :: US -> US -> LHsExpr GhcPs -> LHsExpr GhcPs
    genLR_E US
    i US
    n LHsExpr GhcPs
    e
      | US
    n forall a. Eq a => a -> a -> Bool
    == US
    0       = forall a. HasCallStack => String -> a
    error String
    "impossible"
      | US
    n forall a. Eq a => a -> a -> Bool
    == US
    1       = LHsExpr GhcPs
    e
      | US
    i forall a. Ord a => a -> a -> Bool
    <= forall a. Integral a => a -> a -> a
    div US
    n US
    2 = forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> LHsExpr (GhcPass p)
    nlHsVar RdrName
    l1DataCon_RDR forall (id :: Pass).
    IsPass id =>
    LHsExpr (GhcPass id)
    -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
    `nlHsApp`
                                                forall (id :: Pass). LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsPar (US -> US -> LHsExpr GhcPs -> LHsExpr GhcPs
    genLR_E US
    i     (forall a. Integral a => a -> a -> a
    div US
    n US
    2) LHsExpr GhcPs
    e)
      | Bool
    otherwise    = forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> LHsExpr (GhcPass p)
    nlHsVar RdrName
    r1DataCon_RDR forall (id :: Pass).
    IsPass id =>
    LHsExpr (GhcPass id)
    -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
    `nlHsApp`
                                                forall (id :: Pass). LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsPar (US -> US -> LHsExpr GhcPs -> LHsExpr GhcPs
    genLR_E (US
    iforall a. Num a => a -> a -> a
    -US
    m) (US
    nforall a. Num a => a -> a -> a
    -US
    m)     LHsExpr GhcPs
    e)
                         where m :: US
    m = forall a. Integral a => a -> a -> a
    div US
    n US
    2

    --------------------------------------------------------------------------------
    -- Dealing with products
    --------------------------------------------------------------------------------

    -- Build a product expression
    mkProd_E :: GenericKind_DC    -- Generic or Generic1?
             -> [(RdrName, Type)]
                           -- List of variables matched on the lhs and their types
             -> LHsExpr GhcPs   -- Resulting product expression
    mkProd_E :: GenericKind_DC -> [(RdrName, Type)] -> LHsExpr GhcPs
    mkProd_E GenericKind_DC
    gk_ [(RdrName, Type)]
    varTys = LHsExpr GhcPs -> LHsExpr GhcPs
    mkM1_E (forall a. (a -> a -> a) -> a -> [a] -> a
    foldBal forall {p :: Pass}.
    (Anno (IdGhcP p) ~ SrcSpanAnn' (EpAnn NameAnn), IdGhcP p ~ RdrName,
     IsPass p) =>
    GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
    -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
    -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
    prod (forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> LHsExpr (GhcPass p)
    nlHsVar RdrName
    u1DataCon_RDR) [LocatedA (HsExpr GhcPs)]
    appVars)
                          -- These M1s are meta-information for the constructor
      where
        appVars :: [LocatedA (HsExpr GhcPs)]
    appVars = forall a b. (a -> b) -> [a] -> [b]
    map (GenericKind_DC -> (RdrName, Type) -> LHsExpr GhcPs
    wrapArg_E GenericKind_DC
    gk_) [(RdrName, Type)]
    varTys
        prod :: GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
    -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
    -> LHsExpr (GhcPass p)
    prod GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
    a GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
    b = RdrName
    prodDataCon_RDR forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
    `nlHsApps` [GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
    a,GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
    b]

    wrapArg_E :: GenericKind_DC -> (RdrName, Type) -> LHsExpr GhcPs
    wrapArg_E :: GenericKind_DC -> (RdrName, Type) -> LHsExpr GhcPs
    wrapArg_E GenericKind_DC
    Gen0_DC          (RdrName
    var, Type
    ty) = LHsExpr GhcPs -> LHsExpr GhcPs
    mkM1_E forall a b. (a -> b) -> a -> b
    $
                                Type -> RdrName
    boxRepRDR Type
    ty forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
    `nlHsVarApps` [RdrName
    var]
                             -- This M1 is meta-information for the selector
    wrapArg_E (Gen1_DC TyVar
    argVar) (RdrName
    var, Type
    ty) = LHsExpr GhcPs -> LHsExpr GhcPs
    mkM1_E forall a b. (a -> b) -> a -> b
    $
                                Type -> LocatedA (HsExpr GhcPs)
    converter Type
    ty forall (id :: Pass).
    IsPass id =>
    LHsExpr (GhcPass id)
    -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
    `nlHsApp` forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> LHsExpr (GhcPass p)
    nlHsVar RdrName
    var
                             -- This M1 is meta-information for the selector
      where converter :: Type -> LocatedA (HsExpr GhcPs)
    converter = forall a. TyVar -> ArgTyAlg a -> Type -> a
    argTyFold TyVar
    argVar forall a b. (a -> b) -> a -> b
    $ ArgTyAlg
              {ata_rec0 :: Type -> LocatedA (HsExpr GhcPs)
    ata_rec0 = forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> LHsExpr (GhcPass p)
    nlHsVar forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> RdrName
    boxRepRDR,
               ata_par1 :: LocatedA (HsExpr GhcPs)
    ata_par1 = forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> LHsExpr (GhcPass p)
    nlHsVar RdrName
    par1DataCon_RDR,
               ata_rec1 :: Type -> LocatedA (HsExpr GhcPs)
    ata_rec1 = forall a b. a -> b -> a
    const forall a b. (a -> b) -> a -> b
    $ forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> LHsExpr (GhcPass p)
    nlHsVar RdrName
    rec1DataCon_RDR,
               ata_comp :: Type -> LocatedA (HsExpr GhcPs) -> LocatedA (HsExpr GhcPs)
    ata_comp = \Type
    _ LocatedA (HsExpr GhcPs)
    cnv -> forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> LHsExpr (GhcPass p)
    nlHsVar RdrName
    comp1DataCon_RDR LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
    `nlHsCompose`
                                      (forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> LHsExpr (GhcPass p)
    nlHsVar RdrName
    fmap_RDR forall (id :: Pass).
    IsPass id =>
    LHsExpr (GhcPass id)
    -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
    `nlHsApp` LocatedA (HsExpr GhcPs)
    cnv)}

    boxRepRDR :: Type -> RdrName
    boxRepRDR :: Type -> RdrName
    boxRepRDR = forall b a. b -> (a -> b) -> Maybe a -> b
    maybe RdrName
    k1DataCon_RDR forall a b. (a, b) -> a
    fst forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> Maybe (RdrName, RdrName)
    unboxedRepRDRs

    unboxRepRDR :: Type -> RdrName
    unboxRepRDR :: Type -> RdrName
    unboxRepRDR = forall b a. b -> (a -> b) -> Maybe a -> b
    maybe RdrName
    unK1_RDR forall a b. (a, b) -> b
    snd forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> Maybe (RdrName, RdrName)
    unboxedRepRDRs

    -- Retrieve the RDRs associated with each URec data family instance
    -- constructor. See Note [Generics and unlifted types]
    unboxedRepRDRs :: Type -> Maybe (RdrName, RdrName)
    unboxedRepRDRs :: Type -> Maybe (RdrName, RdrName)
    unboxedRepRDRs Type
    ty
      | Type
    ty Type -> Type -> Bool
    `eqType` Type
    addrPrimTy   = forall a. a -> Maybe a
    Just (RdrName
    uAddrDataCon_RDR,   RdrName
    uAddrHash_RDR)
      | Type
    ty Type -> Type -> Bool
    `eqType` Type
    charPrimTy   = forall a. a -> Maybe a
    Just (RdrName
    uCharDataCon_RDR,   RdrName
    uCharHash_RDR)
      | Type
    ty Type -> Type -> Bool
    `eqType` Type
    doublePrimTy = forall a. a -> Maybe a
    Just (RdrName
    uDoubleDataCon_RDR, RdrName
    uDoubleHash_RDR)
      | Type
    ty Type -> Type -> Bool
    `eqType` Type
    floatPrimTy  = forall a. a -> Maybe a
    Just (RdrName
    uFloatDataCon_RDR,  RdrName
    uFloatHash_RDR)
      | Type
    ty Type -> Type -> Bool
    `eqType` Type
    intPrimTy    = forall a. a -> Maybe a
    Just (RdrName
    uIntDataCon_RDR,    RdrName
    uIntHash_RDR)
      | Type
    ty Type -> Type -> Bool
    `eqType` Type
    wordPrimTy   = forall a. a -> Maybe a
    Just (RdrName
    uWordDataCon_RDR,   RdrName
    uWordHash_RDR)
      | Bool
    otherwise          = forall a. Maybe a
    Nothing

    -- Build a product pattern
    mkProd_P :: GenericKind       -- Gen0 or Gen1
             -> [(RdrName, Type)] -- List of variables to match,
                                  --   along with their types
             -> LPat GhcPs      -- Resulting product pattern
    mkProd_P :: GenericKind -> [(RdrName, Type)] -> LPat GhcPs
    mkProd_P GenericKind
    gk [(RdrName, Type)]
    varTys = LPat GhcPs -> LPat GhcPs
    mkM1_P (forall a. (a -> a -> a) -> a -> [a] -> a
    foldBal GenLocated SrcSpanAnnA (Pat GhcPs)
    -> GenLocated SrcSpanAnnA (Pat GhcPs)
    -> GenLocated SrcSpanAnnA (Pat GhcPs)
    prod (RdrName -> LPat GhcPs
    nlNullaryConPat RdrName
    u1DataCon_RDR) [GenLocated SrcSpanAnnA (Pat GhcPs)]
    appVars)
                         -- These M1s are meta-information for the constructor
      where
        appVars :: [GenLocated SrcSpanAnnA (Pat GhcPs)]
    appVars = forall a b c. (a -> b -> c) -> [(a, b)] -> [c]
    unzipWith (GenericKind -> RdrName -> Type -> LPat GhcPs
    wrapArg_P GenericKind
    gk) [(RdrName, Type)]
    varTys
        prod :: GenLocated SrcSpanAnnA (Pat GhcPs)
    -> GenLocated SrcSpanAnnA (Pat GhcPs) -> LPat GhcPs
    prod GenLocated SrcSpanAnnA (Pat GhcPs)
    a GenLocated SrcSpanAnnA (Pat GhcPs)
    b = forall (name :: Pass). LPat (GhcPass name) -> LPat (GhcPass name)
    nlParPat forall a b. (a -> b) -> a -> b
    $ RdrName
    prodDataCon_RDR RdrName -> [LPat GhcPs] -> LPat GhcPs
    `nlConPat` [GenLocated SrcSpanAnnA (Pat GhcPs)
    a,GenLocated SrcSpanAnnA (Pat GhcPs)
    b]

    wrapArg_P :: GenericKind -> RdrName -> Type -> LPat GhcPs
    wrapArg_P :: GenericKind -> RdrName -> Type -> LPat GhcPs
    wrapArg_P GenericKind
    Gen0 RdrName
    v Type
    ty = LPat GhcPs -> LPat GhcPs
    mkM1_P (forall (name :: Pass). LPat (GhcPass name) -> LPat (GhcPass name)
    nlParPat forall a b. (a -> b) -> a -> b
    $ Type -> RdrName
    boxRepRDR Type
    ty RdrName -> [RdrName] -> LPat GhcPs
    `nlConVarPat` [RdrName
    v])
                       -- This M1 is meta-information for the selector
    wrapArg_P GenericKind
    Gen1 RdrName
    v Type
    _  = forall (name :: Pass). LPat (GhcPass name) -> LPat (GhcPass name)
    nlParPat forall a b. (a -> b) -> a -> b
    $ RdrName
    m1DataCon_RDR RdrName -> [RdrName] -> LPat GhcPs
    `nlConVarPat` [RdrName
    v]

    mkGenericLocal :: US -> RdrName
    mkGenericLocal :: US -> RdrName
    mkGenericLocal US
    u = FastString -> RdrName
    mkVarUnqual (String -> FastString
    mkFastString (String
    "g" forall a. [a] -> [a] -> [a]
    ++ forall a. Show a => a -> String
    show US
    u))

    x_RDR :: RdrName
    x_RDR :: RdrName
    x_RDR = FastString -> RdrName
    mkVarUnqual (String -> FastString
    fsLit String
    "x")

    x_Expr :: LHsExpr GhcPs
    x_Expr :: LHsExpr GhcPs
    x_Expr = forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> LHsExpr (GhcPass p)
    nlHsVar RdrName
    x_RDR

    x_Pat :: LPat GhcPs
    x_Pat :: LPat GhcPs
    x_Pat = forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> LPat (GhcPass p)
    nlVarPat RdrName
    x_RDR

    mkM1_E :: LHsExpr GhcPs -> LHsExpr GhcPs
    mkM1_E :: LHsExpr GhcPs -> LHsExpr GhcPs
    mkM1_E LHsExpr GhcPs
    e = forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> LHsExpr (GhcPass p)
    nlHsVar RdrName
    m1DataCon_RDR forall (id :: Pass).
    IsPass id =>
    LHsExpr (GhcPass id)
    -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
    `nlHsApp` LHsExpr GhcPs
    e

    mkM1_P :: LPat GhcPs -> LPat GhcPs
    mkM1_P :: LPat GhcPs -> LPat GhcPs
    mkM1_P LPat GhcPs
    p = forall (name :: Pass). LPat (GhcPass name) -> LPat (GhcPass name)
    nlParPat forall a b. (a -> b) -> a -> b
    $ RdrName
    m1DataCon_RDR RdrName -> [LPat GhcPs] -> LPat GhcPs
    `nlConPat` [LPat GhcPs
    p]

    nlHsCompose :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
    nlHsCompose :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
    nlHsCompose LHsExpr GhcPs
    x LHsExpr GhcPs
    y = RdrName
    compose_RDR forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
    `nlHsApps` [LHsExpr GhcPs
    x, LHsExpr GhcPs
    y]

    -- | Variant of foldr for producing balanced lists
    foldBal :: (a -> a -> a) -> a -> [a] -> a
    {-# INLINE foldBal #-} -- inlined to produce specialised code for each op
    foldBal :: forall a. (a -> a -> a) -> a -> [a] -> a
    foldBal a -> a -> a
    op0 a
    x0 [a]
    xs0 = forall {t}. (t -> t -> t) -> t -> US -> [t] -> t
    fold_bal a -> a -> a
    op0 a
    x0 (forall (t :: * -> *) a. Foldable t => t a -> US
    length [a]
    xs0) [a]
    xs0
      where
        fold_bal :: (t -> t -> t) -> t -> US -> [t] -> t
    fold_bal t -> t -> t
    op t
    x !US
    n [t]
    xs = case [t]
    xs of
          []  -> t
    x
          [t
    a] -> t
    a
          [t]
    _   -> let !nl :: US
    nl = US
    n forall a. Integral a => a -> a -> a
    `div` US
    2
                     !nr :: US
    nr = US
    n forall a. Num a => a -> a -> a
    - US
    nl
                     ([t]
    l,[t]
    r) = forall a. US -> [a] -> ([a], [a])
    splitAt US
    nl [t]
    xs
                 in (t -> t -> t) -> t -> US -> [t] -> t
    fold_bal t -> t -> t
    op t
    x US
    nl [t]
    l
                    t -> t -> t
    `op` (t -> t -> t) -> t -> US -> [t] -> t
    fold_bal t -> t -> t
    op t
    x US
    nr [t]
    r

    {-
    Note [Generics and unlifted types]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Normally, all constants are marked with K1/Rec0. The exception to this rule is
    when a data constructor has an unlifted argument (e.g., Int#, Char#, etc.). In
    that case, we must use a data family instance of URec (from GHC.Generics) to
    mark it. As a result, before we can generate K1 or unK1, we must first check
    to see if the type is actually one of the unlifted types for which URec has a
    data family instance; if so, we generate that instead.

    See wiki:commentary/compiler/generic-deriving#handling-unlifted-types for more
    details on why URec is implemented the way it is.

    Note [Generating a correctly typed Rep instance]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    tc_mkRepTy derives the RHS of the Rep(1) type family instance when deriving
    Generic(1). That is, it derives the ellipsis in the following:

        instance Generic Foo where
          type Rep Foo = ...

    However, tc_mkRepTy only has knowledge of the *TyCon* of the type for which
    a Generic(1) instance is being derived, not the fully instantiated type. As a
    result, tc_mkRepTy builds the most generalized Rep(1) instance possible using
    the type variables it learns from the TyCon (i.e., it uses tyConTyVars). This
    can cause problems when the instance has instantiated type variables
    (see #11732). As an example:

        data T a = MkT a
        deriving instance Generic (T Int)
        ==>
        instance Generic (T Int) where
          type Rep (T Int) = (... (Rec0 a)) -- wrong!

    -XStandaloneDeriving is one way for the type variables to become instantiated.
    Another way is when Generic1 is being derived for a datatype with a visible
    kind binder, e.g.,

       data P k (a :: k) = MkP k deriving Generic1
       ==>
       instance Generic1 (P *) where
         type Rep1 (P *) = (... (Rec0 k)) -- wrong!

    See Note [Unify kinds in deriving] in GHC.Tc.Deriv.

    In any such scenario, we must prevent a discrepancy between the LHS and RHS of
    a Rep(1) instance. To do so, we create a type variable substitution that maps
    the tyConTyVars of the TyCon to their counterparts in the fully instantiated
    type. (For example, using T above as example, you'd map a :-> Int.) We then
    apply the substitution to the RHS before generating the instance.

    A wrinkle in all of this: when forming the type variable substitution for
    Generic1 instances, we map the last type variable of the tycon to Any. Why?
    It's because of wily data types like this one (#15012):

       data T a = MkT (FakeOut a)
       type FakeOut a = Int

    If we ignore a, then we'll produce the following Rep1 instance:

       instance Generic1 T where
         type Rep1 T = ... (Rec0 (FakeOut a))
         ...

    Oh no! Now we have `a` on the RHS, but it's completely unbound. Instead, we
    ensure that `a` is mapped to Any:

       instance Generic1 T where
         type Rep1 T = ... (Rec0 (FakeOut Any))
         ...

    And now all is good.

    Alternatively, we could have avoided this problem by expanding all type
    synonyms on the RHSes of Rep1 instances. But we might blow up the size of
    these types even further by doing this, so we choose not to do so.

    Note [Handling kinds in a Rep instance]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Because Generic1 is poly-kinded, the representation types were generalized to
    be kind-polymorphic as well. As a result, tc_mkRepTy must explicitly apply
    the kind of the instance being derived to all the representation type
    constructors. For instance, if you have

        data Empty (a :: k) = Empty deriving Generic1

    Then the generated code is now approximately (with -fprint-explicit-kinds
    syntax):

        instance Generic1 k (Empty k) where
          type Rep1 k (Empty k) = U1 k

    Most representation types have only one kind variable, making them easy to deal
    with. The only non-trivial case is (:.:), which is only used in Generic1
    instances:

        newtype (:.:) (f :: k2 -> *) (g :: k1 -> k2) (p :: k1) =
            Comp1 { unComp1 :: f (g p) }

    Here, we do something a bit counter-intuitive: we make k1 be the kind of the
    instance being derived, and we always make k2 be *. Why *? It's because
    the code that GHC generates using (:.:) is always of the form x :.: Rec1 y
    for some types x and y. In other words, the second type to which (:.:) is
    applied always has kind k -> *, for some kind k, so k2 cannot possibly be
    anything other than * in a generated Generic1 instance.

    Note [Generics compilation speed tricks]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Deriving Generic(1) is known to have a large constant factor during
    compilation, which contributes to noticeable compilation slowdowns when
    deriving Generic(1) for large datatypes (see #5642).

    To ease the pain, there is a trick one can play when generating definitions for
    to(1) and from(1). If you have a datatype like:

      data Letter = A | B | C | D

    then a naïve Generic instance for Letter would be:

      instance Generic Letter where
        type Rep Letter = D1 ('MetaData ...) ...

        to (M1 (L1 (L1 (M1 U1)))) = A
        to (M1 (L1 (R1 (M1 U1)))) = B
        to (M1 (R1 (L1 (M1 U1)))) = C
        to (M1 (R1 (R1 (M1 U1)))) = D

        from A = M1 (L1 (L1 (M1 U1)))
        from B = M1 (L1 (R1 (M1 U1)))
        from C = M1 (R1 (L1 (M1 U1)))
        from D = M1 (R1 (R1 (M1 U1)))

    Notice that in every LHS pattern-match of the 'to' definition, and in every RHS
    expression in the 'from' definition, the topmost constructor is M1. This
    corresponds to the datatype-specific metadata (the D1 in the Rep Letter
    instance). But this is wasteful from a typechecking perspective, since this
    definition requires GHC to typecheck an application of M1 in every single case,
    leading to an O(n) increase in the number of coercions the typechecker has to
    solve, which in turn increases allocations and degrades compilation speed.

    Luckily, since the topmost M1 has the exact same type across every case, we can
    factor it out reduce the typechecker's burden:

      instance Generic Letter where
        type Rep Letter = D1 ('MetaData ...) ...

        to (M1 x) = case x of
          L1 (L1 (M1 U1)) -> A
          L1 (R1 (M1 U1)) -> B
          R1 (L1 (M1 U1)) -> C
          R1 (R1 (M1 U1)) -> D

        from x = M1 (case x of
          A -> L1 (L1 (M1 U1))
          B -> L1 (R1 (M1 U1))
          C -> R1 (L1 (M1 U1))
          D -> R1 (R1 (M1 U1)))

    A simple change, but one that pays off, since it goes turns an O(n) amount of
    coercions to an O(1) amount.

    Note [Generics performance tricks]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Generics-based algorithms tend to rely on GHC optimizing away the intermediate
    representation for optimal performance. However, the default unfolding threshold
    is usually too small for GHC to do that.

    The recommended approach thus far was to increase unfolding threshold, but this
    makes GHC inline more aggressively in general, whereas it should only be more
    aggresive with generics-based code.

    The solution is to use a heuristic that'll annotate Generic class methods with
    INLINE[1] pragmas (the explicit phase is used to give users phase control as
    they can annotate their functions with INLINE[2] or INLINE[0] if appropriate).

    The current heuristic was chosen by looking at how annotating Generic methods
    INLINE[1] helps with optimal code generation for several types of generic
    algorithms:

    * Round trip through the generic representation.

    * Generation of NFData instances.

    * Generation of field lenses.

    The experimentation was done by picking data types having N constructors with M
    fields each and using their derived Generic instances to generate code with the
    above algorithms.

    The results are threshold values for N and M (contained in
    `mkBindsRep.inlining_useful`) for which inlining is beneficial, i.e. it usually
    leads to performance improvements at both compile time (the simplifier has to do
    more work, but then there's much less code left for subsequent phases to work
    with) and run time (the generic representation of a data type is optimized
    away).

    The T11068 test case, which includes the algorithms mentioned above, tests that
    the generic representations of several data types optimize away using the
    threshold values in `mkBindsRep.inlining_useful`.

    If one uses threshold values higher what is found in
    `mkBindsRep.inlining_useful`, then annotating Generic class methods with INLINE
    pragmas tends to be at best useless and at worst lead to code size blowup
    without runtime performance improvements.
    -}