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

    -}

    {-# LANGUAGE CPP #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE TypeApplications #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE ViewPatterns #-}

    -- | Typechecking @foreign@ declarations
    --
    -- A foreign declaration is used to either give an externally
    -- implemented function a Haskell type (and calling interface) or
    -- give a Haskell function an external calling interface. Either way,
    -- the range of argument and result types these functions can accommodate
    -- is restricted to what the outside world understands (read C), and this
    -- module checks to see if a foreign declaration has got a legal type.
    module GHC.Tc.Gen.Foreign
            ( tcForeignImports
            , tcForeignExports

            -- Low-level exports for hooks
            , isForeignImport, isForeignExport
            , tcFImport, tcFExport
            , tcForeignImports'
            , tcCheckFIType, checkCTarget, checkForeignArgs, checkForeignRes
            , normaliseFfiType
            , nonIOok, mustBeIO
            , checkSafe, noCheckSafe
            , tcForeignExports'
            , tcCheckFEType
            ) where

    #include "HsVersions.h"

    import GHC.Prelude

    import GHC.Hs

    import GHC.Tc.Utils.Monad
    import GHC.Tc.Gen.HsType
    import GHC.Tc.Gen.Expr
    import GHC.Tc.Utils.Env

    import GHC.Tc.Instance.Family
    import GHC.Core.FamInstEnv
    import GHC.Core.Coercion
    import GHC.Core.Type
    import GHC.Core.Multiplicity
    import GHC.Types.ForeignCall
    import GHC.Utils.Error
    import GHC.Types.Id
    import GHC.Types.Name
    import GHC.Types.Name.Reader
    import GHC.Core.DataCon
    import GHC.Core.TyCon
    import GHC.Core.TyCon.RecWalk
    import GHC.Tc.Utils.TcType
    import GHC.Builtin.Names
    import GHC.Driver.Session
    import GHC.Driver.Backend
    import GHC.Utils.Outputable as Outputable
    import GHC.Utils.Panic
    import GHC.Platform
    import GHC.Types.SrcLoc
    import GHC.Data.Bag
    import GHC.Driver.Hooks
    import qualified GHC.LanguageExtensions as LangExt

    import Control.Monad

    -- Defines a binding
    isForeignImport :: forall name. UnXRec name => LForeignDecl name -> Bool
    isForeignImport :: forall name. UnXRec name => LForeignDecl name -> Bool
    isForeignImport (forall p a. UnXRec p => XRec p a -> a
    unXRec @name -> ForeignImport {}) = Bool
    True
    isForeignImport LForeignDecl name
    _                        = Bool
    False

    -- Exports a binding
    isForeignExport :: forall name. UnXRec name => LForeignDecl name -> Bool
    isForeignExport :: forall name. UnXRec name => LForeignDecl name -> Bool
    isForeignExport (forall p a. UnXRec p => XRec p a -> a
    unXRec @name -> ForeignExport {}) = Bool
    True
    isForeignExport LForeignDecl name
    _                        = Bool
    False

    {-
    Note [Don't recur in normaliseFfiType']
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    normaliseFfiType' is the workhorse for normalising a type used in a foreign
    declaration. If we have

    newtype Age = MkAge Int

    we want to see that Age -> IO () is the same as Int -> IO (). But, we don't
    need to recur on any type parameters, because no paramaterized types (with
    interesting parameters) are marshalable! The full list of marshalable types
    is in the body of boxedMarshalableTyCon in GHC.Tc.Utils.TcType. The only members of that
    list not at kind * are Ptr, FunPtr, and StablePtr, all of which get marshaled
    the same way regardless of type parameter. So, no need to recur into
    parameters.

    Similarly, we don't need to look in AppTy's, because nothing headed by
    an AppTy will be marshalable.
    -}

    -- normaliseFfiType takes the type from an FFI declaration, and
    -- evaluates any type synonyms, type functions, and newtypes. However,
    -- we are only allowed to look through newtypes if the constructor is
    -- in scope.  We return a bag of all the newtype constructors thus found.
    -- Always returns a Representational coercion
    normaliseFfiType :: Type -> TcM (Coercion, Type, Bag GlobalRdrElt)
    normaliseFfiType :: Type -> TcM (Coercion, Type, Bag GlobalRdrElt)
    normaliseFfiType Type
    ty
        = do FamInstEnvs
    fam_envs <- TcM FamInstEnvs
    tcGetFamInstEnvs
             FamInstEnvs -> Type -> TcM (Coercion, Type, Bag GlobalRdrElt)
    normaliseFfiType' FamInstEnvs
    fam_envs Type
    ty

    normaliseFfiType' :: FamInstEnvs -> Type -> TcM (Coercion, Type, Bag GlobalRdrElt)
    normaliseFfiType' :: FamInstEnvs -> Type -> TcM (Coercion, Type, Bag GlobalRdrElt)
    normaliseFfiType' FamInstEnvs
    env Type
    ty0 = Role
    -> RecTcChecker -> Type -> TcM (Coercion, Type, Bag GlobalRdrElt)
    go Role
    Representational RecTcChecker
    initRecTc Type
    ty0
      where
        go :: Role -> RecTcChecker -> Type -> TcM (Coercion, Type, Bag GlobalRdrElt)
        go :: Role
    -> RecTcChecker -> Type -> TcM (Coercion, Type, Bag GlobalRdrElt)
    go Role
    role RecTcChecker
    rec_nts Type
    ty
          | Just Type
    ty' <- Type -> Maybe Type
    tcView Type
    ty     -- Expand synonyms
          = Role
    -> RecTcChecker -> Type -> TcM (Coercion, Type, Bag GlobalRdrElt)
    go Role
    role RecTcChecker
    rec_nts Type
    ty'

          | Just (TyCon
    tc, [Type]
    tys) <- HasDebugCallStack => Type -> Maybe (TyCon, [Type])
    Type -> Maybe (TyCon, [Type])
    splitTyConApp_maybe Type
    ty
          = Role
    -> RecTcChecker
    -> TyCon
    -> [Type]
    -> TcM (Coercion, Type, Bag GlobalRdrElt)
    go_tc_app Role
    role RecTcChecker
    rec_nts TyCon
    tc [Type]
    tys

          | ([TyCoVarBinder]
    bndrs, Type
    inner_ty) <- Type -> ([TyCoVarBinder], Type)
    splitForAllTyCoVarBinders Type
    ty
          , Bool -> Bool
    not ([TyCoVarBinder] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TyCoVarBinder]
    bndrs)
          = do (Coercion
    coi, Type
    nty1, Bag GlobalRdrElt
    gres1) <- Role
    -> RecTcChecker -> Type -> TcM (Coercion, Type, Bag GlobalRdrElt)
    go Role
    role RecTcChecker
    rec_nts Type
    inner_ty
               (Coercion, Type, Bag GlobalRdrElt)
    -> TcM (Coercion, Type, Bag GlobalRdrElt)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( [TyCoVar] -> Coercion -> Coercion
    mkHomoForAllCos ([TyCoVarBinder] -> [TyCoVar]
    forall tv argf. [VarBndr tv argf] -> [tv]
    binderVars [TyCoVarBinder]
    bndrs) Coercion
    coi
                      , [TyCoVarBinder] -> Type -> Type
    mkForAllTys [TyCoVarBinder]
    bndrs Type
    nty1, Bag GlobalRdrElt
    gres1 )

          | Bool
    otherwise -- see Note [Don't recur in normaliseFfiType']
          = (Coercion, Type, Bag GlobalRdrElt)
    -> TcM (Coercion, Type, Bag GlobalRdrElt)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Role -> Type -> Coercion
    mkReflCo Role
    role Type
    ty, Type
    ty, Bag GlobalRdrElt
    forall a. Bag a
    emptyBag)

        go_tc_app :: Role -> RecTcChecker -> TyCon -> [Type]
                  -> TcM (Coercion, Type, Bag GlobalRdrElt)
        go_tc_app :: Role
    -> RecTcChecker
    -> TyCon
    -> [Type]
    -> TcM (Coercion, Type, Bag GlobalRdrElt)
    go_tc_app Role
    role RecTcChecker
    rec_nts TyCon
    tc [Type]
    tys
            -- We don't want to look through the IO newtype, even if it is
            -- in scope, so we have a special case for it:
            | Unique
    tc_key Unique -> [Unique] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Unique
    ioTyConKey, Unique
    funPtrTyConKey, Unique
    funTyConKey]
            = TcM (Coercion, Type, Bag GlobalRdrElt)
    children_only

            | TyCon -> Bool
    isNewTyCon TyCon
    tc         -- Expand newtypes
            , Just RecTcChecker
    rec_nts' <- RecTcChecker -> TyCon -> Maybe RecTcChecker
    checkRecTc RecTcChecker
    rec_nts TyCon
    tc
                       -- See Note [Expanding newtypes] in GHC.Core.TyCon
                       -- We can't just use isRecursiveTyCon; sometimes recursion is ok:
                       --     newtype T = T (Ptr T)
                       --   Here, we don't reject the type for being recursive.
                       -- If this is a recursive newtype then it will normally
                       -- be rejected later as not being a valid FFI type.
            = do { GlobalRdrEnv
    rdr_env <- TcRn GlobalRdrEnv
    getGlobalRdrEnv
                 ; case GlobalRdrEnv -> TyCon -> Maybe GlobalRdrElt
    checkNewtypeFFI GlobalRdrEnv
    rdr_env TyCon
    tc of
                     Maybe GlobalRdrElt
    Nothing  -> TcM (Coercion, Type, Bag GlobalRdrElt)
    nothing
                     Just GlobalRdrElt
    gre -> do { (Coercion
    co', Type
    ty', Bag GlobalRdrElt
    gres) <- Role
    -> RecTcChecker -> Type -> TcM (Coercion, Type, Bag GlobalRdrElt)
    go Role
    role RecTcChecker
    rec_nts' Type
    nt_rhs
                                    ; (Coercion, Type, Bag GlobalRdrElt)
    -> TcM (Coercion, Type, Bag GlobalRdrElt)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Coercion -> Coercion -> Coercion
    mkTransCo Coercion
    nt_co Coercion
    co', Type
    ty', GlobalRdrElt
    gre GlobalRdrElt -> Bag GlobalRdrElt -> Bag GlobalRdrElt
    forall a. a -> Bag a -> Bag a
    `consBag` Bag GlobalRdrElt
    gres) } }

            | TyCon -> Bool
    isFamilyTyCon TyCon
    tc              -- Expand open tycons
            , (Coercion
    co, Type
    ty) <- FamInstEnvs -> Role -> TyCon -> [Type] -> (Coercion, Type)
    normaliseTcApp FamInstEnvs
    env Role
    role TyCon
    tc [Type]
    tys
            , Bool -> Bool
    not (Coercion -> Bool
    isReflexiveCo Coercion
    co)
            = do (Coercion
    co', Type
    ty', Bag GlobalRdrElt
    gres) <- Role
    -> RecTcChecker -> Type -> TcM (Coercion, Type, Bag GlobalRdrElt)
    go Role
    role RecTcChecker
    rec_nts Type
    ty
                 (Coercion, Type, Bag GlobalRdrElt)
    -> TcM (Coercion, Type, Bag GlobalRdrElt)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Coercion -> Coercion -> Coercion
    mkTransCo Coercion
    co Coercion
    co', Type
    ty', Bag GlobalRdrElt
    gres)

            | Bool
    otherwise
            = TcM (Coercion, Type, Bag GlobalRdrElt)
    nothing -- see Note [Don't recur in normaliseFfiType']
            where
              tc_key :: Unique
    tc_key = TyCon -> Unique
    forall a. Uniquable a => a -> Unique
    getUnique TyCon
    tc
              children_only :: TcM (Coercion, Type, Bag GlobalRdrElt)
    children_only
                = do [(Coercion, Type, Bag GlobalRdrElt)]
    xs <- (Type -> Role -> TcM (Coercion, Type, Bag GlobalRdrElt))
    -> [Type]
    -> [Role]
    -> IOEnv
         (Env TcGblEnv TcLclEnv) [(Coercion, Type, Bag GlobalRdrElt)]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM (\Type
    ty Role
    r -> Role
    -> RecTcChecker -> Type -> TcM (Coercion, Type, Bag GlobalRdrElt)
    go Role
    r RecTcChecker
    rec_nts Type
    ty) [Type]
    tys (Role -> TyCon -> [Role]
    tyConRolesX Role
    role TyCon
    tc)
                     let ([Coercion]
    cos, [Type]
    tys', [Bag GlobalRdrElt]
    gres) = [(Coercion, Type, Bag GlobalRdrElt)]
    -> ([Coercion], [Type], [Bag GlobalRdrElt])
    forall a b c. [(a, b, c)] -> ([a], [b], [c])
    unzip3 [(Coercion, Type, Bag GlobalRdrElt)]
    xs
                     (Coercion, Type, Bag GlobalRdrElt)
    -> TcM (Coercion, Type, Bag GlobalRdrElt)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( HasDebugCallStack => Role -> TyCon -> [Coercion] -> Coercion
    Role -> TyCon -> [Coercion] -> Coercion
    mkTyConAppCo Role
    role TyCon
    tc [Coercion]
    cos
                            , TyCon -> [Type] -> Type
    mkTyConApp TyCon
    tc [Type]
    tys', [Bag GlobalRdrElt] -> Bag GlobalRdrElt
    forall a. [Bag a] -> Bag a
    unionManyBags [Bag GlobalRdrElt]
    gres)
              nt_co :: Coercion
    nt_co  = Role -> CoAxiom Unbranched -> [Type] -> [Coercion] -> Coercion
    mkUnbranchedAxInstCo Role
    role (TyCon -> CoAxiom Unbranched
    newTyConCo TyCon
    tc) [Type]
    tys []
              nt_rhs :: Type
    nt_rhs = TyCon -> [Type] -> Type
    newTyConInstRhs TyCon
    tc [Type]
    tys

              ty :: Type
    ty      = TyCon -> [Type] -> Type
    mkTyConApp TyCon
    tc [Type]
    tys
              nothing :: TcM (Coercion, Type, Bag GlobalRdrElt)
    nothing = (Coercion, Type, Bag GlobalRdrElt)
    -> TcM (Coercion, Type, Bag GlobalRdrElt)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Role -> Type -> Coercion
    mkReflCo Role
    role Type
    ty, Type
    ty, Bag GlobalRdrElt
    forall a. Bag a
    emptyBag)

    checkNewtypeFFI :: GlobalRdrEnv -> TyCon -> Maybe GlobalRdrElt
    checkNewtypeFFI :: GlobalRdrEnv -> TyCon -> Maybe GlobalRdrElt
    checkNewtypeFFI GlobalRdrEnv
    rdr_env TyCon
    tc
      | Just DataCon
    con <- TyCon -> Maybe DataCon
    tyConSingleDataCon_maybe TyCon
    tc
      , Just GlobalRdrElt
    gre <- GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
    lookupGRE_Name GlobalRdrEnv
    rdr_env (DataCon -> Name
    dataConName DataCon
    con)
      = GlobalRdrElt -> Maybe GlobalRdrElt
    forall a. a -> Maybe a
    Just GlobalRdrElt
    gre    -- See Note [Newtype constructor usage in foreign declarations]
      | Bool
    otherwise
      = Maybe GlobalRdrElt
    forall a. Maybe a
    Nothing

    {-
    Note [Newtype constructor usage in foreign declarations]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    GHC automatically "unwraps" newtype constructors in foreign import/export
    declarations.  In effect that means that a newtype data constructor is
    used even though it is not mentioned expclitly in the source, so we don't
    want to report it as "defined but not used" or "imported but not used".
    eg     newtype D = MkD Int
           foreign import foo :: D -> IO ()
    Here 'MkD' us used.  See #7408.

    GHC also expands type functions during this process, so it's not enough
    just to look at the free variables of the declaration.
    eg     type instance F Bool = D
           foreign import bar :: F Bool -> IO ()
    Here again 'MkD' is used.

    So we really have wait until the type checker to decide what is used.
    That's why tcForeignImports and tecForeignExports return a (Bag GRE)
    for the newtype constructors they see. Then GHC.Tc.Module can add them
    to the module's usages.

    ************************************************************************
    *                                                                      *
    \subsection{Imports}
    *                                                                      *
    ************************************************************************
    -}

    tcForeignImports :: [LForeignDecl GhcRn]
                     -> TcM ([Id], [LForeignDecl GhcTc], Bag GlobalRdrElt)
    tcForeignImports :: [LForeignDecl GhcRn]
    -> TcM ([TyCoVar], [LForeignDecl GhcTc], Bag GlobalRdrElt)
    tcForeignImports [LForeignDecl GhcRn]
    decls = do
        Hooks
    hooks <- IOEnv (Env TcGblEnv TcLclEnv) Hooks
    forall (m :: * -> *). HasHooks m => m Hooks
    getHooks
        case Hooks
    -> Maybe
         ([LForeignDecl GhcRn]
          -> TcM ([TyCoVar], [LForeignDecl GhcTc], Bag GlobalRdrElt))
    tcForeignImportsHook Hooks
    hooks of
            Maybe
      ([LForeignDecl GhcRn]
       -> TcM ([TyCoVar], [LForeignDecl GhcTc], Bag GlobalRdrElt))
    Nothing -> [LForeignDecl GhcRn]
    -> TcM ([TyCoVar], [LForeignDecl GhcTc], Bag GlobalRdrElt)
    tcForeignImports' [LForeignDecl GhcRn]
    decls
            Just [LForeignDecl GhcRn]
    -> TcM ([TyCoVar], [LForeignDecl GhcTc], Bag GlobalRdrElt)
    h  -> [LForeignDecl GhcRn]
    -> TcM ([TyCoVar], [LForeignDecl GhcTc], Bag GlobalRdrElt)
    h [LForeignDecl GhcRn]
    decls

    tcForeignImports' :: [LForeignDecl GhcRn]
                      -> TcM ([Id], [LForeignDecl GhcTc], Bag GlobalRdrElt)
    -- For the (Bag GlobalRdrElt) result,
    -- see Note [Newtype constructor usage in foreign declarations]
    tcForeignImports' :: [LForeignDecl GhcRn]
    -> TcM ([TyCoVar], [LForeignDecl GhcTc], Bag GlobalRdrElt)
    tcForeignImports' [LForeignDecl GhcRn]
    decls
      = do { ([TyCoVar]
    ids, [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)]
    decls, [Bag GlobalRdrElt]
    gres) <- (GenLocated SrcSpanAnnA (ForeignDecl GhcRn)
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (TyCoVar, GenLocated SrcSpanAnnA (ForeignDecl GhcTc),
           Bag GlobalRdrElt))
    -> [GenLocated SrcSpanAnnA (ForeignDecl GhcRn)]
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([TyCoVar], [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)],
          [Bag GlobalRdrElt])
    forall (m :: * -> *) a b c d.
    Monad m =>
    (a -> m (b, c, d)) -> [a] -> m ([b], [c], [d])
    mapAndUnzip3M GenLocated SrcSpanAnnA (ForeignDecl GhcRn)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (TyCoVar, GenLocated SrcSpanAnnA (ForeignDecl GhcTc),
          Bag GlobalRdrElt)
    LForeignDecl GhcRn
    -> TcM (TyCoVar, LForeignDecl GhcTc, Bag GlobalRdrElt)
    tcFImport ([GenLocated SrcSpanAnnA (ForeignDecl GhcRn)]
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          ([TyCoVar], [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)],
           [Bag GlobalRdrElt]))
    -> [GenLocated SrcSpanAnnA (ForeignDecl GhcRn)]
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([TyCoVar], [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)],
          [Bag GlobalRdrElt])
    forall a b. (a -> b) -> a -> b
    $
                                   (GenLocated SrcSpanAnnA (ForeignDecl GhcRn) -> Bool)
    -> [GenLocated SrcSpanAnnA (ForeignDecl GhcRn)]
    -> [GenLocated SrcSpanAnnA (ForeignDecl GhcRn)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter GenLocated SrcSpanAnnA (ForeignDecl GhcRn) -> Bool
    forall name. UnXRec name => LForeignDecl name -> Bool
    isForeignImport [GenLocated SrcSpanAnnA (ForeignDecl GhcRn)]
    [LForeignDecl GhcRn]
    decls
           ; ([TyCoVar], [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)],
     Bag GlobalRdrElt)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([TyCoVar], [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)],
          Bag GlobalRdrElt)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([TyCoVar]
    ids, [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)]
    decls, [Bag GlobalRdrElt] -> Bag GlobalRdrElt
    forall a. [Bag a] -> Bag a
    unionManyBags [Bag GlobalRdrElt]
    gres) }

    tcFImport :: LForeignDecl GhcRn
              -> TcM (Id, LForeignDecl GhcTc, Bag GlobalRdrElt)
    tcFImport :: LForeignDecl GhcRn
    -> TcM (TyCoVar, LForeignDecl GhcTc, Bag GlobalRdrElt)
    tcFImport (L SrcSpanAnnA
    dloc fo :: ForeignDecl GhcRn
    fo@(ForeignImport { fd_name :: forall pass. ForeignDecl pass -> LIdP pass
    fd_name = L SrcSpanAnnN
    nloc Name
    nm, fd_sig_ty :: forall pass. ForeignDecl pass -> LHsSigType pass
    fd_sig_ty = LHsSigType GhcRn
    hs_ty
                                        , fd_fi :: forall pass. ForeignDecl pass -> ForeignImport
    fd_fi = ForeignImport
    imp_decl }))
      = SrcSpanAnnA
    -> TcM (TyCoVar, LForeignDecl GhcTc, Bag GlobalRdrElt)
    -> TcM (TyCoVar, LForeignDecl GhcTc, Bag GlobalRdrElt)
    forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    dloc (TcM (TyCoVar, LForeignDecl GhcTc, Bag GlobalRdrElt)
     -> TcM (TyCoVar, LForeignDecl GhcTc, Bag GlobalRdrElt))
    -> TcM (TyCoVar, LForeignDecl GhcTc, Bag GlobalRdrElt)
    -> TcM (TyCoVar, LForeignDecl GhcTc, Bag GlobalRdrElt)
    forall a b. (a -> b) -> a -> b
    $ SDoc
    -> TcM (TyCoVar, LForeignDecl GhcTc, Bag GlobalRdrElt)
    -> TcM (TyCoVar, LForeignDecl GhcTc, Bag GlobalRdrElt)
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (ForeignDecl GhcRn -> SDoc
    foreignDeclCtxt ForeignDecl GhcRn
    fo)  (TcM (TyCoVar, LForeignDecl GhcTc, Bag GlobalRdrElt)
     -> TcM (TyCoVar, LForeignDecl GhcTc, Bag GlobalRdrElt))
    -> TcM (TyCoVar, LForeignDecl GhcTc, Bag GlobalRdrElt)
    -> TcM (TyCoVar, LForeignDecl GhcTc, Bag GlobalRdrElt)
    forall a b. (a -> b) -> a -> b
    $
        do { Type
    sig_ty <- UserTypeCtxt -> LHsSigType GhcRn -> TcM Type
    tcHsSigType (Name -> UserTypeCtxt
    ForSigCtxt Name
    nm) LHsSigType GhcRn
    hs_ty
           ; (Coercion
    norm_co, Type
    norm_sig_ty, Bag GlobalRdrElt
    gres) <- Type -> TcM (Coercion, Type, Bag GlobalRdrElt)
    normaliseFfiType Type
    sig_ty
           ; let
               -- Drop the foralls before inspecting the
               -- structure of the foreign type.
                 ([Scaled Type]
    arg_tys, Type
    res_ty) = Type -> ([Scaled Type], Type)
    tcSplitFunTys (Type -> Type
    dropForAlls Type
    norm_sig_ty)
                 id :: TyCoVar
    id                = HasDebugCallStack => Name -> Type -> Type -> TyCoVar
    Name -> Type -> Type -> TyCoVar
    mkLocalId Name
    nm Type
    Many Type
    sig_ty
                     -- Use a LocalId to obey the invariant that locally-defined
                     -- things are LocalIds.  However, it does not need zonking,
                     -- (so GHC.Tc.Utils.Zonk.zonkForeignExports ignores it).

           ; ForeignImport
    imp_decl' <- [Scaled Type] -> Type -> ForeignImport -> TcM ForeignImport
    tcCheckFIType [Scaled Type]
    arg_tys Type
    res_ty ForeignImport
    imp_decl
              -- Can't use sig_ty here because sig_ty :: Type and
              -- we need HsType Id hence the undefined
           ; let fi_decl :: ForeignDecl GhcTc
    fi_decl = ForeignImport { fd_name :: LIdP GhcTc
    fd_name = SrcSpanAnnN -> TyCoVar -> GenLocated SrcSpanAnnN TyCoVar
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnN
    nloc TyCoVar
    id
                                         , fd_sig_ty :: LHsSigType GhcTc
    fd_sig_ty = LHsSigType GhcTc
    forall a. HasCallStack => a
    undefined
                                         , fd_i_ext :: XForeignImport GhcTc
    fd_i_ext = Coercion -> Coercion
    mkSymCo Coercion
    norm_co
                                         , fd_fi :: ForeignImport
    fd_fi = ForeignImport
    imp_decl' }
           ; (TyCoVar, GenLocated SrcSpanAnnA (ForeignDecl GhcTc),
     Bag GlobalRdrElt)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (TyCoVar, GenLocated SrcSpanAnnA (ForeignDecl GhcTc),
          Bag GlobalRdrElt)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TyCoVar
    id, SrcSpanAnnA
    -> ForeignDecl GhcTc -> GenLocated SrcSpanAnnA (ForeignDecl GhcTc)
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    dloc ForeignDecl GhcTc
    fi_decl, Bag GlobalRdrElt
    gres) }
    tcFImport LForeignDecl GhcRn
    d = String
    -> SDoc
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (TyCoVar, GenLocated SrcSpanAnnA (ForeignDecl GhcTc),
          Bag GlobalRdrElt)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcFImport" (GenLocated SrcSpanAnnA (ForeignDecl GhcRn) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr GenLocated SrcSpanAnnA (ForeignDecl GhcRn)
    LForeignDecl GhcRn
    d)

    -- ------------ Checking types for foreign import ----------------------

    tcCheckFIType :: [Scaled Type] -> Type -> ForeignImport -> TcM ForeignImport

    tcCheckFIType :: [Scaled Type] -> Type -> ForeignImport -> TcM ForeignImport
    tcCheckFIType [Scaled Type]
    arg_tys Type
    res_ty (CImport (L SrcSpan
    lc CCallConv
    cconv) Located Safety
    safety Maybe Header
    mh l :: CImportSpec
    l@(CLabel CLabelString
    _) Located SourceText
    src)
      -- Foreign import label
      = do (Backend -> Validity) -> TcM ()
    checkCg Backend -> Validity
    checkCOrAsmOrLlvmOrInterp
           -- NB check res_ty not sig_ty!
           --    In case sig_ty is (forall a. ForeignPtr a)
           Validity -> (SDoc -> SDoc) -> TcM ()
    check (Type -> Validity
    isFFILabelTy ([Scaled Type] -> Type -> Type
    mkVisFunTys [Scaled Type]
    arg_tys Type
    res_ty)) (SDoc -> SDoc -> SDoc
    illegalForeignTyErr SDoc
    Outputable.empty)
           CCallConv
    cconv' <- CCallConv -> TcM CCallConv
    checkCConv CCallConv
    cconv
           ForeignImport -> TcM ForeignImport
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GenLocated SrcSpan CCallConv
    -> Located Safety
    -> Maybe Header
    -> CImportSpec
    -> Located SourceText
    -> ForeignImport
    CImport (SrcSpan -> CCallConv -> GenLocated SrcSpan CCallConv
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    lc CCallConv
    cconv') Located Safety
    safety Maybe Header
    mh CImportSpec
    l Located SourceText
    src)

    tcCheckFIType [Scaled Type]
    arg_tys Type
    res_ty (CImport (L SrcSpan
    lc CCallConv
    cconv) Located Safety
    safety Maybe Header
    mh CImportSpec
    CWrapper Located SourceText
    src) = do
            -- Foreign wrapper (former f.e.d.)
            -- The type must be of the form ft -> IO (FunPtr ft), where ft is a valid
            -- foreign type.  For legacy reasons ft -> IO (Ptr ft) is accepted, too.
            -- The use of the latter form is DEPRECATED, though.
        (Backend -> Validity) -> TcM ()
    checkCg Backend -> Validity
    checkCOrAsmOrLlvmOrInterp
        CCallConv
    cconv' <- CCallConv -> TcM CCallConv
    checkCConv CCallConv
    cconv
        case [Scaled Type]
    arg_tys of
            [Scaled Type
    arg1_mult Type
    arg1_ty] -> do
                            Type -> TcM ()
    checkNoLinearFFI Type
    arg1_mult
                            (Type -> Validity) -> [Scaled Type] -> TcM ()
    checkForeignArgs Type -> Validity
    isFFIExternalTy [Scaled Type]
    arg1_tys
                            Bool -> Bool -> (Type -> Validity) -> Type -> TcM ()
    checkForeignRes Bool
    nonIOok  Bool
    checkSafe Type -> Validity
    isFFIExportResultTy Type
    res1_ty
                            Bool -> Bool -> (Type -> Validity) -> Type -> TcM ()
    checkForeignRes Bool
    mustBeIO Bool
    checkSafe (Type -> Type -> Validity
    isFFIDynTy Type
    arg1_ty) Type
    res_ty
                      where
                         ([Scaled Type]
    arg1_tys, Type
    res1_ty) = Type -> ([Scaled Type], Type)
    tcSplitFunTys Type
    arg1_ty
            [Scaled Type]
    _ -> SDoc -> TcM ()
    addErrTc (SDoc -> SDoc -> SDoc
    illegalForeignTyErr SDoc
    Outputable.empty (String -> SDoc
    text String
    "One argument expected"))
        ForeignImport -> TcM ForeignImport
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GenLocated SrcSpan CCallConv
    -> Located Safety
    -> Maybe Header
    -> CImportSpec
    -> Located SourceText
    -> ForeignImport
    CImport (SrcSpan -> CCallConv -> GenLocated SrcSpan CCallConv
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    lc CCallConv
    cconv') Located Safety
    safety Maybe Header
    mh CImportSpec
    CWrapper Located SourceText
    src)

    tcCheckFIType [Scaled Type]
    arg_tys Type
    res_ty idecl :: ForeignImport
    idecl@(CImport (L SrcSpan
    lc CCallConv
    cconv) (L SrcSpan
    ls Safety
    safety) Maybe Header
    mh
                                                (CFunction CCallTarget
    target) Located SourceText
    src)
      | CCallTarget -> Bool
    isDynamicTarget CCallTarget
    target = do -- Foreign import dynamic
          (Backend -> Validity) -> TcM ()
    checkCg Backend -> Validity
    checkCOrAsmOrLlvmOrInterp
          CCallConv
    cconv' <- CCallConv -> TcM CCallConv
    checkCConv CCallConv
    cconv
          case [Scaled Type]
    arg_tys of           -- The first arg must be Ptr or FunPtr
            []                ->
              SDoc -> TcM ()
    addErrTc (SDoc -> SDoc -> SDoc
    illegalForeignTyErr SDoc
    Outputable.empty (String -> SDoc
    text String
    "At least one argument expected"))
            (Scaled Type
    arg1_mult Type
    arg1_ty:[Scaled Type]
    arg_tys) -> do
              DynFlags
    dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
              let curried_res_ty :: Type
    curried_res_ty = [Scaled Type] -> Type -> Type
    mkVisFunTys [Scaled Type]
    arg_tys Type
    res_ty
              Type -> TcM ()
    checkNoLinearFFI Type
    arg1_mult
              Validity -> (SDoc -> SDoc) -> TcM ()
    check (Type -> Type -> Validity
    isFFIDynTy Type
    curried_res_ty Type
    arg1_ty)
                    (SDoc -> SDoc -> SDoc
    illegalForeignTyErr SDoc
    argument)
              (Type -> Validity) -> [Scaled Type] -> TcM ()
    checkForeignArgs (DynFlags -> Safety -> Type -> Validity
    isFFIArgumentTy DynFlags
    dflags Safety
    safety) [Scaled Type]
    arg_tys
              Bool -> Bool -> (Type -> Validity) -> Type -> TcM ()
    checkForeignRes Bool
    nonIOok Bool
    checkSafe (DynFlags -> Type -> Validity
    isFFIImportResultTy DynFlags
    dflags) Type
    res_ty
          ForeignImport -> TcM ForeignImport
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ForeignImport -> TcM ForeignImport)
    -> ForeignImport -> TcM ForeignImport
    forall a b. (a -> b) -> a -> b
    $ GenLocated SrcSpan CCallConv
    -> Located Safety
    -> Maybe Header
    -> CImportSpec
    -> Located SourceText
    -> ForeignImport
    CImport (SrcSpan -> CCallConv -> GenLocated SrcSpan CCallConv
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    lc CCallConv
    cconv') (SrcSpan -> Safety -> Located Safety
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    ls Safety
    safety) Maybe Header
    mh (CCallTarget -> CImportSpec
    CFunction CCallTarget
    target) Located SourceText
    src
      | CCallConv
    cconv CCallConv -> CCallConv -> Bool
    forall a. Eq a => a -> a -> Bool
    == CCallConv
    PrimCallConv = do
          DynFlags
    dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
          Bool -> SDoc -> TcM ()
    checkTc (Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.GHCForeignImportPrim DynFlags
    dflags)
                  (String -> SDoc
    text String
    "Use GHCForeignImportPrim to allow `foreign import prim'.")
          (Backend -> Validity) -> TcM ()
    checkCg Backend -> Validity
    checkCOrAsmOrLlvmOrInterp
          CCallTarget -> TcM ()
    checkCTarget CCallTarget
    target
          Bool -> SDoc -> TcM ()
    checkTc (Safety -> Bool
    playSafe Safety
    safety)
                  (String -> SDoc
    text String
    "The safe/unsafe annotation should not be used with `foreign import prim'.")
          (Type -> Validity) -> [Scaled Type] -> TcM ()
    checkForeignArgs (DynFlags -> Type -> Validity
    isFFIPrimArgumentTy DynFlags
    dflags) [Scaled Type]
    arg_tys
          -- prim import result is more liberal, allows (#,,#)
          Bool -> Bool -> (Type -> Validity) -> Type -> TcM ()
    checkForeignRes Bool
    nonIOok Bool
    checkSafe (DynFlags -> Type -> Validity
    isFFIPrimResultTy DynFlags
    dflags) Type
    res_ty
          ForeignImport -> TcM ForeignImport
    forall (m :: * -> *) a. Monad m => a -> m a
    return ForeignImport
    idecl
      | Bool
    otherwise = do              -- Normal foreign import
          (Backend -> Validity) -> TcM ()
    checkCg Backend -> Validity
    checkCOrAsmOrLlvmOrInterp
          CCallConv
    cconv' <- CCallConv -> TcM CCallConv
    checkCConv CCallConv
    cconv
          CCallTarget -> TcM ()
    checkCTarget CCallTarget
    target
          DynFlags
    dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
          (Type -> Validity) -> [Scaled Type] -> TcM ()
    checkForeignArgs (DynFlags -> Safety -> Type -> Validity
    isFFIArgumentTy DynFlags
    dflags Safety
    safety) [Scaled Type]
    arg_tys
          Bool -> Bool -> (Type -> Validity) -> Type -> TcM ()
    checkForeignRes Bool
    nonIOok Bool
    checkSafe (DynFlags -> Type -> Validity
    isFFIImportResultTy DynFlags
    dflags) Type
    res_ty
          DynFlags -> [Type] -> Type -> TcM ()
    checkMissingAmpersand DynFlags
    dflags ((Scaled Type -> Type) -> [Scaled Type] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map Scaled Type -> Type
    forall a. Scaled a -> a
    scaledThing [Scaled Type]
    arg_tys) Type
    res_ty
          case CCallTarget
    target of
              StaticTarget SourceText
    _ CLabelString
    _ Maybe Unit
    _ Bool
    False
               | Bool -> Bool
    not ([Scaled Type] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Scaled Type]
    arg_tys) ->
                  SDoc -> TcM ()
    addErrTc (String -> SDoc
    text String
    "`value' imports cannot have function types")
              CCallTarget
    _ -> () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          ForeignImport -> TcM ForeignImport
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ForeignImport -> TcM ForeignImport)
    -> ForeignImport -> TcM ForeignImport
    forall a b. (a -> b) -> a -> b
    $ GenLocated SrcSpan CCallConv
    -> Located Safety
    -> Maybe Header
    -> CImportSpec
    -> Located SourceText
    -> ForeignImport
    CImport (SrcSpan -> CCallConv -> GenLocated SrcSpan CCallConv
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    lc CCallConv
    cconv') (SrcSpan -> Safety -> Located Safety
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    ls Safety
    safety) Maybe Header
    mh (CCallTarget -> CImportSpec
    CFunction CCallTarget
    target) Located SourceText
    src

    -- This makes a convenient place to check
    -- that the C identifier is valid for C
    checkCTarget :: CCallTarget -> TcM ()
    checkCTarget :: CCallTarget -> TcM ()
    checkCTarget (StaticTarget SourceText
    _ CLabelString
    str Maybe Unit
    _ Bool
    _) = do
        (Backend -> Validity) -> TcM ()
    checkCg Backend -> Validity
    checkCOrAsmOrLlvmOrInterp
        Bool -> SDoc -> TcM ()
    checkTc (CLabelString -> Bool
    isCLabelString CLabelString
    str) (CLabelString -> SDoc
    badCName CLabelString
    str)

    checkCTarget CCallTarget
    DynamicTarget = String -> TcM ()
    forall a. String -> a
    panic String
    "checkCTarget DynamicTarget"

    checkMissingAmpersand :: DynFlags -> [Type] -> Type -> TcM ()
    checkMissingAmpersand :: DynFlags -> [Type] -> Type -> TcM ()
    checkMissingAmpersand DynFlags
    dflags [Type]
    arg_tys Type
    res_ty
      | [Type] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Type]
    arg_tys Bool -> Bool -> Bool
    && Type -> Bool
    isFunPtrTy Type
    res_ty Bool -> Bool -> Bool
    &&
        WarningFlag -> DynFlags -> Bool
    wopt WarningFlag
    Opt_WarnDodgyForeignImports DynFlags
    dflags
      = WarnReason -> SDoc -> TcM ()
    addWarn (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnDodgyForeignImports)
            (String -> SDoc
    text String
    "possible missing & in foreign import of FunPtr")
      | Bool
    otherwise
      = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Exports}
    *                                                                      *
    ************************************************************************
    -}

    tcForeignExports :: [LForeignDecl GhcRn]
                 -> TcM (LHsBinds GhcTc, [LForeignDecl GhcTc], Bag GlobalRdrElt)
    tcForeignExports :: [LForeignDecl GhcRn]
    -> TcM (LHsBinds GhcTc, [LForeignDecl GhcTc], Bag GlobalRdrElt)
    tcForeignExports [LForeignDecl GhcRn]
    decls = do
        Hooks
    hooks <- IOEnv (Env TcGblEnv TcLclEnv) Hooks
    forall (m :: * -> *). HasHooks m => m Hooks
    getHooks
        case Hooks
    -> Maybe
         ([LForeignDecl GhcRn]
          -> TcM (LHsBinds GhcTc, [LForeignDecl GhcTc], Bag GlobalRdrElt))
    tcForeignExportsHook Hooks
    hooks of
            Maybe
      ([LForeignDecl GhcRn]
       -> TcM (LHsBinds GhcTc, [LForeignDecl GhcTc], Bag GlobalRdrElt))
    Nothing -> [LForeignDecl GhcRn]
    -> TcM (LHsBinds GhcTc, [LForeignDecl GhcTc], Bag GlobalRdrElt)
    tcForeignExports' [LForeignDecl GhcRn]
    decls
            Just [LForeignDecl GhcRn]
    -> TcM (LHsBinds GhcTc, [LForeignDecl GhcTc], Bag GlobalRdrElt)
    h  -> [LForeignDecl GhcRn]
    -> TcM (LHsBinds GhcTc, [LForeignDecl GhcTc], Bag GlobalRdrElt)
    h [LForeignDecl GhcRn]
    decls

    tcForeignExports' :: [LForeignDecl GhcRn]
                 -> TcM (LHsBinds GhcTc, [LForeignDecl GhcTc], Bag GlobalRdrElt)
    -- For the (Bag GlobalRdrElt) result,
    -- see Note [Newtype constructor usage in foreign declarations]
    tcForeignExports' :: [LForeignDecl GhcRn]
    -> TcM (LHsBinds GhcTc, [LForeignDecl GhcTc], Bag GlobalRdrElt)
    tcForeignExports' [LForeignDecl GhcRn]
    decls
      = ((Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)),
      [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)], Bag GlobalRdrElt)
     -> GenLocated SrcSpanAnnA (ForeignDecl GhcRn)
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)),
           [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)], Bag GlobalRdrElt))
    -> (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)),
        [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)], Bag GlobalRdrElt)
    -> [GenLocated SrcSpanAnnA (ForeignDecl GhcRn)]
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)),
          [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)], Bag GlobalRdrElt)
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldlM (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)),
     [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)], Bag GlobalRdrElt)
    -> GenLocated SrcSpanAnnA (ForeignDecl GhcRn)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)),
          [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)], Bag GlobalRdrElt)
    forall {ann}.
    (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)),
     [GenLocated (SrcSpanAnn' ann) (ForeignDecl GhcTc)],
     Bag GlobalRdrElt)
    -> GenLocated (SrcSpanAnn' ann) (ForeignDecl GhcRn)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)),
          [GenLocated (SrcSpanAnn' ann) (ForeignDecl GhcTc)],
          Bag GlobalRdrElt)
    combine (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    forall (idL :: Pass) idR. LHsBindsLR (GhcPass idL) idR
    emptyLHsBinds, [], Bag GlobalRdrElt
    forall a. Bag a
    emptyBag) ((GenLocated SrcSpanAnnA (ForeignDecl GhcRn) -> Bool)
    -> [GenLocated SrcSpanAnnA (ForeignDecl GhcRn)]
    -> [GenLocated SrcSpanAnnA (ForeignDecl GhcRn)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter GenLocated SrcSpanAnnA (ForeignDecl GhcRn) -> Bool
    forall name. UnXRec name => LForeignDecl name -> Bool
    isForeignExport [GenLocated SrcSpanAnnA (ForeignDecl GhcRn)]
    [LForeignDecl GhcRn]
    decls)
      where
       combine :: (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)),
     [GenLocated (SrcSpanAnn' ann) (ForeignDecl GhcTc)],
     Bag GlobalRdrElt)
    -> GenLocated (SrcSpanAnn' ann) (ForeignDecl GhcRn)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)),
          [GenLocated (SrcSpanAnn' ann) (ForeignDecl GhcTc)],
          Bag GlobalRdrElt)
    combine (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    binds, [GenLocated (SrcSpanAnn' ann) (ForeignDecl GhcTc)]
    fs, Bag GlobalRdrElt
    gres1) (L SrcSpanAnn' ann
    loc ForeignDecl GhcRn
    fe) = do
           (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
    b, ForeignDecl GhcTc
    f, Bag GlobalRdrElt
    gres2) <- SrcSpanAnn' ann
    -> TcRn
         (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc), ForeignDecl GhcTc,
          Bag GlobalRdrElt)
    -> TcRn
         (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc), ForeignDecl GhcTc,
          Bag GlobalRdrElt)
    forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnn' ann
    loc (ForeignDecl GhcRn
    -> TcM (LHsBind GhcTc, ForeignDecl GhcTc, Bag GlobalRdrElt)
    tcFExport ForeignDecl GhcRn
    fe)
           (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)),
     [GenLocated (SrcSpanAnn' ann) (ForeignDecl GhcTc)],
     Bag GlobalRdrElt)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)),
          [GenLocated (SrcSpanAnn' ann) (ForeignDecl GhcTc)],
          Bag GlobalRdrElt)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
    b GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
    -> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    -> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    forall a. a -> Bag a -> Bag a
    `consBag` Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    binds, SrcSpanAnn' ann
    -> ForeignDecl GhcTc
    -> GenLocated (SrcSpanAnn' ann) (ForeignDecl GhcTc)
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnn' ann
    loc ForeignDecl GhcTc
    f GenLocated (SrcSpanAnn' ann) (ForeignDecl GhcTc)
    -> [GenLocated (SrcSpanAnn' ann) (ForeignDecl GhcTc)]
    -> [GenLocated (SrcSpanAnn' ann) (ForeignDecl GhcTc)]
    forall a. a -> [a] -> [a]
    : [GenLocated (SrcSpanAnn' ann) (ForeignDecl GhcTc)]
    fs, Bag GlobalRdrElt
    gres1 Bag GlobalRdrElt -> Bag GlobalRdrElt -> Bag GlobalRdrElt
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` Bag GlobalRdrElt
    gres2)

    tcFExport :: ForeignDecl GhcRn
              -> TcM (LHsBind GhcTc, ForeignDecl GhcTc, Bag GlobalRdrElt)
    tcFExport :: ForeignDecl GhcRn
    -> TcM (LHsBind GhcTc, ForeignDecl GhcTc, Bag GlobalRdrElt)
    tcFExport fo :: ForeignDecl GhcRn
    fo@(ForeignExport { fd_name :: forall pass. ForeignDecl pass -> LIdP pass
    fd_name = L SrcSpanAnnN
    loc Name
    nm, fd_sig_ty :: forall pass. ForeignDecl pass -> LHsSigType pass
    fd_sig_ty = LHsSigType GhcRn
    hs_ty, fd_fe :: forall pass. ForeignDecl pass -> ForeignExport
    fd_fe = ForeignExport
    spec })
      = SDoc
    -> TcM (LHsBind GhcTc, ForeignDecl GhcTc, Bag GlobalRdrElt)
    -> TcM (LHsBind GhcTc, ForeignDecl GhcTc, Bag GlobalRdrElt)
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (ForeignDecl GhcRn -> SDoc
    foreignDeclCtxt ForeignDecl GhcRn
    fo) (TcM (LHsBind GhcTc, ForeignDecl GhcTc, Bag GlobalRdrElt)
     -> TcM (LHsBind GhcTc, ForeignDecl GhcTc, Bag GlobalRdrElt))
    -> TcM (LHsBind GhcTc, ForeignDecl GhcTc, Bag GlobalRdrElt)
    -> TcM (LHsBind GhcTc, ForeignDecl GhcTc, Bag GlobalRdrElt)
    forall a b. (a -> b) -> a -> b
    $ do

        Type
    sig_ty <- UserTypeCtxt -> LHsSigType GhcRn -> TcM Type
    tcHsSigType (Name -> UserTypeCtxt
    ForSigCtxt Name
    nm) LHsSigType GhcRn
    hs_ty
        GenLocated SrcSpanAnnA (HsExpr GhcTc)
    rhs <- LHsExpr GhcRn -> Type -> TcM (LHsExpr GhcTc)
    tcCheckPolyExpr (IdP GhcRn -> LHsExpr GhcRn
    forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> LHsExpr (GhcPass p)
    nlHsVar Name
    IdP GhcRn
    nm) Type
    sig_ty

        (Coercion
    norm_co, Type
    norm_sig_ty, Bag GlobalRdrElt
    gres) <- Type -> TcM (Coercion, Type, Bag GlobalRdrElt)
    normaliseFfiType Type
    sig_ty

        ForeignExport
    spec' <- Type -> ForeignExport -> TcM ForeignExport
    tcCheckFEType Type
    norm_sig_ty ForeignExport
    spec

               -- we're exporting a function, but at a type possibly more
               -- constrained than its declared/inferred type. Hence the need
               -- to create a local binding which will call the exported function
               -- at a particular type (and, maybe, overloading).

        -- We need to give a name to the new top-level binding that
        -- is *stable* (i.e. the compiler won't change it later),
        -- because this name will be referred to by the C code stub.
        TyCoVar
    id  <- Name -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TyCoVar
    mkStableIdFromName Name
    nm Type
    sig_ty (SrcSpanAnnN -> SrcSpan
    forall a. SrcSpanAnn' a -> SrcSpan
    locA SrcSpanAnnN
    loc) OccName -> OccName
    mkForeignExportOcc
        (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc), ForeignDecl GhcTc,
     Bag GlobalRdrElt)
    -> TcRn
         (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc), ForeignDecl GhcTc,
          Bag GlobalRdrElt)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( IdP GhcTc -> LHsExpr GhcTc -> LHsBind GhcTc
    forall (p :: Pass).
    IdP (GhcPass p) -> LHsExpr (GhcPass p) -> LHsBind (GhcPass p)
    mkVarBind TyCoVar
    IdP GhcTc
    id GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    rhs
               , ForeignExport { fd_name :: LIdP GhcTc
    fd_name = SrcSpanAnnN -> TyCoVar -> GenLocated SrcSpanAnnN TyCoVar
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnN
    loc TyCoVar
    id
                               , fd_sig_ty :: LHsSigType GhcTc
    fd_sig_ty = LHsSigType GhcTc
    forall a. HasCallStack => a
    undefined
                               , fd_e_ext :: XForeignExport GhcTc
    fd_e_ext = Coercion
    XForeignExport GhcTc
    norm_co, fd_fe :: ForeignExport
    fd_fe = ForeignExport
    spec' }
               , Bag GlobalRdrElt
    gres)
    tcFExport ForeignDecl GhcRn
    d = String
    -> SDoc
    -> TcRn
         (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc), ForeignDecl GhcTc,
          Bag GlobalRdrElt)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcFExport" (ForeignDecl GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ForeignDecl GhcRn
    d)

    -- ------------ Checking argument types for foreign export ----------------------

    tcCheckFEType :: Type -> ForeignExport -> TcM ForeignExport
    tcCheckFEType :: Type -> ForeignExport -> TcM ForeignExport
    tcCheckFEType Type
    sig_ty (CExport (L SrcSpan
    l (CExportStatic SourceText
    esrc CLabelString
    str CCallConv
    cconv)) Located SourceText
    src) = do
        (Backend -> Validity) -> TcM ()
    checkCg Backend -> Validity
    checkCOrAsmOrLlvm
        Bool -> SDoc -> TcM ()
    checkTc (CLabelString -> Bool
    isCLabelString CLabelString
    str) (CLabelString -> SDoc
    badCName CLabelString
    str)
        CCallConv
    cconv' <- CCallConv -> TcM CCallConv
    checkCConv CCallConv
    cconv
        (Type -> Validity) -> [Scaled Type] -> TcM ()
    checkForeignArgs Type -> Validity
    isFFIExternalTy [Scaled Type]
    arg_tys
        Bool -> Bool -> (Type -> Validity) -> Type -> TcM ()
    checkForeignRes Bool
    nonIOok Bool
    noCheckSafe Type -> Validity
    isFFIExportResultTy Type
    res_ty
        ForeignExport -> TcM ForeignExport
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GenLocated SrcSpan CExportSpec
    -> Located SourceText -> ForeignExport
    CExport (SrcSpan -> CExportSpec -> GenLocated SrcSpan CExportSpec
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l (SourceText -> CLabelString -> CCallConv -> CExportSpec
    CExportStatic SourceText
    esrc CLabelString
    str CCallConv
    cconv')) Located SourceText
    src)
      where
          -- Drop the foralls before inspecting
          -- the structure of the foreign type.
        ([Scaled Type]
    arg_tys, Type
    res_ty) = Type -> ([Scaled Type], Type)
    tcSplitFunTys (Type -> Type
    dropForAlls Type
    sig_ty)

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Miscellaneous}
    *                                                                      *
    ************************************************************************
    -}

    ------------ Checking argument types for foreign import ----------------------
    checkForeignArgs :: (Type -> Validity) -> [Scaled Type] -> TcM ()
    checkForeignArgs :: (Type -> Validity) -> [Scaled Type] -> TcM ()
    checkForeignArgs Type -> Validity
    pred [Scaled Type]
    tys = (Scaled Type -> TcM ()) -> [Scaled Type] -> TcM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Scaled Type -> TcM ()
    go [Scaled Type]
    tys
      where
        go :: Scaled Type -> TcM ()
    go (Scaled Type
    mult Type
    ty) = Type -> TcM ()
    checkNoLinearFFI Type
    mult TcM () -> TcM () -> TcM ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
                              Validity -> (SDoc -> SDoc) -> TcM ()
    check (Type -> Validity
    pred Type
    ty) (SDoc -> SDoc -> SDoc
    illegalForeignTyErr SDoc
    argument)

    checkNoLinearFFI :: Mult -> TcM ()  -- No linear types in FFI (#18472)
    checkNoLinearFFI :: Type -> TcM ()
    checkNoLinearFFI Type
    Many = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    checkNoLinearFFI Type
    _    = SDoc -> TcM ()
    addErrTc (SDoc -> TcM ()) -> SDoc -> TcM ()
    forall a b. (a -> b) -> a -> b
    $ SDoc -> SDoc -> SDoc
    illegalForeignTyErr SDoc
    argument
                                       (String -> SDoc
    text String
    "Linear types are not supported in FFI declarations, see #18472")

    ------------ Checking result types for foreign calls ----------------------
    -- | Check that the type has the form
    --    (IO t) or (t) , and that t satisfies the given predicate.
    -- When calling this function, any newtype wrappers (should) have been
    -- already dealt with by normaliseFfiType.
    --
    -- We also check that the Safe Haskell condition of FFI imports having
    -- results in the IO monad holds.
    --
    checkForeignRes :: Bool -> Bool -> (Type -> Validity) -> Type -> TcM ()
    checkForeignRes :: Bool -> Bool -> (Type -> Validity) -> Type -> TcM ()
    checkForeignRes Bool
    non_io_result_ok Bool
    check_safe Type -> Validity
    pred_res_ty Type
    ty
      | Just (TyCon
    _, Type
    res_ty) <- Type -> Maybe (TyCon, Type)
    tcSplitIOType_maybe Type
    ty
      =     -- Got an IO result type, that's always fine!
         Validity -> (SDoc -> SDoc) -> TcM ()
    check (Type -> Validity
    pred_res_ty Type
    res_ty) (SDoc -> SDoc -> SDoc
    illegalForeignTyErr SDoc
    result)

      -- We disallow nested foralls in foreign types
      -- (at least, for the time being). See #16702.
      | Type -> Bool
    tcIsForAllTy Type
    ty
      = SDoc -> TcM ()
    addErrTc (SDoc -> TcM ()) -> SDoc -> TcM ()
    forall a b. (a -> b) -> a -> b
    $ SDoc -> SDoc -> SDoc
    illegalForeignTyErr SDoc
    result (String -> SDoc
    text String
    "Unexpected nested forall")

      -- Case for non-IO result type with FFI Import
      | Bool -> Bool
    not Bool
    non_io_result_ok
      = SDoc -> TcM ()
    addErrTc (SDoc -> TcM ()) -> SDoc -> TcM ()
    forall a b. (a -> b) -> a -> b
    $ SDoc -> SDoc -> SDoc
    illegalForeignTyErr SDoc
    result (String -> SDoc
    text String
    "IO result type expected")

      | Bool
    otherwise
      = do { DynFlags
    dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           ; case Type -> Validity
    pred_res_ty Type
    ty of
                    -- Handle normal typecheck fail, we want to handle this first and
                    -- only report safe haskell errors if the normal type check is OK.
               NotValid SDoc
    msg -> SDoc -> TcM ()
    addErrTc (SDoc -> TcM ()) -> SDoc -> TcM ()
    forall a b. (a -> b) -> a -> b
    $ SDoc -> SDoc -> SDoc
    illegalForeignTyErr SDoc
    result SDoc
    msg

               -- handle safe infer fail
               Validity
    _ | Bool
    check_safe Bool -> Bool -> Bool
    && DynFlags -> Bool
    safeInferOn DynFlags
    dflags
                   -> WarningMessages -> TcM ()
    recordUnsafeInfer WarningMessages
    forall a. Bag a
    emptyBag

               -- handle safe language typecheck fail
               Validity
    _ | Bool
    check_safe Bool -> Bool -> Bool
    && DynFlags -> Bool
    safeLanguageOn DynFlags
    dflags
                   -> SDoc -> TcM ()
    addErrTc (SDoc -> SDoc -> SDoc
    illegalForeignTyErr SDoc
    result SDoc
    safeHsErr)

               -- success! non-IO return is fine
               Validity
    _ -> () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return () }
      where
        safeHsErr :: SDoc
    safeHsErr =
          String -> SDoc
    text String
    "Safe Haskell is on, all FFI imports must be in the IO monad"

    nonIOok, mustBeIO :: Bool
    nonIOok :: Bool
    nonIOok  = Bool
    True
    mustBeIO :: Bool
    mustBeIO = Bool
    False

    checkSafe, noCheckSafe :: Bool
    checkSafe :: Bool
    checkSafe   = Bool
    True
    noCheckSafe :: Bool
    noCheckSafe = Bool
    False

    -- | Checking a supported backend is in use
    checkCOrAsmOrLlvm :: Backend -> Validity
    checkCOrAsmOrLlvm :: Backend -> Validity
    checkCOrAsmOrLlvm Backend
    ViaC = Validity
    IsValid
    checkCOrAsmOrLlvm Backend
    NCG  = Validity
    IsValid
    checkCOrAsmOrLlvm Backend
    LLVM = Validity
    IsValid
    checkCOrAsmOrLlvm Backend
    _
      = SDoc -> Validity
    NotValid (String -> SDoc
    text String
    "requires unregisterised, llvm (-fllvm) or native code generation (-fasm)")

    -- | Checking a supported backend is in use
    checkCOrAsmOrLlvmOrInterp :: Backend -> Validity
    checkCOrAsmOrLlvmOrInterp :: Backend -> Validity
    checkCOrAsmOrLlvmOrInterp Backend
    ViaC        = Validity
    IsValid
    checkCOrAsmOrLlvmOrInterp Backend
    NCG         = Validity
    IsValid
    checkCOrAsmOrLlvmOrInterp Backend
    LLVM        = Validity
    IsValid
    checkCOrAsmOrLlvmOrInterp Backend
    Interpreter = Validity
    IsValid
    checkCOrAsmOrLlvmOrInterp Backend
    _
      = SDoc -> Validity
    NotValid (String -> SDoc
    text String
    "requires interpreted, unregisterised, llvm or native code generation")

    checkCg :: (Backend -> Validity) -> TcM ()
    checkCg :: (Backend -> Validity) -> TcM ()
    checkCg Backend -> Validity
    check = do
        DynFlags
    dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        let bcknd :: Backend
    bcknd = DynFlags -> Backend
    backend DynFlags
    dflags
        case Backend
    bcknd of
          Backend
    NoBackend -> () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          Backend
    _ ->
            case Backend -> Validity
    check Backend
    bcknd of
              Validity
    IsValid      -> () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
              NotValid SDoc
    err -> SDoc -> TcM ()
    addErrTc (String -> SDoc
    text String
    "Illegal foreign declaration:" SDoc -> SDoc -> SDoc
    <+> SDoc
    err)

    -- Calling conventions

    checkCConv :: CCallConv -> TcM CCallConv
    checkCConv :: CCallConv -> TcM CCallConv
    checkCConv CCallConv
    CCallConv    = CCallConv -> TcM CCallConv
    forall (m :: * -> *) a. Monad m => a -> m a
    return CCallConv
    CCallConv
    checkCConv CCallConv
    CApiConv     = CCallConv -> TcM CCallConv
    forall (m :: * -> *) a. Monad m => a -> m a
    return CCallConv
    CApiConv
    checkCConv CCallConv
    StdCallConv  = do DynFlags
    dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
                                 let platform :: Platform
    platform = DynFlags -> Platform
    targetPlatform DynFlags
    dflags
                                 if Platform -> Arch
    platformArch Platform
    platform Arch -> Arch -> Bool
    forall a. Eq a => a -> a -> Bool
    == Arch
    ArchX86
                                     then CCallConv -> TcM CCallConv
    forall (m :: * -> *) a. Monad m => a -> m a
    return CCallConv
    StdCallConv
                                     else do -- This is a warning, not an error. see #3336
                                             Bool -> TcM () -> TcM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (WarningFlag -> DynFlags -> Bool
    wopt WarningFlag
    Opt_WarnUnsupportedCallingConventions DynFlags
    dflags) (TcM () -> TcM ()) -> TcM () -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
                                                 WarnReason -> SDoc -> TcM ()
    addWarnTc (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnUnsupportedCallingConventions)
                                                     (String -> SDoc
    text String
    "the 'stdcall' calling convention is unsupported on this platform," SDoc -> SDoc -> SDoc
    $$ String -> SDoc
    text String
    "treating as ccall")
                                             CCallConv -> TcM CCallConv
    forall (m :: * -> *) a. Monad m => a -> m a
    return CCallConv
    CCallConv
    checkCConv CCallConv
    PrimCallConv = do SDoc -> TcM ()
    addErrTc (String -> SDoc
    text String
    "The `prim' calling convention can only be used with `foreign import'")
                                 CCallConv -> TcM CCallConv
    forall (m :: * -> *) a. Monad m => a -> m a
    return CCallConv
    PrimCallConv
    checkCConv CCallConv
    JavaScriptCallConv = do DynFlags
    dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
                                       if Platform -> Arch
    platformArch (DynFlags -> Platform
    targetPlatform DynFlags
    dflags) Arch -> Arch -> Bool
    forall a. Eq a => a -> a -> Bool
    == Arch
    ArchJavaScript
                                           then CCallConv -> TcM CCallConv
    forall (m :: * -> *) a. Monad m => a -> m a
    return CCallConv
    JavaScriptCallConv
                                           else do SDoc -> TcM ()
    addErrTc (String -> SDoc
    text String
    "The `javascript' calling convention is unsupported on this platform")
                                                   CCallConv -> TcM CCallConv
    forall (m :: * -> *) a. Monad m => a -> m a
    return CCallConv
    JavaScriptCallConv

    -- Warnings

    check :: Validity -> (SDoc -> SDoc) -> TcM ()
    check :: Validity -> (SDoc -> SDoc) -> TcM ()
    check Validity
    IsValid SDoc -> SDoc
    _             = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    check (NotValid SDoc
    doc) SDoc -> SDoc
    err_fn = SDoc -> TcM ()
    addErrTc (SDoc -> SDoc
    err_fn SDoc
    doc)

    illegalForeignTyErr :: SDoc -> SDoc -> SDoc
    illegalForeignTyErr :: SDoc -> SDoc -> SDoc
    illegalForeignTyErr SDoc
    arg_or_res SDoc
    extra
      = SDoc -> Int -> SDoc -> SDoc
    hang SDoc
    msg Int
    2 SDoc
    extra
      where
        msg :: SDoc
    msg = [SDoc] -> SDoc
    hsep [ String -> SDoc
    text String
    "Unacceptable", SDoc
    arg_or_res
                   , String -> SDoc
    text String
    "type in foreign declaration:"]

    -- Used for 'arg_or_res' argument to illegalForeignTyErr
    argument, result :: SDoc
    argument :: SDoc
    argument = String -> SDoc
    text String
    "argument"
    result :: SDoc
    result   = String -> SDoc
    text String
    "result"

    badCName :: CLabelString -> SDoc
    badCName :: CLabelString -> SDoc
    badCName CLabelString
    target
      = [SDoc] -> SDoc
    sep [SDoc -> SDoc
    quotes (CLabelString -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CLabelString
    target) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is not a valid C identifier"]

    foreignDeclCtxt :: ForeignDecl GhcRn -> SDoc
    foreignDeclCtxt :: ForeignDecl GhcRn -> SDoc
    foreignDeclCtxt ForeignDecl GhcRn
    fo
      = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "When checking declaration:")
           Int
    2 (ForeignDecl GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ForeignDecl GhcRn
    fo)