{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module GHC.Runtime.Interpreter
( module GHC.Runtime.Interpreter.Types
, BCOOpts (..)
, evalStmt, EvalStatus_(..), EvalStatus, EvalResult(..), EvalExpr(..)
, resumeStmt
, abandonStmt
, evalIO
, evalString
, evalStringToIOString
, mallocData
, createBCOs
, addSptEntry
, mkCostCentres
, costCentreStackInfo
, newBreakArray
, storeBreakpoint
, breakpointStatus
, getBreakpointVar
, getClosure
, getModBreaks
, seqHValue
, interpreterDynamic
, interpreterProfiled
, initObjLinker
, lookupSymbol
, lookupClosure
, loadDLL
, loadArchive
, loadObj
, unloadObj
, addLibrarySearchPath
, removeLibrarySearchPath
, resolveObjs
, findSystemLibrary
, interpCmd, Message(..), withIServ, withIServ_
, stopInterp
, iservCall, readIServ, writeIServ
, purgeLookupSymbolCache
, freeHValueRefs
, mkFinalizedHValue
, wormhole, wormholeRef
, fromEvalResult
) where
import GHC.Prelude
import GHC.IO (catchException)
import GHC.Runtime.Interpreter.Types
import GHCi.Message
import GHCi.RemoteTypes
import GHCi.ResolvedBCO
import GHCi.BreakArray (BreakArray)
import GHC.Types.BreakInfo (BreakInfo(..))
import GHC.ByteCode.Types
import GHC.Linker.Types
import GHC.Data.Maybe
import GHC.Data.FastString
import GHC.Types.Unique
import GHC.Types.SrcLoc
import GHC.Types.Unique.FM
import GHC.Types.Basic
import GHC.Utils.Panic
import GHC.Utils.Exception as Ex
import GHC.Utils.Outputable(brackets, ppr, showSDocUnsafe)
import GHC.Utils.Fingerprint
import GHC.Utils.Misc
import GHC.Unit.Module
import GHC.Unit.Module.ModIface
import GHC.Unit.Home.ModInfo
import GHC.Unit.Env
#if defined(HAVE_INTERNAL_INTERPRETER)
import GHCi.Run
import GHC.Platform.Ways
#endif
import Control.Concurrent
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Catch as MC (mask, onException)
import Data.Binary
import Data.Binary.Put
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LB
import Data.Array ((!))
import Data.IORef
import Foreign hiding (void)
import qualified GHC.Exts.Heap as Heap
import GHC.Stack.CCS (CostCentre,CostCentreStack)
import System.Exit
import GHC.IO.Handle.Types (Handle)
#if defined(mingw32_HOST_OS)
import Foreign.C
import GHC.IO.Handle.FD (fdToHandle)
# if defined(__IO_MANAGER_WINIO__)
import GHC.IO.SubSystem ((<!>))
import GHC.IO.Handle.Windows (handleToHANDLE)
import GHC.Event.Windows (associateHandle')
# endif
#else
import System.Posix as Posix
#endif
import System.Directory
import System.Process
import GHC.Conc (pseq, par)
interpCmd :: Binary a => Interp -> Message a -> IO a
interpCmd :: forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp Message a
msg = case Interp -> InterpInstance
interpInstance Interp
interp of
#if defined(HAVE_INTERNAL_INTERPRETER)
InterpInstance
InternalInterp -> Message a -> IO a
forall a. Message a -> IO a
run Message a
msg
#endif
ExternalInterp IServConfig
c IServ
i -> IServConfig -> IServ -> (IServInstance -> IO a) -> IO a
forall (m :: * -> *) a.
(MonadIO m, ExceptionMonad m) =>
IServConfig -> IServ -> (IServInstance -> m a) -> m a
withIServ_ IServConfig
c IServ
i ((IServInstance -> IO a) -> IO a)
-> (IServInstance -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \IServInstance
iserv ->
IO a -> IO a
forall a. IO a -> IO a
uninterruptibleMask_ (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$
IServInstance -> Message a -> IO a
forall a. Binary a => IServInstance -> Message a -> IO a
iservCall IServInstance
iserv Message a
msg
withIServ
:: (ExceptionMonad m)
=> IServConfig -> IServ -> (IServInstance -> m (IServInstance, a)) -> m a
withIServ :: forall (m :: * -> *) a.
ExceptionMonad m =>
IServConfig
-> IServ -> (IServInstance -> m (IServInstance, a)) -> m a
withIServ IServConfig
conf (IServ MVar IServState
mIServState) IServInstance -> m (IServInstance, a)
action =
((forall a. m a -> m a) -> m a) -> m a
forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
MC.mask (((forall a. m a -> m a) -> m a) -> m a)
-> ((forall a. m a -> m a) -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore -> do
IServState
state <- IO IServState -> m IServState
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IServState -> m IServState) -> IO IServState -> m IServState
forall a b. (a -> b) -> a -> b
$ MVar IServState -> IO IServState
forall a. MVar a -> IO a
takeMVar MVar IServState
mIServState
IServInstance
iserv <- case IServState
state of
IServState
IServPending ->
IO IServInstance -> m IServInstance
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IServConfig -> IO IServInstance
spawnIServ IServConfig
conf)
m IServInstance -> m () -> m IServInstance
forall (m :: * -> *) a b.
(HasCallStack, MonadCatch m) =>
m a -> m b -> m a
`MC.onException` (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MVar IServState -> IServState -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar IServState
mIServState IServState
state)
IServRunning IServInstance
inst -> IServInstance -> m IServInstance
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return IServInstance
inst
let iserv' :: IServInstance
iserv' = IServInstance
iserv{ iservPendingFrees = [] }
(IServInstance
iserv'',a
a) <- (do
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([HValueRef] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (IServInstance -> [HValueRef]
iservPendingFrees IServInstance
iserv))) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IServInstance -> Message () -> IO ()
forall a. Binary a => IServInstance -> Message a -> IO a
iservCall IServInstance
iserv ([HValueRef] -> Message ()
FreeHValueRefs (IServInstance -> [HValueRef]
iservPendingFrees IServInstance
iserv))
m (IServInstance, a) -> m (IServInstance, a)
forall a. m a -> m a
restore (m (IServInstance, a) -> m (IServInstance, a))
-> m (IServInstance, a) -> m (IServInstance, a)
forall a b. (a -> b) -> a -> b
$ IServInstance -> m (IServInstance, a)
action IServInstance
iserv')
m (IServInstance, a) -> m () -> m (IServInstance, a)
forall (m :: * -> *) a b.
(HasCallStack, MonadCatch m) =>
m a -> m b -> m a
`MC.onException` (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MVar IServState -> IServState -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar IServState
mIServState (IServInstance -> IServState
IServRunning IServInstance
iserv'))
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MVar IServState -> IServState -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar IServState
mIServState (IServInstance -> IServState
IServRunning IServInstance
iserv'')
a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
withIServ_
:: (MonadIO m, ExceptionMonad m)
=> IServConfig -> IServ -> (IServInstance -> m a) -> m a
withIServ_ :: forall (m :: * -> *) a.
(MonadIO m, ExceptionMonad m) =>
IServConfig -> IServ -> (IServInstance -> m a) -> m a
withIServ_ IServConfig
conf IServ
iserv IServInstance -> m a
action = IServConfig
-> IServ -> (IServInstance -> m (IServInstance, a)) -> m a
forall (m :: * -> *) a.
ExceptionMonad m =>
IServConfig
-> IServ -> (IServInstance -> m (IServInstance, a)) -> m a
withIServ IServConfig
conf IServ
iserv ((IServInstance -> m (IServInstance, a)) -> m a)
-> (IServInstance -> m (IServInstance, a)) -> m a
forall a b. (a -> b) -> a -> b
$ \IServInstance
inst ->
(IServInstance
inst,) (a -> (IServInstance, a)) -> m a -> m (IServInstance, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IServInstance -> m a
action IServInstance
inst
evalStmt
:: Interp
-> EvalOpts
-> EvalExpr ForeignHValue
-> IO (EvalStatus_ [ForeignHValue] [HValueRef])
evalStmt :: Interp
-> EvalOpts
-> EvalExpr ForeignHValue
-> IO (EvalStatus_ [ForeignHValue] [HValueRef])
evalStmt Interp
interp EvalOpts
opts EvalExpr ForeignHValue
foreign_expr = do
EvalStatus_ [HValueRef] [HValueRef]
status <- EvalExpr ForeignHValue
-> (EvalExpr HValueRef -> IO (EvalStatus_ [HValueRef] [HValueRef]))
-> IO (EvalStatus_ [HValueRef] [HValueRef])
forall a.
EvalExpr ForeignHValue -> (EvalExpr HValueRef -> IO a) -> IO a
withExpr EvalExpr ForeignHValue
foreign_expr ((EvalExpr HValueRef -> IO (EvalStatus_ [HValueRef] [HValueRef]))
-> IO (EvalStatus_ [HValueRef] [HValueRef]))
-> (EvalExpr HValueRef -> IO (EvalStatus_ [HValueRef] [HValueRef]))
-> IO (EvalStatus_ [HValueRef] [HValueRef])
forall a b. (a -> b) -> a -> b
$ \EvalExpr HValueRef
expr ->
Interp
-> Message (EvalStatus_ [HValueRef] [HValueRef])
-> IO (EvalStatus_ [HValueRef] [HValueRef])
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp (EvalOpts
-> EvalExpr HValueRef
-> Message (EvalStatus_ [HValueRef] [HValueRef])
EvalStmt EvalOpts
opts EvalExpr HValueRef
expr)
Interp
-> EvalStatus_ [HValueRef] [HValueRef]
-> IO (EvalStatus_ [ForeignHValue] [HValueRef])
handleEvalStatus Interp
interp EvalStatus_ [HValueRef] [HValueRef]
status
where
withExpr :: EvalExpr ForeignHValue -> (EvalExpr HValueRef -> IO a) -> IO a
withExpr :: forall a.
EvalExpr ForeignHValue -> (EvalExpr HValueRef -> IO a) -> IO a
withExpr (EvalThis ForeignHValue
fhv) EvalExpr HValueRef -> IO a
cont =
ForeignHValue -> (HValueRef -> IO a) -> IO a
forall a b. ForeignRef a -> (RemoteRef a -> IO b) -> IO b
withForeignRef ForeignHValue
fhv ((HValueRef -> IO a) -> IO a) -> (HValueRef -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \HValueRef
hvref -> EvalExpr HValueRef -> IO a
cont (HValueRef -> EvalExpr HValueRef
forall a. a -> EvalExpr a
EvalThis HValueRef
hvref)
withExpr (EvalApp EvalExpr ForeignHValue
fl EvalExpr ForeignHValue
fr) EvalExpr HValueRef -> IO a
cont =
EvalExpr ForeignHValue -> (EvalExpr HValueRef -> IO a) -> IO a
forall a.
EvalExpr ForeignHValue -> (EvalExpr HValueRef -> IO a) -> IO a
withExpr EvalExpr ForeignHValue
fl ((EvalExpr HValueRef -> IO a) -> IO a)
-> (EvalExpr HValueRef -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \EvalExpr HValueRef
fl' ->
EvalExpr ForeignHValue -> (EvalExpr HValueRef -> IO a) -> IO a
forall a.
EvalExpr ForeignHValue -> (EvalExpr HValueRef -> IO a) -> IO a
withExpr EvalExpr ForeignHValue
fr ((EvalExpr HValueRef -> IO a) -> IO a)
-> (EvalExpr HValueRef -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \EvalExpr HValueRef
fr' ->
EvalExpr HValueRef -> IO a
cont (EvalExpr HValueRef -> EvalExpr HValueRef -> EvalExpr HValueRef
forall a. EvalExpr a -> EvalExpr a -> EvalExpr a
EvalApp EvalExpr HValueRef
fl' EvalExpr HValueRef
fr')
resumeStmt
:: Interp
-> EvalOpts
-> ForeignRef (ResumeContext [HValueRef])
-> IO (EvalStatus_ [ForeignHValue] [HValueRef])
resumeStmt :: Interp
-> EvalOpts
-> ForeignRef (ResumeContext [HValueRef])
-> IO (EvalStatus_ [ForeignHValue] [HValueRef])
resumeStmt Interp
interp EvalOpts
opts ForeignRef (ResumeContext [HValueRef])
resume_ctxt = do
EvalStatus_ [HValueRef] [HValueRef]
status <- ForeignRef (ResumeContext [HValueRef])
-> (RemoteRef (ResumeContext [HValueRef])
-> IO (EvalStatus_ [HValueRef] [HValueRef]))
-> IO (EvalStatus_ [HValueRef] [HValueRef])
forall a b. ForeignRef a -> (RemoteRef a -> IO b) -> IO b
withForeignRef ForeignRef (ResumeContext [HValueRef])
resume_ctxt ((RemoteRef (ResumeContext [HValueRef])
-> IO (EvalStatus_ [HValueRef] [HValueRef]))
-> IO (EvalStatus_ [HValueRef] [HValueRef]))
-> (RemoteRef (ResumeContext [HValueRef])
-> IO (EvalStatus_ [HValueRef] [HValueRef]))
-> IO (EvalStatus_ [HValueRef] [HValueRef])
forall a b. (a -> b) -> a -> b
$ \RemoteRef (ResumeContext [HValueRef])
rhv ->
Interp
-> Message (EvalStatus_ [HValueRef] [HValueRef])
-> IO (EvalStatus_ [HValueRef] [HValueRef])
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp (EvalOpts
-> RemoteRef (ResumeContext [HValueRef])
-> Message (EvalStatus_ [HValueRef] [HValueRef])
ResumeStmt EvalOpts
opts RemoteRef (ResumeContext [HValueRef])
rhv)
Interp
-> EvalStatus_ [HValueRef] [HValueRef]
-> IO (EvalStatus_ [ForeignHValue] [HValueRef])
handleEvalStatus Interp
interp EvalStatus_ [HValueRef] [HValueRef]
status
abandonStmt :: Interp -> ForeignRef (ResumeContext [HValueRef]) -> IO ()
abandonStmt :: Interp -> ForeignRef (ResumeContext [HValueRef]) -> IO ()
abandonStmt Interp
interp ForeignRef (ResumeContext [HValueRef])
resume_ctxt =
ForeignRef (ResumeContext [HValueRef])
-> (RemoteRef (ResumeContext [HValueRef]) -> IO ()) -> IO ()
forall a b. ForeignRef a -> (RemoteRef a -> IO b) -> IO b
withForeignRef ForeignRef (ResumeContext [HValueRef])
resume_ctxt ((RemoteRef (ResumeContext [HValueRef]) -> IO ()) -> IO ())
-> (RemoteRef (ResumeContext [HValueRef]) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \RemoteRef (ResumeContext [HValueRef])
rhv ->
Interp -> Message () -> IO ()
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp (RemoteRef (ResumeContext [HValueRef]) -> Message ()
AbandonStmt RemoteRef (ResumeContext [HValueRef])
rhv)
handleEvalStatus
:: Interp
-> EvalStatus [HValueRef]
-> IO (EvalStatus_ [ForeignHValue] [HValueRef])
handleEvalStatus :: Interp
-> EvalStatus_ [HValueRef] [HValueRef]
-> IO (EvalStatus_ [ForeignHValue] [HValueRef])
handleEvalStatus Interp
interp EvalStatus_ [HValueRef] [HValueRef]
status =
case EvalStatus_ [HValueRef] [HValueRef]
status of
EvalBreak Bool
a HValueRef
b Int
c Int
d RemoteRef (ResumeContext [HValueRef])
e RemotePtr CostCentreStack
f -> EvalStatus_ [ForeignHValue] [HValueRef]
-> IO (EvalStatus_ [ForeignHValue] [HValueRef])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
-> HValueRef
-> Int
-> Int
-> RemoteRef (ResumeContext [HValueRef])
-> RemotePtr CostCentreStack
-> EvalStatus_ [ForeignHValue] [HValueRef]
forall a b.
Bool
-> HValueRef
-> Int
-> Int
-> RemoteRef (ResumeContext b)
-> RemotePtr CostCentreStack
-> EvalStatus_ a b
EvalBreak Bool
a HValueRef
b Int
c Int
d RemoteRef (ResumeContext [HValueRef])
e RemotePtr CostCentreStack
f)
EvalComplete Word64
alloc EvalResult [HValueRef]
res ->
Word64
-> EvalResult [ForeignHValue]
-> EvalStatus_ [ForeignHValue] [HValueRef]
forall a b. Word64 -> EvalResult a -> EvalStatus_ a b
EvalComplete Word64
alloc (EvalResult [ForeignHValue]
-> EvalStatus_ [ForeignHValue] [HValueRef])
-> IO (EvalResult [ForeignHValue])
-> IO (EvalStatus_ [ForeignHValue] [HValueRef])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EvalResult [HValueRef] -> IO (EvalResult [ForeignHValue])
addFinalizer EvalResult [HValueRef]
res
where
addFinalizer :: EvalResult [HValueRef] -> IO (EvalResult [ForeignHValue])
addFinalizer (EvalException SerializableException
e) = EvalResult [ForeignHValue] -> IO (EvalResult [ForeignHValue])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SerializableException -> EvalResult [ForeignHValue]
forall a. SerializableException -> EvalResult a
EvalException SerializableException
e)
addFinalizer (EvalSuccess [HValueRef]
rs) =
[ForeignHValue] -> EvalResult [ForeignHValue]
forall a. a -> EvalResult a
EvalSuccess ([ForeignHValue] -> EvalResult [ForeignHValue])
-> IO [ForeignHValue] -> IO (EvalResult [ForeignHValue])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HValueRef -> IO ForeignHValue)
-> [HValueRef] -> IO [ForeignHValue]
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 (Interp -> HValueRef -> IO ForeignHValue
forall a. Interp -> RemoteRef a -> IO (ForeignRef a)
mkFinalizedHValue Interp
interp) [HValueRef]
rs
evalIO :: Interp -> ForeignHValue -> IO ()
evalIO :: Interp -> ForeignHValue -> IO ()
evalIO Interp
interp ForeignHValue
fhv =
IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ForeignHValue -> (HValueRef -> IO ()) -> IO ()
forall a b. ForeignRef a -> (RemoteRef a -> IO b) -> IO b
withForeignRef ForeignHValue
fhv ((HValueRef -> IO ()) -> IO ()) -> (HValueRef -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HValueRef
fhv ->
Interp -> Message (EvalResult ()) -> IO (EvalResult ())
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp (HValueRef -> Message (EvalResult ())
EvalIO HValueRef
fhv) IO (EvalResult ()) -> (EvalResult () -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EvalResult () -> IO ()
forall a. EvalResult a -> IO a
fromEvalResult
evalString :: Interp -> ForeignHValue -> IO String
evalString :: Interp -> ForeignHValue -> IO String
evalString Interp
interp ForeignHValue
fhv =
IO String -> IO String
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> IO String) -> IO String -> IO String
forall a b. (a -> b) -> a -> b
$ ForeignHValue -> (HValueRef -> IO String) -> IO String
forall a b. ForeignRef a -> (RemoteRef a -> IO b) -> IO b
withForeignRef ForeignHValue
fhv ((HValueRef -> IO String) -> IO String)
-> (HValueRef -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \HValueRef
fhv ->
Interp -> Message (EvalResult String) -> IO (EvalResult String)
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp (HValueRef -> Message (EvalResult String)
EvalString HValueRef
fhv) IO (EvalResult String)
-> (EvalResult String -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EvalResult String -> IO String
forall a. EvalResult a -> IO a
fromEvalResult
evalStringToIOString :: Interp -> ForeignHValue -> String -> IO String
evalStringToIOString :: Interp -> ForeignHValue -> String -> IO String
evalStringToIOString Interp
interp ForeignHValue
fhv String
str =
IO String -> IO String
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> IO String) -> IO String -> IO String
forall a b. (a -> b) -> a -> b
$ ForeignHValue -> (HValueRef -> IO String) -> IO String
forall a b. ForeignRef a -> (RemoteRef a -> IO b) -> IO b
withForeignRef ForeignHValue
fhv ((HValueRef -> IO String) -> IO String)
-> (HValueRef -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \HValueRef
fhv ->
Interp -> Message (EvalResult String) -> IO (EvalResult String)
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp (HValueRef -> String -> Message (EvalResult String)
EvalStringToString HValueRef
fhv String
str) IO (EvalResult String)
-> (EvalResult String -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EvalResult String -> IO String
forall a. EvalResult a -> IO a
fromEvalResult
mallocData :: Interp -> ByteString -> IO (RemotePtr ())
mallocData :: Interp -> ByteString -> IO (RemotePtr ())
mallocData Interp
interp ByteString
bs = Interp -> Message (RemotePtr ()) -> IO (RemotePtr ())
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp (ByteString -> Message (RemotePtr ())
MallocData ByteString
bs)
mkCostCentres :: Interp -> String -> [(String,String)] -> IO [RemotePtr CostCentre]
mkCostCentres :: Interp -> String -> [(String, String)] -> IO [RemotePtr CostCentre]
mkCostCentres Interp
interp String
mod [(String, String)]
ccs =
Interp
-> Message [RemotePtr CostCentre] -> IO [RemotePtr CostCentre]
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp (String -> [(String, String)] -> Message [RemotePtr CostCentre]
MkCostCentres String
mod [(String, String)]
ccs)
newtype BCOOpts = BCOOpts
{ BCOOpts -> Int
bco_n_jobs :: Int
}
createBCOs :: Interp -> BCOOpts -> [ResolvedBCO] -> IO [HValueRef]
createBCOs :: Interp -> BCOOpts -> [ResolvedBCO] -> IO [HValueRef]
createBCOs Interp
interp BCOOpts
opts [ResolvedBCO]
rbcos = do
let n_jobs :: Int
n_jobs = BCOOpts -> Int
bco_n_jobs BCOOpts
opts
if (Int
n_jobs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1)
then
Interp -> Message [HValueRef] -> IO [HValueRef]
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp ([ByteString] -> Message [HValueRef]
CreateBCOs [Put -> ByteString
runPut ([ResolvedBCO] -> Put
forall t. Binary t => t -> Put
put [ResolvedBCO]
rbcos)])
else do
Int
old_caps <- IO Int
getNumCapabilities
if Int
old_caps Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n_jobs
then IO [ByteString] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [ByteString] -> IO ()) -> IO [ByteString] -> IO ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> IO [ByteString]
forall a. a -> IO a
evaluate [ByteString]
puts
else IO () -> IO () -> IO () -> IO ()
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (Int -> IO ()
setNumCapabilities Int
n_jobs)
(Int -> IO ()
setNumCapabilities Int
old_caps)
(IO [ByteString] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [ByteString] -> IO ()) -> IO [ByteString] -> IO ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> IO [ByteString]
forall a. a -> IO a
evaluate [ByteString]
puts)
Interp -> Message [HValueRef] -> IO [HValueRef]
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp ([ByteString] -> Message [HValueRef]
CreateBCOs [ByteString]
puts)
where
puts :: [ByteString]
puts = ([ResolvedBCO] -> ByteString) -> [[ResolvedBCO]] -> [ByteString]
forall {t} {a}. (t -> a) -> [t] -> [a]
parMap [ResolvedBCO] -> ByteString
forall {t}. Binary t => t -> ByteString
doChunk (Int -> [ResolvedBCO] -> [[ResolvedBCO]]
forall a. Int -> [a] -> [[a]]
chunkList Int
100 [ResolvedBCO]
rbcos)
doChunk :: t -> ByteString
doChunk t
c = Int64 -> ByteString -> ByteString
forall a b. a -> b -> b
pseq (ByteString -> Int64
LB.length ByteString
bs) ByteString
bs
where bs :: ByteString
bs = Put -> ByteString
runPut (t -> Put
forall t. Binary t => t -> Put
put t
c)
parMap :: (t -> a) -> [t] -> [a]
parMap t -> a
_ [] = []
parMap t -> a
f (t
x:[t]
xs) = a
fx a -> [a] -> [a]
forall a b. a -> b -> b
`par` ([a]
fxs [a] -> [a] -> [a]
forall a b. a -> b -> b
`pseq` (a
fx a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
fxs))
where fx :: a
fx = t -> a
f t
x; fxs :: [a]
fxs = (t -> a) -> [t] -> [a]
parMap t -> a
f [t]
xs
addSptEntry :: Interp -> Fingerprint -> ForeignHValue -> IO ()
addSptEntry :: Interp -> Fingerprint -> ForeignHValue -> IO ()
addSptEntry Interp
interp Fingerprint
fpr ForeignHValue
ref =
ForeignHValue -> (HValueRef -> IO ()) -> IO ()
forall a b. ForeignRef a -> (RemoteRef a -> IO b) -> IO b
withForeignRef ForeignHValue
ref ((HValueRef -> IO ()) -> IO ()) -> (HValueRef -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HValueRef
val ->
Interp -> Message () -> IO ()
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp (Fingerprint -> HValueRef -> Message ()
AddSptEntry Fingerprint
fpr HValueRef
val)
costCentreStackInfo :: Interp -> RemotePtr CostCentreStack -> IO [String]
costCentreStackInfo :: Interp -> RemotePtr CostCentreStack -> IO [String]
costCentreStackInfo Interp
interp RemotePtr CostCentreStack
ccs =
Interp -> Message [String] -> IO [String]
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp (RemotePtr CostCentreStack -> Message [String]
CostCentreStackInfo RemotePtr CostCentreStack
ccs)
newBreakArray :: Interp -> Int -> IO (ForeignRef BreakArray)
newBreakArray :: Interp -> Int -> IO (ForeignRef BreakArray)
newBreakArray Interp
interp Int
size = do
RemoteRef BreakArray
breakArray <- Interp
-> Message (RemoteRef BreakArray) -> IO (RemoteRef BreakArray)
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp (Int -> Message (RemoteRef BreakArray)
NewBreakArray Int
size)
Interp -> RemoteRef BreakArray -> IO (ForeignRef BreakArray)
forall a. Interp -> RemoteRef a -> IO (ForeignRef a)
mkFinalizedHValue Interp
interp RemoteRef BreakArray
breakArray
storeBreakpoint :: Interp -> ForeignRef BreakArray -> Int -> Int -> IO ()
storeBreakpoint :: Interp -> ForeignRef BreakArray -> Int -> Int -> IO ()
storeBreakpoint Interp
interp ForeignRef BreakArray
ref Int
ix Int
cnt = do
ForeignRef BreakArray -> (RemoteRef BreakArray -> IO ()) -> IO ()
forall a b. ForeignRef a -> (RemoteRef a -> IO b) -> IO b
withForeignRef ForeignRef BreakArray
ref ((RemoteRef BreakArray -> IO ()) -> IO ())
-> (RemoteRef BreakArray -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \RemoteRef BreakArray
breakarray ->
Interp -> Message () -> IO ()
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp (RemoteRef BreakArray -> Int -> Int -> Message ()
SetupBreakpoint RemoteRef BreakArray
breakarray Int
ix Int
cnt)
breakpointStatus :: Interp -> ForeignRef BreakArray -> Int -> IO Bool
breakpointStatus :: Interp -> ForeignRef BreakArray -> Int -> IO Bool
breakpointStatus Interp
interp ForeignRef BreakArray
ref Int
ix =
ForeignRef BreakArray
-> (RemoteRef BreakArray -> IO Bool) -> IO Bool
forall a b. ForeignRef a -> (RemoteRef a -> IO b) -> IO b
withForeignRef ForeignRef BreakArray
ref ((RemoteRef BreakArray -> IO Bool) -> IO Bool)
-> (RemoteRef BreakArray -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \RemoteRef BreakArray
breakarray ->
Interp -> Message Bool -> IO Bool
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp (RemoteRef BreakArray -> Int -> Message Bool
BreakpointStatus RemoteRef BreakArray
breakarray Int
ix)
getBreakpointVar :: Interp -> ForeignHValue -> Int -> IO (Maybe ForeignHValue)
getBreakpointVar :: Interp -> ForeignHValue -> Int -> IO (Maybe ForeignHValue)
getBreakpointVar Interp
interp ForeignHValue
ref Int
ix =
ForeignHValue
-> (HValueRef -> IO (Maybe ForeignHValue))
-> IO (Maybe ForeignHValue)
forall a b. ForeignRef a -> (RemoteRef a -> IO b) -> IO b
withForeignRef ForeignHValue
ref ((HValueRef -> IO (Maybe ForeignHValue))
-> IO (Maybe ForeignHValue))
-> (HValueRef -> IO (Maybe ForeignHValue))
-> IO (Maybe ForeignHValue)
forall a b. (a -> b) -> a -> b
$ \HValueRef
apStack -> do
Maybe HValueRef
mb <- Interp -> Message (Maybe HValueRef) -> IO (Maybe HValueRef)
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp (HValueRef -> Int -> Message (Maybe HValueRef)
GetBreakpointVar HValueRef
apStack Int
ix)
(HValueRef -> IO ForeignHValue)
-> Maybe HValueRef -> IO (Maybe ForeignHValue)
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) -> Maybe a -> m (Maybe b)
mapM (Interp -> HValueRef -> IO ForeignHValue
forall a. Interp -> RemoteRef a -> IO (ForeignRef a)
mkFinalizedHValue Interp
interp) Maybe HValueRef
mb
getClosure :: Interp -> ForeignHValue -> IO (Heap.GenClosure ForeignHValue)
getClosure :: Interp -> ForeignHValue -> IO (GenClosure ForeignHValue)
getClosure Interp
interp ForeignHValue
ref =
ForeignHValue
-> (HValueRef -> IO (GenClosure ForeignHValue))
-> IO (GenClosure ForeignHValue)
forall a b. ForeignRef a -> (RemoteRef a -> IO b) -> IO b
withForeignRef ForeignHValue
ref ((HValueRef -> IO (GenClosure ForeignHValue))
-> IO (GenClosure ForeignHValue))
-> (HValueRef -> IO (GenClosure ForeignHValue))
-> IO (GenClosure ForeignHValue)
forall a b. (a -> b) -> a -> b
$ \HValueRef
hval -> do
GenClosure HValueRef
mb <- Interp
-> Message (GenClosure HValueRef) -> IO (GenClosure HValueRef)
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp (HValueRef -> Message (GenClosure HValueRef)
GetClosure HValueRef
hval)
(HValueRef -> IO ForeignHValue)
-> GenClosure HValueRef -> IO (GenClosure ForeignHValue)
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) -> GenClosure a -> m (GenClosure b)
mapM (Interp -> HValueRef -> IO ForeignHValue
forall a. Interp -> RemoteRef a -> IO (ForeignRef a)
mkFinalizedHValue Interp
interp) GenClosure HValueRef
mb
seqHValue :: Interp -> UnitEnv -> ForeignHValue -> IO (EvalResult ())
seqHValue :: Interp -> UnitEnv -> ForeignHValue -> IO (EvalResult ())
seqHValue Interp
interp UnitEnv
unit_env ForeignHValue
ref =
ForeignHValue
-> (HValueRef -> IO (EvalResult ())) -> IO (EvalResult ())
forall a b. ForeignRef a -> (RemoteRef a -> IO b) -> IO b
withForeignRef ForeignHValue
ref ((HValueRef -> IO (EvalResult ())) -> IO (EvalResult ()))
-> (HValueRef -> IO (EvalResult ())) -> IO (EvalResult ())
forall a b. (a -> b) -> a -> b
$ \HValueRef
hval -> do
EvalStatus_ () ()
status <- Interp -> Message (EvalStatus_ () ()) -> IO (EvalStatus_ () ())
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp (HValueRef -> Message (EvalStatus_ () ())
Seq HValueRef
hval)
Interp -> UnitEnv -> EvalStatus_ () () -> IO (EvalResult ())
handleSeqHValueStatus Interp
interp UnitEnv
unit_env EvalStatus_ () ()
status
handleSeqHValueStatus :: Interp -> UnitEnv -> EvalStatus () -> IO (EvalResult ())
handleSeqHValueStatus :: Interp -> UnitEnv -> EvalStatus_ () () -> IO (EvalResult ())
handleSeqHValueStatus Interp
interp UnitEnv
unit_env EvalStatus_ () ()
eval_status =
case EvalStatus_ () ()
eval_status of
(EvalBreak Bool
is_exception HValueRef
_ Int
ix Int
mod_uniq RemoteRef (ResumeContext ())
resume_ctxt RemotePtr CostCentreStack
_) -> do
ForeignRef (ResumeContext ())
resume_ctxt_fhv <- IO (ForeignRef (ResumeContext ()))
-> IO (ForeignRef (ResumeContext ()))
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ForeignRef (ResumeContext ()))
-> IO (ForeignRef (ResumeContext ())))
-> IO (ForeignRef (ResumeContext ()))
-> IO (ForeignRef (ResumeContext ()))
forall a b. (a -> b) -> a -> b
$ Interp
-> RemoteRef (ResumeContext ())
-> IO (ForeignRef (ResumeContext ()))
forall a. Interp -> RemoteRef a -> IO (ForeignRef a)
mkFinalizedHValue Interp
interp RemoteRef (ResumeContext ())
resume_ctxt
let hmi :: HomeModInfo
hmi = String -> Maybe HomeModInfo -> HomeModInfo
forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"handleRunStatus" (Maybe HomeModInfo -> HomeModInfo)
-> Maybe HomeModInfo -> HomeModInfo
forall a b. (a -> b) -> a -> b
$
HomePackageTable -> Unique -> Maybe HomeModInfo
lookupHptDirectly ((() :: Constraint) => UnitEnv -> HomePackageTable
UnitEnv -> HomePackageTable
ue_hpt UnitEnv
unit_env)
(Int -> Unique
mkUniqueGrimily Int
mod_uniq)
modl :: Module
modl = ModIface_ 'ModIfaceFinal -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module (HomeModInfo -> ModIface_ 'ModIfaceFinal
hm_iface HomeModInfo
hmi)
bp :: Maybe BreakInfo
bp | Bool
is_exception = Maybe BreakInfo
forall a. Maybe a
Nothing
| Bool
otherwise = BreakInfo -> Maybe BreakInfo
forall a. a -> Maybe a
Just (Module -> Int -> BreakInfo
BreakInfo Module
modl Int
ix)
sdocBpLoc :: Maybe BreakInfo -> SDoc
sdocBpLoc = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets (SDoc -> SDoc)
-> (Maybe BreakInfo -> SDoc) -> Maybe BreakInfo -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (SrcSpan -> SDoc)
-> (Maybe BreakInfo -> SrcSpan) -> Maybe BreakInfo -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe BreakInfo -> SrcSpan
getSeqBpSpan
String -> IO ()
putStrLn (String
"*** Ignoring breakpoint " String -> String -> String
forall a. [a] -> [a] -> [a]
++
(SDoc -> String
showSDocUnsafe (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ Maybe BreakInfo -> SDoc
sdocBpLoc Maybe BreakInfo
bp))
ForeignRef (ResumeContext ())
-> (RemoteRef (ResumeContext ()) -> IO (EvalResult ()))
-> IO (EvalResult ())
forall a b. ForeignRef a -> (RemoteRef a -> IO b) -> IO b
withForeignRef ForeignRef (ResumeContext ())
resume_ctxt_fhv ((RemoteRef (ResumeContext ()) -> IO (EvalResult ()))
-> IO (EvalResult ()))
-> (RemoteRef (ResumeContext ()) -> IO (EvalResult ()))
-> IO (EvalResult ())
forall a b. (a -> b) -> a -> b
$ \RemoteRef (ResumeContext ())
hval -> do
EvalStatus_ () ()
status <- Interp -> Message (EvalStatus_ () ()) -> IO (EvalStatus_ () ())
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp (RemoteRef (ResumeContext ()) -> Message (EvalStatus_ () ())
ResumeSeq RemoteRef (ResumeContext ())
hval)
Interp -> UnitEnv -> EvalStatus_ () () -> IO (EvalResult ())
handleSeqHValueStatus Interp
interp UnitEnv
unit_env EvalStatus_ () ()
status
(EvalComplete Word64
_ EvalResult ()
r) -> EvalResult () -> IO (EvalResult ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult ()
r
where
getSeqBpSpan :: Maybe BreakInfo -> SrcSpan
getSeqBpSpan :: Maybe BreakInfo -> SrcSpan
getSeqBpSpan (Just BreakInfo{Int
Module
breakInfo_module :: Module
breakInfo_number :: Int
breakInfo_module :: BreakInfo -> Module
breakInfo_number :: BreakInfo -> Int
..}) =
(ModBreaks -> Array Int SrcSpan
modBreaks_locs (Module -> ModBreaks
breaks Module
breakInfo_module)) Array Int SrcSpan -> Int -> SrcSpan
forall i e. Ix i => Array i e -> i -> e
! Int
breakInfo_number
getSeqBpSpan Maybe BreakInfo
Nothing = FastString -> SrcSpan
mkGeneralSrcSpan (String -> FastString
fsLit String
"<unknown>")
breaks :: Module -> ModBreaks
breaks Module
mod = HomeModInfo -> ModBreaks
getModBreaks (HomeModInfo -> ModBreaks) -> HomeModInfo -> ModBreaks
forall a b. (a -> b) -> a -> b
$ String -> Maybe HomeModInfo -> HomeModInfo
forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"getSeqBpSpan" (Maybe HomeModInfo -> HomeModInfo)
-> Maybe HomeModInfo -> HomeModInfo
forall a b. (a -> b) -> a -> b
$
HomePackageTable -> ModuleName -> Maybe HomeModInfo
lookupHpt ((() :: Constraint) => UnitEnv -> HomePackageTable
UnitEnv -> HomePackageTable
ue_hpt UnitEnv
unit_env) (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod)
initObjLinker :: Interp -> IO ()
initObjLinker :: Interp -> IO ()
initObjLinker Interp
interp = Interp -> Message () -> IO ()
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp Message ()
InitLinker
lookupSymbol :: Interp -> FastString -> IO (Maybe (Ptr ()))
lookupSymbol :: Interp -> FastString -> IO (Maybe (Ptr ()))
lookupSymbol Interp
interp FastString
str = case Interp -> InterpInstance
interpInstance Interp
interp of
#if defined(HAVE_INTERNAL_INTERPRETER)
InterpInstance
InternalInterp -> (RemotePtr () -> Ptr ()) -> Maybe (RemotePtr ()) -> Maybe (Ptr ())
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RemotePtr () -> Ptr ()
forall a. RemotePtr a -> Ptr a
fromRemotePtr (Maybe (RemotePtr ()) -> Maybe (Ptr ()))
-> IO (Maybe (RemotePtr ())) -> IO (Maybe (Ptr ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message (Maybe (RemotePtr ())) -> IO (Maybe (RemotePtr ()))
forall a. Message a -> IO a
run (String -> Message (Maybe (RemotePtr ()))
LookupSymbol (FastString -> String
unpackFS FastString
str))
#endif
ExternalInterp IServConfig
c IServ
i -> IServConfig
-> IServ
-> (IServInstance -> IO (IServInstance, Maybe (Ptr ())))
-> IO (Maybe (Ptr ()))
forall (m :: * -> *) a.
ExceptionMonad m =>
IServConfig
-> IServ -> (IServInstance -> m (IServInstance, a)) -> m a
withIServ IServConfig
c IServ
i ((IServInstance -> IO (IServInstance, Maybe (Ptr ())))
-> IO (Maybe (Ptr ())))
-> (IServInstance -> IO (IServInstance, Maybe (Ptr ())))
-> IO (Maybe (Ptr ()))
forall a b. (a -> b) -> a -> b
$ \IServInstance
iserv -> do
let cache :: UniqFM FastString (Ptr ())
cache = IServInstance -> UniqFM FastString (Ptr ())
iservLookupSymbolCache IServInstance
iserv
case UniqFM FastString (Ptr ()) -> FastString -> Maybe (Ptr ())
forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM UniqFM FastString (Ptr ())
cache FastString
str of
Just Ptr ()
p -> (IServInstance, Maybe (Ptr ()))
-> IO (IServInstance, Maybe (Ptr ()))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IServInstance
iserv, Ptr () -> Maybe (Ptr ())
forall a. a -> Maybe a
Just Ptr ()
p)
Maybe (Ptr ())
Nothing -> do
Maybe (RemotePtr ())
m <- IO (Maybe (RemotePtr ())) -> IO (Maybe (RemotePtr ()))
forall a. IO a -> IO a
uninterruptibleMask_ (IO (Maybe (RemotePtr ())) -> IO (Maybe (RemotePtr ())))
-> IO (Maybe (RemotePtr ())) -> IO (Maybe (RemotePtr ()))
forall a b. (a -> b) -> a -> b
$
IServInstance
-> Message (Maybe (RemotePtr ())) -> IO (Maybe (RemotePtr ()))
forall a. Binary a => IServInstance -> Message a -> IO a
iservCall IServInstance
iserv (String -> Message (Maybe (RemotePtr ()))
LookupSymbol (FastString -> String
unpackFS FastString
str))
case Maybe (RemotePtr ())
m of
Maybe (RemotePtr ())
Nothing -> (IServInstance, Maybe (Ptr ()))
-> IO (IServInstance, Maybe (Ptr ()))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IServInstance
iserv, Maybe (Ptr ())
forall a. Maybe a
Nothing)
Just RemotePtr ()
r -> do
let p :: Ptr ()
p = RemotePtr () -> Ptr ()
forall a. RemotePtr a -> Ptr a
fromRemotePtr RemotePtr ()
r
cache' :: UniqFM FastString (Ptr ())
cache' = UniqFM FastString (Ptr ())
-> FastString -> Ptr () -> UniqFM FastString (Ptr ())
forall key elt.
Uniquable key =>
UniqFM key elt -> key -> elt -> UniqFM key elt
addToUFM UniqFM FastString (Ptr ())
cache FastString
str Ptr ()
p
iserv' :: IServInstance
iserv' = IServInstance
iserv {iservLookupSymbolCache = cache'}
(IServInstance, Maybe (Ptr ()))
-> IO (IServInstance, Maybe (Ptr ()))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IServInstance
iserv', Ptr () -> Maybe (Ptr ())
forall a. a -> Maybe a
Just Ptr ()
p)
lookupClosure :: Interp -> String -> IO (Maybe HValueRef)
lookupClosure :: Interp -> String -> IO (Maybe HValueRef)
lookupClosure Interp
interp String
str =
Interp -> Message (Maybe HValueRef) -> IO (Maybe HValueRef)
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp (String -> Message (Maybe HValueRef)
LookupClosure String
str)
purgeLookupSymbolCache :: Interp -> IO ()
purgeLookupSymbolCache :: Interp -> IO ()
purgeLookupSymbolCache Interp
interp = case Interp -> InterpInstance
interpInstance Interp
interp of
#if defined(HAVE_INTERNAL_INTERPRETER)
InterpInstance
InternalInterp -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
#endif
ExternalInterp IServConfig
_ (IServ MVar IServState
mstate) ->
MVar IServState -> (IServState -> IO IServState) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar IServState
mstate ((IServState -> IO IServState) -> IO ())
-> (IServState -> IO IServState) -> IO ()
forall a b. (a -> b) -> a -> b
$ \IServState
state -> IServState -> IO IServState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IServState -> IO IServState) -> IServState -> IO IServState
forall a b. (a -> b) -> a -> b
$ case IServState
state of
IServState
IServPending -> IServState
state
IServRunning IServInstance
iserv -> IServInstance -> IServState
IServRunning
(IServInstance
iserv { iservLookupSymbolCache = emptyUFM })
loadDLL :: Interp -> String -> IO (Maybe String)
loadDLL :: Interp -> String -> IO (Maybe String)
loadDLL Interp
interp String
str = Interp -> Message (Maybe String) -> IO (Maybe String)
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp (String -> Message (Maybe String)
LoadDLL String
str)
loadArchive :: Interp -> String -> IO ()
loadArchive :: Interp -> String -> IO ()
loadArchive Interp
interp String
path = do
String
path' <- String -> IO String
canonicalizePath String
path
Interp -> Message () -> IO ()
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp (String -> Message ()
LoadArchive String
path')
loadObj :: Interp -> String -> IO ()
loadObj :: Interp -> String -> IO ()
loadObj Interp
interp String
path = do
String
path' <- String -> IO String
canonicalizePath String
path
Interp -> Message () -> IO ()
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp (String -> Message ()
LoadObj String
path')
unloadObj :: Interp -> String -> IO ()
unloadObj :: Interp -> String -> IO ()
unloadObj Interp
interp String
path = do
String
path' <- String -> IO String
canonicalizePath String
path
Interp -> Message () -> IO ()
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp (String -> Message ()
UnloadObj String
path')
addLibrarySearchPath :: Interp -> String -> IO (Ptr ())
addLibrarySearchPath :: Interp -> String -> IO (Ptr ())
addLibrarySearchPath Interp
interp String
str =
RemotePtr () -> Ptr ()
forall a. RemotePtr a -> Ptr a
fromRemotePtr (RemotePtr () -> Ptr ()) -> IO (RemotePtr ()) -> IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Interp -> Message (RemotePtr ()) -> IO (RemotePtr ())
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp (String -> Message (RemotePtr ())
AddLibrarySearchPath String
str)
removeLibrarySearchPath :: Interp -> Ptr () -> IO Bool
removeLibrarySearchPath :: Interp -> Ptr () -> IO Bool
removeLibrarySearchPath Interp
interp Ptr ()
p =
Interp -> Message Bool -> IO Bool
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp (RemotePtr () -> Message Bool
RemoveLibrarySearchPath (Ptr () -> RemotePtr ()
forall a. Ptr a -> RemotePtr a
toRemotePtr Ptr ()
p))
resolveObjs :: Interp -> IO SuccessFlag
resolveObjs :: Interp -> IO SuccessFlag
resolveObjs Interp
interp = Bool -> SuccessFlag
successIf (Bool -> SuccessFlag) -> IO Bool -> IO SuccessFlag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Interp -> Message Bool -> IO Bool
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp Message Bool
ResolveObjs
findSystemLibrary :: Interp -> String -> IO (Maybe String)
findSystemLibrary :: Interp -> String -> IO (Maybe String)
findSystemLibrary Interp
interp String
str = Interp -> Message (Maybe String) -> IO (Maybe String)
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp (String -> Message (Maybe String)
FindSystemLibrary String
str)
iservCall :: Binary a => IServInstance -> Message a -> IO a
iservCall :: forall a. Binary a => IServInstance -> Message a -> IO a
iservCall IServInstance
iserv Message a
msg =
Pipe -> Message a -> IO a
forall a. Binary a => Pipe -> Message a -> IO a
remoteCall (IServInstance -> Pipe
iservPipe IServInstance
iserv) Message a
msg
IO a -> (SomeException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catchException` \(SomeException
e :: SomeException) -> IServInstance -> SomeException -> IO a
forall a. IServInstance -> SomeException -> IO a
handleIServFailure IServInstance
iserv SomeException
e
readIServ :: IServInstance -> Get a -> IO a
readIServ :: forall a. IServInstance -> Get a -> IO a
readIServ IServInstance
iserv Get a
get =
Pipe -> Get a -> IO a
forall a. Pipe -> Get a -> IO a
readPipe (IServInstance -> Pipe
iservPipe IServInstance
iserv) Get a
get
IO a -> (SomeException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catchException` \(SomeException
e :: SomeException) -> IServInstance -> SomeException -> IO a
forall a. IServInstance -> SomeException -> IO a
handleIServFailure IServInstance
iserv SomeException
e
writeIServ :: IServInstance -> Put -> IO ()
writeIServ :: IServInstance -> Put -> IO ()
writeIServ IServInstance
iserv Put
put =
Pipe -> Put -> IO ()
writePipe (IServInstance -> Pipe
iservPipe IServInstance
iserv) Put
put
IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catchException` \(SomeException
e :: SomeException) -> IServInstance -> SomeException -> IO ()
forall a. IServInstance -> SomeException -> IO a
handleIServFailure IServInstance
iserv SomeException
e
handleIServFailure :: IServInstance -> SomeException -> IO a
handleIServFailure :: forall a. IServInstance -> SomeException -> IO a
handleIServFailure IServInstance
iserv SomeException
e = do
let proc :: ProcessHandle
proc = IServInstance -> ProcessHandle
iservProcess IServInstance
iserv
Maybe ExitCode
ex <- ProcessHandle -> IO (Maybe ExitCode)
getProcessExitCode ProcessHandle
proc
case Maybe ExitCode
ex of
Just (ExitFailure Int
n) ->
GhcException -> IO a
forall e a. Exception e => e -> IO a
throwIO (String -> GhcException
InstallationError (String
"ghc-iserv terminated (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"))
Maybe ExitCode
_ -> do
ProcessHandle -> IO ()
terminateProcess ProcessHandle
proc
ExitCode
_ <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
proc
SomeException -> IO a
forall a e. Exception e => e -> a
throw SomeException
e
spawnIServ :: IServConfig -> IO IServInstance
spawnIServ :: IServConfig -> IO IServInstance
spawnIServ IServConfig
conf = do
IServConfig -> IO ()
iservConfTrace IServConfig
conf
let createProc :: CreateProcess -> IO ProcessHandle
createProc = (CreateProcess -> IO ProcessHandle)
-> Maybe (CreateProcess -> IO ProcessHandle)
-> CreateProcess
-> IO ProcessHandle
forall a. a -> Maybe a -> a
fromMaybe (\CreateProcess
cp -> do { (Maybe Handle
_,Maybe Handle
_,Maybe Handle
_,ProcessHandle
ph) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess
cp
; ProcessHandle -> IO ProcessHandle
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessHandle
ph })
(IServConfig -> Maybe (CreateProcess -> IO ProcessHandle)
iservConfHook IServConfig
conf)
(ProcessHandle
ph, Handle
rh, Handle
wh) <- (CreateProcess -> IO ProcessHandle)
-> String -> [String] -> IO (ProcessHandle, Handle, Handle)
runWithPipes CreateProcess -> IO ProcessHandle
createProc (IServConfig -> String
iservConfProgram IServConfig
conf)
(IServConfig -> [String]
iservConfOpts IServConfig
conf)
IORef (Maybe ByteString)
lo_ref <- Maybe ByteString -> IO (IORef (Maybe ByteString))
forall a. a -> IO (IORef a)
newIORef Maybe ByteString
forall a. Maybe a
Nothing
IServInstance -> IO IServInstance
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IServInstance -> IO IServInstance)
-> IServInstance -> IO IServInstance
forall a b. (a -> b) -> a -> b
$ IServInstance
{ iservPipe :: Pipe
iservPipe = Pipe { pipeRead :: Handle
pipeRead = Handle
rh, pipeWrite :: Handle
pipeWrite = Handle
wh, pipeLeftovers :: IORef (Maybe ByteString)
pipeLeftovers = IORef (Maybe ByteString)
lo_ref }
, iservProcess :: ProcessHandle
iservProcess = ProcessHandle
ph
, iservLookupSymbolCache :: UniqFM FastString (Ptr ())
iservLookupSymbolCache = UniqFM FastString (Ptr ())
forall key elt. UniqFM key elt
emptyUFM
, iservPendingFrees :: [HValueRef]
iservPendingFrees = []
}
stopInterp :: Interp -> IO ()
stopInterp :: Interp -> IO ()
stopInterp Interp
interp = case Interp -> InterpInstance
interpInstance Interp
interp of
#if defined(HAVE_INTERNAL_INTERPRETER)
InterpInstance
InternalInterp -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
#endif
ExternalInterp IServConfig
_ (IServ MVar IServState
mstate) ->
((forall a. IO a -> IO a) -> IO ()) -> IO ()
forall b.
HasCallStack =>
((forall a. IO a -> IO a) -> IO b) -> IO b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
MC.mask (((forall a. IO a -> IO a) -> IO ()) -> IO ())
-> ((forall a. IO a -> IO a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
_restore -> MVar IServState -> (IServState -> IO IServState) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar IServState
mstate ((IServState -> IO IServState) -> IO ())
-> (IServState -> IO IServState) -> IO ()
forall a b. (a -> b) -> a -> b
$ \IServState
state -> do
case IServState
state of
IServState
IServPending -> IServState -> IO IServState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IServState
state
IServRunning IServInstance
i -> do
Maybe ExitCode
ex <- ProcessHandle -> IO (Maybe ExitCode)
getProcessExitCode (IServInstance -> ProcessHandle
iservProcess IServInstance
i)
if Maybe ExitCode -> Bool
forall a. Maybe a -> Bool
isJust Maybe ExitCode
ex
then () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
else IServInstance -> Message () -> IO ()
forall a. Binary a => IServInstance -> Message a -> IO a
iservCall IServInstance
i Message ()
Shutdown
IServState -> IO IServState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IServState
IServPending
runWithPipes :: (CreateProcess -> IO ProcessHandle)
-> FilePath -> [String] -> IO (ProcessHandle, Handle, Handle)
#if defined(mingw32_HOST_OS)
foreign import ccall "io.h _close"
c__close :: CInt -> IO CInt
foreign import ccall unsafe "io.h _get_osfhandle"
_get_osfhandle :: CInt -> IO CInt
runWithPipesPOSIX :: (CreateProcess -> IO ProcessHandle)
-> FilePath -> [String] -> IO (ProcessHandle, Handle, Handle)
runWithPipesPOSIX createProc prog opts = do
(rfd1, wfd1) <- createPipeFd
(rfd2, wfd2) <- createPipeFd
wh_client <- _get_osfhandle wfd1
rh_client <- _get_osfhandle rfd2
let args = show wh_client : show rh_client : opts
ph <- createProc (proc prog args)
rh <- mkHandle rfd1
wh <- mkHandle wfd2
return (ph, rh, wh)
where mkHandle :: CInt -> IO Handle
mkHandle fd = (fdToHandle fd) `Ex.onException` (c__close fd)
# if defined (__IO_MANAGER_WINIO__)
runWithPipesNative :: (CreateProcess -> IO ProcessHandle)
-> FilePath -> [String] -> IO (ProcessHandle, Handle, Handle)
runWithPipesNative createProc prog opts = do
(rh, wfd1) <- createPipe
(rfd2, wh) <- createPipe
wh_client <- handleToHANDLE wfd1
rh_client <- handleToHANDLE rfd2
associateHandle' =<< handleToHANDLE rh
associateHandle' =<< handleToHANDLE wh
let args = show wh_client : show rh_client : opts
ph <- createProc (proc prog args)
return (ph, rh, wh)
runWithPipes = runWithPipesPOSIX <!> runWithPipesNative
# else
runWithPipes = runWithPipesPOSIX
# endif
#else
runWithPipes :: (CreateProcess -> IO ProcessHandle)
-> String -> [String] -> IO (ProcessHandle, Handle, Handle)
runWithPipes CreateProcess -> IO ProcessHandle
createProc String
prog [String]
opts = do
(Fd
rfd1, Fd
wfd1) <- IO (Fd, Fd)
Posix.createPipe
(Fd
rfd2, Fd
wfd2) <- IO (Fd, Fd)
Posix.createPipe
Fd -> FdOption -> Bool -> IO ()
setFdOption Fd
rfd1 FdOption
CloseOnExec Bool
True
Fd -> FdOption -> Bool -> IO ()
setFdOption Fd
wfd2 FdOption
CloseOnExec Bool
True
let args :: [String]
args = Fd -> String
forall a. Show a => a -> String
show Fd
wfd1 String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Fd -> String
forall a. Show a => a -> String
show Fd
rfd2 String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
opts
ProcessHandle
ph <- CreateProcess -> IO ProcessHandle
createProc (String -> [String] -> CreateProcess
proc String
prog [String]
args)
Fd -> IO ()
closeFd Fd
wfd1
Fd -> IO ()
closeFd Fd
rfd2
Handle
rh <- Fd -> IO Handle
fdToHandle Fd
rfd1
Handle
wh <- Fd -> IO Handle
fdToHandle Fd
wfd2
(ProcessHandle, Handle, Handle)
-> IO (ProcessHandle, Handle, Handle)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessHandle
ph, Handle
rh, Handle
wh)
#endif
mkFinalizedHValue :: Interp -> RemoteRef a -> IO (ForeignRef a)
mkFinalizedHValue :: forall a. Interp -> RemoteRef a -> IO (ForeignRef a)
mkFinalizedHValue Interp
interp RemoteRef a
rref = do
let hvref :: HValueRef
hvref = RemoteRef a -> HValueRef
forall a. RemoteRef a -> HValueRef
toHValueRef RemoteRef a
rref
IO ()
free <- case Interp -> InterpInstance
interpInstance Interp
interp of
#if defined(HAVE_INTERNAL_INTERPRETER)
InterpInstance
InternalInterp -> IO () -> IO (IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HValueRef -> IO ()
forall a. RemoteRef a -> IO ()
freeRemoteRef HValueRef
hvref)
#endif
ExternalInterp IServConfig
_ (IServ MVar IServState
i) -> IO () -> IO (IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> IO (IO ())) -> IO () -> IO (IO ())
forall a b. (a -> b) -> a -> b
$ MVar IServState -> (IServState -> IO IServState) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar IServState
i ((IServState -> IO IServState) -> IO ())
-> (IServState -> IO IServState) -> IO ()
forall a b. (a -> b) -> a -> b
$ \IServState
state ->
case IServState
state of
IServPending {} -> IServState -> IO IServState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IServState
state
IServRunning IServInstance
inst -> do
let !inst' :: IServInstance
inst' = IServInstance
inst {iservPendingFrees = hvref:iservPendingFrees inst}
IServState -> IO IServState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IServInstance -> IServState
IServRunning IServInstance
inst')
RemoteRef a -> IO () -> IO (ForeignRef a)
forall a. RemoteRef a -> IO () -> IO (ForeignRef a)
mkForeignRef RemoteRef a
rref IO ()
free
freeHValueRefs :: Interp -> [HValueRef] -> IO ()
freeHValueRefs :: Interp -> [HValueRef] -> IO ()
freeHValueRefs Interp
_ [] = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
freeHValueRefs Interp
interp [HValueRef]
refs = Interp -> Message () -> IO ()
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp ([HValueRef] -> Message ()
FreeHValueRefs [HValueRef]
refs)
wormhole :: Interp -> ForeignRef a -> IO a
wormhole :: forall a. Interp -> ForeignRef a -> IO a
wormhole Interp
interp ForeignRef a
r = Interp -> RemoteRef a -> IO a
forall a. Interp -> RemoteRef a -> IO a
wormholeRef Interp
interp (ForeignRef a -> RemoteRef a
forall a. ForeignRef a -> RemoteRef a
unsafeForeignRefToRemoteRef ForeignRef a
r)
wormholeRef :: Interp -> RemoteRef a -> IO a
wormholeRef :: forall a. Interp -> RemoteRef a -> IO a
wormholeRef Interp
interp RemoteRef a
_r = case Interp -> InterpInstance
interpInstance Interp
interp of
#if defined(HAVE_INTERNAL_INTERPRETER)
InterpInstance
InternalInterp -> RemoteRef a -> IO a
forall a. RemoteRef a -> IO a
localRef RemoteRef a
_r
#endif
ExternalInterp {}
-> GhcException -> IO a
forall e a. Exception e => e -> IO a
throwIO (String -> GhcException
InstallationError String
"this operation requires -fno-external-interpreter")
fromEvalResult :: EvalResult a -> IO a
fromEvalResult :: forall a. EvalResult a -> IO a
fromEvalResult (EvalException SerializableException
e) = SomeException -> IO a
forall e a. Exception e => e -> IO a
throwIO (SerializableException -> SomeException
fromSerializableException SerializableException
e)
fromEvalResult (EvalSuccess a
a) = a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
getModBreaks :: HomeModInfo -> ModBreaks
getModBreaks :: HomeModInfo -> ModBreaks
getModBreaks HomeModInfo
hmi
| Just Linkable
linkable <- HomeModInfo -> Maybe Linkable
homeModInfoByteCode HomeModInfo
hmi,
[CompiledByteCode
cbc] <- (Unlinked -> Maybe CompiledByteCode)
-> [Unlinked] -> [CompiledByteCode]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Unlinked -> Maybe CompiledByteCode
onlyBCOs ([Unlinked] -> [CompiledByteCode])
-> [Unlinked] -> [CompiledByteCode]
forall a b. (a -> b) -> a -> b
$ Linkable -> [Unlinked]
linkableUnlinked Linkable
linkable
= ModBreaks -> Maybe ModBreaks -> ModBreaks
forall a. a -> Maybe a -> a
fromMaybe ModBreaks
emptyModBreaks (CompiledByteCode -> Maybe ModBreaks
bc_breaks CompiledByteCode
cbc)
| Bool
otherwise
= ModBreaks
emptyModBreaks
where
onlyBCOs :: Unlinked -> Maybe CompiledByteCode
onlyBCOs :: Unlinked -> Maybe CompiledByteCode
onlyBCOs (BCOs CompiledByteCode
cbc [SptEntry]
_) = CompiledByteCode -> Maybe CompiledByteCode
forall a. a -> Maybe a
Just CompiledByteCode
cbc
onlyBCOs Unlinked
_ = Maybe CompiledByteCode
forall a. Maybe a
Nothing
interpreterProfiled :: Interp -> Bool
interpreterProfiled :: Interp -> Bool
interpreterProfiled Interp
interp = case Interp -> InterpInstance
interpInstance Interp
interp of
#if defined(HAVE_INTERNAL_INTERPRETER)
InterpInstance
InternalInterp -> Bool
hostIsProfiled
#endif
ExternalInterp IServConfig
c IServ
_ -> IServConfig -> Bool
iservConfProfiled IServConfig
c
interpreterDynamic :: Interp -> Bool
interpreterDynamic :: Interp -> Bool
interpreterDynamic Interp
interp = case Interp -> InterpInstance
interpInstance Interp
interp of
#if defined(HAVE_INTERNAL_INTERPRETER)
InterpInstance
InternalInterp -> Bool
hostIsDynamic
#endif
ExternalInterp IServConfig
c IServ
_ -> IServConfig -> Bool
iservConfDynamic IServConfig
c