    {- Language/Haskell/TH/Desugar/Core.hs

    (c) Richard Eisenberg 2013
    rae@cs.brynmawr.edu

    Desugars full Template Haskell syntax into a smaller core syntax for further
    processing. The desugared types and constructors are prefixed with a D.
    -}

    {-# LANGUAGE TemplateHaskellQuotes, LambdaCase, CPP, ScopedTypeVariables,
                 TupleSections, DeriveDataTypeable, DeriveGeneric #-}

    module Language.Haskell.TH.Desugar.Core where

    import Prelude hiding (mapM, foldl, foldr, all, elem, exp, concatMap, and)

    import Language.Haskell.TH hiding (Extension(..), match, clause, cxt)
    import Language.Haskell.TH.Datatype.TyVarBndr
    import Language.Haskell.TH.Syntax hiding (Extension(..), lift)

    import Control.Monad hiding (forM_, mapM)
    import qualified Control.Monad.Fail as Fail
    import Control.Monad.Trans (MonadTrans(..))
    import Control.Monad.Writer (MonadWriter(..), WriterT(..))
    import Control.Monad.Zip
    import Data.Data (Data)
    import Data.Either (lefts)
    import Data.Foldable as F hiding (concat, notElem)
    import qualified Data.Map as M
    import Data.Map (Map)
    import Data.Maybe (isJust, mapMaybe)
    import Data.Monoid (All(..))
    import qualified Data.Set as S
    import Data.Set (Set)
    import Data.Traversable

    #if __GLASGOW_HASKELL__ >= 803
    import GHC.OverloadedLabels ( fromLabel )
    #endif

    #if __GLASGOW_HASKELL__ >= 807
    import GHC.Classes (IP(..))
    #else
    import qualified Language.Haskell.TH as LangExt (Extension(..))
    #endif

    #if __GLASGOW_HASKELL__ >= 902
    import Data.List.NonEmpty (NonEmpty(..))
    import GHC.Records (HasField(..))
    #endif

    import GHC.Exts
    import GHC.Generics (Generic)

    import Language.Haskell.TH.Desugar.AST
    import Language.Haskell.TH.Desugar.FV
    import qualified Language.Haskell.TH.Desugar.OSet as OS
    import Language.Haskell.TH.Desugar.OSet (OSet)
    import Language.Haskell.TH.Desugar.Util
    import Language.Haskell.TH.Desugar.Reify

    -- | Desugar an expression

    dsExp :: DsMonad q => Exp -> q DExp
    dsExp :: forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp (VarE Name
    n) = DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DExp -> q DExp) -> DExp -> q DExp
    forall a b. (a -> b) -> a -> b
    $ Name -> DExp
    DVarE Name
    n
    dsExp (ConE Name
    n) = DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DExp -> q DExp) -> DExp -> q DExp
    forall a b. (a -> b) -> a -> b
    $ Name -> DExp
    DConE Name
    n
    dsExp (LitE Lit
    lit) = DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DExp -> q DExp) -> DExp -> q DExp
    forall a b. (a -> b) -> a -> b
    $ Lit -> DExp
    DLitE Lit
    lit
    dsExp (AppE Exp
    e1 Exp
    e2) = DExp -> DExp -> DExp
    DAppE (DExp -> DExp -> DExp) -> q DExp -> q (DExp -> DExp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    e1 q (DExp -> DExp) -> q DExp -> q DExp
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    e2
    dsExp (InfixE Maybe Exp
    Nothing Exp
    op Maybe Exp
    Nothing) = Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    op
    dsExp (InfixE (Just Exp
    lhs) Exp
    op Maybe Exp
    Nothing) = DExp -> DExp -> DExp
    DAppE (DExp -> DExp -> DExp) -> q DExp -> q (DExp -> DExp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    op) q (DExp -> DExp) -> q DExp -> q DExp
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    lhs)
    dsExp (InfixE Maybe Exp
    Nothing Exp
    op (Just Exp
    rhs)) = do
      Name
    lhsName <- String -> q Name
    forall (q :: * -> *). Quasi q => String -> q Name
    newUniqueName String
    "lhs"
      DExp
    op' <- Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    op
      DExp
    rhs' <- Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    rhs
      DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DExp -> q DExp) -> DExp -> q DExp
    forall a b. (a -> b) -> a -> b
    $ [Name] -> DExp -> DExp
    DLamE [Name
    lhsName] ((DExp -> DExp -> DExp) -> DExp -> [DExp] -> DExp
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl DExp -> DExp -> DExp
    DAppE DExp
    op' [Name -> DExp
    DVarE Name
    lhsName, DExp
    rhs'])
    dsExp (InfixE (Just Exp
    lhs) Exp
    op (Just Exp
    rhs)) =
      DExp -> DExp -> DExp
    DAppE (DExp -> DExp -> DExp) -> q DExp -> q (DExp -> DExp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (DExp -> DExp -> DExp
    DAppE (DExp -> DExp -> DExp) -> q DExp -> q (DExp -> DExp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    op q (DExp -> DExp) -> q DExp -> q DExp
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    lhs) q (DExp -> DExp) -> q DExp -> q DExp
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    rhs
    dsExp (UInfixE Exp
    _ Exp
    _ Exp
    _) =
      String -> q DExp
    forall a. String -> q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Cannot desugar unresolved infix operators."
    dsExp (ParensE Exp
    exp) = Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    exp
    dsExp (LamE [Pat]
    pats Exp
    exp) = do
      DExp
    exp' <- Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    exp
      ([DPat]
    pats', DExp
    exp'') <- [Pat] -> DExp -> q ([DPat], DExp)
    forall (q :: * -> *).
    DsMonad q =>
    [Pat] -> DExp -> q ([DPat], DExp)
    dsPatsOverExp [Pat]
    pats DExp
    exp'
      [DPat] -> DExp -> q DExp
    forall (q :: * -> *). Quasi q => [DPat] -> DExp -> q DExp
    mkDLamEFromDPats [DPat]
    pats' DExp
    exp''
    dsExp (LamCaseE [Match]
    matches) = do
      Name
    x <- String -> q Name
    forall (q :: * -> *). Quasi q => String -> q Name
    newUniqueName String
    "x"
      [DMatch]
    matches' <- Name -> [Match] -> q [DMatch]
    forall (q :: * -> *). DsMonad q => Name -> [Match] -> q [DMatch]
    dsMatches Name
    x [Match]
    matches
      DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DExp -> q DExp) -> DExp -> q DExp
    forall a b. (a -> b) -> a -> b
    $ [Name] -> DExp -> DExp
    DLamE [Name
    x] (DExp -> [DMatch] -> DExp
    DCaseE (Name -> DExp
    DVarE Name
    x) [DMatch]
    matches')
    dsExp (TupE [Maybe Exp]
    exps) = (Int -> Name) -> [Maybe Exp] -> q DExp
    forall (q :: * -> *).
    DsMonad q =>
    (Int -> Name) -> [Maybe Exp] -> q DExp
    dsTup Int -> Name
    tupleDataName [Maybe Exp]
    exps
    dsExp (UnboxedTupE [Maybe Exp]
    exps) = (Int -> Name) -> [Maybe Exp] -> q DExp
    forall (q :: * -> *).
    DsMonad q =>
    (Int -> Name) -> [Maybe Exp] -> q DExp
    dsTup Int -> Name
    unboxedTupleDataName [Maybe Exp]
    exps
    dsExp (CondE Exp
    e1 Exp
    e2 Exp
    e3) =
      Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp (Exp -> [Match] -> Exp
    CaseE Exp
    e1 [Name -> Exp -> Match
    mkBoolMatch 'True Exp
    e2, Name -> Exp -> Match
    mkBoolMatch 'False Exp
    e3])
      where
        mkBoolMatch :: Name -> Exp -> Match
        mkBoolMatch :: Name -> Exp -> Match
    mkBoolMatch Name
    boolDataCon Exp
    rhs =
          Pat -> Body -> [Dec] -> Match
    Match (Name -> [Type] -> [Pat] -> Pat
    ConP Name
    boolDataCon
    #if __GLASGOW_HASKELL__ >= 901
                      []
    #endif
                      []) (Exp -> Body
    NormalB Exp
    rhs) []
    dsExp (MultiIfE [(Guard, Exp)]
    guarded_exps) =
      let failure :: DExp
    failure = MatchContext -> DExp
    mkErrorMatchExpr MatchContext
    MultiWayIfAlt in
      [(Guard, Exp)] -> DExp -> q DExp
    forall (q :: * -> *). DsMonad q => [(Guard, Exp)] -> DExp -> q DExp
    dsGuards [(Guard, Exp)]
    guarded_exps DExp
    failure
    dsExp (LetE [Dec]
    decs Exp
    exp) = do
      ([DLetDec]
    decs', DExp -> DExp
    ip_binder) <- [Dec] -> q ([DLetDec], DExp -> DExp)
    forall (q :: * -> *).
    DsMonad q =>
    [Dec] -> q ([DLetDec], DExp -> DExp)
    dsLetDecs [Dec]
    decs
      DExp
    exp' <- Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    exp
      DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DExp -> q DExp) -> DExp -> q DExp
    forall a b. (a -> b) -> a -> b
    $ [DLetDec] -> DExp -> DExp
    DLetE [DLetDec]
    decs' (DExp -> DExp) -> DExp -> DExp
    forall a b. (a -> b) -> a -> b
    $ DExp -> DExp
    ip_binder DExp
    exp'
        -- the following special case avoids creating a new "let" when it's not

        -- necessary. See #34.

    dsExp (CaseE (VarE Name
    scrutinee) [Match]
    matches) = do
      [DMatch]
    matches' <- Name -> [Match] -> q [DMatch]
    forall (q :: * -> *). DsMonad q => Name -> [Match] -> q [DMatch]
    dsMatches Name
    scrutinee [Match]
    matches
      DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DExp -> q DExp) -> DExp -> q DExp
    forall a b. (a -> b) -> a -> b
    $ DExp -> [DMatch] -> DExp
    DCaseE (Name -> DExp
    DVarE Name
    scrutinee) [DMatch]
    matches'
    dsExp (CaseE Exp
    exp [Match]
    matches) = do
      Name
    scrutinee <- String -> q Name
    forall (q :: * -> *). Quasi q => String -> q Name
    newUniqueName String
    "scrutinee"
      DExp
    exp' <- Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    exp
      [DMatch]
    matches' <- Name -> [Match] -> q [DMatch]
    forall (q :: * -> *). DsMonad q => Name -> [Match] -> q [DMatch]
    dsMatches Name
    scrutinee [Match]
    matches
      DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DExp -> q DExp) -> DExp -> q DExp
    forall a b. (a -> b) -> a -> b
    $ [DLetDec] -> DExp -> DExp
    DLetE [DPat -> DExp -> DLetDec
    DValD (Name -> DPat
    DVarP Name
    scrutinee) DExp
    exp'] (DExp -> DExp) -> DExp -> DExp
    forall a b. (a -> b) -> a -> b
    $
               DExp -> [DMatch] -> DExp
    DCaseE (Name -> DExp
    DVarE Name
    scrutinee) [DMatch]
    matches'
    #if __GLASGOW_HASKELL__ >= 900
    dsExp (DoE Maybe ModName
    mb_mod [Stmt]
    stmts) = Maybe ModName -> [Stmt] -> q DExp
    forall (q :: * -> *).
    DsMonad q =>
    Maybe ModName -> [Stmt] -> q DExp
    dsDoStmts Maybe ModName
    mb_mod [Stmt]
    stmts
    #else
    dsExp (DoE        stmts) = dsDoStmts Nothing stmts
    #endif
    dsExp (CompE [Stmt]
    stmts) = [Stmt] -> q DExp
    forall (q :: * -> *). DsMonad q => [Stmt] -> q DExp
    dsComp [Stmt]
    stmts
    dsExp (ArithSeqE (FromR Exp
    exp)) = DExp -> DExp -> DExp
    DAppE (Name -> DExp
    DVarE 'enumFrom) (DExp -> DExp) -> q DExp -> q DExp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    exp
    dsExp (ArithSeqE (FromThenR Exp
    exp1 Exp
    exp2)) =
      DExp -> DExp -> DExp
    DAppE (DExp -> DExp -> DExp) -> q DExp -> q (DExp -> DExp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (DExp -> DExp -> DExp
    DAppE (Name -> DExp
    DVarE 'enumFromThen) (DExp -> DExp) -> q DExp -> q DExp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    exp1) q (DExp -> DExp) -> q DExp -> q DExp
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    exp2
    dsExp (ArithSeqE (FromToR Exp
    exp1 Exp
    exp2)) =
      DExp -> DExp -> DExp
    DAppE (DExp -> DExp -> DExp) -> q DExp -> q (DExp -> DExp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (DExp -> DExp -> DExp
    DAppE (Name -> DExp
    DVarE 'enumFromTo) (DExp -> DExp) -> q DExp -> q DExp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    exp1) q (DExp -> DExp) -> q DExp -> q DExp
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    exp2
    dsExp (ArithSeqE (FromThenToR Exp
    e1 Exp
    e2 Exp
    e3)) =
      DExp -> DExp -> DExp
    DAppE (DExp -> DExp -> DExp) -> q DExp -> q (DExp -> DExp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (DExp -> DExp -> DExp
    DAppE (DExp -> DExp -> DExp) -> q DExp -> q (DExp -> DExp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (DExp -> DExp -> DExp
    DAppE (Name -> DExp
    DVarE 'enumFromThenTo) (DExp -> DExp) -> q DExp -> q DExp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    e1) q (DExp -> DExp) -> q DExp -> q DExp
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*>
                                   Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    e2) q (DExp -> DExp) -> q DExp -> q DExp
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*>
                Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    e3
    dsExp (ListE [Exp]
    exps) = [Exp] -> q DExp
    forall {m :: * -> *}. DsMonad m => [Exp] -> m DExp
    go [Exp]
    exps
      where go :: [Exp] -> m DExp
    go [] = DExp -> m DExp
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DExp -> m DExp) -> DExp -> m DExp
    forall a b. (a -> b) -> a -> b
    $ Name -> DExp
    DConE '[]
            go (Exp
    h : [Exp]
    t) = DExp -> DExp -> DExp
    DAppE (DExp -> DExp -> DExp) -> m DExp -> m (DExp -> DExp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (DExp -> DExp -> DExp
    DAppE (Name -> DExp
    DConE '(:)) (DExp -> DExp) -> m DExp -> m DExp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Exp -> m DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    h) m (DExp -> DExp) -> m DExp -> m DExp
    forall a b. m (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [Exp] -> m DExp
    go [Exp]
    t
    dsExp (SigE Exp
    exp Type
    ty) = DExp -> DKind -> DExp
    DSigE (DExp -> DKind -> DExp) -> q DExp -> q (DKind -> DExp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    exp q (DKind -> DExp) -> q DKind -> q DExp
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    ty
    dsExp (RecConE Name
    con_name [FieldExp]
    field_exps) = do
      Con
    con <- Name -> q Con
    forall (q :: * -> *). DsMonad q => Name -> q Con
    dataConNameToCon Name
    con_name
      [DExp]
    reordered <- Con -> q [DExp]
    forall {m :: * -> *}. DsMonad m => Con -> m [DExp]
    reorder Con
    con
      DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DExp -> q DExp) -> DExp -> q DExp
    forall a b. (a -> b) -> a -> b
    $ (DExp -> DExp -> DExp) -> DExp -> [DExp] -> DExp
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl DExp -> DExp -> DExp
    DAppE (Name -> DExp
    DConE Name
    con_name) [DExp]
    reordered
      where
        reorder :: Con -> m [DExp]
    reorder Con
    con = case Con
    con of
                        NormalC Name
    _name [BangType]
    fields -> [BangType] -> m [DExp]
    forall {m :: * -> *} {t :: * -> *} {a}.
    (Foldable t, MonadFail m) =>
    t a -> m [DExp]
    non_record [BangType]
    fields
                        InfixC BangType
    field1 Name
    _name BangType
    field2 -> [BangType] -> m [DExp]
    forall {m :: * -> *} {t :: * -> *} {a}.
    (Foldable t, MonadFail m) =>
    t a -> m [DExp]
    non_record [BangType
    field1, BangType
    field2]
                        RecC Name
    _name [VarBangType]
    fields -> [VarBangType] -> m [DExp]
    forall {q :: * -> *}. DsMonad q => [VarBangType] -> q [DExp]
    reorder_fields [VarBangType]
    fields
                        ForallC [TyVarBndr Specificity]
    _ [Type]
    _ Con
    c -> Con -> m [DExp]
    reorder Con
    c
                        GadtC [Name]
    _names [BangType]
    fields Type
    _ret_ty -> [BangType] -> m [DExp]
    forall {m :: * -> *} {t :: * -> *} {a}.
    (Foldable t, MonadFail m) =>
    t a -> m [DExp]
    non_record [BangType]
    fields
                        RecGadtC [Name]
    _names [VarBangType]
    fields Type
    _ret_ty -> [VarBangType] -> m [DExp]
    forall {q :: * -> *}. DsMonad q => [VarBangType] -> q [DExp]
    reorder_fields [VarBangType]
    fields

        reorder_fields :: [VarBangType] -> q [DExp]
    reorder_fields [VarBangType]
    fields = Name -> [VarBangType] -> [FieldExp] -> [DExp] -> q [DExp]
    forall (q :: * -> *).
    DsMonad q =>
    Name -> [VarBangType] -> [FieldExp] -> [DExp] -> q [DExp]
    reorderFields Name
    con_name [VarBangType]
    fields [FieldExp]
    field_exps
                                              (DExp -> [DExp]
    forall a. a -> [a]
    repeat (DExp -> [DExp]) -> DExp -> [DExp]
    forall a b. (a -> b) -> a -> b
    $ Name -> DExp
    DVarE 'undefined)

        non_record :: t a -> m [DExp]
    non_record t a
    fields | [FieldExp] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [FieldExp]
    field_exps
                            -- Special case: record construction is allowed for any

                            -- constructor, regardless of whether the constructor

                            -- actually was declared with records, provided that no

                            -- records are given in the expression itself. (See #59).

                            --

                            -- Con{} desugars down to Con undefined ... undefined.

                          = [DExp] -> m [DExp]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([DExp] -> m [DExp]) -> [DExp] -> m [DExp]
    forall a b. (a -> b) -> a -> b
    $ Int -> DExp -> [DExp]
    forall a. Int -> a -> [a]
    replicate (t a -> Int
    forall a. t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length t a
    fields) (DExp -> [DExp]) -> DExp -> [DExp]
    forall a b. (a -> b) -> a -> b
    $ Name -> DExp
    DVarE 'undefined

                          | Bool
    otherwise =
                              String -> m [DExp]
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible (String -> m [DExp]) -> String -> m [DExp]
    forall a b. (a -> b) -> a -> b
    $ String
    "Record syntax used with non-record constructor "
                                           String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (Name -> String
    forall a. Show a => a -> String
    show Name
    con_name) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "."

    dsExp (RecUpdE Exp
    exp [FieldExp]
    field_exps) = do
      -- here, we need to use one of the field names to find the tycon, somewhat dodgily

      Name
    first_name <- case [FieldExp]
    field_exps of
                      ((Name
    name, Exp
    _) : [FieldExp]
    _) -> Name -> q Name
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    name
                      [FieldExp]
    _ -> String -> q Name
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible String
    "Record update with no fields listed."
      Info
    info <- Name -> q Info
    forall (q :: * -> *). DsMonad q => Name -> q Info
    reifyWithLocals Name
    first_name
      Type
    applied_type <- case Info
    info of
                        VarI Name
    _name Type
    ty Maybe Dec
    _m_dec -> Type -> q Type
    forall (q :: * -> *). DsMonad q => Type -> q Type
    extract_first_arg Type
    ty
                        Info
    _ -> String -> q Type
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible String
    "Record update with an invalid field name."
      Name
    type_name <- Type -> q Name
    forall (q :: * -> *). DsMonad q => Type -> q Name
    extract_type_name Type
    applied_type
      (DataFlavor
    _, [TyVarBndrUnit]
    _, [Con]
    cons) <- String -> Name -> q (DataFlavor, [TyVarBndrUnit], [Con])
    forall (q :: * -> *).
    DsMonad q =>
    String -> Name -> q (DataFlavor, [TyVarBndrUnit], [Con])
    getDataD String
    "This seems to be an error in GHC." Name
    type_name
      let filtered_cons :: [Con]
    filtered_cons = [Con] -> [Name] -> [Con]
    forall {t :: * -> *}. Foldable t => [Con] -> t Name -> [Con]
    filter_cons_with_names [Con]
    cons ((FieldExp -> Name) -> [FieldExp] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map FieldExp -> Name
    forall a b. (a, b) -> a
    fst [FieldExp]
    field_exps)
      DExp
    exp' <- Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    exp
      [DMatch]
    matches <- (Con -> q DMatch) -> [Con] -> q [DMatch]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Con -> q DMatch
    forall (q :: * -> *). DsMonad q => Con -> q DMatch
    con_to_dmatch [Con]
    filtered_cons
      let all_matches :: [DMatch]
    all_matches
            | [Con] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Con]
    filtered_cons Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Con] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Con]
    cons = [DMatch]
    matches
            | Bool
    otherwise                           = [DMatch]
    matches [DMatch] -> [DMatch] -> [DMatch]
    forall a. [a] -> [a] -> [a]
    ++ [DMatch
    error_match]
      DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DExp -> q DExp) -> DExp -> q DExp
    forall a b. (a -> b) -> a -> b
    $ DExp -> [DMatch] -> DExp
    DCaseE DExp
    exp' [DMatch]
    all_matches
      where
        extract_first_arg :: DsMonad q => Type -> q Type
        extract_first_arg :: forall (q :: * -> *). DsMonad q => Type -> q Type
    extract_first_arg (AppT (AppT Type
    ArrowT Type
    arg) Type
    _) = Type -> q Type
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    arg
        extract_first_arg (ForallT [TyVarBndr Specificity]
    _ [Type]
    _ Type
    t) = Type -> q Type
    forall (q :: * -> *). DsMonad q => Type -> q Type
    extract_first_arg Type
    t
        extract_first_arg (SigT Type
    t Type
    _) = Type -> q Type
    forall (q :: * -> *). DsMonad q => Type -> q Type
    extract_first_arg Type
    t
        extract_first_arg Type
    _ = String -> q Type
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible String
    "Record selector not a function."

        extract_type_name :: DsMonad q => Type -> q Name
        extract_type_name :: forall (q :: * -> *). DsMonad q => Type -> q Name
    extract_type_name (AppT Type
    t1 Type
    _) = Type -> q Name
    forall (q :: * -> *). DsMonad q => Type -> q Name
    extract_type_name Type
    t1
        extract_type_name (SigT Type
    t Type
    _) = Type -> q Name
    forall (q :: * -> *). DsMonad q => Type -> q Name
    extract_type_name Type
    t
        extract_type_name (ConT Name
    n) = Name -> q Name
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    n
        extract_type_name Type
    _ = String -> q Name
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible String
    "Record selector domain not a datatype."

        filter_cons_with_names :: [Con] -> t Name -> [Con]
    filter_cons_with_names [Con]
    cons t Name
    field_names =
          (Con -> Bool) -> [Con] -> [Con]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Con -> Bool
    has_names [Con]
    cons
          where
            args_contain_names :: [(Name, b, c)] -> Bool
    args_contain_names [(Name, b, c)]
    args =
              let con_field_names :: [Name]
    con_field_names = ((Name, b, c) -> Name) -> [(Name, b, c)] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name, b, c) -> Name
    forall {a} {b} {c}. (a, b, c) -> a
    fst_of_3 [(Name, b, c)]
    args in
              (Name -> Bool) -> t Name -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Name -> [Name] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Name]
    con_field_names) t Name
    field_names

            has_names :: Con -> Bool
    has_names (RecC Name
    _con_name [VarBangType]
    args) =
              [VarBangType] -> Bool
    forall {b} {c}. [(Name, b, c)] -> Bool
    args_contain_names [VarBangType]
    args
            has_names (RecGadtC [Name]
    _con_name [VarBangType]
    args Type
    _ret_ty) =
              [VarBangType] -> Bool
    forall {b} {c}. [(Name, b, c)] -> Bool
    args_contain_names [VarBangType]
    args
            has_names (ForallC [TyVarBndr Specificity]
    _ [Type]
    _ Con
    c) = Con -> Bool
    has_names Con
    c
            has_names Con
    _               = Bool
    False

        rec_con_to_dmatch :: Name -> [VarBangType] -> m DMatch
    rec_con_to_dmatch Name
    con_name [VarBangType]
    args = do
          let con_field_names :: [Name]
    con_field_names = (VarBangType -> Name) -> [VarBangType] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map VarBangType -> Name
    forall {a} {b} {c}. (a, b, c) -> a
    fst_of_3 [VarBangType]
    args
          [Name]
    field_var_names <- (Name -> m Name) -> [Name] -> m [Name]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (String -> m Name
    forall (q :: * -> *). Quasi q => String -> q Name
    newUniqueName (String -> m Name) -> (Name -> String) -> Name -> m Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String
    nameBase) [Name]
    con_field_names
          DPat -> DExp -> DMatch
    DMatch (Name -> [DKind] -> [DPat] -> DPat
    DConP Name
    con_name [] ((Name -> DPat) -> [Name] -> [DPat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> DPat
    DVarP [Name]
    field_var_names)) (DExp -> DMatch) -> m DExp -> m DMatch
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                 ((DExp -> DExp -> DExp) -> DExp -> [DExp] -> DExp
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl DExp -> DExp -> DExp
    DAppE (Name -> DExp
    DConE Name
    con_name) ([DExp] -> DExp) -> m [DExp] -> m DExp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                        (Name -> [VarBangType] -> [FieldExp] -> [DExp] -> m [DExp]
    forall (q :: * -> *).
    DsMonad q =>
    Name -> [VarBangType] -> [FieldExp] -> [DExp] -> q [DExp]
    reorderFields Name
    con_name [VarBangType]
    args [FieldExp]
    field_exps ((Name -> DExp) -> [Name] -> [DExp]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> DExp
    DVarE [Name]
    field_var_names)))

        con_to_dmatch :: DsMonad q => Con -> q DMatch
        con_to_dmatch :: forall (q :: * -> *). DsMonad q => Con -> q DMatch
    con_to_dmatch (RecC Name
    con_name [VarBangType]
    args) = Name -> [VarBangType] -> q DMatch
    forall {m :: * -> *}.
    DsMonad m =>
    Name -> [VarBangType] -> m DMatch
    rec_con_to_dmatch Name
    con_name [VarBangType]
    args
        -- We're assuming the GADT constructor has only one Name here, but since

        -- this constructor was reified, this assumption should always hold true.

        con_to_dmatch (RecGadtC [Name
    con_name] [VarBangType]
    args Type
    _ret_ty) = Name -> [VarBangType] -> q DMatch
    forall {m :: * -> *}.
    DsMonad m =>
    Name -> [VarBangType] -> m DMatch
    rec_con_to_dmatch Name
    con_name [VarBangType]
    args
        con_to_dmatch (ForallC [TyVarBndr Specificity]
    _ [Type]
    _ Con
    c) = Con -> q DMatch
    forall (q :: * -> *). DsMonad q => Con -> q DMatch
    con_to_dmatch Con
    c
        con_to_dmatch Con
    _ = String -> q DMatch
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible String
    "Internal error within th-desugar."

        error_match :: DMatch
    error_match = DPat -> DExp -> DMatch
    DMatch DPat
    DWildP (MatchContext -> DExp
    mkErrorMatchExpr MatchContext
    RecUpd)

        fst_of_3 :: (a, b, c) -> a
    fst_of_3 (a
    x, b
    _, c
    _) = a
    x
    dsExp (StaticE Exp
    exp) = DExp -> DExp
    DStaticE (DExp -> DExp) -> q DExp -> q DExp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    exp
    dsExp (UnboundVarE Name
    n) = DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name -> DExp
    DVarE Name
    n)
    #if __GLASGOW_HASKELL__ >= 801
    dsExp (AppTypeE Exp
    exp Type
    ty) = DExp -> DKind -> DExp
    DAppTypeE (DExp -> DKind -> DExp) -> q DExp -> q (DKind -> DExp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    exp q (DKind -> DExp) -> q DKind -> q DExp
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    ty
    dsExp (UnboxedSumE Exp
    exp Int
    alt Int
    arity) =
      DExp -> DExp -> DExp
    DAppE (Name -> DExp
    DConE (Name -> DExp) -> Name -> DExp
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Name
    unboxedSumDataName Int
    alt Int
    arity) (DExp -> DExp) -> q DExp -> q DExp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    exp
    #endif
    #if __GLASGOW_HASKELL__ >= 803
    dsExp (LabelE String
    str) = DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DExp -> q DExp) -> DExp -> q DExp
    forall a b. (a -> b) -> a -> b
    $ Name -> DExp
    DVarE 'fromLabel DExp -> DKind -> DExp
    `DAppTypeE` TyLit -> DKind
    DLitT (String -> TyLit
    StrTyLit String
    str)
    #endif
    #if __GLASGOW_HASKELL__ >= 807
    dsExp (ImplicitParamVarE String
    n) = DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DExp -> q DExp) -> DExp -> q DExp
    forall a b. (a -> b) -> a -> b
    $ Name -> DExp
    DVarE 'ip DExp -> DKind -> DExp
    `DAppTypeE` TyLit -> DKind
    DLitT (String -> TyLit
    StrTyLit String
    n)
    dsExp (MDoE {}) = String -> q DExp
    forall a. String -> q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "th-desugar currently does not support RecursiveDo"
    #endif
    #if __GLASGOW_HASKELL__ >= 902
    dsExp (GetFieldE Exp
    arg String
    field) = DExp -> DExp -> DExp
    DAppE (String -> DExp
    mkGetFieldProj String
    field) (DExp -> DExp) -> q DExp -> q DExp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    arg
    dsExp (ProjectionE NonEmpty String
    fields) =
      case NonEmpty String
    fields of
        String
    f :| [String]
    fs -> DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DExp -> q DExp) -> DExp -> q DExp
    forall a b. (a -> b) -> a -> b
    $ (DExp -> String -> DExp) -> DExp -> [String] -> DExp
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' DExp -> String -> DExp
    comp (String -> DExp
    mkGetFieldProj String
    f) [String]
    fs
      where
        comp :: DExp -> String -> DExp
        comp :: DExp -> String -> DExp
    comp DExp
    acc String
    f = Name -> DExp
    DVarE '(.) DExp -> DExp -> DExp
    `DAppE` String -> DExp
    mkGetFieldProj String
    f DExp -> DExp -> DExp
    `DAppE` DExp
    acc
    #endif
    #if __GLASGOW_HASKELL__ >= 903
    dsExp (LamCasesE [Clause]
    clauses) = do
      [DClause]
    clauses' <- MatchContext -> [Clause] -> q [DClause]
    forall (q :: * -> *).
    DsMonad q =>
    MatchContext -> [Clause] -> q [DClause]
    dsClauses MatchContext
    CaseAlt [Clause]
    clauses
      Int
    numArgs <-
        case [DClause]
    clauses' of
          (DClause [DPat]
    pats DExp
    _:[DClause]
    _) -> Int -> q Int
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> q Int) -> Int -> q Int
    forall a b. (a -> b) -> a -> b
    $ [DPat] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [DPat]
    pats
          [] -> String -> q Int
    forall a. String -> q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "\\cases expression must have at least one alternative"
      [Name]
    args <- Int -> q Name -> q [Name]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM Int
    numArgs (String -> q Name
    forall (q :: * -> *). Quasi q => String -> q Name
    newUniqueName String
    "x")
      DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DExp -> q DExp) -> DExp -> q DExp
    forall a b. (a -> b) -> a -> b
    $ [Name] -> DExp -> DExp
    DLamE [Name]
    args (DExp -> DExp) -> DExp -> DExp
    forall a b. (a -> b) -> a -> b
    $ DExp -> [DMatch] -> DExp
    DCaseE ([DExp] -> DExp
    mkUnboxedTupleDExp ((Name -> DExp) -> [Name] -> [DExp]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> DExp
    DVarE [Name]
    args))
                                   ((DClause -> DMatch) -> [DClause] -> [DMatch]
    forall a b. (a -> b) -> [a] -> [b]
    map DClause -> DMatch
    dClauseToUnboxedTupleMatch [DClause]
    clauses')
    #endif

    -- | Convert a 'DClause' to a 'DMatch' by bundling all of the clause's patterns

    -- into a match on a single unboxed tuple pattern. That is, convert this:

    --

    -- @

    -- f x y z = rhs

    -- @

    --

    -- To this:

    --

    -- @

    -- f (# x, y, z #) = rhs

    -- @

    --

    -- This is used to desugar @\\cases@ expressions into lambda expressions.

    dClauseToUnboxedTupleMatch :: DClause -> DMatch
    dClauseToUnboxedTupleMatch :: DClause -> DMatch
    dClauseToUnboxedTupleMatch (DClause [DPat]
    pats DExp
    rhs) =
      DPat -> DExp -> DMatch
    DMatch ([DPat] -> DPat
    mkUnboxedTupleDPat [DPat]
    pats) DExp
    rhs

    #if __GLASGOW_HASKELL__ >= 809
    dsTup :: DsMonad q => (Int -> Name) -> [Maybe Exp] -> q DExp
    dsTup :: forall (q :: * -> *).
    DsMonad q =>
    (Int -> Name) -> [Maybe Exp] -> q DExp
    dsTup = (Int -> Name) -> [Maybe Exp] -> q DExp
    forall (q :: * -> *).
    DsMonad q =>
    (Int -> Name) -> [Maybe Exp] -> q DExp
    ds_tup
    #else
    dsTup :: DsMonad q => (Int -> Name) -> [Exp]       -> q DExp
    dsTup tuple_data_name = ds_tup tuple_data_name . map Just
    #endif

    -- | Desugar a tuple (or tuple section) expression.

    ds_tup :: forall q. DsMonad q
           => (Int -> Name) -- ^ Compute the 'Name' of a tuple (boxed or unboxed)

                            --   data constructor from its arity.

           -> [Maybe Exp]   -- ^ The tuple's subexpressions. 'Nothing' entries

                            --   denote empty fields in a tuple section.

           -> q DExp
    ds_tup :: forall (q :: * -> *).
    DsMonad q =>
    (Int -> Name) -> [Maybe Exp] -> q DExp
    ds_tup Int -> Name
    tuple_data_name [Maybe Exp]
    mb_exps = do
      [Either Name DExp]
    section_exps <- (Maybe Exp -> q (Either Name DExp))
    -> [Maybe Exp] -> q [Either Name DExp]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Maybe Exp -> q (Either Name DExp)
    ds_section_exp [Maybe Exp]
    mb_exps
      let section_vars :: [Name]
    section_vars = [Either Name DExp] -> [Name]
    forall a b. [Either a b] -> [a]
    lefts [Either Name DExp]
    section_exps
          tup_body :: DExp
    tup_body     = [Either Name DExp] -> DExp
    mk_tup_body [Either Name DExp]
    section_exps
      if [Name] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Name]
    section_vars
         then DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return DExp
    tup_body -- If this isn't a tuple section,

                              -- don't create a lambda.

         else [DPat] -> DExp -> q DExp
    forall (q :: * -> *). Quasi q => [DPat] -> DExp -> q DExp
    mkDLamEFromDPats ((Name -> DPat) -> [Name] -> [DPat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> DPat
    DVarP [Name]
    section_vars) DExp
    tup_body
      where
        -- If dealing with an empty field in a tuple section (Nothing), create a

        -- unique name and return Left. These names will be used to construct the

        -- lambda expression that it desugars to.

        -- (For example, `(,5)` desugars to `\ts -> (,) ts 5`.)

        --

        -- If dealing with a tuple subexpression (Just), desugar it and return

        -- Right.

        ds_section_exp :: Maybe Exp -> q (Either Name DExp)
        ds_section_exp :: Maybe Exp -> q (Either Name DExp)
    ds_section_exp = q (Either Name DExp)
    -> (Exp -> q (Either Name DExp))
    -> Maybe Exp
    -> q (Either Name DExp)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Name -> Either Name DExp
    forall a b. a -> Either a b
    Left (Name -> Either Name DExp) -> q Name -> q (Either Name DExp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> q Name
    forall (q :: * -> *). Quasi q => String -> q Name
    qNewName String
    "ts") ((DExp -> Either Name DExp) -> q DExp -> q (Either Name DExp)
    forall a b. (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DExp -> Either Name DExp
    forall a b. b -> Either a b
    Right (q DExp -> q (Either Name DExp))
    -> (Exp -> q DExp) -> Exp -> q (Either Name DExp)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp)

        mk_tup_body :: [Either Name DExp] -> DExp
        mk_tup_body :: [Either Name DExp] -> DExp
    mk_tup_body [Either Name DExp]
    section_exps =
          (DExp -> Either Name DExp -> DExp)
    -> DExp -> [Either Name DExp] -> DExp
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' DExp -> Either Name DExp -> DExp
    apply_tup_body (Name -> DExp
    DConE (Name -> DExp) -> Name -> DExp
    forall a b. (a -> b) -> a -> b
    $ Int -> Name
    tuple_data_name ([Either Name DExp] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Either Name DExp]
    section_exps))
                 [Either Name DExp]
    section_exps

        apply_tup_body :: DExp -> Either Name DExp -> DExp
        apply_tup_body :: DExp -> Either Name DExp -> DExp
    apply_tup_body DExp
    f (Left Name
    n)  = DExp
    f DExp -> DExp -> DExp
    `DAppE` Name -> DExp
    DVarE Name
    n
        apply_tup_body DExp
    f (Right DExp
    e) = DExp
    f DExp -> DExp -> DExp
    `DAppE` DExp
    e

    -- | Convert a list of 'DPat' arguments and a 'DExp' body into a 'DLamE'. This

    -- is needed since 'DLamE' takes a list of 'Name's for its bound variables

    -- instead of 'DPat's, so some reorganization is needed.

    mkDLamEFromDPats :: Quasi q => [DPat] -> DExp -> q DExp
    mkDLamEFromDPats :: forall (q :: * -> *). Quasi q => [DPat] -> DExp -> q DExp
    mkDLamEFromDPats [DPat]
    pats DExp
    exp
      | Just [Name]
    names <- (DPat -> Maybe Name) -> [DPat] -> Maybe [Name]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM DPat -> Maybe Name
    stripDVarP_maybe [DPat]
    pats
      = DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DExp -> q DExp) -> DExp -> q DExp
    forall a b. (a -> b) -> a -> b
    $ [Name] -> DExp -> DExp
    DLamE [Name]
    names DExp
    exp
      | Bool
    otherwise
      = do [Name]
    arg_names <- Int -> q Name -> q [Name]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM ([DPat] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [DPat]
    pats) (String -> q Name
    forall (q :: * -> *). Quasi q => String -> q Name
    newUniqueName String
    "arg")
           let scrutinee :: DExp
    scrutinee = [DExp] -> DExp
    mkUnboxedTupleDExp ((Name -> DExp) -> [Name] -> [DExp]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> DExp
    DVarE [Name]
    arg_names)
               match :: DMatch
    match     = DPat -> DExp -> DMatch
    DMatch ([DPat] -> DPat
    mkUnboxedTupleDPat [DPat]
    pats) DExp
    exp
           DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DExp -> q DExp) -> DExp -> q DExp
    forall a b. (a -> b) -> a -> b
    $ [Name] -> DExp -> DExp
    DLamE [Name]
    arg_names (DExp -> [DMatch] -> DExp
    DCaseE DExp
    scrutinee [DMatch
    match])
      where
        stripDVarP_maybe :: DPat -> Maybe Name
        stripDVarP_maybe :: DPat -> Maybe Name
    stripDVarP_maybe (DVarP Name
    n) = Name -> Maybe Name
    forall a. a -> Maybe a
    Just Name
    n
        stripDVarP_maybe DPat
    _          = Maybe Name
    forall a. Maybe a
    Nothing

    #if __GLASGOW_HASKELL__ >= 902
    mkGetFieldProj :: String -> DExp
    mkGetFieldProj :: String -> DExp
    mkGetFieldProj String
    field = Name -> DExp
    DVarE 'getField DExp -> DKind -> DExp
    `DAppTypeE` TyLit -> DKind
    DLitT (String -> TyLit
    StrTyLit String
    field)
    #endif

    -- | Desugar a list of matches for a @case@ statement

    dsMatches :: DsMonad q
              => Name     -- ^ Name of the scrutinee, which must be a bare var

              -> [Match]  -- ^ Matches of the @case@ statement

              -> q [DMatch]
    dsMatches :: forall (q :: * -> *). DsMonad q => Name -> [Match] -> q [DMatch]
    dsMatches Name
    scr = [Match] -> q [DMatch]
    forall (q :: * -> *). DsMonad q => [Match] -> q [DMatch]
    go
      where
        go :: DsMonad q => [Match] -> q [DMatch]
        go :: forall (q :: * -> *). DsMonad q => [Match] -> q [DMatch]
    go [] = [DMatch] -> q [DMatch]
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
        go (Match Pat
    pat Body
    body [Dec]
    where_decs : [Match]
    rest) = do
          [DMatch]
    rest' <- [Match] -> q [DMatch]
    forall (q :: * -> *). DsMonad q => [Match] -> q [DMatch]
    go [Match]
    rest
          let failure :: DExp
    failure = MatchContext -> DExp -> [DMatch] -> DExp
    maybeDCaseE MatchContext
    CaseAlt (Name -> DExp
    DVarE Name
    scr) [DMatch]
    rest'
          DExp
    exp' <- Body -> [Dec] -> DExp -> q DExp
    forall (q :: * -> *). DsMonad q => Body -> [Dec] -> DExp -> q DExp
    dsBody Body
    body [Dec]
    where_decs DExp
    failure
          (DPat
    pat', DExp
    exp'') <- Pat -> DExp -> q (DPat, DExp)
    forall (q :: * -> *). DsMonad q => Pat -> DExp -> q (DPat, DExp)
    dsPatOverExp Pat
    pat DExp
    exp'
          Bool
    uni_pattern <- DPat -> q Bool
    forall (q :: * -> *). DsMonad q => DPat -> q Bool
    isUniversalPattern DPat
    pat' -- incomplete attempt at #6

          if Bool
    uni_pattern
          then [DMatch] -> q [DMatch]
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [DPat -> DExp -> DMatch
    DMatch DPat
    pat' DExp
    exp'']
          else [DMatch] -> q [DMatch]
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DPat -> DExp -> DMatch
    DMatch DPat
    pat' DExp
    exp'' DMatch -> [DMatch] -> [DMatch]
    forall a. a -> [a] -> [a]
    : [DMatch]
    rest')

    -- | Desugar a @Body@

    dsBody :: DsMonad q
           => Body      -- ^ body to desugar

           -> [Dec]     -- ^ "where" declarations

           -> DExp      -- ^ what to do if the guards don't match

           -> q DExp
    dsBody :: forall (q :: * -> *). DsMonad q => Body -> [Dec] -> DExp -> q DExp
    dsBody (NormalB Exp
    exp) [Dec]
    decs DExp
    _ = do
      ([DLetDec]
    decs', DExp -> DExp
    ip_binder) <- [Dec] -> q ([DLetDec], DExp -> DExp)
    forall (q :: * -> *).
    DsMonad q =>
    [Dec] -> q ([DLetDec], DExp -> DExp)
    dsLetDecs [Dec]
    decs
      DExp
    exp' <- Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    exp
      DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DExp -> q DExp) -> DExp -> q DExp
    forall a b. (a -> b) -> a -> b
    $ [DLetDec] -> DExp -> DExp
    maybeDLetE [DLetDec]
    decs' (DExp -> DExp) -> DExp -> DExp
    forall a b. (a -> b) -> a -> b
    $ DExp -> DExp
    ip_binder DExp
    exp'
    dsBody (GuardedB [(Guard, Exp)]
    guarded_exps) [Dec]
    decs DExp
    failure = do
      ([DLetDec]
    decs', DExp -> DExp
    ip_binder) <- [Dec] -> q ([DLetDec], DExp -> DExp)
    forall (q :: * -> *).
    DsMonad q =>
    [Dec] -> q ([DLetDec], DExp -> DExp)
    dsLetDecs [Dec]
    decs
      DExp
    guarded_exp' <- [(Guard, Exp)] -> DExp -> q DExp
    forall (q :: * -> *). DsMonad q => [(Guard, Exp)] -> DExp -> q DExp
    dsGuards [(Guard, Exp)]
    guarded_exps DExp
    failure
      DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DExp -> q DExp) -> DExp -> q DExp
    forall a b. (a -> b) -> a -> b
    $ [DLetDec] -> DExp -> DExp
    maybeDLetE [DLetDec]
    decs' (DExp -> DExp) -> DExp -> DExp
    forall a b. (a -> b) -> a -> b
    $ DExp -> DExp
    ip_binder DExp
    guarded_exp'

    -- | If decs is non-empty, delcare them in a let:

    maybeDLetE :: [DLetDec] -> DExp -> DExp
    maybeDLetE :: [DLetDec] -> DExp -> DExp
    maybeDLetE [] DExp
    exp   = DExp
    exp
    maybeDLetE [DLetDec]
    decs DExp
    exp = [DLetDec] -> DExp -> DExp
    DLetE [DLetDec]
    decs DExp
    exp

    -- | If matches is non-empty, make a case statement; otherwise make an error statement

    maybeDCaseE :: MatchContext -> DExp -> [DMatch] -> DExp
    maybeDCaseE :: MatchContext -> DExp -> [DMatch] -> DExp
    maybeDCaseE MatchContext
    mc DExp
    _     []      = MatchContext -> DExp
    mkErrorMatchExpr MatchContext
    mc
    maybeDCaseE MatchContext
    _  DExp
    scrut [DMatch]
    matches = DExp -> [DMatch] -> DExp
    DCaseE DExp
    scrut [DMatch]
    matches

    -- | Desugar guarded expressions

    dsGuards :: DsMonad q
             => [(Guard, Exp)]  -- ^ Guarded expressions

             -> DExp            -- ^ What to do if none of the guards match

             -> q DExp
    dsGuards :: forall (q :: * -> *). DsMonad q => [(Guard, Exp)] -> DExp -> q DExp
    dsGuards [] DExp
    thing_inside = DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return DExp
    thing_inside
    dsGuards ((NormalG Exp
    gd, Exp
    exp) : [(Guard, Exp)]
    rest) DExp
    thing_inside =
      [(Guard, Exp)] -> DExp -> q DExp
    forall (q :: * -> *). DsMonad q => [(Guard, Exp)] -> DExp -> q DExp
    dsGuards (([Stmt] -> Guard
    PatG [Exp -> Stmt
    NoBindS Exp
    gd], Exp
    exp) (Guard, Exp) -> [(Guard, Exp)] -> [(Guard, Exp)]
    forall a. a -> [a] -> [a]
    : [(Guard, Exp)]
    rest) DExp
    thing_inside
    dsGuards ((PatG [Stmt]
    stmts, Exp
    exp) : [(Guard, Exp)]
    rest) DExp
    thing_inside = do
      DExp
    success <- Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    exp
      DExp
    failure <- [(Guard, Exp)] -> DExp -> q DExp
    forall (q :: * -> *). DsMonad q => [(Guard, Exp)] -> DExp -> q DExp
    dsGuards [(Guard, Exp)]
    rest DExp
    thing_inside
      [Stmt] -> DExp -> DExp -> q DExp
    forall (q :: * -> *). DsMonad q => [Stmt] -> DExp -> DExp -> q DExp
    dsGuardStmts [Stmt]
    stmts DExp
    success DExp
    failure

    -- | Desugar the @Stmt@s in a guard

    dsGuardStmts :: DsMonad q
                 => [Stmt]  -- ^ The @Stmt@s to desugar

                 -> DExp    -- ^ What to do if the @Stmt@s yield success

                 -> DExp    -- ^ What to do if the @Stmt@s yield failure

                 -> q DExp
    dsGuardStmts :: forall (q :: * -> *). DsMonad q => [Stmt] -> DExp -> DExp -> q DExp
    dsGuardStmts [] DExp
    success DExp
    _failure = DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return DExp
    success
    dsGuardStmts (BindS Pat
    pat Exp
    exp : [Stmt]
    rest) DExp
    success DExp
    failure = do
      DExp
    success' <- [Stmt] -> DExp -> DExp -> q DExp
    forall (q :: * -> *). DsMonad q => [Stmt] -> DExp -> DExp -> q DExp
    dsGuardStmts [Stmt]
    rest DExp
    success DExp
    failure
      (DPat
    pat', DExp
    success'') <- Pat -> DExp -> q (DPat, DExp)
    forall (q :: * -> *). DsMonad q => Pat -> DExp -> q (DPat, DExp)
    dsPatOverExp Pat
    pat DExp
    success'
      DExp
    exp' <- Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    exp
      DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DExp -> q DExp) -> DExp -> q DExp
    forall a b. (a -> b) -> a -> b
    $ DExp -> [DMatch] -> DExp
    DCaseE DExp
    exp' [DPat -> DExp -> DMatch
    DMatch DPat
    pat' DExp
    success'', DPat -> DExp -> DMatch
    DMatch DPat
    DWildP DExp
    failure]
    dsGuardStmts (LetS [Dec]
    decs : [Stmt]
    rest) DExp
    success DExp
    failure = do
      ([DLetDec]
    decs', DExp -> DExp
    ip_binder) <- [Dec] -> q ([DLetDec], DExp -> DExp)
    forall (q :: * -> *).
    DsMonad q =>
    [Dec] -> q ([DLetDec], DExp -> DExp)
    dsLetDecs [Dec]
    decs
      DExp
    success' <- [Stmt] -> DExp -> DExp -> q DExp
    forall (q :: * -> *). DsMonad q => [Stmt] -> DExp -> DExp -> q DExp
    dsGuardStmts [Stmt]
    rest DExp
    success DExp
    failure
      DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DExp -> q DExp) -> DExp -> q DExp
    forall a b. (a -> b) -> a -> b
    $ [DLetDec] -> DExp -> DExp
    DLetE [DLetDec]
    decs' (DExp -> DExp) -> DExp -> DExp
    forall a b. (a -> b) -> a -> b
    $ DExp -> DExp
    ip_binder DExp
    success'
      -- special-case a final pattern containing "otherwise" or "True"

      -- note that GHC does this special-casing, too, in DsGRHSs.isTrueLHsExpr

    dsGuardStmts [NoBindS Exp
    exp] DExp
    success DExp
    _failure
      | VarE Name
    name <- Exp
    exp
      , Name
    name Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == 'otherwise
      = DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return DExp
    success

      | ConE Name
    name <- Exp
    exp
      , Name
    name Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == 'True
      = DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return DExp
    success
    dsGuardStmts (NoBindS Exp
    exp : [Stmt]
    rest) DExp
    success DExp
    failure = do
      DExp
    exp' <- Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    exp
      DExp
    success' <- [Stmt] -> DExp -> DExp -> q DExp
    forall (q :: * -> *). DsMonad q => [Stmt] -> DExp -> DExp -> q DExp
    dsGuardStmts [Stmt]
    rest DExp
    success DExp
    failure
      DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DExp -> q DExp) -> DExp -> q DExp
    forall a b. (a -> b) -> a -> b
    $ DExp -> [DMatch] -> DExp
    DCaseE DExp
    exp' [ DPat -> DExp -> DMatch
    DMatch (Name -> [DKind] -> [DPat] -> DPat
    DConP 'True  [] []) DExp
    success'
                           , DPat -> DExp -> DMatch
    DMatch (Name -> [DKind] -> [DPat] -> DPat
    DConP 'False [] []) DExp
    failure ]
    dsGuardStmts (ParS [[Stmt]]
    _ : [Stmt]
    _) DExp
    _ DExp
    _ = String -> q DExp
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible String
    "Parallel comprehension in a pattern guard."
    #if __GLASGOW_HASKELL__ >= 807
    dsGuardStmts (RecS {} : [Stmt]
    _) DExp
    _ DExp
    _ = String -> q DExp
    forall a. String -> q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "th-desugar currently does not support RecursiveDo"
    #endif

    -- | Desugar the @Stmt@s in a @do@ expression

    dsDoStmts :: forall q. DsMonad q => Maybe ModName -> [Stmt] -> q DExp
    dsDoStmts :: forall (q :: * -> *).
    DsMonad q =>
    Maybe ModName -> [Stmt] -> q DExp
    dsDoStmts Maybe ModName
    mb_mod = [Stmt] -> q DExp
    go
      where
        go :: [Stmt] -> q DExp
        go :: [Stmt] -> q DExp
    go [] = String -> q DExp
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible String
    "do-expression ended with something other than bare statement."
        go [NoBindS Exp
    exp] = Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    exp
        go (BindS Pat
    pat Exp
    exp : [Stmt]
    rest) = do
          DExp
    rest' <- [Stmt] -> q DExp
    go [Stmt]
    rest
          Maybe ModName -> Exp -> Pat -> DExp -> String -> q DExp
    forall (q :: * -> *).
    DsMonad q =>
    Maybe ModName -> Exp -> Pat -> DExp -> String -> q DExp
    dsBindS Maybe ModName
    mb_mod Exp
    exp Pat
    pat DExp
    rest' String
    "do expression"
        go (LetS [Dec]
    decs : [Stmt]
    rest) = do
          ([DLetDec]
    decs', DExp -> DExp
    ip_binder) <- [Dec] -> q ([DLetDec], DExp -> DExp)
    forall (q :: * -> *).
    DsMonad q =>
    [Dec] -> q ([DLetDec], DExp -> DExp)
    dsLetDecs [Dec]
    decs
          DExp
    rest' <- [Stmt] -> q DExp
    go [Stmt]
    rest
          DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DExp -> q DExp) -> DExp -> q DExp
    forall a b. (a -> b) -> a -> b
    $ [DLetDec] -> DExp -> DExp
    DLetE [DLetDec]
    decs' (DExp -> DExp) -> DExp -> DExp
    forall a b. (a -> b) -> a -> b
    $ DExp -> DExp
    ip_binder DExp
    rest'
        go (NoBindS Exp
    exp : [Stmt]
    rest) = do
          DExp
    exp' <- Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    exp
          DExp
    rest' <- [Stmt] -> q DExp
    go [Stmt]
    rest
          let sequence_name :: Name
    sequence_name = Maybe ModName -> Name -> Name
    mk_qual_do_name Maybe ModName
    mb_mod '(>>)
          DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DExp -> q DExp) -> DExp -> q DExp
    forall a b. (a -> b) -> a -> b
    $ DExp -> DExp -> DExp
    DAppE (DExp -> DExp -> DExp
    DAppE (Name -> DExp
    DVarE Name
    sequence_name) DExp
    exp') DExp
    rest'
        go (ParS [[Stmt]]
    _ : [Stmt]
    _) = String -> q DExp
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible String
    "Parallel comprehension in a do-statement."
    #if __GLASGOW_HASKELL__ >= 807
        go (RecS {} : [Stmt]
    _) = String -> q DExp
    forall a. String -> q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "th-desugar currently does not support RecursiveDo"
    #endif

    -- | Desugar the @Stmt@s in a list or monad comprehension

    dsComp :: DsMonad q => [Stmt] -> q DExp
    dsComp :: forall (q :: * -> *). DsMonad q => [Stmt] -> q DExp
    dsComp [] = String -> q DExp
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible String
    "List/monad comprehension ended with something other than a bare statement."
    dsComp [NoBindS Exp
    exp] = DExp -> DExp -> DExp
    DAppE (Name -> DExp
    DVarE 'return) (DExp -> DExp) -> q DExp -> q DExp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    exp
    dsComp (BindS Pat
    pat Exp
    exp : [Stmt]
    rest) = do
      DExp
    rest' <- [Stmt] -> q DExp
    forall (q :: * -> *). DsMonad q => [Stmt] -> q DExp
    dsComp [Stmt]
    rest
      Maybe ModName -> Exp -> Pat -> DExp -> String -> q DExp
    forall (q :: * -> *).
    DsMonad q =>
    Maybe ModName -> Exp -> Pat -> DExp -> String -> q DExp
    dsBindS Maybe ModName
    forall a. Maybe a
    Nothing Exp
    exp Pat
    pat DExp
    rest' String
    "monad comprehension"
    dsComp (LetS [Dec]
    decs : [Stmt]
    rest) = do
      ([DLetDec]
    decs', DExp -> DExp
    ip_binder) <- [Dec] -> q ([DLetDec], DExp -> DExp)
    forall (q :: * -> *).
    DsMonad q =>
    [Dec] -> q ([DLetDec], DExp -> DExp)
    dsLetDecs [Dec]
    decs
      DExp
    rest' <- [Stmt] -> q DExp
    forall (q :: * -> *). DsMonad q => [Stmt] -> q DExp
    dsComp [Stmt]
    rest
      DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DExp -> q DExp) -> DExp -> q DExp
    forall a b. (a -> b) -> a -> b
    $ [DLetDec] -> DExp -> DExp
    DLetE [DLetDec]
    decs' (DExp -> DExp) -> DExp -> DExp
    forall a b. (a -> b) -> a -> b
    $ DExp -> DExp
    ip_binder DExp
    rest'
    dsComp (NoBindS Exp
    exp : [Stmt]
    rest) = do
      DExp
    exp' <- Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    exp
      DExp
    rest' <- [Stmt] -> q DExp
    forall (q :: * -> *). DsMonad q => [Stmt] -> q DExp
    dsComp [Stmt]
    rest
      DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DExp -> q DExp) -> DExp -> q DExp
    forall a b. (a -> b) -> a -> b
    $ DExp -> DExp -> DExp
    DAppE (DExp -> DExp -> DExp
    DAppE (Name -> DExp
    DVarE '(>>)) (DExp -> DExp -> DExp
    DAppE (Name -> DExp
    DVarE 'guard) DExp
    exp')) DExp
    rest'
    dsComp (ParS [[Stmt]]
    stmtss : [Stmt]
    rest) = do
      (DPat
    pat, DExp
    exp) <- [[Stmt]] -> q (DPat, DExp)
    forall (q :: * -> *). DsMonad q => [[Stmt]] -> q (DPat, DExp)
    dsParComp [[Stmt]]
    stmtss
      DExp
    rest' <- [Stmt] -> q DExp
    forall (q :: * -> *). DsMonad q => [Stmt] -> q DExp
    dsComp [Stmt]
    rest
      DExp -> DExp -> DExp
    DAppE (DExp -> DExp -> DExp
    DAppE (Name -> DExp
    DVarE '(>>=)) DExp
    exp) (DExp -> DExp) -> q DExp -> q DExp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [DPat] -> DExp -> q DExp
    forall (q :: * -> *). Quasi q => [DPat] -> DExp -> q DExp
    mkDLamEFromDPats [DPat
    pat] DExp
    rest'
    #if __GLASGOW_HASKELL__ >= 807
    dsComp (RecS {} : [Stmt]
    _) = String -> q DExp
    forall a. String -> q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "th-desugar currently does not support RecursiveDo"
    #endif

    -- Desugar a binding statement in a do- or list comprehension.

    --

    -- In the event that the pattern in the statement is partial, the desugared

    -- case expression will contain a catch-all case that calls 'fail' from either

    -- 'MonadFail' or 'Monad', depending on whether the @MonadFailDesugaring@

    -- language extension is enabled or not. (On GHCs older than 8.0, 'fail' from

    -- 'Monad' is always used.)

    dsBindS :: forall q. DsMonad q
            => Maybe ModName -> Exp -> Pat -> DExp -> String -> q DExp
    dsBindS :: forall (q :: * -> *).
    DsMonad q =>
    Maybe ModName -> Exp -> Pat -> DExp -> String -> q DExp
    dsBindS Maybe ModName
    mb_mod Exp
    bind_arg_exp Pat
    success_pat DExp
    success_exp String
    ctxt = do
      DExp
    bind_arg_exp' <- Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    bind_arg_exp
      (DPat
    success_pat', DExp
    success_exp') <- Pat -> DExp -> q (DPat, DExp)
    forall (q :: * -> *). DsMonad q => Pat -> DExp -> q (DPat, DExp)
    dsPatOverExp Pat
    success_pat DExp
    success_exp
      Bool
    is_univ_pat <- DPat -> q Bool
    forall (q :: * -> *). DsMonad q => DPat -> q Bool
    isUniversalPattern DPat
    success_pat'
      let bind_into :: DExp -> DExp
    bind_into = DExp -> DExp -> DExp
    DAppE (DExp -> DExp -> DExp
    DAppE (Name -> DExp
    DVarE Name
    bind_name) DExp
    bind_arg_exp')
      if Bool
    is_univ_pat
         then DExp -> DExp
    bind_into (DExp -> DExp) -> q DExp -> q DExp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [DPat] -> DExp -> q DExp
    forall (q :: * -> *). Quasi q => [DPat] -> DExp -> q DExp
    mkDLamEFromDPats [DPat
    success_pat'] DExp
    success_exp'
         else do Name
    arg_name  <- String -> q Name
    forall (q :: * -> *). Quasi q => String -> q Name
    newUniqueName String
    "arg"
                 Name
    fail_name <- q Name
    mk_fail_name
                 DExp -> q DExp
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DExp -> q DExp) -> DExp -> q DExp
    forall a b. (a -> b) -> a -> b
    $ DExp -> DExp
    bind_into (DExp -> DExp) -> DExp -> DExp
    forall a b. (a -> b) -> a -> b
    $ [Name] -> DExp -> DExp
    DLamE [Name
    arg_name] (DExp -> DExp) -> DExp -> DExp
    forall a b. (a -> b) -> a -> b
    $ DExp -> [DMatch] -> DExp
    DCaseE (Name -> DExp
    DVarE Name
    arg_name)
                   [ DPat -> DExp -> DMatch
    DMatch DPat
    success_pat' DExp
    success_exp'
                   , DPat -> DExp -> DMatch
    DMatch DPat
    DWildP (DExp -> DMatch) -> DExp -> DMatch
    forall a b. (a -> b) -> a -> b
    $
                     Name -> DExp
    DVarE Name
    fail_name DExp -> DExp -> DExp
    `DAppE`
                       Lit -> DExp
    DLitE (String -> Lit
    StringL (String -> Lit) -> String -> Lit
    forall a b. (a -> b) -> a -> b
    $ String
    "Pattern match failure in " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ctxt)
                   ]
      where
        bind_name :: Name
    bind_name = Maybe ModName -> Name -> Name
    mk_qual_do_name Maybe ModName
    mb_mod '(>>=)

        mk_fail_name :: q Name
    #if __GLASGOW_HASKELL__ >= 807
        -- GHC 8.8 deprecates the MonadFailDesugaring extension since its effects

        -- are always enabled. Furthermore, MonadFailDesugaring is no longer

        -- enabled by default, so simply use MonadFail.fail. (That happens to

        -- be the same as Prelude.fail in 8.8+.)

        mk_fail_name :: q Name
    mk_fail_name = Name -> q Name
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    fail_MonadFail_name
    #else
        mk_fail_name = do
          mfd <- qIsExtEnabled LangExt.MonadFailDesugaring
          return $ if mfd then fail_MonadFail_name else fail_Prelude_name
    #endif

        fail_MonadFail_name :: Name
    fail_MonadFail_name = Maybe ModName -> Name -> Name
    mk_qual_do_name Maybe ModName
    mb_mod 'Fail.fail

    #if __GLASGOW_HASKELL__ < 807
        fail_Prelude_name = mk_qual_do_name mb_mod 'Prelude.fail
    #endif

    -- | Desugar the contents of a parallel comprehension.

    --   Returns a @Pat@ containing a tuple of all bound variables and an expression

    --   to produce the values for those variables

    dsParComp :: DsMonad q => [[Stmt]] -> q (DPat, DExp)
    dsParComp :: forall (q :: * -> *). DsMonad q => [[Stmt]] -> q (DPat, DExp)
    dsParComp [] = String -> q (DPat, DExp)
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible String
    "Empty list of parallel comprehension statements."
    dsParComp [[Stmt]
    r] = do
      let rv :: OSet Name
    rv = (Stmt -> OSet Name) -> [Stmt] -> OSet Name
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Stmt -> OSet Name
    extractBoundNamesStmt [Stmt]
    r
      DExp
    dsR <- [Stmt] -> q DExp
    forall (q :: * -> *). DsMonad q => [Stmt] -> q DExp
    dsComp ([Stmt]
    r [Stmt] -> [Stmt] -> [Stmt]
    forall a. [a] -> [a] -> [a]
    ++ [OSet Name -> Stmt
    mk_tuple_stmt OSet Name
    rv])
      (DPat, DExp) -> q (DPat, DExp)
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OSet Name -> DPat
    mk_tuple_dpat OSet Name
    rv, DExp
    dsR)
    dsParComp ([Stmt]
    q : [[Stmt]]
    rest) = do
      let qv :: OSet Name
    qv = (Stmt -> OSet Name) -> [Stmt] -> OSet Name
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Stmt -> OSet Name
    extractBoundNamesStmt [Stmt]
    q
      (DPat
    rest_pat, DExp
    rest_exp) <- [[Stmt]] -> q (DPat, DExp)
    forall (q :: * -> *). DsMonad q => [[Stmt]] -> q (DPat, DExp)
    dsParComp [[Stmt]]
    rest
      DExp
    dsQ <- [Stmt] -> q DExp
    forall (q :: * -> *). DsMonad q => [Stmt] -> q DExp
    dsComp ([Stmt]
    q [Stmt] -> [Stmt] -> [Stmt]
    forall a. [a] -> [a] -> [a]
    ++ [OSet Name -> Stmt
    mk_tuple_stmt OSet Name
    qv])
      let zipped :: DExp
    zipped = DExp -> DExp -> DExp
    DAppE (DExp -> DExp -> DExp
    DAppE (Name -> DExp
    DVarE 'mzip) DExp
    dsQ) DExp
    rest_exp
      (DPat, DExp) -> q (DPat, DExp)
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name -> [DKind] -> [DPat] -> DPat
    DConP (Int -> Name
    tupleDataName Int
    2) [] [OSet Name -> DPat
    mk_tuple_dpat OSet Name
    qv, DPat
    rest_pat], DExp
    zipped)

    -- helper function for dsParComp

    mk_tuple_stmt :: OSet Name -> Stmt
    mk_tuple_stmt :: OSet Name -> Stmt
    mk_tuple_stmt OSet Name
    name_set =
      Exp -> Stmt
    NoBindS ([Exp] -> Exp
    mkTupleExp ((Name -> [Exp] -> [Exp]) -> [Exp] -> OSet Name -> [Exp]
    forall a b. (a -> b -> b) -> b -> OSet a -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    F.foldr ((:) (Exp -> [Exp] -> [Exp]) -> (Name -> Exp) -> Name -> [Exp] -> [Exp]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Exp
    VarE) [] OSet Name
    name_set))

    -- helper function for dsParComp

    mk_tuple_dpat :: OSet Name -> DPat
    mk_tuple_dpat :: OSet Name -> DPat
    mk_tuple_dpat OSet Name
    name_set =
      [DPat] -> DPat
    mkTupleDPat ((Name -> [DPat] -> [DPat]) -> [DPat] -> OSet Name -> [DPat]
    forall a b. (a -> b -> b) -> b -> OSet a -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    F.foldr ((:) (DPat -> [DPat] -> [DPat])
    -> (Name -> DPat) -> Name -> [DPat] -> [DPat]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> DPat
    DVarP) [] OSet Name
    name_set)

    -- | Desugar a pattern, along with processing a (desugared) expression that

    -- is the entire scope of the variables bound in the pattern.

    dsPatOverExp :: DsMonad q => Pat -> DExp -> q (DPat, DExp)
    dsPatOverExp :: forall (q :: * -> *). DsMonad q => Pat -> DExp -> q (DPat, DExp)
    dsPatOverExp Pat
    pat DExp
    exp = do
      (DPat
    pat', [(Name, DExp)]
    vars) <- WriterT [(Name, DExp)] q DPat -> q (DPat, [(Name, DExp)])
    forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
    runWriterT (WriterT [(Name, DExp)] q DPat -> q (DPat, [(Name, DExp)]))
    -> WriterT [(Name, DExp)] q DPat -> q (DPat, [(Name, DExp)])
    forall a b. (a -> b) -> a -> b
    $ Pat -> WriterT [(Name, DExp)] q DPat
    forall (q :: * -> *). DsMonad q => Pat -> PatM q DPat
    dsPat Pat
    pat
      let name_decs :: [DLetDec]
    name_decs = ((Name, DExp) -> DLetDec) -> [(Name, DExp)] -> [DLetDec]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Name -> DExp -> DLetDec) -> (Name, DExp) -> DLetDec
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (DPat -> DExp -> DLetDec
    DValD (DPat -> DExp -> DLetDec)
    -> (Name -> DPat) -> Name -> DExp -> DLetDec
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> DPat
    DVarP)) [(Name, DExp)]
    vars
      (DPat, DExp) -> q (DPat, DExp)
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DPat
    pat', [DLetDec] -> DExp -> DExp
    maybeDLetE [DLetDec]
    name_decs DExp
    exp)

    -- | Desugar multiple patterns. Like 'dsPatOverExp'.

    dsPatsOverExp :: DsMonad q => [Pat] -> DExp -> q ([DPat], DExp)
    dsPatsOverExp :: forall (q :: * -> *).
    DsMonad q =>
    [Pat] -> DExp -> q ([DPat], DExp)
    dsPatsOverExp [Pat]
    pats DExp
    exp = do
      ([DPat]
    pats', [(Name, DExp)]
    vars) <- WriterT [(Name, DExp)] q [DPat] -> q ([DPat], [(Name, DExp)])
    forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
    runWriterT (WriterT [(Name, DExp)] q [DPat] -> q ([DPat], [(Name, DExp)]))
    -> WriterT [(Name, DExp)] q [DPat] -> q ([DPat], [(Name, DExp)])
    forall a b. (a -> b) -> a -> b
    $ (Pat -> WriterT [(Name, DExp)] q DPat)
    -> [Pat] -> WriterT [(Name, DExp)] q [DPat]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Pat -> WriterT [(Name, DExp)] q DPat
    forall (q :: * -> *). DsMonad q => Pat -> PatM q DPat
    dsPat [Pat]
    pats
      let name_decs :: [DLetDec]
    name_decs = ((Name, DExp) -> DLetDec) -> [(Name, DExp)] -> [DLetDec]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Name -> DExp -> DLetDec) -> (Name, DExp) -> DLetDec
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (DPat -> DExp -> DLetDec
    DValD (DPat -> DExp -> DLetDec)
    -> (Name -> DPat) -> Name -> DExp -> DLetDec
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> DPat
    DVarP)) [(Name, DExp)]
    vars
      ([DPat], DExp) -> q ([DPat], DExp)
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([DPat]
    pats', [DLetDec] -> DExp -> DExp
    maybeDLetE [DLetDec]
    name_decs DExp
    exp)

    -- | Desugar a pattern, returning a list of (Name, DExp) pairs of extra

    -- variables that must be bound within the scope of the pattern

    dsPatX :: DsMonad q => Pat -> q (DPat, [(Name, DExp)])
    dsPatX :: forall (q :: * -> *). DsMonad q => Pat -> q (DPat, [(Name, DExp)])
    dsPatX = WriterT [(Name, DExp)] q DPat -> q (DPat, [(Name, DExp)])
    forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
    runWriterT (WriterT [(Name, DExp)] q DPat -> q (DPat, [(Name, DExp)]))
    -> (Pat -> WriterT [(Name, DExp)] q DPat)
    -> Pat
    -> q (DPat, [(Name, DExp)])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Pat -> WriterT [(Name, DExp)] q DPat
    forall (q :: * -> *). DsMonad q => Pat -> PatM q DPat
    dsPat

    -- | Desugaring a pattern also returns the list of variables bound in as-patterns

    -- and the values they should be bound to. This variables must be brought into

    -- scope in the "body" of the pattern.

    type PatM q = WriterT [(Name, DExp)] q

    -- | Desugar a pattern.

    dsPat :: DsMonad q => Pat -> PatM q DPat
    dsPat :: forall (q :: * -> *). DsMonad q => Pat -> PatM q DPat
    dsPat (LitP Lit
    lit) = DPat -> WriterT [(Name, DExp)] q DPat
    forall a. a -> WriterT [(Name, DExp)] q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DPat -> WriterT [(Name, DExp)] q DPat)
    -> DPat -> WriterT [(Name, DExp)] q DPat
    forall a b. (a -> b) -> a -> b
    $ Lit -> DPat
    DLitP Lit
    lit
    dsPat (VarP Name
    n) = DPat -> WriterT [(Name, DExp)] q DPat
    forall a. a -> WriterT [(Name, DExp)] q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DPat -> WriterT [(Name, DExp)] q DPat)
    -> DPat -> WriterT [(Name, DExp)] q DPat
    forall a b. (a -> b) -> a -> b
    $ Name -> DPat
    DVarP Name
    n
    dsPat (TupP [Pat]
    pats) = Name -> [DKind] -> [DPat] -> DPat
    DConP (Int -> Name
    tupleDataName ([Pat] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Pat]
    pats)) [] ([DPat] -> DPat)
    -> WriterT [(Name, DExp)] q [DPat] -> WriterT [(Name, DExp)] q DPat
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Pat -> WriterT [(Name, DExp)] q DPat)
    -> [Pat] -> WriterT [(Name, DExp)] q [DPat]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Pat -> WriterT [(Name, DExp)] q DPat
    forall (q :: * -> *). DsMonad q => Pat -> PatM q DPat
    dsPat [Pat]
    pats
    dsPat (UnboxedTupP [Pat]
    pats) = Name -> [DKind] -> [DPat] -> DPat
    DConP (Int -> Name
    unboxedTupleDataName ([Pat] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Pat]
    pats)) [] ([DPat] -> DPat)
    -> WriterT [(Name, DExp)] q [DPat] -> WriterT [(Name, DExp)] q DPat
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                               (Pat -> WriterT [(Name, DExp)] q DPat)
    -> [Pat] -> WriterT [(Name, DExp)] q [DPat]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Pat -> WriterT [(Name, DExp)] q DPat
    forall (q :: * -> *). DsMonad q => Pat -> PatM q DPat
    dsPat [Pat]
    pats
    #if __GLASGOW_HASKELL__ >= 901
    dsPat (ConP Name
    name [Type]
    tys [Pat]
    pats) = Name -> [DKind] -> [DPat] -> DPat
    DConP Name
    name ([DKind] -> [DPat] -> DPat)
    -> WriterT [(Name, DExp)] q [DKind]
    -> WriterT [(Name, DExp)] q ([DPat] -> DPat)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Type -> WriterT [(Name, DExp)] q DKind)
    -> [Type] -> WriterT [(Name, DExp)] q [DKind]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Type -> WriterT [(Name, DExp)] q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType [Type]
    tys WriterT [(Name, DExp)] q ([DPat] -> DPat)
    -> WriterT [(Name, DExp)] q [DPat] -> WriterT [(Name, DExp)] q DPat
    forall a b.
    WriterT [(Name, DExp)] q (a -> b)
    -> WriterT [(Name, DExp)] q a -> WriterT [(Name, DExp)] q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Pat -> WriterT [(Name, DExp)] q DPat)
    -> [Pat] -> WriterT [(Name, DExp)] q [DPat]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Pat -> WriterT [(Name, DExp)] q DPat
    forall (q :: * -> *). DsMonad q => Pat -> PatM q DPat
    dsPat [Pat]
    pats
    #else
    dsPat (ConP name     pats) = DConP name [] <$> mapM dsPat pats
    #endif
    dsPat (InfixP Pat
    p1 Name
    name Pat
    p2) = Name -> [DKind] -> [DPat] -> DPat
    DConP Name
    name [] ([DPat] -> DPat)
    -> WriterT [(Name, DExp)] q [DPat] -> WriterT [(Name, DExp)] q DPat
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Pat -> WriterT [(Name, DExp)] q DPat)
    -> [Pat] -> WriterT [(Name, DExp)] q [DPat]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Pat -> WriterT [(Name, DExp)] q DPat
    forall (q :: * -> *). DsMonad q => Pat -> PatM q DPat
    dsPat [Pat
    p1, Pat
    p2]
    dsPat (UInfixP Pat
    _ Name
    _ Pat
    _) =
      String -> WriterT [(Name, DExp)] q DPat
    forall a. String -> WriterT [(Name, DExp)] q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Cannot desugar unresolved infix operators."
    dsPat (ParensP Pat
    pat) = Pat -> WriterT [(Name, DExp)] q DPat
    forall (q :: * -> *). DsMonad q => Pat -> PatM q DPat
    dsPat Pat
    pat
    dsPat (TildeP Pat
    pat) = DPat -> DPat
    DTildeP (DPat -> DPat)
    -> WriterT [(Name, DExp)] q DPat -> WriterT [(Name, DExp)] q DPat
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Pat -> WriterT [(Name, DExp)] q DPat
    forall (q :: * -> *). DsMonad q => Pat -> PatM q DPat
    dsPat Pat
    pat
    dsPat (BangP Pat
    pat) = DPat -> DPat
    DBangP (DPat -> DPat)
    -> WriterT [(Name, DExp)] q DPat -> WriterT [(Name, DExp)] q DPat
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Pat -> WriterT [(Name, DExp)] q DPat
    forall (q :: * -> *). DsMonad q => Pat -> PatM q DPat
    dsPat Pat
    pat
    dsPat (AsP Name
    name Pat
    pat) = do
      DPat
    pat' <- Pat -> WriterT [(Name, DExp)] q DPat
    forall (q :: * -> *). DsMonad q => Pat -> PatM q DPat
    dsPat Pat
    pat
      DPat
    pat'' <- q DPat -> WriterT [(Name, DExp)] q DPat
    forall (m :: * -> *) a.
    Monad m =>
    m a -> WriterT [(Name, DExp)] m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (q DPat -> WriterT [(Name, DExp)] q DPat)
    -> q DPat -> WriterT [(Name, DExp)] q DPat
    forall a b. (a -> b) -> a -> b
    $ DPat -> q DPat
    forall (q :: * -> *). DsMonad q => DPat -> q DPat
    removeWilds DPat
    pat'
      [(Name, DExp)] -> WriterT [(Name, DExp)] q ()
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
    tell [(Name
    name, DPat -> DExp
    dPatToDExp DPat
    pat'')]
      DPat -> WriterT [(Name, DExp)] q DPat
    forall a. a -> WriterT [(Name, DExp)] q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return DPat
    pat''
    dsPat Pat
    WildP = DPat -> WriterT [(Name, DExp)] q DPat
    forall a. a -> WriterT [(Name, DExp)] q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return DPat
    DWildP
    dsPat (RecP Name
    con_name [FieldPat]
    field_pats) = do
      Con
    con <- q Con -> WriterT [(Name, DExp)] q Con
    forall (m :: * -> *) a.
    Monad m =>
    m a -> WriterT [(Name, DExp)] m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (q Con -> WriterT [(Name, DExp)] q Con)
    -> q Con -> WriterT [(Name, DExp)] q Con
    forall a b. (a -> b) -> a -> b
    $ Name -> q Con
    forall (q :: * -> *). DsMonad q => Name -> q Con
    dataConNameToCon Name
    con_name
      [DPat]
    reordered <- Con -> WriterT [(Name, DExp)] q [DPat]
    forall {m :: * -> *}.
    DsMonad m =>
    Con -> WriterT [(Name, DExp)] m [DPat]
    reorder Con
    con
      DPat -> WriterT [(Name, DExp)] q DPat
    forall a. a -> WriterT [(Name, DExp)] q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DPat -> WriterT [(Name, DExp)] q DPat)
    -> DPat -> WriterT [(Name, DExp)] q DPat
    forall a b. (a -> b) -> a -> b
    $ Name -> [DKind] -> [DPat] -> DPat
    DConP Name
    con_name [] [DPat]
    reordered
      where
        reorder :: Con -> WriterT [(Name, DExp)] m [DPat]
    reorder Con
    con = case Con
    con of
                         NormalC Name
    _name [BangType]
    fields -> [BangType] -> WriterT [(Name, DExp)] m [DPat]
    forall {t :: * -> *} {t :: (* -> *) -> * -> *} {m :: * -> *} {a}.
    (Foldable t, MonadTrans t, Monad (t m), MonadFail m) =>
    t a -> t m [DPat]
    non_record [BangType]
    fields
                         InfixC BangType
    field1 Name
    _name BangType
    field2 -> [BangType] -> WriterT [(Name, DExp)] m [DPat]
    forall {t :: * -> *} {t :: (* -> *) -> * -> *} {m :: * -> *} {a}.
    (Foldable t, MonadTrans t, Monad (t m), MonadFail m) =>
    t a -> t m [DPat]
    non_record [BangType
    field1, BangType
    field2]
                         RecC Name
    _name [VarBangType]
    fields -> [VarBangType] -> WriterT [(Name, DExp)] m [DPat]
    forall {q :: * -> *}. DsMonad q => [VarBangType] -> PatM q [DPat]
    reorder_fields_pat [VarBangType]
    fields
                         ForallC [TyVarBndr Specificity]
    _ [Type]
    _ Con
    c -> Con -> WriterT [(Name, DExp)] m [DPat]
    reorder Con
    c
                         GadtC [Name]
    _names [BangType]
    fields Type
    _ret_ty -> [BangType] -> WriterT [(Name, DExp)] m [DPat]
    forall {t :: * -> *} {t :: (* -> *) -> * -> *} {m :: * -> *} {a}.
    (Foldable t, MonadTrans t, Monad (t m), MonadFail m) =>
    t a -> t m [DPat]
    non_record [BangType]
    fields
                         RecGadtC [Name]
    _names [VarBangType]
    fields Type
    _ret_ty -> [VarBangType] -> WriterT [(Name, DExp)] m [DPat]
    forall {q :: * -> *}. DsMonad q => [VarBangType] -> PatM q [DPat]
    reorder_fields_pat [VarBangType]
    fields

        reorder_fields_pat :: [VarBangType] -> PatM q [DPat]
    reorder_fields_pat [VarBangType]
    fields = Name -> [VarBangType] -> [FieldPat] -> PatM q [DPat]
    forall (q :: * -> *).
    DsMonad q =>
    Name -> [VarBangType] -> [FieldPat] -> PatM q [DPat]
    reorderFieldsPat Name
    con_name [VarBangType]
    fields [FieldPat]
    field_pats

        non_record :: t a -> t m [DPat]
    non_record t a
    fields | [FieldPat] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [FieldPat]
    field_pats
                            -- Special case: record patterns are allowed for any

                            -- constructor, regardless of whether the constructor

                            -- actually was declared with records, provided that

                            -- no records are given in the pattern itself. (See #59).

                            --

                            -- Con{} desugars down to Con _ ... _.

                          = [DPat] -> t m [DPat]
    forall a. a -> t m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([DPat] -> t m [DPat]) -> [DPat] -> t m [DPat]
    forall a b. (a -> b) -> a -> b
    $ Int -> DPat -> [DPat]
    forall a. Int -> a -> [a]
    replicate (t a -> Int
    forall a. t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length t a
    fields) DPat
    DWildP
                          | Bool
    otherwise = m [DPat] -> t m [DPat]
    forall (m :: * -> *) a. Monad m => m a -> t m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (m [DPat] -> t m [DPat]) -> m [DPat] -> t m [DPat]
    forall a b. (a -> b) -> a -> b
    $ String -> m [DPat]
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible
                                             (String -> m [DPat]) -> String -> m [DPat]
    forall a b. (a -> b) -> a -> b
    $ String
    "Record syntax used with non-record constructor "
                                               String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (Name -> String
    forall a. Show a => a -> String
    show Name
    con_name) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "."

    dsPat (ListP [Pat]
    pats) = [Pat] -> WriterT [(Name, DExp)] q DPat
    forall {q :: * -> *}.
    DsMonad q =>
    [Pat] -> WriterT [(Name, DExp)] q DPat
    go [Pat]
    pats
      where go :: [Pat] -> WriterT [(Name, DExp)] q DPat
    go [] = DPat -> WriterT [(Name, DExp)] q DPat
    forall a. a -> WriterT [(Name, DExp)] q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DPat -> WriterT [(Name, DExp)] q DPat)
    -> DPat -> WriterT [(Name, DExp)] q DPat
    forall a b. (a -> b) -> a -> b
    $ Name -> [DKind] -> [DPat] -> DPat
    DConP '[] [] []
            go (Pat
    h : [Pat]
    t) = do
              DPat
    h' <- Pat -> WriterT [(Name, DExp)] q DPat
    forall (q :: * -> *). DsMonad q => Pat -> PatM q DPat
    dsPat Pat
    h
              DPat
    t' <- [Pat] -> WriterT [(Name, DExp)] q DPat
    go [Pat]
    t
              DPat -> WriterT [(Name, DExp)] q DPat
    forall a. a -> WriterT [(Name, DExp)] q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DPat -> WriterT [(Name, DExp)] q DPat)
    -> DPat -> WriterT [(Name, DExp)] q DPat
    forall a b. (a -> b) -> a -> b
    $ Name -> [DKind] -> [DPat] -> DPat
    DConP '(:) [] [DPat
    h', DPat
    t']
    dsPat (SigP Pat
    pat Type
    ty) = DPat -> DKind -> DPat
    DSigP (DPat -> DKind -> DPat)
    -> WriterT [(Name, DExp)] q DPat
    -> WriterT [(Name, DExp)] q (DKind -> DPat)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Pat -> WriterT [(Name, DExp)] q DPat
    forall (q :: * -> *). DsMonad q => Pat -> PatM q DPat
    dsPat Pat
    pat WriterT [(Name, DExp)] q (DKind -> DPat)
    -> WriterT [(Name, DExp)] q DKind -> WriterT [(Name, DExp)] q DPat
    forall a b.
    WriterT [(Name, DExp)] q (a -> b)
    -> WriterT [(Name, DExp)] q a -> WriterT [(Name, DExp)] q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> WriterT [(Name, DExp)] q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    ty
    #if __GLASGOW_HASKELL__ >= 801
    dsPat (UnboxedSumP Pat
    pat Int
    alt Int
    arity) =
      Name -> [DKind] -> [DPat] -> DPat
    DConP (Int -> Int -> Name
    unboxedSumDataName Int
    alt Int
    arity) [] ([DPat] -> DPat)
    -> WriterT [(Name, DExp)] q [DPat] -> WriterT [(Name, DExp)] q DPat
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((DPat -> [DPat] -> [DPat]
    forall a. a -> [a] -> [a]
    :[]) (DPat -> [DPat])
    -> WriterT [(Name, DExp)] q DPat -> WriterT [(Name, DExp)] q [DPat]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Pat -> WriterT [(Name, DExp)] q DPat
    forall (q :: * -> *). DsMonad q => Pat -> PatM q DPat
    dsPat Pat
    pat)
    #endif
    dsPat (ViewP Exp
    _ Pat
    _) =
      String -> WriterT [(Name, DExp)] q DPat
    forall a. String -> WriterT [(Name, DExp)] q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "View patterns are not supported in th-desugar. Use pattern guards instead."

    -- | Convert a 'DPat' to a 'DExp'. Fails on 'DWildP'.

    dPatToDExp :: DPat -> DExp
    dPatToDExp :: DPat -> DExp
    dPatToDExp (DLitP Lit
    lit) = Lit -> DExp
    DLitE Lit
    lit
    dPatToDExp (DVarP Name
    name) = Name -> DExp
    DVarE Name
    name
    dPatToDExp (DConP Name
    name [DKind]
    tys [DPat]
    pats) = (DExp -> DExp -> DExp) -> DExp -> [DExp] -> DExp
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl DExp -> DExp -> DExp
    DAppE ((DExp -> DKind -> DExp) -> DExp -> [DKind] -> DExp
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl DExp -> DKind -> DExp
    DAppTypeE (Name -> DExp
    DConE Name
    name) [DKind]
    tys) ((DPat -> DExp) -> [DPat] -> [DExp]
    forall a b. (a -> b) -> [a] -> [b]
    map DPat -> DExp
    dPatToDExp [DPat]
    pats)
    dPatToDExp (DTildeP DPat
    pat) = DPat -> DExp
    dPatToDExp DPat
    pat
    dPatToDExp (DBangP DPat
    pat) = DPat -> DExp
    dPatToDExp DPat
    pat
    dPatToDExp (DSigP DPat
    pat DKind
    ty) = DExp -> DKind -> DExp
    DSigE (DPat -> DExp
    dPatToDExp DPat
    pat) DKind
    ty
    dPatToDExp DPat
    DWildP = String -> DExp
    forall a. HasCallStack => String -> a
    error String
    "Internal error in th-desugar: wildcard in rhs of as-pattern"

    -- | Remove all wildcards from a pattern, replacing any wildcard with a fresh

    --   variable

    removeWilds :: DsMonad q => DPat -> q DPat
    removeWilds :: forall (q :: * -> *). DsMonad q => DPat -> q DPat
    removeWilds p :: DPat
    p@(DLitP Lit
    _) = DPat -> q DPat
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return DPat
    p
    removeWilds p :: DPat
    p@(DVarP Name
    _) = DPat -> q DPat
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return DPat
    p
    removeWilds (DConP Name
    con_name [DKind]
    tys [DPat]
    pats) = Name -> [DKind] -> [DPat] -> DPat
    DConP Name
    con_name [DKind]
    tys ([DPat] -> DPat) -> q [DPat] -> q DPat
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (DPat -> q DPat) -> [DPat] -> q [DPat]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM DPat -> q DPat
    forall (q :: * -> *). DsMonad q => DPat -> q DPat
    removeWilds [DPat]
    pats
    removeWilds (DTildeP DPat
    pat) = DPat -> DPat
    DTildeP (DPat -> DPat) -> q DPat -> q DPat
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> DPat -> q DPat
    forall (q :: * -> *). DsMonad q => DPat -> q DPat
    removeWilds DPat
    pat
    removeWilds (DBangP DPat
    pat) = DPat -> DPat
    DBangP (DPat -> DPat) -> q DPat -> q DPat
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> DPat -> q DPat
    forall (q :: * -> *). DsMonad q => DPat -> q DPat
    removeWilds DPat
    pat
    removeWilds (DSigP DPat
    pat DKind
    ty) = DPat -> DKind -> DPat
    DSigP (DPat -> DKind -> DPat) -> q DPat -> q (DKind -> DPat)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> DPat -> q DPat
    forall (q :: * -> *). DsMonad q => DPat -> q DPat
    removeWilds DPat
    pat q (DKind -> DPat) -> q DKind -> q DPat
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> DKind -> q DKind
    forall a. a -> q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure DKind
    ty
    removeWilds DPat
    DWildP = Name -> DPat
    DVarP (Name -> DPat) -> q Name -> q DPat
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> q Name
    forall (q :: * -> *). Quasi q => String -> q Name
    newUniqueName String
    "wild"

    -- | Desugar @Info@

    dsInfo :: DsMonad q => Info -> q DInfo
    dsInfo :: forall (q :: * -> *). DsMonad q => Info -> q DInfo
    dsInfo (ClassI Dec
    dec [Dec]
    instances) = do
      [DDec
    ddec]     <- Dec -> q [DDec]
    forall (q :: * -> *). DsMonad q => Dec -> q [DDec]
    dsDec Dec
    dec
      [DDec]
    dinstances <- [Dec] -> q [DDec]
    forall (q :: * -> *). DsMonad q => [Dec] -> q [DDec]
    dsDecs [Dec]
    instances
      DInfo -> q DInfo
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DInfo -> q DInfo) -> DInfo -> q DInfo
    forall a b. (a -> b) -> a -> b
    $ DDec -> Maybe [DDec] -> DInfo
    DTyConI DDec
    ddec ([DDec] -> Maybe [DDec]
    forall a. a -> Maybe a
    Just [DDec]
    dinstances)
    dsInfo (ClassOpI Name
    name Type
    ty Name
    parent) =
      Name -> DKind -> Maybe Name -> DInfo
    DVarI Name
    name (DKind -> Maybe Name -> DInfo)
    -> q DKind -> q (Maybe Name -> DInfo)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    ty q (Maybe Name -> DInfo) -> q (Maybe Name) -> q DInfo
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Maybe Name -> q (Maybe Name)
    forall a. a -> q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Name -> Maybe Name
    forall a. a -> Maybe a
    Just Name
    parent)
    dsInfo (TyConI Dec
    dec) = do
      [DDec
    ddec] <- Dec -> q [DDec]
    forall (q :: * -> *). DsMonad q => Dec -> q [DDec]
    dsDec Dec
    dec
      DInfo -> q DInfo
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DInfo -> q DInfo) -> DInfo -> q DInfo
    forall a b. (a -> b) -> a -> b
    $ DDec -> Maybe [DDec] -> DInfo
    DTyConI DDec
    ddec Maybe [DDec]
    forall a. Maybe a
    Nothing
    dsInfo (FamilyI Dec
    dec [Dec]
    instances) = do
      [DDec
    ddec]     <- Dec -> q [DDec]
    forall (q :: * -> *). DsMonad q => Dec -> q [DDec]
    dsDec Dec
    dec
      [DDec]
    dinstances <- [Dec] -> q [DDec]
    forall (q :: * -> *). DsMonad q => [Dec] -> q [DDec]
    dsDecs [Dec]
    instances
      DInfo -> q DInfo
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DInfo -> q DInfo) -> DInfo -> q DInfo
    forall a b. (a -> b) -> a -> b
    $ DDec -> Maybe [DDec] -> DInfo
    DTyConI DDec
    ddec ([DDec] -> Maybe [DDec]
    forall a. a -> Maybe a
    Just [DDec]
    dinstances)
    dsInfo (PrimTyConI Name
    name Int
    arity Bool
    unlifted) =
      DInfo -> q DInfo
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DInfo -> q DInfo) -> DInfo -> q DInfo
    forall a b. (a -> b) -> a -> b
    $ Name -> Int -> Bool -> DInfo
    DPrimTyConI Name
    name Int
    arity Bool
    unlifted
    dsInfo (DataConI Name
    name Type
    ty Name
    parent) =
      Name -> DKind -> Maybe Name -> DInfo
    DVarI Name
    name (DKind -> Maybe Name -> DInfo)
    -> q DKind -> q (Maybe Name -> DInfo)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    ty q (Maybe Name -> DInfo) -> q (Maybe Name) -> q DInfo
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Maybe Name -> q (Maybe Name)
    forall a. a -> q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Name -> Maybe Name
    forall a. a -> Maybe a
    Just Name
    parent)
    dsInfo (VarI Name
    name Type
    ty Maybe Dec
    Nothing) =
      Name -> DKind -> Maybe Name -> DInfo
    DVarI Name
    name (DKind -> Maybe Name -> DInfo)
    -> q DKind -> q (Maybe Name -> DInfo)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    ty q (Maybe Name -> DInfo) -> q (Maybe Name) -> q DInfo
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Maybe Name -> q (Maybe Name)
    forall a. a -> q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Name
    forall a. Maybe a
    Nothing
    dsInfo (VarI Name
    name Type
    _ (Just Dec
    _)) =
      String -> q DInfo
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible (String -> q DInfo) -> String -> q DInfo
    forall a b. (a -> b) -> a -> b
    $ String
    "Declaration supplied with variable: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Name -> String
    forall a. Show a => a -> String
    show Name
    name
    dsInfo (TyVarI Name
    name Type
    ty) = Name -> DKind -> DInfo
    DTyVarI Name
    name (DKind -> DInfo) -> q DKind -> q DInfo
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    ty
    #if __GLASGOW_HASKELL__ >= 801
    dsInfo (PatSynI Name
    name Type
    ty) = Name -> DKind -> DInfo
    DPatSynI Name
    name (DKind -> DInfo) -> q DKind -> q DInfo
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    ty
    #endif

    -- | Desugar arbitrary @Dec@s

    dsDecs :: DsMonad q => [Dec] -> q [DDec]
    dsDecs :: forall (q :: * -> *). DsMonad q => [Dec] -> q [DDec]
    dsDecs = (Dec -> q [DDec]) -> [Dec] -> q [DDec]
    forall (monad :: * -> *) monoid (t :: * -> *) a.
    (Monad monad, Monoid monoid, Traversable t) =>
    (a -> monad monoid) -> t a -> monad monoid
    concatMapM Dec -> q [DDec]
    forall (q :: * -> *). DsMonad q => Dec -> q [DDec]
    dsDec

    -- | Desugar a single @Dec@, perhaps producing multiple 'DDec's

    dsDec :: DsMonad q => Dec -> q [DDec]
    dsDec :: forall (q :: * -> *). DsMonad q => Dec -> q [DDec]
    dsDec d :: Dec
    d@(FunD {}) = Dec -> q [DDec]
    forall (q :: * -> *). DsMonad q => Dec -> q [DDec]
    dsTopLevelLetDec Dec
    d
    dsDec d :: Dec
    d@(ValD {}) = Dec -> q [DDec]
    forall (q :: * -> *). DsMonad q => Dec -> q [DDec]
    dsTopLevelLetDec Dec
    d
    dsDec (DataD [Type]
    cxt Name
    n [TyVarBndrUnit]
    tvbs Maybe Type
    mk [Con]
    cons [DerivClause]
    derivings) =
      DataFlavor
    -> [Type]
    -> Name
    -> [TyVarBndrUnit]
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> q [DDec]
    forall (q :: * -> *).
    DsMonad q =>
    DataFlavor
    -> [Type]
    -> Name
    -> [TyVarBndrUnit]
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> q [DDec]
    dsDataDec DataFlavor
    Data [Type]
    cxt Name
    n [TyVarBndrUnit]
    tvbs Maybe Type
    mk [Con]
    cons [DerivClause]
    derivings
    dsDec (NewtypeD [Type]
    cxt Name
    n [TyVarBndrUnit]
    tvbs Maybe Type
    mk Con
    con [DerivClause]
    derivings) =
      DataFlavor
    -> [Type]
    -> Name
    -> [TyVarBndrUnit]
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> q [DDec]
    forall (q :: * -> *).
    DsMonad q =>
    DataFlavor
    -> [Type]
    -> Name
    -> [TyVarBndrUnit]
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> q [DDec]
    dsDataDec DataFlavor
    Newtype [Type]
    cxt Name
    n [TyVarBndrUnit]
    tvbs Maybe Type
    mk [Con
    con] [DerivClause]
    derivings
    dsDec (TySynD Name
    n [TyVarBndrUnit]
    tvbs Type
    ty) =
      (DDec -> [DDec] -> [DDec]
    forall a. a -> [a] -> [a]
    :[]) (DDec -> [DDec]) -> q DDec -> q [DDec]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Name -> [DTyVarBndrUnit] -> DKind -> DDec
    DTySynD Name
    n ([DTyVarBndrUnit] -> DKind -> DDec)
    -> q [DTyVarBndrUnit] -> q (DKind -> DDec)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (TyVarBndrUnit -> q DTyVarBndrUnit)
    -> [TyVarBndrUnit] -> q [DTyVarBndrUnit]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM TyVarBndrUnit -> q DTyVarBndrUnit
    forall (q :: * -> *).
    DsMonad q =>
    TyVarBndrUnit -> q DTyVarBndrUnit
    dsTvbUnit [TyVarBndrUnit]
    tvbs q (DKind -> DDec) -> q DKind -> q DDec
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    ty)
    dsDec (ClassD [Type]
    cxt Name
    n [TyVarBndrUnit]
    tvbs [FunDep]
    fds [Dec]
    decs) =
      (DDec -> [DDec] -> [DDec]
    forall a. a -> [a] -> [a]
    :[]) (DDec -> [DDec]) -> q DDec -> q [DDec]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ([DKind] -> Name -> [DTyVarBndrUnit] -> [FunDep] -> [DDec] -> DDec
    DClassD ([DKind] -> Name -> [DTyVarBndrUnit] -> [FunDep] -> [DDec] -> DDec)
    -> q [DKind]
    -> q (Name -> [DTyVarBndrUnit] -> [FunDep] -> [DDec] -> DDec)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Type] -> q [DKind]
    forall (q :: * -> *). DsMonad q => [Type] -> q [DKind]
    dsCxt [Type]
    cxt q (Name -> [DTyVarBndrUnit] -> [FunDep] -> [DDec] -> DDec)
    -> q Name -> q ([DTyVarBndrUnit] -> [FunDep] -> [DDec] -> DDec)
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Name -> q Name
    forall a. a -> q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Name
    n q ([DTyVarBndrUnit] -> [FunDep] -> [DDec] -> DDec)
    -> q [DTyVarBndrUnit] -> q ([FunDep] -> [DDec] -> DDec)
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (TyVarBndrUnit -> q DTyVarBndrUnit)
    -> [TyVarBndrUnit] -> q [DTyVarBndrUnit]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM TyVarBndrUnit -> q DTyVarBndrUnit
    forall (q :: * -> *).
    DsMonad q =>
    TyVarBndrUnit -> q DTyVarBndrUnit
    dsTvbUnit [TyVarBndrUnit]
    tvbs
                         q ([FunDep] -> [DDec] -> DDec) -> q [FunDep] -> q ([DDec] -> DDec)
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [FunDep] -> q [FunDep]
    forall a. a -> q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [FunDep]
    fds q ([DDec] -> DDec) -> q [DDec] -> q DDec
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [Dec] -> q [DDec]
    forall (q :: * -> *). DsMonad q => [Dec] -> q [DDec]
    dsDecs [Dec]
    decs)
    dsDec (InstanceD Maybe Overlap
    over [Type]
    cxt Type
    ty [Dec]
    decs) =
      (DDec -> [DDec] -> [DDec]
    forall a. a -> [a] -> [a]
    :[]) (DDec -> [DDec]) -> q DDec -> q [DDec]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Maybe Overlap
    -> Maybe [DTyVarBndrUnit] -> [DKind] -> DKind -> [DDec] -> DDec
    DInstanceD Maybe Overlap
    over Maybe [DTyVarBndrUnit]
    forall a. Maybe a
    Nothing ([DKind] -> DKind -> [DDec] -> DDec)
    -> q [DKind] -> q (DKind -> [DDec] -> DDec)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Type] -> q [DKind]
    forall (q :: * -> *). DsMonad q => [Type] -> q [DKind]
    dsCxt [Type]
    cxt q (DKind -> [DDec] -> DDec) -> q DKind -> q ([DDec] -> DDec)
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    ty q ([DDec] -> DDec) -> q [DDec] -> q DDec
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [Dec] -> q [DDec]
    forall (q :: * -> *). DsMonad q => [Dec] -> q [DDec]
    dsDecs [Dec]
    decs)
    dsDec d :: Dec
    d@(SigD {}) = Dec -> q [DDec]
    forall (q :: * -> *). DsMonad q => Dec -> q [DDec]
    dsTopLevelLetDec Dec
    d
    dsDec (ForeignD Foreign
    f) = (DDec -> [DDec] -> [DDec]
    forall a. a -> [a] -> [a]
    :[]) (DDec -> [DDec]) -> q DDec -> q [DDec]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (DForeign -> DDec
    DForeignD (DForeign -> DDec) -> q DForeign -> q DDec
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Foreign -> q DForeign
    forall (q :: * -> *). DsMonad q => Foreign -> q DForeign
    dsForeign Foreign
    f)
    dsDec d :: Dec
    d@(InfixD {}) = Dec -> q [DDec]
    forall (q :: * -> *). DsMonad q => Dec -> q [DDec]
    dsTopLevelLetDec Dec
    d
    dsDec d :: Dec
    d@(PragmaD {}) = Dec -> q [DDec]
    forall (q :: * -> *). DsMonad q => Dec -> q [DDec]
    dsTopLevelLetDec Dec
    d
    dsDec (OpenTypeFamilyD TypeFamilyHead
    tfHead) =
      (DDec -> [DDec] -> [DDec]
    forall a. a -> [a] -> [a]
    :[]) (DDec -> [DDec]) -> q DDec -> q [DDec]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (DTypeFamilyHead -> DDec
    DOpenTypeFamilyD (DTypeFamilyHead -> DDec) -> q DTypeFamilyHead -> q DDec
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TypeFamilyHead -> q DTypeFamilyHead
    forall (q :: * -> *).
    DsMonad q =>
    TypeFamilyHead -> q DTypeFamilyHead
    dsTypeFamilyHead TypeFamilyHead
    tfHead)
    dsDec (DataFamilyD Name
    n [TyVarBndrUnit]
    tvbs Maybe Type
    m_k) =
      (DDec -> [DDec] -> [DDec]
    forall a. a -> [a] -> [a]
    :[]) (DDec -> [DDec]) -> q DDec -> q [DDec]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Name -> [DTyVarBndrUnit] -> Maybe DKind -> DDec
    DDataFamilyD Name
    n ([DTyVarBndrUnit] -> Maybe DKind -> DDec)
    -> q [DTyVarBndrUnit] -> q (Maybe DKind -> DDec)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (TyVarBndrUnit -> q DTyVarBndrUnit)
    -> [TyVarBndrUnit] -> q [DTyVarBndrUnit]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM TyVarBndrUnit -> q DTyVarBndrUnit
    forall (q :: * -> *).
    DsMonad q =>
    TyVarBndrUnit -> q DTyVarBndrUnit
    dsTvbUnit [TyVarBndrUnit]
    tvbs q (Maybe DKind -> DDec) -> q (Maybe DKind) -> q DDec
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Type -> q DKind) -> Maybe Type -> q (Maybe DKind)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Maybe a -> m (Maybe b)
    mapM Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Maybe Type
    m_k)
    #if __GLASGOW_HASKELL__ >= 807
    dsDec (DataInstD [Type]
    cxt Maybe [TyVarBndrUnit]
    mtvbs Type
    lhs Maybe Type
    mk [Con]
    cons [DerivClause]
    derivings) =
      case Type -> (Type, [TypeArg])
    unfoldType Type
    lhs of
        (ConT Name
    n, [TypeArg]
    tys) -> DataFlavor
    -> [Type]
    -> Name
    -> Maybe [TyVarBndrUnit]
    -> [TypeArg]
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> q [DDec]
    forall (q :: * -> *).
    DsMonad q =>
    DataFlavor
    -> [Type]
    -> Name
    -> Maybe [TyVarBndrUnit]
    -> [TypeArg]
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> q [DDec]
    dsDataInstDec DataFlavor
    Data [Type]
    cxt Name
    n Maybe [TyVarBndrUnit]
    mtvbs [TypeArg]
    tys Maybe Type
    mk [Con]
    cons [DerivClause]
    derivings
        (Type
    _, [TypeArg]
    _)        -> String -> q [DDec]
    forall a. String -> q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> q [DDec]) -> String -> q [DDec]
    forall a b. (a -> b) -> a -> b
    $ String
    "Unexpected data instance LHS: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    forall a. Ppr a => a -> String
    pprint Type
    lhs
    dsDec (NewtypeInstD [Type]
    cxt Maybe [TyVarBndrUnit]
    mtvbs Type
    lhs Maybe Type
    mk Con
    con [DerivClause]
    derivings) =
      case Type -> (Type, [TypeArg])
    unfoldType Type
    lhs of
        (ConT Name
    n, [TypeArg]
    tys) -> DataFlavor
    -> [Type]
    -> Name
    -> Maybe [TyVarBndrUnit]
    -> [TypeArg]
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> q [DDec]
    forall (q :: * -> *).
    DsMonad q =>
    DataFlavor
    -> [Type]
    -> Name
    -> Maybe [TyVarBndrUnit]
    -> [TypeArg]
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> q [DDec]
    dsDataInstDec DataFlavor
    Newtype [Type]
    cxt Name
    n Maybe [TyVarBndrUnit]
    mtvbs [TypeArg]
    tys Maybe Type
    mk [Con
    con] [DerivClause]
    derivings
        (Type
    _, [TypeArg]
    _)        -> String -> q [DDec]
    forall a. String -> q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> q [DDec]) -> String -> q [DDec]
    forall a b. (a -> b) -> a -> b
    $ String
    "Unexpected newtype instance LHS: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    forall a. Ppr a => a -> String
    pprint Type
    lhs
    #else
    dsDec (DataInstD cxt n tys mk cons derivings) =
      dsDataInstDec Data cxt n Nothing (map TANormal tys) mk cons derivings
    dsDec (NewtypeInstD cxt n tys mk con derivings) =
      dsDataInstDec Newtype cxt n Nothing (map TANormal tys) mk [con] derivings
    #endif
    #if __GLASGOW_HASKELL__ >= 807
    dsDec (TySynInstD TySynEqn
    eqn) = (DDec -> [DDec] -> [DDec]
    forall a. a -> [a] -> [a]
    :[]) (DDec -> [DDec]) -> q DDec -> q [DDec]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (DTySynEqn -> DDec
    DTySynInstD (DTySynEqn -> DDec) -> q DTySynEqn -> q DDec
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name -> TySynEqn -> q DTySynEqn
    forall (q :: * -> *). DsMonad q => Name -> TySynEqn -> q DTySynEqn
    dsTySynEqn Name
    forall a. a
    unusedArgument TySynEqn
    eqn)
    #else
    dsDec (TySynInstD n eqn) = (:[]) <$> (DTySynInstD <$> dsTySynEqn n eqn)
    #endif
    dsDec (ClosedTypeFamilyD TypeFamilyHead
    tfHead [TySynEqn]
    eqns) =
      (DDec -> [DDec] -> [DDec]
    forall a. a -> [a] -> [a]
    :[]) (DDec -> [DDec]) -> q DDec -> q [DDec]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (DTypeFamilyHead -> [DTySynEqn] -> DDec
    DClosedTypeFamilyD (DTypeFamilyHead -> [DTySynEqn] -> DDec)
    -> q DTypeFamilyHead -> q ([DTySynEqn] -> DDec)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TypeFamilyHead -> q DTypeFamilyHead
    forall (q :: * -> *).
    DsMonad q =>
    TypeFamilyHead -> q DTypeFamilyHead
    dsTypeFamilyHead TypeFamilyHead
    tfHead
                                    q ([DTySynEqn] -> DDec) -> q [DTySynEqn] -> q DDec
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (TySynEqn -> q DTySynEqn) -> [TySynEqn] -> q [DTySynEqn]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Name -> TySynEqn -> q DTySynEqn
    forall (q :: * -> *). DsMonad q => Name -> TySynEqn -> q DTySynEqn
    dsTySynEqn (TypeFamilyHead -> Name
    typeFamilyHeadName TypeFamilyHead
    tfHead)) [TySynEqn]
    eqns)
    dsDec (RoleAnnotD Name
    n [Role]
    roles) = [DDec] -> q [DDec]
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Name -> [Role] -> DDec
    DRoleAnnotD Name
    n [Role]
    roles]
    #if __GLASGOW_HASKELL__ >= 801
    dsDec (PatSynD Name
    n PatSynArgs
    args PatSynDir
    dir Pat
    pat) = do
      DPatSynDir
    dir' <- Name -> PatSynDir -> q DPatSynDir
    forall (q :: * -> *).
    DsMonad q =>
    Name -> PatSynDir -> q DPatSynDir
    dsPatSynDir Name
    n PatSynDir
    dir
      (DPat
    pat', [(Name, DExp)]
    vars) <- Pat -> q (DPat, [(Name, DExp)])
    forall (q :: * -> *). DsMonad q => Pat -> q (DPat, [(Name, DExp)])
    dsPatX Pat
    pat
      Bool -> q () -> q ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([(Name, DExp)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(Name, DExp)]
    vars) (q () -> q ()) -> q () -> q ()
    forall a b. (a -> b) -> a -> b
    $
        String -> q ()
    forall a. String -> q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> q ()) -> String -> q ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Pattern synonym definition cannot contain as-patterns (@)."
      [DDec] -> q [DDec]
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Name -> PatSynArgs -> DPatSynDir -> DPat -> DDec
    DPatSynD Name
    n PatSynArgs
    args DPatSynDir
    dir' DPat
    pat']
    dsDec (PatSynSigD Name
    n Type
    ty) = (DDec -> [DDec] -> [DDec]
    forall a. a -> [a] -> [a]
    :[]) (DDec -> [DDec]) -> q DDec -> q [DDec]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Name -> DKind -> DDec
    DPatSynSigD Name
    n (DKind -> DDec) -> q DKind -> q DDec
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    ty)
    dsDec (StandaloneDerivD Maybe DerivStrategy
    mds [Type]
    cxt Type
    ty) =
      (DDec -> [DDec] -> [DDec]
    forall a. a -> [a] -> [a]
    :[]) (DDec -> [DDec]) -> q DDec -> q [DDec]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Maybe DDerivStrategy
    -> Maybe [DTyVarBndrUnit] -> [DKind] -> DKind -> DDec
    DStandaloneDerivD (Maybe DDerivStrategy
     -> Maybe [DTyVarBndrUnit] -> [DKind] -> DKind -> DDec)
    -> q (Maybe DDerivStrategy)
    -> q (Maybe [DTyVarBndrUnit] -> [DKind] -> DKind -> DDec)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (DerivStrategy -> q DDerivStrategy)
    -> Maybe DerivStrategy -> q (Maybe DDerivStrategy)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Maybe a -> m (Maybe b)
    mapM DerivStrategy -> q DDerivStrategy
    forall (q :: * -> *).
    DsMonad q =>
    DerivStrategy -> q DDerivStrategy
    dsDerivStrategy Maybe DerivStrategy
    mds
                                   q (Maybe [DTyVarBndrUnit] -> [DKind] -> DKind -> DDec)
    -> q (Maybe [DTyVarBndrUnit]) -> q ([DKind] -> DKind -> DDec)
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Maybe [DTyVarBndrUnit] -> q (Maybe [DTyVarBndrUnit])
    forall a. a -> q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe [DTyVarBndrUnit]
    forall a. Maybe a
    Nothing q ([DKind] -> DKind -> DDec) -> q [DKind] -> q (DKind -> DDec)
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [Type] -> q [DKind]
    forall (q :: * -> *). DsMonad q => [Type] -> q [DKind]
    dsCxt [Type]
    cxt q (DKind -> DDec) -> q DKind -> q DDec
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    ty)
    #else
    dsDec (StandaloneDerivD cxt ty) =
      (:[]) <$> (DStandaloneDerivD Nothing Nothing <$> dsCxt cxt <*> dsType ty)
    #endif
    dsDec (DefaultSigD Name
    n Type
    ty) = (DDec -> [DDec] -> [DDec]
    forall a. a -> [a] -> [a]
    :[]) (DDec -> [DDec]) -> q DDec -> q [DDec]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Name -> DKind -> DDec
    DDefaultSigD Name
    n (DKind -> DDec) -> q DKind -> q DDec
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    ty)
    #if __GLASGOW_HASKELL__ >= 807
    dsDec (ImplicitParamBindD {}) = String -> q [DDec]
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible String
    "Non-`let`-bound implicit param binding"
    #endif
    #if __GLASGOW_HASKELL__ >= 809
    dsDec (KiSigD Name
    n Type
    ki) = (DDec -> [DDec] -> [DDec]
    forall a. a -> [a] -> [a]
    :[]) (DDec -> [DDec]) -> q DDec -> q [DDec]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Name -> DKind -> DDec
    DKiSigD Name
    n (DKind -> DDec) -> q DKind -> q DDec
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    ki)
    #endif
    #if __GLASGOW_HASKELL__ >= 903
    dsDec (DefaultD [Type]
    tys) = (DDec -> [DDec] -> [DDec]
    forall a. a -> [a] -> [a]
    :[]) (DDec -> [DDec]) -> q DDec -> q [DDec]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ([DKind] -> DDec
    DDefaultD ([DKind] -> DDec) -> q [DKind] -> q DDec
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Type -> q DKind) -> [Type] -> q [DKind]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType [Type]
    tys)
    #endif
    #if __GLASGOW_HASKELL__ >= 906
    dsDec (TypeDataD Name
    n [TyVarBndrUnit]
    tys Maybe Type
    mk [Con]
    cons) =
      DataFlavor
    -> [Type]
    -> Name
    -> [TyVarBndrUnit]
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> q [DDec]
    forall (q :: * -> *).
    DsMonad q =>
    DataFlavor
    -> [Type]
    -> Name
    -> [TyVarBndrUnit]
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> q [DDec]
    dsDataDec DataFlavor
    TypeData [] Name
    n [TyVarBndrUnit]
    tys Maybe Type
    mk [Con]
    cons []
    #endif

    -- | Desugar a 'DataD', 'NewtypeD', or 'TypeDataD'.

    dsDataDec :: DsMonad q
              => DataFlavor -> Cxt -> Name -> [TyVarBndrUnit]
              -> Maybe Kind -> [Con] -> [DerivingClause] -> q [DDec]
    dsDataDec :: forall (q :: * -> *).
    DsMonad q =>
    DataFlavor
    -> [Type]
    -> Name
    -> [TyVarBndrUnit]
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> q [DDec]
    dsDataDec DataFlavor
    nd [Type]
    cxt Name
    n [TyVarBndrUnit]
    tvbs Maybe Type
    mk [Con]
    cons [DerivClause]
    derivings = do
      [DTyVarBndrUnit]
    tvbs' <- (TyVarBndrUnit -> q DTyVarBndrUnit)
    -> [TyVarBndrUnit] -> q [DTyVarBndrUnit]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM TyVarBndrUnit -> q DTyVarBndrUnit
    forall (q :: * -> *).
    DsMonad q =>
    TyVarBndrUnit -> q DTyVarBndrUnit
    dsTvbUnit [TyVarBndrUnit]
    tvbs
      let h98_tvbs :: [DTyVarBndrUnit]
    h98_tvbs = case Maybe Type
    mk of
                       -- If there's an explicit return kind, we're dealing with a

                       -- GADT, so this argument goes unused in dsCon.

                       Just {} -> [DTyVarBndrUnit]
    forall a. a
    unusedArgument
                       Maybe Type
    Nothing -> [DTyVarBndrUnit]
    tvbs'
          h98_return_type :: DKind
    h98_return_type = Name -> [DTyVarBndrUnit] -> DKind
    nonFamilyDataReturnType Name
    n [DTyVarBndrUnit]
    tvbs'
      (DDec -> [DDec] -> [DDec]
    forall a. a -> [a] -> [a]
    :[]) (DDec -> [DDec]) -> q DDec -> q [DDec]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (DataFlavor
    -> [DKind]
    -> Name
    -> [DTyVarBndrUnit]
    -> Maybe DKind
    -> [DCon]
    -> [DDerivClause]
    -> DDec
    DDataD DataFlavor
    nd ([DKind]
     -> Name
     -> [DTyVarBndrUnit]
     -> Maybe DKind
     -> [DCon]
     -> [DDerivClause]
     -> DDec)
    -> q [DKind]
    -> q (Name
          -> [DTyVarBndrUnit]
          -> Maybe DKind
          -> [DCon]
          -> [DDerivClause]
          -> DDec)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Type] -> q [DKind]
    forall (q :: * -> *). DsMonad q => [Type] -> q [DKind]
    dsCxt [Type]
    cxt q (Name
       -> [DTyVarBndrUnit]
       -> Maybe DKind
       -> [DCon]
       -> [DDerivClause]
       -> DDec)
    -> q Name
    -> q ([DTyVarBndrUnit]
          -> Maybe DKind -> [DCon] -> [DDerivClause] -> DDec)
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Name -> q Name
    forall a. a -> q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Name
    n
                           q ([DTyVarBndrUnit]
       -> Maybe DKind -> [DCon] -> [DDerivClause] -> DDec)
    -> q [DTyVarBndrUnit]
    -> q (Maybe DKind -> [DCon] -> [DDerivClause] -> DDec)
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [DTyVarBndrUnit] -> q [DTyVarBndrUnit]
    forall a. a -> q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [DTyVarBndrUnit]
    tvbs' q (Maybe DKind -> [DCon] -> [DDerivClause] -> DDec)
    -> q (Maybe DKind) -> q ([DCon] -> [DDerivClause] -> DDec)
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Type -> q DKind) -> Maybe Type -> q (Maybe DKind)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Maybe a -> m (Maybe b)
    mapM Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Maybe Type
    mk
                           q ([DCon] -> [DDerivClause] -> DDec)
    -> q [DCon] -> q ([DDerivClause] -> DDec)
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Con -> q [DCon]) -> [Con] -> q [DCon]
    forall (monad :: * -> *) monoid (t :: * -> *) a.
    (Monad monad, Monoid monoid, Traversable t) =>
    (a -> monad monoid) -> t a -> monad monoid
    concatMapM ([DTyVarBndrUnit] -> DKind -> Con -> q [DCon]
    forall (q :: * -> *).
    DsMonad q =>
    [DTyVarBndrUnit] -> DKind -> Con -> q [DCon]
    dsCon [DTyVarBndrUnit]
    h98_tvbs DKind
    h98_return_type) [Con]
    cons
                           q ([DDerivClause] -> DDec) -> q [DDerivClause] -> q DDec
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (DerivClause -> q DDerivClause)
    -> [DerivClause] -> q [DDerivClause]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM DerivClause -> q DDerivClause
    forall (q :: * -> *). DsMonad q => DerivClause -> q DDerivClause
    dsDerivClause [DerivClause]
    derivings)

    -- | Desugar a 'DataInstD' or a 'NewtypeInstD'.

    dsDataInstDec :: DsMonad q
                  => DataFlavor -> Cxt -> Name -> Maybe [TyVarBndrUnit] -> [TypeArg]
                  -> Maybe Kind -> [Con] -> [DerivingClause] -> q [DDec]
    dsDataInstDec :: forall (q :: * -> *).
    DsMonad q =>
    DataFlavor
    -> [Type]
    -> Name
    -> Maybe [TyVarBndrUnit]
    -> [TypeArg]
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> q [DDec]
    dsDataInstDec DataFlavor
    nd [Type]
    cxt Name
    n Maybe [TyVarBndrUnit]
    mtvbs [TypeArg]
    tys Maybe Type
    mk [Con]
    cons [DerivClause]
    derivings = do
      Maybe [DTyVarBndrUnit]
    mtvbs' <- ([TyVarBndrUnit] -> q [DTyVarBndrUnit])
    -> Maybe [TyVarBndrUnit] -> q (Maybe [DTyVarBndrUnit])
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Maybe a -> m (Maybe b)
    mapM ((TyVarBndrUnit -> q DTyVarBndrUnit)
    -> [TyVarBndrUnit] -> q [DTyVarBndrUnit]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM TyVarBndrUnit -> q DTyVarBndrUnit
    forall (q :: * -> *).
    DsMonad q =>
    TyVarBndrUnit -> q DTyVarBndrUnit
    dsTvbUnit) Maybe [TyVarBndrUnit]
    mtvbs
      [DTypeArg]
    tys'   <- (TypeArg -> q DTypeArg) -> [TypeArg] -> q [DTypeArg]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM TypeArg -> q DTypeArg
    forall (q :: * -> *). DsMonad q => TypeArg -> q DTypeArg
    dsTypeArg [TypeArg]
    tys
      let lhs' :: DKind
    lhs' = DKind -> [DTypeArg] -> DKind
    applyDType (Name -> DKind
    DConT Name
    n) [DTypeArg]
    tys'
          h98_tvbs :: [DTyVarBndrUnit]
    h98_tvbs =
            case (Maybe Type
    mk, Maybe [DTyVarBndrUnit]
    mtvbs') of
              -- If there's an explicit return kind, we're dealing with a

              -- GADT, so this argument goes unused in dsCon.

              (Just {}, Maybe [DTyVarBndrUnit]
    _)          -> [DTyVarBndrUnit]
    forall a. a
    unusedArgument
              -- H98, and there is an explicit `forall` in front. Just reuse the

              -- type variable binders from the `forall`.

              (Maybe Type
    Nothing, Just [DTyVarBndrUnit]
    tvbs') -> [DTyVarBndrUnit]
    tvbs'
              -- H98, and no explicit `forall`. Compute the bound variables

              -- manually.

              (Maybe Type
    Nothing, Maybe [DTyVarBndrUnit]
    Nothing)    -> [DTypeArg] -> [DTyVarBndrUnit]
    dataFamInstTvbs [DTypeArg]
    tys'
          h98_fam_inst_type :: DKind
    h98_fam_inst_type = Name -> [DTypeArg] -> DKind
    dataFamInstReturnType Name
    n [DTypeArg]
    tys'
      (DDec -> [DDec] -> [DDec]
    forall a. a -> [a] -> [a]
    :[]) (DDec -> [DDec]) -> q DDec -> q [DDec]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (DataFlavor
    -> [DKind]
    -> Maybe [DTyVarBndrUnit]
    -> DKind
    -> Maybe DKind
    -> [DCon]
    -> [DDerivClause]
    -> DDec
    DDataInstD DataFlavor
    nd ([DKind]
     -> Maybe [DTyVarBndrUnit]
     -> DKind
     -> Maybe DKind
     -> [DCon]
     -> [DDerivClause]
     -> DDec)
    -> q [DKind]
    -> q (Maybe [DTyVarBndrUnit]
          -> DKind -> Maybe DKind -> [DCon] -> [DDerivClause] -> DDec)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Type] -> q [DKind]
    forall (q :: * -> *). DsMonad q => [Type] -> q [DKind]
    dsCxt [Type]
    cxt q (Maybe [DTyVarBndrUnit]
       -> DKind -> Maybe DKind -> [DCon] -> [DDerivClause] -> DDec)
    -> q (Maybe [DTyVarBndrUnit])
    -> q (DKind -> Maybe DKind -> [DCon] -> [DDerivClause] -> DDec)
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Maybe [DTyVarBndrUnit] -> q (Maybe [DTyVarBndrUnit])
    forall a. a -> q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe [DTyVarBndrUnit]
    mtvbs'
                               q (DKind -> Maybe DKind -> [DCon] -> [DDerivClause] -> DDec)
    -> q DKind -> q (Maybe DKind -> [DCon] -> [DDerivClause] -> DDec)
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> DKind -> q DKind
    forall a. a -> q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure DKind
    lhs' q (Maybe DKind -> [DCon] -> [DDerivClause] -> DDec)
    -> q (Maybe DKind) -> q ([DCon] -> [DDerivClause] -> DDec)
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Type -> q DKind) -> Maybe Type -> q (Maybe DKind)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Maybe a -> m (Maybe b)
    mapM Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Maybe Type
    mk
                               q ([DCon] -> [DDerivClause] -> DDec)
    -> q [DCon] -> q ([DDerivClause] -> DDec)
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Con -> q [DCon]) -> [Con] -> q [DCon]
    forall (monad :: * -> *) monoid (t :: * -> *) a.
    (Monad monad, Monoid monoid, Traversable t) =>
    (a -> monad monoid) -> t a -> monad monoid
    concatMapM ([DTyVarBndrUnit] -> DKind -> Con -> q [DCon]
    forall (q :: * -> *).
    DsMonad q =>
    [DTyVarBndrUnit] -> DKind -> Con -> q [DCon]
    dsCon [DTyVarBndrUnit]
    h98_tvbs DKind
    h98_fam_inst_type) [Con]
    cons
                               q ([DDerivClause] -> DDec) -> q [DDerivClause] -> q DDec
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (DerivClause -> q DDerivClause)
    -> [DerivClause] -> q [DDerivClause]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM DerivClause -> q DDerivClause
    forall (q :: * -> *). DsMonad q => DerivClause -> q DDerivClause
    dsDerivClause [DerivClause]
    derivings)

    -- | Desugar a @FamilyResultSig@

    dsFamilyResultSig :: DsMonad q => FamilyResultSig -> q DFamilyResultSig
    dsFamilyResultSig :: forall (q :: * -> *).
    DsMonad q =>
    FamilyResultSig -> q DFamilyResultSig
    dsFamilyResultSig FamilyResultSig
    NoSig          = DFamilyResultSig -> q DFamilyResultSig
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return DFamilyResultSig
    DNoSig
    dsFamilyResultSig (KindSig Type
    k)    = DKind -> DFamilyResultSig
    DKindSig (DKind -> DFamilyResultSig) -> q DKind -> q DFamilyResultSig
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    k
    dsFamilyResultSig (TyVarSig TyVarBndrUnit
    tvb) = DTyVarBndrUnit -> DFamilyResultSig
    DTyVarSig (DTyVarBndrUnit -> DFamilyResultSig)
    -> q DTyVarBndrUnit -> q DFamilyResultSig
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TyVarBndrUnit -> q DTyVarBndrUnit
    forall (q :: * -> *).
    DsMonad q =>
    TyVarBndrUnit -> q DTyVarBndrUnit
    dsTvbUnit TyVarBndrUnit
    tvb

    -- | Desugar a @TypeFamilyHead@

    dsTypeFamilyHead :: DsMonad q => TypeFamilyHead -> q DTypeFamilyHead
    dsTypeFamilyHead :: forall (q :: * -> *).
    DsMonad q =>
    TypeFamilyHead -> q DTypeFamilyHead
    dsTypeFamilyHead (TypeFamilyHead Name
    n [TyVarBndrUnit]
    tvbs FamilyResultSig
    result Maybe InjectivityAnn
    inj)
      = Name
    -> [DTyVarBndrUnit]
    -> DFamilyResultSig
    -> Maybe InjectivityAnn
    -> DTypeFamilyHead
    DTypeFamilyHead Name
    n ([DTyVarBndrUnit]
     -> DFamilyResultSig -> Maybe InjectivityAnn -> DTypeFamilyHead)
    -> q [DTyVarBndrUnit]
    -> q (DFamilyResultSig -> Maybe InjectivityAnn -> DTypeFamilyHead)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (TyVarBndrUnit -> q DTyVarBndrUnit)
    -> [TyVarBndrUnit] -> q [DTyVarBndrUnit]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM TyVarBndrUnit -> q DTyVarBndrUnit
    forall (q :: * -> *).
    DsMonad q =>
    TyVarBndrUnit -> q DTyVarBndrUnit
    dsTvbUnit [TyVarBndrUnit]
    tvbs
                          q (DFamilyResultSig -> Maybe InjectivityAnn -> DTypeFamilyHead)
    -> q DFamilyResultSig
    -> q (Maybe InjectivityAnn -> DTypeFamilyHead)
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> FamilyResultSig -> q DFamilyResultSig
    forall (q :: * -> *).
    DsMonad q =>
    FamilyResultSig -> q DFamilyResultSig
    dsFamilyResultSig FamilyResultSig
    result
                          q (Maybe InjectivityAnn -> DTypeFamilyHead)
    -> q (Maybe InjectivityAnn) -> q DTypeFamilyHead
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Maybe InjectivityAnn -> q (Maybe InjectivityAnn)
    forall a. a -> q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe InjectivityAnn
    inj

    typeFamilyHeadName :: TypeFamilyHead -> Name
    typeFamilyHeadName :: TypeFamilyHead -> Name
    typeFamilyHeadName (TypeFamilyHead Name
    n [TyVarBndrUnit]
    _ FamilyResultSig
    _ Maybe InjectivityAnn
    _) = Name
    n

    -- | Desugar @Dec@s that can appear in a @let@ expression. See the

    -- documentation for 'dsLetDec' for an explanation of what the return type

    -- represents.

    dsLetDecs :: DsMonad q => [Dec] -> q ([DLetDec], DExp -> DExp)
    dsLetDecs :: forall (q :: * -> *).
    DsMonad q =>
    [Dec] -> q ([DLetDec], DExp -> DExp)
    dsLetDecs [Dec]
    decs = do
      ([[DLetDec]]
    let_decss, [DExp -> DExp]
    ip_binders) <- (Dec -> q ([DLetDec], DExp -> DExp))
    -> [Dec] -> q ([[DLetDec]], [DExp -> DExp])
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> m (b, c)) -> [a] -> m ([b], [c])
    mapAndUnzipM Dec -> q ([DLetDec], DExp -> DExp)
    forall (q :: * -> *).
    DsMonad q =>
    Dec -> q ([DLetDec], DExp -> DExp)
    dsLetDec [Dec]
    decs
      let let_decs :: [DLetDec]
          let_decs :: [DLetDec]
    let_decs = [[DLetDec]] -> [DLetDec]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[DLetDec]]
    let_decss

          ip_binder :: DExp -> DExp
          ip_binder :: DExp -> DExp
    ip_binder = ((DExp -> DExp) -> (DExp -> DExp) -> DExp -> DExp)
    -> (DExp -> DExp) -> [DExp -> DExp] -> DExp -> DExp
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (DExp -> DExp) -> (DExp -> DExp) -> DExp -> DExp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.) DExp -> DExp
    forall a. a -> a
    id [DExp -> DExp]
    ip_binders
      ([DLetDec], DExp -> DExp) -> q ([DLetDec], DExp -> DExp)
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([DLetDec]
    let_decs, DExp -> DExp
    ip_binder)

    -- | Desugar a single 'Dec' that can appear in a @let@ expression.

    -- This produces the following output:

    --

    -- * One or more 'DLetDec's (a single 'Dec' can produce multiple 'DLetDec's

    --   in the event of a value declaration that binds multiple things by way

    --   of pattern matching.

    --

    -- * A function of type @'DExp' -> 'DExp'@, which should be applied to the

    --   expression immediately following the 'DLetDec's. This function prepends

    --   binding forms for any implicit params that were bound in the argument

    --   'Dec'. (If no implicit params are bound, this is simply the 'id'

    --   function.)

    --

    -- For instance, if the argument to 'dsLetDec' is the @?x = 42@ part of this

    -- expression:

    --

    -- @

    -- let { ?x = 42 } in ?x

    -- @

    --

    -- Then the output is:

    --

    -- * @let new_x_val = 42@

    --

    -- * @\\z -> 'bindIP' \@\"x\" new_x_val z@

    --

    -- This way, the expression

    -- @let { new_x_val = 42 } in 'bindIP' \@"x" new_x_val ('ip' \@\"x\")@ can be

    -- formed. The implicit param binders always come after all the other

    -- 'DLetDec's to support parallel assignment of implicit params.

    dsLetDec :: DsMonad q => Dec -> q ([DLetDec], DExp -> DExp)
    dsLetDec :: forall (q :: * -> *).
    DsMonad q =>
    Dec -> q ([DLetDec], DExp -> DExp)
    dsLetDec (FunD Name
    name [Clause]
    clauses) = do
      [DClause]
    clauses' <- MatchContext -> [Clause] -> q [DClause]
    forall (q :: * -> *).
    DsMonad q =>
    MatchContext -> [Clause] -> q [DClause]
    dsClauses (Name -> MatchContext
    FunRhs Name
    name) [Clause]
    clauses
      ([DLetDec], DExp -> DExp) -> q ([DLetDec], DExp -> DExp)
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Name -> [DClause] -> DLetDec
    DFunD Name
    name [DClause]
    clauses'], DExp -> DExp
    forall a. a -> a
    id)
    dsLetDec (ValD Pat
    pat Body
    body [Dec]
    where_decs) = do
      (DPat
    pat', [(Name, DExp)]
    vars) <- Pat -> q (DPat, [(Name, DExp)])
    forall (q :: * -> *). DsMonad q => Pat -> q (DPat, [(Name, DExp)])
    dsPatX Pat
    pat
      DExp
    body' <- Body -> [Dec] -> DExp -> q DExp
    forall (q :: * -> *). DsMonad q => Body -> [Dec] -> DExp -> q DExp
    dsBody Body
    body [Dec]
    where_decs DExp
    error_exp
      let extras :: [DLetDec]
    extras = ([Name] -> [DExp] -> [DLetDec]) -> ([Name], [DExp]) -> [DLetDec]
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry ((Name -> DExp -> DLetDec) -> [Name] -> [DExp] -> [DLetDec]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (DPat -> DExp -> DLetDec
    DValD (DPat -> DExp -> DLetDec)
    -> (Name -> DPat) -> Name -> DExp -> DLetDec
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> DPat
    DVarP)) (([Name], [DExp]) -> [DLetDec]) -> ([Name], [DExp]) -> [DLetDec]
    forall a b. (a -> b) -> a -> b
    $ [(Name, DExp)] -> ([Name], [DExp])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(Name, DExp)]
    vars
      ([DLetDec], DExp -> DExp) -> q ([DLetDec], DExp -> DExp)
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DPat -> DExp -> DLetDec
    DValD DPat
    pat' DExp
    body' DLetDec -> [DLetDec] -> [DLetDec]
    forall a. a -> [a] -> [a]
    : [DLetDec]
    extras, DExp -> DExp
    forall a. a -> a
    id)
      where
        error_exp :: DExp
    error_exp = MatchContext -> DExp
    mkErrorMatchExpr (Pat -> MatchContext
    LetDecRhs Pat
    pat)
    dsLetDec (SigD Name
    name Type
    ty) = do
      DKind
    ty' <- Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    ty
      ([DLetDec], DExp -> DExp) -> q ([DLetDec], DExp -> DExp)
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Name -> DKind -> DLetDec
    DSigD Name
    name DKind
    ty'], DExp -> DExp
    forall a. a -> a
    id)
    dsLetDec (InfixD Fixity
    fixity Name
    name) = ([DLetDec], DExp -> DExp) -> q ([DLetDec], DExp -> DExp)
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Fixity -> Name -> DLetDec
    DInfixD Fixity
    fixity Name
    name], DExp -> DExp
    forall a. a -> a
    id)
    dsLetDec (PragmaD Pragma
    prag) = do
      DPragma
    prag' <- Pragma -> q DPragma
    forall (q :: * -> *). DsMonad q => Pragma -> q DPragma
    dsPragma Pragma
    prag
      ([DLetDec], DExp -> DExp) -> q ([DLetDec], DExp -> DExp)
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([DPragma -> DLetDec
    DPragmaD DPragma
    prag'], DExp -> DExp
    forall a. a -> a
    id)
    #if __GLASGOW_HASKELL__ >= 807
    dsLetDec (ImplicitParamBindD String
    n Exp
    e) = do
      Name
    new_n_name <- String -> q Name
    forall (q :: * -> *). Quasi q => String -> q Name
    qNewName (String -> q Name) -> String -> q Name
    forall a b. (a -> b) -> a -> b
    $ String
    "new_" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    n String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "_val"
      DExp
    e' <- Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    e
      let let_dec :: DLetDec
          let_dec :: DLetDec
    let_dec = DPat -> DExp -> DLetDec
    DValD (Name -> DPat
    DVarP Name
    new_n_name) DExp
    e'

          ip_binder :: DExp -> DExp
          ip_binder :: DExp -> DExp
    ip_binder = (Name -> DExp
    DVarE 'bindIP        DExp -> DKind -> DExp
    `DAppTypeE`
                         TyLit -> DKind
    DLitT (String -> TyLit
    StrTyLit String
    n) DExp -> DExp -> DExp
    `DAppE`
                         Name -> DExp
    DVarE Name
    new_n_name   DExp -> DExp -> DExp
    `DAppE`)
      ([DLetDec], DExp -> DExp) -> q ([DLetDec], DExp -> DExp)
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([DLetDec
    let_dec], DExp -> DExp
    ip_binder)
    #endif
    dsLetDec Dec
    _dec = String -> q ([DLetDec], DExp -> DExp)
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible String
    "Illegal declaration in let expression."

    -- | Desugar a single 'Dec' corresponding to something that could appear after

    -- the @let@ in a @let@ expression, but occurring at the top level. Because the

    -- 'Dec' occurs at the top level, there is nothing that would correspond to the

    -- @in ...@ part of the @let@ expression. As a consequence, this function does

    -- not return a @'DExp' -> 'DExp'@ function corresonding to implicit param

    -- binders (these cannot occur at the top level).

    dsTopLevelLetDec :: DsMonad q => Dec -> q [DDec]
    dsTopLevelLetDec :: forall (q :: * -> *). DsMonad q => Dec -> q [DDec]
    dsTopLevelLetDec = (([DLetDec], DExp -> DExp) -> [DDec])
    -> q ([DLetDec], DExp -> DExp) -> q [DDec]
    forall a b. (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((DLetDec -> DDec) -> [DLetDec] -> [DDec]
    forall a b. (a -> b) -> [a] -> [b]
    map DLetDec -> DDec
    DLetDec ([DLetDec] -> [DDec])
    -> (([DLetDec], DExp -> DExp) -> [DLetDec])
    -> ([DLetDec], DExp -> DExp)
    -> [DDec]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([DLetDec], DExp -> DExp) -> [DLetDec]
    forall a b. (a, b) -> a
    fst) (q ([DLetDec], DExp -> DExp) -> q [DDec])
    -> (Dec -> q ([DLetDec], DExp -> DExp)) -> Dec -> q [DDec]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Dec -> q ([DLetDec], DExp -> DExp)
    forall (q :: * -> *).
    DsMonad q =>
    Dec -> q ([DLetDec], DExp -> DExp)
    dsLetDec
      -- Note the use of fst above: we're silently throwing away any implicit param

      -- binders that dsLetDec returns, since there is invariant that there will be

      -- no implicit params in the first place.

    -- | Desugar a single @Con@.

    --

    -- Because we always desugar @Con@s to GADT syntax (see the documentation for

    -- 'DCon'), it is not always possible to desugar with just a 'Con' alone.

    -- For instance, we must desugar:

    --

    -- @

    -- data Foo a = forall b. MkFoo b

    -- @

    --

    -- To this:

    --

    -- @

    -- data Foo a :: Type where

    --   MkFoo :: forall a b. b -> Foo a

    -- @

    --

    -- If our only argument was @forall b. MkFoo b@, it would be somewhat awkward

    -- to figure out (1) what the set of universally quantified type variables

    -- (@[a]@) was, and (2) what the return type (@Foo a@) was. For this reason,

    -- we require passing these as arguments. (If we desugar an actual GADT

    -- constructor, these arguments are ignored.)

    dsCon :: DsMonad q
          => [DTyVarBndrUnit] -- ^ The universally quantified type variables

                              --   (used if desugaring a non-GADT constructor).

          -> DType            -- ^ The original data declaration's type

                              --   (used if desugaring a non-GADT constructor).

          -> Con -> q [DCon]
    dsCon :: forall (q :: * -> *).
    DsMonad q =>
    [DTyVarBndrUnit] -> DKind -> Con -> q [DCon]
    dsCon [DTyVarBndrUnit]
    univ_dtvbs DKind
    data_type Con
    con = do
      [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    dcons' <- Con
    -> q [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    forall (q :: * -> *).
    DsMonad q =>
    Con
    -> q [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    dsCon' Con
    con
      [DCon] -> q [DCon]
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([DCon] -> q [DCon]) -> [DCon] -> q [DCon]
    forall a b. (a -> b) -> a -> b
    $ (((Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)
      -> DCon)
     -> [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
     -> [DCon])
    -> [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    -> ((Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)
        -> DCon)
    -> [DCon]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ((Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)
     -> DCon)
    -> [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    -> [DCon]
    forall a b. (a -> b) -> [a] -> [b]
    map [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    dcons' (((Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)
      -> DCon)
     -> [DCon])
    -> ((Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)
        -> DCon)
    -> [DCon]
    forall a b. (a -> b) -> a -> b
    $ \(Name
    n, [DTyVarBndrSpec]
    dtvbs, [DKind]
    dcxt, DConFields
    fields, Maybe DKind
    m_gadt_type) ->
        case Maybe DKind
    m_gadt_type of
          Maybe DKind
    Nothing ->
            let ex_dtvbs :: [DTyVarBndrSpec]
    ex_dtvbs   = [DTyVarBndrSpec]
    dtvbs
                expl_dtvbs :: [DTyVarBndrSpec]
    expl_dtvbs = Specificity -> [DTyVarBndrUnit] -> [DTyVarBndrSpec]
    forall newFlag oldFlag.
    newFlag -> [DTyVarBndr oldFlag] -> [DTyVarBndr newFlag]
    changeDTVFlags Specificity
    SpecifiedSpec [DTyVarBndrUnit]
    univ_dtvbs [DTyVarBndrSpec] -> [DTyVarBndrSpec] -> [DTyVarBndrSpec]
    forall a. [a] -> [a] -> [a]
    ++
                             [DTyVarBndrSpec]
    ex_dtvbs
                impl_dtvbs :: [DTyVarBndrSpec]
    impl_dtvbs = Specificity -> [DTyVarBndrUnit] -> [DTyVarBndrSpec]
    forall newFlag oldFlag.
    newFlag -> [DTyVarBndr oldFlag] -> [DTyVarBndr newFlag]
    changeDTVFlags Specificity
    SpecifiedSpec ([DTyVarBndrUnit] -> [DTyVarBndrSpec])
    -> [DTyVarBndrUnit] -> [DTyVarBndrSpec]
    forall a b. (a -> b) -> a -> b
    $
                             [DKind] -> [DTyVarBndrUnit]
    toposortTyVarsOf ([DKind] -> [DTyVarBndrUnit]) -> [DKind] -> [DTyVarBndrUnit]
    forall a b. (a -> b) -> a -> b
    $ (DTyVarBndrSpec -> Maybe DKind) -> [DTyVarBndrSpec] -> [DKind]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe DTyVarBndrSpec -> Maybe DKind
    forall flag. DTyVarBndr flag -> Maybe DKind
    extractTvbKind [DTyVarBndrSpec]
    expl_dtvbs in
            [DTyVarBndrSpec] -> [DKind] -> Name -> DConFields -> DKind -> DCon
    DCon ([DTyVarBndrSpec]
    impl_dtvbs [DTyVarBndrSpec] -> [DTyVarBndrSpec] -> [DTyVarBndrSpec]
    forall a. [a] -> [a] -> [a]
    ++ [DTyVarBndrSpec]
    expl_dtvbs) [DKind]
    dcxt Name
    n DConFields
    fields DKind
    data_type
          Just DKind
    gadt_type ->
            let univ_ex_dtvbs :: [DTyVarBndrSpec]
    univ_ex_dtvbs = [DTyVarBndrSpec]
    dtvbs in
            [DTyVarBndrSpec] -> [DKind] -> Name -> DConFields -> DKind -> DCon
    DCon [DTyVarBndrSpec]
    univ_ex_dtvbs [DKind]
    dcxt Name
    n DConFields
    fields DKind
    gadt_type

    -- Desugar a Con in isolation. The meaning of the returned DTyVarBndrs changes

    -- depending on what the returned Maybe DType value is:

    --

    -- * If returning Just gadt_ty, then we've encountered a GadtC or RecGadtC,

    --   so the returned DTyVarBndrs are both the universally and existentially

    --   quantified tyvars.

    -- * If returning Nothing, we're dealing with a non-GADT constructor, so

    --   the returned DTyVarBndrs are the existentials only.

    dsCon' :: DsMonad q
           => Con -> q [(Name, [DTyVarBndrSpec], DCxt, DConFields, Maybe DType)]
    dsCon' :: forall (q :: * -> *).
    DsMonad q =>
    Con
    -> q [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    dsCon' (NormalC Name
    n [BangType]
    stys) = do
      [DBangType]
    dtys <- (BangType -> q DBangType) -> [BangType] -> q [DBangType]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM BangType -> q DBangType
    forall (q :: * -> *). DsMonad q => BangType -> q DBangType
    dsBangType [BangType]
    stys
      [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    -> q [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(Name
    n, [], [], Bool -> [DBangType] -> DConFields
    DNormalC Bool
    False [DBangType]
    dtys, Maybe DKind
    forall a. Maybe a
    Nothing)]
    dsCon' (RecC Name
    n [VarBangType]
    vstys) = do
      [DVarBangType]
    vdtys <- (VarBangType -> q DVarBangType)
    -> [VarBangType] -> q [DVarBangType]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM VarBangType -> q DVarBangType
    forall (q :: * -> *). DsMonad q => VarBangType -> q DVarBangType
    dsVarBangType [VarBangType]
    vstys
      [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    -> q [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(Name
    n, [], [], [DVarBangType] -> DConFields
    DRecC [DVarBangType]
    vdtys, Maybe DKind
    forall a. Maybe a
    Nothing)]
    dsCon' (InfixC BangType
    sty1 Name
    n BangType
    sty2) = do
      DBangType
    dty1 <- BangType -> q DBangType
    forall (q :: * -> *). DsMonad q => BangType -> q DBangType
    dsBangType BangType
    sty1
      DBangType
    dty2 <- BangType -> q DBangType
    forall (q :: * -> *). DsMonad q => BangType -> q DBangType
    dsBangType BangType
    sty2
      [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    -> q [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(Name
    n, [], [], Bool -> [DBangType] -> DConFields
    DNormalC Bool
    True [DBangType
    dty1, DBangType
    dty2], Maybe DKind
    forall a. Maybe a
    Nothing)]
    dsCon' (ForallC [TyVarBndr Specificity]
    tvbs [Type]
    cxt Con
    con) = do
      [DTyVarBndrSpec]
    dtvbs <- (TyVarBndr Specificity -> q DTyVarBndrSpec)
    -> [TyVarBndr Specificity] -> q [DTyVarBndrSpec]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM TyVarBndr Specificity -> q DTyVarBndrSpec
    forall (q :: * -> *).
    DsMonad q =>
    TyVarBndr Specificity -> q DTyVarBndrSpec
    dsTvbSpec [TyVarBndr Specificity]
    tvbs
      [DKind]
    dcxt <- [Type] -> q [DKind]
    forall (q :: * -> *). DsMonad q => [Type] -> q [DKind]
    dsCxt [Type]
    cxt
      [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    dcons' <- Con
    -> q [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    forall (q :: * -> *).
    DsMonad q =>
    Con
    -> q [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    dsCon' Con
    con
      [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    -> q [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
     -> q [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)])
    -> [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    -> q [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    forall a b. (a -> b) -> a -> b
    $ (((Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)
      -> (Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind))
     -> [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
     -> [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)])
    -> [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    -> ((Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)
        -> (Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind))
    -> [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ((Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)
     -> (Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind))
    -> [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    -> [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    forall a b. (a -> b) -> [a] -> [b]
    map [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    dcons' (((Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)
      -> (Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind))
     -> [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)])
    -> ((Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)
        -> (Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind))
    -> [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    forall a b. (a -> b) -> a -> b
    $ \(Name
    n, [DTyVarBndrSpec]
    dtvbs', [DKind]
    dcxt', DConFields
    fields, Maybe DKind
    m_gadt_type) ->
        (Name
    n, [DTyVarBndrSpec]
    dtvbs [DTyVarBndrSpec] -> [DTyVarBndrSpec] -> [DTyVarBndrSpec]
    forall a. [a] -> [a] -> [a]
    ++ [DTyVarBndrSpec]
    dtvbs', [DKind]
    dcxt [DKind] -> [DKind] -> [DKind]
    forall a. [a] -> [a] -> [a]
    ++ [DKind]
    dcxt', DConFields
    fields, Maybe DKind
    m_gadt_type)
    dsCon' (GadtC [Name]
    nms [BangType]
    btys Type
    rty) = do
      [DBangType]
    dbtys <- (BangType -> q DBangType) -> [BangType] -> q [DBangType]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM BangType -> q DBangType
    forall (q :: * -> *). DsMonad q => BangType -> q DBangType
    dsBangType [BangType]
    btys
      DKind
    drty  <- Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    rty
      [q (Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    -> q [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence ([q (Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
     -> q [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)])
    -> [q (Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    -> q [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    forall a b. (a -> b) -> a -> b
    $ ((Name
      -> q (Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind))
     -> [Name]
     -> [q (Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)])
    -> [Name]
    -> (Name
        -> q (Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind))
    -> [q (Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (Name
     -> q (Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind))
    -> [Name]
    -> [q (Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    forall a b. (a -> b) -> [a] -> [b]
    map [Name]
    nms ((Name
      -> q (Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind))
     -> [q (Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)])
    -> (Name
        -> q (Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind))
    -> [q (Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    forall a b. (a -> b) -> a -> b
    $ \Name
    nm -> do
        Maybe Fixity
    mbFi <- Name -> q (Maybe Fixity)
    forall (q :: * -> *). DsMonad q => Name -> q (Maybe Fixity)
    reifyFixityWithLocals Name
    nm
        -- A GADT data constructor is declared infix when these three

        -- properties hold:

        let decInfix :: Bool
    decInfix = String -> Bool
    isInfixDataCon (Name -> String
    nameBase Name
    nm) -- 1. Its name uses operator syntax

                                                    --    (e.g., (:*:))

                    Bool -> Bool -> Bool
    && [DBangType] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [DBangType]
    dbtys Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    2            -- 2. It has exactly two fields

                    Bool -> Bool -> Bool
    && Maybe Fixity -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe Fixity
    mbFi                  -- 3. It has a programmer-specified

                                                    --    fixity declaration

        (Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)
    -> q (Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name
    nm, [], [], Bool -> [DBangType] -> DConFields
    DNormalC Bool
    decInfix [DBangType]
    dbtys, DKind -> Maybe DKind
    forall a. a -> Maybe a
    Just DKind
    drty)
    dsCon' (RecGadtC [Name]
    nms [VarBangType]
    vbtys Type
    rty) = do
      [DVarBangType]
    dvbtys <- (VarBangType -> q DVarBangType)
    -> [VarBangType] -> q [DVarBangType]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM VarBangType -> q DVarBangType
    forall (q :: * -> *). DsMonad q => VarBangType -> q DVarBangType
    dsVarBangType [VarBangType]
    vbtys
      DKind
    drty   <- Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    rty
      [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    -> q [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
     -> q [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)])
    -> [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    -> q [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    forall a b. (a -> b) -> a -> b
    $ ((Name
      -> (Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind))
     -> [Name]
     -> [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)])
    -> [Name]
    -> (Name
        -> (Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind))
    -> [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (Name
     -> (Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind))
    -> [Name]
    -> [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    forall a b. (a -> b) -> [a] -> [b]
    map [Name]
    nms ((Name
      -> (Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind))
     -> [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)])
    -> (Name
        -> (Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind))
    -> [(Name, [DTyVarBndrSpec], [DKind], DConFields, Maybe DKind)]
    forall a b. (a -> b) -> a -> b
    $ \Name
    nm ->
        (Name
    nm, [], [], [DVarBangType] -> DConFields
    DRecC [DVarBangType]
    dvbtys, DKind -> Maybe DKind
    forall a. a -> Maybe a
    Just DKind
    drty)

    -- | Desugar a @BangType@.

    dsBangType :: DsMonad q => BangType -> q DBangType
    dsBangType :: forall (q :: * -> *). DsMonad q => BangType -> q DBangType
    dsBangType (Bang
    b, Type
    ty) = (Bang
    b, ) (DKind -> DBangType) -> q DKind -> q DBangType
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    ty

    -- | Desugar a @VarBangType@.

    dsVarBangType :: DsMonad q => VarBangType -> q DVarBangType
    dsVarBangType :: forall (q :: * -> *). DsMonad q => VarBangType -> q DVarBangType
    dsVarBangType (Name
    n, Bang
    b, Type
    ty) = (Name
    n, Bang
    b, ) (DKind -> DVarBangType) -> q DKind -> q DVarBangType
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    ty

    -- | Desugar a @Foreign@.

    dsForeign :: DsMonad q => Foreign -> q DForeign
    dsForeign :: forall (q :: * -> *). DsMonad q => Foreign -> q DForeign
    dsForeign (ImportF Callconv
    cc Safety
    safety String
    str Name
    n Type
    ty) = Callconv -> Safety -> String -> Name -> DKind -> DForeign
    DImportF Callconv
    cc Safety
    safety String
    str Name
    n (DKind -> DForeign) -> q DKind -> q DForeign
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    ty
    dsForeign (ExportF Callconv
    cc String
    str Name
    n Type
    ty)        = Callconv -> String -> Name -> DKind -> DForeign
    DExportF Callconv
    cc String
    str Name
    n (DKind -> DForeign) -> q DKind -> q DForeign
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    ty

    -- | Desugar a @Pragma@.

    dsPragma :: DsMonad q => Pragma -> q DPragma
    dsPragma :: forall (q :: * -> *). DsMonad q => Pragma -> q DPragma
    dsPragma (InlineP Name
    n Inline
    inl RuleMatch
    rm Phases
    phases)       = DPragma -> q DPragma
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DPragma -> q DPragma) -> DPragma -> q DPragma
    forall a b. (a -> b) -> a -> b
    $ Name -> Inline -> RuleMatch -> Phases -> DPragma
    DInlineP Name
    n Inline
    inl RuleMatch
    rm Phases
    phases
    dsPragma (SpecialiseP Name
    n Type
    ty Maybe Inline
    m_inl Phases
    phases) = Name -> DKind -> Maybe Inline -> Phases -> DPragma
    DSpecialiseP Name
    n (DKind -> Maybe Inline -> Phases -> DPragma)
    -> q DKind -> q (Maybe Inline -> Phases -> DPragma)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    ty
                                                              q (Maybe Inline -> Phases -> DPragma)
    -> q (Maybe Inline) -> q (Phases -> DPragma)
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Maybe Inline -> q (Maybe Inline)
    forall a. a -> q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Inline
    m_inl
                                                              q (Phases -> DPragma) -> q Phases -> q DPragma
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Phases -> q Phases
    forall a. a -> q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Phases
    phases
    dsPragma (SpecialiseInstP Type
    ty)            = DKind -> DPragma
    DSpecialiseInstP (DKind -> DPragma) -> q DKind -> q DPragma
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    ty
    #if __GLASGOW_HASKELL__ >= 807
    dsPragma (RuleP String
    str Maybe [TyVarBndrUnit]
    mtvbs [RuleBndr]
    rbs Exp
    lhs Exp
    rhs Phases
    phases)
                                             = String
    -> Maybe [DTyVarBndrUnit]
    -> [DRuleBndr]
    -> DExp
    -> DExp
    -> Phases
    -> DPragma
    DRuleP String
    str (Maybe [DTyVarBndrUnit]
     -> [DRuleBndr] -> DExp -> DExp -> Phases -> DPragma)
    -> q (Maybe [DTyVarBndrUnit])
    -> q ([DRuleBndr] -> DExp -> DExp -> Phases -> DPragma)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ([TyVarBndrUnit] -> q [DTyVarBndrUnit])
    -> Maybe [TyVarBndrUnit] -> q (Maybe [DTyVarBndrUnit])
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Maybe a -> m (Maybe b)
    mapM ((TyVarBndrUnit -> q DTyVarBndrUnit)
    -> [TyVarBndrUnit] -> q [DTyVarBndrUnit]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM TyVarBndrUnit -> q DTyVarBndrUnit
    forall (q :: * -> *).
    DsMonad q =>
    TyVarBndrUnit -> q DTyVarBndrUnit
    dsTvbUnit) Maybe [TyVarBndrUnit]
    mtvbs
                                                          q ([DRuleBndr] -> DExp -> DExp -> Phases -> DPragma)
    -> q [DRuleBndr] -> q (DExp -> DExp -> Phases -> DPragma)
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (RuleBndr -> q DRuleBndr) -> [RuleBndr] -> q [DRuleBndr]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM RuleBndr -> q DRuleBndr
    forall (q :: * -> *). DsMonad q => RuleBndr -> q DRuleBndr
    dsRuleBndr [RuleBndr]
    rbs
                                                          q (DExp -> DExp -> Phases -> DPragma)
    -> q DExp -> q (DExp -> Phases -> DPragma)
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    lhs
                                                          q (DExp -> Phases -> DPragma) -> q DExp -> q (Phases -> DPragma)
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    rhs
                                                          q (Phases -> DPragma) -> q Phases -> q DPragma
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Phases -> q Phases
    forall a. a -> q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Phases
    phases
    #else
    dsPragma (RuleP str rbs lhs rhs phases)  = DRuleP str Nothing
                                                          <$> mapM dsRuleBndr rbs
                                                          <*> dsExp lhs
                                                          <*> dsExp rhs
                                                          <*> pure phases
    #endif
    dsPragma (AnnP AnnTarget
    target Exp
    exp)               = AnnTarget -> DExp -> DPragma
    DAnnP AnnTarget
    target (DExp -> DPragma) -> q DExp -> q DPragma
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    exp
    dsPragma (LineP Int
    n String
    str)                   = DPragma -> q DPragma
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DPragma -> q DPragma) -> DPragma -> q DPragma
    forall a b. (a -> b) -> a -> b
    $ Int -> String -> DPragma
    DLineP Int
    n String
    str
    #if __GLASGOW_HASKELL__ >= 801
    dsPragma (CompleteP [Name]
    cls Maybe Name
    mty)             = DPragma -> q DPragma
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DPragma -> q DPragma) -> DPragma -> q DPragma
    forall a b. (a -> b) -> a -> b
    $ [Name] -> Maybe Name -> DPragma
    DCompleteP [Name]
    cls Maybe Name
    mty
    #endif
    #if __GLASGOW_HASKELL__ >= 903
    dsPragma (OpaqueP Name
    n)                     = DPragma -> q DPragma
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DPragma -> q DPragma) -> DPragma -> q DPragma
    forall a b. (a -> b) -> a -> b
    $ Name -> DPragma
    DOpaqueP Name
    n
    #endif

    -- | Desugar a @RuleBndr@.

    dsRuleBndr :: DsMonad q => RuleBndr -> q DRuleBndr
    dsRuleBndr :: forall (q :: * -> *). DsMonad q => RuleBndr -> q DRuleBndr
    dsRuleBndr (RuleVar Name
    n)         = DRuleBndr -> q DRuleBndr
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DRuleBndr -> q DRuleBndr) -> DRuleBndr -> q DRuleBndr
    forall a b. (a -> b) -> a -> b
    $ Name -> DRuleBndr
    DRuleVar Name
    n
    dsRuleBndr (TypedRuleVar Name
    n Type
    ty) = Name -> DKind -> DRuleBndr
    DTypedRuleVar Name
    n (DKind -> DRuleBndr) -> q DKind -> q DRuleBndr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    ty

    #if __GLASGOW_HASKELL__ >= 807
    -- | Desugar a @TySynEqn@. (Available only with GHC 7.8+)

    --

    -- This requires a 'Name' as an argument since 'TySynEqn's did not have

    -- this information prior to GHC 8.8.

    dsTySynEqn :: DsMonad q => Name -> TySynEqn -> q DTySynEqn
    dsTySynEqn :: forall (q :: * -> *). DsMonad q => Name -> TySynEqn -> q DTySynEqn
    dsTySynEqn Name
    _ (TySynEqn Maybe [TyVarBndrUnit]
    mtvbs Type
    lhs Type
    rhs) =
      Maybe [DTyVarBndrUnit] -> DKind -> DKind -> DTySynEqn
    DTySynEqn (Maybe [DTyVarBndrUnit] -> DKind -> DKind -> DTySynEqn)
    -> q (Maybe [DTyVarBndrUnit]) -> q (DKind -> DKind -> DTySynEqn)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ([TyVarBndrUnit] -> q [DTyVarBndrUnit])
    -> Maybe [TyVarBndrUnit] -> q (Maybe [DTyVarBndrUnit])
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Maybe a -> m (Maybe b)
    mapM ((TyVarBndrUnit -> q DTyVarBndrUnit)
    -> [TyVarBndrUnit] -> q [DTyVarBndrUnit]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM TyVarBndrUnit -> q DTyVarBndrUnit
    forall (q :: * -> *).
    DsMonad q =>
    TyVarBndrUnit -> q DTyVarBndrUnit
    dsTvbUnit) Maybe [TyVarBndrUnit]
    mtvbs q (DKind -> DKind -> DTySynEqn)
    -> q DKind -> q (DKind -> DTySynEqn)
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    lhs q (DKind -> DTySynEqn) -> q DKind -> q DTySynEqn
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    rhs
    #else
    -- | Desugar a @TySynEqn@. (Available only with GHC 7.8+)

    dsTySynEqn :: DsMonad q => Name -> TySynEqn -> q DTySynEqn
    dsTySynEqn n (TySynEqn lhss rhs) = do
      lhss' <- mapM dsType lhss
      let lhs' = applyDType (DConT n) $ map DTANormal lhss'
      DTySynEqn Nothing lhs' <$> dsType rhs
    #endif

    -- | Desugar clauses to a function definition

    dsClauses :: DsMonad q
              => MatchContext -- ^ The context in which the clauses arise

              -> [Clause]     -- ^ Clauses to desugar

              -> q [DClause]
    dsClauses :: forall (q :: * -> *).
    DsMonad q =>
    MatchContext -> [Clause] -> q [DClause]
    dsClauses MatchContext
    _ [] = [DClause] -> q [DClause]
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
    dsClauses MatchContext
    mc (Clause [Pat]
    pats (NormalB Exp
    exp) [Dec]
    where_decs : [Clause]
    rest) = do
      -- this case is necessary to maintain the roundtrip property.

      [DClause]
    rest' <- MatchContext -> [Clause] -> q [DClause]
    forall (q :: * -> *).
    DsMonad q =>
    MatchContext -> [Clause] -> q [DClause]
    dsClauses MatchContext
    mc [Clause]
    rest
      DExp
    exp' <- Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    exp
      ([DLetDec]
    where_decs', DExp -> DExp
    ip_binder) <- [Dec] -> q ([DLetDec], DExp -> DExp)
    forall (q :: * -> *).
    DsMonad q =>
    [Dec] -> q ([DLetDec], DExp -> DExp)
    dsLetDecs [Dec]
    where_decs
      let exp_with_wheres :: DExp
    exp_with_wheres = [DLetDec] -> DExp -> DExp
    maybeDLetE [DLetDec]
    where_decs' (DExp -> DExp
    ip_binder DExp
    exp')
      ([DPat]
    pats', DExp
    exp'') <- [Pat] -> DExp -> q ([DPat], DExp)
    forall (q :: * -> *).
    DsMonad q =>
    [Pat] -> DExp -> q ([DPat], DExp)
    dsPatsOverExp [Pat]
    pats DExp
    exp_with_wheres
      [DClause] -> q [DClause]
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([DClause] -> q [DClause]) -> [DClause] -> q [DClause]
    forall a b. (a -> b) -> a -> b
    $ [DPat] -> DExp -> DClause
    DClause [DPat]
    pats' DExp
    exp'' DClause -> [DClause] -> [DClause]
    forall a. a -> [a] -> [a]
    : [DClause]
    rest'
    dsClauses MatchContext
    mc clauses :: [Clause]
    clauses@(Clause [Pat]
    outer_pats Body
    _ [Dec]
    _ : [Clause]
    _) = do
      [Name]
    arg_names <- Int -> q Name -> q [Name]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM ([Pat] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Pat]
    outer_pats) (String -> q Name
    forall (q :: * -> *). Quasi q => String -> q Name
    newUniqueName String
    "arg")
      let scrutinee :: DExp
    scrutinee = [DExp] -> DExp
    mkUnboxedTupleDExp ((Name -> DExp) -> [Name] -> [DExp]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> DExp
    DVarE [Name]
    arg_names)
      DClause
    clause <- [DPat] -> DExp -> DClause
    DClause ((Name -> DPat) -> [Name] -> [DPat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> DPat
    DVarP [Name]
    arg_names) (DExp -> DClause) -> q DExp -> q DClause
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                  (DExp -> [DMatch] -> DExp
    DCaseE DExp
    scrutinee ([DMatch] -> DExp) -> q [DMatch] -> q DExp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Clause -> [DMatch] -> q [DMatch])
    -> [DMatch] -> [Clause] -> q [DMatch]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> b -> m b) -> b -> t a -> m b
    foldrM (DExp -> Clause -> [DMatch] -> q [DMatch]
    forall (q :: * -> *).
    DsMonad q =>
    DExp -> Clause -> [DMatch] -> q [DMatch]
    clause_to_dmatch DExp
    scrutinee) [] [Clause]
    clauses)
      [DClause] -> q [DClause]
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [DClause
    clause]
      where
        clause_to_dmatch :: DsMonad q => DExp -> Clause -> [DMatch] -> q [DMatch]
        clause_to_dmatch :: forall (q :: * -> *).
    DsMonad q =>
    DExp -> Clause -> [DMatch] -> q [DMatch]
    clause_to_dmatch DExp
    scrutinee (Clause [Pat]
    pats Body
    body [Dec]
    where_decs) [DMatch]
    failure_matches = do
          let failure_exp :: DExp
    failure_exp = MatchContext -> DExp -> [DMatch] -> DExp
    maybeDCaseE MatchContext
    mc DExp
    scrutinee [DMatch]
    failure_matches
          DExp
    exp <- Body -> [Dec] -> DExp -> q DExp
    forall (q :: * -> *). DsMonad q => Body -> [Dec] -> DExp -> q DExp
    dsBody Body
    body [Dec]
    where_decs DExp
    failure_exp
          ([DPat]
    pats', DExp
    exp') <- [Pat] -> DExp -> q ([DPat], DExp)
    forall (q :: * -> *).
    DsMonad q =>
    [Pat] -> DExp -> q ([DPat], DExp)
    dsPatsOverExp [Pat]
    pats DExp
    exp
          Bool
    uni_pats <- (All -> Bool) -> q All -> q Bool
    forall a b. (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap All -> Bool
    getAll (q All -> q Bool) -> q All -> q Bool
    forall a b. (a -> b) -> a -> b
    $ (DPat -> q All) -> [DPat] -> q All
    forall (monad :: * -> *) monoid (t :: * -> *) a.
    (Monad monad, Monoid monoid, Traversable t) =>
    (a -> monad monoid) -> t a -> monad monoid
    concatMapM ((Bool -> All) -> q Bool -> q All
    forall a b. (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Bool -> All
    All (q Bool -> q All) -> (DPat -> q Bool) -> DPat -> q All
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DPat -> q Bool
    forall (q :: * -> *). DsMonad q => DPat -> q Bool
    isUniversalPattern) [DPat]
    pats'
          let match :: DMatch
    match = DPat -> DExp -> DMatch
    DMatch ([DPat] -> DPat
    mkUnboxedTupleDPat [DPat]
    pats') DExp
    exp'
          if Bool
    uni_pats
          then [DMatch] -> q [DMatch]
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [DMatch
    match]
          else [DMatch] -> q [DMatch]
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DMatch
    match DMatch -> [DMatch] -> [DMatch]
    forall a. a -> [a] -> [a]
    : [DMatch]
    failure_matches)

    -- | The context of a pattern match. This is used to produce

    -- @Non-exhaustive patterns in...@ messages that are tailored to specific

    -- situations. Compare this to GHC's @HsMatchContext@ data type

    -- (https://gitlab.haskell.org/ghc/ghc/-/blob/81cf52bb301592ff3d043d03eb9a0d547891a3e1/compiler/Language/Haskell/Syntax/Expr.hs#L1662-1695),

    -- from which the @MatchContext@ data type takes inspiration.

    data MatchContext
      = FunRhs Name
        -- ^ A pattern matching on an argument of a function binding

      | LetDecRhs Pat
        -- ^ A pattern in a @let@ declaration

      | RecUpd
        -- ^ A record update

      | MultiWayIfAlt
        -- ^ Guards in a multi-way if alternative

      | CaseAlt
        -- ^ Patterns and guards in a case alternative

    -- | Construct an expression that throws an error when encountering a pattern

    -- at runtime that is not covered by pattern matching.

    mkErrorMatchExpr :: MatchContext -> DExp
    mkErrorMatchExpr :: MatchContext -> DExp
    mkErrorMatchExpr MatchContext
    mc =
      DExp -> DExp -> DExp
    DAppE (Name -> DExp
    DVarE 'error) (Lit -> DExp
    DLitE (String -> Lit
    StringL (String
    "Non-exhaustive patterns in " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    pp_context)))
      where
        pp_context :: String
    pp_context =
          case MatchContext
    mc of
            FunRhs Name
    n      -> Name -> String
    forall a. Show a => a -> String
    show Name
    n
            LetDecRhs Pat
    pat -> Pat -> String
    forall a. Ppr a => a -> String
    pprint Pat
    pat
            MatchContext
    RecUpd        -> String
    "record update"
            MatchContext
    MultiWayIfAlt -> String
    "multi-way if"
            MatchContext
    CaseAlt       -> String
    "case"

    -- | Desugar a type

    dsType :: DsMonad q => Type -> q DType
    #if __GLASGOW_HASKELL__ >= 900
    -- See Note [Gracefully handling linear types]

    dsType :: forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType (Type
    MulArrowT `AppT` Type
    _) = DKind -> q DKind
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return DKind
    DArrowT
    dsType Type
    MulArrowT = String -> q DKind
    forall a. String -> q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Cannot desugar exotic uses of linear types."
    #endif
    dsType (ForallT [TyVarBndr Specificity]
    tvbs [Type]
    preds Type
    ty) =
      DForallTelescope -> [DKind] -> DKind -> DKind
    mkDForallConstrainedT (DForallTelescope -> [DKind] -> DKind -> DKind)
    -> q DForallTelescope -> q ([DKind] -> DKind -> DKind)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ([DTyVarBndrSpec] -> DForallTelescope
    DForallInvis ([DTyVarBndrSpec] -> DForallTelescope)
    -> q [DTyVarBndrSpec] -> q DForallTelescope
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (TyVarBndr Specificity -> q DTyVarBndrSpec)
    -> [TyVarBndr Specificity] -> q [DTyVarBndrSpec]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM TyVarBndr Specificity -> q DTyVarBndrSpec
    forall (q :: * -> *).
    DsMonad q =>
    TyVarBndr Specificity -> q DTyVarBndrSpec
    dsTvbSpec [TyVarBndr Specificity]
    tvbs)
                            q ([DKind] -> DKind -> DKind) -> q [DKind] -> q (DKind -> DKind)
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [Type] -> q [DKind]
    forall (q :: * -> *). DsMonad q => [Type] -> q [DKind]
    dsCxt [Type]
    preds q (DKind -> DKind) -> q DKind -> q DKind
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    ty
    dsType (AppT Type
    t1 Type
    t2) = DKind -> DKind -> DKind
    DAppT (DKind -> DKind -> DKind) -> q DKind -> q (DKind -> DKind)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    t1 q (DKind -> DKind) -> q DKind -> q DKind
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    t2
    dsType (SigT Type
    ty Type
    ki) = DKind -> DKind -> DKind
    DSigT (DKind -> DKind -> DKind) -> q DKind -> q (DKind -> DKind)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    ty q (DKind -> DKind) -> q DKind -> q DKind
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    ki
    dsType (VarT Name
    name) = DKind -> q DKind
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DKind -> q DKind) -> DKind -> q DKind
    forall a b. (a -> b) -> a -> b
    $ Name -> DKind
    DVarT Name
    name
    dsType (ConT Name
    name) = DKind -> q DKind
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DKind -> q DKind) -> DKind -> q DKind
    forall a b. (a -> b) -> a -> b
    $ Name -> DKind
    DConT Name
    name
    -- The PromotedT case is identical to the ConT case above.

    -- See Note [Desugaring promoted types].

    dsType (PromotedT Name
    name) = DKind -> q DKind
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DKind -> q DKind) -> DKind -> q DKind
    forall a b. (a -> b) -> a -> b
    $ Name -> DKind
    DConT Name
    name
    dsType (TupleT Int
    n) = DKind -> q DKind
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DKind -> q DKind) -> DKind -> q DKind
    forall a b. (a -> b) -> a -> b
    $ Name -> DKind
    DConT (Int -> Name
    tupleTypeName Int
    n)
    dsType (UnboxedTupleT Int
    n) = DKind -> q DKind
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DKind -> q DKind) -> DKind -> q DKind
    forall a b. (a -> b) -> a -> b
    $ Name -> DKind
    DConT (Int -> Name
    unboxedTupleTypeName Int
    n)
    dsType Type
    ArrowT = DKind -> q DKind
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return DKind
    DArrowT
    dsType Type
    ListT = DKind -> q DKind
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DKind -> q DKind) -> DKind -> q DKind
    forall a b. (a -> b) -> a -> b
    $ Name -> DKind
    DConT ''[]
    dsType (PromotedTupleT Int
    n) = DKind -> q DKind
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DKind -> q DKind) -> DKind -> q DKind
    forall a b. (a -> b) -> a -> b
    $ Name -> DKind
    DConT (Int -> Name
    tupleDataName Int
    n)
    dsType Type
    PromotedNilT = DKind -> q DKind
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DKind -> q DKind) -> DKind -> q DKind
    forall a b. (a -> b) -> a -> b
    $ Name -> DKind
    DConT '[]
    dsType Type
    PromotedConsT = DKind -> q DKind
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DKind -> q DKind) -> DKind -> q DKind
    forall a b. (a -> b) -> a -> b
    $ Name -> DKind
    DConT '(:)
    dsType Type
    StarT = DKind -> q DKind
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DKind -> q DKind) -> DKind -> q DKind
    forall a b. (a -> b) -> a -> b
    $ Name -> DKind
    DConT Name
    typeKindName
    dsType Type
    ConstraintT = DKind -> q DKind
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DKind -> q DKind) -> DKind -> q DKind
    forall a b. (a -> b) -> a -> b
    $ Name -> DKind
    DConT ''Constraint
    dsType (LitT TyLit
    lit) = DKind -> q DKind
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DKind -> q DKind) -> DKind -> q DKind
    forall a b. (a -> b) -> a -> b
    $ TyLit -> DKind
    DLitT TyLit
    lit
    dsType Type
    EqualityT = DKind -> q DKind
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DKind -> q DKind) -> DKind -> q DKind
    forall a b. (a -> b) -> a -> b
    $ Name -> DKind
    DConT ''(~)
    dsType (InfixT Type
    t1 Name
    n Type
    t2) = Type -> Name -> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> Name -> Type -> q DKind
    dsInfixT Type
    t1 Name
    n Type
    t2
    dsType (UInfixT{}) = q DKind
    forall (m :: * -> *) a. MonadFail m => m a
    dsUInfixT
    dsType (ParensT Type
    t) = Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    t
    dsType Type
    WildCardT = DKind -> q DKind
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return DKind
    DWildCardT
    #if __GLASGOW_HASKELL__ >= 801
    dsType (UnboxedSumT Int
    arity) = DKind -> q DKind
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DKind -> q DKind) -> DKind -> q DKind
    forall a b. (a -> b) -> a -> b
    $ Name -> DKind
    DConT (Int -> Name
    unboxedSumTypeName Int
    arity)
    #endif
    #if __GLASGOW_HASKELL__ >= 807
    dsType (AppKindT Type
    t Type
    k) = DKind -> DKind -> DKind
    DAppKindT (DKind -> DKind -> DKind) -> q DKind -> q (DKind -> DKind)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    t q (DKind -> DKind) -> q DKind -> q DKind
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    k
    dsType (ImplicitParamT String
    n Type
    t) = do
      DKind
    t' <- Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    t
      DKind -> q DKind
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DKind -> q DKind) -> DKind -> q DKind
    forall a b. (a -> b) -> a -> b
    $ Name -> DKind
    DConT ''IP DKind -> DKind -> DKind
    `DAppT` TyLit -> DKind
    DLitT (String -> TyLit
    StrTyLit String
    n) DKind -> DKind -> DKind
    `DAppT` DKind
    t'
    #endif
    #if __GLASGOW_HASKELL__ >= 809
    dsType (ForallVisT [TyVarBndrUnit]
    tvbs Type
    ty) =
      DForallTelescope -> DKind -> DKind
    DForallT (DForallTelescope -> DKind -> DKind)
    -> q DForallTelescope -> q (DKind -> DKind)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ([DTyVarBndrUnit] -> DForallTelescope
    DForallVis ([DTyVarBndrUnit] -> DForallTelescope)
    -> q [DTyVarBndrUnit] -> q DForallTelescope
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (TyVarBndrUnit -> q DTyVarBndrUnit)
    -> [TyVarBndrUnit] -> q [DTyVarBndrUnit]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM TyVarBndrUnit -> q DTyVarBndrUnit
    forall (q :: * -> *).
    DsMonad q =>
    TyVarBndrUnit -> q DTyVarBndrUnit
    dsTvbUnit [TyVarBndrUnit]
    tvbs) q (DKind -> DKind) -> q DKind -> q DKind
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    ty
    #endif
    #if __GLASGOW_HASKELL__ >= 903
    -- The PromotedInfixT case is identical to the InfixT case above.

    -- See Note [Desugaring promoted types].

    dsType (PromotedInfixT Type
    t1 Name
    n Type
    t2) = Type -> Name -> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> Name -> Type -> q DKind
    dsInfixT Type
    t1 Name
    n Type
    t2
    dsType PromotedUInfixT{} = q DKind
    forall (m :: * -> *) a. MonadFail m => m a
    dsUInfixT
    #endif

    #if __GLASGOW_HASKELL__ >= 900
    -- | Desugar a 'TyVarBndr'.

    dsTvb :: DsMonad q => TyVarBndr_ flag -> q (DTyVarBndr flag)
    dsTvb :: forall (q :: * -> *) flag.
    DsMonad q =>
    TyVarBndr_ flag -> q (DTyVarBndr flag)
    dsTvb (PlainTV Name
    n flag
    flag)    = DTyVarBndr flag -> q (DTyVarBndr flag)
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DTyVarBndr flag -> q (DTyVarBndr flag))
    -> DTyVarBndr flag -> q (DTyVarBndr flag)
    forall a b. (a -> b) -> a -> b
    $ Name -> flag -> DTyVarBndr flag
    forall flag. Name -> flag -> DTyVarBndr flag
    DPlainTV Name
    n flag
    flag
    dsTvb (KindedTV Name
    n flag
    flag Type
    k) = Name -> flag -> DKind -> DTyVarBndr flag
    forall flag. Name -> flag -> DKind -> DTyVarBndr flag
    DKindedTV Name
    n flag
    flag (DKind -> DTyVarBndr flag) -> q DKind -> q (DTyVarBndr flag)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    k
    #else
    -- | Desugar a 'TyVarBndr' with a particular @flag@.

    dsTvb :: DsMonad q => flag -> TyVarBndr -> q (DTyVarBndr flag)
    dsTvb flag (PlainTV n)    = return $ DPlainTV n flag
    dsTvb flag (KindedTV n k) = DKindedTV n flag <$> dsType k
    #endif

    {-
    Note [Gracefully handling linear types]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Per the README, th-desugar does not currently support linear types.
    Unfortunately, we cannot simply reject all occurrences of
    multiplicity-polymorphic function arrows (i.e., MulArrowT), as it is possible
    for "non-linear" code to contain them when reified. For example, the type of a
    Haskell98 data constructor such as `Just` will be reified as

      a #-> Maybe a

    In terms of the TH AST, that is:

      MulArrowT `AppT` PromotedConT 'One `AppT` VarT a `AppT` (ConT ''Maybe `AppT` VarT a)

    Therefore, in order to desugar these sorts of types, we have to do *something*
    with MulArrowT. The approach that th-desugar takes is to pretend that all
    multiplicity-polymorphic function arrows are actually ordinary function arrows
    (->) when desugaring types. In other words, whenever th-desugar sees
    (MulArrowT `AppT` m), for any particular value of `m`, it will turn it into
    DArrowT.

    This approach is enough to gracefully handle most uses of MulArrowT, as TH
    reification always generates MulArrowT applied to some particular multiplicity
    (as of GHC 9.0, at least). It's conceivable that some wily user could manually
    construct a TH AST containing MulArrowT in a different position, but since this
    situation is rare, we simply throw an error in such cases.

    We adopt a similar stance in L.H.TH.Desugar.Reify when locally reifying the
    types of data constructors: since th-desugar doesn't currently support linear
    types, we pretend as if MulArrowT does not exist. As a result, the type of
    `Just` would be locally reified as `a -> Maybe a`, not `a #-> Maybe a`.

    Note [Desugaring promoted types]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ConT and PromotedT both contain Names as a payload, the only difference being
    that PromotedT is intended to refer exclusively to promoted data constructor
    Names, while ConT can refer to both type and data constructor Names alike.

    When desugaring a PromotedT, we make the assumption that the TH quoting
    mechanism produced the correct Name and wrap the name in a DConT. In other
    words, we desugar ConT and PromotedT identically. This assumption about
    PromotedT may not always be correct, however. Consider this example:

      data a :+: b = Inl a | Inr b
      data Exp a = ... | Exp :+: Exp

    How should `PromotedT (mkName ":+:")` be desugared? Morally, it ought to be
    desugared to a DConT that contains (:+:) the data constructor, not (:+:) the
    type constructor. Deciding between the two is not always straightforward,
    however. We could use the `lookupDataName` function to try and distinguish
    between the two Names, but this may not necessarily work. This is because the
    Name passed to `lookupDataName` could have its original module attached, which
    may not be in scope.

    Long story short: we make things simple (albeit slightly wrong) by desugaring
    ConT and PromotedT identically. We'll wait for someone to complain about the
    wrongness of this approach before researching a more accurate solution.

    Note that the same considerations also apply to InfixT and PromotedInfixT,
    which are also desugared identically.
    -}

    -- | Desugar an infix 'Type'.

    dsInfixT :: DsMonad q => Type -> Name -> Type -> q DType
    dsInfixT :: forall (q :: * -> *). DsMonad q => Type -> Name -> Type -> q DKind
    dsInfixT Type
    t1 Name
    n Type
    t2 = DKind -> DKind -> DKind
    DAppT (DKind -> DKind -> DKind) -> q DKind -> q (DKind -> DKind)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (DKind -> DKind -> DKind
    DAppT (Name -> DKind
    DConT Name
    n) (DKind -> DKind) -> q DKind -> q DKind
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    t1) q (DKind -> DKind) -> q DKind -> q DKind
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    t2

    -- | We cannot desugar unresolved infix operators, so fail if we encounter one.

    dsUInfixT :: Fail.MonadFail m => m a
    dsUInfixT :: forall (m :: * -> *) a. MonadFail m => m a
    dsUInfixT = String -> m a
    forall a. String -> m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Cannot desugar unresolved infix operators."

    -- | Desugar a 'TyVarBndrSpec'.

    dsTvbSpec :: DsMonad q => TyVarBndrSpec -> q DTyVarBndrSpec
    #if __GLASGOW_HASKELL__ >= 900
    dsTvbSpec :: forall (q :: * -> *).
    DsMonad q =>
    TyVarBndr Specificity -> q DTyVarBndrSpec
    dsTvbSpec = TyVarBndr Specificity -> q DTyVarBndrSpec
    forall (q :: * -> *) flag.
    DsMonad q =>
    TyVarBndr_ flag -> q (DTyVarBndr flag)
    dsTvb
    #else
    dsTvbSpec = dsTvb SpecifiedSpec
    #endif

    -- | Desugar a 'TyVarBndrUnit'.

    dsTvbUnit :: DsMonad q => TyVarBndrUnit -> q DTyVarBndrUnit
    #if __GLASGOW_HASKELL__ >= 900
    dsTvbUnit :: forall (q :: * -> *).
    DsMonad q =>
    TyVarBndrUnit -> q DTyVarBndrUnit
    dsTvbUnit = TyVarBndrUnit -> q DTyVarBndrUnit
    forall (q :: * -> *) flag.
    DsMonad q =>
    TyVarBndr_ flag -> q (DTyVarBndr flag)
    dsTvb
    #else
    dsTvbUnit = dsTvb ()
    #endif

    -- | Desugar a @Cxt@

    dsCxt :: DsMonad q => Cxt -> q DCxt
    dsCxt :: forall (q :: * -> *). DsMonad q => [Type] -> q [DKind]
    dsCxt = (Type -> q [DKind]) -> [Type] -> q [DKind]
    forall (monad :: * -> *) monoid (t :: * -> *) a.
    (Monad monad, Monoid monoid, Traversable t) =>
    (a -> monad monoid) -> t a -> monad monoid
    concatMapM Type -> q [DKind]
    forall (q :: * -> *). DsMonad q => Type -> q [DKind]
    dsPred

    #if __GLASGOW_HASKELL__ >= 801
    -- | A backwards-compatible type synonym for the thing representing a single

    -- derived class in a @deriving@ clause. (This is a @DerivClause@, @Pred@, or

    -- @Name@ depending on the GHC version.)

    type DerivingClause = DerivClause

    -- | Desugar a @DerivingClause@.

    dsDerivClause :: DsMonad q => DerivingClause -> q DDerivClause
    dsDerivClause :: forall (q :: * -> *). DsMonad q => DerivClause -> q DDerivClause
    dsDerivClause (DerivClause Maybe DerivStrategy
    mds [Type]
    cxt) =
      Maybe DDerivStrategy -> [DKind] -> DDerivClause
    DDerivClause (Maybe DDerivStrategy -> [DKind] -> DDerivClause)
    -> q (Maybe DDerivStrategy) -> q ([DKind] -> DDerivClause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (DerivStrategy -> q DDerivStrategy)
    -> Maybe DerivStrategy -> q (Maybe DDerivStrategy)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Maybe a -> m (Maybe b)
    mapM DerivStrategy -> q DDerivStrategy
    forall (q :: * -> *).
    DsMonad q =>
    DerivStrategy -> q DDerivStrategy
    dsDerivStrategy Maybe DerivStrategy
    mds q ([DKind] -> DDerivClause) -> q [DKind] -> q DDerivClause
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [Type] -> q [DKind]
    forall (q :: * -> *). DsMonad q => [Type] -> q [DKind]
    dsCxt [Type]
    cxt
    #else
    type DerivingClause = Pred

    dsDerivClause :: DsMonad q => DerivingClause -> q DDerivClause
    dsDerivClause p = DDerivClause Nothing <$> dsPred p
    #endif

    #if __GLASGOW_HASKELL__ >= 801
    -- | Desugar a @DerivStrategy@.

    dsDerivStrategy :: DsMonad q => DerivStrategy -> q DDerivStrategy
    dsDerivStrategy :: forall (q :: * -> *).
    DsMonad q =>
    DerivStrategy -> q DDerivStrategy
    dsDerivStrategy DerivStrategy
    StockStrategy    = DDerivStrategy -> q DDerivStrategy
    forall a. a -> q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure DDerivStrategy
    DStockStrategy
    dsDerivStrategy DerivStrategy
    AnyclassStrategy = DDerivStrategy -> q DDerivStrategy
    forall a. a -> q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure DDerivStrategy
    DAnyclassStrategy
    dsDerivStrategy DerivStrategy
    NewtypeStrategy  = DDerivStrategy -> q DDerivStrategy
    forall a. a -> q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure DDerivStrategy
    DNewtypeStrategy
    #if __GLASGOW_HASKELL__ >= 805
    dsDerivStrategy (ViaStrategy Type
    ty) = DKind -> DDerivStrategy
    DViaStrategy (DKind -> DDerivStrategy) -> q DKind -> q DDerivStrategy
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    ty
    #endif
    #endif

    #if __GLASGOW_HASKELL__ >= 801
    -- | Desugar a @PatSynDir@. (Available only with GHC 8.2+)

    dsPatSynDir :: DsMonad q => Name -> PatSynDir -> q DPatSynDir
    dsPatSynDir :: forall (q :: * -> *).
    DsMonad q =>
    Name -> PatSynDir -> q DPatSynDir
    dsPatSynDir Name
    _ PatSynDir
    Unidir              = DPatSynDir -> q DPatSynDir
    forall a. a -> q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure DPatSynDir
    DUnidir
    dsPatSynDir Name
    _ PatSynDir
    ImplBidir           = DPatSynDir -> q DPatSynDir
    forall a. a -> q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure DPatSynDir
    DImplBidir
    dsPatSynDir Name
    n (ExplBidir [Clause]
    clauses) = [DClause] -> DPatSynDir
    DExplBidir ([DClause] -> DPatSynDir) -> q [DClause] -> q DPatSynDir
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> MatchContext -> [Clause] -> q [DClause]
    forall (q :: * -> *).
    DsMonad q =>
    MatchContext -> [Clause] -> q [DClause]
    dsClauses (Name -> MatchContext
    FunRhs Name
    n) [Clause]
    clauses
    #endif

    -- | Desugar a @Pred@, flattening any internal tuples

    dsPred :: DsMonad q => Pred -> q DCxt
    dsPred :: forall (q :: * -> *). DsMonad q => Type -> q [DKind]
    dsPred Type
    t
      | Just [Type]
    ts <- Type -> Maybe [Type]
    splitTuple_maybe Type
    t
      = (Type -> q [DKind]) -> [Type] -> q [DKind]
    forall (monad :: * -> *) monoid (t :: * -> *) a.
    (Monad monad, Monoid monoid, Traversable t) =>
    (a -> monad monoid) -> t a -> monad monoid
    concatMapM Type -> q [DKind]
    forall (q :: * -> *). DsMonad q => Type -> q [DKind]
    dsPred [Type]
    ts
    dsPred (ForallT [TyVarBndr Specificity]
    tvbs [Type]
    cxt Type
    p) = [TyVarBndr Specificity] -> [Type] -> Type -> q [DKind]
    forall (q :: * -> *).
    DsMonad q =>
    [TyVarBndr Specificity] -> [Type] -> Type -> q [DKind]
    dsForallPred [TyVarBndr Specificity]
    tvbs [Type]
    cxt Type
    p
    dsPred (AppT Type
    t1 Type
    t2) = do
      [DKind
    p1] <- Type -> q [DKind]
    forall (q :: * -> *). DsMonad q => Type -> q [DKind]
    dsPred Type
    t1   -- tuples can't be applied!

      (DKind -> [DKind] -> [DKind]
    forall a. a -> [a] -> [a]
    :[]) (DKind -> [DKind]) -> (DKind -> DKind) -> DKind -> [DKind]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> DKind -> DKind -> DKind
    DAppT DKind
    p1 (DKind -> [DKind]) -> q DKind -> q [DKind]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    t2
    dsPred (SigT Type
    ty Type
    ki) = do
      [DKind]
    preds <- Type -> q [DKind]
    forall (q :: * -> *). DsMonad q => Type -> q [DKind]
    dsPred Type
    ty
      case [DKind]
    preds of
        [DKind
    p]   -> (DKind -> [DKind] -> [DKind]
    forall a. a -> [a] -> [a]
    :[]) (DKind -> [DKind]) -> (DKind -> DKind) -> DKind -> [DKind]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> DKind -> DKind -> DKind
    DSigT DKind
    p (DKind -> [DKind]) -> q DKind -> q [DKind]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    ki
        [DKind]
    other -> [DKind] -> q [DKind]
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [DKind]
    other   -- just drop the kind signature on a tuple.

    dsPred (VarT Name
    n) = [DKind] -> q [DKind]
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Name -> DKind
    DVarT Name
    n]
    dsPred (ConT Name
    n) = [DKind] -> q [DKind]
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Name -> DKind
    DConT Name
    n]
    dsPred t :: Type
    t@(PromotedT Name
    _) =
      String -> q [DKind]
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible (String -> q [DKind]) -> String -> q [DKind]
    forall a b. (a -> b) -> a -> b
    $ String
    "Promoted type seen as head of constraint: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    forall a. Show a => a -> String
    show Type
    t
    dsPred (TupleT Int
    0) = [DKind] -> q [DKind]
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Name -> DKind
    DConT (Int -> Name
    tupleTypeName Int
    0)]
    dsPred (TupleT Int
    _) =
      String -> q [DKind]
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible String
    "Internal error in th-desugar in detecting tuple constraints."
    dsPred t :: Type
    t@(UnboxedTupleT Int
    _) =
      String -> q [DKind]
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible (String -> q [DKind]) -> String -> q [DKind]
    forall a b. (a -> b) -> a -> b
    $ String
    "Unboxed tuple seen as head of constraint: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    forall a. Show a => a -> String
    show Type
    t
    dsPred Type
    ArrowT = String -> q [DKind]
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible String
    "Arrow seen as head of constraint."
    dsPred Type
    ListT  = String -> q [DKind]
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible String
    "List seen as head of constraint."
    dsPred (PromotedTupleT Int
    _) =
      String -> q [DKind]
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible String
    "Promoted tuple seen as head of constraint."
    dsPred Type
    PromotedNilT  = String -> q [DKind]
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible String
    "Promoted nil seen as head of constraint."
    dsPred Type
    PromotedConsT = String -> q [DKind]
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible String
    "Promoted cons seen as head of constraint."
    dsPred Type
    StarT         = String -> q [DKind]
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible String
    "* seen as head of constraint."
    dsPred Type
    ConstraintT =
      String -> q [DKind]
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible String
    "The kind `Constraint' seen as head of constraint."
    dsPred t :: Type
    t@(LitT TyLit
    _) =
      String -> q [DKind]
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible (String -> q [DKind]) -> String -> q [DKind]
    forall a b. (a -> b) -> a -> b
    $ String
    "Type literal seen as head of constraint: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    forall a. Show a => a -> String
    show Type
    t
    dsPred Type
    EqualityT = [DKind] -> q [DKind]
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Name -> DKind
    DConT ''(~)]
    dsPred (InfixT Type
    t1 Name
    n Type
    t2) = (DKind -> [DKind] -> [DKind]
    forall a. a -> [a] -> [a]
    :[]) (DKind -> [DKind]) -> q DKind -> q [DKind]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> Name -> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> Name -> Type -> q DKind
    dsInfixT Type
    t1 Name
    n Type
    t2
    dsPred (UInfixT{}) = q [DKind]
    forall (m :: * -> *) a. MonadFail m => m a
    dsUInfixT
    dsPred (ParensT Type
    t) = Type -> q [DKind]
    forall (q :: * -> *). DsMonad q => Type -> q [DKind]
    dsPred Type
    t
    dsPred Type
    WildCardT = [DKind] -> q [DKind]
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [DKind
    DWildCardT]
    #if __GLASGOW_HASKELL__ >= 801
    dsPred t :: Type
    t@(UnboxedSumT {}) =
      String -> q [DKind]
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible (String -> q [DKind]) -> String -> q [DKind]
    forall a b. (a -> b) -> a -> b
    $ String
    "Unboxed sum seen as head of constraint: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    forall a. Show a => a -> String
    show Type
    t
    #endif
    #if __GLASGOW_HASKELL__ >= 807
    dsPred (AppKindT Type
    t Type
    k) = do
      [DKind
    p] <- Type -> q [DKind]
    forall (q :: * -> *). DsMonad q => Type -> q [DKind]
    dsPred Type
    t
      (DKind -> [DKind] -> [DKind]
    forall a. a -> [a] -> [a]
    :[]) (DKind -> [DKind]) -> q DKind -> q [DKind]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (DKind -> DKind -> DKind
    DAppKindT DKind
    p (DKind -> DKind) -> q DKind -> q DKind
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    k)
    dsPred (ImplicitParamT String
    n Type
    t) = do
      DKind
    t' <- Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    t
      [DKind] -> q [DKind]
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Name -> DKind
    DConT ''IP DKind -> DKind -> DKind
    `DAppT` TyLit -> DKind
    DLitT (String -> TyLit
    StrTyLit String
    n) DKind -> DKind -> DKind
    `DAppT` DKind
    t']
    #endif
    #if __GLASGOW_HASKELL__ >= 809
    dsPred t :: Type
    t@(ForallVisT {}) =
      String -> q [DKind]
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible (String -> q [DKind]) -> String -> q [DKind]
    forall a b. (a -> b) -> a -> b
    $ String
    "Visible dependent quantifier seen as head of constraint: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    forall a. Show a => a -> String
    show Type
    t
    #endif
    #if __GLASGOW_HASKELL__ >= 900
    dsPred Type
    MulArrowT = String -> q [DKind]
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible String
    "Linear arrow seen as head of constraint."
    #endif
    #if __GLASGOW_HASKELL__ >= 903
    dsPred t :: Type
    t@PromotedInfixT{} =
      String -> q [DKind]
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible (String -> q [DKind]) -> String -> q [DKind]
    forall a b. (a -> b) -> a -> b
    $ String
    "Promoted infix type seen as head of constraint: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    forall a. Show a => a -> String
    show Type
    t
    dsPred PromotedUInfixT{} = q [DKind]
    forall (m :: * -> *) a. MonadFail m => m a
    dsUInfixT
    #endif

    -- | Desugar a quantified constraint.

    dsForallPred :: DsMonad q => [TyVarBndrSpec] -> Cxt -> Pred -> q DCxt
    dsForallPred :: forall (q :: * -> *).
    DsMonad q =>
    [TyVarBndr Specificity] -> [Type] -> Type -> q [DKind]
    dsForallPred [TyVarBndr Specificity]
    tvbs [Type]
    cxt Type
    p = do
      [DKind]
    ps' <- Type -> q [DKind]
    forall (q :: * -> *). DsMonad q => Type -> q [DKind]
    dsPred Type
    p
      case [DKind]
    ps' of
        [DKind
    p'] -> (DKind -> [DKind] -> [DKind]
    forall a. a -> [a] -> [a]
    :[]) (DKind -> [DKind]) -> q DKind -> q [DKind]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (DForallTelescope -> [DKind] -> DKind -> DKind
    mkDForallConstrainedT (DForallTelescope -> [DKind] -> DKind -> DKind)
    -> q DForallTelescope -> q ([DKind] -> DKind -> DKind)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                             ([DTyVarBndrSpec] -> DForallTelescope
    DForallInvis ([DTyVarBndrSpec] -> DForallTelescope)
    -> q [DTyVarBndrSpec] -> q DForallTelescope
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (TyVarBndr Specificity -> q DTyVarBndrSpec)
    -> [TyVarBndr Specificity] -> q [DTyVarBndrSpec]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM TyVarBndr Specificity -> q DTyVarBndrSpec
    forall (q :: * -> *).
    DsMonad q =>
    TyVarBndr Specificity -> q DTyVarBndrSpec
    dsTvbSpec [TyVarBndr Specificity]
    tvbs) q ([DKind] -> DKind -> DKind) -> q [DKind] -> q (DKind -> DKind)
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [Type] -> q [DKind]
    forall (q :: * -> *). DsMonad q => [Type] -> q [DKind]
    dsCxt [Type]
    cxt q (DKind -> DKind) -> q DKind -> q DKind
    forall a b. q (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> DKind -> q DKind
    forall a. a -> q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure DKind
    p')
        [DKind]
    _    -> String -> q [DKind]
    forall a. String -> q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Cannot desugar constraint tuples in the body of a quantified constraint"
                  -- See GHC #15334.

    -- | Like 'reify', but safer and desugared. Uses local declarations where

    -- available.

    dsReify :: DsMonad q => Name -> q (Maybe DInfo)
    dsReify :: forall (q :: * -> *). DsMonad q => Name -> q (Maybe DInfo)
    dsReify = (Info -> q DInfo) -> Maybe Info -> q (Maybe DInfo)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Maybe a -> f (Maybe b)
    traverse Info -> q DInfo
    forall (q :: * -> *). DsMonad q => Info -> q DInfo
    dsInfo (Maybe Info -> q (Maybe DInfo))
    -> (Name -> q (Maybe Info)) -> Name -> q (Maybe DInfo)
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< Name -> q (Maybe Info)
    forall (q :: * -> *). DsMonad q => Name -> q (Maybe Info)
    reifyWithLocals_maybe

    -- | Like 'reifyType', but safer and desugared. Uses local declarations where

    -- available.

    dsReifyType :: DsMonad q => Name -> q (Maybe DType)
    dsReifyType :: forall (q :: * -> *). DsMonad q => Name -> q (Maybe DKind)
    dsReifyType = (Type -> q DKind) -> Maybe Type -> q (Maybe DKind)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Maybe a -> f (Maybe b)
    traverse Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType (Maybe Type -> q (Maybe DKind))
    -> (Name -> q (Maybe Type)) -> Name -> q (Maybe DKind)
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< Name -> q (Maybe Type)
    forall (q :: * -> *). DsMonad q => Name -> q (Maybe Type)
    reifyTypeWithLocals_maybe

    -- Given a list of `forall`ed type variable binders and a context, construct

    -- a DType using DForallT and DConstrainedT as appropriate. The phrase

    -- "as appropriate" is used because DConstrainedT will not be used if the

    -- context is empty, per Note [Desugaring and sweetening ForallT].

    mkDForallConstrainedT :: DForallTelescope -> DCxt -> DType -> DType
    mkDForallConstrainedT :: DForallTelescope -> [DKind] -> DKind -> DKind
    mkDForallConstrainedT DForallTelescope
    tele [DKind]
    ctxt DKind
    ty =
      DForallTelescope -> DKind -> DKind
    DForallT DForallTelescope
    tele (DKind -> DKind) -> DKind -> DKind
    forall a b. (a -> b) -> a -> b
    $ if [DKind] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [DKind]
    ctxt then DKind
    ty else [DKind] -> DKind -> DKind
    DConstrainedT [DKind]
    ctxt DKind
    ty

    -- create a list of expressions in the same order as the fields in the first argument

    -- but with the values as given in the second argument

    -- if a field is missing from the second argument, use the corresponding expression

    -- from the third argument

    reorderFields :: DsMonad q => Name -> [VarStrictType] -> [FieldExp] -> [DExp] -> q [DExp]
    reorderFields :: forall (q :: * -> *).
    DsMonad q =>
    Name -> [VarBangType] -> [FieldExp] -> [DExp] -> q [DExp]
    reorderFields = (Exp -> q DExp)
    -> Name -> [VarBangType] -> [FieldExp] -> [DExp] -> q [DExp]
    forall (m :: * -> *) a da.
    (Applicative m, MonadFail m) =>
    (a -> m da)
    -> Name -> [VarBangType] -> [(Name, a)] -> [da] -> m [da]
    reorderFields' Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp

    reorderFieldsPat :: DsMonad q => Name -> [VarStrictType] -> [FieldPat] -> PatM q [DPat]
    reorderFieldsPat :: forall (q :: * -> *).
    DsMonad q =>
    Name -> [VarBangType] -> [FieldPat] -> PatM q [DPat]
    reorderFieldsPat Name
    con_name [VarBangType]
    field_decs [FieldPat]
    field_pats =
      (Pat -> WriterT [(Name, DExp)] q DPat)
    -> Name
    -> [VarBangType]
    -> [FieldPat]
    -> [DPat]
    -> WriterT [(Name, DExp)] q [DPat]
    forall (m :: * -> *) a da.
    (Applicative m, MonadFail m) =>
    (a -> m da)
    -> Name -> [VarBangType] -> [(Name, a)] -> [da] -> m [da]
    reorderFields' Pat -> WriterT [(Name, DExp)] q DPat
    forall (q :: * -> *). DsMonad q => Pat -> PatM q DPat
    dsPat Name
    con_name [VarBangType]
    field_decs [FieldPat]
    field_pats (DPat -> [DPat]
    forall a. a -> [a]
    repeat DPat
    DWildP)

    reorderFields' :: (Applicative m, Fail.MonadFail m)
                   => (a -> m da)
                   -> Name -- ^ The name of the constructor (used for error reporting)

                   -> [VarStrictType] -> [(Name, a)]
                   -> [da] -> m [da]
    reorderFields' :: forall (m :: * -> *) a da.
    (Applicative m, MonadFail m) =>
    (a -> m da)
    -> Name -> [VarBangType] -> [(Name, a)] -> [da] -> m [da]
    reorderFields' a -> m da
    ds_thing Name
    con_name [VarBangType]
    field_names_types [(Name, a)]
    field_things [da]
    deflts =
      m ()
    check_valid_fields m () -> m [da] -> m [da]
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> [Name] -> [da] -> m [da]
    reorder [Name]
    field_names [da]
    deflts
      where
        field_names :: [Name]
    field_names = (VarBangType -> Name) -> [VarBangType] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Name
    a, Bang
    _, Type
    _) -> Name
    a) [VarBangType]
    field_names_types

        check_valid_fields :: m ()
    check_valid_fields =
          [(Name, a)] -> ((Name, a) -> m ()) -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [(Name, a)]
    field_things (((Name, a) -> m ()) -> m ()) -> ((Name, a) -> m ()) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \(Name
    thing_name, a
    _) ->
            Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Name
    thing_name Name -> [Name] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Name]
    field_names) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
              String -> m ()
    forall a. String -> m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> m ()) -> String -> m ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Constructor ‘" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Name -> String
    nameBase Name
    con_name   String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "‘ does not have field ‘"
                                     String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Name -> String
    nameBase Name
    thing_name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "‘"

        reorder :: [Name] -> [da] -> m [da]
    reorder [] [da]
    _ = [da] -> m [da]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
        reorder (Name
    field_name : [Name]
    rest) (da
    deflt : [da]
    rest_deflt) = do
          [da]
    rest' <- [Name] -> [da] -> m [da]
    reorder [Name]
    rest [da]
    rest_deflt
          case ((Name, a) -> Bool) -> [(Name, a)] -> Maybe (Name, a)
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find (\(Name
    thing_name, a
    _) -> Name
    thing_name Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    field_name) [(Name, a)]
    field_things of
            Just (Name
    _, a
    thing) -> (da -> [da] -> [da]
    forall a. a -> [a] -> [a]
    : [da]
    rest') (da -> [da]) -> m da -> m [da]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> a -> m da
    ds_thing a
    thing
            Maybe (Name, a)
    Nothing -> [da] -> m [da]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([da] -> m [da]) -> [da] -> m [da]
    forall a b. (a -> b) -> a -> b
    $ da
    deflt da -> [da] -> [da]
    forall a. a -> [a] -> [a]
    : [da]
    rest'
        reorder (Name
    _ : [Name]
    _) [] = String -> m [da]
    forall a. HasCallStack => String -> a
    error String
    "Internal error in th-desugar."

    -- mkTupleDExp, mkUnboxedTupleDExp, and friends construct tuples, avoiding the

    -- use of 1-tuples. These are used to create auxiliary tuple values when

    -- desugaring pattern-matching constructs to simpler forms.

    -- See Note [Auxiliary tuples in pattern matching].

    -- | Make a tuple 'DExp' from a list of 'DExp's. Avoids using a 1-tuple.

    mkTupleDExp :: [DExp] -> DExp
    mkTupleDExp :: [DExp] -> DExp
    mkTupleDExp [DExp
    exp] = DExp
    exp
    mkTupleDExp [DExp]
    exps = (DExp -> DExp -> DExp) -> DExp -> [DExp] -> DExp
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl DExp -> DExp -> DExp
    DAppE (Name -> DExp
    DConE (Name -> DExp) -> Name -> DExp
    forall a b. (a -> b) -> a -> b
    $ Int -> Name
    tupleDataName ([DExp] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [DExp]
    exps)) [DExp]
    exps

    -- | Make an unboxed tuple 'DExp' from a list of 'DExp's. Avoids using a 1-tuple.

    mkUnboxedTupleDExp :: [DExp] -> DExp
    mkUnboxedTupleDExp :: [DExp] -> DExp
    mkUnboxedTupleDExp [DExp
    exp] = DExp
    exp
    mkUnboxedTupleDExp [DExp]
    exps = (DExp -> DExp -> DExp) -> DExp -> [DExp] -> DExp
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl DExp -> DExp -> DExp
    DAppE (Name -> DExp
    DConE (Name -> DExp) -> Name -> DExp
    forall a b. (a -> b) -> a -> b
    $ Int -> Name
    unboxedTupleDataName ([DExp] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [DExp]
    exps)) [DExp]
    exps

    -- | Make a tuple 'Exp' from a list of 'Exp's. Avoids using a 1-tuple.

    mkTupleExp :: [Exp] -> Exp
    mkTupleExp :: [Exp] -> Exp
    mkTupleExp [Exp
    exp] = Exp
    exp
    mkTupleExp [Exp]
    exps = (Exp -> Exp -> Exp) -> Exp -> [Exp] -> Exp
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Exp -> Exp -> Exp
    AppE (Name -> Exp
    ConE (Name -> Exp) -> Name -> Exp
    forall a b. (a -> b) -> a -> b
    $ Int -> Name
    tupleDataName ([Exp] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Exp]
    exps)) [Exp]
    exps

    -- | Make an unboxed tuple 'Exp' from a list of 'Exp's. Avoids using a 1-tuple.

    mkUnboxedTupleExp :: [Exp] -> Exp
    mkUnboxedTupleExp :: [Exp] -> Exp
    mkUnboxedTupleExp [Exp
    exp] = Exp
    exp
    mkUnboxedTupleExp [Exp]
    exps = (Exp -> Exp -> Exp) -> Exp -> [Exp] -> Exp
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Exp -> Exp -> Exp
    AppE (Name -> Exp
    ConE (Name -> Exp) -> Name -> Exp
    forall a b. (a -> b) -> a -> b
    $ Int -> Name
    unboxedTupleDataName ([Exp] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Exp]
    exps)) [Exp]
    exps

    -- | Make a tuple 'DPat' from a list of 'DPat's. Avoids using a 1-tuple.

    mkTupleDPat :: [DPat] -> DPat
    mkTupleDPat :: [DPat] -> DPat
    mkTupleDPat [DPat
    pat] = DPat
    pat
    mkTupleDPat [DPat]
    pats = Name -> [DKind] -> [DPat] -> DPat
    DConP (Int -> Name
    tupleDataName ([DPat] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [DPat]
    pats)) [] [DPat]
    pats

    -- | Make an unboxed tuple 'DPat' from a list of 'DPat's. Avoids using a 1-tuple.

    mkUnboxedTupleDPat :: [DPat] -> DPat
    mkUnboxedTupleDPat :: [DPat] -> DPat
    mkUnboxedTupleDPat [DPat
    pat] = DPat
    pat
    mkUnboxedTupleDPat [DPat]
    pats = Name -> [DKind] -> [DPat] -> DPat
    DConP (Int -> Name
    unboxedTupleDataName ([DPat] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [DPat]
    pats)) [] [DPat]
    pats

    -- | Is this pattern guaranteed to match?

    isUniversalPattern :: DsMonad q => DPat -> q Bool
    isUniversalPattern :: forall (q :: * -> *). DsMonad q => DPat -> q Bool
    isUniversalPattern (DLitP {}) = Bool -> q Bool
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
    isUniversalPattern (DVarP {}) = Bool -> q Bool
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
    isUniversalPattern (DConP Name
    con_name [DKind]
    _ [DPat]
    pats) = do
      Name
    data_name <- Name -> q Name
    forall (q :: * -> *). DsMonad q => Name -> q Name
    dataConNameToDataName Name
    con_name
      (DataFlavor
    _df, [TyVarBndrUnit]
    _tvbs, [Con]
    cons) <- String -> Name -> q (DataFlavor, [TyVarBndrUnit], [Con])
    forall (q :: * -> *).
    DsMonad q =>
    String -> Name -> q (DataFlavor, [TyVarBndrUnit], [Con])
    getDataD String
    "Internal error." Name
    data_name
      if [Con] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Con]
    cons Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1
      then ([Bool] -> Bool) -> q [Bool] -> q Bool
    forall a b. (a -> b) -> q a -> q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and (q [Bool] -> q Bool) -> q [Bool] -> q Bool
    forall a b. (a -> b) -> a -> b
    $ (DPat -> q Bool) -> [DPat] -> q [Bool]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM DPat -> q Bool
    forall (q :: * -> *). DsMonad q => DPat -> q Bool
    isUniversalPattern [DPat]
    pats
      else Bool -> q Bool
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
    isUniversalPattern (DTildeP {})  = Bool -> q Bool
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
    isUniversalPattern (DBangP DPat
    pat)  = DPat -> q Bool
    forall (q :: * -> *). DsMonad q => DPat -> q Bool
    isUniversalPattern DPat
    pat
    isUniversalPattern (DSigP DPat
    pat DKind
    _) = DPat -> q Bool
    forall (q :: * -> *). DsMonad q => DPat -> q Bool
    isUniversalPattern DPat
    pat
    isUniversalPattern DPat
    DWildP        = Bool -> q Bool
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True

    -- | Apply one 'DExp' to a list of arguments

    applyDExp :: DExp -> [DExp] -> DExp
    applyDExp :: DExp -> [DExp] -> DExp
    applyDExp = (DExp -> DExp -> DExp) -> DExp -> [DExp] -> DExp
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl DExp -> DExp -> DExp
    DAppE

    -- | Apply one 'DType' to a list of arguments

    applyDType :: DType -> [DTypeArg] -> DType
    applyDType :: DKind -> [DTypeArg] -> DKind
    applyDType = (DKind -> DTypeArg -> DKind) -> DKind -> [DTypeArg] -> DKind
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl DKind -> DTypeArg -> DKind
    apply
      where
        apply :: DType -> DTypeArg -> DType
        apply :: DKind -> DTypeArg -> DKind
    apply DKind
    f (DTANormal DKind
    x) = DKind
    f DKind -> DKind -> DKind
    `DAppT` DKind
    x
        apply DKind
    f (DTyArg DKind
    x)    = DKind
    f DKind -> DKind -> DKind
    `DAppKindT` DKind
    x

    -- | An argument to a type, either a normal type ('DTANormal') or a visible

    -- kind application ('DTyArg').

    --

    -- 'DTypeArg' does not appear directly in the @th-desugar@ AST, but it is

    -- useful when decomposing an application of a 'DType' to its arguments.

    data DTypeArg
      = DTANormal DType
      | DTyArg DKind
      deriving (DTypeArg -> DTypeArg -> Bool
    (DTypeArg -> DTypeArg -> Bool)
    -> (DTypeArg -> DTypeArg -> Bool) -> Eq DTypeArg
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: DTypeArg -> DTypeArg -> Bool
    == :: DTypeArg -> DTypeArg -> Bool
    $c/= :: DTypeArg -> DTypeArg -> Bool
    /= :: DTypeArg -> DTypeArg -> Bool
    Eq, Int -> DTypeArg -> String -> String
    [DTypeArg] -> String -> String
    DTypeArg -> String
    (Int -> DTypeArg -> String -> String)
    -> (DTypeArg -> String)
    -> ([DTypeArg] -> String -> String)
    -> Show DTypeArg
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> DTypeArg -> String -> String
    showsPrec :: Int -> DTypeArg -> String -> String
    $cshow :: DTypeArg -> String
    show :: DTypeArg -> String
    $cshowList :: [DTypeArg] -> String -> String
    showList :: [DTypeArg] -> String -> String
    Show, Typeable DTypeArg
    Typeable DTypeArg =>
    (forall (c :: * -> *).
     (forall d b. Data d => c (d -> b) -> d -> c b)
     -> (forall g. g -> c g) -> DTypeArg -> c DTypeArg)
    -> (forall (c :: * -> *).
        (forall b r. Data b => c (b -> r) -> c r)
        -> (forall r. r -> c r) -> Constr -> c DTypeArg)
    -> (DTypeArg -> Constr)
    -> (DTypeArg -> DataType)
    -> (forall (t :: * -> *) (c :: * -> *).
        Typeable t =>
        (forall d. Data d => c (t d)) -> Maybe (c DTypeArg))
    -> (forall (t :: * -> * -> *) (c :: * -> *).
        Typeable t =>
        (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DTypeArg))
    -> ((forall b. Data b => b -> b) -> DTypeArg -> DTypeArg)
    -> (forall r r'.
        (r -> r' -> r)
        -> r -> (forall d. Data d => d -> r') -> DTypeArg -> r)
    -> (forall r r'.
        (r' -> r -> r)
        -> r -> (forall d. Data d => d -> r') -> DTypeArg -> r)
    -> (forall u. (forall d. Data d => d -> u) -> DTypeArg -> [u])
    -> (forall u. Int -> (forall d. Data d => d -> u) -> DTypeArg -> u)
    -> (forall (m :: * -> *).
        Monad m =>
        (forall d. Data d => d -> m d) -> DTypeArg -> m DTypeArg)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> DTypeArg -> m DTypeArg)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> DTypeArg -> m DTypeArg)
    -> Data DTypeArg
    DTypeArg -> Constr
    DTypeArg -> DataType
    (forall b. Data b => b -> b) -> DTypeArg -> DTypeArg
    forall a.
    Typeable a =>
    (forall (c :: * -> *).
     (forall d b. Data d => c (d -> b) -> d -> c b)
     -> (forall g. g -> c g) -> a -> c a)
    -> (forall (c :: * -> *).
        (forall b r. Data b => c (b -> r) -> c r)
        -> (forall r. r -> c r) -> Constr -> c a)
    -> (a -> Constr)
    -> (a -> DataType)
    -> (forall (t :: * -> *) (c :: * -> *).
        Typeable t =>
        (forall d. Data d => c (t d)) -> Maybe (c a))
    -> (forall (t :: * -> * -> *) (c :: * -> *).
        Typeable t =>
        (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
    -> ((forall b. Data b => b -> b) -> a -> a)
    -> (forall r r'.
        (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
    -> (forall r r'.
        (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
    -> (forall u. (forall d. Data d => d -> u) -> a -> [u])
    -> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
    -> (forall (m :: * -> *).
        Monad m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> Data a
    forall u. Int -> (forall d. Data d => d -> u) -> DTypeArg -> u
    forall u. (forall d. Data d => d -> u) -> DTypeArg -> [u]
    forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DTypeArg -> r
    forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DTypeArg -> r
    forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DTypeArg -> m DTypeArg
    forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DTypeArg -> m DTypeArg
    forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DTypeArg
    forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DTypeArg -> c DTypeArg
    forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DTypeArg)
    forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DTypeArg)
    $cgfoldl :: forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DTypeArg -> c DTypeArg
    gfoldl :: forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DTypeArg -> c DTypeArg
    $cgunfold :: forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DTypeArg
    gunfold :: forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DTypeArg
    $ctoConstr :: DTypeArg -> Constr
    toConstr :: DTypeArg -> Constr
    $cdataTypeOf :: DTypeArg -> DataType
    dataTypeOf :: DTypeArg -> DataType
    $cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DTypeArg)
    dataCast1 :: forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DTypeArg)
    $cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DTypeArg)
    dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DTypeArg)
    $cgmapT :: (forall b. Data b => b -> b) -> DTypeArg -> DTypeArg
    gmapT :: (forall b. Data b => b -> b) -> DTypeArg -> DTypeArg
    $cgmapQl :: forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DTypeArg -> r
    gmapQl :: forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DTypeArg -> r
    $cgmapQr :: forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DTypeArg -> r
    gmapQr :: forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DTypeArg -> r
    $cgmapQ :: forall u. (forall d. Data d => d -> u) -> DTypeArg -> [u]
    gmapQ :: forall u. (forall d. Data d => d -> u) -> DTypeArg -> [u]
    $cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DTypeArg -> u
    gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DTypeArg -> u
    $cgmapM :: forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DTypeArg -> m DTypeArg
    gmapM :: forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DTypeArg -> m DTypeArg
    $cgmapMp :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DTypeArg -> m DTypeArg
    gmapMp :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DTypeArg -> m DTypeArg
    $cgmapMo :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DTypeArg -> m DTypeArg
    gmapMo :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DTypeArg -> m DTypeArg
    Data, (forall x. DTypeArg -> Rep DTypeArg x)
    -> (forall x. Rep DTypeArg x -> DTypeArg) -> Generic DTypeArg
    forall x. Rep DTypeArg x -> DTypeArg
    forall x. DTypeArg -> Rep DTypeArg x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. DTypeArg -> Rep DTypeArg x
    from :: forall x. DTypeArg -> Rep DTypeArg x
    $cto :: forall x. Rep DTypeArg x -> DTypeArg
    to :: forall x. Rep DTypeArg x -> DTypeArg
    Generic)

    -- | Desugar a 'TypeArg'.

    dsTypeArg :: DsMonad q => TypeArg -> q DTypeArg
    dsTypeArg :: forall (q :: * -> *). DsMonad q => TypeArg -> q DTypeArg
    dsTypeArg (TANormal Type
    t) = DKind -> DTypeArg
    DTANormal (DKind -> DTypeArg) -> q DKind -> q DTypeArg
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    t
    dsTypeArg (TyArg Type
    k)    = DKind -> DTypeArg
    DTyArg    (DKind -> DTypeArg) -> q DKind -> q DTypeArg
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DKind
    forall (q :: * -> *). DsMonad q => Type -> q DKind
    dsType Type
    k

    -- | Filter the normal type arguments from a list of 'DTypeArg's.

    filterDTANormals :: [DTypeArg] -> [DType]
    filterDTANormals :: [DTypeArg] -> [DKind]
    filterDTANormals = (DTypeArg -> Maybe DKind) -> [DTypeArg] -> [DKind]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe DTypeArg -> Maybe DKind
    getDTANormal
      where
        getDTANormal :: DTypeArg -> Maybe DType
        getDTANormal :: DTypeArg -> Maybe DKind
    getDTANormal (DTANormal DKind
    t) = DKind -> Maybe DKind
    forall a. a -> Maybe a
    Just DKind
    t
        getDTANormal (DTyArg {})   = Maybe DKind
    forall a. Maybe a
    Nothing

    -- | Convert a 'DTyVarBndr' into a 'DType'

    dTyVarBndrToDType :: DTyVarBndr flag -> DType
    dTyVarBndrToDType :: forall flag. DTyVarBndr flag -> DKind
    dTyVarBndrToDType (DPlainTV Name
    a flag
    _)    = Name -> DKind
    DVarT Name
    a
    dTyVarBndrToDType (DKindedTV Name
    a flag
    _ DKind
    k) = Name -> DKind
    DVarT Name
    a DKind -> DKind -> DKind
    `DSigT` DKind
    k

    -- | Extract the underlying 'DType' or 'DKind' from a 'DTypeArg'. This forgets

    -- information about whether a type is a normal argument or not, so use with

    -- caution.

    probablyWrongUnDTypeArg :: DTypeArg -> DType
    probablyWrongUnDTypeArg :: DTypeArg -> DKind
    probablyWrongUnDTypeArg (DTANormal DKind
    t) = DKind
    t
    probablyWrongUnDTypeArg (DTyArg DKind
    k)    = DKind
    k

    -- Take a data type name (which does not belong to a data family) and

    -- apply it to its type variable binders to form a DType.

    nonFamilyDataReturnType :: Name -> [DTyVarBndrUnit] -> DType
    nonFamilyDataReturnType :: Name -> [DTyVarBndrUnit] -> DKind
    nonFamilyDataReturnType Name
    con_name =
      DKind -> [DTypeArg] -> DKind
    applyDType (Name -> DKind
    DConT Name
    con_name) ([DTypeArg] -> DKind)
    -> ([DTyVarBndrUnit] -> [DTypeArg]) -> [DTyVarBndrUnit] -> DKind
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (DTyVarBndrUnit -> DTypeArg) -> [DTyVarBndrUnit] -> [DTypeArg]
    forall a b. (a -> b) -> [a] -> [b]
    map (DKind -> DTypeArg
    DTANormal (DKind -> DTypeArg)
    -> (DTyVarBndrUnit -> DKind) -> DTyVarBndrUnit -> DTypeArg
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DTyVarBndrUnit -> DKind
    forall flag. DTyVarBndr flag -> DKind
    dTyVarBndrToDType)

    -- Take a data family name and apply it to its argument types to form a

    -- data family instance DType.

    dataFamInstReturnType :: Name -> [DTypeArg] -> DType
    dataFamInstReturnType :: Name -> [DTypeArg] -> DKind
    dataFamInstReturnType Name
    fam_name = DKind -> [DTypeArg] -> DKind
    applyDType (Name -> DKind
    DConT Name
    fam_name)

    -- Data family instance declarations did not come equipped with a list of bound

    -- type variables until GHC 8.8 (and even then, it's optional whether the user

    -- provides them or not). This means that there are situations where we must

    -- reverse engineer this information ourselves from the list of type

    -- arguments. We accomplish this by taking the free variables of the types

    -- and performing a reverse topological sort on them to ensure that the

    -- returned list is well scoped.

    dataFamInstTvbs :: [DTypeArg] -> [DTyVarBndrUnit]
    dataFamInstTvbs :: [DTypeArg] -> [DTyVarBndrUnit]
    dataFamInstTvbs = [DKind] -> [DTyVarBndrUnit]
    toposortTyVarsOf ([DKind] -> [DTyVarBndrUnit])
    -> ([DTypeArg] -> [DKind]) -> [DTypeArg] -> [DTyVarBndrUnit]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (DTypeArg -> DKind) -> [DTypeArg] -> [DKind]
    forall a b. (a -> b) -> [a] -> [b]
    map DTypeArg -> DKind
    probablyWrongUnDTypeArg

    -- | Take a list of 'DType's, find their free variables, and sort them in

    -- reverse topological order to ensure that they are well scoped. In other

    -- words, the free variables are ordered such that:

    --

    -- 1. Whenever an explicit kind signature of the form @(A :: K)@ is

    --    encountered, the free variables of @K@ will always appear to the left of

    --    the free variables of @A@ in the returned result.

    --

    -- 2. The constraint in (1) notwithstanding, free variables will appear in

    --    left-to-right order of their original appearance.

    --

    -- On older GHCs, this takes measures to avoid returning explicitly bound

    -- kind variables, which was not possible before @TypeInType@.

    toposortTyVarsOf :: [DType] -> [DTyVarBndrUnit]
    toposortTyVarsOf :: [DKind] -> [DTyVarBndrUnit]
    toposortTyVarsOf [DKind]
    tys =
      let freeVars :: [Name]
          freeVars :: [Name]
    freeVars = OSet Name -> [Name]
    forall a. OSet a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    F.toList (OSet Name -> [Name]) -> OSet Name -> [Name]
    forall a b. (a -> b) -> a -> b
    $ (DKind -> OSet Name) -> [DKind] -> OSet Name
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap DKind -> OSet Name
    fvDType [DKind]
    tys

          varKindSigs :: Map Name DKind
          varKindSigs :: Map Name DKind
    varKindSigs = (DKind -> Map Name DKind) -> [DKind] -> Map Name DKind
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap DKind -> Map Name DKind
    go_ty [DKind]
    tys
            where
              go_ty :: DType -> Map Name DKind
              go_ty :: DKind -> Map Name DKind
    go_ty (DForallT DForallTelescope
    tele DKind
    t) = DForallTelescope -> Map Name DKind -> Map Name DKind
    go_tele DForallTelescope
    tele (DKind -> Map Name DKind
    go_ty DKind
    t)
              go_ty (DConstrainedT [DKind]
    ctxt DKind
    t) = (DKind -> Map Name DKind) -> [DKind] -> Map Name DKind
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap DKind -> Map Name DKind
    go_ty [DKind]
    ctxt Map Name DKind -> Map Name DKind -> Map Name DKind
    forall a. Monoid a => a -> a -> a
    `mappend` DKind -> Map Name DKind
    go_ty DKind
    t
              go_ty (DAppT DKind
    t1 DKind
    t2) = DKind -> Map Name DKind
    go_ty DKind
    t1 Map Name DKind -> Map Name DKind -> Map Name DKind
    forall a. Monoid a => a -> a -> a
    `mappend` DKind -> Map Name DKind
    go_ty DKind
    t2
              go_ty (DAppKindT DKind
    t DKind
    k) = DKind -> Map Name DKind
    go_ty DKind
    t Map Name DKind -> Map Name DKind -> Map Name DKind
    forall a. Monoid a => a -> a -> a
    `mappend` DKind -> Map Name DKind
    go_ty DKind
    k
              go_ty (DSigT DKind
    t DKind
    k) =
                let kSigs :: Map Name DKind
    kSigs = DKind -> Map Name DKind
    go_ty DKind
    k
                in case DKind
    t of
                     DVarT Name
    n -> Name -> DKind -> Map Name DKind -> Map Name DKind
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert Name
    n DKind
    k Map Name DKind
    kSigs
                     DKind
    _       -> DKind -> Map Name DKind
    go_ty DKind
    t Map Name DKind -> Map Name DKind -> Map Name DKind
    forall a. Monoid a => a -> a -> a
    `mappend` Map Name DKind
    kSigs
              go_ty (DVarT {}) = Map Name DKind
    forall a. Monoid a => a
    mempty
              go_ty (DConT {}) = Map Name DKind
    forall a. Monoid a => a
    mempty
              go_ty DKind
    DArrowT    = Map Name DKind
    forall a. Monoid a => a
    mempty
              go_ty (DLitT {}) = Map Name DKind
    forall a. Monoid a => a
    mempty
              go_ty DKind
    DWildCardT = Map Name DKind
    forall a. Monoid a => a
    mempty

              go_tele :: DForallTelescope -> Map Name DKind -> Map Name DKind
              go_tele :: DForallTelescope -> Map Name DKind -> Map Name DKind
    go_tele (DForallVis   [DTyVarBndrUnit]
    tvbs) = [DTyVarBndrUnit] -> Map Name DKind -> Map Name DKind
    forall flag. [DTyVarBndr flag] -> Map Name DKind -> Map Name DKind
    go_tvbs [DTyVarBndrUnit]
    tvbs
              go_tele (DForallInvis [DTyVarBndrSpec]
    tvbs) = [DTyVarBndrSpec] -> Map Name DKind -> Map Name DKind
    forall flag. [DTyVarBndr flag] -> Map Name DKind -> Map Name DKind
    go_tvbs [DTyVarBndrSpec]
    tvbs

              go_tvbs :: [DTyVarBndr flag] -> Map Name DKind -> Map Name DKind
              go_tvbs :: forall flag. [DTyVarBndr flag] -> Map Name DKind -> Map Name DKind
    go_tvbs [DTyVarBndr flag]
    tvbs Map Name DKind
    m = (DTyVarBndr flag -> Map Name DKind -> Map Name DKind)
    -> Map Name DKind -> [DTyVarBndr flag] -> Map Name DKind
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr DTyVarBndr flag -> Map Name DKind -> Map Name DKind
    forall flag. DTyVarBndr flag -> Map Name DKind -> Map Name DKind
    go_tvb Map Name DKind
    m [DTyVarBndr flag]
    tvbs

              go_tvb :: DTyVarBndr flag -> Map Name DKind -> Map Name DKind
              go_tvb :: forall flag. DTyVarBndr flag -> Map Name DKind -> Map Name DKind
    go_tvb (DPlainTV Name
    n flag
    _)    Map Name DKind
    m = Name -> Map Name DKind -> Map Name DKind
    forall k a. Ord k => k -> Map k a -> Map k a
    M.delete Name
    n Map Name DKind
    m
              go_tvb (DKindedTV Name
    n flag
    _ DKind
    k) Map Name DKind
    m = Name -> Map Name DKind -> Map Name DKind
    forall k a. Ord k => k -> Map k a -> Map k a
    M.delete Name
    n Map Name DKind
    m Map Name DKind -> Map Name DKind -> Map Name DKind
    forall a. Monoid a => a -> a -> a
    `mappend` DKind -> Map Name DKind
    go_ty DKind
    k

          -- | Do a topological sort on a list of tyvars,

          --   so that binders occur before occurrences

          -- E.g. given  [ a::k, k::*, b::k ]

          -- it'll return a well-scoped list [ k::*, a::k, b::k ]

          --

          -- This is a deterministic sorting operation

          -- (that is, doesn't depend on Uniques).

          --

          -- It is also meant to be stable: that is, variables should not

          -- be reordered unnecessarily.

          scopedSort :: [Name] -> [Name]
          scopedSort :: [Name] -> [Name]
    scopedSort = [Name] -> [Set Name] -> [Name] -> [Name]
    go [] []

          go :: [Name]     -- already sorted, in reverse order

             -> [Set Name] -- each set contains all the variables which must be placed

                           -- before the tv corresponding to the set; they are accumulations

                           -- of the fvs in the sorted tvs' kinds

                           -- This list is in 1-to-1 correspondence with the sorted tyvars

                           -- INVARIANT:

                           --   all (\tl -> all (`isSubsetOf` head tl) (tail tl)) (tails fv_list)

                           -- That is, each set in the list is a superset of all later sets.

             -> [Name]     -- yet to be sorted

             -> [Name]
          go :: [Name] -> [Set Name] -> [Name] -> [Name]
    go [Name]
    acc [Set Name]
    _fv_list [] = [Name] -> [Name]
    forall a. [a] -> [a]
    reverse [Name]
    acc
          go [Name]
    acc  [Set Name]
    fv_list (Name
    tv:[Name]
    tvs)
            = [Name] -> [Set Name] -> [Name] -> [Name]
    go [Name]
    acc' [Set Name]
    fv_list' [Name]
    tvs
            where
              ([Name]
    acc', [Set Name]
    fv_list') = Name -> [Name] -> [Set Name] -> ([Name], [Set Name])
    insert Name
    tv [Name]
    acc [Set Name]
    fv_list

          insert :: Name       -- var to insert

                 -> [Name]     -- sorted list, in reverse order

                 -> [Set Name] -- list of fvs, as above

                 -> ([Name], [Set Name])   -- augmented lists

          insert :: Name -> [Name] -> [Set Name] -> ([Name], [Set Name])
    insert Name
    tv []     []         = ([Name
    tv], [Name -> Set Name
    kindFVSet Name
    tv])
          insert Name
    tv (Name
    a:[Name]
    as) (Set Name
    fvs:[Set Name]
    fvss)
            | Name
    tv Name -> Set Name -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set Name
    fvs
            , ([Name]
    as', [Set Name]
    fvss') <- Name -> [Name] -> [Set Name] -> ([Name], [Set Name])
    insert Name
    tv [Name]
    as [Set Name]
    fvss
            = (Name
    aName -> [Name] -> [Name]
    forall a. a -> [a] -> [a]
    :[Name]
    as', Set Name
    fvs Set Name -> Set Name -> Set Name
    forall a. Ord a => Set a -> Set a -> Set a
    `S.union` Set Name
    fv_tv Set Name -> [Set Name] -> [Set Name]
    forall a. a -> [a] -> [a]
    : [Set Name]
    fvss')

            | Bool
    otherwise
            = (Name
    tvName -> [Name] -> [Name]
    forall a. a -> [a] -> [a]
    :Name
    aName -> [Name] -> [Name]
    forall a. a -> [a] -> [a]
    :[Name]
    as, Set Name
    fvs Set Name -> Set Name -> Set Name
    forall a. Ord a => Set a -> Set a -> Set a
    `S.union` Set Name
    fv_tv Set Name -> [Set Name] -> [Set Name]
    forall a. a -> [a] -> [a]
    : Set Name
    fvs Set Name -> [Set Name] -> [Set Name]
    forall a. a -> [a] -> [a]
    : [Set Name]
    fvss)
            where
              fv_tv :: Set Name
    fv_tv = Name -> Set Name
    kindFVSet Name
    tv

             -- lists not in correspondence

          insert Name
    _ [Name]
    _ [Set Name]
    _ = String -> ([Name], [Set Name])
    forall a. HasCallStack => String -> a
    error String
    "scopedSort"

          kindFVSet :: Name -> Set Name
    kindFVSet Name
    n =
            Set Name -> (DKind -> Set Name) -> Maybe DKind -> Set Name
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Set Name
    forall a. Set a
    S.empty (OSet Name -> Set Name
    forall a. OSet a -> Set a
    OS.toSet (OSet Name -> Set Name)
    -> (DKind -> OSet Name) -> DKind -> Set Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DKind -> OSet Name
    fvDType)
                          (Name -> Map Name DKind -> Maybe DKind
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Name
    n Map Name DKind
    varKindSigs)
          ascribeWithKind :: Name -> DTyVarBndrUnit
    ascribeWithKind Name
    n =
            DTyVarBndrUnit
    -> (DKind -> DTyVarBndrUnit) -> Maybe DKind -> DTyVarBndrUnit
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Name -> () -> DTyVarBndrUnit
    forall flag. Name -> flag -> DTyVarBndr flag
    DPlainTV Name
    n ()) (Name -> () -> DKind -> DTyVarBndrUnit
    forall flag. Name -> flag -> DKind -> DTyVarBndr flag
    DKindedTV Name
    n ()) (Name -> Map Name DKind -> Maybe DKind
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Name
    n Map Name DKind
    varKindSigs)

      in (Name -> DTyVarBndrUnit) -> [Name] -> [DTyVarBndrUnit]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> DTyVarBndrUnit
    ascribeWithKind ([Name] -> [DTyVarBndrUnit]) -> [Name] -> [DTyVarBndrUnit]
    forall a b. (a -> b) -> a -> b
    $
         [Name] -> [Name]
    scopedSort [Name]
    freeVars

    dtvbName :: DTyVarBndr flag -> Name
    dtvbName :: forall flag. DTyVarBndr flag -> Name
    dtvbName (DPlainTV Name
    n flag
    _)    = Name
    n
    dtvbName (DKindedTV Name
    n flag
    _ DKind
    _) = Name
    n

    -- @mk_qual_do_name mb_mod orig_name@ will simply return @orig_name@ if

    -- @mb_mod@ is Nothing. If @mb_mod@ is @Just mod_@, then a new 'Name' will be

    -- returned that uses @mod_@ as the new module prefix. This is useful for

    -- emulating the behavior of the @QualifiedDo@ extension, which adds module

    -- prefixes to functions such as ('>>=') and ('>>').

    mk_qual_do_name :: Maybe ModName -> Name -> Name
    mk_qual_do_name :: Maybe ModName -> Name -> Name
    mk_qual_do_name Maybe ModName
    mb_mod Name
    orig_name = case Maybe ModName
    mb_mod of
      Maybe ModName
    Nothing   -> Name
    orig_name
      Just ModName
    mod_ -> OccName -> NameFlavour -> Name
    Name (String -> OccName
    OccName (Name -> String
    nameBase Name
    orig_name)) (ModName -> NameFlavour
    NameQ ModName
    mod_)

    -- | Reconstruct an arrow 'DType' from its argument and result types.

    ravelDType :: DFunArgs -> DType -> DType
    ravelDType :: DFunArgs -> DKind -> DKind
    ravelDType DFunArgs
    DFANil                 DKind
    res = DKind
    res
    ravelDType (DFAForalls DForallTelescope
    tele DFunArgs
    args) DKind
    res = DForallTelescope -> DKind -> DKind
    DForallT DForallTelescope
    tele (DFunArgs -> DKind -> DKind
    ravelDType DFunArgs
    args DKind
    res)
    ravelDType (DFACxt [DKind]
    cxt DFunArgs
    args)      DKind
    res = [DKind] -> DKind -> DKind
    DConstrainedT [DKind]
    cxt (DFunArgs -> DKind -> DKind
    ravelDType DFunArgs
    args DKind
    res)
    ravelDType (DFAAnon DKind
    t DFunArgs
    args)       DKind
    res = DKind -> DKind -> DKind
    DAppT (DKind -> DKind -> DKind
    DAppT DKind
    DArrowT DKind
    t) (DFunArgs -> DKind -> DKind
    ravelDType DFunArgs
    args DKind
    res)

    -- | Decompose a function 'DType' into its arguments (the 'DFunArgs') and its

    -- result type (the 'DType).

    unravelDType :: DType -> (DFunArgs, DType)
    unravelDType :: DKind -> (DFunArgs, DKind)
    unravelDType (DForallT DForallTelescope
    tele DKind
    ty) =
      let (DFunArgs
    args, DKind
    res) = DKind -> (DFunArgs, DKind)
    unravelDType DKind
    ty in
      (DForallTelescope -> DFunArgs -> DFunArgs
    DFAForalls DForallTelescope
    tele DFunArgs
    args, DKind
    res)
    unravelDType (DConstrainedT [DKind]
    cxt DKind
    ty) =
      let (DFunArgs
    args, DKind
    res) = DKind -> (DFunArgs, DKind)
    unravelDType DKind
    ty in
      ([DKind] -> DFunArgs -> DFunArgs
    DFACxt [DKind]
    cxt DFunArgs
    args, DKind
    res)
    unravelDType (DAppT (DAppT DKind
    DArrowT DKind
    t1) DKind
    t2) =
      let (DFunArgs
    args, DKind
    res) = DKind -> (DFunArgs, DKind)
    unravelDType DKind
    t2 in
      (DKind -> DFunArgs -> DFunArgs
    DFAAnon DKind
    t1 DFunArgs
    args, DKind
    res)
    unravelDType DKind
    t = (DFunArgs
    DFANil, DKind
    t)

    -- | The list of arguments in a function 'DType'.

    data DFunArgs
      = DFANil
        -- ^ No more arguments.

      | DFAForalls DForallTelescope DFunArgs
        -- ^ A series of @forall@ed type variables followed by a dot (if

        --   'ForallInvis') or an arrow (if 'ForallVis'). For example,

        --   the type variables @a1 ... an@ in @forall a1 ... an. r@.

      | DFACxt DCxt DFunArgs
        -- ^ A series of constraint arguments followed by @=>@. For example,

        --   the @(c1, ..., cn)@ in @(c1, ..., cn) => r@.

      | DFAAnon DType DFunArgs
        -- ^ An anonymous argument followed by an arrow. For example, the @a@

        --   in @a -> r@.

      deriving (DFunArgs -> DFunArgs -> Bool
    (DFunArgs -> DFunArgs -> Bool)
    -> (DFunArgs -> DFunArgs -> Bool) -> Eq DFunArgs
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: DFunArgs -> DFunArgs -> Bool
    == :: DFunArgs -> DFunArgs -> Bool
    $c/= :: DFunArgs -> DFunArgs -> Bool
    /= :: DFunArgs -> DFunArgs -> Bool
    Eq, Int -> DFunArgs -> String -> String
    [DFunArgs] -> String -> String
    DFunArgs -> String
    (Int -> DFunArgs -> String -> String)
    -> (DFunArgs -> String)
    -> ([DFunArgs] -> String -> String)
    -> Show DFunArgs
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> DFunArgs -> String -> String
    showsPrec :: Int -> DFunArgs -> String -> String
    $cshow :: DFunArgs -> String
    show :: DFunArgs -> String
    $cshowList :: [DFunArgs] -> String -> String
    showList :: [DFunArgs] -> String -> String
    Show, Typeable DFunArgs
    Typeable DFunArgs =>
    (forall (c :: * -> *).
     (forall d b. Data d => c (d -> b) -> d -> c b)
     -> (forall g. g -> c g) -> DFunArgs -> c DFunArgs)
    -> (forall (c :: * -> *).
        (forall b r. Data b => c (b -> r) -> c r)
        -> (forall r. r -> c r) -> Constr -> c DFunArgs)
    -> (DFunArgs -> Constr)
    -> (DFunArgs -> DataType)
    -> (forall (t :: * -> *) (c :: * -> *).
        Typeable t =>
        (forall d. Data d => c (t d)) -> Maybe (c DFunArgs))
    -> (forall (t :: * -> * -> *) (c :: * -> *).
        Typeable t =>
        (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DFunArgs))
    -> ((forall b. Data b => b -> b) -> DFunArgs -> DFunArgs)
    -> (forall r r'.
        (r -> r' -> r)
        -> r -> (forall d. Data d => d -> r') -> DFunArgs -> r)
    -> (forall r r'.
        (r' -> r -> r)
        -> r -> (forall d. Data d => d -> r') -> DFunArgs -> r)
    -> (forall u. (forall d. Data d => d -> u) -> DFunArgs -> [u])
    -> (forall u. Int -> (forall d. Data d => d -> u) -> DFunArgs -> u)
    -> (forall (m :: * -> *).
        Monad m =>
        (forall d. Data d => d -> m d) -> DFunArgs -> m DFunArgs)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> DFunArgs -> m DFunArgs)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> DFunArgs -> m DFunArgs)
    -> Data DFunArgs
    DFunArgs -> Constr
    DFunArgs -> DataType
    (forall b. Data b => b -> b) -> DFunArgs -> DFunArgs
    forall a.
    Typeable a =>
    (forall (c :: * -> *).
     (forall d b. Data d => c (d -> b) -> d -> c b)
     -> (forall g. g -> c g) -> a -> c a)
    -> (forall (c :: * -> *).
        (forall b r. Data b => c (b -> r) -> c r)
        -> (forall r. r -> c r) -> Constr -> c a)
    -> (a -> Constr)
    -> (a -> DataType)
    -> (forall (t :: * -> *) (c :: * -> *).
        Typeable t =>
        (forall d. Data d => c (t d)) -> Maybe (c a))
    -> (forall (t :: * -> * -> *) (c :: * -> *).
        Typeable t =>
        (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
    -> ((forall b. Data b => b -> b) -> a -> a)
    -> (forall r r'.
        (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
    -> (forall r r'.
        (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
    -> (forall u. (forall d. Data d => d -> u) -> a -> [u])
    -> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
    -> (forall (m :: * -> *).
        Monad m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> Data a
    forall u. Int -> (forall d. Data d => d -> u) -> DFunArgs -> u
    forall u. (forall d. Data d => d -> u) -> DFunArgs -> [u]
    forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DFunArgs -> r
    forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DFunArgs -> r
    forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DFunArgs -> m DFunArgs
    forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DFunArgs -> m DFunArgs
    forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DFunArgs
    forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DFunArgs -> c DFunArgs
    forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DFunArgs)
    forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DFunArgs)
    $cgfoldl :: forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DFunArgs -> c DFunArgs
    gfoldl :: forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DFunArgs -> c DFunArgs
    $cgunfold :: forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DFunArgs
    gunfold :: forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DFunArgs
    $ctoConstr :: DFunArgs -> Constr
    toConstr :: DFunArgs -> Constr
    $cdataTypeOf :: DFunArgs -> DataType
    dataTypeOf :: DFunArgs -> DataType
    $cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DFunArgs)
    dataCast1 :: forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DFunArgs)
    $cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DFunArgs)
    dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DFunArgs)
    $cgmapT :: (forall b. Data b => b -> b) -> DFunArgs -> DFunArgs
    gmapT :: (forall b. Data b => b -> b) -> DFunArgs -> DFunArgs
    $cgmapQl :: forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DFunArgs -> r
    gmapQl :: forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DFunArgs -> r
    $cgmapQr :: forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DFunArgs -> r
    gmapQr :: forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DFunArgs -> r
    $cgmapQ :: forall u. (forall d. Data d => d -> u) -> DFunArgs -> [u]
    gmapQ :: forall u. (forall d. Data d => d -> u) -> DFunArgs -> [u]
    $cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DFunArgs -> u
    gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DFunArgs -> u
    $cgmapM :: forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DFunArgs -> m DFunArgs
    gmapM :: forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DFunArgs -> m DFunArgs
    $cgmapMp :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DFunArgs -> m DFunArgs
    gmapMp :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DFunArgs -> m DFunArgs
    $cgmapMo :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DFunArgs -> m DFunArgs
    gmapMo :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DFunArgs -> m DFunArgs
    Data, (forall x. DFunArgs -> Rep DFunArgs x)
    -> (forall x. Rep DFunArgs x -> DFunArgs) -> Generic DFunArgs
    forall x. Rep DFunArgs x -> DFunArgs
    forall x. DFunArgs -> Rep DFunArgs x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. DFunArgs -> Rep DFunArgs x
    from :: forall x. DFunArgs -> Rep DFunArgs x
    $cto :: forall x. Rep DFunArgs x -> DFunArgs
    to :: forall x. Rep DFunArgs x -> DFunArgs
    Generic)

    -- | A /visible/ function argument type (i.e., one that must be supplied

    -- explicitly in the source code). This is in contrast to /invisible/

    -- arguments (e.g., the @c@ in @c => r@), which are instantiated without

    -- the need for explicit user input.

    data DVisFunArg
      = DVisFADep DTyVarBndrUnit
        -- ^ A visible @forall@ (e.g., @forall a -> a@).

      | DVisFAAnon DType
        -- ^ An anonymous argument followed by an arrow (e.g., @a -> r@).

      deriving (DVisFunArg -> DVisFunArg -> Bool
    (DVisFunArg -> DVisFunArg -> Bool)
    -> (DVisFunArg -> DVisFunArg -> Bool) -> Eq DVisFunArg
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: DVisFunArg -> DVisFunArg -> Bool
    == :: DVisFunArg -> DVisFunArg -> Bool
    $c/= :: DVisFunArg -> DVisFunArg -> Bool
    /= :: DVisFunArg -> DVisFunArg -> Bool
    Eq, Int -> DVisFunArg -> String -> String
    [DVisFunArg] -> String -> String
    DVisFunArg -> String
    (Int -> DVisFunArg -> String -> String)
    -> (DVisFunArg -> String)
    -> ([DVisFunArg] -> String -> String)
    -> Show DVisFunArg
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> DVisFunArg -> String -> String
    showsPrec :: Int -> DVisFunArg -> String -> String
    $cshow :: DVisFunArg -> String
    show :: DVisFunArg -> String
    $cshowList :: [DVisFunArg] -> String -> String
    showList :: [DVisFunArg] -> String -> String
    Show, Typeable DVisFunArg
    Typeable DVisFunArg =>
    (forall (c :: * -> *).
     (forall d b. Data d => c (d -> b) -> d -> c b)
     -> (forall g. g -> c g) -> DVisFunArg -> c DVisFunArg)
    -> (forall (c :: * -> *).
        (forall b r. Data b => c (b -> r) -> c r)
        -> (forall r. r -> c r) -> Constr -> c DVisFunArg)
    -> (DVisFunArg -> Constr)
    -> (DVisFunArg -> DataType)
    -> (forall (t :: * -> *) (c :: * -> *).
        Typeable t =>
        (forall d. Data d => c (t d)) -> Maybe (c DVisFunArg))
    -> (forall (t :: * -> * -> *) (c :: * -> *).
        Typeable t =>
        (forall d e. (Data d, Data e) => c (t d e))
        -> Maybe (c DVisFunArg))
    -> ((forall b. Data b => b -> b) -> DVisFunArg -> DVisFunArg)
    -> (forall r r'.
        (r -> r' -> r)
        -> r -> (forall d. Data d => d -> r') -> DVisFunArg -> r)
    -> (forall r r'.
        (r' -> r -> r)
        -> r -> (forall d. Data d => d -> r') -> DVisFunArg -> r)
    -> (forall u. (forall d. Data d => d -> u) -> DVisFunArg -> [u])
    -> (forall u.
        Int -> (forall d. Data d => d -> u) -> DVisFunArg -> u)
    -> (forall (m :: * -> *).
        Monad m =>
        (forall d. Data d => d -> m d) -> DVisFunArg -> m DVisFunArg)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> DVisFunArg -> m DVisFunArg)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> DVisFunArg -> m DVisFunArg)
    -> Data DVisFunArg
    DVisFunArg -> Constr
    DVisFunArg -> DataType
    (forall b. Data b => b -> b) -> DVisFunArg -> DVisFunArg
    forall a.
    Typeable a =>
    (forall (c :: * -> *).
     (forall d b. Data d => c (d -> b) -> d -> c b)
     -> (forall g. g -> c g) -> a -> c a)
    -> (forall (c :: * -> *).
        (forall b r. Data b => c (b -> r) -> c r)
        -> (forall r. r -> c r) -> Constr -> c a)
    -> (a -> Constr)
    -> (a -> DataType)
    -> (forall (t :: * -> *) (c :: * -> *).
        Typeable t =>
        (forall d. Data d => c (t d)) -> Maybe (c a))
    -> (forall (t :: * -> * -> *) (c :: * -> *).
        Typeable t =>
        (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
    -> ((forall b. Data b => b -> b) -> a -> a)
    -> (forall r r'.
        (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
    -> (forall r r'.
        (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
    -> (forall u. (forall d. Data d => d -> u) -> a -> [u])
    -> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
    -> (forall (m :: * -> *).
        Monad m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> Data a
    forall u. Int -> (forall d. Data d => d -> u) -> DVisFunArg -> u
    forall u. (forall d. Data d => d -> u) -> DVisFunArg -> [u]
    forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DVisFunArg -> r
    forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DVisFunArg -> r
    forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DVisFunArg -> m DVisFunArg
    forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DVisFunArg -> m DVisFunArg
    forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DVisFunArg
    forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DVisFunArg -> c DVisFunArg
    forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DVisFunArg)
    forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DVisFunArg)
    $cgfoldl :: forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DVisFunArg -> c DVisFunArg
    gfoldl :: forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DVisFunArg -> c DVisFunArg
    $cgunfold :: forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DVisFunArg
    gunfold :: forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DVisFunArg
    $ctoConstr :: DVisFunArg -> Constr
    toConstr :: DVisFunArg -> Constr
    $cdataTypeOf :: DVisFunArg -> DataType
    dataTypeOf :: DVisFunArg -> DataType
    $cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DVisFunArg)
    dataCast1 :: forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DVisFunArg)
    $cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DVisFunArg)
    dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DVisFunArg)
    $cgmapT :: (forall b. Data b => b -> b) -> DVisFunArg -> DVisFunArg
    gmapT :: (forall b. Data b => b -> b) -> DVisFunArg -> DVisFunArg
    $cgmapQl :: forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DVisFunArg -> r
    gmapQl :: forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DVisFunArg -> r
    $cgmapQr :: forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DVisFunArg -> r
    gmapQr :: forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DVisFunArg -> r
    $cgmapQ :: forall u. (forall d. Data d => d -> u) -> DVisFunArg -> [u]
    gmapQ :: forall u. (forall d. Data d => d -> u) -> DVisFunArg -> [u]
    $cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DVisFunArg -> u
    gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DVisFunArg -> u
    $cgmapM :: forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DVisFunArg -> m DVisFunArg
    gmapM :: forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DVisFunArg -> m DVisFunArg
    $cgmapMp :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DVisFunArg -> m DVisFunArg
    gmapMp :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DVisFunArg -> m DVisFunArg
    $cgmapMo :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DVisFunArg -> m DVisFunArg
    gmapMo :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DVisFunArg -> m DVisFunArg
    Data, (forall x. DVisFunArg -> Rep DVisFunArg x)
    -> (forall x. Rep DVisFunArg x -> DVisFunArg) -> Generic DVisFunArg
    forall x. Rep DVisFunArg x -> DVisFunArg
    forall x. DVisFunArg -> Rep DVisFunArg x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. DVisFunArg -> Rep DVisFunArg x
    from :: forall x. DVisFunArg -> Rep DVisFunArg x
    $cto :: forall x. Rep DVisFunArg x -> DVisFunArg
    to :: forall x. Rep DVisFunArg x -> DVisFunArg
    Generic)

    -- | Filter the visible function arguments from a list of 'DFunArgs'.

    filterDVisFunArgs :: DFunArgs -> [DVisFunArg]
    filterDVisFunArgs :: DFunArgs -> [DVisFunArg]
    filterDVisFunArgs DFunArgs
    DFANil = []
    filterDVisFunArgs (DFAForalls DForallTelescope
    tele DFunArgs
    args) =
      case DForallTelescope
    tele of
        DForallVis [DTyVarBndrUnit]
    tvbs -> (DTyVarBndrUnit -> DVisFunArg) -> [DTyVarBndrUnit] -> [DVisFunArg]
    forall a b. (a -> b) -> [a] -> [b]
    map DTyVarBndrUnit -> DVisFunArg
    DVisFADep [DTyVarBndrUnit]
    tvbs [DVisFunArg] -> [DVisFunArg] -> [DVisFunArg]
    forall a. [a] -> [a] -> [a]
    ++ [DVisFunArg]
    args'
        DForallInvis [DTyVarBndrSpec]
    _  -> [DVisFunArg]
    args'
      where
        args' :: [DVisFunArg]
    args' = DFunArgs -> [DVisFunArg]
    filterDVisFunArgs DFunArgs
    args
    filterDVisFunArgs (DFACxt [DKind]
    _ DFunArgs
    args) =
      DFunArgs -> [DVisFunArg]
    filterDVisFunArgs DFunArgs
    args
    filterDVisFunArgs (DFAAnon DKind
    t DFunArgs
    args) =
      DKind -> DVisFunArg
    DVisFAAnon DKind
    tDVisFunArg -> [DVisFunArg] -> [DVisFunArg]
    forall a. a -> [a] -> [a]
    :DFunArgs -> [DVisFunArg]
    filterDVisFunArgs DFunArgs
    args

    -- | Decompose an applied type into its individual components. For example, this:

    --

    -- @

    -- Proxy \@Type Char

    -- @

    --

    -- would be unfolded to this:

    --

    -- @

    -- ('DConT' ''Proxy, ['DTyArg' ('DConT' ''Type), 'DTANormal' ('DConT' ''Char)])

    -- @

    unfoldDType :: DType -> (DType, [DTypeArg])
    unfoldDType :: DKind -> (DKind, [DTypeArg])
    unfoldDType = [DTypeArg] -> DKind -> (DKind, [DTypeArg])
    go []
      where
        go :: [DTypeArg] -> DType -> (DType, [DTypeArg])
        go :: [DTypeArg] -> DKind -> (DKind, [DTypeArg])
    go [DTypeArg]
    acc (DForallT DForallTelescope
    _ DKind
    ty)   = [DTypeArg] -> DKind -> (DKind, [DTypeArg])
    go [DTypeArg]
    acc DKind
    ty
        go [DTypeArg]
    acc (DAppT DKind
    ty1 DKind
    ty2)   = [DTypeArg] -> DKind -> (DKind, [DTypeArg])
    go (DKind -> DTypeArg
    DTANormal DKind
    ty2DTypeArg -> [DTypeArg] -> [DTypeArg]
    forall a. a -> [a] -> [a]
    :[DTypeArg]
    acc) DKind
    ty1
        go [DTypeArg]
    acc (DAppKindT DKind
    ty DKind
    ki) = [DTypeArg] -> DKind -> (DKind, [DTypeArg])
    go (DKind -> DTypeArg
    DTyArg DKind
    kiDTypeArg -> [DTypeArg] -> [DTypeArg]
    forall a. a -> [a] -> [a]
    :[DTypeArg]
    acc) DKind
    ty
        go [DTypeArg]
    acc (DSigT DKind
    ty DKind
    _)      = [DTypeArg] -> DKind -> (DKind, [DTypeArg])
    go [DTypeArg]
    acc DKind
    ty
        go [DTypeArg]
    acc DKind
    ty                = (DKind
    ty, [DTypeArg]
    acc)

    -- | Extract the kind from a 'DTyVarBndr', if one is present.

    extractTvbKind :: DTyVarBndr flag -> Maybe DKind
    extractTvbKind :: forall flag. DTyVarBndr flag -> Maybe DKind
    extractTvbKind (DPlainTV Name
    _ flag
    _)    = Maybe DKind
    forall a. Maybe a
    Nothing
    extractTvbKind (DKindedTV Name
    _ flag
    _ DKind
    k) = DKind -> Maybe DKind
    forall a. a -> Maybe a
    Just DKind
    k

    -- | Set the flag in a list of 'DTyVarBndr's. This is often useful in contexts

    -- where one needs to re-use a list of 'DTyVarBndr's from one flag setting to

    -- another flag setting. For example, in order to re-use the 'DTyVarBndr's bound

    -- by a 'DDataD' in a 'DForallT', one can do the following:

    --

    -- @

    -- case x of

    --   'DDataD' _ _ _ tvbs _ _ _ ->

    --     'DForallT' ('DForallInvis' ('changeDTVFlags' 'SpecifiedSpec' tvbs)) ...

    -- @

    changeDTVFlags :: newFlag -> [DTyVarBndr oldFlag] -> [DTyVarBndr newFlag]
    changeDTVFlags :: forall newFlag oldFlag.
    newFlag -> [DTyVarBndr oldFlag] -> [DTyVarBndr newFlag]
    changeDTVFlags newFlag
    new_flag = (DTyVarBndr oldFlag -> DTyVarBndr newFlag)
    -> [DTyVarBndr oldFlag] -> [DTyVarBndr newFlag]
    forall a b. (a -> b) -> [a] -> [b]
    map (newFlag
    new_flag newFlag -> DTyVarBndr oldFlag -> DTyVarBndr newFlag
    forall a b. a -> DTyVarBndr b -> DTyVarBndr a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$)

    -- | Some functions in this module only use certain arguments on particular

    -- versions of GHC. Other versions of GHC (that don't make use of those

    -- arguments) might need to conjure up those arguments out of thin air at the

    -- functions' call sites, so this function serves as a placeholder to use in

    -- those situations. (In other words, this is a slightly more informative

    -- version of 'undefined'.)

    unusedArgument :: a
    unusedArgument :: forall a. a
    unusedArgument = String -> a
    forall a. HasCallStack => String -> a
    error String
    "Unused"

    {-
    Note [Desugaring and sweetening ForallT]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The ForallT constructor from template-haskell is tremendously awkward. Because
    ForallT contains both a list of type variable binders and constraint arguments,
    ForallT expressions can be ambiguous when one of these lists is empty. For
    example, consider this expression with no constraints:

      ForallT [PlainTV a] [] (VarT a)

    What should this desugar to in th-desugar, which must maintain a clear
    separation between type variable binders and constraints? There are two
    possibilities:

    1. DForallT DForallInvis [DPlainTV a] (DVarT a)
       (i.e., forall a. a)
    2. DForallT DForallInvis [DPlainTV a] (DConstrainedT [] (DVarT a))
       (i.e., forall a. () => a)

    Template Haskell generally drops these empty lists when splicing Template
    Haskell expressions, so we would like to do the same in th-desugar to mimic
    TH's behavior as closely as possible. However, there are some situations where
    dropping empty lists of `forall`ed type variable binders can change the
    semantics of a program. For instance, contrast `foo :: forall. a -> a` (which
    is an error) with `foo :: a -> a` (which is fine). Therefore, we try to
    preserve empty `forall`s to the best of our ability.

    Here is an informal specification of how th-desugar should handle different sorts
    of ambiguity. First, a specification for desugaring.
    Let `tvbs` and `ctxt` be non-empty:

    * `ForallT tvbs [] ty` should desugar to `DForallT DForallInvis tvbs ty`.
    * `ForallT [] ctxt ty` should desguar to `DForallT DForallInvis [] (DConstrainedT ctxt ty)`.
    * `ForallT [] [] ty`   should desugar to `DForallT DForallInvis [] ty`.
    * For all other cases, just straightforwardly desugar
      `ForallT tvbs ctxt ty` to `DForallT DForallInvis tvbs (DConstraintedT ctxt ty)`.

    For sweetening:

    * `DForallT DForallInvis tvbs (DConstrainedT ctxt ty)` should sweeten to `ForallT tvbs ctxt ty`.
    * `DForallT DForallInvis []   (DConstrainedT ctxt ty)` should sweeten to `ForallT [] ctxt ty`.
    * `DForallT DForallInvis tvbs (DConstrainedT [] ty)`   should sweeten to `ForallT tvbs [] ty`.
    * `DForallT DForallInvis []   (DConstrainedT [] ty)`   should sweeten to `ForallT [] [] ty`.
    * For all other cases, just straightforwardly sweeten
      `DForallT DForallInvis tvbs ty` to `ForallT tvbs [] ty` and
      `DConstrainedT ctxt ty` to `ForallT [] ctxt ty`.

    Note [Auxiliary tuples in pattern matching]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    th-desugar simplifies the overall treatment of pattern matching in two
    notable ways:

    1. Lambda expressions only bind variables and do not directly perform pattern
       matching. For example, this:

         \True False -> ()

       Roughly desugars to:

         \x y -> case (x, y) of
                   (True, False) -> ()
                   _             -> error "Non-exhaustive patterns"
    2. th-desugar does not have guards, as guards are desugared into pattern
       matches. For example, this:

         f x y | True <- x
               , False <- y
               = ()

      Roughly desugars to:

        f x y = case (x, y) of
                  (True, False) -> ()
                  _             -> error "Non-exhaustive patterns"

    In both of these examples, there are multiple expressions being matched on
    simultaneously. When desugaring these examples to `case` expressions, we need a
    construct that allows us to group these patterns together. Auxiliary tuples are
    one way to accomplish this.

    While this use of tuples works well when the arguments have lifted types, such
    as Bool, it doesn't work when the arguments have unlifted types, such as Int#.
    Imagine desugaring this lambda expression, for instance:

      \27# 42# -> ()

    The approach above would desugar this to:

      \x y -> case (x, y) of
                (27#, 42#) -> ()
                _          -> error "Non-exhaustive patterns"

    This will not typecheck, however, as we are using _lifted_ tuples, which
    require their arguments to have lifted types. If we want to support unlifted
    types, we need a different approach.

    One idea that seems tempting at first is to create an auxiliary `let`
    expression, e.g.,

      \x y ->
        let aux 27# 42# = ()
         in aux x y

    This avoids having to use lifted tuples, but it creates a new problem: type
    inference. In the general case, auxiliary `let` expressions aren't enough to
    handle GADT pattern matches, such as in this example:

      data T a where
        MkT :: Int -> T Int

      g :: T a -> T a -> a
      g = \(MkT x1) (MkT x2) -> x1 + x2

    If you desugar `g` to use an auxiliary `let` expression:

      g :: T a -> T a -> a
      g = \t1 t2 ->
            let aux (MkT x1) (MkT x2) = x1 + x2
            in aux t1 t2

    Then it will not typecheck. To make this work, you'd need to give `aux` a type
    signature. Doing this in general is tantamount to performing type inference,
    however, which is very challenging in a Template Haskell setting.

    Another approach, which is what th-desugar currently uses, is to use auxiliary
    _unboxed_ tuples. This is identical to the previous tuple approach, but with
    slightly different syntax:

      \x y -> case (# x, y #) of
                (# 27#, 42# #) -> ()
                _              -> error "Non-exhaustive patterns"

    Unboxed tuples can handle lifted and unlifted arguments alike, so it is capable
    of handling all the examples above.

    You might worry that this approach would require clients of th-desugar to
    enable the UnboxedTuples extension in non-obvious places, but fortunately, this
    is not the case. For one thing, all unboxed tuples produced by th-desugar would
    be TH-generated, so we would bypass the need to enable UnboxedTuples to lex
    unboxed tuple syntax. GHC's typechecker also imposes a requirement that
    UnboxedTuples be enabled if a variable has an unboxed tuple type, but this
    never happens in th-desugar by construction. It's possible that a future
    version of GHC might be stricter about this, but it seems unlikely.

    There are a couple of exceptions to the general rule that auxiliary binders
    should be unboxed:

    1. ParallelListComp is desugared using the `mzip` function, which returns a
       lifted pair. As a result, the variables bound in a parallel list
       comprehension must be lifted. This is a restriction which is inherited from
       GHC itself—https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7270.

    2. Match flattening desugars lazy patterns that bind multiple variables to code
       that extracts fields from tuples. For instance, this:

         data Pair a b = MkPair a b

         f :: Pair a b -> Pair b a
         f ~(MkPair x y) = MkPair y x

       Desugars to this (roughly) when match-flattened:

         f :: Pair a b -> Pair b a
         f p =
           let tuple = case p of
                         MkPair x y -> (x, y)

               x = case tuple of
                     (x, _) -> x

               y = case tuple of
                     (_, y) -> x

            in MkPair y x

       One could imagine using an unboxed tuple here instead, but since the
       intermediate `tuple` value would have an unboxed tuple this, this would
       require users of match flattening to enable UnboxedTuples. Fortunately,
       using unboxed tuples here isn't necessary, as GHC doesn't support binding
       variables with unlifted types in lazy patterns anyway.
    -}