    {-# LANGUAGE CPP                 #-}
    {-# LANGUAGE DataKinds           #-}
    {-# LANGUAGE FlexibleContexts    #-}
    {-# LANGUAGE GADTs               #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeFamilies        #-}
    {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]

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

    {-
    %
    (c) The University of Glasgow 2006
    (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
    -}

    module GHC.Tc.Gen.App
           ( tcApp
           , tcInferSigma
           , tcExprPrag ) where

    import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcPolyExpr )

    import GHC.Builtin.Types (multiplicityTy)
    import GHC.Tc.Gen.Head
    import GHC.Hs
    import GHC.Tc.Utils.Monad
    import GHC.Tc.Utils.Unify
    import GHC.Tc.Utils.Instantiate
    import GHC.Tc.Instance.Family ( tcGetFamInstEnvs, tcLookupDataFamInst_maybe )
    import GHC.Tc.Gen.HsType
    import GHC.Tc.Utils.TcMType
    import GHC.Tc.Types.Origin
    import GHC.Tc.Utils.TcType as TcType
    import GHC.Core.TyCon
    import GHC.Core.TyCo.Rep
    import GHC.Core.TyCo.Ppr
    import GHC.Core.TyCo.Subst (substTyWithInScope)
    import GHC.Core.TyCo.FVs( shallowTyCoVarsOfType )
    import GHC.Core.Type
    import GHC.Tc.Types.Evidence
    import GHC.Types.Var.Set
    import GHC.Builtin.PrimOps( tagToEnumKey )
    import GHC.Builtin.Names
    import GHC.Driver.Session
    import GHC.Types.SrcLoc
    import GHC.Types.Var.Env  ( emptyTidyEnv, mkInScopeSet )
    import GHC.Data.Maybe
    import GHC.Utils.Misc
    import GHC.Utils.Outputable as Outputable
    import GHC.Utils.Panic
    import qualified GHC.LanguageExtensions as LangExt

    import Control.Monad
    import Data.Function

    #include "HsVersions.h"

    import GHC.Prelude

    {- *********************************************************************
    *                                                                      *
                     Quick Look overview
    *                                                                      *
    ********************************************************************* -}

    {- Note [Quick Look]
    ~~~~~~~~~~~~~~~~~~~~
    The implementation of Quick Look closely follows the QL paper
       A quick look at impredicativity, Serrano et al, ICFP 2020
       https://www.microsoft.com/en-us/research/publication/a-quick-look-at-impredicativity/

    All the moving parts are in this module, GHC.Tc.Gen.App, so named
    because it deal with n-ary application.  The main workhorse is tcApp.

    Some notes relative to the paper

    * The "instantiation variables" of the paper are ordinary unification
      variables.  We keep track of which variables are instantiation variables
      by keeping a set Delta of instantiation variables.

    * When we learn what an instantiation variable must be, we simply unify
      it with that type; this is done in qlUnify, which is the function mgu_ql(t1,t2)
      of the paper.  This may fill in a (mutable) instantiation variable with
      a polytype.

    * When QL is done, we don't need to turn the un-filled-in
      instantiation variables into unification variables -- they
      already /are/ unification varibles!  See also
      Note [Instantiation variables are short lived].

    * We cleverly avoid the quadratic cost of QL, alluded to in the paper.
      See Note [Quick Look at value arguments]

    Note [Instantiation variables are short lived]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    By the time QL is done, all filled-in occurrences of instantiation
    variables have been zonked away (see "Crucial step" in tcValArgs),
    and so the constraint /generator/ never subsequently sees a meta-type
    variable filled in with a polytype -- a meta type variable stands
    (only) for a monotype.  See Section 4.3 "Applications and instantiation"
    of the paper.

    However, the constraint /solver/ can see a meta-type-variable filled
    in with a polytype (#18987). Suppose
      f :: forall a. Dict a => [a] -> [a]
      xs :: [forall b. b->b]
    and consider the call (f xs).  QL will
    * Instantiate f, with a := kappa, where kappa is an instantiation variable
    * Emit a constraint (Dict kappa), via instantiateSigma, called from tcInstFun
    * Do QL on the argument, to discover kappa := forall b. b->b

    But by the time the third step has happened, the constraint has been
    emitted into the monad.  The constraint solver will later find it, and
    rewrite it to (Dict (forall b. b->b)). That's fine -- the constraint
    solver does no implicit instantiation (which is what makes it so
    tricky to have foralls hiding inside unification variables), so there
    is no difficulty with allowing those filled-in kappa's to persist.
    (We could find them and zonk them away, but that would cost code and
    execution time, for no purpose.)

    Since the constraint solver does not do implicit instantiation (as the
    constraint generator does), the fact that a unification variable might
    stand for a polytype does not matter.
    -}

    {- *********************************************************************
    *                                                                      *
                  tcInferSigma
    *                                                                      *
    ********************************************************************* -}

    tcInferSigma :: Bool -> LHsExpr GhcRn -> TcM TcSigmaType
    -- Used only to implement :type; see GHC.Tc.Module.tcRnExpr
    -- True  <=> instantiate -- return a rho-type
    -- False <=> don't instantiate -- return a sigma-type
    tcInferSigma :: Bool -> LHsExpr GhcRn -> TcM TcType
    tcInferSigma Bool
    inst (L SrcSpanAnnA
    loc HsExpr GhcRn
    rn_expr)
      | (fun :: (HsExpr GhcRn, AppCtxt)
    fun@(HsExpr GhcRn
    rn_fun,AppCtxt
    _), [HsExprArg 'TcpRn]
    rn_args) <- HsExpr GhcRn -> ((HsExpr GhcRn, AppCtxt), [HsExprArg 'TcpRn])
    splitHsApps HsExpr GhcRn
    rn_expr
      = forall a. HsExpr GhcRn -> TcRn a -> TcRn a
    addExprCtxt HsExpr GhcRn
    rn_expr forall a b. (a -> b) -> a -> b
    $
        forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    loc     forall a b. (a -> b) -> a -> b
    $
        do { Bool
    do_ql <- HsExpr GhcRn -> TcM Bool
    wantQuickLook HsExpr GhcRn
    rn_fun
           ; (HsExpr GhcTc
    _tc_fun, TcType
    fun_sigma) <- (HsExpr GhcRn, AppCtxt)
    -> [HsExprArg 'TcpRn] -> Maybe TcType -> TcM (HsExpr GhcTc, TcType)
    tcInferAppHead (HsExpr GhcRn, AppCtxt)
    fun [HsExprArg 'TcpRn]
    rn_args forall a. Maybe a
    Nothing
           ; (Delta
    _delta, [HsExprArg 'TcpInst]
    inst_args, TcType
    app_res_sigma) <- Bool
    -> Bool
    -> (HsExpr GhcRn, AppCtxt)
    -> TcType
    -> [HsExprArg 'TcpRn]
    -> TcM (Delta, [HsExprArg 'TcpInst], TcType)
    tcInstFun Bool
    do_ql Bool
    inst (HsExpr GhcRn, AppCtxt)
    fun TcType
    fun_sigma [HsExprArg 'TcpRn]
    rn_args
           ; [HsExprArg 'TcpTc]
    _tc_args <- Bool -> [HsExprArg 'TcpInst] -> TcM [HsExprArg 'TcpTc]
    tcValArgs Bool
    do_ql [HsExprArg 'TcpInst]
    inst_args
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return TcType
    app_res_sigma }

    {- *********************************************************************
    *                                                                      *
                  Typechecking n-ary applications
    *                                                                      *
    ********************************************************************* -}

    {- Note [Application chains and heads]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Quick Look treats application chains specially.  What is an
    "application chain"?  See Fig 2, of the QL paper: "A quick look at
    impredicativity" (ICFP'20). Here's the syntax:

    app ::= head
         |  app expr            -- HsApp: ordinary application
         |  app @type           -- HsTypeApp: VTA
         |  expr `head` expr    -- OpApp: infix applications
         |  ( app )             -- HsPar: parens
         |  {-# PRAGMA #-} app  -- HsPragE: pragmas

    head ::= f             -- HsVar:    variables
          |  fld           -- HsRecFld: record field selectors
          |  (expr :: ty)  -- ExprWithTySig: expr with user type sig
          |  lit           -- HsOverLit: overloaded literals
          |  $([| head |])    -- HsSpliceE+HsSpliced+HsSplicedExpr: untyped TH expression splices
          |  other_expr    -- Other expressions

    When tcExpr sees something that starts an application chain (namely,
    any of the constructors in 'app' or 'head'), it invokes tcApp to
    typecheck it: see Note [tcApp: typechecking applications].  However,
    for HsPar and HsPragE, there is no tcWrapResult (which would
    instantiate types, bypassing Quick Look), so nothing is gained by
    using the application chain route, and we can just recurse to tcExpr.

    A "head" has three special cases (for which we can infer a polytype
    using tcInferAppHead_maybe); otherwise is just any old expression (for
    which we can infer a rho-type (via tcInfer).

    There is no special treatment for HsUnboundVar, HsOverLit etc, because
    we can't get a polytype from them.

    Left and right sections (e.g. (x +) and (+ x)) are not yet supported.
    Probably left sections (x +) would be easy to add, since x is the
    first arg of (+); but right sections are not so easy.  For symmetry
    reasons I've left both unchanged, in GHC.Tc.Gen.Expr.

    It may not be immediately obvious why ExprWithTySig (e::ty) should be
    dealt with by tcApp, even when it is not applied to anything. Consider
       f :: [forall a. a->a] -> Int
       ...(f (undefined :: forall b. b))...
    Clearly this should work!  But it will /only/ work because if we
    instantiate that (forall b. b) impredicatively!  And that only happens
    in tcApp.

    We also wish to typecheck application chains with untyped Template Haskell
    splices in the head, such as this example from #21038:
        data Foo = MkFoo (forall a. a -> a)
        f = $([| MkFoo |]) $ \x -> x
    This should typecheck just as if the TH splice was never in the way—that is,
    just as if the user had written `MkFoo $ \x -> x`. We could conceivably have
    a case for typed TH expression splices too, but it wouldn't be useful in
    practice, since the types of typed TH expressions aren't allowed to have
    polymorphic types, such as the type of MkFoo.

    Note [tcApp: typechecking applications]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    tcApp implements the APP-Downarrow/Uparrow rule of
    Fig 3, plus the modification in Fig 5, of the QL paper:
    "A quick look at impredicativity" (ICFP'20).

    It treats application chains (f e1 @ty e2) specially:

    * So we can report errors like "in the third arument of a call of f"

    * So we can do Visible Type Application (VTA), for which we must not
      eagerly instantiate the function part of the application.

    * So that we can do Quick Look impredicativity.

    tcApp works like this:

    1. Use splitHsApps, which peels off
         HsApp, HsTypeApp, HsPrag, HsPar
       returning the function in the corner and the arguments

       splitHsApps can deal with infix as well as prefix application,
       and returns a Rebuilder to re-assemble the the application after
       typechecking.

       The "list of arguments" is [HsExprArg], described in Note [HsExprArg].
       in GHC.Tc.Gen.Head

    2. Use tcInferAppHead to infer the type of the function,
         as an (uninstantiated) TcSigmaType
       There are special cases for
         HsVar, HsRecFld, and ExprWithTySig
       Otherwise, delegate back to tcExpr, which
         infers an (instantiated) TcRhoType

    3. Use tcInstFun to instantiate the function, Quick-Looking as we go.
       This implements the |-inst judgement in Fig 4, plus the
       modification in Fig 5, of the QL paper:
       "A quick look at impredicativity" (ICFP'20).

       In tcInstFun we take a quick look at value arguments, using
       quickLookArg.  See Note [Quick Look at value arguments].

    4. Use quickLookResultType to take a quick look at the result type,
       when in checking mode.  This is the shaded part of APP-Downarrow
       in Fig 5.

    5. Use unifyResultType to match up the result type of the call
       with that expected by the context.  See Note [Unify with
       expected type before typechecking arguments]

    6. Use tcValArgs to typecheck the value arguments

    7. After a gruesome special case for tagToEnum, rebuild the result.

    Some cases that /won't/ work:

    1. Consider this (which uses visible type application):

        (let { f :: forall a. a -> a; f x = x } in f) @Int

       Since 'let' is not among the special cases for tcInferAppHead,
       we'll delegate back to tcExpr, which will instantiate f's type
       and the type application to @Int will fail.  Too bad!

    Note [Quick Look for particular Ids]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We switch on Quick Look (regardless of -XImpredicativeTypes) for certain
    particular Ids:

    * ($): For a long time GHC has had a special typing rule for ($), that
      allows it to type (runST $ foo), which requires impredicative instantiation
      of ($), without language flags.  It's a bit ad-hoc, but it's been that
      way for ages.  Using quickLookIds is the only special treatment ($) needs
      now, which is a lot better.

    * leftSection, rightSection: these are introduced by the expansion step in
      the renamer (Note [Handling overloaded and rebindable constructs] in
      GHC.Rename.Expr), and we want them to be instantiated impredicatively
      so that (f `op`), say, will work OK even if `f` is higher rank.
      See Note [Left and right sections] in GHC.Rename.Expr.

    Note [Unify with expected type before typechecking arguments]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider this (#19364)
      data Pair a b = Pair a b
      baz :: MkPair Int Bool
      baz = MkPair "yes" "no"

    We instantiate MkPair with `alpha`, `beta`, and push its argument
    types (`alpha` and `beta`) into the arguments ("yes" and "no").
    But if we first unify the result type (Pair alpha beta) with the expected
    type (Pair Int Bool) we will push the much more informative types
    `Int` and `Bool` into the arguments.   This makes a difference:

    Unify result type /after/ typechecking the args
        • Couldn't match type ‘[Char]’ with ‘Bool’
          Expected type: Pair Foo Bar
            Actual type: Pair [Char] [Char]
        • In the expression: Pair "yes" "no"

    Unify result type /before/ typechecking the args
        • Couldn't match type ‘[Char]’ with ‘Bool’
          Expected: Foo
            Actual: String
        • In the first argument of ‘Pair’, namely ‘"yes"’

    The latter is much better. That is why we call unifyExpectedType
    before tcValArgs.
    -}

    tcApp :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    -- See Note [tcApp: typechecking applications]
    tcApp :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcApp HsExpr GhcRn
    rn_expr ExpRhoType
    exp_res_ty
      | (fun :: (HsExpr GhcRn, AppCtxt)
    fun@(HsExpr GhcRn
    rn_fun, AppCtxt
    fun_ctxt), [HsExprArg 'TcpRn]
    rn_args) <- HsExpr GhcRn -> ((HsExpr GhcRn, AppCtxt), [HsExprArg 'TcpRn])
    splitHsApps HsExpr GhcRn
    rn_expr
      = do { (HsExpr GhcTc
    tc_fun, TcType
    fun_sigma) <- (HsExpr GhcRn, AppCtxt)
    -> [HsExprArg 'TcpRn] -> Maybe TcType -> TcM (HsExpr GhcTc, TcType)
    tcInferAppHead (HsExpr GhcRn, AppCtxt)
    fun [HsExprArg 'TcpRn]
    rn_args
                                        (ExpRhoType -> Maybe TcType
    checkingExpType_maybe ExpRhoType
    exp_res_ty)

           -- Instantiate
           ; Bool
    do_ql <- HsExpr GhcRn -> TcM Bool
    wantQuickLook HsExpr GhcRn
    rn_fun
           ; (Delta
    delta, [HsExprArg 'TcpInst]
    inst_args, TcType
    app_res_rho) <- Bool
    -> Bool
    -> (HsExpr GhcRn, AppCtxt)
    -> TcType
    -> [HsExprArg 'TcpRn]
    -> TcM (Delta, [HsExprArg 'TcpInst], TcType)
    tcInstFun Bool
    do_ql Bool
    True (HsExpr GhcRn, AppCtxt)
    fun TcType
    fun_sigma [HsExprArg 'TcpRn]
    rn_args

           -- Quick look at result
           ; TcType
    app_res_rho <- if Bool
    do_ql
                            then Delta -> TcType -> ExpRhoType -> TcM TcType
    quickLookResultType Delta
    delta TcType
    app_res_rho ExpRhoType
    exp_res_ty
                            else forall (m :: * -> *) a. Monad m => a -> m a
    return TcType
    app_res_rho

           -- Unify with expected type from the context
           -- See Note [Unify with expected type before typechecking arguments]
           --
           -- perhaps_add_res_ty_ctxt: Inside an expansion, the addFunResCtxt stuff is
           --    more confusing than helpful because the function at the head isn't in
           --    the source program; it was added by the renamer.  See
           --    Note [Handling overloaded and rebindable constructs] in GHC.Rename.Expr
           ; let  perhaps_add_res_ty_ctxt :: TcM HsWrapper -> TcM HsWrapper
    perhaps_add_res_ty_ctxt TcM HsWrapper
    thing_inside
                     | AppCtxt -> Bool
    insideExpansion AppCtxt
    fun_ctxt
                     = TcM HsWrapper
    thing_inside
                     | Bool
    otherwise
                     = forall a.
    HsExpr GhcRn
    -> [HsExprArg 'TcpRn] -> TcType -> ExpRhoType -> TcM a -> TcM a
    addFunResCtxt HsExpr GhcRn
    rn_fun [HsExprArg 'TcpRn]
    rn_args TcType
    app_res_rho ExpRhoType
    exp_res_ty forall a b. (a -> b) -> a -> b
    $
                       TcM HsWrapper
    thing_inside

           -- Match up app_res_rho: the result type of rn_expr
           --     with exp_res_ty:  the expected result type
           ; Bool
    do_ds <- forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
    xoptM Extension
    LangExt.DeepSubsumption
           ; HsWrapper
    res_wrap <- TcM HsWrapper -> TcM HsWrapper
    perhaps_add_res_ty_ctxt forall a b. (a -> b) -> a -> b
    $
                if Bool -> Bool
    not Bool
    do_ds
                then -- No deep subsumption
                     -- app_res_rho and exp_res_ty are both rho-types,
                     -- so with simple subsumption we can just unify them
                     -- No need to zonk; the unifier does that
                     do { TcCoercionN
    co <- HsExpr GhcRn -> TcType -> ExpRhoType -> TcM TcCoercionN
    unifyExpectedType HsExpr GhcRn
    rn_expr TcType
    app_res_rho ExpRhoType
    exp_res_ty
                        ; forall (m :: * -> *) a. Monad m => a -> m a
    return (TcCoercionN -> HsWrapper
    mkWpCastN TcCoercionN
    co) }

                else -- Deep subsumption
                     -- Even though both app_res_rho and exp_res_ty are rho-types,
                     -- they may have nested polymorphism, so if deep subsumption
                     -- is on we must call tcSubType.
                     -- Zonk app_res_rho first, becuase QL may have instantiated some
                     -- delta variables to polytypes, and tcSubType doesn't expect that
                     do { TcType
    app_res_rho <- Bool -> TcType -> TcM TcType
    zonkQuickLook Bool
    do_ql TcType
    app_res_rho
                        ; HsExpr GhcRn -> TcType -> ExpRhoType -> TcM HsWrapper
    tcSubTypeDS HsExpr GhcRn
    rn_expr TcType
    app_res_rho ExpRhoType
    exp_res_ty }

           ; forall gbl lcl. DumpFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
    whenDOptM DumpFlag
    Opt_D_dump_tc_trace forall a b. (a -> b) -> a -> b
    $
             do { [HsExprArg 'TcpInst]
    inst_args <- forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM HsExprArg 'TcpInst -> TcM (HsExprArg 'TcpInst)
    zonkArg [HsExprArg 'TcpInst]
    inst_args  -- Only when tracing
                ; String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "tcApp" ([SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "rn_fun"       SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcRn
    rn_fun
                                   , String -> SDoc
    text String
    "inst_args"    SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    brackets (forall a. (a -> SDoc) -> [a] -> SDoc
    pprWithCommas HsExprArg 'TcpInst -> SDoc
    pprHsExprArgTc [HsExprArg 'TcpInst]
    inst_args)
                                   , String -> SDoc
    text String
    "do_ql:  "     SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr Bool
    do_ql
                                   , String -> SDoc
    text String
    "fun_sigma:  " SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr TcType
    fun_sigma
                                   , String -> SDoc
    text String
    "delta:      " SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr Delta
    delta
                                   , String -> SDoc
    text String
    "app_res_rho:" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr TcType
    app_res_rho
                                   , String -> SDoc
    text String
    "exp_res_ty:"  SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr ExpRhoType
    exp_res_ty
                                   , String -> SDoc
    text String
    "rn_expr:"     SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcRn
    rn_expr ]) }

           -- Typecheck the value arguments
           ; [HsExprArg 'TcpTc]
    tc_args <- Bool -> [HsExprArg 'TcpInst] -> TcM [HsExprArg 'TcpTc]
    tcValArgs Bool
    do_ql [HsExprArg 'TcpInst]
    inst_args

           -- Reconstruct, with special case for tagToEnum#
           ; HsExpr GhcTc
    tc_expr <- if HsExpr GhcRn -> Bool
    isTagToEnum HsExpr GhcRn
    rn_fun
                        then HsExpr GhcTc
    -> AppCtxt -> [HsExprArg 'TcpTc] -> TcType -> TcM (HsExpr GhcTc)
    tcTagToEnum HsExpr GhcTc
    tc_fun AppCtxt
    fun_ctxt [HsExprArg 'TcpTc]
    tc_args TcType
    app_res_rho
                        else forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcTc -> AppCtxt -> [HsExprArg 'TcpTc] -> HsExpr GhcTc
    rebuildHsApps HsExpr GhcTc
    tc_fun AppCtxt
    fun_ctxt [HsExprArg 'TcpTc]
    tc_args)

           -- Wrap the result
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap HsWrapper
    res_wrap HsExpr GhcTc
    tc_expr) }

    --------------------
    wantQuickLook :: HsExpr GhcRn -> TcM Bool
    wantQuickLook :: HsExpr GhcRn -> TcM Bool
    wantQuickLook (HsVar XVar GhcRn
    _ (L SrcSpanAnnN
    _ Name
    f))
      | forall a. Uniquable a => a -> Unique
    getUnique Name
    f forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Unique]
    quickLookKeys = forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
    wantQuickLook HsExpr GhcRn
    _                      = forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
    xoptM Extension
    LangExt.ImpredicativeTypes

    quickLookKeys :: [Unique]
    -- See Note [Quick Look for particular Ids]
    quickLookKeys :: [Unique]
    quickLookKeys = [Unique
    dollarIdKey, Unique
    leftSectionKey, Unique
    rightSectionKey]

    zonkQuickLook :: Bool -> TcType -> TcM TcType
    -- After all Quick Look unifications are done, zonk to ensure that all
    -- instantiation variables are substituted away
    --
    -- So far as the paper is concerned, this step applies
    -- the poly-substitution Theta, learned by QL, so that we
    -- "see" the polymorphism in that type
    --
    -- In implementation terms this ensures that no unification variable
    -- linger on that have been filled in with a polytype
    zonkQuickLook :: Bool -> TcType -> TcM TcType
    zonkQuickLook Bool
    do_ql TcType
    ty
      | Bool
    do_ql     = TcType -> TcM TcType
    zonkTcType TcType
    ty
      | Bool
    otherwise = forall (m :: * -> *) a. Monad m => a -> m a
    return TcType
    ty

    -- zonkArg is used *only* during debug-tracing, to make it easier to
    -- see what is going on.  For that reason, it is not a full zonk: add
    -- more if you need it.
    zonkArg :: HsExprArg 'TcpInst -> TcM (HsExprArg 'TcpInst)
    zonkArg :: HsExprArg 'TcpInst -> TcM (HsExprArg 'TcpInst)
    zonkArg eva :: HsExprArg 'TcpInst
    eva@(EValArg { eva_arg_ty :: forall (p :: TcPass). HsExprArg p -> XEVAType p
    eva_arg_ty = Scaled TcType
    m TcType
    ty })
      = do { TcType
    ty' <- TcType -> TcM TcType
    zonkTcType TcType
    ty
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExprArg 'TcpInst
    eva { eva_arg_ty :: XEVAType 'TcpInst
    eva_arg_ty = forall a. TcType -> a -> Scaled a
    Scaled TcType
    m TcType
    ty' }) }
    zonkArg HsExprArg 'TcpInst
    arg = forall (m :: * -> *) a. Monad m => a -> m a
    return HsExprArg 'TcpInst
    arg

    ----------------
    tcValArgs :: Bool                    -- Quick-look on?
              -> [HsExprArg 'TcpInst]    -- Actual argument
              -> TcM [HsExprArg 'TcpTc]  -- Resulting argument
    tcValArgs :: Bool -> [HsExprArg 'TcpInst] -> TcM [HsExprArg 'TcpTc]
    tcValArgs Bool
    do_ql [HsExprArg 'TcpInst]
    args
      = forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM HsExprArg 'TcpInst -> TcM (HsExprArg 'TcpTc)
    tc_arg [HsExprArg 'TcpInst]
    args
      where
        tc_arg :: HsExprArg 'TcpInst -> TcM (HsExprArg 'TcpTc)
        tc_arg :: HsExprArg 'TcpInst -> TcM (HsExprArg 'TcpTc)
    tc_arg (EPrag AppCtxt
    l HsPragE (GhcPass (XPass 'TcpInst))
    p)           = forall (m :: * -> *) a. Monad m => a -> m a
    return (forall (p :: TcPass).
    AppCtxt -> HsPragE (GhcPass (XPass p)) -> HsExprArg p
    EPrag AppCtxt
    l (HsPragE GhcRn -> HsPragE GhcTc
    tcExprPrag HsPragE (GhcPass (XPass 'TcpInst))
    p))
        tc_arg (EWrap EWrap
    w)             = forall (m :: * -> *) a. Monad m => a -> m a
    return (forall (p :: TcPass). EWrap -> HsExprArg p
    EWrap EWrap
    w)
        tc_arg (ETypeArg AppCtxt
    l LHsWcType GhcRn
    hs_ty XETAType 'TcpInst
    ty) = forall (m :: * -> *) a. Monad m => a -> m a
    return (forall (p :: TcPass).
    AppCtxt -> LHsWcType GhcRn -> XETAType p -> HsExprArg p
    ETypeArg AppCtxt
    l LHsWcType GhcRn
    hs_ty XETAType 'TcpInst
    ty)

        tc_arg eva :: HsExprArg 'TcpInst
    eva@(EValArg { eva_arg :: forall (p :: TcPass). HsExprArg p -> EValArg p
    eva_arg = EValArg 'TcpInst
    arg, eva_arg_ty :: forall (p :: TcPass). HsExprArg p -> XEVAType p
    eva_arg_ty = Scaled TcType
    mult TcType
    arg_ty
                            , eva_ctxt :: forall (p :: TcPass). HsExprArg p -> AppCtxt
    eva_ctxt = AppCtxt
    ctxt })
          = do { -- Crucial step: expose QL results before checking arg_ty
                 -- So far as the paper is concerned, this step applies
                 -- the poly-substitution Theta, learned by QL, so that we
                 -- "see" the polymorphism in that argument type. E.g.
                 --    (:) e ids, where ids :: [forall a. a->a]
                 --                     (:) :: forall p. p->[p]->[p]
                 -- Then Theta = [p :-> forall a. a->a], and we want
                 -- to check 'e' with expected type (forall a. a->a)
                 -- See Note [Instantiation variables are short lived]
                 TcType
    arg_ty <- Bool -> TcType -> TcM TcType
    zonkQuickLook Bool
    do_ql TcType
    arg_ty

                 -- Now check the argument
               ; GenLocated SrcSpanAnnA (HsExpr GhcTc)
    arg' <- forall a. TcType -> TcM a -> TcM a
    tcScalingUsage TcType
    mult forall a b. (a -> b) -> a -> b
    $
                         do { String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "tcEValArg" forall a b. (a -> b) -> a -> b
    $
                              [SDoc] -> SDoc
    vcat [ forall a. Outputable a => a -> SDoc
    ppr AppCtxt
    ctxt
                                   , String -> SDoc
    text String
    "arg type:" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr TcType
    arg_ty
                                   , String -> SDoc
    text String
    "arg:" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr EValArg 'TcpInst
    arg ]
                            ; AppCtxt -> EValArg 'TcpInst -> TcType -> TcM (LHsExpr GhcTc)
    tcEValArg AppCtxt
    ctxt EValArg 'TcpInst
    arg TcType
    arg_ty }

               ; forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExprArg 'TcpInst
    eva { eva_arg :: EValArg 'TcpTc
    eva_arg    = forall (p :: TcPass). LHsExpr (GhcPass (XPass p)) -> EValArg p
    ValArg GenLocated SrcSpanAnnA (HsExpr GhcTc)
    arg'
                             , eva_arg_ty :: XEVAType 'TcpTc
    eva_arg_ty = forall a. TcType -> a -> Scaled a
    Scaled TcType
    mult TcType
    arg_ty }) }

    tcEValArg :: AppCtxt -> EValArg 'TcpInst -> TcSigmaType -> TcM (LHsExpr GhcTc)
    -- Typecheck one value argument of a function call
    tcEValArg :: AppCtxt -> EValArg 'TcpInst -> TcType -> TcM (LHsExpr GhcTc)
    tcEValArg AppCtxt
    ctxt (ValArg larg :: LHsExpr (GhcPass (XPass 'TcpInst))
    larg@(L SrcSpanAnnA
    arg_loc HsExpr GhcRn
    arg)) TcType
    exp_arg_sigma
      = forall a. AppCtxt -> LHsExpr GhcRn -> TcM a -> TcM a
    addArgCtxt AppCtxt
    ctxt LHsExpr (GhcPass (XPass 'TcpInst))
    larg forall a b. (a -> b) -> a -> b
    $
        do { HsExpr GhcTc
    arg' <- HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcPolyExpr HsExpr GhcRn
    arg (TcType -> ExpRhoType
    mkCheckExpType TcType
    exp_arg_sigma)
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    arg_loc HsExpr GhcTc
    arg') }

    tcEValArg AppCtxt
    ctxt (ValArgQL { va_expr :: EValArg 'TcpInst -> LHsExpr GhcRn
    va_expr = larg :: LHsExpr GhcRn
    larg@(L SrcSpanAnnA
    arg_loc HsExpr GhcRn
    _)
                             , va_fun :: EValArg 'TcpInst -> (HsExpr GhcTc, AppCtxt)
    va_fun = (HsExpr GhcTc
    inner_fun, AppCtxt
    fun_ctxt)
                             , va_args :: EValArg 'TcpInst -> [HsExprArg 'TcpInst]
    va_args = [HsExprArg 'TcpInst]
    inner_args
                             , va_ty :: EValArg 'TcpInst -> TcType
    va_ty = TcType
    app_res_rho }) TcType
    exp_arg_sigma
      = forall a. AppCtxt -> LHsExpr GhcRn -> TcM a -> TcM a
    addArgCtxt AppCtxt
    ctxt LHsExpr GhcRn
    larg forall a b. (a -> b) -> a -> b
    $
        do { String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "tcEValArgQL {" ([SDoc] -> SDoc
    vcat [ forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcTc
    inner_fun SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr [HsExprArg 'TcpInst]
    inner_args ])
           ; [HsExprArg 'TcpTc]
    tc_args <- Bool -> [HsExprArg 'TcpInst] -> TcM [HsExprArg 'TcpTc]
    tcValArgs Bool
    True [HsExprArg 'TcpInst]
    inner_args
           ; TcCoercionN
    co      <- Maybe SDoc -> TcType -> TcType -> TcM TcCoercionN
    unifyType forall a. Maybe a
    Nothing TcType
    app_res_rho TcType
    exp_arg_sigma
           ; String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "tcEValArg }" SDoc
    empty
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    arg_loc forall a b. (a -> b) -> a -> b
    $ TcCoercionN -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrapCo TcCoercionN
    co forall a b. (a -> b) -> a -> b
    $
                     HsExpr GhcTc -> AppCtxt -> [HsExprArg 'TcpTc] -> HsExpr GhcTc
    rebuildHsApps HsExpr GhcTc
    inner_fun AppCtxt
    fun_ctxt [HsExprArg 'TcpTc]
    tc_args) }

    {- *********************************************************************
    *                                                                      *
                  Instantiating the call
    *                                                                      *
    ********************************************************************* -}

    type Delta = TcTyVarSet   -- Set of instantiation variables,
                              --   written \kappa in the QL paper
                              -- Just a set of ordinary unification variables,
                              --   but ones that QL may fill in with polytypes

    tcInstFun :: Bool   -- True  <=> Do quick-look
              -> Bool   -- False <=> Instantiate only /inferred/ variables at the end
                        --           so may return a sigma-typex
                        -- True  <=> Instantiate all type variables at the end:
                        --           return a rho-type
                        -- The /only/ call site that passes in False is the one
                        --    in tcInferSigma, which is used only to implement :type
                        -- Otherwise we do eager instantiation; in Fig 5 of the paper
                        --    |-inst returns a rho-type
              -> (HsExpr GhcRn, AppCtxt)        -- Error messages only
              -> TcSigmaType -> [HsExprArg 'TcpRn]
              -> TcM ( Delta
                     , [HsExprArg 'TcpInst]
                     , TcSigmaType )
    -- This function implements the |-inst judgement in Fig 4, plus the
    -- modification in Fig 5, of the QL paper:
    -- "A quick look at impredicativity" (ICFP'20).
    tcInstFun :: Bool
    -> Bool
    -> (HsExpr GhcRn, AppCtxt)
    -> TcType
    -> [HsExprArg 'TcpRn]
    -> TcM (Delta, [HsExprArg 'TcpInst], TcType)
    tcInstFun Bool
    do_ql Bool
    inst_final (HsExpr GhcRn
    rn_fun, AppCtxt
    fun_ctxt) TcType
    fun_sigma [HsExprArg 'TcpRn]
    rn_args
      = do { String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "tcInstFun" ([SDoc] -> SDoc
    vcat [ forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcRn
    rn_fun, forall a. Outputable a => a -> SDoc
    ppr TcType
    fun_sigma
                                       , String -> SDoc
    text String
    "args:" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr [HsExprArg 'TcpRn]
    rn_args
                                       , String -> SDoc
    text String
    "do_ql" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr Bool
    do_ql ])
           ; Delta
    -> [HsExprArg 'TcpInst]
    -> [Scaled TcType]
    -> TcType
    -> [HsExprArg 'TcpRn]
    -> TcM (Delta, [HsExprArg 'TcpInst], TcType)
    go Delta
    emptyVarSet [] [] TcType
    fun_sigma [HsExprArg 'TcpRn]
    rn_args }
      where
        fun_loc :: SrcSpan
    fun_loc  = AppCtxt -> SrcSpan
    appCtxtLoc AppCtxt
    fun_ctxt
        fun_orig :: CtOrigin
    fun_orig = HsExpr GhcRn -> CtOrigin
    exprCtOrigin (case AppCtxt
    fun_ctxt of
                                   VAExpansion HsExpr GhcRn
    e SrcSpan
    _ -> HsExpr GhcRn
    e
                                   VACall HsExpr GhcRn
    e Int
    _ SrcSpan
    _    -> HsExpr GhcRn
    e)
        set_fun_ctxt :: TcRn ([TcTyVar], HsWrapper, TcType)
    -> TcRn ([TcTyVar], HsWrapper, TcType)
    set_fun_ctxt TcRn ([TcTyVar], HsWrapper, TcType)
    thing_inside
          | Bool -> Bool
    not (SrcSpan -> Bool
    isGoodSrcSpan SrcSpan
    fun_loc)   -- noSrcSpan => no arguments
          = TcRn ([TcTyVar], HsWrapper, TcType)
    thing_inside                  -- => context is already set
          | Bool
    otherwise
          = forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    fun_loc forall a b. (a -> b) -> a -> b
    $
            case AppCtxt
    fun_ctxt of
              VAExpansion HsExpr GhcRn
    orig SrcSpan
    _ -> forall a. HsExpr GhcRn -> TcRn a -> TcRn a
    addExprCtxt HsExpr GhcRn
    orig TcRn ([TcTyVar], HsWrapper, TcType)
    thing_inside
              VACall {}          -> TcRn ([TcTyVar], HsWrapper, TcType)
    thing_inside

        herald :: SDoc
    herald = [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "The function" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcRn
    rn_fun)
                     , String -> SDoc
    text String
    "is applied to"]

        -- Count value args only when complaining about a function
        -- applied to too many value args
        -- See Note [Herald for matchExpectedFunTys] in GHC.Tc.Utils.Unify.
        n_val_args :: Int
    n_val_args = forall a. (a -> Bool) -> [a] -> Int
    count forall (id :: TcPass). HsExprArg id -> Bool
    isHsValArg [HsExprArg 'TcpRn]
    rn_args

        fun_is_out_of_scope :: Bool
    fun_is_out_of_scope  -- See Note [VTA for out-of-scope functions]
          = case HsExpr GhcRn
    rn_fun of
              HsUnboundVar {} -> Bool
    True
              HsExpr GhcRn
    _               -> Bool
    False

        inst_all :: ArgFlag -> Bool
        inst_all :: ArgFlag -> Bool
    inst_all (Invisible {}) = Bool
    True
        inst_all ArgFlag
    Required       = Bool
    False

        inst_inferred :: ArgFlag -> Bool
        inst_inferred :: ArgFlag -> Bool
    inst_inferred (Invisible Specificity
    InferredSpec)  = Bool
    True
        inst_inferred (Invisible Specificity
    SpecifiedSpec) = Bool
    False
        inst_inferred ArgFlag
    Required                  = Bool
    False

        inst_fun :: [HsExprArg 'TcpRn] -> ArgFlag -> Bool
        inst_fun :: [HsExprArg 'TcpRn] -> ArgFlag -> Bool
    inst_fun [] | Bool
    inst_final  = ArgFlag -> Bool
    inst_all
                    | Bool
    otherwise   = ArgFlag -> Bool
    inst_inferred
        inst_fun (EValArg {} : [HsExprArg 'TcpRn]
    _) = ArgFlag -> Bool
    inst_all
        inst_fun [HsExprArg 'TcpRn]
    _                = ArgFlag -> Bool
    inst_inferred

        -----------
        go, go1 :: Delta
                -> [HsExprArg 'TcpInst]  -- Accumulator, reversed
                -> [Scaled TcSigmaType]  -- Value args to which applied so far
                -> TcSigmaType -> [HsExprArg 'TcpRn]
                -> TcM (Delta, [HsExprArg 'TcpInst], TcSigmaType)

        -- go: If fun_ty=kappa, look it up in Theta
        go :: Delta
    -> [HsExprArg 'TcpInst]
    -> [Scaled TcType]
    -> TcType
    -> [HsExprArg 'TcpRn]
    -> TcM (Delta, [HsExprArg 'TcpInst], TcType)
    go Delta
    delta [HsExprArg 'TcpInst]
    acc [Scaled TcType]
    so_far TcType
    fun_ty [HsExprArg 'TcpRn]
    args
          | Just TcTyVar
    kappa <- TcType -> Maybe TcTyVar
    tcGetTyVar_maybe TcType
    fun_ty
          , TcTyVar
    kappa TcTyVar -> Delta -> Bool
    `elemVarSet` Delta
    delta
          = do { MetaDetails
    cts <- TcTyVar -> TcM MetaDetails
    readMetaTyVar TcTyVar
    kappa
               ; case MetaDetails
    cts of
                    Indirect TcType
    fun_ty' -> Delta
    -> [HsExprArg 'TcpInst]
    -> [Scaled TcType]
    -> TcType
    -> [HsExprArg 'TcpRn]
    -> TcM (Delta, [HsExprArg 'TcpInst], TcType)
    go  Delta
    delta [HsExprArg 'TcpInst]
    acc [Scaled TcType]
    so_far TcType
    fun_ty' [HsExprArg 'TcpRn]
    args
                    MetaDetails
    Flexi            -> Delta
    -> [HsExprArg 'TcpInst]
    -> [Scaled TcType]
    -> TcType
    -> [HsExprArg 'TcpRn]
    -> TcM (Delta, [HsExprArg 'TcpInst], TcType)
    go1 Delta
    delta [HsExprArg 'TcpInst]
    acc [Scaled TcType]
    so_far TcType
    fun_ty  [HsExprArg 'TcpRn]
    args }
         | Bool
    otherwise
         = Delta
    -> [HsExprArg 'TcpInst]
    -> [Scaled TcType]
    -> TcType
    -> [HsExprArg 'TcpRn]
    -> TcM (Delta, [HsExprArg 'TcpInst], TcType)
    go1 Delta
    delta [HsExprArg 'TcpInst]
    acc [Scaled TcType]
    so_far TcType
    fun_ty [HsExprArg 'TcpRn]
    args

        -- go1: fun_ty is not filled-in instantiation variable
        --      ('go' dealt with that case)

        -- Rule IALL from Fig 4 of the QL paper
        -- c.f. GHC.Tc.Utils.Instantiate.topInstantiate
        go1 :: Delta
    -> [HsExprArg 'TcpInst]
    -> [Scaled TcType]
    -> TcType
    -> [HsExprArg 'TcpRn]
    -> TcM (Delta, [HsExprArg 'TcpInst], TcType)
    go1 Delta
    delta [HsExprArg 'TcpInst]
    acc [Scaled TcType]
    so_far TcType
    fun_ty [HsExprArg 'TcpRn]
    args
          | ([TcTyVar]
    tvs,   TcType
    body1) <- (ArgFlag -> Bool) -> TcType -> ([TcTyVar], TcType)
    tcSplitSomeForAllTyVars ([HsExprArg 'TcpRn] -> ArgFlag -> Bool
    inst_fun [HsExprArg 'TcpRn]
    args) TcType
    fun_ty
          , (ThetaType
    theta, TcType
    body2) <- TcType -> (ThetaType, TcType)
    tcSplitPhiTy TcType
    body1
          , Bool -> Bool
    not (forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TcTyVar]
    tvs Bool -> Bool -> Bool
    && forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ThetaType
    theta)
          = do { ([TcTyVar]
    inst_tvs, HsWrapper
    wrap, TcType
    fun_rho) <- TcRn ([TcTyVar], HsWrapper, TcType)
    -> TcRn ([TcTyVar], HsWrapper, TcType)
    set_fun_ctxt forall a b. (a -> b) -> a -> b
    $
                                              CtOrigin
    -> [TcTyVar]
    -> ThetaType
    -> TcType
    -> TcRn ([TcTyVar], HsWrapper, TcType)
    instantiateSigma CtOrigin
    fun_orig [TcTyVar]
    tvs ThetaType
    theta TcType
    body2
                     -- set_fun_ctxt: important for the class constraints
                     -- that may be emitted from instantiating fun_sigma
               ; Delta
    -> [HsExprArg 'TcpInst]
    -> [Scaled TcType]
    -> TcType
    -> [HsExprArg 'TcpRn]
    -> TcM (Delta, [HsExprArg 'TcpInst], TcType)
    go (Delta
    delta Delta -> [TcTyVar] -> Delta
    `extendVarSetList` [TcTyVar]
    inst_tvs)
                    (HsWrapper -> [HsExprArg 'TcpInst] -> [HsExprArg 'TcpInst]
    addArgWrap HsWrapper
    wrap [HsExprArg 'TcpInst]
    acc) [Scaled TcType]
    so_far TcType
    fun_rho [HsExprArg 'TcpRn]
    args }
                    -- Going around again means we deal easily with
                    -- nested  forall a. Eq a => forall b. Show b => blah

        -- Rule IRESULT from Fig 4 of the QL paper
        go1 Delta
    delta [HsExprArg 'TcpInst]
    acc [Scaled TcType]
    _ TcType
    fun_ty []
           = do { String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "tcInstFun:ret" (forall a. Outputable a => a -> SDoc
    ppr TcType
    fun_ty)
                ; forall (m :: * -> *) a. Monad m => a -> m a
    return (Delta
    delta, forall a. [a] -> [a]
    reverse [HsExprArg 'TcpInst]
    acc, TcType
    fun_ty) }

        go1 Delta
    delta [HsExprArg 'TcpInst]
    acc [Scaled TcType]
    so_far TcType
    fun_ty (EWrap EWrap
    w : [HsExprArg 'TcpRn]
    args)
          = Delta
    -> [HsExprArg 'TcpInst]
    -> [Scaled TcType]
    -> TcType
    -> [HsExprArg 'TcpRn]
    -> TcM (Delta, [HsExprArg 'TcpInst], TcType)
    go1 Delta
    delta (forall (p :: TcPass). EWrap -> HsExprArg p
    EWrap EWrap
    w forall a. a -> [a] -> [a]
    : [HsExprArg 'TcpInst]
    acc) [Scaled TcType]
    so_far TcType
    fun_ty [HsExprArg 'TcpRn]
    args

        go1 Delta
    delta [HsExprArg 'TcpInst]
    acc [Scaled TcType]
    so_far TcType
    fun_ty (EPrag AppCtxt
    sp HsPragE (GhcPass (XPass 'TcpRn))
    prag : [HsExprArg 'TcpRn]
    args)
          = Delta
    -> [HsExprArg 'TcpInst]
    -> [Scaled TcType]
    -> TcType
    -> [HsExprArg 'TcpRn]
    -> TcM (Delta, [HsExprArg 'TcpInst], TcType)
    go1 Delta
    delta (forall (p :: TcPass).
    AppCtxt -> HsPragE (GhcPass (XPass p)) -> HsExprArg p
    EPrag AppCtxt
    sp HsPragE (GhcPass (XPass 'TcpRn))
    prag forall a. a -> [a] -> [a]
    : [HsExprArg 'TcpInst]
    acc) [Scaled TcType]
    so_far TcType
    fun_ty [HsExprArg 'TcpRn]
    args

        -- Rule ITYARG from Fig 4 of the QL paper
        go1 Delta
    delta [HsExprArg 'TcpInst]
    acc [Scaled TcType]
    so_far TcType
    fun_ty ( ETypeArg { eva_ctxt :: forall (p :: TcPass). HsExprArg p -> AppCtxt
    eva_ctxt = AppCtxt
    ctxt, eva_hs_ty :: forall (p :: TcPass). HsExprArg p -> LHsWcType GhcRn
    eva_hs_ty = LHsWcType GhcRn
    hs_ty }
                                    : [HsExprArg 'TcpRn]
    rest_args )
          | Bool
    fun_is_out_of_scope   -- See Note [VTA for out-of-scope functions]
          = Delta
    -> [HsExprArg 'TcpInst]
    -> [Scaled TcType]
    -> TcType
    -> [HsExprArg 'TcpRn]
    -> TcM (Delta, [HsExprArg 'TcpInst], TcType)
    go Delta
    delta [HsExprArg 'TcpInst]
    acc [Scaled TcType]
    so_far TcType
    fun_ty [HsExprArg 'TcpRn]
    rest_args

          | Bool
    otherwise
          = do { (TcType
    ty_arg, TcType
    inst_ty) <- TcType -> LHsWcType GhcRn -> TcM (TcType, TcType)
    tcVTA TcType
    fun_ty LHsWcType GhcRn
    hs_ty
               ; let arg' :: HsExprArg 'TcpInst
    arg' = ETypeArg { eva_ctxt :: AppCtxt
    eva_ctxt = AppCtxt
    ctxt, eva_hs_ty :: LHsWcType GhcRn
    eva_hs_ty = LHsWcType GhcRn
    hs_ty, eva_ty :: XETAType 'TcpInst
    eva_ty = TcType
    ty_arg }
               ; Delta
    -> [HsExprArg 'TcpInst]
    -> [Scaled TcType]
    -> TcType
    -> [HsExprArg 'TcpRn]
    -> TcM (Delta, [HsExprArg 'TcpInst], TcType)
    go Delta
    delta (HsExprArg 'TcpInst
    arg' forall a. a -> [a] -> [a]
    : [HsExprArg 'TcpInst]
    acc) [Scaled TcType]
    so_far TcType
    inst_ty [HsExprArg 'TcpRn]
    rest_args }

        -- Rule IVAR from Fig 4 of the QL paper:
        go1 Delta
    delta [HsExprArg 'TcpInst]
    acc [Scaled TcType]
    so_far TcType
    fun_ty args :: [HsExprArg 'TcpRn]
    args@(EValArg {} : [HsExprArg 'TcpRn]
    _)
          | Just TcTyVar
    kappa <- TcType -> Maybe TcTyVar
    tcGetTyVar_maybe TcType
    fun_ty
          , TcTyVar
    kappa TcTyVar -> Delta -> Bool
    `elemVarSet` Delta
    delta
          = -- Function type was of form   f :: forall a b. t1 -> t2 -> b
            -- with 'b', one of the quantified type variables, in the corner
            -- but the call applies it to three or more value args.
            -- Suppose b is instantiated by kappa.  Then we want to make fresh
            -- instantiation variables nu1, nu2, and set kappa := nu1 -> nu2
            --
            -- In principle what is happening here is not unlike matchActualFunTysRho
            -- but there are many small differences:
            --   - We know that the function type in unfilled meta-tyvar
            --     matchActualFunTysRho is much more general, has a loop, etc.
            --   - We must be sure to actually update the variable right now,
            --     not defer in any way, because this is a QL instantiation variable.
            --   - We need the freshly allocated unification variables, to extend
            --     delta with.
            -- It's easier just to do the job directly here.
            do { let valArgsCount :: Int
    valArgsCount = forall (id :: TcPass). [HsExprArg id] -> Int
    countLeadingValArgs [HsExprArg 'TcpRn]
    args
               ; [TcTyVar]
    arg_nus <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM Int
    valArgsCount TcM TcTyVar
    newOpenFlexiTyVar
                 -- We need variables for multiplicity (#18731)
                 -- Otherwise, 'undefined x' wouldn't be linear in x
               ; ThetaType
    mults   <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM Int
    valArgsCount (TcType -> TcM TcType
    newFlexiTyVarTy TcType
    multiplicityTy)
               ; TcTyVar
    res_nu  <- TcM TcTyVar
    newOpenFlexiTyVar
               ; TcCoercionN
    kind_co <- Maybe SDoc -> TcType -> TcType -> TcM TcCoercionN
    unifyKind forall a. Maybe a
    Nothing TcType
    liftedTypeKind (TcTyVar -> TcType
    tyVarKind TcTyVar
    kappa)
               ; let delta' :: Delta
    delta'  = Delta
    delta Delta -> [TcTyVar] -> Delta
    `extendVarSetList` (TcTyVar
    res_nuforall a. a -> [a] -> [a]
    :[TcTyVar]
    arg_nus)
                     arg_tys :: ThetaType
    arg_tys = [TcTyVar] -> ThetaType
    mkTyVarTys [TcTyVar]
    arg_nus
                     res_ty :: TcType
    res_ty  = TcTyVar -> TcType
    mkTyVarTy TcTyVar
    res_nu
                     fun_ty' :: TcType
    fun_ty' = [Scaled TcType] -> TcType -> TcType
    mkVisFunTys (forall a b c. String -> (a -> b -> c) -> [a] -> [b] -> [c]
    zipWithEqual String
    "tcInstFun" forall a. TcType -> a -> Scaled a
    mkScaled ThetaType
    mults ThetaType
    arg_tys) TcType
    res_ty
                     co_wrap :: HsWrapper
    co_wrap = TcCoercionN -> HsWrapper
    mkWpCastN (Role -> TcType -> TcCoercionN -> TcCoercionN
    mkTcGReflLeftCo Role
    Nominal TcType
    fun_ty' TcCoercionN
    kind_co)
                     acc' :: [HsExprArg 'TcpInst]
    acc'    = HsWrapper -> [HsExprArg 'TcpInst] -> [HsExprArg 'TcpInst]
    addArgWrap HsWrapper
    co_wrap [HsExprArg 'TcpInst]
    acc
                     -- Suppose kappa :: kk
                     -- Then fun_ty :: kk, fun_ty' :: Type, kind_co :: Type ~ kk
                     --      co_wrap :: (fun_ty' |> kind_co) ~ fun_ty'
               ; TcTyVar -> TcType -> TcRnIf TcGblEnv TcLclEnv ()
    writeMetaTyVar TcTyVar
    kappa (TcType -> TcCoercionN -> TcType
    mkCastTy TcType
    fun_ty' TcCoercionN
    kind_co)
                     -- kappa is uninstantiated ('go' already checked that)
               ; Delta
    -> [HsExprArg 'TcpInst]
    -> [Scaled TcType]
    -> TcType
    -> [HsExprArg 'TcpRn]
    -> TcM (Delta, [HsExprArg 'TcpInst], TcType)
    go Delta
    delta' [HsExprArg 'TcpInst]
    acc' [Scaled TcType]
    so_far TcType
    fun_ty' [HsExprArg 'TcpRn]
    args }

        -- Rule IARG from Fig 4 of the QL paper:
        go1 Delta
    delta [HsExprArg 'TcpInst]
    acc [Scaled TcType]
    so_far TcType
    fun_ty
            (eva :: HsExprArg 'TcpRn
    eva@(EValArg { eva_arg :: forall (p :: TcPass). HsExprArg p -> EValArg p
    eva_arg = ValArg LHsExpr (GhcPass (XPass 'TcpRn))
    arg, eva_ctxt :: forall (p :: TcPass). HsExprArg p -> AppCtxt
    eva_ctxt = AppCtxt
    ctxt })  : [HsExprArg 'TcpRn]
    rest_args)
          = do { (HsWrapper
    wrap, Scaled TcType
    arg_ty, TcType
    res_ty) <- SDoc
    -> Maybe SDoc
    -> (Int, [Scaled TcType])
    -> TcType
    -> TcM (HsWrapper, Scaled TcType, TcType)
    matchActualFunTySigma SDoc
    herald
                                              (forall a. a -> Maybe a
    Just (forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcRn
    rn_fun))
                                              (Int
    n_val_args, [Scaled TcType]
    so_far) TcType
    fun_ty
              ; (Delta
    delta', EValArg 'TcpInst
    arg') <- if Bool
    do_ql
                                  then forall a. AppCtxt -> LHsExpr GhcRn -> TcM a -> TcM a
    addArgCtxt AppCtxt
    ctxt LHsExpr (GhcPass (XPass 'TcpRn))
    arg forall a b. (a -> b) -> a -> b
    $
                                       -- Context needed for constraints
                                       -- generated by calls in arg
                                       Delta
    -> LHsExpr GhcRn -> Scaled TcType -> TcM (Delta, EValArg 'TcpInst)
    quickLookArg Delta
    delta LHsExpr (GhcPass (XPass 'TcpRn))
    arg Scaled TcType
    arg_ty
                                  else forall (m :: * -> *) a. Monad m => a -> m a
    return (Delta
    delta, forall (p :: TcPass). LHsExpr (GhcPass (XPass p)) -> EValArg p
    ValArg LHsExpr (GhcPass (XPass 'TcpRn))
    arg)
              ; let acc' :: [HsExprArg 'TcpInst]
    acc' = HsExprArg 'TcpRn
    eva { eva_arg :: EValArg 'TcpInst
    eva_arg = EValArg 'TcpInst
    arg', eva_arg_ty :: XEVAType 'TcpInst
    eva_arg_ty = Scaled TcType
    arg_ty }
                           forall a. a -> [a] -> [a]
    : HsWrapper -> [HsExprArg 'TcpInst] -> [HsExprArg 'TcpInst]
    addArgWrap HsWrapper
    wrap [HsExprArg 'TcpInst]
    acc
              ; Delta
    -> [HsExprArg 'TcpInst]
    -> [Scaled TcType]
    -> TcType
    -> [HsExprArg 'TcpRn]
    -> TcM (Delta, [HsExprArg 'TcpInst], TcType)
    go Delta
    delta' [HsExprArg 'TcpInst]
    acc' (Scaled TcType
    arg_tyforall a. a -> [a] -> [a]
    :[Scaled TcType]
    so_far) TcType
    res_ty [HsExprArg 'TcpRn]
    rest_args }

    addArgCtxt :: AppCtxt -> LHsExpr GhcRn
               -> TcM a -> TcM a
    -- Adds a "In the third argument of f, namely blah"
    -- context, unless we are in generated code, in which case
    -- use "In the expression: arg"
    ---See Note [Rebindable syntax and HsExpansion] in GHC.Hs.Expr
    addArgCtxt :: forall a. AppCtxt -> LHsExpr GhcRn -> TcM a -> TcM a
    addArgCtxt (VACall HsExpr GhcRn
    fun Int
    arg_no SrcSpan
    _) (L SrcSpanAnnA
    arg_loc HsExpr GhcRn
    arg) TcM a
    thing_inside
      = forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    arg_loc forall a b. (a -> b) -> a -> b
    $
        forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (forall fun arg.
    (Outputable fun, Outputable arg) =>
    fun -> arg -> Int -> SDoc
    funAppCtxt HsExpr GhcRn
    fun HsExpr GhcRn
    arg Int
    arg_no) forall a b. (a -> b) -> a -> b
    $
        TcM a
    thing_inside

    addArgCtxt (VAExpansion {}) (L SrcSpanAnnA
    arg_loc HsExpr GhcRn
    arg) TcM a
    thing_inside
      = forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    arg_loc forall a b. (a -> b) -> a -> b
    $
        forall a. HsExpr GhcRn -> TcRn a -> TcRn a
    addExprCtxt HsExpr GhcRn
    arg    forall a b. (a -> b) -> a -> b
    $  -- Auto-suppressed if arg_loc is generated
        TcM a
    thing_inside

    {- *********************************************************************
    *                                                                      *
                  Visible type application
    *                                                                      *
    ********************************************************************* -}

    tcVTA :: TcType            -- Function type
          -> LHsWcType GhcRn   -- Argument type
          -> TcM (TcType, TcType)
    -- Deal with a visible type application
    -- The function type has already had its Inferred binders instantiated
    tcVTA :: TcType -> LHsWcType GhcRn -> TcM (TcType, TcType)
    tcVTA TcType
    fun_ty LHsWcType GhcRn
    hs_ty
      | Just (TyVarBinder
    tvb, TcType
    inner_ty) <- TcType -> Maybe (TyVarBinder, TcType)
    tcSplitForAllTyVarBinder_maybe TcType
    fun_ty
      , forall tv argf. VarBndr tv argf -> argf
    binderArgFlag TyVarBinder
    tvb forall a. Eq a => a -> a -> Bool
    == ArgFlag
    Specified
        -- It really can't be Inferred, because we've just
        -- instantiated those. But, oddly, it might just be Required.
        -- See Note [Required quantifiers in the type of a term]
      = do { let tv :: TcTyVar
    tv   = forall tv argf. VarBndr tv argf -> tv
    binderVar TyVarBinder
    tvb
                 kind :: TcType
    kind = TcTyVar -> TcType
    tyVarKind TcTyVar
    tv
           ; TcType
    ty_arg <- LHsWcType GhcRn -> TcType -> TcM TcType
    tcHsTypeApp LHsWcType GhcRn
    hs_ty TcType
    kind

           ; TcType
    inner_ty <- TcType -> TcM TcType
    zonkTcType TcType
    inner_ty
                 -- See Note [Visible type application zonk]

           ; let in_scope :: InScopeSet
    in_scope  = Delta -> InScopeSet
    mkInScopeSet (ThetaType -> Delta
    tyCoVarsOfTypes [TcType
    fun_ty, TcType
    ty_arg])
                 insted_ty :: TcType
    insted_ty = InScopeSet -> [TcTyVar] -> ThetaType -> TcType -> TcType
    substTyWithInScope InScopeSet
    in_scope [TcTyVar
    tv] [TcType
    ty_arg] TcType
    inner_ty
                             -- NB: tv and ty_arg have the same kind, so this
                             --     substitution is kind-respecting
           ; String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "VTA" ([SDoc] -> SDoc
    vcat [forall a. Outputable a => a -> SDoc
    ppr TcTyVar
    tv, TcType -> SDoc
    debugPprType TcType
    kind
                                 , TcType -> SDoc
    debugPprType TcType
    ty_arg
                                 , TcType -> SDoc
    debugPprType (HasDebugCallStack => TcType -> TcType
    tcTypeKind TcType
    ty_arg)
                                 , TcType -> SDoc
    debugPprType TcType
    inner_ty
                                 , TcType -> SDoc
    debugPprType TcType
    insted_ty ])
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (TcType
    ty_arg, TcType
    insted_ty) }

      | Bool
    otherwise
      = do { (TidyEnv
    _, TcType
    fun_ty) <- TidyEnv -> TcType -> TcM (TidyEnv, TcType)
    zonkTidyTcType TidyEnv
    emptyTidyEnv TcType
    fun_ty
           ; forall a. SDoc -> TcRn a
    failWith forall a b. (a -> b) -> a -> b
    $
             String -> SDoc
    text String
    "Cannot apply expression of type" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (forall a. Outputable a => a -> SDoc
    ppr TcType
    fun_ty) SDoc -> SDoc -> SDoc
    $$
             String -> SDoc
    text String
    "to a visible type argument" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (forall a. Outputable a => a -> SDoc
    ppr LHsWcType GhcRn
    hs_ty) }

    {- Note [Required quantifiers in the type of a term]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider (#15859)

      data A k :: k -> Type      -- A      :: forall k -> k -> Type
      type KindOf (a :: k) = k   -- KindOf :: forall k. k -> Type
      a = (undefined :: KindOf A) @Int

    With ImpredicativeTypes (thin ice, I know), we instantiate
    KindOf at type (forall k -> k -> Type), so
      KindOf A = forall k -> k -> Type
    whose first argument is Required

    We want to reject this type application to Int, but in earlier
    GHCs we had an ASSERT that Required could not occur here.

    The ice is thin; c.f. Note [No Required TyCoBinder in terms]
    in GHC.Core.TyCo.Rep.

    Note [VTA for out-of-scope functions]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Suppose 'wurble' is not in scope, and we have
       (wurble @Int @Bool True 'x')

    Then the renamer will make (HsUnboundVar "wurble) for 'wurble',
    and the typechecker will typecheck it with tcUnboundId, giving it
    a type 'alpha', and emitting a deferred Hole constraint, to
    be reported later.

    But then comes the visible type application. If we do nothing, we'll
    generate an immediate failure (in tc_app_err), saying that a function
    of type 'alpha' can't be applied to Bool.  That's insane!  And indeed
    users complain bitterly (#13834, #17150.)

    The right error is the Hole, which has /already/ been emitted by
    tcUnboundId.  It later reports 'wurble' as out of scope, and tries to
    give its type.

    Fortunately in tcInstFun we still have access to the function, so we
    can check if it is a HsUnboundVar.  We use this info to simply skip
    over any visible type arguments.  We've already inferred the type of
    the function (in tcInferAppHead), so we'll /already/ have emitted a
    Hole constraint; failing preserves that constraint.

    We do /not/ want to fail altogether in this case (via failM) because
    that may abandon an entire instance decl, which (in the presence of
    -fdefer-type-errors) leads to leading to #17792.

    Downside; the typechecked term has lost its visible type arguments; we
    don't even kind-check them.  But let's jump that bridge if we come to
    it.  Meanwhile, let's not crash!

    Note [Visible type application zonk]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    * Substitutions should be kind-preserving, so we need kind(tv) = kind(ty_arg).

    * tcHsTypeApp only guarantees that
        - ty_arg is zonked
        - kind(zonk(tv)) = kind(ty_arg)
      (checkExpectedKind zonks as it goes).

    So we must zonk inner_ty as well, to guarantee consistency between zonk(tv)
    and inner_ty. Otherwise we can build an ill-kinded type. An example was #14158,
    where we had:
       id :: forall k. forall (cat :: k -> k -> *). forall (a :: k). cat a a
    and we had the visible type application
      id @(->)

    * We instantiated k := kappa, yielding
        forall (cat :: kappa -> kappa -> *). forall (a :: kappa). cat a a
    * Then we called tcHsTypeApp (->) with expected kind (kappa -> kappa -> *).
    * That instantiated (->) as ((->) q1 q1), and unified kappa := q1,
      Here q1 :: RuntimeRep
    * Now we substitute
         cat  :->  (->) q1 q1 :: TYPE q1 -> TYPE q1 -> *
      but we must first zonk the inner_ty to get
          forall (a :: TYPE q1). cat a a
      so that the result of substitution is well-kinded
      Failing to do so led to #14158.

    -}

    {- *********************************************************************
    *                                                                      *
                  Quick Look
    *                                                                      *
    ********************************************************************* -}

    {- Note [Quick Look at value arguments]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The function quickLookArg implements the "QL argument" judgement of
    the QL paper, in Fig 5 of "A quick look at impredicativity" (ICFP 2020),
    rather directly.

    Wrinkles:

    * We avoid zonking, so quickLookArg thereby sees the argument type /before/
      the QL substitution Theta is applied to it. So we achieve argument-order
      independence for free (see 5.7 in the paper).

    * When we quick-look at an argument, we save the work done, by returning
      an EValArg with a ValArgQL inside it.  (It started life with a ValArg
      inside.)  The ValArgQL remembers all the work that QL did (notably,
      decomposing the argument and instantiating) so that tcValArgs does
      not need to repeat it.  Rather neat, and remarkably easy.
    -}

    ----------------
    quickLookArg :: Delta
                 -> LHsExpr GhcRn       -- Argument
                 -> Scaled TcSigmaType  -- Type expected by the function
                 -> TcM (Delta, EValArg 'TcpInst)
    -- See Note [Quick Look at value arguments]
    --
    -- The returned Delta is a superset of the one passed in
    -- with added instantiation variables from
    --   (a) the call itself
    --   (b) the arguments of the call
    quickLookArg :: Delta
    -> LHsExpr GhcRn -> Scaled TcType -> TcM (Delta, EValArg 'TcpInst)
    quickLookArg Delta
    delta LHsExpr GhcRn
    larg (Scaled TcType
    _ TcType
    arg_ty)
      | Delta -> Bool
    isEmptyVarSet Delta
    delta  = Delta -> LHsExpr GhcRn -> TcM (Delta, EValArg 'TcpInst)
    skipQuickLook Delta
    delta LHsExpr GhcRn
    larg
      | Bool
    otherwise            = TcType -> TcM (Delta, EValArg 'TcpInst)
    go TcType
    arg_ty
      where
        guarded :: Bool
    guarded = TcType -> Bool
    isGuardedTy TcType
    arg_ty
          -- NB: guardedness is computed based on the original,
          -- unzonked arg_ty, so we deliberately do not exploit
          -- guardedness that emerges a result of QL on earlier args

        go :: TcType -> TcM (Delta, EValArg 'TcpInst)
    go TcType
    arg_ty | Bool -> Bool
    not (TcType -> Bool
    isRhoTy TcType
    arg_ty)
                  = Delta -> LHsExpr GhcRn -> TcM (Delta, EValArg 'TcpInst)
    skipQuickLook Delta
    delta LHsExpr GhcRn
    larg

                  -- This top-level zonk step, which is the reason
                  -- we need a local 'go' loop, is subtle
                  -- See Section 9 of the QL paper
                  | Just TcTyVar
    kappa <- TcType -> Maybe TcTyVar
    tcGetTyVar_maybe TcType
    arg_ty
                  , TcTyVar
    kappa TcTyVar -> Delta -> Bool
    `elemVarSet` Delta
    delta
                  = do { MetaDetails
    info <- TcTyVar -> TcM MetaDetails
    readMetaTyVar TcTyVar
    kappa
                       ; case MetaDetails
    info of
                           Indirect TcType
    arg_ty' -> TcType -> TcM (Delta, EValArg 'TcpInst)
    go TcType
    arg_ty'
                           MetaDetails
    Flexi            -> Bool
    -> Delta
    -> LHsExpr GhcRn
    -> TcType
    -> TcM (Delta, EValArg 'TcpInst)
    quickLookArg1 Bool
    guarded Delta
    delta LHsExpr GhcRn
    larg TcType
    arg_ty }

                  | Bool
    otherwise
                  = Bool
    -> Delta
    -> LHsExpr GhcRn
    -> TcType
    -> TcM (Delta, EValArg 'TcpInst)
    quickLookArg1 Bool
    guarded Delta
    delta LHsExpr GhcRn
    larg TcType
    arg_ty

    isGuardedTy :: TcType -> Bool
    isGuardedTy :: TcType -> Bool
    isGuardedTy TcType
    ty
      | Just (TyCon
    tc,ThetaType
    _) <- HasCallStack => TcType -> Maybe (TyCon, ThetaType)
    tcSplitTyConApp_maybe TcType
    ty = TyCon -> Role -> Bool
    isGenerativeTyCon TyCon
    tc Role
    Nominal
      | Just {} <- TcType -> Maybe (TcType, TcType)
    tcSplitAppTy_maybe TcType
    ty        = Bool
    True
      | Bool
    otherwise                               = Bool
    False

    quickLookArg1 :: Bool -> Delta -> LHsExpr GhcRn -> TcSigmaType
                  -> TcM (Delta, EValArg 'TcpInst)
    quickLookArg1 :: Bool
    -> Delta
    -> LHsExpr GhcRn
    -> TcType
    -> TcM (Delta, EValArg 'TcpInst)
    quickLookArg1 Bool
    guarded Delta
    delta larg :: LHsExpr GhcRn
    larg@(L SrcSpanAnnA
    _ HsExpr GhcRn
    arg) TcType
    arg_ty
      = do { let (fun :: (HsExpr GhcRn, AppCtxt)
    fun@(HsExpr GhcRn
    rn_fun, AppCtxt
    fun_ctxt), [HsExprArg 'TcpRn]
    rn_args) = HsExpr GhcRn -> ((HsExpr GhcRn, AppCtxt), [HsExprArg 'TcpRn])
    splitHsApps HsExpr GhcRn
    arg
           ; Maybe (HsExpr GhcTc, TcType)
    mb_fun_ty <- HsExpr GhcRn
    -> [HsExprArg 'TcpRn]
    -> Maybe TcType
    -> TcM (Maybe (HsExpr GhcTc, TcType))
    tcInferAppHead_maybe HsExpr GhcRn
    rn_fun [HsExprArg 'TcpRn]
    rn_args (forall a. a -> Maybe a
    Just TcType
    arg_ty)
           ; String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "quickLookArg 1" forall a b. (a -> b) -> a -> b
    $
             [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "arg:" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcRn
    arg
                  , String -> SDoc
    text String
    "head:" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcRn
    rn_fun SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr Maybe (HsExpr GhcTc, TcType)
    mb_fun_ty
                  , String -> SDoc
    text String
    "args:" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr [HsExprArg 'TcpRn]
    rn_args ]

           ; case Maybe (HsExpr GhcTc, TcType)
    mb_fun_ty of {
               Maybe (HsExpr GhcTc, TcType)
    Nothing     -> -- fun is too complicated
                              Delta -> LHsExpr GhcRn -> TcM (Delta, EValArg 'TcpInst)
    skipQuickLook Delta
    delta LHsExpr GhcRn
    larg ;
               Just (HsExpr GhcTc
    tc_fun, TcType
    fun_sigma) ->

        do { let no_free_kappas :: Bool
    no_free_kappas = TcType -> [HsExprArg 'TcpRn] -> Bool
    findNoQuantVars TcType
    fun_sigma [HsExprArg 'TcpRn]
    rn_args
           ; String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "quickLookArg 2" forall a b. (a -> b) -> a -> b
    $
             [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "no_free_kappas:" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr Bool
    no_free_kappas
                  , String -> SDoc
    text String
    "guarded:" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr Bool
    guarded
                  , String -> SDoc
    text String
    "tc_fun:" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcTc
    tc_fun
                  , String -> SDoc
    text String
    "fun_sigma:" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr TcType
    fun_sigma ]
           ; if Bool -> Bool
    not (Bool
    guarded Bool -> Bool -> Bool
    || Bool
    no_free_kappas)
             then Delta -> LHsExpr GhcRn -> TcM (Delta, EValArg 'TcpInst)
    skipQuickLook Delta
    delta LHsExpr GhcRn
    larg
             else
        do { Bool
    do_ql <- HsExpr GhcRn -> TcM Bool
    wantQuickLook HsExpr GhcRn
    rn_fun
           ; (Delta
    delta_app, [HsExprArg 'TcpInst]
    inst_args, TcType
    app_res_rho) <- Bool
    -> Bool
    -> (HsExpr GhcRn, AppCtxt)
    -> TcType
    -> [HsExprArg 'TcpRn]
    -> TcM (Delta, [HsExprArg 'TcpInst], TcType)
    tcInstFun Bool
    do_ql Bool
    True (HsExpr GhcRn, AppCtxt)
    fun TcType
    fun_sigma [HsExprArg 'TcpRn]
    rn_args
           ; String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "quickLookArg 3" forall a b. (a -> b) -> a -> b
    $
             [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "arg:" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcRn
    arg
                  , String -> SDoc
    text String
    "delta:" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr Delta
    delta
                  , String -> SDoc
    text String
    "delta_app:" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr Delta
    delta_app
                  , String -> SDoc
    text String
    "arg_ty:" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr TcType
    arg_ty
                  , String -> SDoc
    text String
    "app_res_rho:" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr TcType
    app_res_rho ]

           -- Do quick-look unification
           -- NB: arg_ty may not be zonked, but that's ok
           ; let delta' :: Delta
    delta' = Delta
    delta Delta -> Delta -> Delta
    `unionVarSet` Delta
    delta_app
           ; Delta -> TcType -> TcType -> TcRnIf TcGblEnv TcLclEnv ()
    qlUnify Delta
    delta' TcType
    arg_ty TcType
    app_res_rho

           ; let ql_arg :: EValArg 'TcpInst
    ql_arg = ValArgQL { va_expr :: LHsExpr GhcRn
    va_expr  = LHsExpr GhcRn
    larg
                                   , va_fun :: (HsExpr GhcTc, AppCtxt)
    va_fun   = (HsExpr GhcTc
    tc_fun, AppCtxt
    fun_ctxt)
                                   , va_args :: [HsExprArg 'TcpInst]
    va_args  = [HsExprArg 'TcpInst]
    inst_args
                                   , va_ty :: TcType
    va_ty    = TcType
    app_res_rho }
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (Delta
    delta', EValArg 'TcpInst
    ql_arg) } } } }

    skipQuickLook :: Delta -> LHsExpr GhcRn -> TcM (Delta, EValArg 'TcpInst)
    skipQuickLook :: Delta -> LHsExpr GhcRn -> TcM (Delta, EValArg 'TcpInst)
    skipQuickLook Delta
    delta LHsExpr GhcRn
    larg = forall (m :: * -> *) a. Monad m => a -> m a
    return (Delta
    delta, forall (p :: TcPass). LHsExpr (GhcPass (XPass p)) -> EValArg p
    ValArg LHsExpr GhcRn
    larg)

    ----------------
    quickLookResultType :: Delta -> TcRhoType -> ExpRhoType -> TcM TcRhoType
    -- This function implements the shaded bit of rule APP-Downarrow in
    -- Fig 5 of the QL paper: "A quick look at impredicativity" (ICFP'20).
    -- It returns its second argument, but with any variables in Delta
    -- substituted out, so no variables in Delta escape

    quickLookResultType :: Delta -> TcType -> ExpRhoType -> TcM TcType
    quickLookResultType Delta
    delta TcType
    app_res_rho (Check TcType
    exp_rho)
      = -- In checking mode only, do qlUnify with the expected result type
        do { forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Delta -> Bool
    isEmptyVarSet Delta
    delta)  forall a b. (a -> b) -> a -> b
    $ -- Optimisation only
             Delta -> TcType -> TcType -> TcRnIf TcGblEnv TcLclEnv ()
    qlUnify Delta
    delta TcType
    app_res_rho TcType
    exp_rho
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return TcType
    app_res_rho }

    quickLookResultType Delta
    _ TcType
    app_res_rho (Infer {})
      = TcType -> TcM TcType
    zonkTcType TcType
    app_res_rho
        -- Zonk the result type, to ensure that we substitute out any
        -- filled-in instantiation variable before calling
        -- unifyExpectedType. In the Check case, this isn't necessary,
        -- because unifyExpectedType just drops to tcUnify; but in the
        -- Infer case a filled-in instantiation variable (filled in by
        -- tcInstFun) might perhaps escape into the constraint
        -- generator. The safe thing to do is to zonk any instantiation
        -- variables away.  See Note [Instantiation variables are short lived]

    ---------------------
    qlUnify :: Delta -> TcType -> TcType -> TcM ()
    -- Unify ty1 with ty2, unifying only variables in delta
    qlUnify :: Delta -> TcType -> TcType -> TcRnIf TcGblEnv TcLclEnv ()
    qlUnify Delta
    delta TcType
    ty1 TcType
    ty2
      = do { String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "qlUnify" (forall a. Outputable a => a -> SDoc
    ppr Delta
    delta SDoc -> SDoc -> SDoc
    $$ forall a. Outputable a => a -> SDoc
    ppr TcType
    ty1 SDoc -> SDoc -> SDoc
    $$ forall a. Outputable a => a -> SDoc
    ppr TcType
    ty2)
           ; (Delta, Delta) -> TcType -> TcType -> TcRnIf TcGblEnv TcLclEnv ()
    go (Delta
    emptyVarSet,Delta
    emptyVarSet) TcType
    ty1 TcType
    ty2 }
      where
        go :: (TyVarSet, TcTyVarSet)
           -> TcType -> TcType
           -> TcM ()
        -- The TyVarSets give the variables bound by enclosing foralls
        -- for the corresponding type. Don't unify with these.
        go :: (Delta, Delta) -> TcType -> TcType -> TcRnIf TcGblEnv TcLclEnv ()
    go (Delta, Delta)
    bvs (TyVarTy TcTyVar
    tv) TcType
    ty2
          | TcTyVar
    tv TcTyVar -> Delta -> Bool
    `elemVarSet` Delta
    delta = (Delta, Delta) -> TcTyVar -> TcType -> TcRnIf TcGblEnv TcLclEnv ()
    go_kappa (Delta, Delta)
    bvs TcTyVar
    tv TcType
    ty2

        go (Delta
    bvs1, Delta
    bvs2) TcType
    ty1 (TyVarTy TcTyVar
    tv)
          | TcTyVar
    tv TcTyVar -> Delta -> Bool
    `elemVarSet` Delta
    delta = (Delta, Delta) -> TcTyVar -> TcType -> TcRnIf TcGblEnv TcLclEnv ()
    go_kappa (Delta
    bvs2,Delta
    bvs1) TcTyVar
    tv TcType
    ty1

        go (Delta, Delta)
    bvs (CastTy TcType
    ty1 TcCoercionN
    _) TcType
    ty2 = (Delta, Delta) -> TcType -> TcType -> TcRnIf TcGblEnv TcLclEnv ()
    go (Delta, Delta)
    bvs TcType
    ty1 TcType
    ty2
        go (Delta, Delta)
    bvs TcType
    ty1 (CastTy TcType
    ty2 TcCoercionN
    _) = (Delta, Delta) -> TcType -> TcType -> TcRnIf TcGblEnv TcLclEnv ()
    go (Delta, Delta)
    bvs TcType
    ty1 TcType
    ty2

        go (Delta, Delta)
    _ (TyConApp TyCon
    tc1 []) (TyConApp TyCon
    tc2 [])
          | TyCon
    tc1 forall a. Eq a => a -> a -> Bool
    == TyCon
    tc2 -- See GHC.Tc.Utils.Unify
          = forall (m :: * -> *) a. Monad m => a -> m a
    return ()  -- Note [Expanding synonyms during unification]

        -- Now, and only now, expand synonyms
        go (Delta, Delta)
    bvs TcType
    rho1 TcType
    rho2
          | Just TcType
    rho1 <- TcType -> Maybe TcType
    tcView TcType
    rho1 = (Delta, Delta) -> TcType -> TcType -> TcRnIf TcGblEnv TcLclEnv ()
    go (Delta, Delta)
    bvs TcType
    rho1 TcType
    rho2
          | Just TcType
    rho2 <- TcType -> Maybe TcType
    tcView TcType
    rho2 = (Delta, Delta) -> TcType -> TcType -> TcRnIf TcGblEnv TcLclEnv ()
    go (Delta, Delta)
    bvs TcType
    rho1 TcType
    rho2

        go (Delta, Delta)
    bvs (TyConApp TyCon
    tc1 ThetaType
    tys1) (TyConApp TyCon
    tc2 ThetaType
    tys2)
          | TyCon
    tc1 forall a. Eq a => a -> a -> Bool
    == TyCon
    tc2
          , Bool -> Bool
    not (TyCon -> Bool
    isTypeFamilyTyCon TyCon
    tc1)
          , ThetaType
    tys1 forall a b. [a] -> [b] -> Bool
    `equalLength` ThetaType
    tys2
          = forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m ()
    zipWithM_ ((Delta, Delta) -> TcType -> TcType -> TcRnIf TcGblEnv TcLclEnv ()
    go (Delta, Delta)
    bvs) ThetaType
    tys1 ThetaType
    tys2

        -- Decompose (arg1 -> res1) ~ (arg2 -> res2)
        -- and         (c1 => res1) ~   (c2 => res2)
        -- But for the latter we only learn instantiation info from t1~t2
        -- We look at the multiplicity too, although the chances of getting
        -- impredicative instantiation info from there seems...remote.
        go (Delta, Delta)
    bvs (FunTy { ft_af :: TcType -> AnonArgFlag
    ft_af = AnonArgFlag
    af1, ft_arg :: TcType -> TcType
    ft_arg = TcType
    arg1, ft_res :: TcType -> TcType
    ft_res = TcType
    res1, ft_mult :: TcType -> TcType
    ft_mult = TcType
    mult1 })
               (FunTy { ft_af :: TcType -> AnonArgFlag
    ft_af = AnonArgFlag
    af2, ft_arg :: TcType -> TcType
    ft_arg = TcType
    arg2, ft_res :: TcType -> TcType
    ft_res = TcType
    res2, ft_mult :: TcType -> TcType
    ft_mult = TcType
    mult2 })
          | AnonArgFlag
    af1 forall a. Eq a => a -> a -> Bool
    == AnonArgFlag
    af2
          = do { forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (AnonArgFlag
    af1 forall a. Eq a => a -> a -> Bool
    == AnonArgFlag
    VisArg) forall a b. (a -> b) -> a -> b
    $
                 do { (Delta, Delta) -> TcType -> TcType -> TcRnIf TcGblEnv TcLclEnv ()
    go (Delta, Delta)
    bvs TcType
    arg1 TcType
    arg2; (Delta, Delta) -> TcType -> TcType -> TcRnIf TcGblEnv TcLclEnv ()
    go (Delta, Delta)
    bvs TcType
    mult1 TcType
    mult2 }
               ; (Delta, Delta) -> TcType -> TcType -> TcRnIf TcGblEnv TcLclEnv ()
    go (Delta, Delta)
    bvs TcType
    res1 TcType
    res2 }

        -- ToDo: c.f. Tc.Utils.unify.uType,
        -- which does not split FunTy here
        -- Also NB tcRepSplitAppTy here, which does not split (c => t)
        go (Delta, Delta)
    bvs (AppTy TcType
    t1a TcType
    t1b) TcType
    ty2
          | Just (TcType
    t2a, TcType
    t2b) <- TcType -> Maybe (TcType, TcType)
    tcRepSplitAppTy_maybe TcType
    ty2
          = do { (Delta, Delta) -> TcType -> TcType -> TcRnIf TcGblEnv TcLclEnv ()
    go (Delta, Delta)
    bvs TcType
    t1a TcType
    t2a; (Delta, Delta) -> TcType -> TcType -> TcRnIf TcGblEnv TcLclEnv ()
    go (Delta, Delta)
    bvs TcType
    t1b TcType
    t2b }

        go (Delta, Delta)
    bvs TcType
    ty1 (AppTy TcType
    t2a TcType
    t2b)
          | Just (TcType
    t1a, TcType
    t1b) <- TcType -> Maybe (TcType, TcType)
    tcRepSplitAppTy_maybe TcType
    ty1
          = do { (Delta, Delta) -> TcType -> TcType -> TcRnIf TcGblEnv TcLclEnv ()
    go (Delta, Delta)
    bvs TcType
    t1a TcType
    t2a; (Delta, Delta) -> TcType -> TcType -> TcRnIf TcGblEnv TcLclEnv ()
    go (Delta, Delta)
    bvs TcType
    t1b TcType
    t2b }

        go (Delta
    bvs1, Delta
    bvs2) (ForAllTy TyVarBinder
    bv1 TcType
    ty1) (ForAllTy TyVarBinder
    bv2 TcType
    ty2)
          = (Delta, Delta) -> TcType -> TcType -> TcRnIf TcGblEnv TcLclEnv ()
    go (Delta
    bvs1',Delta
    bvs2') TcType
    ty1 TcType
    ty2
          where
           bvs1' :: Delta
    bvs1' = Delta
    bvs1 Delta -> TcTyVar -> Delta
    `extendVarSet` forall tv argf. VarBndr tv argf -> tv
    binderVar TyVarBinder
    bv1
           bvs2' :: Delta
    bvs2' = Delta
    bvs2 Delta -> TcTyVar -> Delta
    `extendVarSet` forall tv argf. VarBndr tv argf -> tv
    binderVar TyVarBinder
    bv2

        go (Delta, Delta)
    _ TcType
    _ TcType
    _ = forall (m :: * -> *) a. Monad m => a -> m a
    return ()

        ----------------
        go_kappa :: (Delta, Delta) -> TcTyVar -> TcType -> TcRnIf TcGblEnv TcLclEnv ()
    go_kappa (Delta, Delta)
    bvs TcTyVar
    kappa TcType
    ty2
          = ASSERT2( isMetaTyVar kappa, ppr kappa )
            do { MetaDetails
    info <- TcTyVar -> TcM MetaDetails
    readMetaTyVar TcTyVar
    kappa
               ; case MetaDetails
    info of
                   Indirect TcType
    ty1 -> (Delta, Delta) -> TcType -> TcType -> TcRnIf TcGblEnv TcLclEnv ()
    go (Delta, Delta)
    bvs TcType
    ty1 TcType
    ty2
                   MetaDetails
    Flexi        -> do { TcType
    ty2 <- TcType -> TcM TcType
    zonkTcType TcType
    ty2
                                      ; forall {a}.
    (a, Delta) -> TcTyVar -> TcType -> TcRnIf TcGblEnv TcLclEnv ()
    go_flexi (Delta, Delta)
    bvs TcTyVar
    kappa TcType
    ty2 } }

        ----------------
        go_flexi :: (a, Delta) -> TcTyVar -> TcType -> TcRnIf TcGblEnv TcLclEnv ()
    go_flexi (a
    _,Delta
    bvs2) TcTyVar
    kappa TcType
    ty2  -- ty2 is zonked
          | -- See Note [Actual unification in qlUnify]
            let ty2_tvs :: Delta
    ty2_tvs = TcType -> Delta
    shallowTyCoVarsOfType TcType
    ty2
          , Bool -> Bool
    not (Delta
    ty2_tvs Delta -> Delta -> Bool
    `intersectsVarSet` Delta
    bvs2)
              -- Can't instantiate a delta-varto a forall-bound variable
          , Just TcType
    ty2 <- [TcTyVar] -> TcType -> Maybe TcType
    occCheckExpand [TcTyVar
    kappa] TcType
    ty2
              -- Passes the occurs check
          = do { let ty2_kind :: TcType
    ty2_kind   = HasDebugCallStack => TcType -> TcType
    typeKind TcType
    ty2
                     kappa_kind :: TcType
    kappa_kind = TcTyVar -> TcType
    tyVarKind TcTyVar
    kappa
               ; TcCoercionN
    co <- Maybe SDoc -> TcType -> TcType -> TcM TcCoercionN
    unifyKind (forall a. a -> Maybe a
    Just (forall a. Outputable a => a -> SDoc
    ppr TcType
    ty2)) TcType
    ty2_kind TcType
    kappa_kind
                       -- unifyKind: see Note [Actual unification in qlUnify]

               ; String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "qlUnify:update" forall a b. (a -> b) -> a -> b
    $
                 [SDoc] -> SDoc
    vcat [ SDoc -> Int -> SDoc -> SDoc
    hang (forall a. Outputable a => a -> SDoc
    ppr TcTyVar
    kappa SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr TcType
    kappa_kind)
                           Int
    2 (String -> SDoc
    text String
    ":=" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr TcType
    ty2 SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr TcType
    ty2_kind)
                     , String -> SDoc
    text String
    "co:" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr TcCoercionN
    co ]
               ; TcTyVar -> TcType -> TcRnIf TcGblEnv TcLclEnv ()
    writeMetaTyVar TcTyVar
    kappa (TcType -> TcCoercionN -> TcType
    mkCastTy TcType
    ty2 TcCoercionN
    co) }

          | Bool
    otherwise
          = forall (m :: * -> *) a. Monad m => a -> m a
    return ()   -- Occurs-check or forall-bound varialbe

    {- Note [Actual unification in qlUnify]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In qlUnify, if we find (kappa ~ ty), we are going to update kappa := ty.
    That is the entire point of qlUnify!   Wrinkles:

    * We must not unify with anything bound by an enclosing forall; e.g.
        (forall a. kappa -> Int) ~ forall a. a -> Int)
      That's tracked by the 'bvs' arg of 'go'.

    * We must not make an occurs-check; we use occCheckExpand for that.

    * checkTypeEq also checks for various other things, including
      - foralls, and predicate types (which we want to allow here)
      - type families (relates to a very specific and exotic performance
        question, that is unlikely to bite here)
      - blocking coercion holes
      After some thought we believe that none of these are relevant
      here

    * What if kappa and ty have different kinds?  We solve that problem by
      calling unifyKind, producing a coercion perhaps emitting some deferred
      equality constraints.  That is /different/ from the approach we use in
      the main constraint solver for herterogeneous equalities; see Note
      [Equalities with incompatible kinds] in Solver.Canonical

      Why different? Because:
      - We can't use qlUnify to solve the kind constraint because qlUnify
        won't unify ordinary (non-instantiation) unification variables.
        (It would have to worry about lots of things like untouchability
        if it did.)
      - qlUnify can't give up if the kinds look un-equal because that would
        mean that it might succeed some times (when the eager unifier
        has already unified those kinds) but not others -- order
        dependence.
      - We can't use the ordinary unifier/constraint solver instead,
        because it doesn't unify polykinds, and has all kinds of other
        magic.  qlUnify is very focused.

      TL;DR Calling unifyKind seems like the lesser evil.
      -}

    {- *********************************************************************
    *                                                                      *
                  Guardedness
    *                                                                      *
    ********************************************************************* -}

    findNoQuantVars :: TcSigmaType -> [HsExprArg 'TcpRn] -> Bool
    -- True <=> there are no free quantified variables
    --          in the result of the call
    -- E.g. in the call (f e1 e2), if
    --   f :: forall a b. a -> b -> Int   return True
    --   f :: forall a b. a -> b -> b     return False (b is free)
    findNoQuantVars :: TcType -> [HsExprArg 'TcpRn] -> Bool
    findNoQuantVars TcType
    fun_ty [HsExprArg 'TcpRn]
    args
      = Delta -> TcType -> [HsExprArg 'TcpRn] -> Bool
    go Delta
    emptyVarSet TcType
    fun_ty [HsExprArg 'TcpRn]
    args
      where
        need_instantiation :: [HsExprArg p] -> Bool
    need_instantiation []               = Bool
    True
        need_instantiation (EValArg {} : [HsExprArg p]
    _) = Bool
    True
        need_instantiation [HsExprArg p]
    _                = Bool
    False

        go :: TyVarSet -> TcSigmaType -> [HsExprArg 'TcpRn] -> Bool
        go :: Delta -> TcType -> [HsExprArg 'TcpRn] -> Bool
    go Delta
    bvs TcType
    fun_ty [HsExprArg 'TcpRn]
    args
          | forall {p :: TcPass}. [HsExprArg p] -> Bool
    need_instantiation [HsExprArg 'TcpRn]
    args
          , ([TcTyVar]
    tvs, ThetaType
    theta, TcType
    rho) <- TcType -> ([TcTyVar], ThetaType, TcType)
    tcSplitSigmaTy TcType
    fun_ty
          , Bool -> Bool
    not (forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TcTyVar]
    tvs Bool -> Bool -> Bool
    && forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ThetaType
    theta)
          = Delta -> TcType -> [HsExprArg 'TcpRn] -> Bool
    go (Delta
    bvs Delta -> [TcTyVar] -> Delta
    `extendVarSetList` [TcTyVar]
    tvs) TcType
    rho [HsExprArg 'TcpRn]
    args

        go Delta
    bvs TcType
    fun_ty [] =  TcType -> Delta
    tyCoVarsOfType TcType
    fun_ty Delta -> Delta -> Bool
    `disjointVarSet` Delta
    bvs

        go Delta
    bvs TcType
    fun_ty (EWrap {} : [HsExprArg 'TcpRn]
    args) = Delta -> TcType -> [HsExprArg 'TcpRn] -> Bool
    go Delta
    bvs TcType
    fun_ty [HsExprArg 'TcpRn]
    args
        go Delta
    bvs TcType
    fun_ty (EPrag {} : [HsExprArg 'TcpRn]
    args) = Delta -> TcType -> [HsExprArg 'TcpRn] -> Bool
    go Delta
    bvs TcType
    fun_ty [HsExprArg 'TcpRn]
    args

        go Delta
    bvs TcType
    fun_ty args :: [HsExprArg 'TcpRn]
    args@(ETypeArg {} : [HsExprArg 'TcpRn]
    rest_args)
          | ([TcTyVar]
    tvs,  TcType
    body1) <- (ArgFlag -> Bool) -> TcType -> ([TcTyVar], TcType)
    tcSplitSomeForAllTyVars (forall a. Eq a => a -> a -> Bool
    == ArgFlag
    Inferred) TcType
    fun_ty
          , (ThetaType
    theta, TcType
    body2) <- TcType -> (ThetaType, TcType)
    tcSplitPhiTy TcType
    body1
          , Bool -> Bool
    not (forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TcTyVar]
    tvs Bool -> Bool -> Bool
    && forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ThetaType
    theta)
          = Delta -> TcType -> [HsExprArg 'TcpRn] -> Bool
    go (Delta
    bvs Delta -> [TcTyVar] -> Delta
    `extendVarSetList` [TcTyVar]
    tvs) TcType
    body2 [HsExprArg 'TcpRn]
    args
          | Just (TyVarBinder
    _tv, TcType
    res_ty) <- TcType -> Maybe (TyVarBinder, TcType)
    tcSplitForAllTyVarBinder_maybe TcType
    fun_ty
          = Delta -> TcType -> [HsExprArg 'TcpRn] -> Bool
    go Delta
    bvs TcType
    res_ty [HsExprArg 'TcpRn]
    rest_args
          | Bool
    otherwise
          = Bool
    False  -- E.g. head ids @Int

        go Delta
    bvs TcType
    fun_ty (EValArg {} : [HsExprArg 'TcpRn]
    rest_args)
          | Just (Scaled TcType
    _, TcType
    res_ty) <- TcType -> Maybe (Scaled TcType, TcType)
    tcSplitFunTy_maybe TcType
    fun_ty
          = Delta -> TcType -> [HsExprArg 'TcpRn] -> Bool
    go Delta
    bvs TcType
    res_ty [HsExprArg 'TcpRn]
    rest_args
          | Bool
    otherwise
          = Bool
    False  -- E.g. head id 'x'

    {- *********************************************************************
    *                                                                      *
                     tagToEnum#
    *                                                                      *
    ********************************************************************* -}

    {- Note [tagToEnum#]
    ~~~~~~~~~~~~~~~~~~~~
    Nasty check to ensure that tagToEnum# is applied to a type that is an
    enumeration TyCon.  It's crude, because it relies on our
    knowing *now* that the type is ok, which in turn relies on the
    eager-unification part of the type checker pushing enough information
    here.  In theory the Right Thing to do is to have a new form of
    constraint but I definitely cannot face that!  And it works ok as-is.

    Here's are two cases that should fail
            f :: forall a. a
            f = tagToEnum# 0        -- Can't do tagToEnum# at a type variable

            g :: Int
            g = tagToEnum# 0        -- Int is not an enumeration

    When data type families are involved it's a bit more complicated.
         data family F a
         data instance F [Int] = A | B | C
    Then we want to generate something like
         tagToEnum# R:FListInt 3# |> co :: R:FListInt ~ F [Int]
    Usually that coercion is hidden inside the wrappers for
    constructors of F [Int] but here we have to do it explicitly.

    It's all grotesquely complicated.
    -}

    isTagToEnum :: HsExpr GhcRn -> Bool
    isTagToEnum :: HsExpr GhcRn -> Bool
    isTagToEnum (HsVar XVar GhcRn
    _ (L SrcSpanAnnN
    _ Name
    fun_id)) = Name
    fun_id forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    tagToEnumKey
    isTagToEnum HsExpr GhcRn
    _ = Bool
    False

    tcTagToEnum :: HsExpr GhcTc -> AppCtxt -> [HsExprArg 'TcpTc]
                -> TcRhoType
                -> TcM (HsExpr GhcTc)
    -- tagToEnum# :: forall a. Int# -> a
    -- See Note [tagToEnum#]   Urgh!
    tcTagToEnum :: HsExpr GhcTc
    -> AppCtxt -> [HsExprArg 'TcpTc] -> TcType -> TcM (HsExpr GhcTc)
    tcTagToEnum HsExpr GhcTc
    tc_fun AppCtxt
    fun_ctxt [HsExprArg 'TcpTc]
    tc_args TcType
    res_ty
      | [HsExprArg 'TcpTc
    val_arg] <- forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Bool -> Bool
    not forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall (id :: TcPass). HsExprArg id -> Bool
    isHsValArg) [HsExprArg 'TcpTc]
    tc_args
      = do { TcType
    res_ty <- TcType -> TcM TcType
    zonkTcType TcType
    res_ty

           -- Check that the type is algebraic
           ; case HasCallStack => TcType -> Maybe (TyCon, ThetaType)
    tcSplitTyConApp_maybe TcType
    res_ty of {
               Maybe (TyCon, ThetaType)
    Nothing -> do { SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    addErrTc (TcType -> SDoc -> SDoc
    mk_error TcType
    res_ty SDoc
    doc1)
                             ; TcM (HsExpr GhcTc)
    vanilla_result } ;
               Just (TyCon
    tc, ThetaType
    tc_args) ->

        do { -- Look through any type family
           ; FamInstEnvs
    fam_envs <- TcM FamInstEnvs
    tcGetFamInstEnvs
           ; case FamInstEnvs
    -> TyCon -> ThetaType -> Maybe (TyCon, ThetaType, TcCoercionN)
    tcLookupDataFamInst_maybe FamInstEnvs
    fam_envs TyCon
    tc ThetaType
    tc_args of {
               Maybe (TyCon, ThetaType, TcCoercionN)
    Nothing -> do { TcType -> TyCon -> TcRnIf TcGblEnv TcLclEnv ()
    check_enumeration TcType
    res_ty TyCon
    tc
                             ; TcM (HsExpr GhcTc)
    vanilla_result } ;
               Just (TyCon
    rep_tc, ThetaType
    rep_args, TcCoercionN
    coi) ->

        do { -- coi :: tc tc_args ~R rep_tc rep_args
             TcType -> TyCon -> TcRnIf TcGblEnv TcLclEnv ()
    check_enumeration TcType
    res_ty TyCon
    rep_tc
           ; let rep_ty :: TcType
    rep_ty  = TyCon -> ThetaType -> TcType
    mkTyConApp TyCon
    rep_tc ThetaType
    rep_args
                 tc_fun' :: HsExpr GhcTc
    tc_fun' = HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap (TcType -> HsWrapper
    WpTyApp TcType
    rep_ty) HsExpr GhcTc
    tc_fun
                 tc_expr :: HsExpr GhcTc
    tc_expr = HsExpr GhcTc -> AppCtxt -> [HsExprArg 'TcpTc] -> HsExpr GhcTc
    rebuildHsApps HsExpr GhcTc
    tc_fun' AppCtxt
    fun_ctxt [HsExprArg 'TcpTc
    val_arg]
                 df_wrap :: HsWrapper
    df_wrap = TcCoercionN -> HsWrapper
    mkWpCastR (TcCoercionN -> TcCoercionN
    mkTcSymCo TcCoercionN
    coi)
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap HsWrapper
    df_wrap HsExpr GhcTc
    tc_expr) }}}}}

      | Bool
    otherwise
      = forall a. SDoc -> TcRn a
    failWithTc (String -> SDoc
    text String
    "tagToEnum# must appear applied to one value argument")

      where
        vanilla_result :: TcM (HsExpr GhcTc)
    vanilla_result = forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcTc -> AppCtxt -> [HsExprArg 'TcpTc] -> HsExpr GhcTc
    rebuildHsApps HsExpr GhcTc
    tc_fun AppCtxt
    fun_ctxt [HsExprArg 'TcpTc]
    tc_args)

        check_enumeration :: TcType -> TyCon -> TcRnIf TcGblEnv TcLclEnv ()
    check_enumeration TcType
    ty' TyCon
    tc
          | TyCon -> Bool
    isEnumerationTyCon TyCon
    tc = forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          | Bool
    otherwise             = SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    addErrTc (TcType -> SDoc -> SDoc
    mk_error TcType
    ty' SDoc
    doc2)

        doc1 :: SDoc
    doc1 = [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "Specify the type by giving a type signature"
                   , String -> SDoc
    text String
    "e.g. (tagToEnum# x) :: Bool" ]
        doc2 :: SDoc
    doc2 = String -> SDoc
    text String
    "Result type must be an enumeration type"

        mk_error :: TcType -> SDoc -> SDoc
        mk_error :: TcType -> SDoc -> SDoc
    mk_error TcType
    ty SDoc
    what
          = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Bad call to tagToEnum#"
                   SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "at type" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr TcType
    ty)
               Int
    2 SDoc
    what

    {- *********************************************************************
    *                                                                      *
                 Pragmas on expressions
    *                                                                      *
    ********************************************************************* -}

    tcExprPrag :: HsPragE GhcRn -> HsPragE GhcTc
    tcExprPrag :: HsPragE GhcRn -> HsPragE GhcTc
    tcExprPrag (HsPragSCC XSCC GhcRn
    x1 SourceText
    src StringLiteral
    ann) = forall p. XSCC p -> SourceText -> StringLiteral -> HsPragE p
    HsPragSCC XSCC GhcRn
    x1 SourceText
    src StringLiteral
    ann