{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE DataKinds             #-}
{-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE #-}
--
--  (c) The University of Glasgow 2002-2006
--

-- | Bytecode assembler and linker
module GHC.ByteCode.Linker
  ( linkBCO
  , lookupStaticPtr
  , lookupIE
  , linkFail
  )
where

import GHC.Prelude

import GHC.Runtime.Interpreter
import GHC.ByteCode.Types
import GHCi.RemoteTypes
import GHCi.ResolvedBCO

import GHC.Builtin.PrimOps
import GHC.Builtin.PrimOps.Ids

import GHC.Unit.Types

import GHC.Data.FastString
import GHC.Data.SizedSeq

import GHC.Linker.Types

import GHC.Utils.Panic
import GHC.Utils.Outputable

import GHC.Types.Name
import GHC.Types.Name.Env
import qualified GHC.Types.Id as Id
import GHC.Types.Unique.DFM

-- Standard libraries
import Data.Array.Unboxed
import Foreign.Ptr
import GHC.Exts

{-
  Linking interpretables into something we can run
-}

linkBCO
  :: Interp
  -> PkgsLoaded
  -> LinkerEnv
  -> NameEnv Int
  -> UnlinkedBCO
  -> IO ResolvedBCO
linkBCO :: Interp
-> PkgsLoaded
-> LinkerEnv
-> NameEnv Int
-> UnlinkedBCO
-> IO ResolvedBCO
linkBCO Interp
interp PkgsLoaded
pkgs_loaded LinkerEnv
le NameEnv Int
bco_ix
           (UnlinkedBCO Name
_ Int
arity BCOByteArray Word16
insns BCOByteArray Word
bitmap FlatBag BCONPtr
lits0 FlatBag BCOPtr
ptrs0) = do
  -- fromIntegral Word -> Word64 should be a no op if Word is Word64
  -- otherwise it will result in a cast to longlong on 32bit systems.
  (lits :: [Word]) <- (BCONPtr -> IO Word) -> [BCONPtr] -> IO [Word]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Word -> Word) -> IO Word -> IO Word
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO Word -> IO Word) -> (BCONPtr -> IO Word) -> BCONPtr -> IO Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interp -> PkgsLoaded -> LinkerEnv -> BCONPtr -> IO Word
lookupLiteral Interp
interp PkgsLoaded
pkgs_loaded LinkerEnv
le) (FlatBag BCONPtr -> [BCONPtr]
forall a. FlatBag a -> [a]
elemsFlatBag FlatBag BCONPtr
lits0)
  ptrs <- mapM (resolvePtr interp pkgs_loaded le bco_ix) (elemsFlatBag ptrs0)
  let lits' = (Int, Int) -> [Word] -> UArray Int Word
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0 :: Int, Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FlatBag BCONPtr -> Word
forall a. FlatBag a -> Word
sizeFlatBag FlatBag BCONPtr
lits0)Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [Word]
lits
  return (ResolvedBCO isLittleEndian arity
              insns
              bitmap
              (mkBCOByteArray lits')
              (addListToSS emptySS ptrs))

lookupLiteral :: Interp -> PkgsLoaded -> LinkerEnv -> BCONPtr -> IO Word
lookupLiteral :: Interp -> PkgsLoaded -> LinkerEnv -> BCONPtr -> IO Word
lookupLiteral Interp
interp PkgsLoaded
pkgs_loaded LinkerEnv
le BCONPtr
ptr = case BCONPtr
ptr of
  BCONPtrWord Word
lit -> Word -> IO Word
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word
lit
  BCONPtrLbl  FastString
sym -> do
    Ptr a# <- Interp -> FastString -> IO (Ptr ())
lookupStaticPtr Interp
interp FastString
sym
    return (W# (int2Word# (addr2Int# a#)))
  BCONPtrItbl Name
nm -> do
    Ptr a# <- Interp -> PkgsLoaded -> ItblEnv -> Name -> IO (Ptr ())
lookupIE Interp
interp PkgsLoaded
pkgs_loaded (LinkerEnv -> ItblEnv
itbl_env LinkerEnv
le) Name
nm
    return (W# (int2Word# (addr2Int# a#)))
  BCONPtrAddr Name
nm -> do
    Ptr a# <- Interp -> PkgsLoaded -> AddrEnv -> Name -> IO (Ptr ())
lookupAddr Interp
interp PkgsLoaded
pkgs_loaded (LinkerEnv -> AddrEnv
addr_env LinkerEnv
le) Name
nm
    return (W# (int2Word# (addr2Int# a#)))
  BCONPtrStr ByteString
_ ->
    -- should be eliminated during assembleBCOs
    [Char] -> IO Word
forall a. HasCallStack => [Char] -> a
panic [Char]
"lookupLiteral: BCONPtrStr"

lookupStaticPtr :: Interp -> FastString -> IO (Ptr ())
lookupStaticPtr :: Interp -> FastString -> IO (Ptr ())
lookupStaticPtr Interp
interp FastString
addr_of_label_string = do
  m <- Interp -> InterpSymbol 'Interpreted -> IO (Maybe (Ptr ()))
forall (s :: SuffixOrInterpreted).
Interp -> InterpSymbol s -> IO (Maybe (Ptr ()))
lookupSymbol Interp
interp (FastString -> InterpSymbol 'Interpreted
IFaststringSymbol FastString
addr_of_label_string)
  case m of
    Just Ptr ()
ptr -> Ptr () -> IO (Ptr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
ptr
    Maybe (Ptr ())
Nothing  -> [Char] -> SDoc -> IO (Ptr ())
forall a. [Char] -> SDoc -> IO a
linkFail [Char]
"GHC.ByteCode.Linker: can't find label"
                  (FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
addr_of_label_string)

lookupIE :: Interp -> PkgsLoaded -> ItblEnv -> Name -> IO (Ptr ())
lookupIE :: Interp -> PkgsLoaded -> ItblEnv -> Name -> IO (Ptr ())
lookupIE Interp
interp PkgsLoaded
pkgs_loaded ItblEnv
ie Name
con_nm =
  case ItblEnv -> Name -> Maybe (Name, ItblPtr)
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv ItblEnv
ie Name
con_nm of
    Just (Name
_, ItblPtr RemotePtr StgInfoTable
a) -> Ptr () -> IO (Ptr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RemotePtr () -> Ptr ()
forall a. RemotePtr a -> Ptr a
fromRemotePtr (RemotePtr StgInfoTable -> RemotePtr ()
forall a b. RemotePtr a -> RemotePtr b
castRemotePtr RemotePtr StgInfoTable
a))
    Maybe (Name, ItblPtr)
Nothing -> do -- try looking up in the object files.
       let sym_to_find1 :: InterpSymbol ('Suffix "con_info")
sym_to_find1 = Name -> InterpSymbol ('Suffix "con_info")
IConInfoSymbol Name
con_nm
       m <- Interp
-> PkgsLoaded
-> InterpSymbol ('Suffix "con_info")
-> IO (Maybe (Ptr ()))
forall (s :: Symbol).
Interp
-> PkgsLoaded -> InterpSymbol ('Suffix s) -> IO (Maybe (Ptr ()))
lookupHsSymbol Interp
interp PkgsLoaded
pkgs_loaded InterpSymbol ('Suffix "con_info")
sym_to_find1
       case m of
          Just Ptr ()
addr -> Ptr () -> IO (Ptr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
addr
          Maybe (Ptr ())
Nothing
             -> do -- perhaps a nullary constructor?
                   let sym_to_find2 :: InterpSymbol ('Suffix "static_info")
sym_to_find2 = Name -> InterpSymbol ('Suffix "static_info")
IStaticInfoSymbol Name
con_nm
                   n <- Interp
-> PkgsLoaded
-> InterpSymbol ('Suffix "static_info")
-> IO (Maybe (Ptr ()))
forall (s :: Symbol).
Interp
-> PkgsLoaded -> InterpSymbol ('Suffix s) -> IO (Maybe (Ptr ()))
lookupHsSymbol Interp
interp PkgsLoaded
pkgs_loaded InterpSymbol ('Suffix "static_info")
sym_to_find2
                   case n of
                      Just Ptr ()
addr -> Ptr () -> IO (Ptr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
addr
                      Maybe (Ptr ())
Nothing   -> [Char] -> SDoc -> IO (Ptr ())
forall a. [Char] -> SDoc -> IO a
linkFail [Char]
"GHC.ByteCode.Linker.lookupIE"
                                      (InterpSymbol ('Suffix "con_info") -> SDoc
forall a. Outputable a => a -> SDoc
ppr InterpSymbol ('Suffix "con_info")
sym_to_find1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
" or " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
                                       InterpSymbol ('Suffix "static_info") -> SDoc
forall a. Outputable a => a -> SDoc
ppr InterpSymbol ('Suffix "static_info")
sym_to_find2)

-- see Note [Generating code for top-level string literal bindings] in GHC.StgToByteCode
lookupAddr :: Interp -> PkgsLoaded -> AddrEnv -> Name -> IO (Ptr ())
lookupAddr :: Interp -> PkgsLoaded -> AddrEnv -> Name -> IO (Ptr ())
lookupAddr Interp
interp PkgsLoaded
pkgs_loaded AddrEnv
ae Name
addr_nm = do
  case AddrEnv -> Name -> Maybe (Name, AddrPtr)
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv AddrEnv
ae Name
addr_nm of
    Just (Name
_, AddrPtr RemotePtr ()
ptr) -> Ptr () -> IO (Ptr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RemotePtr () -> Ptr ()
forall a. RemotePtr a -> Ptr a
fromRemotePtr RemotePtr ()
ptr)
    Maybe (Name, AddrPtr)
Nothing -> do -- try looking up in the object files.
      let sym_to_find :: InterpSymbol ('Suffix "bytes")
sym_to_find = Name -> InterpSymbol ('Suffix "bytes")
IBytesSymbol Name
addr_nm
                          -- see Note [Bytes label] in GHC.Cmm.CLabel
      m <- Interp
-> PkgsLoaded
-> InterpSymbol ('Suffix "bytes")
-> IO (Maybe (Ptr ()))
forall (s :: Symbol).
Interp
-> PkgsLoaded -> InterpSymbol ('Suffix s) -> IO (Maybe (Ptr ()))
lookupHsSymbol Interp
interp PkgsLoaded
pkgs_loaded InterpSymbol ('Suffix "bytes")
sym_to_find
      case m of
        Just Ptr ()
ptr -> Ptr () -> IO (Ptr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
ptr
        Maybe (Ptr ())
Nothing -> [Char] -> SDoc -> IO (Ptr ())
forall a. [Char] -> SDoc -> IO a
linkFail [Char]
"GHC.ByteCode.Linker.lookupAddr"
                     (InterpSymbol ('Suffix "bytes") -> SDoc
forall a. Outputable a => a -> SDoc
ppr InterpSymbol ('Suffix "bytes")
sym_to_find)

lookupPrimOp :: Interp -> PkgsLoaded -> PrimOp -> IO (RemotePtr ())
lookupPrimOp :: Interp -> PkgsLoaded -> PrimOp -> IO (RemotePtr ())
lookupPrimOp Interp
interp PkgsLoaded
pkgs_loaded PrimOp
primop = do
  let sym_to_find :: [Char]
sym_to_find = PrimOp -> [Char] -> [Char]
primopToCLabel PrimOp
primop [Char]
"closure"
  m <- Interp
-> PkgsLoaded
-> InterpSymbol ('Suffix "closure")
-> IO (Maybe (Ptr ()))
forall (s :: Symbol).
Interp
-> PkgsLoaded -> InterpSymbol ('Suffix s) -> IO (Maybe (Ptr ()))
lookupHsSymbol Interp
interp PkgsLoaded
pkgs_loaded (Name -> InterpSymbol ('Suffix "closure")
IClosureSymbol (Id -> Name
Id.idName (Id -> Name) -> Id -> Name
forall a b. (a -> b) -> a -> b
$ PrimOp -> Id
primOpId PrimOp
primop))
  case m of
    Just Ptr ()
p -> RemotePtr () -> IO (RemotePtr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr () -> RemotePtr ()
forall a. Ptr a -> RemotePtr a
toRemotePtr Ptr ()
p)
    Maybe (Ptr ())
Nothing -> [Char] -> SDoc -> IO (RemotePtr ())
forall a. [Char] -> SDoc -> IO a
linkFail [Char]
"GHC.ByteCode.Linker.lookupCE(primop)" ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
sym_to_find)

resolvePtr
  :: Interp
  -> PkgsLoaded
  -> LinkerEnv
  -> NameEnv Int
  -> BCOPtr
  -> IO ResolvedBCOPtr
resolvePtr :: Interp
-> PkgsLoaded
-> LinkerEnv
-> NameEnv Int
-> BCOPtr
-> IO ResolvedBCOPtr
resolvePtr Interp
interp PkgsLoaded
pkgs_loaded LinkerEnv
le NameEnv Int
bco_ix BCOPtr
ptr = case BCOPtr
ptr of
  BCOPtrName Name
nm
    | Just Int
ix <- NameEnv Int -> Name -> Maybe Int
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv NameEnv Int
bco_ix Name
nm
    -> ResolvedBCOPtr -> IO ResolvedBCOPtr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ResolvedBCOPtr
ResolvedBCORef Int
ix) -- ref to another BCO in this group

    | Just (Name
_, ForeignHValue
rhv) <- NameEnv (Name, ForeignHValue)
-> Name -> Maybe (Name, ForeignHValue)
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv (LinkerEnv -> NameEnv (Name, ForeignHValue)
closure_env LinkerEnv
le) Name
nm
    -> ResolvedBCOPtr -> IO ResolvedBCOPtr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RemoteRef HValue -> ResolvedBCOPtr
ResolvedBCOPtr (ForeignHValue -> RemoteRef HValue
forall a. ForeignRef a -> RemoteRef a
unsafeForeignRefToRemoteRef ForeignHValue
rhv))

    | Bool
otherwise
    -> Bool -> SDoc -> IO ResolvedBCOPtr -> IO ResolvedBCOPtr
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Name -> Bool
isExternalName Name
nm) (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nm) (IO ResolvedBCOPtr -> IO ResolvedBCOPtr)
-> IO ResolvedBCOPtr -> IO ResolvedBCOPtr
forall a b. (a -> b) -> a -> b
$
       do
          let sym_to_find :: InterpSymbol ('Suffix "closure")
sym_to_find = Name -> InterpSymbol ('Suffix "closure")
IClosureSymbol Name
nm
          m <- Interp
-> PkgsLoaded
-> InterpSymbol ('Suffix "closure")
-> IO (Maybe (Ptr ()))
forall (s :: Symbol).
Interp
-> PkgsLoaded -> InterpSymbol ('Suffix s) -> IO (Maybe (Ptr ()))
lookupHsSymbol Interp
interp PkgsLoaded
pkgs_loaded InterpSymbol ('Suffix "closure")
sym_to_find
          case m of
            Just Ptr ()
p -> ResolvedBCOPtr -> IO ResolvedBCOPtr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RemotePtr () -> ResolvedBCOPtr
ResolvedBCOStaticPtr (Ptr () -> RemotePtr ()
forall a. Ptr a -> RemotePtr a
toRemotePtr Ptr ()
p))
            Maybe (Ptr ())
Nothing -> [Char] -> SDoc -> IO ResolvedBCOPtr
forall a. [Char] -> SDoc -> IO a
linkFail [Char]
"GHC.ByteCode.Linker.lookupCE" (InterpSymbol ('Suffix "closure") -> SDoc
forall a. Outputable a => a -> SDoc
ppr InterpSymbol ('Suffix "closure")
sym_to_find)

  BCOPtrPrimOp PrimOp
op
    -> RemotePtr () -> ResolvedBCOPtr
ResolvedBCOStaticPtr (RemotePtr () -> ResolvedBCOPtr)
-> IO (RemotePtr ()) -> IO ResolvedBCOPtr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Interp -> PkgsLoaded -> PrimOp -> IO (RemotePtr ())
lookupPrimOp Interp
interp PkgsLoaded
pkgs_loaded PrimOp
op

  BCOPtrBCO UnlinkedBCO
bco
    -> ResolvedBCO -> ResolvedBCOPtr
ResolvedBCOPtrBCO (ResolvedBCO -> ResolvedBCOPtr)
-> IO ResolvedBCO -> IO ResolvedBCOPtr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Interp
-> PkgsLoaded
-> LinkerEnv
-> NameEnv Int
-> UnlinkedBCO
-> IO ResolvedBCO
linkBCO Interp
interp PkgsLoaded
pkgs_loaded LinkerEnv
le NameEnv Int
bco_ix UnlinkedBCO
bco

  BCOPtrBreakArray ForeignRef BreakArray
breakarray
    -> ForeignRef BreakArray
-> (RemoteRef BreakArray -> IO ResolvedBCOPtr) -> IO ResolvedBCOPtr
forall a b. ForeignRef a -> (RemoteRef a -> IO b) -> IO b
withForeignRef ForeignRef BreakArray
breakarray ((RemoteRef BreakArray -> IO ResolvedBCOPtr) -> IO ResolvedBCOPtr)
-> (RemoteRef BreakArray -> IO ResolvedBCOPtr) -> IO ResolvedBCOPtr
forall a b. (a -> b) -> a -> b
$ \RemoteRef BreakArray
ba -> ResolvedBCOPtr -> IO ResolvedBCOPtr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RemoteRef BreakArray -> ResolvedBCOPtr
ResolvedBCOPtrBreakArray RemoteRef BreakArray
ba)

-- | Look up the address of a Haskell symbol in the currently
-- loaded units.
--
-- See Note [Looking up symbols in the relevant objects].
lookupHsSymbol :: Interp -> PkgsLoaded -> InterpSymbol (Suffix s) -> IO (Maybe (Ptr ()))
lookupHsSymbol :: forall (s :: Symbol).
Interp
-> PkgsLoaded -> InterpSymbol ('Suffix s) -> IO (Maybe (Ptr ()))
lookupHsSymbol Interp
interp PkgsLoaded
pkgs_loaded InterpSymbol ('Suffix s)
sym_to_find = do
  Bool -> SDoc -> IO ()
forall (m :: * -> *).
(HasCallStack, Applicative m) =>
Bool -> SDoc -> m ()
massertPpr (Name -> Bool
isExternalName (InterpSymbol ('Suffix s) -> Name
forall (s :: Symbol). InterpSymbol ('Suffix s) -> Name
interpSymbolName InterpSymbol ('Suffix s)
sym_to_find)) (InterpSymbol ('Suffix s) -> SDoc
forall a. Outputable a => a -> SDoc
ppr InterpSymbol ('Suffix s)
sym_to_find)
  let pkg_id :: UnitId
pkg_id = Module -> UnitId
moduleUnitId (Module -> UnitId) -> Module -> UnitId
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => Name -> Module
Name -> Module
nameModule (InterpSymbol ('Suffix s) -> Name
forall (s :: Symbol). InterpSymbol ('Suffix s) -> Name
interpSymbolName InterpSymbol ('Suffix s)
sym_to_find)
      loaded_dlls :: [RemotePtr LoadedDLL]
loaded_dlls = [RemotePtr LoadedDLL]
-> (LoadedPkgInfo -> [RemotePtr LoadedDLL])
-> Maybe LoadedPkgInfo
-> [RemotePtr LoadedDLL]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] LoadedPkgInfo -> [RemotePtr LoadedDLL]
loaded_pkg_hs_dlls (Maybe LoadedPkgInfo -> [RemotePtr LoadedDLL])
-> Maybe LoadedPkgInfo -> [RemotePtr LoadedDLL]
forall a b. (a -> b) -> a -> b
$ PkgsLoaded -> UnitId -> Maybe LoadedPkgInfo
forall key elt.
Uniquable key =>
UniqDFM key elt -> key -> Maybe elt
lookupUDFM PkgsLoaded
pkgs_loaded UnitId
pkg_id

      go :: [RemotePtr LoadedDLL] -> IO (Maybe (Ptr ()))
go (RemotePtr LoadedDLL
dll:[RemotePtr LoadedDLL]
dlls) = do
        mb_ptr <- Interp
-> RemotePtr LoadedDLL
-> InterpSymbol ('Suffix s)
-> IO (Maybe (Ptr ()))
forall (s :: SuffixOrInterpreted).
Interp
-> RemotePtr LoadedDLL -> InterpSymbol s -> IO (Maybe (Ptr ()))
lookupSymbolInDLL Interp
interp RemotePtr LoadedDLL
dll InterpSymbol ('Suffix s)
sym_to_find
        case mb_ptr of
          Just Ptr ()
ptr -> Maybe (Ptr ()) -> IO (Maybe (Ptr ()))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr () -> Maybe (Ptr ())
forall a. a -> Maybe a
Just Ptr ()
ptr)
          Maybe (Ptr ())
Nothing -> [RemotePtr LoadedDLL] -> IO (Maybe (Ptr ()))
go [RemotePtr LoadedDLL]
dlls
      go [] =
        -- See Note [Symbols may not be found in pkgs_loaded] in GHC.Linker.Types
        Interp -> InterpSymbol ('Suffix s) -> IO (Maybe (Ptr ()))
forall (s :: SuffixOrInterpreted).
Interp -> InterpSymbol s -> IO (Maybe (Ptr ()))
lookupSymbol Interp
interp InterpSymbol ('Suffix s)
sym_to_find

  [RemotePtr LoadedDLL] -> IO (Maybe (Ptr ()))
go [RemotePtr LoadedDLL]
loaded_dlls

linkFail :: String -> SDoc -> IO a
linkFail :: forall a. [Char] -> SDoc -> IO a
linkFail [Char]
who SDoc
what
   = GhcException -> IO a
forall a. GhcException -> IO a
throwGhcExceptionIO ([Char] -> GhcException
ProgramError ([Char] -> GhcException) -> [Char] -> GhcException
forall a b. (a -> b) -> a -> b
$
        [[Char]] -> [Char]
unlines [ [Char]
"",[Char]
who
                , [Char]
"During interactive linking, GHCi couldn't find the following symbol:"
                , Char
' ' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
' ' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: SDoc -> [Char]
showSDocUnsafe SDoc
what
                , [Char]
"This may be due to you not asking GHCi to load extra object files,"
                , [Char]
"archives or DLLs needed by your current session.  Restart GHCi, specifying"
                , [Char]
"the missing library using the -L/path/to/object/dir and -lmissinglibname"
                , [Char]
"flags, or simply by naming the relevant files on the GHCi command line."
                , [Char]
"Alternatively, this link failure might indicate a bug in GHCi."
                , [Char]
"If you suspect the latter, please report this as a GHC bug:"
                , [Char]
"  https://www.haskell.org/ghc/reportabug"
                ])






-- See Note [Primop wrappers] in GHC.Builtin.PrimOps
primopToCLabel :: PrimOp -> String -> String
primopToCLabel :: PrimOp -> [Char] -> [Char]
primopToCLabel PrimOp
primop [Char]
suffix = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [Char]
"ghczminternal_GHCziInternalziPrimopWrappers_"
    , FastZString -> [Char]
zString (FastString -> FastZString
zEncodeFS (OccName -> FastString
occNameFS (PrimOp -> OccName
primOpOcc PrimOp
primop)))
    , Char
'_'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
suffix
    ]