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

    -}

    {-# LANGUAGE RankNTypes, TupleSections #-}
    {-# LANGUAGE TypeFamilies #-}

    {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}

    -- | Typecheck arrow notation
    module GHC.Tc.Gen.Arrow ( tcProc ) where

    import GHC.Prelude

    import {-# SOURCE #-}   GHC.Tc.Gen.Expr( tcCheckMonoExpr, tcInferRho, tcSyntaxOp
                                           , tcCheckId, tcCheckPolyExpr )

    import GHC.Hs
    import GHC.Tc.Gen.Match
    import GHC.Tc.Utils.Zonk( hsLPatType )
    import GHC.Tc.Utils.TcType
    import GHC.Tc.Utils.TcMType
    import GHC.Tc.Gen.Bind
    import GHC.Tc.Gen.Pat
    import GHC.Tc.Utils.Unify
    import GHC.Tc.Utils.Monad
    import GHC.Tc.Utils.Env
    import GHC.Tc.Types.Origin
    import GHC.Tc.Types.Evidence
    import GHC.Core.Multiplicity
    import GHC.Types.Id( mkLocalId )
    import GHC.Tc.Utils.Instantiate
    import GHC.Builtin.Types
    import GHC.Types.Var.Set
    import GHC.Builtin.Types.Prim
    import GHC.Types.Basic( Arity )
    import GHC.Types.SrcLoc
    import GHC.Utils.Outputable
    import GHC.Utils.Misc

    import Control.Monad

    {-
    Note [Arrow overview]
    ~~~~~~~~~~~~~~~~~~~~~
    Here's a summary of arrows and how they typecheck.  First, here's
    a cut-down syntax:

      expr ::= ....
            |  proc pat cmd

      cmd ::= cmd exp                    -- Arrow application
           |  \pat -> cmd                -- Arrow abstraction
           |  (| exp cmd1 ... cmdn |)    -- Arrow form, n>=0
           |  ... -- If, case in the usual way

      cmd_type ::= carg_type --> type

      carg_type ::= ()
                 |  (type, carg_type)

    Note that
     * The 'exp' in an arrow form can mention only
       "arrow-local" variables

     * An "arrow-local" variable is bound by an enclosing
       cmd binding form (eg arrow abstraction)

     * A cmd_type is here written with a funny arrow "-->",
       The bit on the left is a carg_type (command argument type)
       which itself is a nested tuple, finishing with ()

     * The arrow-tail operator (e1 -< e2) means
           (| e1 <<< arr snd |) e2

    ************************************************************************
    *                                                                      *
                    Proc
    *                                                                      *
    ************************************************************************
    -}

    tcProc :: LPat GhcRn -> LHsCmdTop GhcRn         -- proc pat -> expr
           -> ExpRhoType                            -- Expected type of whole proc expression
           -> TcM (LPat GhcTc, LHsCmdTop GhcTc, TcCoercion)

    tcProc :: LPat GhcRn
    -> LHsCmdTop GhcRn
    -> ExpRhoType
    -> TcM (LPat GhcTc, LHsCmdTop GhcTc, TcCoercion)
    tcProc LPat GhcRn
    pat LHsCmdTop GhcRn
    cmd ExpRhoType
    exp_ty
      = TcM (Located (Pat GhcTc), LHsCmdTop GhcTc, TcCoercion)
    -> TcM (Located (Pat GhcTc), LHsCmdTop GhcTc, TcCoercion)
    forall a. TcM a -> TcM a
    newArrowScope (TcM (Located (Pat GhcTc), LHsCmdTop GhcTc, TcCoercion)
     -> TcM (Located (Pat GhcTc), LHsCmdTop GhcTc, TcCoercion))
    -> TcM (Located (Pat GhcTc), LHsCmdTop GhcTc, TcCoercion)
    -> TcM (Located (Pat GhcTc), LHsCmdTop GhcTc, TcCoercion)
    forall a b. (a -> b) -> a -> b
    $
        do  { TcType
    exp_ty <- ExpRhoType -> TcM TcType
    expTypeToType ExpRhoType
    exp_ty  -- no higher-rank stuff with arrows
            ; (TcCoercion
    co, (TcType
    exp_ty1, TcType
    res_ty)) <- TcType -> TcM (TcCoercion, (TcType, TcType))
    matchExpectedAppTy TcType
    exp_ty
            ; (TcCoercion
    co1, (TcType
    arr_ty, TcType
    arg_ty)) <- TcType -> TcM (TcCoercion, (TcType, TcType))
    matchExpectedAppTy TcType
    exp_ty1
            ; let cmd_env :: CmdEnv
    cmd_env = CmdEnv :: TcType -> CmdEnv
    CmdEnv { cmd_arr :: TcType
    cmd_arr = TcType
    arr_ty }
            ; (Located (Pat GhcTc)
    pat', LHsCmdTop GhcTc
    cmd') <- HsMatchContext GhcRn
    -> LPat GhcRn
    -> Scaled TcType
    -> TcM (LHsCmdTop GhcTc)
    -> TcM (LPat GhcTc, LHsCmdTop GhcTc)
    forall a.
    HsMatchContext GhcRn
    -> LPat GhcRn -> Scaled TcType -> TcM a -> TcM (LPat GhcTc, a)
    tcCheckPat HsMatchContext GhcRn
    forall p. HsMatchContext p
    ProcExpr LPat GhcRn
    pat (TcType -> Scaled TcType
    forall a. a -> Scaled a
    unrestricted TcType
    arg_ty) (TcM (LHsCmdTop GhcTc) -> TcM (LPat GhcTc, LHsCmdTop GhcTc))
    -> TcM (LHsCmdTop GhcTc) -> TcM (LPat GhcTc, LHsCmdTop GhcTc)
    forall a b. (a -> b) -> a -> b
    $
                              CmdEnv
    -> LHsCmdTop GhcRn -> (TcType, TcType) -> TcM (LHsCmdTop GhcTc)
    tcCmdTop CmdEnv
    cmd_env LHsCmdTop GhcRn
    cmd (TcType
    unitTy, TcType
    res_ty)
            ; let res_co :: TcCoercion
    res_co = TcCoercion -> TcCoercion -> TcCoercion
    mkTcTransCo TcCoercion
    co
                             (TcCoercion -> TcCoercion -> TcCoercion
    mkTcAppCo TcCoercion
    co1 (TcType -> TcCoercion
    mkTcNomReflCo TcType
    res_ty))
            ; (Located (Pat GhcTc), LHsCmdTop GhcTc, TcCoercion)
    -> TcM (Located (Pat GhcTc), LHsCmdTop GhcTc, TcCoercion)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Located (Pat GhcTc)
    pat', LHsCmdTop GhcTc
    cmd', TcCoercion
    res_co) }

    {-
    ************************************************************************
    *                                                                      *
                    Commands
    *                                                                      *
    ************************************************************************
    -}

    -- See Note [Arrow overview]
    type CmdType    = (CmdArgType, TcTauType)    -- cmd_type
    type CmdArgType = TcTauType                  -- carg_type, a nested tuple

    data CmdEnv
      = CmdEnv {
            CmdEnv -> TcType
    cmd_arr :: TcType -- arrow type constructor, of kind *->*->*
        }

    mkCmdArrTy :: CmdEnv -> TcTauType -> TcTauType -> TcTauType
    mkCmdArrTy :: CmdEnv -> TcType -> TcType -> TcType
    mkCmdArrTy CmdEnv
    env TcType
    t1 TcType
    t2 = TcType -> [TcType] -> TcType
    mkAppTys (CmdEnv -> TcType
    cmd_arr CmdEnv
    env) [TcType
    t1, TcType
    t2]

    ---------------------------------------
    tcCmdTop :: CmdEnv
             -> LHsCmdTop GhcRn
             -> CmdType
             -> TcM (LHsCmdTop GhcTc)

    tcCmdTop :: CmdEnv
    -> LHsCmdTop GhcRn -> (TcType, TcType) -> TcM (LHsCmdTop GhcTc)
    tcCmdTop CmdEnv
    env (L SrcSpan
    loc (HsCmdTop XCmdTop GhcRn
    names LHsCmd GhcRn
    cmd)) cmd_ty :: (TcType, TcType)
    cmd_ty@(TcType
    cmd_stk, TcType
    res_ty)
      = SrcSpan -> TcM (LHsCmdTop GhcTc) -> TcM (LHsCmdTop GhcTc)
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc (TcM (LHsCmdTop GhcTc) -> TcM (LHsCmdTop GhcTc))
    -> TcM (LHsCmdTop GhcTc) -> TcM (LHsCmdTop GhcTc)
    forall a b. (a -> b) -> a -> b
    $
        do  { LHsCmd GhcTc
    cmd'   <- CmdEnv -> LHsCmd GhcRn -> (TcType, TcType) -> TcM (LHsCmd GhcTc)
    tcCmd CmdEnv
    env LHsCmd GhcRn
    cmd (TcType, TcType)
    cmd_ty
            ; [(Name, HsExpr GhcTc)]
    names' <- ((Name, HsExpr GhcRn)
     -> IOEnv (Env TcGblEnv TcLclEnv) (Name, HsExpr GhcTc))
    -> [(Name, HsExpr GhcRn)]
    -> IOEnv (Env TcGblEnv TcLclEnv) [(Name, HsExpr GhcTc)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (CtOrigin
    -> TcType
    -> (Name, HsExpr GhcRn)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Name, HsExpr GhcTc)
    tcSyntaxName CtOrigin
    ProcOrigin (CmdEnv -> TcType
    cmd_arr CmdEnv
    env)) [(Name, HsExpr GhcRn)]
    XCmdTop GhcRn
    names
            ; LHsCmdTop GhcTc -> TcM (LHsCmdTop GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpan -> HsCmdTop GhcTc -> LHsCmdTop GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (HsCmdTop GhcTc -> LHsCmdTop GhcTc)
    -> HsCmdTop GhcTc -> LHsCmdTop GhcTc
    forall a b. (a -> b) -> a -> b
    $ XCmdTop GhcTc -> LHsCmd GhcTc -> HsCmdTop GhcTc
    forall p. XCmdTop p -> LHsCmd p -> HsCmdTop p
    HsCmdTop (TcType -> TcType -> [(Name, HsExpr GhcTc)] -> CmdTopTc
    CmdTopTc TcType
    cmd_stk TcType
    res_ty [(Name, HsExpr GhcTc)]
    names') LHsCmd GhcTc
    cmd') }

    ----------------------------------------
    tcCmd  :: CmdEnv -> LHsCmd GhcRn -> CmdType -> TcM (LHsCmd GhcTc)
            -- The main recursive function
    tcCmd :: CmdEnv -> LHsCmd GhcRn -> (TcType, TcType) -> TcM (LHsCmd GhcTc)
    tcCmd CmdEnv
    env (L SrcSpan
    loc HsCmd GhcRn
    cmd) (TcType, TcType)
    res_ty
      = SrcSpan -> TcM (LHsCmd GhcTc) -> TcM (LHsCmd GhcTc)
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc (TcM (LHsCmd GhcTc) -> TcM (LHsCmd GhcTc))
    -> TcM (LHsCmd GhcTc) -> TcM (LHsCmd GhcTc)
    forall a b. (a -> b) -> a -> b
    $ do
            { HsCmd GhcTc
    cmd' <- CmdEnv -> HsCmd GhcRn -> (TcType, TcType) -> TcM (HsCmd GhcTc)
    tc_cmd CmdEnv
    env HsCmd GhcRn
    cmd (TcType, TcType)
    res_ty
            ; LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpan -> HsCmd GhcTc -> LHsCmd GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc HsCmd GhcTc
    cmd') }

    tc_cmd :: CmdEnv -> HsCmd GhcRn  -> CmdType -> TcM (HsCmd GhcTc)
    tc_cmd :: CmdEnv -> HsCmd GhcRn -> (TcType, TcType) -> TcM (HsCmd GhcTc)
    tc_cmd CmdEnv
    env (HsCmdPar XCmdPar GhcRn
    x LHsCmd GhcRn
    cmd) (TcType, TcType)
    res_ty
      = do  { LHsCmd GhcTc
    cmd' <- CmdEnv -> LHsCmd GhcRn -> (TcType, TcType) -> TcM (LHsCmd GhcTc)
    tcCmd CmdEnv
    env LHsCmd GhcRn
    cmd (TcType, TcType)
    res_ty
            ; HsCmd GhcTc -> TcM (HsCmd GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XCmdPar GhcTc -> LHsCmd GhcTc -> HsCmd GhcTc
    forall id. XCmdPar id -> LHsCmd id -> HsCmd id
    HsCmdPar XCmdPar GhcRn
    XCmdPar GhcTc
    x LHsCmd GhcTc
    cmd') }

    tc_cmd CmdEnv
    env (HsCmdLet XCmdLet GhcRn
    x (L SrcSpan
    l HsLocalBinds GhcRn
    binds) (L SrcSpan
    body_loc HsCmd GhcRn
    body)) (TcType, TcType)
    res_ty
      = do  { (HsLocalBinds GhcTc
    binds', HsCmd GhcTc
    body') <- HsLocalBinds GhcRn
    -> TcM (HsCmd GhcTc) -> TcM (HsLocalBinds GhcTc, HsCmd GhcTc)
    forall thing.
    HsLocalBinds GhcRn -> TcM thing -> TcM (HsLocalBinds GhcTc, thing)
    tcLocalBinds HsLocalBinds GhcRn
    binds         (TcM (HsCmd GhcTc) -> TcM (HsLocalBinds GhcTc, HsCmd GhcTc))
    -> TcM (HsCmd GhcTc) -> TcM (HsLocalBinds GhcTc, HsCmd GhcTc)
    forall a b. (a -> b) -> a -> b
    $
                                 SrcSpan -> TcM (HsCmd GhcTc) -> TcM (HsCmd GhcTc)
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    body_loc        (TcM (HsCmd GhcTc) -> TcM (HsCmd GhcTc))
    -> TcM (HsCmd GhcTc) -> TcM (HsCmd GhcTc)
    forall a b. (a -> b) -> a -> b
    $
                                 CmdEnv -> HsCmd GhcRn -> (TcType, TcType) -> TcM (HsCmd GhcTc)
    tc_cmd CmdEnv
    env HsCmd GhcRn
    body (TcType, TcType)
    res_ty
            ; HsCmd GhcTc -> TcM (HsCmd GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XCmdLet GhcTc -> LHsLocalBinds GhcTc -> LHsCmd GhcTc -> HsCmd GhcTc
    forall id. XCmdLet id -> LHsLocalBinds id -> LHsCmd id -> HsCmd id
    HsCmdLet XCmdLet GhcRn
    XCmdLet GhcTc
    x (SrcSpan -> HsLocalBinds GhcTc -> LHsLocalBinds GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l HsLocalBinds GhcTc
    binds') (SrcSpan -> HsCmd GhcTc -> LHsCmd GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    body_loc HsCmd GhcTc
    body')) }

    tc_cmd CmdEnv
    env in_cmd :: HsCmd GhcRn
    in_cmd@(HsCmdCase XCmdCase GhcRn
    x LHsExpr GhcRn
    scrut MatchGroup GhcRn (LHsCmd GhcRn)
    matches) (TcType
    stk, TcType
    res_ty)
      = MsgDoc -> TcM (HsCmd GhcTc) -> TcM (HsCmd GhcTc)
    forall a. MsgDoc -> TcM a -> TcM a
    addErrCtxt (HsCmd GhcRn -> MsgDoc
    cmdCtxt HsCmd GhcRn
    in_cmd) (TcM (HsCmd GhcTc) -> TcM (HsCmd GhcTc))
    -> TcM (HsCmd GhcTc) -> TcM (HsCmd GhcTc)
    forall a b. (a -> b) -> a -> b
    $ do
          (LHsExpr GhcTc
    scrut', TcType
    scrut_ty) <- LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcType)
    tcInferRho LHsExpr GhcRn
    scrut
          MatchGroup GhcTc (LHsCmd GhcTc)
    matches' <- CmdEnv
    -> TcType
    -> MatchGroup GhcRn (LHsCmd GhcRn)
    -> (TcType, TcType)
    -> TcM (MatchGroup GhcTc (LHsCmd GhcTc))
    tcCmdMatches CmdEnv
    env TcType
    scrut_ty MatchGroup GhcRn (LHsCmd GhcRn)
    matches (TcType
    stk, TcType
    res_ty)
          HsCmd GhcTc -> TcM (HsCmd GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XCmdCase GhcTc
    -> LHsExpr GhcTc -> MatchGroup GhcTc (LHsCmd GhcTc) -> HsCmd GhcTc
    forall id.
    XCmdCase id -> LHsExpr id -> MatchGroup id (LHsCmd id) -> HsCmd id
    HsCmdCase XCmdCase GhcRn
    XCmdCase GhcTc
    x LHsExpr GhcTc
    scrut' MatchGroup GhcTc (LHsCmd GhcTc)
    matches')

    tc_cmd CmdEnv
    env in_cmd :: HsCmd GhcRn
    in_cmd@(HsCmdLamCase XCmdLamCase GhcRn
    x MatchGroup GhcRn (LHsCmd GhcRn)
    matches) (TcType
    stk, TcType
    res_ty)
      = MsgDoc -> TcM (HsCmd GhcTc) -> TcM (HsCmd GhcTc)
    forall a. MsgDoc -> TcM a -> TcM a
    addErrCtxt (HsCmd GhcRn -> MsgDoc
    cmdCtxt HsCmd GhcRn
    in_cmd) (TcM (HsCmd GhcTc) -> TcM (HsCmd GhcTc))
    -> TcM (HsCmd GhcTc) -> TcM (HsCmd GhcTc)
    forall a b. (a -> b) -> a -> b
    $ do
          (TcCoercion
    co, [TcType
    scrut_ty], TcType
    stk') <- Arity -> TcType -> TcM (TcCoercion, [TcType], TcType)
    matchExpectedCmdArgs Arity
    1 TcType
    stk
          MatchGroup GhcTc (LHsCmd GhcTc)
    matches' <- CmdEnv
    -> TcType
    -> MatchGroup GhcRn (LHsCmd GhcRn)
    -> (TcType, TcType)
    -> TcM (MatchGroup GhcTc (LHsCmd GhcTc))
    tcCmdMatches CmdEnv
    env TcType
    scrut_ty MatchGroup GhcRn (LHsCmd GhcRn)
    matches (TcType
    stk', TcType
    res_ty)
          HsCmd GhcTc -> TcM (HsCmd GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsWrapper -> HsCmd GhcTc -> HsCmd GhcTc
    mkHsCmdWrap (TcCoercion -> HsWrapper
    mkWpCastN TcCoercion
    co) (XCmdLamCase GhcTc -> MatchGroup GhcTc (LHsCmd GhcTc) -> HsCmd GhcTc
    forall id. XCmdLamCase id -> MatchGroup id (LHsCmd id) -> HsCmd id
    HsCmdLamCase XCmdLamCase GhcRn
    XCmdLamCase GhcTc
    x MatchGroup GhcTc (LHsCmd GhcTc)
    matches'))

    tc_cmd CmdEnv
    env (HsCmdIf XCmdIf GhcRn
    x SyntaxExpr GhcRn
    SyntaxExprRn
    NoSyntaxExprRn LHsExpr GhcRn
    pred LHsCmd GhcRn
    b1 LHsCmd GhcRn
    b2) (TcType, TcType)
    res_ty    -- Ordinary 'if'
      = do  { LHsExpr GhcTc
    pred' <- LHsExpr GhcRn -> TcType -> TcM (LHsExpr GhcTc)
    tcCheckMonoExpr LHsExpr GhcRn
    pred TcType
    boolTy
            ; LHsCmd GhcTc
    b1'   <- CmdEnv -> LHsCmd GhcRn -> (TcType, TcType) -> TcM (LHsCmd GhcTc)
    tcCmd CmdEnv
    env LHsCmd GhcRn
    b1 (TcType, TcType)
    res_ty
            ; LHsCmd GhcTc
    b2'   <- CmdEnv -> LHsCmd GhcRn -> (TcType, TcType) -> TcM (LHsCmd GhcTc)
    tcCmd CmdEnv
    env LHsCmd GhcRn
    b2 (TcType, TcType)
    res_ty
            ; HsCmd GhcTc -> TcM (HsCmd GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XCmdIf GhcTc
    -> SyntaxExpr GhcTc
    -> LHsExpr GhcTc
    -> LHsCmd GhcTc
    -> LHsCmd GhcTc
    -> HsCmd GhcTc
    forall id.
    XCmdIf id
    -> SyntaxExpr id
    -> LHsExpr id
    -> LHsCmd id
    -> LHsCmd id
    -> HsCmd id
    HsCmdIf XCmdIf GhcRn
    XCmdIf GhcTc
    x SyntaxExpr GhcTc
    SyntaxExprTc
    NoSyntaxExprTc LHsExpr GhcTc
    pred' LHsCmd GhcTc
    b1' LHsCmd GhcTc
    b2')
        }

    tc_cmd CmdEnv
    env (HsCmdIf XCmdIf GhcRn
    x fun :: SyntaxExpr GhcRn
    fun@(SyntaxExprRn {}) LHsExpr GhcRn
    pred LHsCmd GhcRn
    b1 LHsCmd GhcRn
    b2) (TcType, TcType)
    res_ty -- Rebindable syntax for if
      = do  { TcType
    pred_ty <- TcM TcType
    newOpenFlexiTyVarTy
            -- For arrows, need ifThenElse :: forall r. T -> r -> r -> r
            -- because we're going to apply it to the environment, not
            -- the return value.
            ; (TCvSubst
    _, [TcTyVar
    r_tv]) <- [TcTyVar] -> TcM (TCvSubst, [TcTyVar])
    tcInstSkolTyVars [TcTyVar
    alphaTyVar]
            ; let r_ty :: TcType
    r_ty = TcTyVar -> TcType
    mkTyVarTy TcTyVar
    r_tv
            ; Bool -> MsgDoc -> TcM ()
    checkTc (Bool -> Bool
    not (TcTyVar
    r_tv TcTyVar -> VarSet -> Bool
    `elemVarSet` TcType -> VarSet
    tyCoVarsOfType TcType
    pred_ty))
                      (String -> MsgDoc
    text String
    "Predicate type of `ifThenElse' depends on result type")
            ; (LHsExpr GhcTc
    pred', SyntaxExprTc
    fun')
                <- CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([TcType] -> [TcType] -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc, SyntaxExprTc)
    forall a.
    CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([TcType] -> [TcType] -> TcM a)
    -> TcM (a, SyntaxExprTc)
    tcSyntaxOp CtOrigin
    IfOrigin SyntaxExpr GhcRn
    SyntaxExprRn
    fun ((TcType -> SyntaxOpType) -> [TcType] -> [SyntaxOpType]
    forall a b. (a -> b) -> [a] -> [b]
    map TcType -> SyntaxOpType
    synKnownType [TcType
    pred_ty, TcType
    r_ty, TcType
    r_ty])
                                           (TcType -> ExpRhoType
    mkCheckExpType TcType
    r_ty) (([TcType] -> [TcType] -> TcM (LHsExpr GhcTc))
     -> TcM (LHsExpr GhcTc, SyntaxExprTc))
    -> ([TcType] -> [TcType] -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc, SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $ \ [TcType]
    _ [TcType]
    _ ->
                   LHsExpr GhcRn -> TcType -> TcM (LHsExpr GhcTc)
    tcCheckMonoExpr LHsExpr GhcRn
    pred TcType
    pred_ty

            ; LHsCmd GhcTc
    b1'   <- CmdEnv -> LHsCmd GhcRn -> (TcType, TcType) -> TcM (LHsCmd GhcTc)
    tcCmd CmdEnv
    env LHsCmd GhcRn
    b1 (TcType, TcType)
    res_ty
            ; LHsCmd GhcTc
    b2'   <- CmdEnv -> LHsCmd GhcRn -> (TcType, TcType) -> TcM (LHsCmd GhcTc)
    tcCmd CmdEnv
    env LHsCmd GhcRn
    b2 (TcType, TcType)
    res_ty
            ; HsCmd GhcTc -> TcM (HsCmd GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XCmdIf GhcTc
    -> SyntaxExpr GhcTc
    -> LHsExpr GhcTc
    -> LHsCmd GhcTc
    -> LHsCmd GhcTc
    -> HsCmd GhcTc
    forall id.
    XCmdIf id
    -> SyntaxExpr id
    -> LHsExpr id
    -> LHsCmd id
    -> LHsCmd id
    -> HsCmd id
    HsCmdIf XCmdIf GhcRn
    XCmdIf GhcTc
    x SyntaxExpr GhcTc
    SyntaxExprTc
    fun' LHsExpr GhcTc
    pred' LHsCmd GhcTc
    b1' LHsCmd GhcTc
    b2')
        }

    -------------------------------------------
    --              Arrow application
    --          (f -< a)   or   (f -<< a)
    --
    --   D   |- fun :: a t1 t2
    --   D,G |- arg :: t1
    --  ------------------------
    --   D;G |-a  fun -< arg :: stk --> t2
    --
    --   D,G |- fun :: a t1 t2
    --   D,G |- arg :: t1
    --  ------------------------
    --   D;G |-a  fun -<< arg :: stk --> t2
    --
    -- (plus -<< requires ArrowApply)

    tc_cmd CmdEnv
    env cmd :: HsCmd GhcRn
    cmd@(HsCmdArrApp XCmdArrApp GhcRn
    _ LHsExpr GhcRn
    fun LHsExpr GhcRn
    arg HsArrAppType
    ho_app Bool
    lr) (TcType
    _, TcType
    res_ty)
      = MsgDoc -> TcM (HsCmd GhcTc) -> TcM (HsCmd GhcTc)
    forall a. MsgDoc -> TcM a -> TcM a
    addErrCtxt (HsCmd GhcRn -> MsgDoc
    cmdCtxt HsCmd GhcRn
    cmd)    (TcM (HsCmd GhcTc) -> TcM (HsCmd GhcTc))
    -> TcM (HsCmd GhcTc) -> TcM (HsCmd GhcTc)
    forall a b. (a -> b) -> a -> b
    $
        do  { TcType
    arg_ty <- TcM TcType
    newOpenFlexiTyVarTy
            ; let fun_ty :: TcType
    fun_ty = CmdEnv -> TcType -> TcType -> TcType
    mkCmdArrTy CmdEnv
    env TcType
    arg_ty TcType
    res_ty
            ; LHsExpr GhcTc
    fun' <- TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    select_arrow_scope (LHsExpr GhcRn -> TcType -> TcM (LHsExpr GhcTc)
    tcCheckMonoExpr LHsExpr GhcRn
    fun TcType
    fun_ty)

            ; LHsExpr GhcTc
    arg' <- LHsExpr GhcRn -> TcType -> TcM (LHsExpr GhcTc)
    tcCheckMonoExpr LHsExpr GhcRn
    arg TcType
    arg_ty

            ; HsCmd GhcTc -> TcM (HsCmd GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XCmdArrApp GhcTc
    -> LHsExpr GhcTc
    -> LHsExpr GhcTc
    -> HsArrAppType
    -> Bool
    -> HsCmd GhcTc
    forall id.
    XCmdArrApp id
    -> LHsExpr id -> LHsExpr id -> HsArrAppType -> Bool -> HsCmd id
    HsCmdArrApp TcType
    XCmdArrApp GhcTc
    fun_ty LHsExpr GhcTc
    fun' LHsExpr GhcTc
    arg' HsArrAppType
    ho_app Bool
    lr) }
      where
           -- Before type-checking f, use the environment of the enclosing
           -- proc for the (-<) case.
           -- Local bindings, inside the enclosing proc, are not in scope
           -- inside f.  In the higher-order case (-<<), they are.
           -- See Note [Escaping the arrow scope] in GHC.Tc.Types
        select_arrow_scope :: TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    select_arrow_scope TcM (LHsExpr GhcTc)
    tc = case HsArrAppType
    ho_app of
            HsArrAppType
    HsHigherOrderApp -> TcM (LHsExpr GhcTc)
    tc
            HsArrAppType
    HsFirstOrderApp  -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. TcM a -> TcM a
    escapeArrowScope TcM (LHsExpr GhcTc)
    tc

    -------------------------------------------
    --              Command application
    --
    -- D,G |-  exp : t
    -- D;G |-a cmd : (t,stk) --> res
    -- -----------------------------
    -- D;G |-a cmd exp : stk --> res

    tc_cmd CmdEnv
    env cmd :: HsCmd GhcRn
    cmd@(HsCmdApp XCmdApp GhcRn
    x LHsCmd GhcRn
    fun LHsExpr GhcRn
    arg) (TcType
    cmd_stk, TcType
    res_ty)
      = MsgDoc -> TcM (HsCmd GhcTc) -> TcM (HsCmd GhcTc)
    forall a. MsgDoc -> TcM a -> TcM a
    addErrCtxt (HsCmd GhcRn -> MsgDoc
    cmdCtxt HsCmd GhcRn
    cmd)    (TcM (HsCmd GhcTc) -> TcM (HsCmd GhcTc))
    -> TcM (HsCmd GhcTc) -> TcM (HsCmd GhcTc)
    forall a b. (a -> b) -> a -> b
    $
        do  { TcType
    arg_ty <- TcM TcType
    newOpenFlexiTyVarTy
            ; LHsCmd GhcTc
    fun'   <- CmdEnv -> LHsCmd GhcRn -> (TcType, TcType) -> TcM (LHsCmd GhcTc)
    tcCmd CmdEnv
    env LHsCmd GhcRn
    fun (TcType -> TcType -> TcType
    mkPairTy TcType
    arg_ty TcType
    cmd_stk, TcType
    res_ty)
            ; LHsExpr GhcTc
    arg'   <- LHsExpr GhcRn -> TcType -> TcM (LHsExpr GhcTc)
    tcCheckMonoExpr LHsExpr GhcRn
    arg TcType
    arg_ty
            ; HsCmd GhcTc -> TcM (HsCmd GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XCmdApp GhcTc -> LHsCmd GhcTc -> LHsExpr GhcTc -> HsCmd GhcTc
    forall id. XCmdApp id -> LHsCmd id -> LHsExpr id -> HsCmd id
    HsCmdApp XCmdApp GhcRn
    XCmdApp GhcTc
    x LHsCmd GhcTc
    fun' LHsExpr GhcTc
    arg') }

    -------------------------------------------
    --              Lambda
    --
    -- D;G,x:t |-a cmd : stk --> res
    -- ------------------------------
    -- D;G |-a (\x.cmd) : (t,stk) --> res

    tc_cmd CmdEnv
    env
           (HsCmdLam XCmdLam GhcRn
    x (MG { mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
    mg_alts = L SrcSpan
    l [L SrcSpan
    mtch_loc
                                       (match :: Match GhcRn (LHsCmd GhcRn)
    match@(Match { m_pats :: forall p body. Match p body -> [LPat p]
    m_pats = [LPat GhcRn]
    pats, m_grhss :: forall p body. Match p body -> GRHSs p body
    m_grhss = GRHSs GhcRn (LHsCmd GhcRn)
    grhss }))],
                             mg_origin :: forall p body. MatchGroup p body -> Origin
    mg_origin = Origin
    origin }))
           (TcType
    cmd_stk, TcType
    res_ty)
      = MsgDoc -> TcM (HsCmd GhcTc) -> TcM (HsCmd GhcTc)
    forall a. MsgDoc -> TcM a -> TcM a
    addErrCtxt (Match GhcRn (LHsCmd GhcRn) -> MsgDoc
    forall (idR :: Pass) body.
    (OutputableBndrId idR, Outputable body) =>
    Match (GhcPass idR) body -> MsgDoc
    pprMatchInCtxt Match GhcRn (LHsCmd GhcRn)
    match)        (TcM (HsCmd GhcTc) -> TcM (HsCmd GhcTc))
    -> TcM (HsCmd GhcTc) -> TcM (HsCmd GhcTc)
    forall a b. (a -> b) -> a -> b
    $
        do  { (TcCoercion
    co, [TcType]
    arg_tys, TcType
    cmd_stk') <- Arity -> TcType -> TcM (TcCoercion, [TcType], TcType)
    matchExpectedCmdArgs Arity
    n_pats TcType
    cmd_stk

                    -- Check the patterns, and the GRHSs inside
            ; ([Located (Pat GhcTc)]
    pats', GRHSs GhcTc (LHsCmd GhcTc)
    grhss') <- SrcSpan
    -> TcRn ([Located (Pat GhcTc)], GRHSs GhcTc (LHsCmd GhcTc))
    -> TcRn ([Located (Pat GhcTc)], GRHSs GhcTc (LHsCmd GhcTc))
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    mtch_loc                                 (TcRn ([Located (Pat GhcTc)], GRHSs GhcTc (LHsCmd GhcTc))
     -> TcRn ([Located (Pat GhcTc)], GRHSs GhcTc (LHsCmd GhcTc)))
    -> TcRn ([Located (Pat GhcTc)], GRHSs GhcTc (LHsCmd GhcTc))
    -> TcRn ([Located (Pat GhcTc)], GRHSs GhcTc (LHsCmd GhcTc))
    forall a b. (a -> b) -> a -> b
    $
                                 HsMatchContext GhcRn
    -> [LPat GhcRn]
    -> [Scaled ExpRhoType]
    -> TcM (GRHSs GhcTc (LHsCmd GhcTc))
    -> TcM ([LPat GhcTc], GRHSs GhcTc (LHsCmd GhcTc))
    forall a.
    HsMatchContext GhcRn
    -> [LPat GhcRn]
    -> [Scaled ExpRhoType]
    -> TcM a
    -> TcM ([LPat GhcTc], a)
    tcPats HsMatchContext GhcRn
    forall p. HsMatchContext p
    LambdaExpr [LPat GhcRn]
    pats ((TcType -> Scaled ExpRhoType) -> [TcType] -> [Scaled ExpRhoType]
    forall a b. (a -> b) -> [a] -> [b]
    map (ExpRhoType -> Scaled ExpRhoType
    forall a. a -> Scaled a
    unrestricted (ExpRhoType -> Scaled ExpRhoType)
    -> (TcType -> ExpRhoType) -> TcType -> Scaled ExpRhoType
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TcType -> ExpRhoType
    mkCheckExpType) [TcType]
    arg_tys) (TcM (GRHSs GhcTc (LHsCmd GhcTc))
     -> TcM ([LPat GhcTc], GRHSs GhcTc (LHsCmd GhcTc)))
    -> TcM (GRHSs GhcTc (LHsCmd GhcTc))
    -> TcM ([LPat GhcTc], GRHSs GhcTc (LHsCmd GhcTc))
    forall a b. (a -> b) -> a -> b
    $
                                 GRHSs GhcRn (LHsCmd GhcRn)
    -> TcType -> ExpRhoType -> TcM (GRHSs GhcTc (LHsCmd GhcTc))
    tc_grhss GRHSs GhcRn (LHsCmd GhcRn)
    grhss TcType
    cmd_stk' (TcType -> ExpRhoType
    mkCheckExpType TcType
    res_ty)

            ; let match' :: GenLocated SrcSpan (Match GhcTc (LHsCmd GhcTc))
    match' = SrcSpan
    -> Match GhcTc (LHsCmd GhcTc)
    -> GenLocated SrcSpan (Match GhcTc (LHsCmd GhcTc))
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    mtch_loc (Match :: forall p body.
    XCMatch p body
    -> HsMatchContext (NoGhcTc p)
    -> [LPat p]
    -> GRHSs p body
    -> Match p body
    Match { m_ext :: XCMatch GhcTc (LHsCmd GhcTc)
    m_ext = NoExtField
    XCMatch GhcTc (LHsCmd GhcTc)
    noExtField
                                             , m_ctxt :: HsMatchContext (NoGhcTc GhcTc)
    m_ctxt = HsMatchContext (NoGhcTc GhcTc)
    forall p. HsMatchContext p
    LambdaExpr, m_pats :: [LPat GhcTc]
    m_pats = [Located (Pat GhcTc)]
    [LPat GhcTc]
    pats'
                                             , m_grhss :: GRHSs GhcTc (LHsCmd GhcTc)
    m_grhss = GRHSs GhcTc (LHsCmd GhcTc)
    grhss' })
                  arg_tys :: [Scaled TcType]
    arg_tys = (Located (Pat GhcTc) -> Scaled TcType)
    -> [Located (Pat GhcTc)] -> [Scaled TcType]
    forall a b. (a -> b) -> [a] -> [b]
    map (TcType -> Scaled TcType
    forall a. a -> Scaled a
    unrestricted (TcType -> Scaled TcType)
    -> (Located (Pat GhcTc) -> TcType)
    -> Located (Pat GhcTc)
    -> Scaled TcType
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Located (Pat GhcTc) -> TcType
    LPat GhcTc -> TcType
    hsLPatType) [Located (Pat GhcTc)]
    pats'
                  cmd' :: HsCmd GhcTc
    cmd' = XCmdLam GhcTc -> MatchGroup GhcTc (LHsCmd GhcTc) -> HsCmd GhcTc
    forall id. XCmdLam id -> MatchGroup id (LHsCmd id) -> HsCmd id
    HsCmdLam XCmdLam GhcRn
    XCmdLam GhcTc
    x (MG :: forall p body.
    XMG p body
    -> Located [LMatch p body] -> Origin -> MatchGroup p body
    MG { mg_alts :: Located [GenLocated SrcSpan (Match GhcTc (LHsCmd GhcTc))]
    mg_alts = SrcSpan
    -> [GenLocated SrcSpan (Match GhcTc (LHsCmd GhcTc))]
    -> Located [GenLocated SrcSpan (Match GhcTc (LHsCmd GhcTc))]
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l [GenLocated SrcSpan (Match GhcTc (LHsCmd GhcTc))
    match']
                                        , mg_ext :: XMG GhcTc (LHsCmd GhcTc)
    mg_ext = [Scaled TcType] -> TcType -> MatchGroupTc
    MatchGroupTc [Scaled TcType]
    arg_tys TcType
    res_ty
                                        , mg_origin :: Origin
    mg_origin = Origin
    origin })
            ; HsCmd GhcTc -> TcM (HsCmd GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsWrapper -> HsCmd GhcTc -> HsCmd GhcTc
    mkHsCmdWrap (TcCoercion -> HsWrapper
    mkWpCastN TcCoercion
    co) HsCmd GhcTc
    cmd') }
      where
        n_pats :: Arity
    n_pats     = [Located (Pat GhcRn)] -> Arity
    forall (t :: * -> *) a. Foldable t => t a -> Arity
    length [Located (Pat GhcRn)]
    [LPat GhcRn]
    pats
        match_ctxt :: HsMatchContext GhcRn
    match_ctxt = (HsMatchContext GhcRn
    forall p. HsMatchContext p
    LambdaExpr :: HsMatchContext GhcRn)    -- Maybe KappaExpr?
        pg_ctxt :: HsStmtContext GhcRn
    pg_ctxt    = HsMatchContext GhcRn -> HsStmtContext GhcRn
    forall p. HsMatchContext p -> HsStmtContext p
    PatGuard HsMatchContext GhcRn
    match_ctxt

        tc_grhss :: GRHSs GhcRn (LHsCmd GhcRn)
    -> TcType -> ExpRhoType -> TcM (GRHSs GhcTc (LHsCmd GhcTc))
    tc_grhss (GRHSs XCGRHSs GhcRn (LHsCmd GhcRn)
    x [LGRHS GhcRn (LHsCmd GhcRn)]
    grhss (L SrcSpan
    l HsLocalBinds GhcRn
    binds)) TcType
    stk_ty ExpRhoType
    res_ty
            = do { (HsLocalBinds GhcTc
    binds', [Located (GRHS GhcTc (LHsCmd GhcTc))]
    grhss') <- HsLocalBinds GhcRn
    -> TcM [Located (GRHS GhcTc (LHsCmd GhcTc))]
    -> TcM (HsLocalBinds GhcTc, [Located (GRHS GhcTc (LHsCmd GhcTc))])
    forall thing.
    HsLocalBinds GhcRn -> TcM thing -> TcM (HsLocalBinds GhcTc, thing)
    tcLocalBinds HsLocalBinds GhcRn
    binds (TcM [Located (GRHS GhcTc (LHsCmd GhcTc))]
     -> TcM (HsLocalBinds GhcTc, [Located (GRHS GhcTc (LHsCmd GhcTc))]))
    -> TcM [Located (GRHS GhcTc (LHsCmd GhcTc))]
    -> TcM (HsLocalBinds GhcTc, [Located (GRHS GhcTc (LHsCmd GhcTc))])
    forall a b. (a -> b) -> a -> b
    $
                                       (LGRHS GhcRn (LHsCmd GhcRn)
     -> IOEnv
          (Env TcGblEnv TcLclEnv) (Located (GRHS GhcTc (LHsCmd GhcTc))))
    -> [LGRHS GhcRn (LHsCmd GhcRn)]
    -> TcM [Located (GRHS GhcTc (LHsCmd GhcTc))]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((GRHS GhcRn (LHsCmd GhcRn) -> TcM (GRHS GhcTc (LHsCmd GhcTc)))
    -> LGRHS GhcRn (LHsCmd GhcRn)
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (Located (GRHS GhcTc (LHsCmd GhcTc)))
    forall a b. (a -> TcM b) -> Located a -> TcM (Located b)
    wrapLocM (TcType
    -> ExpRhoType
    -> GRHS GhcRn (LHsCmd GhcRn)
    -> TcM (GRHS GhcTc (LHsCmd GhcTc))
    tc_grhs TcType
    stk_ty ExpRhoType
    res_ty)) [LGRHS GhcRn (LHsCmd GhcRn)]
    grhss
                 ; GRHSs GhcTc (LHsCmd GhcTc) -> TcM (GRHSs GhcTc (LHsCmd GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XCGRHSs GhcTc (LHsCmd GhcTc)
    -> [Located (GRHS GhcTc (LHsCmd GhcTc))]
    -> LHsLocalBinds GhcTc
    -> GRHSs GhcTc (LHsCmd GhcTc)
    forall p body.
    XCGRHSs p body -> [LGRHS p body] -> LHsLocalBinds p -> GRHSs p body
    GRHSs XCGRHSs GhcRn (LHsCmd GhcRn)
    XCGRHSs GhcTc (LHsCmd GhcTc)
    x [Located (GRHS GhcTc (LHsCmd GhcTc))]
    grhss' (SrcSpan -> HsLocalBinds GhcTc -> LHsLocalBinds GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l HsLocalBinds GhcTc
    binds')) }

        tc_grhs :: TcType
    -> ExpRhoType
    -> GRHS GhcRn (LHsCmd GhcRn)
    -> TcM (GRHS GhcTc (LHsCmd GhcTc))
    tc_grhs TcType
    stk_ty ExpRhoType
    res_ty (GRHS XCGRHS GhcRn (LHsCmd GhcRn)
    x [GuardLStmt GhcRn]
    guards LHsCmd GhcRn
    body)
            = do { ([LStmt GhcTc (LHsExpr GhcTc)]
    guards', LHsCmd GhcTc
    rhs') <- HsStmtContext GhcRn
    -> TcStmtChecker HsExpr ExpRhoType
    -> [GuardLStmt GhcRn]
    -> ExpRhoType
    -> (ExpRhoType -> TcM (LHsCmd GhcTc))
    -> TcM ([LStmt GhcTc (LHsExpr GhcTc)], LHsCmd GhcTc)
    forall (body :: * -> *) rho_type thing.
    Outputable (body GhcRn) =>
    HsStmtContext GhcRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (Located (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    tcStmtsAndThen HsStmtContext GhcRn
    pg_ctxt TcStmtChecker HsExpr ExpRhoType
    tcGuardStmt [GuardLStmt GhcRn]
    guards ExpRhoType
    res_ty ((ExpRhoType -> TcM (LHsCmd GhcTc))
     -> TcM ([LStmt GhcTc (LHsExpr GhcTc)], LHsCmd GhcTc))
    -> (ExpRhoType -> TcM (LHsCmd GhcTc))
    -> TcM ([LStmt GhcTc (LHsExpr GhcTc)], LHsCmd GhcTc)
    forall a b. (a -> b) -> a -> b
    $
                                      \ ExpRhoType
    res_ty -> CmdEnv -> LHsCmd GhcRn -> (TcType, TcType) -> TcM (LHsCmd GhcTc)
    tcCmd CmdEnv
    env LHsCmd GhcRn
    body
                                                    (TcType
    stk_ty, String -> ExpRhoType -> TcType
    checkingExpType String
    "tc_grhs" ExpRhoType
    res_ty)
                 ; GRHS GhcTc (LHsCmd GhcTc) -> TcM (GRHS GhcTc (LHsCmd GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XCGRHS GhcTc (LHsCmd GhcTc)
    -> [LStmt GhcTc (LHsExpr GhcTc)]
    -> LHsCmd GhcTc
    -> GRHS GhcTc (LHsCmd GhcTc)
    forall p body.
    XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
    GRHS XCGRHS GhcRn (LHsCmd GhcRn)
    XCGRHS GhcTc (LHsCmd GhcTc)
    x [LStmt GhcTc (LHsExpr GhcTc)]
    guards' LHsCmd GhcTc
    rhs') }

    -------------------------------------------
    --              Do notation

    tc_cmd CmdEnv
    env (HsCmdDo XCmdDo GhcRn
    _ (L SrcSpan
    l [CmdLStmt GhcRn]
    stmts) ) (TcType
    cmd_stk, TcType
    res_ty)
      = do  { TcCoercion
    co <- Maybe (HsExpr GhcRn) -> TcType -> TcType -> TcM TcCoercion
    unifyType Maybe (HsExpr GhcRn)
    forall a. Maybe a
    Nothing TcType
    unitTy TcType
    cmd_stk  -- Expecting empty argument stack
            ; [LStmt GhcTc (LHsCmd GhcTc)]
    stmts' <- HsStmtContext GhcRn
    -> TcStmtChecker HsCmd TcType
    -> [CmdLStmt GhcRn]
    -> TcType
    -> TcM [LStmt GhcTc (LHsCmd GhcTc)]
    forall (body :: * -> *) rho_type.
    Outputable (body GhcRn) =>
    HsStmtContext GhcRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (Located (body GhcRn))]
    -> rho_type
    -> TcM [LStmt GhcTc (Located (body GhcTc))]
    tcStmts HsStmtContext GhcRn
    forall p. HsStmtContext p
    ArrowExpr (CmdEnv -> TcStmtChecker HsCmd TcType
    tcArrDoStmt CmdEnv
    env) [CmdLStmt GhcRn]
    stmts TcType
    res_ty
            ; HsCmd GhcTc -> TcM (HsCmd GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsWrapper -> HsCmd GhcTc -> HsCmd GhcTc
    mkHsCmdWrap (TcCoercion -> HsWrapper
    mkWpCastN TcCoercion
    co) (XCmdDo GhcTc -> Located [LStmt GhcTc (LHsCmd GhcTc)] -> HsCmd GhcTc
    forall id. XCmdDo id -> Located [CmdLStmt id] -> HsCmd id
    HsCmdDo TcType
    XCmdDo GhcTc
    res_ty (SrcSpan
    -> [LStmt GhcTc (LHsCmd GhcTc)]
    -> Located [LStmt GhcTc (LHsCmd GhcTc)]
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l [LStmt GhcTc (LHsCmd GhcTc)]
    stmts') )) }

    -----------------------------------------------------------------
    --      Arrow ``forms''       (| e c1 .. cn |)
    --
    --      D; G |-a1 c1 : stk1 --> r1
    --      ...
    --      D; G |-an cn : stkn --> rn
    --      D |-  e :: forall e. a1 (e, stk1) t1
    --                                ...
    --                        -> an (e, stkn) tn
    --                        -> a  (e, stk) t
    --      e \not\in (stk, stk1, ..., stkm, t, t1, ..., tn)
    --      ----------------------------------------------
    --      D; G |-a  (| e c1 ... cn |)  :  stk --> t

    tc_cmd CmdEnv
    env cmd :: HsCmd GhcRn
    cmd@(HsCmdArrForm XCmdArrForm GhcRn
    x LHsExpr GhcRn
    expr LexicalFixity
    f Maybe Fixity
    fixity [LHsCmdTop GhcRn]
    cmd_args) (TcType
    cmd_stk, TcType
    res_ty)
      = MsgDoc -> TcM (HsCmd GhcTc) -> TcM (HsCmd GhcTc)
    forall a. MsgDoc -> TcM a -> TcM a
    addErrCtxt (HsCmd GhcRn -> MsgDoc
    cmdCtxt HsCmd GhcRn
    cmd)    (TcM (HsCmd GhcTc) -> TcM (HsCmd GhcTc))
    -> TcM (HsCmd GhcTc) -> TcM (HsCmd GhcTc)
    forall a b. (a -> b) -> a -> b
    $
        do  { ([LHsCmdTop GhcTc]
    cmd_args', [TcType]
    cmd_tys) <- (LHsCmdTop GhcRn
     -> IOEnv (Env TcGblEnv TcLclEnv) (LHsCmdTop GhcTc, TcType))
    -> [LHsCmdTop GhcRn]
    -> IOEnv (Env TcGblEnv TcLclEnv) ([LHsCmdTop GhcTc], [TcType])
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> m (b, c)) -> [a] -> m ([b], [c])
    mapAndUnzipM LHsCmdTop GhcRn
    -> IOEnv (Env TcGblEnv TcLclEnv) (LHsCmdTop GhcTc, TcType)
    tc_cmd_arg [LHsCmdTop GhcRn]
    cmd_args
                                  -- We use alphaTyVar for 'w'
            ; let e_ty :: TcType
    e_ty = TcTyVar -> TcType -> TcType
    mkInfForAllTy TcTyVar
    alphaTyVar (TcType -> TcType) -> TcType -> TcType
    forall a b. (a -> b) -> a -> b
    $
                         [TcType] -> TcType -> TcType
    mkVisFunTysMany [TcType]
    cmd_tys (TcType -> TcType) -> TcType -> TcType
    forall a b. (a -> b) -> a -> b
    $
                         CmdEnv -> TcType -> TcType -> TcType
    mkCmdArrTy CmdEnv
    env (TcType -> TcType -> TcType
    mkPairTy TcType
    alphaTy TcType
    cmd_stk) TcType
    res_ty
            ; LHsExpr GhcTc
    expr' <- LHsExpr GhcRn -> TcType -> TcM (LHsExpr GhcTc)
    tcCheckPolyExpr LHsExpr GhcRn
    expr TcType
    e_ty
            ; HsCmd GhcTc -> TcM (HsCmd GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XCmdArrForm GhcTc
    -> LHsExpr GhcTc
    -> LexicalFixity
    -> Maybe Fixity
    -> [LHsCmdTop GhcTc]
    -> HsCmd GhcTc
    forall id.
    XCmdArrForm id
    -> LHsExpr id
    -> LexicalFixity
    -> Maybe Fixity
    -> [LHsCmdTop id]
    -> HsCmd id
    HsCmdArrForm XCmdArrForm GhcRn
    XCmdArrForm GhcTc
    x LHsExpr GhcTc
    expr' LexicalFixity
    f Maybe Fixity
    fixity [LHsCmdTop GhcTc]
    cmd_args') }

      where
        tc_cmd_arg :: LHsCmdTop GhcRn -> TcM (LHsCmdTop GhcTc, TcType)
        tc_cmd_arg :: LHsCmdTop GhcRn
    -> IOEnv (Env TcGblEnv TcLclEnv) (LHsCmdTop GhcTc, TcType)
    tc_cmd_arg LHsCmdTop GhcRn
    cmd
           = do { TcType
    arr_ty <- TcType -> TcM TcType
    newFlexiTyVarTy TcType
    arrowTyConKind
                ; TcType
    stk_ty <- TcType -> TcM TcType
    newFlexiTyVarTy TcType
    liftedTypeKind
                ; TcType
    res_ty <- TcType -> TcM TcType
    newFlexiTyVarTy TcType
    liftedTypeKind
                ; let env' :: CmdEnv
    env' = CmdEnv
    env { cmd_arr :: TcType
    cmd_arr = TcType
    arr_ty }
                ; LHsCmdTop GhcTc
    cmd' <- CmdEnv
    -> LHsCmdTop GhcRn -> (TcType, TcType) -> TcM (LHsCmdTop GhcTc)
    tcCmdTop CmdEnv
    env' LHsCmdTop GhcRn
    cmd (TcType
    stk_ty, TcType
    res_ty)
                ; (LHsCmdTop GhcTc, TcType)
    -> IOEnv (Env TcGblEnv TcLclEnv) (LHsCmdTop GhcTc, TcType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsCmdTop GhcTc
    cmd',  CmdEnv -> TcType -> TcType -> TcType
    mkCmdArrTy CmdEnv
    env' (TcType -> TcType -> TcType
    mkPairTy TcType
    alphaTy TcType
    stk_ty) TcType
    res_ty) }

    -----------------------------------------------------------------
    --              Base case for illegal commands
    -- This is where expressions that aren't commands get rejected

    tc_cmd CmdEnv
    _ HsCmd GhcRn
    cmd (TcType, TcType)
    _
      = MsgDoc -> TcM (HsCmd GhcTc)
    forall a. MsgDoc -> TcM a
    failWithTc ([MsgDoc] -> MsgDoc
    vcat [String -> MsgDoc
    text String
    "The expression", Arity -> MsgDoc -> MsgDoc
    nest Arity
    2 (HsCmd GhcRn -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr HsCmd GhcRn
    cmd),
                          String -> MsgDoc
    text String
    "was found where an arrow command was expected"])

    -- | Typechecking for case command alternatives. Used for both
    -- 'HsCmdCase' and 'HsCmdLamCase'.
    tcCmdMatches :: CmdEnv
                 -> TcType                           -- ^ type of the scrutinee
                 -> MatchGroup GhcRn (LHsCmd GhcRn)  -- ^ case alternatives
                 -> CmdType
                 -> TcM (MatchGroup GhcTc (LHsCmd GhcTc))
    tcCmdMatches :: CmdEnv
    -> TcType
    -> MatchGroup GhcRn (LHsCmd GhcRn)
    -> (TcType, TcType)
    -> TcM (MatchGroup GhcTc (LHsCmd GhcTc))
    tcCmdMatches CmdEnv
    env TcType
    scrut_ty MatchGroup GhcRn (LHsCmd GhcRn)
    matches (TcType
    stk, TcType
    res_ty)
      = TcMatchCtxt HsCmd
    -> Scaled TcType
    -> MatchGroup GhcRn (LHsCmd GhcRn)
    -> ExpRhoType
    -> TcM (MatchGroup GhcTc (LHsCmd GhcTc))
    forall (body :: * -> *).
    Outputable (body GhcRn) =>
    TcMatchCtxt body
    -> Scaled TcType
    -> MatchGroup GhcRn (Located (body GhcRn))
    -> ExpRhoType
    -> TcM (MatchGroup GhcTc (Located (body GhcTc)))
    tcMatchesCase TcMatchCtxt HsCmd
    match_ctxt (TcType -> Scaled TcType
    forall a. a -> Scaled a
    unrestricted TcType
    scrut_ty) MatchGroup GhcRn (LHsCmd GhcRn)
    matches (TcType -> ExpRhoType
    mkCheckExpType TcType
    res_ty)
      where
        match_ctxt :: TcMatchCtxt HsCmd
    match_ctxt = MC :: forall (body :: * -> *).
    HsMatchContext GhcRn
    -> (Located (body GhcRn)
        -> ExpRhoType -> TcM (Located (body GhcTc)))
    -> TcMatchCtxt body
    MC { mc_what :: HsMatchContext GhcRn
    mc_what = HsMatchContext GhcRn
    forall p. HsMatchContext p
    CaseAlt,
                          mc_body :: LHsCmd GhcRn -> ExpRhoType -> TcM (LHsCmd GhcTc)
    mc_body = LHsCmd GhcRn -> ExpRhoType -> TcM (LHsCmd GhcTc)
    mc_body }
        mc_body :: LHsCmd GhcRn -> ExpRhoType -> TcM (LHsCmd GhcTc)
    mc_body LHsCmd GhcRn
    body ExpRhoType
    res_ty' = do { TcType
    res_ty' <- ExpRhoType -> TcM TcType
    expTypeToType ExpRhoType
    res_ty'
                                  ; CmdEnv -> LHsCmd GhcRn -> (TcType, TcType) -> TcM (LHsCmd GhcTc)
    tcCmd CmdEnv
    env LHsCmd GhcRn
    body (TcType
    stk, TcType
    res_ty') }

    matchExpectedCmdArgs :: Arity -> TcType -> TcM (TcCoercionN, [TcType], TcType)
    matchExpectedCmdArgs :: Arity -> TcType -> TcM (TcCoercion, [TcType], TcType)
    matchExpectedCmdArgs Arity
    0 TcType
    ty
      = (TcCoercion, [TcType], TcType)
    -> TcM (TcCoercion, [TcType], TcType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcType -> TcCoercion
    mkTcNomReflCo TcType
    ty, [], TcType
    ty)
    matchExpectedCmdArgs Arity
    n TcType
    ty
      = do { (TcCoercion
    co1, [TcType
    ty1, TcType
    ty2]) <- TyCon -> TcType -> TcM (TcCoercion, [TcType])
    matchExpectedTyConApp TyCon
    pairTyCon TcType
    ty
           ; (TcCoercion
    co2, [TcType]
    tys, TcType
    res_ty) <- Arity -> TcType -> TcM (TcCoercion, [TcType], TcType)
    matchExpectedCmdArgs (Arity
    nArity -> Arity -> Arity
    forall a. Num a => a -> a -> a
    -Arity
    1) TcType
    ty2
           ; (TcCoercion, [TcType], TcType)
    -> TcM (TcCoercion, [TcType], TcType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Role -> TyCon -> [TcCoercion] -> TcCoercion
    mkTcTyConAppCo Role
    Nominal TyCon
    pairTyCon [TcCoercion
    co1, TcCoercion
    co2], TcType
    ty1TcType -> [TcType] -> [TcType]
    forall a. a -> [a] -> [a]
    :[TcType]
    tys, TcType
    res_ty) }

    {-
    ************************************************************************
    *                                                                      *
                    Stmts
    *                                                                      *
    ************************************************************************
    -}

    --------------------------------
    --      Mdo-notation
    -- The distinctive features here are
    --      (a) RecStmts, and
    --      (b) no rebindable syntax

    tcArrDoStmt :: CmdEnv -> TcCmdStmtChecker
    tcArrDoStmt :: CmdEnv -> TcStmtChecker HsCmd TcType
    tcArrDoStmt CmdEnv
    env HsStmtContext GhcRn
    _ (LastStmt XLastStmt GhcRn GhcRn (LHsCmd GhcRn)
    x LHsCmd GhcRn
    rhs Maybe Bool
    noret SyntaxExpr GhcRn
    _) TcType
    res_ty TcType -> TcM thing
    thing_inside
      = do  { LHsCmd GhcTc
    rhs' <- CmdEnv -> LHsCmd GhcRn -> (TcType, TcType) -> TcM (LHsCmd GhcTc)
    tcCmd CmdEnv
    env LHsCmd GhcRn
    rhs (TcType
    unitTy, TcType
    res_ty)
            ; thing
    thing <- TcType -> TcM thing
    thing_inside (String -> TcType
    forall a. String -> a
    panic String
    "tcArrDoStmt")
            ; (Stmt GhcTc (LHsCmd GhcTc), thing)
    -> TcM (Stmt GhcTc (LHsCmd GhcTc), thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XLastStmt GhcTc GhcTc (LHsCmd GhcTc)
    -> LHsCmd GhcTc
    -> Maybe Bool
    -> SyntaxExpr GhcTc
    -> Stmt GhcTc (LHsCmd GhcTc)
    forall idL idR body.
    XLastStmt idL idR body
    -> body -> Maybe Bool -> SyntaxExpr idR -> StmtLR idL idR body
    LastStmt XLastStmt GhcRn GhcRn (LHsCmd GhcRn)
    XLastStmt GhcTc GhcTc (LHsCmd GhcTc)
    x LHsCmd GhcTc
    rhs' Maybe Bool
    noret SyntaxExpr GhcTc
    forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
    noSyntaxExpr, thing
    thing) }

    tcArrDoStmt CmdEnv
    env HsStmtContext GhcRn
    _ (BodyStmt XBodyStmt GhcRn GhcRn (LHsCmd GhcRn)
    _ LHsCmd GhcRn
    rhs SyntaxExpr GhcRn
    _ SyntaxExpr GhcRn
    _) TcType
    res_ty TcType -> TcM thing
    thing_inside
      = do  { (LHsCmd GhcTc
    rhs', TcType
    elt_ty) <- CmdEnv -> LHsCmd GhcRn -> TcM (LHsCmd GhcTc, TcType)
    tc_arr_rhs CmdEnv
    env LHsCmd GhcRn
    rhs
            ; thing
    thing          <- TcType -> TcM thing
    thing_inside TcType
    res_ty
            ; (Stmt GhcTc (LHsCmd GhcTc), thing)
    -> TcM (Stmt GhcTc (LHsCmd GhcTc), thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XBodyStmt GhcTc GhcTc (LHsCmd GhcTc)
    -> LHsCmd GhcTc
    -> SyntaxExpr GhcTc
    -> SyntaxExpr GhcTc
    -> Stmt GhcTc (LHsCmd GhcTc)
    forall idL idR body.
    XBodyStmt idL idR body
    -> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
    BodyStmt TcType
    XBodyStmt GhcTc GhcTc (LHsCmd GhcTc)
    elt_ty LHsCmd GhcTc
    rhs' SyntaxExpr GhcTc
    forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
    noSyntaxExpr SyntaxExpr GhcTc
    forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
    noSyntaxExpr, thing
    thing) }

    tcArrDoStmt CmdEnv
    env HsStmtContext GhcRn
    ctxt (BindStmt XBindStmt GhcRn GhcRn (LHsCmd GhcRn)
    _ LPat GhcRn
    pat LHsCmd GhcRn
    rhs) TcType
    res_ty TcType -> TcM thing
    thing_inside
      = do  { (LHsCmd GhcTc
    rhs', TcType
    pat_ty) <- CmdEnv -> LHsCmd GhcRn -> TcM (LHsCmd GhcTc, TcType)
    tc_arr_rhs CmdEnv
    env LHsCmd GhcRn
    rhs
            ; (Located (Pat GhcTc)
    pat', thing
    thing)  <- HsMatchContext GhcRn
    -> LPat GhcRn
    -> Scaled TcType
    -> TcM thing
    -> TcM (LPat GhcTc, thing)
    forall a.
    HsMatchContext GhcRn
    -> LPat GhcRn -> Scaled TcType -> TcM a -> TcM (LPat GhcTc, a)
    tcCheckPat (HsStmtContext GhcRn -> HsMatchContext GhcRn
    forall p. HsStmtContext p -> HsMatchContext p
    StmtCtxt HsStmtContext GhcRn
    ctxt) LPat GhcRn
    pat (TcType -> Scaled TcType
    forall a. a -> Scaled a
    unrestricted TcType
    pat_ty) (TcM thing -> TcM (LPat GhcTc, thing))
    -> TcM thing -> TcM (LPat GhcTc, thing)
    forall a b. (a -> b) -> a -> b
    $
                                TcType -> TcM thing
    thing_inside TcType
    res_ty
            ; (Stmt GhcTc (LHsCmd GhcTc), thing)
    -> TcM (Stmt GhcTc (LHsCmd GhcTc), thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LPat GhcTc -> LHsCmd GhcTc -> Stmt GhcTc (LHsCmd GhcTc)
    forall (bodyR :: * -> *).
    LPat GhcTc
    -> Located (bodyR GhcTc)
    -> StmtLR GhcTc GhcTc (Located (bodyR GhcTc))
    mkTcBindStmt Located (Pat GhcTc)
    LPat GhcTc
    pat' LHsCmd GhcTc
    rhs', thing
    thing) }

    tcArrDoStmt CmdEnv
    env HsStmtContext GhcRn
    ctxt (RecStmt { recS_stmts :: forall idL idR body. StmtLR idL idR body -> [LStmtLR idL idR body]
    recS_stmts = [CmdLStmt GhcRn]
    stmts, recS_later_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
    recS_later_ids = [IdP GhcRn]
    later_names
                                , recS_rec_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
    recS_rec_ids = [IdP GhcRn]
    rec_names }) TcType
    res_ty TcType -> TcM thing
    thing_inside
      = do  { let tup_names :: [Name]
    tup_names = [Name]
    [IdP GhcRn]
    rec_names [Name] -> [Name] -> [Name]
    forall a. [a] -> [a] -> [a]
    ++ (Name -> Bool) -> [Name] -> [Name]
    forall a. (a -> Bool) -> [a] -> [a]
    filterOut (Name -> [Name] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Name]
    [IdP GhcRn]
    rec_names) [Name]
    [IdP GhcRn]
    later_names
            ; [TcType]
    tup_elt_tys <- Arity -> TcType -> TcM [TcType]
    newFlexiTyVarTys ([Name] -> Arity
    forall (t :: * -> *) a. Foldable t => t a -> Arity
    length [Name]
    tup_names) TcType
    liftedTypeKind
            ; let tup_ids :: [TcTyVar]
    tup_ids = (Name -> TcType -> TcTyVar) -> [Name] -> [TcType] -> [TcTyVar]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\Name
    n TcType
    p -> HasDebugCallStack => Name -> TcType -> TcType -> TcTyVar
    Name -> TcType -> TcType -> TcTyVar
    mkLocalId Name
    n TcType
    Many TcType
    p) [Name]
    tup_names [TcType]
    tup_elt_tys -- Many because it's a recursive definition
            ; [TcTyVar]
    -> TcM (Stmt GhcTc (LHsCmd GhcTc), thing)
    -> TcM (Stmt GhcTc (LHsCmd GhcTc), thing)
    forall a. [TcTyVar] -> TcM a -> TcM a
    tcExtendIdEnv [TcTyVar]
    tup_ids (TcM (Stmt GhcTc (LHsCmd GhcTc), thing)
     -> TcM (Stmt GhcTc (LHsCmd GhcTc), thing))
    -> TcM (Stmt GhcTc (LHsCmd GhcTc), thing)
    -> TcM (Stmt GhcTc (LHsCmd GhcTc), thing)
    forall a b. (a -> b) -> a -> b
    $ do
            { ([LStmt GhcTc (LHsCmd GhcTc)]
    stmts', [HsExpr GhcTc]
    tup_rets)
                    <- HsStmtContext GhcRn
    -> TcStmtChecker HsCmd TcType
    -> [CmdLStmt GhcRn]
    -> TcType
    -> (TcType -> TcM [HsExpr GhcTc])
    -> TcM ([LStmt GhcTc (LHsCmd GhcTc)], [HsExpr GhcTc])
    forall (body :: * -> *) rho_type thing.
    Outputable (body GhcRn) =>
    HsStmtContext GhcRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (Located (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    tcStmtsAndThen HsStmtContext GhcRn
    ctxt (CmdEnv -> TcStmtChecker HsCmd TcType
    tcArrDoStmt CmdEnv
    env) [CmdLStmt GhcRn]
    stmts TcType
    res_ty   ((TcType -> TcM [HsExpr GhcTc])
     -> TcM ([LStmt GhcTc (LHsCmd GhcTc)], [HsExpr GhcTc]))
    -> (TcType -> TcM [HsExpr GhcTc])
    -> TcM ([LStmt GhcTc (LHsCmd GhcTc)], [HsExpr GhcTc])
    forall a b. (a -> b) -> a -> b
    $ \ TcType
    _res_ty' ->
                            -- ToDo: res_ty not really right
                       (Name
     -> ExpRhoType -> IOEnv (Env TcGblEnv TcLclEnv) (HsExpr GhcTc))
    -> [Name] -> [ExpRhoType] -> TcM [HsExpr GhcTc]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM Name -> ExpRhoType -> IOEnv (Env TcGblEnv TcLclEnv) (HsExpr GhcTc)
    tcCheckId [Name]
    tup_names ((TcType -> ExpRhoType) -> [TcType] -> [ExpRhoType]
    forall a b. (a -> b) -> [a] -> [b]
    map TcType -> ExpRhoType
    mkCheckExpType [TcType]
    tup_elt_tys)

            ; thing
    thing <- TcType -> TcM thing
    thing_inside TcType
    res_ty
                    -- NB:  The rec_ids for the recursive things
                    --      already scope over this part. This binding may shadow
                    --      some of them with polymorphic things with the same Name
                    --      (see note [RecStmt] in GHC.Hs.Expr)

            ; let rec_ids :: [TcTyVar]
    rec_ids = [Name] -> [TcTyVar] -> [TcTyVar]
    forall b a. [b] -> [a] -> [a]
    takeList [Name]
    [IdP GhcRn]
    rec_names [TcTyVar]
    tup_ids
            ; [TcTyVar]
    later_ids <- [Name] -> TcM [TcTyVar]
    tcLookupLocalIds [Name]
    [IdP GhcRn]
    later_names

            ; let rec_rets :: [HsExpr GhcTc]
    rec_rets = [Name] -> [HsExpr GhcTc] -> [HsExpr GhcTc]
    forall b a. [b] -> [a] -> [a]
    takeList [Name]
    [IdP GhcRn]
    rec_names [HsExpr GhcTc]
    tup_rets
            ; let ret_table :: [(TcTyVar, HsExpr GhcTc)]
    ret_table = [TcTyVar] -> [HsExpr GhcTc] -> [(TcTyVar, HsExpr GhcTc)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [TcTyVar]
    tup_ids [HsExpr GhcTc]
    tup_rets
            ; let later_rets :: [HsExpr GhcTc]
    later_rets = [HsExpr GhcTc
    r | TcTyVar
    i <- [TcTyVar]
    later_ids, (TcTyVar
    j, HsExpr GhcTc
    r) <- [(TcTyVar, HsExpr GhcTc)]
    ret_table, TcTyVar
    i TcTyVar -> TcTyVar -> Bool
    forall a. Eq a => a -> a -> Bool
    == TcTyVar
    j]

            ; (Stmt GhcTc (LHsCmd GhcTc), thing)
    -> TcM (Stmt GhcTc (LHsCmd GhcTc), thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (StmtLR GhcTc GhcTc Any
    forall bodyR. StmtLR GhcTc GhcTc bodyR
    emptyRecStmtId { recS_stmts :: [LStmt GhcTc (LHsCmd GhcTc)]
    recS_stmts = [LStmt GhcTc (LHsCmd GhcTc)]
    stmts'
                                     , recS_later_ids :: [IdP GhcTc]
    recS_later_ids = [TcTyVar]
    [IdP GhcTc]
    later_ids
                                     , recS_rec_ids :: [IdP GhcTc]
    recS_rec_ids = [TcTyVar]
    [IdP GhcTc]
    rec_ids
                                     , recS_ext :: XRecStmt GhcTc GhcTc (LHsCmd GhcTc)
    recS_ext = RecStmtTc
    unitRecStmtTc
                                         { recS_later_rets :: [HsExpr GhcTc]
    recS_later_rets = [HsExpr GhcTc]
    later_rets
                                         , recS_rec_rets :: [HsExpr GhcTc]
    recS_rec_rets = [HsExpr GhcTc]
    rec_rets
                                         , recS_ret_ty :: TcType
    recS_ret_ty = TcType
    res_ty} }, thing
    thing)
            }}

    tcArrDoStmt CmdEnv
    _ HsStmtContext GhcRn
    _ Stmt GhcRn (LHsCmd GhcRn)
    stmt TcType
    _ TcType -> TcM thing
    _
      = String -> MsgDoc -> TcM (Stmt GhcTc (LHsCmd GhcTc), thing)
    forall a. HasCallStack => String -> MsgDoc -> a
    pprPanic String
    "tcArrDoStmt: unexpected Stmt" (Stmt GhcRn (LHsCmd GhcRn) -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr Stmt GhcRn (LHsCmd GhcRn)
    stmt)

    tc_arr_rhs :: CmdEnv -> LHsCmd GhcRn -> TcM (LHsCmd GhcTc, TcType)
    tc_arr_rhs :: CmdEnv -> LHsCmd GhcRn -> TcM (LHsCmd GhcTc, TcType)
    tc_arr_rhs CmdEnv
    env LHsCmd GhcRn
    rhs = do { TcType
    ty <- TcType -> TcM TcType
    newFlexiTyVarTy TcType
    liftedTypeKind
                            ; LHsCmd GhcTc
    rhs' <- CmdEnv -> LHsCmd GhcRn -> (TcType, TcType) -> TcM (LHsCmd GhcTc)
    tcCmd CmdEnv
    env LHsCmd GhcRn
    rhs (TcType
    unitTy, TcType
    ty)
                            ; (LHsCmd GhcTc, TcType) -> TcM (LHsCmd GhcTc, TcType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsCmd GhcTc
    rhs', TcType
    ty) }

    {-
    ************************************************************************
    *                                                                      *
                    Helpers
    *                                                                      *
    ************************************************************************
    -}

    mkPairTy :: Type -> Type -> Type
    mkPairTy :: TcType -> TcType -> TcType
    mkPairTy TcType
    t1 TcType
    t2 = TyCon -> [TcType] -> TcType
    mkTyConApp TyCon
    pairTyCon [TcType
    t1,TcType
    t2]

    arrowTyConKind :: Kind          --  *->*->*
    arrowTyConKind :: TcType
    arrowTyConKind = [TcType] -> TcType -> TcType
    mkVisFunTysMany [TcType
    liftedTypeKind, TcType
    liftedTypeKind] TcType
    liftedTypeKind

    {-
    ************************************************************************
    *                                                                      *
                    Errors
    *                                                                      *
    ************************************************************************
    -}

    cmdCtxt :: HsCmd GhcRn -> SDoc
    cmdCtxt :: HsCmd GhcRn -> MsgDoc
    cmdCtxt HsCmd GhcRn
    cmd = String -> MsgDoc
    text String
    "In the command:" MsgDoc -> MsgDoc -> MsgDoc
    <+> HsCmd GhcRn -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr HsCmd GhcRn
    cmd