    {- 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 TemplateHaskell, 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 (match, clause, cxt)
    import Language.Haskell.TH.Syntax hiding (lift)
    import Language.Haskell.TH.Datatype ( resolveTypeSynonyms )

    #if __GLASGOW_HASKELL__ < 709
    import Control.Applicative
    #endif
    import Control.Monad hiding (forM_, mapM)
    import qualified Control.Monad.Fail as Fail
    import Control.Monad.Zip
    import Control.Monad.Writer hiding (forM_, mapM)
    import Data.Data (Data, Typeable)
    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 (mapMaybe)
    import qualified Data.Set as S
    import Data.Set (Set)
    import Data.Traversable
    #if __GLASGOW_HASKELL__ > 710
    import Data.Maybe (isJust)
    #endif

    #if __GLASGOW_HASKELL__ >= 800
    import qualified Control.Monad.Fail as MonadFail
    #endif

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

    #if __GLASGOW_HASKELL__ >= 807
    import GHC.Classes (IP(..))
    #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 :: Exp -> q DExp
    dsExp (VarE n :: Name
    n) = DExp -> q DExp
    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 n :: Name
    n) = DExp -> q DExp
    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
    lit) = DExp -> q DExp
    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 e1 :: Exp
    e1 e2 :: 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 (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 Nothing op :: Exp
    op Nothing) = Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    op
    dsExp (InfixE (Just lhs :: Exp
    lhs) op :: Exp
    op 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 (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 Nothing op :: Exp
    op (Just rhs :: Exp
    rhs)) = do
      Name
    lhsName <- String -> q Name
    forall (q :: * -> *). Quasi q => String -> q Name
    newUniqueName "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 (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 (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 lhs :: Exp
    lhs) op :: Exp
    op (Just rhs :: 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 (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 (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 _ _ _) =
      String -> q DExp
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail "Cannot desugar unresolved infix operators."
    dsExp (ParensE exp :: Exp
    exp) = Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    exp
    dsExp (LamE pats :: [Pat]
    pats exp :: Exp
    exp) = [Pat] -> DExp -> q DExp
    forall (q :: * -> *). DsMonad q => [Pat] -> DExp -> q DExp
    dsLam [Pat]
    pats (DExp -> q DExp) -> q DExp -> q DExp
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    exp
    dsExp (LamCaseE matches :: [Match]
    matches) = do
      Name
    x <- String -> q Name
    forall (q :: * -> *). Quasi q => String -> q Name
    newUniqueName "x"
      [DMatch]
    matches' <- Name -> [Match] -> q [DMatch]
    forall (q :: * -> *). DsMonad q => Name -> [Match] -> q [DMatch]
    dsMatches Name
    x [Match]
    matches
      DExp -> q DExp
    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 exps :: [Exp]
    exps) = (Int -> Name) -> [Exp] -> q DExp
    forall (q :: * -> *). DsMonad q => (Int -> Name) -> [Exp] -> q DExp
    dsTup Int -> Name
    tupleDataName [Exp]
    exps
    dsExp (UnboxedTupE exps :: [Exp]
    exps) = (Int -> Name) -> [Exp] -> q DExp
    forall (q :: * -> *). DsMonad q => (Int -> Name) -> [Exp] -> q DExp
    dsTup Int -> Name
    unboxedTupleDataName [Exp]
    exps
    dsExp (CondE e1 :: Exp
    e1 e2 :: Exp
    e2 e3 :: Exp
    e3) =
      Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp (Exp -> [Match] -> Exp
    CaseE Exp
    e1 [ Pat -> Body -> [Dec] -> Match
    Match (Name -> [Pat] -> Pat
    ConP 'True [])  (Exp -> Body
    NormalB Exp
    e2) []
                      , Pat -> Body -> [Dec] -> Match
    Match (Name -> [Pat] -> Pat
    ConP 'False []) (Exp -> Body
    NormalB Exp
    e3) [] ])
    dsExp (MultiIfE guarded_exps :: [(Guard, Exp)]
    guarded_exps) =
      let failure :: DExp
    failure = DExp -> DExp -> DExp
    DAppE (Name -> DExp
    DVarE 'error) (Lit -> DExp
    DLitE (String -> Lit
    StringL "Non-exhaustive guards in multi-way if")) in
      [(Guard, Exp)] -> DExp -> q DExp
    forall (q :: * -> *). DsMonad q => [(Guard, Exp)] -> DExp -> q DExp
    dsGuards [(Guard, Exp)]
    guarded_exps DExp
    failure
    dsExp (LetE decs :: [Dec]
    decs exp :: Exp
    exp) = do
      (decs' :: [DLetDec]
    decs', ip_binder :: 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 (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 scrutinee :: Name
    scrutinee) matches :: [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 (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
    exp matches :: [Match]
    matches) = do
      Name
    scrutinee <- String -> q Name
    forall (q :: * -> *). Quasi q => String -> q Name
    newUniqueName "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 (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'
    dsExp (DoE stmts :: [Stmt]
    stmts) = [Stmt] -> q DExp
    forall (q :: * -> *). DsMonad q => [Stmt] -> q DExp
    dsDoStmts [Stmt]
    stmts
    dsExp (CompE stmts :: [Stmt]
    stmts) = [Stmt] -> q DExp
    forall (q :: * -> *). DsMonad q => [Stmt] -> q DExp
    dsComp [Stmt]
    stmts
    dsExp (ArithSeqE (FromR exp :: 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 exp1 :: Exp
    exp1 exp2 :: 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 (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 exp1 :: Exp
    exp1 exp2 :: 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 (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 e1 :: Exp
    e1 e2 :: Exp
    e2 e3 :: 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 (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 (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 exps :: [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 (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 (h :: Exp
    h : t :: [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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [Exp] -> m DExp
    go [Exp]
    t
    dsExp (SigE exp :: Exp
    exp ty :: Type
    ty) = DExp -> DType -> DExp
    DSigE (DExp -> DType -> DExp) -> q DExp -> q (DType -> 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 (DType -> DExp) -> q DType -> q DExp
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    ty
    dsExp (RecConE con_name :: Name
    con_name field_exps :: [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 (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 (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
    con = case Con
    con of
                        NormalC _name :: Name
    _name fields :: [BangType]
    fields -> [BangType] -> m [DExp]
    forall (m :: * -> *) (t :: * -> *) a.
    (Foldable t, MonadFail m) =>
    t a -> m [DExp]
    non_record [BangType]
    fields
                        InfixC field1 :: BangType
    field1 _name :: Name
    _name field2 :: 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
    _name fields :: [VarBangType]
    fields -> [VarBangType] -> m [DExp]
    forall (q :: * -> *). DsMonad q => [VarBangType] -> q [DExp]
    reorder_fields [VarBangType]
    fields
                        ForallC _ _ c :: Con
    c -> Con -> m [DExp]
    reorder Con
    c
    #if __GLASGOW_HASKELL__ >= 800
                        GadtC _names :: [Name]
    _names fields :: [BangType]
    fields _ret_ty :: Type
    _ret_ty -> [BangType] -> m [DExp]
    forall (m :: * -> *) (t :: * -> *) a.
    (Foldable t, MonadFail m) =>
    t a -> m [DExp]
    non_record [BangType]
    fields
                        RecGadtC _names :: [Name]
    _names fields :: [VarBangType]
    fields _ret_ty :: Type
    _ret_ty -> [VarBangType] -> m [DExp]
    forall (q :: * -> *). DsMonad q => [VarBangType] -> q [DExp]
    reorder_fields [VarBangType]
    fields
    #endif

        reorder_fields :: [VarBangType] -> q [DExp]
    reorder_fields 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 fields :: t a
    fields | [FieldExp] -> 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 (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 (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
    $ "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]
    ++ "."

    dsExp (RecUpdE exp :: Exp
    exp field_exps :: [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
    name, _) : _) -> Name -> q Name
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    name
                      _ -> String -> q Name
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible "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
    #if __GLASGOW_HASKELL__ > 710
                        VarI _name :: Name
    _name ty :: Type
    ty _m_dec :: Maybe Dec
    _m_dec -> Type -> q Type
    forall (q :: * -> *). DsMonad q => Type -> q Type
    extract_first_arg Type
    ty
    #else
                        VarI _name ty _m_dec _fixity -> extract_first_arg ty
    #endif
                        _ -> String -> q Type
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible "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
      (_, cons :: [Con]
    cons) <- String -> Name -> q ([TyVarBndr], [Con])
    forall (q :: * -> *).
    DsMonad q =>
    String -> Name -> q ([TyVarBndr], [Con])
    getDataD "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)
    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 (t :: * -> *) a. Foldable t => t a -> Int
    length [Con]
    filtered_cons Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Con] -> 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 (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 :: Type -> q Type
    extract_first_arg (AppT (AppT ArrowT arg :: Type
    arg) _) = Type -> q Type
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    arg
        extract_first_arg (ForallT _ _ t :: Type
    t) = Type -> q Type
    forall (q :: * -> *). DsMonad q => Type -> q Type
    extract_first_arg Type
    t
        extract_first_arg (SigT t :: Type
    t _) = Type -> q Type
    forall (q :: * -> *). DsMonad q => Type -> q Type
    extract_first_arg Type
    t
        extract_first_arg _ = String -> q Type
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible "Record selector not a function."

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

        filter_cons_with_names :: [Con] -> t Name -> [Con]
    filter_cons_with_names cons :: [Con]
    cons field_names :: 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 args :: [(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 (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 _con_name :: Name
    _con_name args :: [VarBangType]
    args) =
              [VarBangType] -> Bool
    forall b c. [(Name, b, c)] -> Bool
    args_contain_names [VarBangType]
    args
    #if __GLASGOW_HASKELL__ >= 800
            has_names (RecGadtC _con_name :: [Name]
    _con_name args :: [VarBangType]
    args _ret_ty :: Type
    _ret_ty) =
              [VarBangType] -> Bool
    forall b c. [(Name, b, c)] -> Bool
    args_contain_names [VarBangType]
    args
    #endif
            has_names (ForallC _ _ c :: Con
    c) = Con -> Bool
    has_names Con
    c
            has_names _               = Bool
    False

        rec_con_to_dmatch :: Name -> [VarBangType] -> m DMatch
    rec_con_to_dmatch con_name :: Name
    con_name args :: [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)
    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 -> [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 (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 :: Con -> q DMatch
    con_to_dmatch (RecC con_name :: Name
    con_name args :: [VarBangType]
    args) = Name -> [VarBangType] -> q DMatch
    forall (m :: * -> *).
    DsMonad m =>
    Name -> [VarBangType] -> m DMatch
    rec_con_to_dmatch Name
    con_name [VarBangType]
    args
    #if __GLASGOW_HASKELL__ >= 800
        -- 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 [con_name :: Name
    con_name] args :: [VarBangType]
    args _ret_ty :: Type
    _ret_ty) = Name -> [VarBangType] -> q DMatch
    forall (m :: * -> *).
    DsMonad m =>
    Name -> [VarBangType] -> m DMatch
    rec_con_to_dmatch Name
    con_name [VarBangType]
    args
    #endif
        con_to_dmatch (ForallC _ _ c :: Con
    c) = Con -> q DMatch
    forall (q :: * -> *). DsMonad q => Con -> q DMatch
    con_to_dmatch Con
    c
        con_to_dmatch _ = String -> q DMatch
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible "Internal error within th-desugar."

        error_match :: DMatch
    error_match = DPat -> DExp -> DMatch
    DMatch DPat
    DWildP (DExp -> DExp -> DExp
    DAppE (Name -> DExp
    DVarE 'error)
                       (Lit -> DExp
    DLitE (String -> Lit
    StringL "Non-exhaustive patterns in record update")))

        fst_of_3 :: (a, b, c) -> a
    fst_of_3 (x :: a
    x, _, _) = a
    x
    #if __GLASGOW_HASKELL__ >= 709
    dsExp (StaticE exp :: 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
    #endif
    #if __GLASGOW_HASKELL__ > 710
    dsExp (UnboundVarE n :: Name
    n) = DExp -> q DExp
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name -> DExp
    DVarE Name
    n)
    #endif
    #if __GLASGOW_HASKELL__ >= 801
    dsExp (AppTypeE exp :: Exp
    exp ty :: Type
    ty) = DExp -> DType -> DExp
    DAppTypeE (DExp -> DType -> DExp) -> q DExp -> q (DType -> 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 (DType -> DExp) -> q DType -> q DExp
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    ty
    dsExp (UnboxedSumE exp :: Exp
    exp alt :: Int
    alt arity :: 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 str :: String
    str) = DExp -> q DExp
    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 -> DType -> DExp
    `DAppTypeE` TyLit -> DType
    DLitT (String -> TyLit
    StrTyLit String
    str)
    #endif
    #if __GLASGOW_HASKELL__ >= 807
    dsExp (ImplicitParamVarE n :: String
    n) = DExp -> q DExp
    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 -> DType -> DExp
    `DAppTypeE` TyLit -> DType
    DLitT (String -> TyLit
    StrTyLit String
    n)
    dsExp (MDoE {}) = String -> q DExp
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail "th-desugar currently does not support RecursiveDo"
    #endif

    #if __GLASGOW_HASKELL__ >= 809
    dsTup :: DsMonad q => (Int -> Name) -> [Maybe Exp] -> q DExp
    dsTup = ds_tup
    #else
    dsTup :: DsMonad q => (Int -> Name) -> [Exp]       -> q DExp
    dsTup :: (Int -> Name) -> [Exp] -> q DExp
    dsTup tuple_data_name :: Int -> Name
    tuple_data_name = (Int -> Name) -> [Maybe Exp] -> q DExp
    forall (q :: * -> *).
    DsMonad q =>
    (Int -> Name) -> [Maybe Exp] -> q DExp
    ds_tup Int -> Name
    tuple_data_name ([Maybe Exp] -> q DExp)
    -> ([Exp] -> [Maybe Exp]) -> [Exp] -> q DExp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Exp -> Maybe Exp) -> [Exp] -> [Maybe Exp]
    forall a b. (a -> b) -> [a] -> [b]
    map Exp -> Maybe Exp
    forall a. a -> Maybe a
    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 :: (Int -> Name) -> [Maybe Exp] -> q DExp
    ds_tup tuple_data_name :: Int -> Name
    tuple_data_name mb_exps :: [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)
    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 (t :: * -> *) a. Foldable t => t a -> Bool
    null [Name]
    section_vars
         then DExp -> q DExp
    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 [Pat] -> DExp -> q DExp
    forall (q :: * -> *). DsMonad q => [Pat] -> DExp -> q DExp
    dsLam ((Name -> Pat) -> [Name] -> [Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Pat
    VarP [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 "ts") ((DExp -> Either Name DExp) -> q DExp -> q (Either Name DExp)
    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 section_exps :: [Either Name DExp]
    section_exps =
          (DExp -> Either Name DExp -> DExp)
    -> DExp -> [Either Name DExp] -> DExp
    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 (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 f :: DExp
    f (Left n :: Name
    n)  = DExp
    f DExp -> DExp -> DExp
    `DAppE` Name -> DExp
    DVarE Name
    n
        apply_tup_body f :: DExp
    f (Right e :: DExp
    e) = DExp
    f DExp -> DExp -> DExp
    `DAppE` DExp
    e

    -- | Desugar a lambda expression, where the body has already been desugared
    dsLam :: DsMonad q => [Pat] -> DExp -> q DExp
    dsLam :: [Pat] -> DExp -> q DExp
    dsLam = (Pat -> Maybe Name)
    -> ([Pat] -> DExp -> q ([DPat], DExp)) -> [Pat] -> DExp -> q DExp
    forall (q :: * -> *) pat.
    DsMonad q =>
    (pat -> Maybe Name)
    -> ([pat] -> DExp -> q ([DPat], DExp)) -> [pat] -> DExp -> q DExp
    mkLam Pat -> Maybe Name
    stripVarP_maybe [Pat] -> DExp -> q ([DPat], DExp)
    forall (q :: * -> *).
    DsMonad q =>
    [Pat] -> DExp -> q ([DPat], DExp)
    dsPatsOverExp

    -- | 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 :: DsMonad q => [DPat] -> DExp -> q DExp
    mkDLamEFromDPats :: [DPat] -> DExp -> q DExp
    mkDLamEFromDPats = (DPat -> Maybe Name)
    -> ([DPat] -> DExp -> q ([DPat], DExp)) -> [DPat] -> DExp -> q DExp
    forall (q :: * -> *) pat.
    DsMonad q =>
    (pat -> Maybe Name)
    -> ([pat] -> DExp -> q ([DPat], DExp)) -> [pat] -> DExp -> q DExp
    mkLam DPat -> Maybe Name
    stripDVarP_maybe (\pats :: [DPat]
    pats exp :: DExp
    exp -> ([DPat], DExp) -> q ([DPat], DExp)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([DPat]
    pats, DExp
    exp))
      where
        stripDVarP_maybe :: DPat -> Maybe Name
        stripDVarP_maybe :: DPat -> Maybe Name
    stripDVarP_maybe (DVarP n :: Name
    n) = Name -> Maybe Name
    forall a. a -> Maybe a
    Just Name
    n
        stripDVarP_maybe _          = Maybe Name
    forall a. Maybe a
    Nothing

    -- | Generalizes 'dsLam' and 'mkDLamEFromDPats' to work over an arbitrary
    -- pattern type.
    mkLam :: DsMonad q
          => (pat -> Maybe Name) -- ^ Should return @'Just' n@ if the argument is a
                                 --   variable pattern, and 'Nothing' otherwise.
          -> ([pat] -> DExp -> q ([DPat], DExp))
                                 -- ^ Should process a list of @pat@ arguments and
                                 --   a 'DExp' body. (This might do some internal
                                 --   reorganization if there are as-patterns, as
                                 --   in the case of 'dsPatsOverExp'.)
          -> [pat] -> DExp -> q DExp
    mkLam :: (pat -> Maybe Name)
    -> ([pat] -> DExp -> q ([DPat], DExp)) -> [pat] -> DExp -> q DExp
    mkLam mb_strip_var_pat :: pat -> Maybe Name
    mb_strip_var_pat process_pats_over_exp :: [pat] -> DExp -> q ([DPat], DExp)
    process_pats_over_exp pats :: [pat]
    pats exp :: DExp
    exp
      | Just names :: [Name]
    names <- (pat -> Maybe Name) -> [pat] -> Maybe [Name]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM pat -> Maybe Name
    mb_strip_var_pat [pat]
    pats
      = DExp -> q DExp
    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 ([pat] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [pat]
    pats) (String -> q Name
    forall (q :: * -> *). Quasi q => String -> q Name
    newUniqueName "arg")
           let scrutinee :: DExp
    scrutinee = [DExp] -> DExp
    mkTupleDExp ((Name -> DExp) -> [Name] -> [DExp]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> DExp
    DVarE [Name]
    arg_names)
           (pats' :: [DPat]
    pats', exp' :: DExp
    exp') <- [pat] -> DExp -> q ([DPat], DExp)
    process_pats_over_exp [pat]
    pats DExp
    exp
           let match :: DMatch
    match = DPat -> DExp -> DMatch
    DMatch ([DPat] -> DPat
    mkTupleDPat [DPat]
    pats') DExp
    exp'
           DExp -> q DExp
    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])

    -- | 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 :: Name -> [Match] -> q [DMatch]
    dsMatches scr :: Name
    scr = [Match] -> q [DMatch]
    forall (q :: * -> *). DsMonad q => [Match] -> q [DMatch]
    go
      where
        go :: DsMonad q => [Match] -> q [DMatch]
        go :: [Match] -> q [DMatch]
    go [] = [DMatch] -> q [DMatch]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
        go (Match pat :: Pat
    pat body :: Body
    body where_decs :: [Dec]
    where_decs : rest :: [Match]
    rest) = do
          [DMatch]
    rest' <- [Match] -> q [DMatch]
    forall (q :: * -> *). DsMonad q => [Match] -> q [DMatch]
    go [Match]
    rest
          let failure :: DExp
    failure = DExp -> [DMatch] -> DExp
    DCaseE (Name -> DExp
    DVarE Name
    scr) [DMatch]
    rest'  -- this might be an empty case.
          DExp
    exp' <- Body -> [Dec] -> DExp -> q DExp
    forall (q :: * -> *). DsMonad q => Body -> [Dec] -> DExp -> q DExp
    dsBody Body
    body [Dec]
    where_decs DExp
    failure
          (pat' :: DPat
    pat', exp'' :: 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 (m :: * -> *) a. Monad m => a -> m a
    return [DPat -> DExp -> DMatch
    DMatch DPat
    pat' DExp
    exp'']
          else [DMatch] -> q [DMatch]
    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 :: Body -> [Dec] -> DExp -> q DExp
    dsBody (NormalB exp :: Exp
    exp) decs :: [Dec]
    decs _ = do
      (decs' :: [DLetDec]
    decs', ip_binder :: 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 (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 guarded_exps :: [(Guard, Exp)]
    guarded_exps) decs :: [Dec]
    decs failure :: DExp
    failure = do
      (decs' :: [DLetDec]
    decs', ip_binder :: 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 (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 [] exp :: DExp
    exp   = DExp
    exp
    maybeDLetE decs :: [DLetDec]
    decs exp :: 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 :: String -> DExp -> [DMatch] -> DExp
    maybeDCaseE :: String -> DExp -> [DMatch] -> DExp
    maybeDCaseE err :: String
    err _     []      = DExp -> DExp -> DExp
    DAppE (Name -> DExp
    DVarE 'error) (Lit -> DExp
    DLitE (String -> Lit
    StringL String
    err))
    maybeDCaseE _   scrut :: DExp
    scrut matches :: [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 :: [(Guard, Exp)] -> DExp -> q DExp
    dsGuards [] thing_inside :: DExp
    thing_inside = DExp -> q DExp
    forall (m :: * -> *) a. Monad m => a -> m a
    return DExp
    thing_inside
    dsGuards ((NormalG gd :: Exp
    gd, exp :: Exp
    exp) : rest :: [(Guard, Exp)]
    rest) thing_inside :: 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 stmts :: [Stmt]
    stmts, exp :: Exp
    exp) : rest :: [(Guard, Exp)]
    rest) thing_inside :: 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 :: [Stmt] -> DExp -> DExp -> q DExp
    dsGuardStmts [] success :: DExp
    success _failure :: DExp
    _failure = DExp -> q DExp
    forall (m :: * -> *) a. Monad m => a -> m a
    return DExp
    success
    dsGuardStmts (BindS pat :: Pat
    pat exp :: Exp
    exp : rest :: [Stmt]
    rest) success :: DExp
    success failure :: 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
      (pat' :: DPat
    pat', success'' :: 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 (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 decs :: [Dec]
    decs : rest :: [Stmt]
    rest) success :: DExp
    success failure :: DExp
    failure = do
      (decs' :: [DLetDec]
    decs', ip_binder :: 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 (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
    exp] success :: DExp
    success _failure :: DExp
    _failure
      | VarE name :: Name
    name <- Exp
    exp
      , Name
    name Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == 'otherwise
      = DExp -> q DExp
    forall (m :: * -> *) a. Monad m => a -> m a
    return DExp
    success

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

    -- | Desugar the @Stmt@s in a @do@ expression
    dsDoStmts :: DsMonad q => [Stmt] -> q DExp
    dsDoStmts :: [Stmt] -> q DExp
    dsDoStmts [] = String -> q DExp
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible "do-expression ended with something other than bare statement."
    dsDoStmts [NoBindS exp :: Exp
    exp] = Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    exp
    dsDoStmts (BindS pat :: Pat
    pat exp :: Exp
    exp : rest :: [Stmt]
    rest) = do
      DExp
    rest' <- [Stmt] -> q DExp
    forall (q :: * -> *). DsMonad q => [Stmt] -> q DExp
    dsDoStmts [Stmt]
    rest
      Exp -> Pat -> DExp -> String -> q DExp
    forall (q :: * -> *).
    DsMonad q =>
    Exp -> Pat -> DExp -> String -> q DExp
    dsBindS Exp
    exp Pat
    pat DExp
    rest' "do expression"
    dsDoStmts (LetS decs :: [Dec]
    decs : rest :: [Stmt]
    rest) = do
      (decs' :: [DLetDec]
    decs', ip_binder :: 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
    dsDoStmts [Stmt]
    rest
      DExp -> q DExp
    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'
    dsDoStmts (NoBindS exp :: Exp
    exp : rest :: [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
    dsDoStmts [Stmt]
    rest
      DExp -> q DExp
    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
    exp') DExp
    rest'
    dsDoStmts (ParS _ : _) = String -> q DExp
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible "Parallel comprehension in a do-statement."
    #if __GLASGOW_HASKELL__ >= 807
    dsDoStmts (RecS {} : _) = String -> q DExp
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail "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 :: [Stmt] -> q DExp
    dsComp [] = String -> q DExp
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible "List/monad comprehension ended with something other than a bare statement."
    dsComp [NoBindS exp :: 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
    pat exp :: Exp
    exp : rest :: [Stmt]
    rest) = do
      DExp
    rest' <- [Stmt] -> q DExp
    forall (q :: * -> *). DsMonad q => [Stmt] -> q DExp
    dsComp [Stmt]
    rest
      Exp -> Pat -> DExp -> String -> q DExp
    forall (q :: * -> *).
    DsMonad q =>
    Exp -> Pat -> DExp -> String -> q DExp
    dsBindS Exp
    exp Pat
    pat DExp
    rest' "monad comprehension"
    dsComp (LetS decs :: [Dec]
    decs : rest :: [Stmt]
    rest) = do
      (decs' :: [DLetDec]
    decs', ip_binder :: 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 (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
    exp : rest :: [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 (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 stmtss :: [[Stmt]]
    stmtss : rest :: [Stmt]
    rest) = do
      (pat :: Pat
    pat, exp :: DExp
    exp) <- [[Stmt]] -> q (Pat, DExp)
    forall (q :: * -> *). DsMonad q => [[Stmt]] -> q (Pat, 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
    <$> [Pat] -> DExp -> q DExp
    forall (q :: * -> *). DsMonad q => [Pat] -> DExp -> q DExp
    dsLam [Pat
    pat] DExp
    rest'
    #if __GLASGOW_HASKELL__ >= 807
    dsComp (RecS {} : _) = String -> q DExp
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail "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 => Exp -> Pat -> DExp -> String -> q DExp
    dsBindS :: Exp -> Pat -> DExp -> String -> q DExp
    dsBindS bind_arg_exp :: Exp
    bind_arg_exp success_pat :: Pat
    success_pat success_exp :: DExp
    success_exp ctxt :: String
    ctxt = do
      DExp
    bind_arg_exp' <- Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    bind_arg_exp
      (success_pat' :: DPat
    success_pat', success_exp' :: 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 '(>>=)) 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 :: * -> *). DsMonad 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 "arg"
                 Name
    fail_name <- q Name
    mk_fail_name
                 DExp -> q DExp
    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
    $ "Pattern match failure in " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ctxt)
                   ]
      where
        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 (m :: * -> *) a. Monad m => a -> m a
    return 'MonadFail.fail
    #elif __GLASGOW_HASKELL__ >= 800
        mk_fail_name = do
          mfd <- qIsExtEnabled MonadFailDesugaring
          return $ if mfd then 'MonadFail.fail else 'Prelude.fail
    #else
        mk_fail_name = return '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 (Pat, DExp)
    dsParComp :: [[Stmt]] -> q (Pat, DExp)
    dsParComp [] = String -> q (Pat, DExp)
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible "Empty list of parallel comprehension statements."
    dsParComp [r :: [Stmt]
    r] = do
      let rv :: OSet Name
    rv = (Stmt -> OSet Name) -> [Stmt] -> OSet Name
    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])
      (Pat, DExp) -> q (Pat, DExp)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OSet Name -> Pat
    mk_tuple_pat OSet Name
    rv, DExp
    dsR)
    dsParComp (q :: [Stmt]
    q : rest :: [[Stmt]]
    rest) = do
      let qv :: OSet Name
    qv = (Stmt -> OSet Name) -> [Stmt] -> OSet Name
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Stmt -> OSet Name
    extractBoundNamesStmt [Stmt]
    q
      (rest_pat :: Pat
    rest_pat, rest_exp :: DExp
    rest_exp) <- [[Stmt]] -> q (Pat, DExp)
    forall (q :: * -> *). DsMonad q => [[Stmt]] -> q (Pat, 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
      (Pat, DExp) -> q (Pat, DExp)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name -> [Pat] -> Pat
    ConP (Int -> Name
    tupleDataName 2) [OSet Name -> Pat
    mk_tuple_pat OSet Name
    qv, Pat
    rest_pat], DExp
    zipped)

    -- helper function for dsParComp
    mk_tuple_stmt :: OSet Name -> Stmt
    mk_tuple_stmt :: OSet Name -> Stmt
    mk_tuple_stmt name_set :: OSet Name
    name_set =
      Exp -> Stmt
    NoBindS ([Exp] -> Exp
    mkTupleExp ((Name -> [Exp] -> [Exp]) -> [Exp] -> OSet Name -> [Exp]
    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_pat :: OSet Name -> Pat
    mk_tuple_pat :: OSet Name -> Pat
    mk_tuple_pat name_set :: OSet Name
    name_set =
      [Pat] -> Pat
    mkTuplePat ((Name -> [Pat] -> [Pat]) -> [Pat] -> OSet Name -> [Pat]
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    F.foldr ((:) (Pat -> [Pat] -> [Pat]) -> (Name -> Pat) -> Name -> [Pat] -> [Pat]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Pat
    VarP) [] 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 :: Pat -> DExp -> q (DPat, DExp)
    dsPatOverExp pat :: Pat
    pat exp :: DExp
    exp = do
      (pat' :: DPat
    pat', vars :: [(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 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
      (DPat, DExp) -> q (DPat, DExp)
    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 :: [Pat] -> DExp -> q ([DPat], DExp)
    dsPatsOverExp pats :: [Pat]
    pats exp :: DExp
    exp = do
      (pats' :: [DPat]
    pats', vars :: [(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)
    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 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
      ([DPat], DExp) -> q ([DPat], DExp)
    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 :: 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 :: Pat -> PatM q DPat
    dsPat (LitP lit :: Lit
    lit) = DPat -> PatM q DPat
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DPat -> PatM q DPat) -> DPat -> PatM q DPat
    forall a b. (a -> b) -> a -> b
    $ Lit -> DPat
    DLitP Lit
    lit
    dsPat (VarP n :: Name
    n) = DPat -> PatM q DPat
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DPat -> PatM q DPat) -> DPat -> PatM q DPat
    forall a b. (a -> b) -> a -> b
    $ Name -> DPat
    DVarP Name
    n
    dsPat (TupP pats :: [Pat]
    pats) = Name -> [DPat] -> DPat
    DConP (Int -> Name
    tupleDataName ([Pat] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Pat]
    pats)) ([DPat] -> DPat) -> WriterT [(Name, DExp)] q [DPat] -> PatM q DPat
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Pat -> PatM 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)
    mapM Pat -> PatM q DPat
    forall (q :: * -> *). DsMonad q => Pat -> PatM q DPat
    dsPat [Pat]
    pats
    dsPat (UnboxedTupP pats :: [Pat]
    pats) = Name -> [DPat] -> DPat
    DConP (Int -> Name
    unboxedTupleDataName ([Pat] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Pat]
    pats)) ([DPat] -> DPat) -> WriterT [(Name, DExp)] q [DPat] -> PatM q DPat
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                               (Pat -> PatM 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)
    mapM Pat -> PatM q DPat
    forall (q :: * -> *). DsMonad q => Pat -> PatM q DPat
    dsPat [Pat]
    pats
    dsPat (ConP name :: Name
    name pats :: [Pat]
    pats) = Name -> [DPat] -> DPat
    DConP Name
    name ([DPat] -> DPat) -> WriterT [(Name, DExp)] q [DPat] -> PatM q DPat
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Pat -> PatM 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)
    mapM Pat -> PatM q DPat
    forall (q :: * -> *). DsMonad q => Pat -> PatM q DPat
    dsPat [Pat]
    pats
    dsPat (InfixP p1 :: Pat
    p1 name :: Name
    name p2 :: Pat
    p2) = Name -> [DPat] -> DPat
    DConP Name
    name ([DPat] -> DPat) -> WriterT [(Name, DExp)] q [DPat] -> PatM q DPat
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Pat -> PatM 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)
    mapM Pat -> PatM q DPat
    forall (q :: * -> *). DsMonad q => Pat -> PatM q DPat
    dsPat [Pat
    p1, Pat
    p2]
    dsPat (UInfixP _ _ _) =
      String -> PatM q DPat
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail "Cannot desugar unresolved infix operators."
    dsPat (ParensP pat :: Pat
    pat) = Pat -> PatM q DPat
    forall (q :: * -> *). DsMonad q => Pat -> PatM q DPat
    dsPat Pat
    pat
    dsPat (TildeP pat :: Pat
    pat) = DPat -> DPat
    DTildeP (DPat -> DPat) -> PatM q DPat -> PatM q DPat
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Pat -> PatM q DPat
    forall (q :: * -> *). DsMonad q => Pat -> PatM q DPat
    dsPat Pat
    pat
    dsPat (BangP pat :: Pat
    pat) = DPat -> DPat
    DBangP (DPat -> DPat) -> PatM q DPat -> PatM q DPat
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Pat -> PatM q DPat
    forall (q :: * -> *). DsMonad q => Pat -> PatM q DPat
    dsPat Pat
    pat
    dsPat (AsP name :: Name
    name pat :: Pat
    pat) = do
      DPat
    pat' <- Pat -> PatM q DPat
    forall (q :: * -> *). DsMonad q => Pat -> PatM q DPat
    dsPat Pat
    pat
      DPat
    pat'' <- q DPat -> PatM q DPat
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (q DPat -> PatM q DPat) -> q DPat -> PatM 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 -> PatM q DPat
    forall (m :: * -> *) a. Monad m => a -> m a
    return DPat
    pat''
    dsPat WildP = DPat -> PatM q DPat
    forall (m :: * -> *) a. Monad m => a -> m a
    return DPat
    DWildP
    dsPat (RecP con_name :: Name
    con_name field_pats :: [FieldPat]
    field_pats) = do
      Con
    con <- q Con -> WriterT [(Name, DExp)] q Con
    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 -> PatM q DPat
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DPat -> PatM q DPat) -> DPat -> PatM q DPat
    forall a b. (a -> b) -> a -> b
    $ Name -> [DPat] -> DPat
    DConP Name
    con_name [DPat]
    reordered
      where
        reorder :: Con -> WriterT [(Name, DExp)] m [DPat]
    reorder con :: Con
    con = case Con
    con of
                         NormalC _name :: Name
    _name fields :: [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 field1 :: BangType
    field1 _name :: Name
    _name field2 :: 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
    _name fields :: [VarBangType]
    fields -> [VarBangType] -> WriterT [(Name, DExp)] m [DPat]
    forall (q :: * -> *). DsMonad q => [VarBangType] -> PatM q [DPat]
    reorder_fields_pat [VarBangType]
    fields
                         ForallC _ _ c :: Con
    c -> Con -> WriterT [(Name, DExp)] m [DPat]
    reorder Con
    c
    #if __GLASGOW_HASKELL__ >= 800
                         GadtC _names :: [Name]
    _names fields :: [BangType]
    fields _ret_ty :: 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 _names :: [Name]
    _names fields :: [VarBangType]
    fields _ret_ty :: Type
    _ret_ty -> [VarBangType] -> WriterT [(Name, DExp)] m [DPat]
    forall (q :: * -> *). DsMonad q => [VarBangType] -> PatM q [DPat]
    reorder_fields_pat [VarBangType]
    fields
    #endif

        reorder_fields_pat :: [VarBangType] -> PatM q [DPat]
    reorder_fields_pat fields :: [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 fields :: t a
    fields | [FieldPat] -> 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 (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 (t :: * -> *) a. Foldable t => t a -> Int
    length t a
    fields) DPat
    DWildP
                          | Bool
    otherwise = m [DPat] -> t m [DPat]
    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
    $ "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]
    ++ "."

    dsPat (ListP pats :: [Pat]
    pats) = [Pat] -> PatM 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 (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] -> DPat
    DConP '[] []
            go (h :: Pat
    h : t :: [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 (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] -> DPat
    DConP '(:) [DPat
    h', DPat
    t']
    dsPat (SigP pat :: Pat
    pat ty :: Type
    ty) = DPat -> DType -> DPat
    DSigP (DPat -> DType -> DPat)
    -> PatM q DPat -> WriterT [(Name, DExp)] q (DType -> DPat)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Pat -> PatM q DPat
    forall (q :: * -> *). DsMonad q => Pat -> PatM q DPat
    dsPat Pat
    pat WriterT [(Name, DExp)] q (DType -> DPat)
    -> WriterT [(Name, DExp)] q DType -> PatM q DPat
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> WriterT [(Name, DExp)] q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    ty
    #if __GLASGOW_HASKELL__ >= 801
    dsPat (UnboxedSumP pat :: Pat
    pat alt :: Int
    alt arity :: Int
    arity) =
      Name -> [DPat] -> DPat
    DConP (Int -> Int -> Name
    unboxedSumDataName Int
    alt Int
    arity) ([DPat] -> DPat) -> WriterT [(Name, DExp)] q [DPat] -> PatM q DPat
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((DPat -> [DPat] -> [DPat]
    forall a. a -> [a] -> [a]
    :[]) (DPat -> [DPat]) -> PatM q DPat -> WriterT [(Name, DExp)] q [DPat]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Pat -> PatM q DPat
    forall (q :: * -> *). DsMonad q => Pat -> PatM q DPat
    dsPat Pat
    pat)
    #endif
    dsPat (ViewP _ _) =
      String -> PatM q DPat
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail "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) = Lit -> DExp
    DLitE Lit
    lit
    dPatToDExp (DVarP name :: Name
    name) = Name -> DExp
    DVarE Name
    name
    dPatToDExp (DConP name :: Name
    name pats :: [DPat]
    pats) = (DExp -> DExp -> DExp) -> DExp -> [DExp] -> DExp
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl DExp -> DExp -> DExp
    DAppE (Name -> DExp
    DConE Name
    name) ((DPat -> DExp) -> [DPat] -> [DExp]
    forall a b. (a -> b) -> [a] -> [b]
    map DPat -> DExp
    dPatToDExp [DPat]
    pats)
    dPatToDExp (DTildeP pat :: DPat
    pat) = DPat -> DExp
    dPatToDExp DPat
    pat
    dPatToDExp (DBangP pat :: DPat
    pat) = DPat -> DExp
    dPatToDExp DPat
    pat
    dPatToDExp (DSigP pat :: DPat
    pat ty :: DType
    ty) = DExp -> DType -> DExp
    DSigE (DPat -> DExp
    dPatToDExp DPat
    pat) DType
    ty
    dPatToDExp DWildP = String -> DExp
    forall a. HasCallStack => String -> a
    error "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 :: DPat -> q DPat
    removeWilds p :: DPat
    p@(DLitP _) = DPat -> q DPat
    forall (m :: * -> *) a. Monad m => a -> m a
    return DPat
    p
    removeWilds p :: DPat
    p@(DVarP _) = DPat -> q DPat
    forall (m :: * -> *) a. Monad m => a -> m a
    return DPat
    p
    removeWilds (DConP con_name :: Name
    con_name pats :: [DPat]
    pats) = Name -> [DPat] -> DPat
    DConP Name
    con_name ([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)
    mapM DPat -> q DPat
    forall (q :: * -> *). DsMonad q => DPat -> q DPat
    removeWilds [DPat]
    pats
    removeWilds (DTildeP pat :: 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 pat :: 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 pat :: DPat
    pat ty :: DType
    ty) = DPat -> DType -> DPat
    DSigP (DPat -> DType -> DPat) -> q DPat -> q (DType -> 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 (DType -> DPat) -> q DType -> q DPat
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> DType -> q DType
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure DType
    ty
    removeWilds 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 "wild"

    -- | Desugar @Info@
    dsInfo :: DsMonad q => Info -> q DInfo
    dsInfo :: Info -> q DInfo
    dsInfo (ClassI dec :: Dec
    dec instances :: [Dec]
    instances) = do
      [ddec :: 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 (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)
    #if __GLASGOW_HASKELL__ > 710
    dsInfo (ClassOpI name :: Name
    name ty :: Type
    ty parent :: Name
    parent) =
    #else
    dsInfo (ClassOpI name ty parent _fixity) =
    #endif
      Name -> DType -> Maybe Name -> DInfo
    DVarI Name
    name (DType -> Maybe Name -> DInfo)
    -> q DType -> q (Maybe Name -> DInfo)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    ty q (Maybe Name -> DInfo) -> q (Maybe Name) -> q DInfo
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Maybe Name -> q (Maybe Name)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Name -> Maybe Name
    forall a. a -> Maybe a
    Just Name
    parent)
    dsInfo (TyConI dec :: Dec
    dec) = do
      [ddec :: DDec
    ddec] <- Dec -> q [DDec]
    forall (q :: * -> *). DsMonad q => Dec -> q [DDec]
    dsDec Dec
    dec
      DInfo -> q DInfo
    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 :: [Dec]
    instances) = do
      [ddec :: 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 (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
    name arity :: Int
    arity unlifted :: Bool
    unlifted) =
      DInfo -> q DInfo
    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
    #if __GLASGOW_HASKELL__ > 710
    dsInfo (DataConI name :: Name
    name ty :: Type
    ty parent :: Name
    parent) =
      Name -> DType -> Maybe Name -> DInfo
    DVarI Name
    name (DType -> Maybe Name -> DInfo)
    -> q DType -> q (Maybe Name -> DInfo)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    ty q (Maybe Name -> DInfo) -> q (Maybe Name) -> q DInfo
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Maybe Name -> q (Maybe Name)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Name -> Maybe Name
    forall a. a -> Maybe a
    Just Name
    parent)
    dsInfo (VarI name :: Name
    name ty :: Type
    ty Nothing) =
      Name -> DType -> Maybe Name -> DInfo
    DVarI Name
    name (DType -> Maybe Name -> DInfo)
    -> q DType -> q (Maybe Name -> DInfo)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    ty q (Maybe Name -> DInfo) -> q (Maybe Name) -> q DInfo
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Maybe Name -> q (Maybe Name)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Name
    forall a. Maybe a
    Nothing
    dsInfo (VarI name :: Name
    name _ (Just _)) =
      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
    $ "Declaration supplied with variable: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Name -> String
    forall a. Show a => a -> String
    show Name
    name
    #else
    dsInfo (DataConI name ty parent _fixity) =
      DVarI name <$> dsType ty <*> pure (Just parent)
    dsInfo (VarI name ty Nothing _fixity) =
      DVarI name <$> dsType ty <*> pure Nothing
    dsInfo (VarI name _ (Just _) _) =
      impossible $ "Declaration supplied with variable: " ++ show name
    #endif
    dsInfo (TyVarI name :: Name
    name ty :: Type
    ty) = Name -> DType -> DInfo
    DTyVarI Name
    name (DType -> DInfo) -> q DType -> q DInfo
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    ty
    #if __GLASGOW_HASKELL__ >= 801
    dsInfo (PatSynI name :: Name
    name ty :: Type
    ty) = Name -> DType -> DInfo
    DPatSynI Name
    name (DType -> DInfo) -> q DType -> q DInfo
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    ty
    #endif

    -- | Desugar arbitrary @Dec@s
    dsDecs :: DsMonad q => [Dec] -> q [DDec]
    dsDecs :: [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 :: 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
    #if __GLASGOW_HASKELL__ > 710
    dsDec (DataD cxt :: Cxt
    cxt n :: Name
    n tvbs :: [TyVarBndr]
    tvbs mk :: Maybe Type
    mk cons :: [Con]
    cons derivings :: [DerivClause]
    derivings) =
      NewOrData
    -> Cxt
    -> Name
    -> [TyVarBndr]
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> q [DDec]
    forall (q :: * -> *).
    DsMonad q =>
    NewOrData
    -> Cxt
    -> Name
    -> [TyVarBndr]
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> q [DDec]
    dsDataDec NewOrData
    Data Cxt
    cxt Name
    n [TyVarBndr]
    tvbs Maybe Type
    mk [Con]
    cons [DerivClause]
    derivings
    dsDec (NewtypeD cxt :: Cxt
    cxt n :: Name
    n tvbs :: [TyVarBndr]
    tvbs mk :: Maybe Type
    mk con :: Con
    con derivings :: [DerivClause]
    derivings) =
      NewOrData
    -> Cxt
    -> Name
    -> [TyVarBndr]
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> q [DDec]
    forall (q :: * -> *).
    DsMonad q =>
    NewOrData
    -> Cxt
    -> Name
    -> [TyVarBndr]
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> q [DDec]
    dsDataDec NewOrData
    Newtype Cxt
    cxt Name
    n [TyVarBndr]
    tvbs Maybe Type
    mk [Con
    con] [DerivClause]
    derivings
    #else
    dsDec (DataD cxt n tvbs cons derivings) =
      dsDataDec Data cxt n tvbs Nothing cons derivings
    dsDec (NewtypeD cxt n tvbs con derivings) =
      dsDataDec Newtype cxt n tvbs Nothing [con] derivings
    #endif
    dsDec (TySynD n :: Name
    n tvbs :: [TyVarBndr]
    tvbs ty :: 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 -> [DTyVarBndr] -> DType -> DDec
    DTySynD Name
    n ([DTyVarBndr] -> DType -> DDec)
    -> q [DTyVarBndr] -> q (DType -> DDec)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (TyVarBndr -> q DTyVarBndr) -> [TyVarBndr] -> q [DTyVarBndr]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM TyVarBndr -> q DTyVarBndr
    forall (q :: * -> *). DsMonad q => TyVarBndr -> q DTyVarBndr
    dsTvb [TyVarBndr]
    tvbs q (DType -> DDec) -> q DType -> q DDec
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    ty)
    dsDec (ClassD cxt :: Cxt
    cxt n :: Name
    n tvbs :: [TyVarBndr]
    tvbs fds :: [FunDep]
    fds decs :: [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
    <$> (DCxt -> Name -> [DTyVarBndr] -> [FunDep] -> [DDec] -> DDec
    DClassD (DCxt -> Name -> [DTyVarBndr] -> [FunDep] -> [DDec] -> DDec)
    -> q DCxt -> q (Name -> [DTyVarBndr] -> [FunDep] -> [DDec] -> DDec)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Cxt -> q DCxt
    forall (q :: * -> *). DsMonad q => Cxt -> q DCxt
    dsCxt Cxt
    cxt q (Name -> [DTyVarBndr] -> [FunDep] -> [DDec] -> DDec)
    -> q Name -> q ([DTyVarBndr] -> [FunDep] -> [DDec] -> DDec)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Name -> q Name
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Name
    n q ([DTyVarBndr] -> [FunDep] -> [DDec] -> DDec)
    -> q [DTyVarBndr] -> q ([FunDep] -> [DDec] -> DDec)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (TyVarBndr -> q DTyVarBndr) -> [TyVarBndr] -> q [DTyVarBndr]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM TyVarBndr -> q DTyVarBndr
    forall (q :: * -> *). DsMonad q => TyVarBndr -> q DTyVarBndr
    dsTvb [TyVarBndr]
    tvbs
                         q ([FunDep] -> [DDec] -> DDec) -> q [FunDep] -> q ([DDec] -> DDec)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [FunDep] -> q [FunDep]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [FunDep]
    fds q ([DDec] -> DDec) -> q [DDec] -> q DDec
    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)
    #if __GLASGOW_HASKELL__ >= 711
    dsDec (InstanceD over :: Maybe Overlap
    over cxt :: Cxt
    cxt ty :: Type
    ty decs :: [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 [DTyVarBndr] -> DCxt -> DType -> [DDec] -> DDec
    DInstanceD Maybe Overlap
    over Maybe [DTyVarBndr]
    forall a. Maybe a
    Nothing (DCxt -> DType -> [DDec] -> DDec)
    -> q DCxt -> q (DType -> [DDec] -> DDec)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Cxt -> q DCxt
    forall (q :: * -> *). DsMonad q => Cxt -> q DCxt
    dsCxt Cxt
    cxt q (DType -> [DDec] -> DDec) -> q DType -> q ([DDec] -> DDec)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    ty q ([DDec] -> DDec) -> q [DDec] -> q DDec
    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)
    #else
    dsDec (InstanceD cxt ty decs) =
      (:[]) <$> (DInstanceD Nothing Nothing <$> dsCxt cxt <*> dsType ty <*> dsDecs decs)
    #endif
    dsDec d :: Dec
    d@(SigD {}) = Dec -> q [DDec]
    forall (q :: * -> *). DsMonad q => Dec -> q [DDec]
    dsTopLevelLetDec Dec
    d
    dsDec (ForeignD f :: 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
    #if __GLASGOW_HASKELL__ > 710
    dsDec (OpenTypeFamilyD tfHead :: 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 n :: Name
    n tvbs :: [TyVarBndr]
    tvbs m_k :: 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 -> [DTyVarBndr] -> Maybe DType -> DDec
    DDataFamilyD Name
    n ([DTyVarBndr] -> Maybe DType -> DDec)
    -> q [DTyVarBndr] -> q (Maybe DType -> DDec)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (TyVarBndr -> q DTyVarBndr) -> [TyVarBndr] -> q [DTyVarBndr]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM TyVarBndr -> q DTyVarBndr
    forall (q :: * -> *). DsMonad q => TyVarBndr -> q DTyVarBndr
    dsTvb [TyVarBndr]
    tvbs q (Maybe DType -> DDec) -> q (Maybe DType) -> q DDec
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Type -> q DType) -> Maybe Type -> q (Maybe DType)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Maybe Type
    m_k)
    #else
    dsDec (FamilyD TypeFam n tvbs m_k) = do
      (:[]) <$> (DOpenTypeFamilyD <$> dsTypeFamilyHead n tvbs m_k)
    dsDec (FamilyD DataFam n tvbs m_k) =
      (:[]) <$> (DDataFamilyD n <$> mapM dsTvb tvbs <*> mapM dsType m_k)
    #endif
    #if __GLASGOW_HASKELL__ >= 807
    dsDec (DataInstD cxt :: Cxt
    cxt mtvbs :: Maybe [TyVarBndr]
    mtvbs lhs :: Type
    lhs mk :: Maybe Type
    mk cons :: [Con]
    cons derivings :: [DerivClause]
    derivings) =
      case Type -> (Type, [TypeArg])
    unfoldType Type
    lhs of
        (ConT n :: Name
    n, tys :: [TypeArg]
    tys) -> NewOrData
    -> Cxt
    -> Name
    -> Maybe [TyVarBndr]
    -> [TypeArg]
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> q [DDec]
    forall (q :: * -> *).
    DsMonad q =>
    NewOrData
    -> Cxt
    -> Name
    -> Maybe [TyVarBndr]
    -> [TypeArg]
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> q [DDec]
    dsDataInstDec NewOrData
    Data Cxt
    cxt Name
    n Maybe [TyVarBndr]
    mtvbs [TypeArg]
    tys Maybe Type
    mk [Con]
    cons [DerivClause]
    derivings
        (_, _)        -> String -> q [DDec]
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> q [DDec]) -> String -> q [DDec]
    forall a b. (a -> b) -> a -> b
    $ "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 cxt :: Cxt
    cxt mtvbs :: Maybe [TyVarBndr]
    mtvbs lhs :: Type
    lhs mk :: Maybe Type
    mk con :: Con
    con derivings :: [DerivClause]
    derivings) =
      case Type -> (Type, [TypeArg])
    unfoldType Type
    lhs of
        (ConT n :: Name
    n, tys :: [TypeArg]
    tys) -> NewOrData
    -> Cxt
    -> Name
    -> Maybe [TyVarBndr]
    -> [TypeArg]
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> q [DDec]
    forall (q :: * -> *).
    DsMonad q =>
    NewOrData
    -> Cxt
    -> Name
    -> Maybe [TyVarBndr]
    -> [TypeArg]
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> q [DDec]
    dsDataInstDec NewOrData
    Newtype Cxt
    cxt Name
    n Maybe [TyVarBndr]
    mtvbs [TypeArg]
    tys Maybe Type
    mk [Con
    con] [DerivClause]
    derivings
        (_, _)        -> String -> q [DDec]
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> q [DDec]) -> String -> q [DDec]
    forall a b. (a -> b) -> a -> b
    $ "Unexpected newtype instance LHS: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    forall a. Ppr a => a -> String
    pprint Type
    lhs
    #elif __GLASGOW_HASKELL__ > 710
    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
    #else
    dsDec (DataInstD cxt n tys cons derivings) =
      dsDataInstDec Data cxt n Nothing (map TANormal tys) Nothing cons derivings
    dsDec (NewtypeInstD cxt n tys con derivings) =
      dsDataInstDec Newtype cxt n Nothing (map TANormal tys) Nothing [con] derivings
    #endif
    #if __GLASGOW_HASKELL__ >= 807
    dsDec (TySynInstD eqn :: 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
    #if __GLASGOW_HASKELL__ > 710
    dsDec (ClosedTypeFamilyD tfHead :: TypeFamilyHead
    tfHead eqns :: [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 (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)
    mapM (Name -> TySynEqn -> q DTySynEqn
    forall (q :: * -> *). DsMonad q => Name -> TySynEqn -> q DTySynEqn
    dsTySynEqn (TypeFamilyHead -> Name
    typeFamilyHeadName TypeFamilyHead
    tfHead)) [TySynEqn]
    eqns)
    #else
    dsDec (ClosedTypeFamilyD n tvbs m_k eqns) = do
      (:[]) <$> (DClosedTypeFamilyD <$> dsTypeFamilyHead n tvbs m_k
                                    <*> mapM (dsTySynEqn n) eqns)
    #endif
    dsDec (RoleAnnotD n :: Name
    n roles :: [Role]
    roles) = [DDec] -> q [DDec]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Name -> [Role] -> DDec
    DRoleAnnotD Name
    n [Role]
    roles]
    #if __GLASGOW_HASKELL__ >= 709
    #if __GLASGOW_HASKELL__ >= 801
    dsDec (PatSynD n :: Name
    n args :: PatSynArgs
    args dir :: PatSynDir
    dir pat :: Pat
    pat) = do
      DPatSynDir
    dir' <- Name -> PatSynDir -> q DPatSynDir
    forall (q :: * -> *).
    DsMonad q =>
    Name -> PatSynDir -> q DPatSynDir
    dsPatSynDir Name
    n PatSynDir
    dir
      (pat' :: DPat
    pat', vars :: [(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 (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 (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> q ()) -> String -> q ()
    forall a b. (a -> b) -> a -> b
    $ "Pattern synonym definition cannot contain as-patterns (@)."
      [DDec] -> q [DDec]
    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 n :: Name
    n ty :: 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 -> DType -> DDec
    DPatSynSigD Name
    n (DType -> DDec) -> q DType -> q DDec
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    ty)
    dsDec (StandaloneDerivD mds :: Maybe DerivStrategy
    mds cxt :: Cxt
    cxt ty :: 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 [DTyVarBndr] -> DCxt -> DType -> DDec
    DStandaloneDerivD (Maybe DDerivStrategy
     -> Maybe [DTyVarBndr] -> DCxt -> DType -> DDec)
    -> q (Maybe DDerivStrategy)
    -> q (Maybe [DTyVarBndr] -> DCxt -> DType -> 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)
    mapM DerivStrategy -> q DDerivStrategy
    forall (q :: * -> *).
    DsMonad q =>
    DerivStrategy -> q DDerivStrategy
    dsDerivStrategy Maybe DerivStrategy
    mds
                                   q (Maybe [DTyVarBndr] -> DCxt -> DType -> DDec)
    -> q (Maybe [DTyVarBndr]) -> q (DCxt -> DType -> DDec)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Maybe [DTyVarBndr] -> q (Maybe [DTyVarBndr])
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe [DTyVarBndr]
    forall a. Maybe a
    Nothing q (DCxt -> DType -> DDec) -> q DCxt -> q (DType -> DDec)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Cxt -> q DCxt
    forall (q :: * -> *). DsMonad q => Cxt -> q DCxt
    dsCxt Cxt
    cxt q (DType -> DDec) -> q DType -> q DDec
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    ty)
    #else
    dsDec (StandaloneDerivD cxt ty) =
      (:[]) <$> (DStandaloneDerivD Nothing Nothing <$> dsCxt cxt <*> dsType ty)
    #endif
    dsDec (DefaultSigD n :: Name
    n ty :: 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 -> DType -> DDec
    DDefaultSigD Name
    n (DType -> DDec) -> q DType -> q DDec
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    ty)
    #endif
    #if __GLASGOW_HASKELL__ >= 807
    dsDec (ImplicitParamBindD {}) = String -> q [DDec]
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible "Non-`let`-bound implicit param binding"
    #endif

    -- | Desugar a 'DataD' or 'NewtypeD'.
    dsDataDec :: DsMonad q
              => NewOrData -> Cxt -> Name -> [TyVarBndr]
              -> Maybe Kind -> [Con] -> [DerivingClause] -> q [DDec]
    dsDataDec :: NewOrData
    -> Cxt
    -> Name
    -> [TyVarBndr]
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> q [DDec]
    dsDataDec nd :: NewOrData
    nd cxt :: Cxt
    cxt n :: Name
    n tvbs :: [TyVarBndr]
    tvbs mk :: Maybe Type
    mk cons :: [Con]
    cons derivings :: [DerivClause]
    derivings = do
      [DTyVarBndr]
    tvbs' <- (TyVarBndr -> q DTyVarBndr) -> [TyVarBndr] -> q [DTyVarBndr]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM TyVarBndr -> q DTyVarBndr
    forall (q :: * -> *). DsMonad q => TyVarBndr -> q DTyVarBndr
    dsTvb [TyVarBndr]
    tvbs
      let h98_tvbs :: [DTyVarBndr]
    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 {} -> [DTyVarBndr]
    forall a. a
    unusedArgument
                       Nothing -> [DTyVarBndr]
    tvbs'
          h98_return_type :: DType
    h98_return_type = Name -> [DTyVarBndr] -> DType
    nonFamilyDataReturnType Name
    n [DTyVarBndr]
    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
    <$> (NewOrData
    -> DCxt
    -> Name
    -> [DTyVarBndr]
    -> Maybe DType
    -> [DCon]
    -> [DDerivClause]
    -> DDec
    DDataD NewOrData
    nd (DCxt
     -> Name
     -> [DTyVarBndr]
     -> Maybe DType
     -> [DCon]
     -> [DDerivClause]
     -> DDec)
    -> q DCxt
    -> q (Name
          -> [DTyVarBndr] -> Maybe DType -> [DCon] -> [DDerivClause] -> DDec)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Cxt -> q DCxt
    forall (q :: * -> *). DsMonad q => Cxt -> q DCxt
    dsCxt Cxt
    cxt q (Name
       -> [DTyVarBndr] -> Maybe DType -> [DCon] -> [DDerivClause] -> DDec)
    -> q Name
    -> q ([DTyVarBndr]
          -> Maybe DType -> [DCon] -> [DDerivClause] -> DDec)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Name -> q Name
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Name
    n
                           q ([DTyVarBndr] -> Maybe DType -> [DCon] -> [DDerivClause] -> DDec)
    -> q [DTyVarBndr]
    -> q (Maybe DType -> [DCon] -> [DDerivClause] -> DDec)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [DTyVarBndr] -> q [DTyVarBndr]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [DTyVarBndr]
    tvbs' q (Maybe DType -> [DCon] -> [DDerivClause] -> DDec)
    -> q (Maybe DType) -> q ([DCon] -> [DDerivClause] -> DDec)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Type -> q DType) -> Maybe Type -> q (Maybe DType)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Maybe Type
    mk
                           q ([DCon] -> [DDerivClause] -> DDec)
    -> q [DCon] -> q ([DDerivClause] -> DDec)
    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 ([DTyVarBndr] -> DType -> Con -> q [DCon]
    forall (q :: * -> *).
    DsMonad q =>
    [DTyVarBndr] -> DType -> Con -> q [DCon]
    dsCon [DTyVarBndr]
    h98_tvbs DType
    h98_return_type) [Con]
    cons
                           q ([DDerivClause] -> DDec) -> q [DDerivClause] -> q DDec
    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)
    mapM DerivClause -> q DDerivClause
    forall (q :: * -> *). DsMonad q => DerivClause -> q DDerivClause
    dsDerivClause [DerivClause]
    derivings)

    -- | Desugar a 'DataInstD' or a 'NewtypeInstD'.
    dsDataInstDec :: DsMonad q
                  => NewOrData -> Cxt -> Name -> Maybe [TyVarBndr] -> [TypeArg]
                  -> Maybe Kind -> [Con] -> [DerivingClause] -> q [DDec]
    dsDataInstDec :: NewOrData
    -> Cxt
    -> Name
    -> Maybe [TyVarBndr]
    -> [TypeArg]
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> q [DDec]
    dsDataInstDec nd :: NewOrData
    nd cxt :: Cxt
    cxt n :: Name
    n mtvbs :: Maybe [TyVarBndr]
    mtvbs tys :: [TypeArg]
    tys mk :: Maybe Type
    mk cons :: [Con]
    cons derivings :: [DerivClause]
    derivings = do
      Maybe [DTyVarBndr]
    mtvbs' <- ([TyVarBndr] -> q [DTyVarBndr])
    -> Maybe [TyVarBndr] -> q (Maybe [DTyVarBndr])
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((TyVarBndr -> q DTyVarBndr) -> [TyVarBndr] -> q [DTyVarBndr]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM TyVarBndr -> q DTyVarBndr
    forall (q :: * -> *). DsMonad q => TyVarBndr -> q DTyVarBndr
    dsTvb) Maybe [TyVarBndr]
    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)
    mapM TypeArg -> q DTypeArg
    forall (q :: * -> *). DsMonad q => TypeArg -> q DTypeArg
    dsTypeArg [TypeArg]
    tys
      let lhs' :: DType
    lhs' = DType -> [DTypeArg] -> DType
    applyDType (Name -> DType
    DConT Name
    n) [DTypeArg]
    tys'
          h98_tvbs :: [DTyVarBndr]
    h98_tvbs =
            case (Maybe Type
    mk, Maybe [DTyVarBndr]
    mtvbs') of
              -- If there's an explicit return kind, we're dealing with a
              -- GADT, so this argument goes unused in dsCon.
              (Just {}, _)          -> [DTyVarBndr]
    forall a. a
    unusedArgument
              -- H98, and there is an explicit `forall` in front. Just reuse the
              -- type variable binders from the `forall`.
              (Nothing, Just tvbs' :: [DTyVarBndr]
    tvbs') -> [DTyVarBndr]
    tvbs'
              -- H98, and no explicit `forall`. Compute the bound variables
              -- manually.
              (Nothing, Nothing)    -> [DTypeArg] -> [DTyVarBndr]
    dataFamInstTvbs [DTypeArg]
    tys'
          h98_fam_inst_type :: DType
    h98_fam_inst_type = Name -> [DTypeArg] -> DType
    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
    <$> (NewOrData
    -> DCxt
    -> Maybe [DTyVarBndr]
    -> DType
    -> Maybe DType
    -> [DCon]
    -> [DDerivClause]
    -> DDec
    DDataInstD NewOrData
    nd (DCxt
     -> Maybe [DTyVarBndr]
     -> DType
     -> Maybe DType
     -> [DCon]
     -> [DDerivClause]
     -> DDec)
    -> q DCxt
    -> q (Maybe [DTyVarBndr]
          -> DType -> Maybe DType -> [DCon] -> [DDerivClause] -> DDec)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Cxt -> q DCxt
    forall (q :: * -> *). DsMonad q => Cxt -> q DCxt
    dsCxt Cxt
    cxt q (Maybe [DTyVarBndr]
       -> DType -> Maybe DType -> [DCon] -> [DDerivClause] -> DDec)
    -> q (Maybe [DTyVarBndr])
    -> q (DType -> Maybe DType -> [DCon] -> [DDerivClause] -> DDec)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Maybe [DTyVarBndr] -> q (Maybe [DTyVarBndr])
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe [DTyVarBndr]
    mtvbs'
                               q (DType -> Maybe DType -> [DCon] -> [DDerivClause] -> DDec)
    -> q DType -> q (Maybe DType -> [DCon] -> [DDerivClause] -> DDec)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> DType -> q DType
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure DType
    lhs' q (Maybe DType -> [DCon] -> [DDerivClause] -> DDec)
    -> q (Maybe DType) -> q ([DCon] -> [DDerivClause] -> DDec)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Type -> q DType) -> Maybe Type -> q (Maybe DType)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Maybe Type
    mk
                               q ([DCon] -> [DDerivClause] -> DDec)
    -> q [DCon] -> q ([DDerivClause] -> DDec)
    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 ([DTyVarBndr] -> DType -> Con -> q [DCon]
    forall (q :: * -> *).
    DsMonad q =>
    [DTyVarBndr] -> DType -> Con -> q [DCon]
    dsCon [DTyVarBndr]
    h98_tvbs DType
    h98_fam_inst_type) [Con]
    cons
                               q ([DDerivClause] -> DDec) -> q [DDerivClause] -> q DDec
    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)
    mapM DerivClause -> q DDerivClause
    forall (q :: * -> *). DsMonad q => DerivClause -> q DDerivClause
    dsDerivClause [DerivClause]
    derivings)

    -- Like mkExtraDKindBinders, but accepts a Maybe Kind
    -- argument instead of DKind.
    mkExtraKindBinders :: DsMonad q => Maybe Kind -> q [DTyVarBndr]
    mkExtraKindBinders :: Maybe Type -> q [DTyVarBndr]
    mkExtraKindBinders =
      q DType -> (Type -> q DType) -> Maybe Type -> q DType
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (DType -> q DType
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Name -> DType
    DConT Name
    typeKindName)) (Q Type -> q Type
    forall (m :: * -> *) a. Quasi m => Q a -> m a
    runQ (Q Type -> q Type) -> (Type -> Q Type) -> Type -> q Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> Q Type
    resolveTypeSynonyms (Type -> q Type) -> (Type -> q DType) -> Type -> q DType
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType)
        (Maybe Type -> q DType)
    -> (DType -> q [DTyVarBndr]) -> Maybe Type -> q [DTyVarBndr]
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> DType -> q [DTyVarBndr]
    forall (q :: * -> *). Quasi q => DType -> q [DTyVarBndr]
    mkExtraDKindBinders'

    -- | Like mkExtraDKindBinders, but assumes kind synonyms have been expanded.
    mkExtraDKindBinders' :: Quasi q => DKind -> q [DTyVarBndr]
    mkExtraDKindBinders' :: DType -> q [DTyVarBndr]
    mkExtraDKindBinders' = (DType -> ([DTyVarBndr], DCxt, DCxt, DType))
    -> (Name -> DType -> DTyVarBndr) -> DType -> q [DTyVarBndr]
    forall (q :: * -> *) kind tyVarBndr pred.
    Quasi q =>
    (kind -> ([tyVarBndr], [pred], [kind], kind))
    -> (Name -> kind -> tyVarBndr) -> kind -> q [tyVarBndr]
    mkExtraKindBindersGeneric DType -> ([DTyVarBndr], DCxt, DCxt, DType)
    unravel Name -> DType -> DTyVarBndr
    DKindedTV

    #if __GLASGOW_HASKELL__ > 710
    -- | Desugar a @FamilyResultSig@
    dsFamilyResultSig :: DsMonad q => FamilyResultSig -> q DFamilyResultSig
    dsFamilyResultSig :: FamilyResultSig -> q DFamilyResultSig
    dsFamilyResultSig NoSig          = DFamilyResultSig -> q DFamilyResultSig
    forall (m :: * -> *) a. Monad m => a -> m a
    return DFamilyResultSig
    DNoSig
    dsFamilyResultSig (KindSig k :: Type
    k)    = DType -> DFamilyResultSig
    DKindSig (DType -> DFamilyResultSig) -> q DType -> q DFamilyResultSig
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    k
    dsFamilyResultSig (TyVarSig tvb :: TyVarBndr
    tvb) = DTyVarBndr -> DFamilyResultSig
    DTyVarSig (DTyVarBndr -> DFamilyResultSig)
    -> q DTyVarBndr -> q DFamilyResultSig
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TyVarBndr -> q DTyVarBndr
    forall (q :: * -> *). DsMonad q => TyVarBndr -> q DTyVarBndr
    dsTvb TyVarBndr
    tvb

    -- | Desugar a @TypeFamilyHead@
    dsTypeFamilyHead :: DsMonad q => TypeFamilyHead -> q DTypeFamilyHead
    dsTypeFamilyHead :: TypeFamilyHead -> q DTypeFamilyHead
    dsTypeFamilyHead (TypeFamilyHead n :: Name
    n tvbs :: [TyVarBndr]
    tvbs result :: FamilyResultSig
    result inj :: Maybe InjectivityAnn
    inj)
      = Name
    -> [DTyVarBndr]
    -> DFamilyResultSig
    -> Maybe InjectivityAnn
    -> DTypeFamilyHead
    DTypeFamilyHead Name
    n ([DTyVarBndr]
     -> DFamilyResultSig -> Maybe InjectivityAnn -> DTypeFamilyHead)
    -> q [DTyVarBndr]
    -> q (DFamilyResultSig -> Maybe InjectivityAnn -> DTypeFamilyHead)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (TyVarBndr -> q DTyVarBndr) -> [TyVarBndr] -> q [DTyVarBndr]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM TyVarBndr -> q DTyVarBndr
    forall (q :: * -> *). DsMonad q => TyVarBndr -> q DTyVarBndr
    dsTvb [TyVarBndr]
    tvbs
                          q (DFamilyResultSig -> Maybe InjectivityAnn -> DTypeFamilyHead)
    -> q DFamilyResultSig
    -> q (Maybe InjectivityAnn -> DTypeFamilyHead)
    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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Maybe InjectivityAnn -> q (Maybe InjectivityAnn)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe InjectivityAnn
    inj

    typeFamilyHeadName :: TypeFamilyHead -> Name
    typeFamilyHeadName :: TypeFamilyHead -> Name
    typeFamilyHeadName (TypeFamilyHead n :: Name
    n _ _ _) = Name
    n
    #else
    -- | Desugar bits and pieces into a 'DTypeFamilyHead'
    dsTypeFamilyHead :: DsMonad q
                     => Name -> [TyVarBndr] -> Maybe Kind -> q DTypeFamilyHead
    dsTypeFamilyHead n tvbs m_kind = do
      result_sig <- case m_kind of
        Nothing -> return DNoSig
        Just k  -> DKindSig <$> dsType k
      DTypeFamilyHead n <$> mapM dsTvb tvbs
                        <*> pure result_sig
                        <*> pure Nothing
    #endif

    -- | 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 :: [Dec] -> q ([DLetDec], DExp -> DExp)
    dsLetDecs decs :: [Dec]
    decs = do
      (let_decss :: [[DLetDec]]
    let_decss, ip_binders :: [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 (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 (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 :: Dec -> q ([DLetDec], DExp -> DExp)
    dsLetDec (FunD name :: Name
    name clauses :: [Clause]
    clauses) = do
      [DClause]
    clauses' <- Name -> [Clause] -> q [DClause]
    forall (q :: * -> *). DsMonad q => Name -> [Clause] -> q [DClause]
    dsClauses Name
    name [Clause]
    clauses
      ([DLetDec], DExp -> DExp) -> q ([DLetDec], DExp -> DExp)
    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
    pat body :: Body
    body where_decs :: [Dec]
    where_decs) = do
      (pat' :: DPat
    pat', vars :: [(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 (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 = DExp -> DExp -> DExp
    DAppE (Name -> DExp
    DVarE 'error) (Lit -> DExp
    DLitE
                           (String -> Lit
    StringL (String -> Lit) -> String -> Lit
    forall a b. (a -> b) -> a -> b
    $ "Non-exhaustive patterns for " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Pat -> String
    forall a. Ppr a => a -> String
    pprint Pat
    pat))
    dsLetDec (SigD name :: Name
    name ty :: Type
    ty) = do
      DType
    ty' <- Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    ty
      ([DLetDec], DExp -> DExp) -> q ([DLetDec], DExp -> DExp)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Name -> DType -> DLetDec
    DSigD Name
    name DType
    ty'], DExp -> DExp
    forall a. a -> a
    id)
    dsLetDec (InfixD fixity :: Fixity
    fixity name :: Name
    name) = ([DLetDec], DExp -> DExp) -> q ([DLetDec], DExp -> DExp)
    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 prag :: 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 (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 n :: String
    n e :: 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
    $ "new_" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    n String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "_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 -> DType -> DExp
    `DAppTypeE`
                         TyLit -> DType
    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 (m :: * -> *) a. Monad m => a -> m a
    return ([DLetDec
    let_dec], DExp -> DExp
    ip_binder)
    #endif
    dsLetDec _dec :: Dec
    _dec = String -> q ([DLetDec], DExp -> DExp)
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible "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 :: Dec -> q [DDec]
    dsTopLevelLetDec = (([DLetDec], DExp -> DExp) -> [DDec])
    -> q ([DLetDec], DExp -> DExp) -> q [DDec]
    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
          => [DTyVarBndr] -- ^ 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 :: [DTyVarBndr] -> DType -> Con -> q [DCon]
    dsCon univ_dtvbs :: [DTyVarBndr]
    univ_dtvbs data_type :: DType
    data_type con :: Con
    con = do
      [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    dcons' <- Con -> q [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    forall (q :: * -> *).
    DsMonad q =>
    Con -> q [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    dsCon' Con
    con
      [DCon] -> q [DCon]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([DCon] -> q [DCon]) -> [DCon] -> q [DCon]
    forall a b. (a -> b) -> a -> b
    $ (((Name, [DTyVarBndr], DCxt, DConFields, Maybe DType) -> DCon)
     -> [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)] -> [DCon])
    -> [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    -> ((Name, [DTyVarBndr], DCxt, DConFields, Maybe DType) -> DCon)
    -> [DCon]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ((Name, [DTyVarBndr], DCxt, DConFields, Maybe DType) -> DCon)
    -> [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)] -> [DCon]
    forall a b. (a -> b) -> [a] -> [b]
    map [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    dcons' (((Name, [DTyVarBndr], DCxt, DConFields, Maybe DType) -> DCon)
     -> [DCon])
    -> ((Name, [DTyVarBndr], DCxt, DConFields, Maybe DType) -> DCon)
    -> [DCon]
    forall a b. (a -> b) -> a -> b
    $ \(n :: Name
    n, dtvbs :: [DTyVarBndr]
    dtvbs, dcxt :: DCxt
    dcxt, fields :: DConFields
    fields, m_gadt_type :: Maybe DType
    m_gadt_type) ->
        case Maybe DType
    m_gadt_type of
          Nothing ->
            let ex_dtvbs :: [DTyVarBndr]
    ex_dtvbs   = [DTyVarBndr]
    dtvbs
                expl_dtvbs :: [DTyVarBndr]
    expl_dtvbs = [DTyVarBndr]
    univ_dtvbs [DTyVarBndr] -> [DTyVarBndr] -> [DTyVarBndr]
    forall a. [a] -> [a] -> [a]
    ++ [DTyVarBndr]
    ex_dtvbs
                impl_dtvbs :: [DTyVarBndr]
    impl_dtvbs = DCxt -> [DTyVarBndr]
    toposortTyVarsOf (DCxt -> [DTyVarBndr]) -> DCxt -> [DTyVarBndr]
    forall a b. (a -> b) -> a -> b
    $ (DTyVarBndr -> Maybe DType) -> [DTyVarBndr] -> DCxt
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe DTyVarBndr -> Maybe DType
    extractTvbKind [DTyVarBndr]
    expl_dtvbs in
            [DTyVarBndr] -> DCxt -> Name -> DConFields -> DType -> DCon
    DCon ([DTyVarBndr]
    impl_dtvbs [DTyVarBndr] -> [DTyVarBndr] -> [DTyVarBndr]
    forall a. [a] -> [a] -> [a]
    ++ [DTyVarBndr]
    expl_dtvbs) DCxt
    dcxt Name
    n DConFields
    fields DType
    data_type
          Just gadt_type :: DType
    gadt_type ->
            let univ_ex_dtvbs :: [DTyVarBndr]
    univ_ex_dtvbs = [DTyVarBndr]
    dtvbs in
            [DTyVarBndr] -> DCxt -> Name -> DConFields -> DType -> DCon
    DCon [DTyVarBndr]
    univ_ex_dtvbs DCxt
    dcxt Name
    n DConFields
    fields DType
    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, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    dsCon' :: Con -> q [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    dsCon' (NormalC n :: Name
    n stys :: [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)
    mapM BangType -> q DBangType
    forall (q :: * -> *). DsMonad q => BangType -> q DBangType
    dsBangType [BangType]
    stys
      [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    -> q [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(Name
    n, [], [], Bool -> [DBangType] -> DConFields
    DNormalC Bool
    False [DBangType]
    dtys, Maybe DType
    forall a. Maybe a
    Nothing)]
    dsCon' (RecC n :: Name
    n vstys :: [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)
    mapM VarBangType -> q DVarBangType
    forall (q :: * -> *). DsMonad q => VarBangType -> q DVarBangType
    dsVarBangType [VarBangType]
    vstys
      [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    -> q [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(Name
    n, [], [], [DVarBangType] -> DConFields
    DRecC [DVarBangType]
    vdtys, Maybe DType
    forall a. Maybe a
    Nothing)]
    dsCon' (InfixC sty1 :: BangType
    sty1 n :: Name
    n sty2 :: 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, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    -> q [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(Name
    n, [], [], Bool -> [DBangType] -> DConFields
    DNormalC Bool
    True [DBangType
    dty1, DBangType
    dty2], Maybe DType
    forall a. Maybe a
    Nothing)]
    dsCon' (ForallC tvbs :: [TyVarBndr]
    tvbs cxt :: Cxt
    cxt con :: Con
    con) = do
      [DTyVarBndr]
    dtvbs <- (TyVarBndr -> q DTyVarBndr) -> [TyVarBndr] -> q [DTyVarBndr]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM TyVarBndr -> q DTyVarBndr
    forall (q :: * -> *). DsMonad q => TyVarBndr -> q DTyVarBndr
    dsTvb [TyVarBndr]
    tvbs
      DCxt
    dcxt <- Cxt -> q DCxt
    forall (q :: * -> *). DsMonad q => Cxt -> q DCxt
    dsCxt Cxt
    cxt
      [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    dcons' <- Con -> q [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    forall (q :: * -> *).
    DsMonad q =>
    Con -> q [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    dsCon' Con
    con
      [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    -> q [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
     -> q [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)])
    -> [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    -> q [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    forall a b. (a -> b) -> a -> b
    $ (((Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)
      -> (Name, [DTyVarBndr], DCxt, DConFields, Maybe DType))
     -> [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
     -> [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)])
    -> [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    -> ((Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)
        -> (Name, [DTyVarBndr], DCxt, DConFields, Maybe DType))
    -> [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ((Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)
     -> (Name, [DTyVarBndr], DCxt, DConFields, Maybe DType))
    -> [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    -> [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    forall a b. (a -> b) -> [a] -> [b]
    map [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    dcons' (((Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)
      -> (Name, [DTyVarBndr], DCxt, DConFields, Maybe DType))
     -> [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)])
    -> ((Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)
        -> (Name, [DTyVarBndr], DCxt, DConFields, Maybe DType))
    -> [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    forall a b. (a -> b) -> a -> b
    $ \(n :: Name
    n, dtvbs' :: [DTyVarBndr]
    dtvbs', dcxt' :: DCxt
    dcxt', fields :: DConFields
    fields, m_gadt_type :: Maybe DType
    m_gadt_type) ->
        (Name
    n, [DTyVarBndr]
    dtvbs [DTyVarBndr] -> [DTyVarBndr] -> [DTyVarBndr]
    forall a. [a] -> [a] -> [a]
    ++ [DTyVarBndr]
    dtvbs', DCxt
    dcxt DCxt -> DCxt -> DCxt
    forall a. [a] -> [a] -> [a]
    ++ DCxt
    dcxt', DConFields
    fields, Maybe DType
    m_gadt_type)
    #if __GLASGOW_HASKELL__ > 710
    dsCon' (GadtC nms :: [Name]
    nms btys :: [BangType]
    btys rty :: 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)
    mapM BangType -> q DBangType
    forall (q :: * -> *). DsMonad q => BangType -> q DBangType
    dsBangType [BangType]
    btys
      DType
    drty  <- Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    rty
      [q (Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    -> q [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    sequence ([q (Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
     -> q [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)])
    -> [q (Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    -> q [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    forall a b. (a -> b) -> a -> b
    $ ((Name -> q (Name, [DTyVarBndr], DCxt, DConFields, Maybe DType))
     -> [Name]
     -> [q (Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)])
    -> [Name]
    -> (Name -> q (Name, [DTyVarBndr], DCxt, DConFields, Maybe DType))
    -> [q (Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (Name -> q (Name, [DTyVarBndr], DCxt, DConFields, Maybe DType))
    -> [Name]
    -> [q (Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    forall a b. (a -> b) -> [a] -> [b]
    map [Name]
    nms ((Name -> q (Name, [DTyVarBndr], DCxt, DConFields, Maybe DType))
     -> [q (Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)])
    -> (Name -> q (Name, [DTyVarBndr], DCxt, DConFields, Maybe DType))
    -> [q (Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    forall a b. (a -> b) -> a -> b
    $ \nm :: 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 (t :: * -> *) a. Foldable t => t a -> Int
    length [DBangType]
    dbtys Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 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, [DTyVarBndr], DCxt, DConFields, Maybe DType)
    -> q (Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name
    nm, [], [], Bool -> [DBangType] -> DConFields
    DNormalC Bool
    decInfix [DBangType]
    dbtys, DType -> Maybe DType
    forall a. a -> Maybe a
    Just DType
    drty)
    dsCon' (RecGadtC nms :: [Name]
    nms vbtys :: [VarBangType]
    vbtys rty :: 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)
    mapM VarBangType -> q DVarBangType
    forall (q :: * -> *). DsMonad q => VarBangType -> q DVarBangType
    dsVarBangType [VarBangType]
    vbtys
      DType
    drty   <- Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    rty
      [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    -> q [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
     -> q [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)])
    -> [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    -> q [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    forall a b. (a -> b) -> a -> b
    $ ((Name -> (Name, [DTyVarBndr], DCxt, DConFields, Maybe DType))
     -> [Name] -> [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)])
    -> [Name]
    -> (Name -> (Name, [DTyVarBndr], DCxt, DConFields, Maybe DType))
    -> [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (Name -> (Name, [DTyVarBndr], DCxt, DConFields, Maybe DType))
    -> [Name] -> [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    forall a b. (a -> b) -> [a] -> [b]
    map [Name]
    nms ((Name -> (Name, [DTyVarBndr], DCxt, DConFields, Maybe DType))
     -> [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)])
    -> (Name -> (Name, [DTyVarBndr], DCxt, DConFields, Maybe DType))
    -> [(Name, [DTyVarBndr], DCxt, DConFields, Maybe DType)]
    forall a b. (a -> b) -> a -> b
    $ \nm :: Name
    nm ->
        (Name
    nm, [], [], [DVarBangType] -> DConFields
    DRecC [DVarBangType]
    dvbtys, DType -> Maybe DType
    forall a. a -> Maybe a
    Just DType
    drty)
    #endif

    #if __GLASGOW_HASKELL__ > 710
    -- | Desugar a @BangType@ (or a @StrictType@, if you're old-fashioned)
    dsBangType :: DsMonad q => BangType -> q DBangType
    dsBangType :: BangType -> q DBangType
    dsBangType (b :: Bang
    b, ty :: Type
    ty) = (Bang
    b, ) (DType -> DBangType) -> q DType -> q DBangType
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    ty

    -- | Desugar a @VarBangType@ (or a @VarStrictType@, if you're old-fashioned)
    dsVarBangType :: DsMonad q => VarBangType -> q DVarBangType
    dsVarBangType :: VarBangType -> q DVarBangType
    dsVarBangType (n :: Name
    n, b :: Bang
    b, ty :: Type
    ty) = (Name
    n, Bang
    b, ) (DType -> DVarBangType) -> q DType -> q DVarBangType
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    ty
    #else
    -- | Desugar a @BangType@ (or a @StrictType@, if you're old-fashioned)
    dsBangType :: DsMonad q => StrictType -> q DBangType
    dsBangType (b, ty) = (strictToBang b, ) <$> dsType ty

    -- | Desugar a @VarBangType@ (or a @VarStrictType@, if you're old-fashioned)
    dsVarBangType :: DsMonad q => VarStrictType -> q DVarBangType
    dsVarBangType (n, b, ty) = (n, strictToBang b, ) <$> dsType ty
    #endif

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

    -- | Desugar a @Pragma@.
    dsPragma :: DsMonad q => Pragma -> q DPragma
    dsPragma :: Pragma -> q DPragma
    dsPragma (InlineP n :: Name
    n inl :: Inline
    inl rm :: RuleMatch
    rm phases :: Phases
    phases)       = DPragma -> q DPragma
    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 n :: Name
    n ty :: Type
    ty m_inl :: Maybe Inline
    m_inl phases :: Phases
    phases) = Name -> DType -> Maybe Inline -> Phases -> DPragma
    DSpecialiseP Name
    n (DType -> Maybe Inline -> Phases -> DPragma)
    -> q DType -> q (Maybe Inline -> Phases -> DPragma)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    ty
                                                              q (Maybe Inline -> Phases -> DPragma)
    -> q (Maybe Inline) -> q (Phases -> DPragma)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Maybe Inline -> q (Maybe Inline)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Inline
    m_inl
                                                              q (Phases -> DPragma) -> q Phases -> q DPragma
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Phases -> q Phases
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Phases
    phases
    dsPragma (SpecialiseInstP ty :: Type
    ty)            = DType -> DPragma
    DSpecialiseInstP (DType -> DPragma) -> q DType -> q DPragma
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    ty
    #if __GLASGOW_HASKELL__ >= 807
    dsPragma (RuleP str :: String
    str mtvbs :: Maybe [TyVarBndr]
    mtvbs rbs :: [RuleBndr]
    rbs lhs :: Exp
    lhs rhs :: Exp
    rhs phases :: Phases
    phases)
                                             = String
    -> Maybe [DTyVarBndr]
    -> [DRuleBndr]
    -> DExp
    -> DExp
    -> Phases
    -> DPragma
    DRuleP String
    str (Maybe [DTyVarBndr]
     -> [DRuleBndr] -> DExp -> DExp -> Phases -> DPragma)
    -> q (Maybe [DTyVarBndr])
    -> q ([DRuleBndr] -> DExp -> DExp -> Phases -> DPragma)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ([TyVarBndr] -> q [DTyVarBndr])
    -> Maybe [TyVarBndr] -> q (Maybe [DTyVarBndr])
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((TyVarBndr -> q DTyVarBndr) -> [TyVarBndr] -> q [DTyVarBndr]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM TyVarBndr -> q DTyVarBndr
    forall (q :: * -> *). DsMonad q => TyVarBndr -> q DTyVarBndr
    dsTvb) Maybe [TyVarBndr]
    mtvbs
                                                          q ([DRuleBndr] -> DExp -> DExp -> Phases -> DPragma)
    -> q [DRuleBndr] -> q (DExp -> DExp -> Phases -> DPragma)
    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)
    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 (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 (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Phases -> q Phases
    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 target :: AnnTarget
    target exp :: 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
    #if __GLASGOW_HASKELL__ >= 709
    dsPragma (LineP n :: Int
    n str :: String
    str)                   = DPragma -> q DPragma
    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
    #endif
    #if __GLASGOW_HASKELL__ >= 801
    dsPragma (CompleteP cls :: [Name]
    cls mty :: Maybe Name
    mty)             = DPragma -> q DPragma
    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

    -- | Desugar a @RuleBndr@.
    dsRuleBndr :: DsMonad q => RuleBndr -> q DRuleBndr
    dsRuleBndr :: RuleBndr -> q DRuleBndr
    dsRuleBndr (RuleVar n :: Name
    n)         = DRuleBndr -> q DRuleBndr
    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 n :: Name
    n ty :: Type
    ty) = Name -> DType -> DRuleBndr
    DTypedRuleVar Name
    n (DType -> DRuleBndr) -> q DType -> q DRuleBndr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    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 :: Name -> TySynEqn -> q DTySynEqn
    dsTySynEqn _ (TySynEqn mtvbs :: Maybe [TyVarBndr]
    mtvbs lhs :: Type
    lhs rhs :: Type
    rhs) =
      Maybe [DTyVarBndr] -> DType -> DType -> DTySynEqn
    DTySynEqn (Maybe [DTyVarBndr] -> DType -> DType -> DTySynEqn)
    -> q (Maybe [DTyVarBndr]) -> q (DType -> DType -> DTySynEqn)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ([TyVarBndr] -> q [DTyVarBndr])
    -> Maybe [TyVarBndr] -> q (Maybe [DTyVarBndr])
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((TyVarBndr -> q DTyVarBndr) -> [TyVarBndr] -> q [DTyVarBndr]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM TyVarBndr -> q DTyVarBndr
    forall (q :: * -> *). DsMonad q => TyVarBndr -> q DTyVarBndr
    dsTvb) Maybe [TyVarBndr]
    mtvbs q (DType -> DType -> DTySynEqn)
    -> q DType -> q (DType -> DTySynEqn)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    lhs q (DType -> DTySynEqn) -> q DType -> q DTySynEqn
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    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
              => Name         -- ^ Name of the function
              -> [Clause]     -- ^ Clauses to desugar
              -> q [DClause]
    dsClauses :: Name -> [Clause] -> q [DClause]
    dsClauses _ [] = [DClause] -> q [DClause]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
    dsClauses n :: Name
    n (Clause pats :: [Pat]
    pats (NormalB exp :: Exp
    exp) where_decs :: [Dec]
    where_decs : rest :: [Clause]
    rest) = do
      -- this case is necessary to maintain the roundtrip property.
      [DClause]
    rest' <- Name -> [Clause] -> q [DClause]
    forall (q :: * -> *). DsMonad q => Name -> [Clause] -> q [DClause]
    dsClauses Name
    n [Clause]
    rest
      DExp
    exp' <- Exp -> q DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp Exp
    exp
      (where_decs' :: [DLetDec]
    where_decs', ip_binder :: 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')
      (pats' :: [DPat]
    pats', exp'' :: 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 (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 n :: Name
    n clauses :: [Clause]
    clauses@(Clause outer_pats :: [Pat]
    outer_pats _ _ : _) = do
      [Name]
    arg_names <- Int -> q Name -> q [Name]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM ([Pat] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Pat]
    outer_pats) (String -> q Name
    forall (q :: * -> *). Quasi q => String -> q Name
    newUniqueName "arg")
      let scrutinee :: DExp
    scrutinee = [DExp] -> DExp
    mkTupleDExp ((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 (m :: * -> *) a. Monad m => a -> m a
    return [DClause
    clause]
      where
        clause_to_dmatch :: DsMonad q => DExp -> Clause -> [DMatch] -> q [DMatch]
        clause_to_dmatch :: DExp -> Clause -> [DMatch] -> q [DMatch]
    clause_to_dmatch scrutinee :: DExp
    scrutinee (Clause pats :: [Pat]
    pats body :: Body
    body where_decs :: [Dec]
    where_decs) failure_matches :: [DMatch]
    failure_matches = do
          let failure_exp :: DExp
    failure_exp = String -> DExp -> [DMatch] -> DExp
    maybeDCaseE ("Non-exhaustive patterns in " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (Name -> String
    forall a. Show a => a -> String
    show Name
    n))
                                        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
          (pats' :: [DPat]
    pats', exp' :: 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 (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 (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
    mkTupleDPat [DPat]
    pats') DExp
    exp'
          if Bool
    uni_pats
          then [DMatch] -> q [DMatch]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [DMatch
    match]
          else [DMatch] -> q [DMatch]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DMatch
    match DMatch -> [DMatch] -> [DMatch]
    forall a. a -> [a] -> [a]
    : [DMatch]
    failure_matches)

    -- | Desugar a type
    dsType :: DsMonad q => Type -> q DType
    dsType :: Type -> q DType
    dsType (ForallT tvbs :: [TyVarBndr]
    tvbs preds :: Cxt
    preds ty :: Type
    ty) = [DTyVarBndr] -> DCxt -> DType -> DType
    DForallT ([DTyVarBndr] -> DCxt -> DType -> DType)
    -> q [DTyVarBndr] -> q (DCxt -> DType -> DType)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (TyVarBndr -> q DTyVarBndr) -> [TyVarBndr] -> q [DTyVarBndr]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM TyVarBndr -> q DTyVarBndr
    forall (q :: * -> *). DsMonad q => TyVarBndr -> q DTyVarBndr
    dsTvb [TyVarBndr]
    tvbs q (DCxt -> DType -> DType) -> q DCxt -> q (DType -> DType)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Cxt -> q DCxt
    forall (q :: * -> *). DsMonad q => Cxt -> q DCxt
    dsCxt Cxt
    preds q (DType -> DType) -> q DType -> q DType
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    ty
    dsType (AppT t1 :: Type
    t1 t2 :: Type
    t2) = DType -> DType -> DType
    DAppT (DType -> DType -> DType) -> q DType -> q (DType -> DType)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    t1 q (DType -> DType) -> q DType -> q DType
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    t2
    dsType (SigT ty :: Type
    ty ki :: Type
    ki) = DType -> DType -> DType
    DSigT (DType -> DType -> DType) -> q DType -> q (DType -> DType)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    ty q (DType -> DType) -> q DType -> q DType
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    ki
    dsType (VarT name :: Name
    name) = DType -> q DType
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DType -> q DType) -> DType -> q DType
    forall a b. (a -> b) -> a -> b
    $ Name -> DType
    DVarT Name
    name
    dsType (ConT name :: Name
    name) = DType -> q DType
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DType -> q DType) -> DType -> q DType
    forall a b. (a -> b) -> a -> b
    $ Name -> DType
    DConT Name
    name
      -- the only difference between ConT and PromotedT is the name lookup. Here, we assume
      -- that the TH quote mechanism figured out the right name. Note that lookupDataName name
      -- does not necessarily work, because `name` has its original module attached, which
      -- may not be in scope.
    dsType (PromotedT name :: Name
    name) = DType -> q DType
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DType -> q DType) -> DType -> q DType
    forall a b. (a -> b) -> a -> b
    $ Name -> DType
    DConT Name
    name
    dsType (TupleT n :: Int
    n) = DType -> q DType
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DType -> q DType) -> DType -> q DType
    forall a b. (a -> b) -> a -> b
    $ Name -> DType
    DConT (Int -> Name
    tupleTypeName Int
    n)
    dsType (UnboxedTupleT n :: Int
    n) = DType -> q DType
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DType -> q DType) -> DType -> q DType
    forall a b. (a -> b) -> a -> b
    $ Name -> DType
    DConT (Int -> Name
    unboxedTupleTypeName Int
    n)
    dsType ArrowT = DType -> q DType
    forall (m :: * -> *) a. Monad m => a -> m a
    return DType
    DArrowT
    dsType ListT = DType -> q DType
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DType -> q DType) -> DType -> q DType
    forall a b. (a -> b) -> a -> b
    $ Name -> DType
    DConT ''[]
    dsType (PromotedTupleT n :: Int
    n) = DType -> q DType
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DType -> q DType) -> DType -> q DType
    forall a b. (a -> b) -> a -> b
    $ Name -> DType
    DConT (Int -> Name
    tupleDataName Int
    n)
    dsType PromotedNilT = DType -> q DType
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DType -> q DType) -> DType -> q DType
    forall a b. (a -> b) -> a -> b
    $ Name -> DType
    DConT '[]
    dsType PromotedConsT = DType -> q DType
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DType -> q DType) -> DType -> q DType
    forall a b. (a -> b) -> a -> b
    $ Name -> DType
    DConT '(:)
    dsType StarT = DType -> q DType
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DType -> q DType) -> DType -> q DType
    forall a b. (a -> b) -> a -> b
    $ Name -> DType
    DConT Name
    typeKindName
    dsType ConstraintT = DType -> q DType
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DType -> q DType) -> DType -> q DType
    forall a b. (a -> b) -> a -> b
    $ Name -> DType
    DConT ''Constraint
    dsType (LitT lit :: TyLit
    lit) = DType -> q DType
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DType -> q DType) -> DType -> q DType
    forall a b. (a -> b) -> a -> b
    $ TyLit -> DType
    DLitT TyLit
    lit
    #if __GLASGOW_HASKELL__ >= 709
    dsType EqualityT = DType -> q DType
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DType -> q DType) -> DType -> q DType
    forall a b. (a -> b) -> a -> b
    $ Name -> DType
    DConT ''(~)
    #endif
    #if __GLASGOW_HASKELL__ > 710
    dsType (InfixT t1 :: Type
    t1 n :: Name
    n t2 :: Type
    t2) = DType -> DType -> DType
    DAppT (DType -> DType -> DType) -> q DType -> q (DType -> DType)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (DType -> DType -> DType
    DAppT (Name -> DType
    DConT Name
    n) (DType -> DType) -> q DType -> q DType
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    t1) q (DType -> DType) -> q DType -> q DType
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    t2
    dsType (UInfixT _ _ _) = String -> q DType
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail "Cannot desugar unresolved infix operators."
    dsType (ParensT t :: Type
    t) = Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    t
    dsType WildCardT = DType -> q DType
    forall (m :: * -> *) a. Monad m => a -> m a
    return DType
    DWildCardT
    #endif
    #if __GLASGOW_HASKELL__ >= 801
    dsType (UnboxedSumT arity :: Int
    arity) = DType -> q DType
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DType -> q DType) -> DType -> q DType
    forall a b. (a -> b) -> a -> b
    $ Name -> DType
    DConT (Int -> Name
    unboxedSumTypeName Int
    arity)
    #endif
    #if __GLASGOW_HASKELL__ >= 807
    dsType (AppKindT t :: Type
    t k :: Type
    k) = DType -> DType -> DType
    DAppKindT (DType -> DType -> DType) -> q DType -> q (DType -> DType)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    t q (DType -> DType) -> q DType -> q DType
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    k
    dsType (ImplicitParamT n :: String
    n t :: Type
    t) = do
      DType
    t' <- Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    t
      DType -> q DType
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DType -> q DType) -> DType -> q DType
    forall a b. (a -> b) -> a -> b
    $ Name -> DType
    DConT ''IP DType -> DType -> DType
    `DAppT` TyLit -> DType
    DLitT (String -> TyLit
    StrTyLit String
    n) DType -> DType -> DType
    `DAppT` DType
    t'
    #endif

    -- | Desugar a @TyVarBndr@
    dsTvb :: DsMonad q => TyVarBndr -> q DTyVarBndr
    dsTvb :: TyVarBndr -> q DTyVarBndr
    dsTvb (PlainTV n :: Name
    n) = DTyVarBndr -> q DTyVarBndr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DTyVarBndr -> q DTyVarBndr) -> DTyVarBndr -> q DTyVarBndr
    forall a b. (a -> b) -> a -> b
    $ Name -> DTyVarBndr
    DPlainTV Name
    n
    dsTvb (KindedTV n :: Name
    n k :: Type
    k) = Name -> DType -> DTyVarBndr
    DKindedTV Name
    n (DType -> DTyVarBndr) -> q DType -> q DTyVarBndr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    k

    -- | Desugar a @Cxt@
    dsCxt :: DsMonad q => Cxt -> q DCxt
    dsCxt :: Cxt -> q DCxt
    dsCxt = (Type -> q DCxt) -> Cxt -> q DCxt
    forall (monad :: * -> *) monoid (t :: * -> *) a.
    (Monad monad, Monoid monoid, Traversable t) =>
    (a -> monad monoid) -> t a -> monad monoid
    concatMapM Type -> q DCxt
    forall (q :: * -> *). DsMonad q => Type -> q DCxt
    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 :: DerivClause -> q DDerivClause
    dsDerivClause (DerivClause mds :: Maybe DerivStrategy
    mds cxt :: Cxt
    cxt) =
      Maybe DDerivStrategy -> DCxt -> DDerivClause
    DDerivClause (Maybe DDerivStrategy -> DCxt -> DDerivClause)
    -> q (Maybe DDerivStrategy) -> q (DCxt -> 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)
    mapM DerivStrategy -> q DDerivStrategy
    forall (q :: * -> *).
    DsMonad q =>
    DerivStrategy -> q DDerivStrategy
    dsDerivStrategy Maybe DerivStrategy
    mds q (DCxt -> DDerivClause) -> q DCxt -> q DDerivClause
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Cxt -> q DCxt
    forall (q :: * -> *). DsMonad q => Cxt -> q DCxt
    dsCxt Cxt
    cxt
    #elif __GLASGOW_HASKELL__ >= 711
    type DerivingClause = Pred

    dsDerivClause :: DsMonad q => DerivingClause -> q DDerivClause
    dsDerivClause p = DDerivClause Nothing <$> dsPred p
    #else
    type DerivingClause = Name

    dsDerivClause :: DsMonad q => DerivingClause -> q DDerivClause
    dsDerivClause n = pure $ DDerivClause Nothing [DConT n]
    #endif

    #if __GLASGOW_HASKELL__ >= 801
    -- | Desugar a @DerivStrategy@.
    dsDerivStrategy :: DsMonad q => DerivStrategy -> q DDerivStrategy
    dsDerivStrategy :: DerivStrategy -> q DDerivStrategy
    dsDerivStrategy StockStrategy    = DDerivStrategy -> q DDerivStrategy
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure DDerivStrategy
    DStockStrategy
    dsDerivStrategy AnyclassStrategy = DDerivStrategy -> q DDerivStrategy
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure DDerivStrategy
    DAnyclassStrategy
    dsDerivStrategy NewtypeStrategy  = DDerivStrategy -> q DDerivStrategy
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure DDerivStrategy
    DNewtypeStrategy
    #if __GLASGOW_HASKELL__ >= 805
    dsDerivStrategy (ViaStrategy ty :: Type
    ty) = DType -> DDerivStrategy
    DViaStrategy (DType -> DDerivStrategy) -> q DType -> q DDerivStrategy
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    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 :: Name -> PatSynDir -> q DPatSynDir
    dsPatSynDir _ Unidir              = DPatSynDir -> q DPatSynDir
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure DPatSynDir
    DUnidir
    dsPatSynDir _ ImplBidir           = DPatSynDir -> q DPatSynDir
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure DPatSynDir
    DImplBidir
    dsPatSynDir n :: Name
    n (ExplBidir clauses :: [Clause]
    clauses) = [DClause] -> DPatSynDir
    DExplBidir ([DClause] -> DPatSynDir) -> q [DClause] -> q DPatSynDir
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name -> [Clause] -> q [DClause]
    forall (q :: * -> *). DsMonad q => Name -> [Clause] -> q [DClause]
    dsClauses Name
    n [Clause]
    clauses
    #endif

    -- | Desugar a @Pred@, flattening any internal tuples
    dsPred :: DsMonad q => Pred -> q DCxt
    #if __GLASGOW_HASKELL__ < 709
    dsPred (ClassP n tys) = do
      ts' <- mapM dsType tys
      return [foldl DAppT (DConT n) ts']
    dsPred (EqualP t1 t2) = do
      ts' <- mapM dsType [t1, t2]
      return [foldl DAppT (DConT ''(~)) ts']
    #else
    dsPred :: Type -> q DCxt
    dsPred t :: Type
    t
      | Just ts :: Cxt
    ts <- Type -> Maybe Cxt
    splitTuple_maybe Type
    t
      = (Type -> q DCxt) -> Cxt -> q DCxt
    forall (monad :: * -> *) monoid (t :: * -> *) a.
    (Monad monad, Monoid monoid, Traversable t) =>
    (a -> monad monoid) -> t a -> monad monoid
    concatMapM Type -> q DCxt
    forall (q :: * -> *). DsMonad q => Type -> q DCxt
    dsPred Cxt
    ts
    dsPred (ForallT tvbs :: [TyVarBndr]
    tvbs cxt :: Cxt
    cxt p :: Type
    p) = do
      DCxt
    ps' <- Type -> q DCxt
    forall (q :: * -> *). DsMonad q => Type -> q DCxt
    dsPred Type
    p
      case DCxt
    ps' of
        [p' :: DType
    p'] -> (DType -> DCxt -> DCxt
    forall a. a -> [a] -> [a]
    :[]) (DType -> DCxt) -> q DType -> q DCxt
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ([DTyVarBndr] -> DCxt -> DType -> DType
    DForallT ([DTyVarBndr] -> DCxt -> DType -> DType)
    -> q [DTyVarBndr] -> q (DCxt -> DType -> DType)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (TyVarBndr -> q DTyVarBndr) -> [TyVarBndr] -> q [DTyVarBndr]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM TyVarBndr -> q DTyVarBndr
    forall (q :: * -> *). DsMonad q => TyVarBndr -> q DTyVarBndr
    dsTvb [TyVarBndr]
    tvbs q (DCxt -> DType -> DType) -> q DCxt -> q (DType -> DType)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Cxt -> q DCxt
    forall (q :: * -> *). DsMonad q => Cxt -> q DCxt
    dsCxt Cxt
    cxt q (DType -> DType) -> q DType -> q DType
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> DType -> q DType
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure DType
    p')
        _    -> String -> q DCxt
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail "Cannot desugar constraint tuples in the body of a quantified constraint"
                  -- See Trac #15334.
    dsPred (AppT t1 :: Type
    t1 t2 :: Type
    t2) = do
      [p1 :: DType
    p1] <- Type -> q DCxt
    forall (q :: * -> *). DsMonad q => Type -> q DCxt
    dsPred Type
    t1   -- tuples can't be applied!
      (DType -> DCxt -> DCxt
    forall a. a -> [a] -> [a]
    :[]) (DType -> DCxt) -> (DType -> DType) -> DType -> DCxt
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> DType -> DType -> DType
    DAppT DType
    p1 (DType -> DCxt) -> q DType -> q DCxt
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    t2
    dsPred (SigT ty :: Type
    ty ki :: Type
    ki) = do
      DCxt
    preds <- Type -> q DCxt
    forall (q :: * -> *). DsMonad q => Type -> q DCxt
    dsPred Type
    ty
      case DCxt
    preds of
        [p :: DType
    p]   -> (DType -> DCxt -> DCxt
    forall a. a -> [a] -> [a]
    :[]) (DType -> DCxt) -> (DType -> DType) -> DType -> DCxt
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> DType -> DType -> DType
    DSigT DType
    p (DType -> DCxt) -> q DType -> q DCxt
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    ki
        other :: DCxt
    other -> DCxt -> q DCxt
    forall (m :: * -> *) a. Monad m => a -> m a
    return DCxt
    other   -- just drop the kind signature on a tuple.
    dsPred (VarT n :: Name
    n) = DCxt -> q DCxt
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Name -> DType
    DVarT Name
    n]
    dsPred (ConT n :: Name
    n) = DCxt -> q DCxt
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Name -> DType
    DConT Name
    n]
    dsPred t :: Type
    t@(PromotedT _) =
      String -> q DCxt
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible (String -> q DCxt) -> String -> q DCxt
    forall a b. (a -> b) -> a -> b
    $ "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 0) = DCxt -> q DCxt
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Name -> DType
    DConT (Int -> Name
    tupleTypeName 0)]
    dsPred (TupleT _) =
      String -> q DCxt
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible "Internal error in th-desugar in detecting tuple constraints."
    dsPred t :: Type
    t@(UnboxedTupleT _) =
      String -> q DCxt
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible (String -> q DCxt) -> String -> q DCxt
    forall a b. (a -> b) -> a -> b
    $ "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 ArrowT = String -> q DCxt
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible "Arrow seen as head of constraint."
    dsPred ListT  = String -> q DCxt
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible "List seen as head of constraint."
    dsPred (PromotedTupleT _) =
      String -> q DCxt
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible "Promoted tuple seen as head of constraint."
    dsPred PromotedNilT  = String -> q DCxt
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible "Promoted nil seen as head of constraint."
    dsPred PromotedConsT = String -> q DCxt
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible "Promoted cons seen as head of constraint."
    dsPred StarT         = String -> q DCxt
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible "* seen as head of constraint."
    dsPred ConstraintT =
      String -> q DCxt
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible "The kind `Constraint' seen as head of constraint."
    dsPred t :: Type
    t@(LitT _) =
      String -> q DCxt
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible (String -> q DCxt) -> String -> q DCxt
    forall a b. (a -> b) -> a -> b
    $ "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 EqualityT = DCxt -> q DCxt
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Name -> DType
    DConT ''(~)]
    #if __GLASGOW_HASKELL__ > 710
    dsPred (InfixT t1 :: Type
    t1 n :: Name
    n t2 :: Type
    t2) = (DType -> DCxt -> DCxt
    forall a. a -> [a] -> [a]
    :[]) (DType -> DCxt) -> q DType -> q DCxt
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (DType -> DType -> DType
    DAppT (DType -> DType -> DType) -> q DType -> q (DType -> DType)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (DType -> DType -> DType
    DAppT (Name -> DType
    DConT Name
    n) (DType -> DType) -> q DType -> q DType
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    t1) q (DType -> DType) -> q DType -> q DType
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    t2)
    dsPred (UInfixT _ _ _) = String -> q DCxt
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail "Cannot desugar unresolved infix operators."
    dsPred (ParensT t :: Type
    t) = Type -> q DCxt
    forall (q :: * -> *). DsMonad q => Type -> q DCxt
    dsPred Type
    t
    dsPred WildCardT = DCxt -> q DCxt
    forall (m :: * -> *) a. Monad m => a -> m a
    return [DType
    DWildCardT]
    #endif
    #if __GLASGOW_HASKELL__ >= 801
    dsPred t :: Type
    t@(UnboxedSumT {}) =
      String -> q DCxt
    forall (q :: * -> *) a. MonadFail q => String -> q a
    impossible (String -> q DCxt) -> String -> q DCxt
    forall a b. (a -> b) -> a -> b
    $ "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 t :: Type
    t k :: Type
    k) = do
      [p :: DType
    p] <- Type -> q DCxt
    forall (q :: * -> *). DsMonad q => Type -> q DCxt
    dsPred Type
    t
      (DType -> DCxt -> DCxt
    forall a. a -> [a] -> [a]
    :[]) (DType -> DCxt) -> q DType -> q DCxt
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (DType -> DType -> DType
    DAppKindT DType
    p (DType -> DType) -> q DType -> q DType
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    k)
    dsPred (ImplicitParamT n :: String
    n t :: Type
    t) = do
      DType
    t' <- Type -> q DType
    forall (q :: * -> *). DsMonad q => Type -> q DType
    dsType Type
    t
      DCxt -> q DCxt
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Name -> DType
    DConT ''IP DType -> DType -> DType
    `DAppT` TyLit -> DType
    DLitT (String -> TyLit
    StrTyLit String
    n) DType -> DType -> DType
    `DAppT` DType
    t']
    #endif
    #endif

    -- | Like 'reify', but safer and desugared. Uses local declarations where
    -- available.
    dsReify :: DsMonad q => Name -> q (Maybe DInfo)
    dsReify :: 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)
    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

    -- 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 :: 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 :: Name -> [VarBangType] -> [FieldPat] -> PatM q [DPat]
    reorderFieldsPat con_name :: Name
    con_name field_decs :: [VarBangType]
    field_decs field_pats :: [FieldPat]
    field_pats =
      (Pat -> WriterT [(Name, DExp)] q DPat)
    -> Name -> [VarBangType] -> [FieldPat] -> [DPat] -> PatM 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' :: (a -> m da)
    -> Name -> [VarBangType] -> [(Name, a)] -> [da] -> m [da]
    reorderFields' ds_thing :: a -> m da
    ds_thing con_name :: Name
    con_name field_names_types :: [VarBangType]
    field_names_types field_things :: [(Name, a)]
    field_things deflts :: [da]
    deflts =
      m ()
    check_valid_fields m () -> m [da] -> m [da]
    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 (\(a :: Name
    a, _, _) -> 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
    $ \(thing_name :: Name
    thing_name, _) ->
            Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Name
    thing_name Name -> [Name] -> 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 (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> m ()) -> String -> m ()
    forall a b. (a -> b) -> a -> b
    $ "Constructor ‘" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Name -> String
    nameBase Name
    con_name   String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "‘ 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]
    ++ "‘"

        reorder :: [Name] -> [da] -> m [da]
    reorder [] _ = [da] -> m [da]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
        reorder (field_name :: Name
    field_name : rest :: [Name]
    rest) (deflt :: da
    deflt : rest_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 (\(thing_name :: Name
    thing_name, _) -> Name
    thing_name Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    field_name) [(Name, a)]
    field_things of
            Just (_, thing :: 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
            Nothing -> [da] -> m [da]
    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 (_ : _) [] = String -> m [da]
    forall a. HasCallStack => String -> a
    error "Internal error in th-desugar."

    -- | Make a tuple 'DExp' from a list of 'DExp's. Avoids using a 1-tuple.
    mkTupleDExp :: [DExp] -> DExp
    mkTupleDExp :: [DExp] -> DExp
    mkTupleDExp [exp :: DExp
    exp] = DExp
    exp
    mkTupleDExp exps :: [DExp]
    exps = (DExp -> DExp -> DExp) -> DExp -> [DExp] -> DExp
    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 (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
    exp
    mkTupleExp exps :: [Exp]
    exps = (Exp -> Exp -> Exp) -> Exp -> [Exp] -> Exp
    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 (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 [pat :: DPat
    pat] = DPat
    pat
    mkTupleDPat pats :: [DPat]
    pats = Name -> [DPat] -> DPat
    DConP (Int -> Name
    tupleDataName ([DPat] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [DPat]
    pats)) [DPat]
    pats

    -- | Make a tuple 'Pat' from a list of 'Pat's. Avoids using a 1-tuple.
    mkTuplePat :: [Pat] -> Pat
    mkTuplePat :: [Pat] -> Pat
    mkTuplePat [pat :: Pat
    pat] = Pat
    pat
    mkTuplePat pats :: [Pat]
    pats = Name -> [Pat] -> Pat
    ConP (Int -> Name
    tupleDataName ([Pat] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Pat]
    pats)) [Pat]
    pats

    -- | Is this pattern guaranteed to match?
    isUniversalPattern :: DsMonad q => DPat -> q Bool
    isUniversalPattern :: DPat -> q Bool
    isUniversalPattern (DLitP {}) = Bool -> q Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
    isUniversalPattern (DVarP {}) = Bool -> q Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
    isUniversalPattern (DConP con_name :: Name
    con_name pats :: [DPat]
    pats) = do
      Name
    data_name <- Name -> q Name
    forall (q :: * -> *). DsMonad q => Name -> q Name
    dataConNameToDataName Name
    con_name
      (_tvbs :: [TyVarBndr]
    _tvbs, cons :: [Con]
    cons) <- String -> Name -> q ([TyVarBndr], [Con])
    forall (q :: * -> *).
    DsMonad q =>
    String -> Name -> q ([TyVarBndr], [Con])
    getDataD "Internal error." Name
    data_name
      if [Con] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Con]
    cons Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1
      then ([Bool] -> Bool) -> q [Bool] -> q Bool
    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)
    mapM DPat -> q Bool
    forall (q :: * -> *). DsMonad q => DPat -> q Bool
    isUniversalPattern [DPat]
    pats
      else Bool -> q Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
    isUniversalPattern (DTildeP {})  = Bool -> q Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
    isUniversalPattern (DBangP pat :: DPat
    pat)  = DPat -> q Bool
    forall (q :: * -> *). DsMonad q => DPat -> q Bool
    isUniversalPattern DPat
    pat
    isUniversalPattern (DSigP pat :: DPat
    pat _) = DPat -> q Bool
    forall (q :: * -> *). DsMonad q => DPat -> q Bool
    isUniversalPattern DPat
    pat
    isUniversalPattern DWildP        = Bool -> q Bool
    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 (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 :: DType -> [DTypeArg] -> DType
    applyDType = (DType -> DTypeArg -> DType) -> DType -> [DTypeArg] -> DType
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl DType -> DTypeArg -> DType
    apply
      where
        apply :: DType -> DTypeArg -> DType
        apply :: DType -> DTypeArg -> DType
    apply f :: DType
    f (DTANormal x :: DType
    x) = DType
    f DType -> DType -> DType
    `DAppT` DType
    x
        apply f :: DType
    f (DTyArg x :: DType
    x)    = DType
    f DType -> DType -> DType
    `DAppKindT` DType
    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
    /= :: DTypeArg -> DTypeArg -> Bool
    $c/= :: DTypeArg -> DTypeArg -> Bool
    == :: DTypeArg -> DTypeArg -> Bool
    $c== :: 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
    showList :: [DTypeArg] -> String -> String
    $cshowList :: [DTypeArg] -> String -> String
    show :: DTypeArg -> String
    $cshow :: DTypeArg -> String
    showsPrec :: Int -> DTypeArg -> String -> String
    $cshowsPrec :: Int -> DTypeArg -> String -> String
    Show, Typeable, Typeable DTypeArg
    DataType
    Constr
    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 -> DataType
    DTypeArg -> Constr
    (forall b. Data b => b -> b) -> DTypeArg -> DTypeArg
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DTypeArg -> c DTypeArg
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c 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)
    $cDTyArg :: Constr
    $cDTANormal :: Constr
    $tDTypeArg :: DataType
    gmapMo :: (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
    gmapMp :: (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
    gmapM :: (forall d. Data d => d -> m d) -> DTypeArg -> m DTypeArg
    $cgmapM :: forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DTypeArg -> m DTypeArg
    gmapQi :: Int -> (forall d. Data d => d -> u) -> DTypeArg -> u
    $cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DTypeArg -> u
    gmapQ :: (forall d. Data d => d -> u) -> DTypeArg -> [u]
    $cgmapQ :: forall u. (forall d. Data d => d -> u) -> DTypeArg -> [u]
    gmapQr :: (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
    gmapQl :: (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DTypeArg -> r
    $cgmapQl :: forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DTypeArg -> r
    gmapT :: (forall b. Data b => b -> b) -> DTypeArg -> DTypeArg
    $cgmapT :: (forall b. Data b => b -> b) -> DTypeArg -> DTypeArg
    dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DTypeArg)
    $cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DTypeArg)
    dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DTypeArg)
    $cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DTypeArg)
    dataTypeOf :: DTypeArg -> DataType
    $cdataTypeOf :: DTypeArg -> DataType
    toConstr :: DTypeArg -> Constr
    $ctoConstr :: DTypeArg -> Constr
    gunfold :: (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DTypeArg
    $cgunfold :: forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DTypeArg
    gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DTypeArg -> c DTypeArg
    $cgfoldl :: forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DTypeArg -> c DTypeArg
    $cp1Data :: Typeable 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
    $cto :: forall x. Rep DTypeArg x -> DTypeArg
    $cfrom :: forall x. DTypeArg -> Rep DTypeArg x
    Generic)

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

    -- | Filter the normal type arguments from a list of 'DTypeArg's.
    filterDTANormals :: [DTypeArg] -> [DType]
    filterDTANormals :: [DTypeArg] -> DCxt
    filterDTANormals = (DTypeArg -> Maybe DType) -> [DTypeArg] -> DCxt
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe DTypeArg -> Maybe DType
    getDTANormal
      where
        getDTANormal :: DTypeArg -> Maybe DType
        getDTANormal :: DTypeArg -> Maybe DType
    getDTANormal (DTANormal t :: DType
    t) = DType -> Maybe DType
    forall a. a -> Maybe a
    Just DType
    t
        getDTANormal (DTyArg {})   = Maybe DType
    forall a. Maybe a
    Nothing

    -- | Convert a 'DTyVarBndr' into a 'DType'
    dTyVarBndrToDType :: DTyVarBndr -> DType
    dTyVarBndrToDType :: DTyVarBndr -> DType
    dTyVarBndrToDType (DPlainTV a :: Name
    a)    = Name -> DType
    DVarT Name
    a
    dTyVarBndrToDType (DKindedTV a :: Name
    a k :: DType
    k) = Name -> DType
    DVarT Name
    a DType -> DType -> DType
    `DSigT` DType
    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 -> DType
    probablyWrongUnDTypeArg (DTANormal t :: DType
    t) = DType
    t
    probablyWrongUnDTypeArg (DTyArg k :: DType
    k)    = DType
    k

    -- | Convert a 'Strict' to a 'Bang' in GHCs 7.x. This is just
    -- the identity operation in GHC 8.x, which has no 'Strict'.
    -- (This is included in GHC 8.x only for good Haddocking.)
    #if __GLASGOW_HASKELL__ <= 710
    strictToBang :: Strict -> Bang
    strictToBang IsStrict  = Bang NoSourceUnpackedness SourceStrict
    strictToBang NotStrict = Bang NoSourceUnpackedness NoSourceStrictness
    strictToBang Unpacked  = Bang SourceUnpack SourceStrict
    #else
    strictToBang :: Bang -> Bang
    strictToBang :: Bang -> Bang
    strictToBang = Bang -> Bang
    forall a. a -> a
    id
    #endif

    -- 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 -> [DTyVarBndr] -> DType
    nonFamilyDataReturnType :: Name -> [DTyVarBndr] -> DType
    nonFamilyDataReturnType con_name :: Name
    con_name =
      DType -> [DTypeArg] -> DType
    applyDType (Name -> DType
    DConT Name
    con_name) ([DTypeArg] -> DType)
    -> ([DTyVarBndr] -> [DTypeArg]) -> [DTyVarBndr] -> DType
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (DTyVarBndr -> DTypeArg) -> [DTyVarBndr] -> [DTypeArg]
    forall a b. (a -> b) -> [a] -> [b]
    map (DType -> DTypeArg
    DTANormal (DType -> DTypeArg)
    -> (DTyVarBndr -> DType) -> DTyVarBndr -> DTypeArg
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DTyVarBndr -> DType
    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] -> DType
    dataFamInstReturnType fam_name :: Name
    fam_name = DType -> [DTypeArg] -> DType
    applyDType (Name -> DType
    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] -> [DTyVarBndr]
    dataFamInstTvbs :: [DTypeArg] -> [DTyVarBndr]
    dataFamInstTvbs = DCxt -> [DTyVarBndr]
    toposortTyVarsOf (DCxt -> [DTyVarBndr])
    -> ([DTypeArg] -> DCxt) -> [DTypeArg] -> [DTyVarBndr]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (DTypeArg -> DType) -> [DTypeArg] -> DCxt
    forall a b. (a -> b) -> [a] -> [b]
    map DTypeArg -> DType
    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] -> [DTyVarBndr]
    toposortTyVarsOf :: DCxt -> [DTyVarBndr]
    toposortTyVarsOf tys :: DCxt
    tys =
      let freeVars :: [Name]
          freeVars :: [Name]
    freeVars = OSet Name -> [Name]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    F.toList (OSet Name -> [Name]) -> OSet Name -> [Name]
    forall a b. (a -> b) -> a -> b
    $ (DType -> OSet Name) -> DCxt -> OSet Name
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap DType -> OSet Name
    fvDType DCxt
    tys

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

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

              go_tvb :: DTyVarBndr -> Map Name DKind -> Map Name DKind
              go_tvb :: DTyVarBndr -> Map Name DType -> Map Name DType
    go_tvb (DPlainTV n :: Name
    n)    m :: Map Name DType
    m = Name -> Map Name DType -> Map Name DType
    forall k a. Ord k => k -> Map k a -> Map k a
    M.delete Name
    n Map Name DType
    m
              go_tvb (DKindedTV n :: Name
    n k :: DType
    k) m :: Map Name DType
    m = Name -> Map Name DType -> Map Name DType
    forall k a. Ord k => k -> Map k a -> Map k a
    M.delete Name
    n Map Name DType
    m Map Name DType -> Map Name DType -> Map Name DType
    forall a. Monoid a => a -> a -> a
    `mappend` DType -> Map Name DType
    go_ty DType
    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 acc :: [Name]
    acc _fv_list :: [Set Name]
    _fv_list [] = [Name] -> [Name]
    forall a. [a] -> [a]
    reverse [Name]
    acc
          go acc :: [Name]
    acc  fv_list :: [Set Name]
    fv_list (tv :: Name
    tv:tvs :: [Name]
    tvs)
            = [Name] -> [Set Name] -> [Name] -> [Name]
    go [Name]
    acc' [Set Name]
    fv_list' [Name]
    tvs
            where
              (acc' :: [Name]
    acc', fv_list' :: [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 tv :: Name
    tv []     []         = ([Name
    tv], [Name -> Set Name
    kindFVSet Name
    tv])
          insert tv :: Name
    tv (a :: Name
    a:as :: [Name]
    as) (fvs :: Set Name
    fvs:fvss :: [Set Name]
    fvss)
            | Name
    tv Name -> Set Name -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set Name
    fvs
            , (as' :: [Name]
    as', fvss' :: [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 _ _ _ = String -> ([Name], [Set Name])
    forall a. HasCallStack => String -> a
    error "scopedSort"

          kindFVSet :: Name -> Set Name
    kindFVSet n :: Name
    n =
            Set Name -> (DType -> Set Name) -> Maybe DType -> 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)
    -> (DType -> OSet Name) -> DType -> Set Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DType -> OSet Name
    fvDType)
                          (Name -> Map Name DType -> Maybe DType
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Name
    n Map Name DType
    varKindSigs)
          ascribeWithKind :: Name -> DTyVarBndr
    ascribeWithKind n :: Name
    n =
            DTyVarBndr -> (DType -> DTyVarBndr) -> Maybe DType -> DTyVarBndr
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Name -> DTyVarBndr
    DPlainTV Name
    n) (Name -> DType -> DTyVarBndr
    DKindedTV Name
    n) (Name -> Map Name DType -> Maybe DType
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Name
    n Map Name DType
    varKindSigs)

          -- An annoying wrinkle: GHCs before 8.0 don't support explicitly
          -- quantifying kinds, so something like @forall k (a :: k)@ would be
          -- rejected. To work around this, we filter out any binders whose names
          -- also appear in a kind on old GHCs.
          isKindBinderOnOldGHCs :: b -> Bool
    isKindBinderOnOldGHCs
    #if __GLASGOW_HASKELL__ >= 800
            = Bool -> b -> Bool
    forall a b. a -> b -> a
    const Bool
    False
    #else
            = (`elem` kindVars)
              where
                kindVars = foldMap fvDType $ M.elems varKindSigs
    #endif

      in (Name -> DTyVarBndr) -> [Name] -> [DTyVarBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> DTyVarBndr
    ascribeWithKind ([Name] -> [DTyVarBndr]) -> [Name] -> [DTyVarBndr]
    forall a b. (a -> b) -> a -> b
    $
         (Name -> Bool) -> [Name] -> [Name]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Name -> Bool) -> Name -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Bool
    forall b. b -> Bool
    isKindBinderOnOldGHCs) ([Name] -> [Name]) -> [Name] -> [Name]
    forall a b. (a -> b) -> a -> b
    $
         [Name] -> [Name]
    scopedSort [Name]
    freeVars

    dtvbName :: DTyVarBndr -> Name
    dtvbName :: DTyVarBndr -> Name
    dtvbName (DPlainTV n :: Name
    n)    = Name
    n
    dtvbName (DKindedTV n :: Name
    n _) = Name
    n

    -- | Decompose a function type into its type variables, its context, its
    -- argument types, and its result type.
    unravel :: DType -> ([DTyVarBndr], [DPred], [DType], DType)
    unravel :: DType -> ([DTyVarBndr], DCxt, DCxt, DType)
    unravel (DForallT tvbs :: [DTyVarBndr]
    tvbs cxt :: DCxt
    cxt ty :: DType
    ty) =
      let (tvbs' :: [DTyVarBndr]
    tvbs', cxt' :: DCxt
    cxt', tys :: DCxt
    tys, res :: DType
    res) = DType -> ([DTyVarBndr], DCxt, DCxt, DType)
    unravel DType
    ty in
      ([DTyVarBndr]
    tvbs [DTyVarBndr] -> [DTyVarBndr] -> [DTyVarBndr]
    forall a. [a] -> [a] -> [a]
    ++ [DTyVarBndr]
    tvbs', DCxt
    cxt DCxt -> DCxt -> DCxt
    forall a. [a] -> [a] -> [a]
    ++ DCxt
    cxt', DCxt
    tys, DType
    res)
    unravel (DAppT (DAppT DArrowT t1 :: DType
    t1) t2 :: DType
    t2) =
      let (tvbs :: [DTyVarBndr]
    tvbs, cxt :: DCxt
    cxt, tys :: DCxt
    tys, res :: DType
    res) = DType -> ([DTyVarBndr], DCxt, DCxt, DType)
    unravel DType
    t2 in
      ([DTyVarBndr]
    tvbs, DCxt
    cxt, DType
    t1 DType -> DCxt -> DCxt
    forall a. a -> [a] -> [a]
    : DCxt
    tys, DType
    res)
    unravel t :: DType
    t = ([], [], [], DType
    t)

    -- | 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 :: DType -> (DType, [DTypeArg])
    unfoldDType = [DTypeArg] -> DType -> (DType, [DTypeArg])
    go []
      where
        go :: [DTypeArg] -> DType -> (DType, [DTypeArg])
        go :: [DTypeArg] -> DType -> (DType, [DTypeArg])
    go acc :: [DTypeArg]
    acc (DForallT _ _ ty :: DType
    ty) = [DTypeArg] -> DType -> (DType, [DTypeArg])
    go [DTypeArg]
    acc DType
    ty
        go acc :: [DTypeArg]
    acc (DAppT ty1 :: DType
    ty1 ty2 :: DType
    ty2)   = [DTypeArg] -> DType -> (DType, [DTypeArg])
    go (DType -> DTypeArg
    DTANormal DType
    ty2DTypeArg -> [DTypeArg] -> [DTypeArg]
    forall a. a -> [a] -> [a]
    :[DTypeArg]
    acc) DType
    ty1
        go acc :: [DTypeArg]
    acc (DAppKindT ty :: DType
    ty ki :: DType
    ki) = [DTypeArg] -> DType -> (DType, [DTypeArg])
    go (DType -> DTypeArg
    DTyArg DType
    kiDTypeArg -> [DTypeArg] -> [DTypeArg]
    forall a. a -> [a] -> [a]
    :[DTypeArg]
    acc) DType
    ty
        go acc :: [DTypeArg]
    acc (DSigT ty :: DType
    ty _)      = [DTypeArg] -> DType -> (DType, [DTypeArg])
    go [DTypeArg]
    acc DType
    ty
        go acc :: [DTypeArg]
    acc ty :: DType
    ty                = (DType
    ty, [DTypeArg]
    acc)

    -- | Extract the kind from a 'TyVarBndr', if one is present.
    extractTvbKind :: DTyVarBndr -> Maybe DKind
    extractTvbKind :: DTyVarBndr -> Maybe DType
    extractTvbKind (DPlainTV _) = Maybe DType
    forall a. Maybe a
    Nothing
    extractTvbKind (DKindedTV _ k :: DType
    k) = DType -> Maybe DType
    forall a. a -> Maybe a
    Just DType
    k

    -- | 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 :: a
    unusedArgument = String -> a
    forall a. HasCallStack => String -> a
    error "Unused"