    -- (those who have too heavy dependencies for GHC.Tc.Types.Evidence)
    module GHC.Tc.Types.EvTerm
        ( evDelayedError, evCallStack )
    where

    import GHC.Prelude

    import GHC.Driver.Session

    import GHC.Tc.Types.Evidence

    import GHC.Unit

    import GHC.Builtin.Names
    import GHC.Builtin.Types ( liftedRepTy, unitTy )

    import GHC.Core.Type
    import GHC.Core
    import GHC.Core.Make
    import GHC.Core.Utils

    import GHC.Types.Literal ( Literal(..) )
    import GHC.Types.SrcLoc
    import GHC.Types.Name
    import GHC.Types.TyThing

    import GHC.Data.FastString

    -- Used with Opt_DeferTypeErrors
    -- See Note [Deferring coercion errors to runtime]
    -- in GHC.Tc.Solver
    evDelayedError :: Type -> FastString -> EvTerm
    evDelayedError :: Type -> FastString -> EvTerm
    evDelayedError Type
    ty FastString
    msg
      = EvExpr -> EvTerm
    EvExpr forall a b. (a -> b) -> a -> b
    $
        let fail_expr :: EvExpr
    fail_expr = forall b. Id -> Expr b
    Var Id
    errorId forall b. Expr b -> [Type] -> Expr b
    `mkTyApps` [Type
    liftedRepTy, Type
    unitTy] forall b. Expr b -> [Expr b] -> Expr b
    `mkApps` [EvExpr
    litMsg]
        in EvExpr -> Scaled Type -> Type -> [CoreAlt] -> EvExpr
    mkWildCase EvExpr
    fail_expr (forall a. a -> Scaled a
    unrestricted Type
    unitTy) Type
    ty []
           -- See Note [Incompleteness and linearity] in GHC.HsToCore.Utils
           -- c.f. mkFailExpr in GHC.HsToCore.Utils

      where
        errorId :: Id
    errorId = Id
    tYPE_ERROR_ID
        litMsg :: EvExpr
    litMsg  = forall b. Literal -> Expr b
    Lit (ByteString -> Literal
    LitString (FastString -> ByteString
    bytesFS FastString
    msg))

    -- Dictionary for CallStack implicit parameters
    evCallStack :: (MonadThings m, HasModule m, HasDynFlags m) =>
        EvCallStack -> m EvExpr
    -- See Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence
    evCallStack :: forall (m :: * -> *).
    (MonadThings m, HasModule m, HasDynFlags m) =>
    EvCallStack -> m EvExpr
    evCallStack EvCallStack
    cs = do
      DynFlags
    df            <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
      let platform :: Platform
    platform = DynFlags -> Platform
    targetPlatform DynFlags
    df
      Module
    m             <- forall (m :: * -> *). HasModule m => m Module
    getModule
      DataCon
    srcLocDataCon <- forall (m :: * -> *). MonadThings m => Name -> m DataCon
    lookupDataCon Name
    srcLocDataConName
      let mkSrcLoc :: RealSrcSpan -> m EvExpr
    mkSrcLoc RealSrcSpan
    l = DataCon -> [EvExpr] -> EvExpr
    mkCoreConApps DataCon
    srcLocDataCon forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                   forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    sequence [ forall (m :: * -> *). MonadThings m => FastString -> m EvExpr
    mkStringExprFS (forall u. IsUnitId u => u -> FastString
    unitFS forall a b. (a -> b) -> a -> b
    $ forall unit. GenModule unit -> unit
    moduleUnit Module
    m)
                            , forall (m :: * -> *). MonadThings m => FastString -> m EvExpr
    mkStringExprFS (ModuleName -> FastString
    moduleNameFS forall a b. (a -> b) -> a -> b
    $ forall unit. GenModule unit -> ModuleName
    moduleName Module
    m)
                            , forall (m :: * -> *). MonadThings m => FastString -> m EvExpr
    mkStringExprFS (RealSrcSpan -> FastString
    srcSpanFile RealSrcSpan
    l)
                            , forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ Platform -> Int -> EvExpr
    mkIntExprInt Platform
    platform (RealSrcSpan -> Int
    srcSpanStartLine RealSrcSpan
    l)
                            , forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ Platform -> Int -> EvExpr
    mkIntExprInt Platform
    platform (RealSrcSpan -> Int
    srcSpanStartCol RealSrcSpan
    l)
                            , forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ Platform -> Int -> EvExpr
    mkIntExprInt Platform
    platform (RealSrcSpan -> Int
    srcSpanEndLine RealSrcSpan
    l)
                            , forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ Platform -> Int -> EvExpr
    mkIntExprInt Platform
    platform (RealSrcSpan -> Int
    srcSpanEndCol RealSrcSpan
    l)
                            ]

      EvExpr
    emptyCS <- forall b. Id -> Expr b
    Var forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> forall (m :: * -> *). MonadThings m => Name -> m Id
    lookupId Name
    emptyCallStackName

      Id
    pushCSVar <- forall (m :: * -> *). MonadThings m => Name -> m Id
    lookupId Name
    pushCallStackName
      let pushCS :: EvExpr -> EvExpr -> EvExpr -> EvExpr
    pushCS EvExpr
    name EvExpr
    loc EvExpr
    rest =
            EvExpr -> [EvExpr] -> EvExpr
    mkCoreApps (forall b. Id -> Expr b
    Var Id
    pushCSVar) [[EvExpr] -> EvExpr
    mkCoreTup [EvExpr
    name, EvExpr
    loc], EvExpr
    rest]

      let mkPush :: FastString -> RealSrcSpan -> EvExpr -> m EvExpr
    mkPush FastString
    name RealSrcSpan
    loc EvExpr
    tm = do
            EvExpr
    nameExpr <- forall (m :: * -> *). MonadThings m => FastString -> m EvExpr
    mkStringExprFS FastString
    name
            EvExpr
    locExpr <- RealSrcSpan -> m EvExpr
    mkSrcLoc RealSrcSpan
    loc
            -- at this point tm :: IP sym CallStack
            -- but we need the actual CallStack to pass to pushCS,
            -- so we use unwrapIP to strip the dictionary wrapper
            -- See Note [Overview of implicit CallStacks]
            let ip_co :: CoercionR
    ip_co = Type -> CoercionR
    unwrapIP (EvExpr -> Type
    exprType EvExpr
    tm)
            forall (m :: * -> *) a. Monad m => a -> m a
    return (EvExpr -> EvExpr -> EvExpr -> EvExpr
    pushCS EvExpr
    nameExpr EvExpr
    locExpr (forall b. Expr b -> CoercionR -> Expr b
    Cast EvExpr
    tm CoercionR
    ip_co))

      case EvCallStack
    cs of
        EvCsPushCall Name
    name RealSrcSpan
    loc EvExpr
    tm -> FastString -> RealSrcSpan -> EvExpr -> m EvExpr
    mkPush (OccName -> FastString
    occNameFS forall a b. (a -> b) -> a -> b
    $ forall a. NamedThing a => a -> OccName
    getOccName Name
    name) RealSrcSpan
    loc EvExpr
    tm
        EvCallStack
    EvCsEmpty -> forall (m :: * -> *) a. Monad m => a -> m a
    return EvExpr
    emptyCS