b4777a3c21024eb7ad116f41ef3e78d1a9ff745e
[ghc.git] / compiler / ghci / GHCi.hs
1 {-# LANGUAGE RecordWildCards, ScopedTypeVariables, BangPatterns, CPP #-}
2
3 --
4 -- | Interacting with the interpreter, whether it is running on an
5 -- external process or in the current process.
6 --
7 module GHCi
8 ( -- * High-level interface to the interpreter
9 evalStmt, EvalStatus_(..), EvalStatus, EvalResult(..), EvalExpr(..)
10 , resumeStmt
11 , abandonStmt
12 , evalIO
13 , evalString
14 , evalStringToIOString
15 , mallocData
16 , createBCOs
17 , mkCostCentres
18 , costCentreStackInfo
19 , newBreakArray
20 , enableBreakpoint
21 , breakpointStatus
22 , getBreakpointVar
23
24 -- * The object-code linker
25 , initObjLinker
26 , lookupSymbol
27 , lookupClosure
28 , loadDLL
29 , loadArchive
30 , loadObj
31 , unloadObj
32 , addLibrarySearchPath
33 , removeLibrarySearchPath
34 , resolveObjs
35 , findSystemLibrary
36
37 -- * Lower-level API using messages
38 , iservCmd, Message(..), withIServ, stopIServ
39 , iservCall, readIServ, writeIServ
40 , purgeLookupSymbolCache
41 , freeHValueRefs
42 , mkFinalizedHValue
43 , wormhole, wormholeRef
44 , mkEvalOpts
45 , fromEvalResult
46 ) where
47
48 import GHCi.Message
49 import GHCi.Run
50 import GHCi.RemoteTypes
51 import GHCi.ResolvedBCO
52 import GHCi.BreakArray (BreakArray)
53 import HscTypes
54 import UniqFM
55 import Panic
56 import DynFlags
57 import ErrUtils
58 import Outputable
59 import Exception
60 import BasicTypes
61 import FastString
62 import Util
63
64 import Control.Concurrent
65 import Control.Monad
66 import Control.Monad.IO.Class
67 import Data.Binary
68 import Data.Binary.Put
69 import Data.ByteString (ByteString)
70 import qualified Data.ByteString.Lazy as LB
71 import Data.IORef
72 import Foreign hiding (void)
73 import GHC.Stack.CCS (CostCentre,CostCentreStack)
74 import System.Exit
75 import Data.Maybe
76 import GHC.IO.Handle.Types (Handle)
77 #ifdef mingw32_HOST_OS
78 import Foreign.C
79 import GHC.IO.Handle.FD (fdToHandle)
80 #else
81 import System.Posix as Posix
82 #endif
83 import System.Process
84 import GHC.Conc (getNumProcessors, pseq, par)
85
86 {- Note [Remote GHCi]
87
88 When the flag -fexternal-interpreter is given to GHC, interpreted code
89 is run in a separate process called iserv, and we communicate with the
90 external process over a pipe using Binary-encoded messages.
91
92 Motivation
93 ~~~~~~~~~~
94
95 When the interpreted code is running in a separate process, it can
96 use a different "way", e.g. profiled or dynamic. This means
97
98 - compiling Template Haskell code with -prof does not require
99 building the code without -prof first
100
101 - when GHC itself is profiled, it can interpret unprofiled code,
102 and the same applies to dynamic linking.
103
104 - An unprofiled GHCi can load and run profiled code, which means it
105 can use the stack-trace functionality provided by profiling without
106 taking the performance hit on the compiler that profiling would
107 entail.
108
109 For other reasons see RemoteGHCi on the wiki.
110
111 Implementation Overview
112 ~~~~~~~~~~~~~~~~~~~~~~~
113
114 The main pieces are:
115
116 - libraries/ghci, containing:
117 - types for talking about remote values (GHCi.RemoteTypes)
118 - the message protocol (GHCi.Message),
119 - implementation of the messages (GHCi.Run)
120 - implementation of Template Haskell (GHCi.TH)
121 - a few other things needed to run interpreted code
122
123 - top-level iserv directory, containing the codefor the external
124 server. This is a fairly simple wrapper, most of the functionality
125 is provided by modules in libraries/ghci.
126
127 - This module (GHCi) which provides the interface to the server used
128 by the rest of GHC.
129
130 GHC works with and without -fexternal-interpreter. With the flag, all
131 interpreted code is run by the iserv binary. Without the flag,
132 interpreted code is run in the same process as GHC.
133
134 Things that do not work with -fexternal-interpreter
135 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
136
137 dynCompileExpr cannot work, because we have no way to run code of an
138 unknown type in the remote process. This API fails with an error
139 message if it is used with -fexternal-interpreter.
140
141 Other Notes on Remote GHCi
142 ~~~~~~~~~~~~~~~~~~~~~~~~~~
143 * This wiki page has an implementation overview:
144 https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/ExternalInterpreter
145 * Note [External GHCi pointers] in compiler/ghci/GHCi.hs
146 * Note [Remote Template Haskell] in libraries/ghci/GHCi/TH.hs
147 -}
148
149 -- | Run a command in the interpreter's context. With
150 -- @-fexternal-interpreter@, the command is serialized and sent to an
151 -- external iserv process, and the response is deserialized (hence the
152 -- @Binary@ constraint). With @-fno-external-interpreter@ we execute
153 -- the command directly here.
154 iservCmd :: Binary a => HscEnv -> Message a -> IO a
155 iservCmd hsc_env@HscEnv{..} msg
156 | gopt Opt_ExternalInterpreter hsc_dflags =
157 withIServ hsc_env $ \iserv ->
158 uninterruptibleMask_ $ do -- Note [uninterruptibleMask_]
159 iservCall iserv msg
160 | otherwise = -- Just run it directly
161 run msg
162
163
164 -- Note [uninterruptibleMask_ and iservCmd]
165 --
166 -- If we receive an async exception, such as ^C, while communicating
167 -- with the iserv process then we will be out-of-sync and not be able
168 -- to recoever. Thus we use uninterruptibleMask_ during
169 -- communication. A ^C will be delivered to the iserv process (because
170 -- signals get sent to the whole process group) which will interrupt
171 -- the running computation and return an EvalException result.
172
173 -- | Grab a lock on the 'IServ' and do something with it.
174 -- Overloaded because this is used from TcM as well as IO.
175 withIServ
176 :: (MonadIO m, ExceptionMonad m)
177 => HscEnv -> (IServ -> m a) -> m a
178 withIServ HscEnv{..} action =
179 gmask $ \restore -> do
180 m <- liftIO $ takeMVar hsc_iserv
181 -- start the iserv process if we haven't done so yet
182 iserv <- maybe (liftIO $ startIServ hsc_dflags) return m
183 `gonException` (liftIO $ putMVar hsc_iserv Nothing)
184 -- free any ForeignHValues that have been garbage collected.
185 let iserv' = iserv{ iservPendingFrees = [] }
186 a <- (do
187 liftIO $ when (not (null (iservPendingFrees iserv))) $
188 iservCall iserv (FreeHValueRefs (iservPendingFrees iserv))
189 -- run the inner action
190 restore $ action iserv)
191 `gonException` (liftIO $ putMVar hsc_iserv (Just iserv'))
192 liftIO $ putMVar hsc_iserv (Just iserv')
193 return a
194
195
196 -- -----------------------------------------------------------------------------
197 -- Wrappers around messages
198
199 -- | Execute an action of type @IO [a]@, returning 'ForeignHValue's for
200 -- each of the results.
201 evalStmt
202 :: HscEnv -> Bool -> EvalExpr ForeignHValue
203 -> IO (EvalStatus_ [ForeignHValue] [HValueRef])
204 evalStmt hsc_env step foreign_expr = do
205 let dflags = hsc_dflags hsc_env
206 status <- withExpr foreign_expr $ \expr ->
207 iservCmd hsc_env (EvalStmt (mkEvalOpts dflags step) expr)
208 handleEvalStatus hsc_env status
209 where
210 withExpr :: EvalExpr ForeignHValue -> (EvalExpr HValueRef -> IO a) -> IO a
211 withExpr (EvalThis fhv) cont =
212 withForeignRef fhv $ \hvref -> cont (EvalThis hvref)
213 withExpr (EvalApp fl fr) cont =
214 withExpr fl $ \fl' ->
215 withExpr fr $ \fr' ->
216 cont (EvalApp fl' fr')
217
218 resumeStmt
219 :: HscEnv -> Bool -> ForeignRef (ResumeContext [HValueRef])
220 -> IO (EvalStatus_ [ForeignHValue] [HValueRef])
221 resumeStmt hsc_env step resume_ctxt = do
222 let dflags = hsc_dflags hsc_env
223 status <- withForeignRef resume_ctxt $ \rhv ->
224 iservCmd hsc_env (ResumeStmt (mkEvalOpts dflags step) rhv)
225 handleEvalStatus hsc_env status
226
227 abandonStmt :: HscEnv -> ForeignRef (ResumeContext [HValueRef]) -> IO ()
228 abandonStmt hsc_env resume_ctxt = do
229 withForeignRef resume_ctxt $ \rhv ->
230 iservCmd hsc_env (AbandonStmt rhv)
231
232 handleEvalStatus
233 :: HscEnv -> EvalStatus [HValueRef]
234 -> IO (EvalStatus_ [ForeignHValue] [HValueRef])
235 handleEvalStatus hsc_env status =
236 case status of
237 EvalBreak a b c d e f -> return (EvalBreak a b c d e f)
238 EvalComplete alloc res ->
239 EvalComplete alloc <$> addFinalizer res
240 where
241 addFinalizer (EvalException e) = return (EvalException e)
242 addFinalizer (EvalSuccess rs) = do
243 EvalSuccess <$> mapM (mkFinalizedHValue hsc_env) rs
244
245 -- | Execute an action of type @IO ()@
246 evalIO :: HscEnv -> ForeignHValue -> IO ()
247 evalIO hsc_env fhv = do
248 liftIO $ withForeignRef fhv $ \fhv ->
249 iservCmd hsc_env (EvalIO fhv) >>= fromEvalResult
250
251 -- | Execute an action of type @IO String@
252 evalString :: HscEnv -> ForeignHValue -> IO String
253 evalString hsc_env fhv = do
254 liftIO $ withForeignRef fhv $ \fhv ->
255 iservCmd hsc_env (EvalString fhv) >>= fromEvalResult
256
257 -- | Execute an action of type @String -> IO String@
258 evalStringToIOString :: HscEnv -> ForeignHValue -> String -> IO String
259 evalStringToIOString hsc_env fhv str = do
260 liftIO $ withForeignRef fhv $ \fhv ->
261 iservCmd hsc_env (EvalStringToString fhv str) >>= fromEvalResult
262
263
264 -- | Allocate and store the given bytes in memory, returning a pointer
265 -- to the memory in the remote process.
266 mallocData :: HscEnv -> ByteString -> IO (RemotePtr ())
267 mallocData hsc_env bs = iservCmd hsc_env (MallocData bs)
268
269 mkCostCentres
270 :: HscEnv -> String -> [(String,String)] -> IO [RemotePtr CostCentre]
271 mkCostCentres hsc_env mod ccs =
272 iservCmd hsc_env (MkCostCentres mod ccs)
273
274 -- | Create a set of BCOs that may be mutually recursive.
275 createBCOs :: HscEnv -> [ResolvedBCO] -> IO [HValueRef]
276 createBCOs hsc_env rbcos = do
277 n_jobs <- case parMakeCount (hsc_dflags hsc_env) of
278 Nothing -> liftIO getNumProcessors
279 Just n -> return n
280 -- Serializing ResolvedBCO is expensive, so if we're in parallel mode
281 -- (-j<n>) parallelise the serialization.
282 if (n_jobs == 1)
283 then
284 iservCmd hsc_env (CreateBCOs [runPut (put rbcos)])
285
286 else do
287 old_caps <- getNumCapabilities
288 if old_caps == n_jobs
289 then void $ evaluate puts
290 else bracket_ (setNumCapabilities n_jobs)
291 (setNumCapabilities old_caps)
292 (void $ evaluate puts)
293 iservCmd hsc_env (CreateBCOs puts)
294 where
295 puts = parMap doChunk (chunkList 100 rbcos)
296
297 -- make sure we force the whole lazy ByteString
298 doChunk c = pseq (LB.length bs) bs
299 where bs = runPut (put c)
300
301 -- We don't have the parallel package, so roll our own simple parMap
302 parMap _ [] = []
303 parMap f (x:xs) = fx `par` (fxs `pseq` (fx : fxs))
304 where fx = f x; fxs = parMap f xs
305
306 costCentreStackInfo :: HscEnv -> RemotePtr CostCentreStack -> IO [String]
307 costCentreStackInfo hsc_env ccs =
308 iservCmd hsc_env (CostCentreStackInfo ccs)
309
310 newBreakArray :: HscEnv -> Int -> IO (ForeignRef BreakArray)
311 newBreakArray hsc_env size = do
312 breakArray <- iservCmd hsc_env (NewBreakArray size)
313 mkFinalizedHValue hsc_env breakArray
314
315 enableBreakpoint :: HscEnv -> ForeignRef BreakArray -> Int -> Bool -> IO ()
316 enableBreakpoint hsc_env ref ix b = do
317 withForeignRef ref $ \breakarray ->
318 iservCmd hsc_env (EnableBreakpoint breakarray ix b)
319
320 breakpointStatus :: HscEnv -> ForeignRef BreakArray -> Int -> IO Bool
321 breakpointStatus hsc_env ref ix = do
322 withForeignRef ref $ \breakarray ->
323 iservCmd hsc_env (BreakpointStatus breakarray ix)
324
325 getBreakpointVar :: HscEnv -> ForeignHValue -> Int -> IO (Maybe ForeignHValue)
326 getBreakpointVar hsc_env ref ix =
327 withForeignRef ref $ \apStack -> do
328 mb <- iservCmd hsc_env (GetBreakpointVar apStack ix)
329 mapM (mkFinalizedHValue hsc_env) mb
330
331 -- -----------------------------------------------------------------------------
332 -- Interface to the object-code linker
333
334 initObjLinker :: HscEnv -> IO ()
335 initObjLinker hsc_env = iservCmd hsc_env InitLinker
336
337 lookupSymbol :: HscEnv -> FastString -> IO (Maybe (Ptr ()))
338 lookupSymbol hsc_env@HscEnv{..} str
339 | gopt Opt_ExternalInterpreter hsc_dflags =
340 -- Profiling of GHCi showed a lot of time and allocation spent
341 -- making cross-process LookupSymbol calls, so I added a GHC-side
342 -- cache which sped things up quite a lot. We have to be careful
343 -- to purge this cache when unloading code though.
344 withIServ hsc_env $ \iserv@IServ{..} -> do
345 cache <- readIORef iservLookupSymbolCache
346 case lookupUFM cache str of
347 Just p -> return (Just p)
348 Nothing -> do
349 m <- uninterruptibleMask_ $
350 iservCall iserv (LookupSymbol (unpackFS str))
351 case m of
352 Nothing -> return Nothing
353 Just r -> do
354 let p = fromRemotePtr r
355 writeIORef iservLookupSymbolCache $! addToUFM cache str p
356 return (Just p)
357 | otherwise =
358 fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str))
359
360 lookupClosure :: HscEnv -> String -> IO (Maybe HValueRef)
361 lookupClosure hsc_env str =
362 iservCmd hsc_env (LookupClosure str)
363
364 purgeLookupSymbolCache :: HscEnv -> IO ()
365 purgeLookupSymbolCache hsc_env@HscEnv{..} =
366 when (gopt Opt_ExternalInterpreter hsc_dflags) $
367 withIServ hsc_env $ \IServ{..} ->
368 writeIORef iservLookupSymbolCache emptyUFM
369
370
371 -- | loadDLL loads a dynamic library using the OS's native linker
372 -- (i.e. dlopen() on Unix, LoadLibrary() on Windows). It takes either
373 -- an absolute pathname to the file, or a relative filename
374 -- (e.g. "libfoo.so" or "foo.dll"). In the latter case, loadDLL
375 -- searches the standard locations for the appropriate library.
376 --
377 -- Returns:
378 --
379 -- Nothing => success
380 -- Just err_msg => failure
381 loadDLL :: HscEnv -> String -> IO (Maybe String)
382 loadDLL hsc_env str = iservCmd hsc_env (LoadDLL str)
383
384 loadArchive :: HscEnv -> String -> IO ()
385 loadArchive hsc_env str = iservCmd hsc_env (LoadArchive str)
386
387 loadObj :: HscEnv -> String -> IO ()
388 loadObj hsc_env str = iservCmd hsc_env (LoadObj str)
389
390 unloadObj :: HscEnv -> String -> IO ()
391 unloadObj hsc_env str = iservCmd hsc_env (UnloadObj str)
392
393 addLibrarySearchPath :: HscEnv -> String -> IO (Ptr ())
394 addLibrarySearchPath hsc_env str =
395 fromRemotePtr <$> iservCmd hsc_env (AddLibrarySearchPath str)
396
397 removeLibrarySearchPath :: HscEnv -> Ptr () -> IO Bool
398 removeLibrarySearchPath hsc_env p =
399 iservCmd hsc_env (RemoveLibrarySearchPath (toRemotePtr p))
400
401 resolveObjs :: HscEnv -> IO SuccessFlag
402 resolveObjs hsc_env = successIf <$> iservCmd hsc_env ResolveObjs
403
404 findSystemLibrary :: HscEnv -> String -> IO (Maybe String)
405 findSystemLibrary hsc_env str = iservCmd hsc_env (FindSystemLibrary str)
406
407
408 -- -----------------------------------------------------------------------------
409 -- Raw calls and messages
410
411 -- | Send a 'Message' and receive the response from the iserv process
412 iservCall :: Binary a => IServ -> Message a -> IO a
413 iservCall iserv@IServ{..} msg =
414 remoteCall iservPipe msg
415 `catch` \(e :: SomeException) -> handleIServFailure iserv e
416
417 -- | Read a value from the iserv process
418 readIServ :: IServ -> Get a -> IO a
419 readIServ iserv@IServ{..} get =
420 readPipe iservPipe get
421 `catch` \(e :: SomeException) -> handleIServFailure iserv e
422
423 -- | Send a value to the iserv process
424 writeIServ :: IServ -> Put -> IO ()
425 writeIServ iserv@IServ{..} put =
426 writePipe iservPipe put
427 `catch` \(e :: SomeException) -> handleIServFailure iserv e
428
429 handleIServFailure :: IServ -> SomeException -> IO a
430 handleIServFailure IServ{..} e = do
431 ex <- getProcessExitCode iservProcess
432 case ex of
433 Just (ExitFailure n) ->
434 throw (InstallationError ("ghc-iserv terminated (" ++ show n ++ ")"))
435 _ -> do
436 terminateProcess iservProcess
437 _ <- waitForProcess iservProcess
438 throw e
439
440 -- -----------------------------------------------------------------------------
441 -- Starting and stopping the iserv process
442
443 startIServ :: DynFlags -> IO IServ
444 startIServ dflags = do
445 let flavour
446 | WayProf `elem` ways dflags = "-prof"
447 | WayDyn `elem` ways dflags = "-dyn"
448 | otherwise = ""
449 prog = pgm_i dflags ++ flavour
450 opts = getOpts dflags opt_i
451 debugTraceMsg dflags 3 $ text "Starting " <> text prog
452 (ph, rh, wh) <- runWithPipes prog opts
453 lo_ref <- newIORef Nothing
454 cache_ref <- newIORef emptyUFM
455 return $ IServ
456 { iservPipe = Pipe { pipeRead = rh
457 , pipeWrite = wh
458 , pipeLeftovers = lo_ref }
459 , iservProcess = ph
460 , iservLookupSymbolCache = cache_ref
461 , iservPendingFrees = []
462 }
463
464 stopIServ :: HscEnv -> IO ()
465 stopIServ HscEnv{..} =
466 gmask $ \_restore -> do
467 m <- takeMVar hsc_iserv
468 maybe (return ()) stop m
469 putMVar hsc_iserv Nothing
470 where
471 stop iserv = do
472 ex <- getProcessExitCode (iservProcess iserv)
473 if isJust ex
474 then return ()
475 else iservCall iserv Shutdown
476
477 runWithPipes :: FilePath -> [String] -> IO (ProcessHandle, Handle, Handle)
478 #ifdef mingw32_HOST_OS
479 foreign import ccall "io.h _close"
480 c__close :: CInt -> IO CInt
481
482 foreign import ccall unsafe "io.h _get_osfhandle"
483 _get_osfhandle :: CInt -> IO CInt
484
485 runWithPipes prog opts = do
486 (rfd1, wfd1) <- createPipeFd -- we read on rfd1
487 (rfd2, wfd2) <- createPipeFd -- we write on wfd2
488 wh_client <- _get_osfhandle wfd1
489 rh_client <- _get_osfhandle rfd2
490 let args = show wh_client : show rh_client : opts
491 (_, _, _, ph) <- createProcess (proc prog args)
492 rh <- mkHandle rfd1
493 wh <- mkHandle wfd2
494 return (ph, rh, wh)
495 where mkHandle :: CInt -> IO Handle
496 mkHandle fd = (fdToHandle fd) `onException` (c__close fd)
497 #else
498 runWithPipes prog opts = do
499 (rfd1, wfd1) <- Posix.createPipe -- we read on rfd1
500 (rfd2, wfd2) <- Posix.createPipe -- we write on wfd2
501 setFdOption rfd1 CloseOnExec True
502 setFdOption wfd2 CloseOnExec True
503 let args = show wfd1 : show rfd2 : opts
504 (_, _, _, ph) <- createProcess (proc prog args)
505 closeFd wfd1
506 closeFd rfd2
507 rh <- fdToHandle rfd1
508 wh <- fdToHandle wfd2
509 return (ph, rh, wh)
510 #endif
511
512 -- -----------------------------------------------------------------------------
513 {- Note [External GHCi pointers]
514
515 We have the following ways to reference things in GHCi:
516
517 HValue
518 ------
519
520 HValue is a direct reference to an value in the local heap. Obviously
521 we cannot use this to refer to things in the external process.
522
523
524 RemoteRef
525 ---------
526
527 RemoteRef is a StablePtr to a heap-resident value. When
528 -fexternal-interpreter is used, this value resides in the external
529 process's heap. RemoteRefs are mostly used to send pointers in
530 messages between GHC and iserv.
531
532 A RemoteRef must be explicitly freed when no longer required, using
533 freeHValueRefs, or by attaching a finalizer with mkForeignHValue.
534
535 To get from a RemoteRef to an HValue you can use 'wormholeRef', which
536 fails with an error message if -fexternal-interpreter is in use.
537
538 ForeignRef
539 ----------
540
541 A ForeignRef is a RemoteRef with a finalizer that will free the
542 'RemoteRef' when it is gargabe collected. We mostly use ForeignHValue
543 on the GHC side.
544
545 The finalizer adds the RemoteRef to the iservPendingFrees list in the
546 IServ record. The next call to iservCmd will free any RemoteRefs in
547 the list. It was done this way rather than calling iservCmd directly,
548 because I didn't want to have arbitrary threads calling iservCmd. In
549 principle it would probably be ok, but it seems less hairy this way.
550 -}
551
552 -- | Creates a 'ForeignRef' that will automatically release the
553 -- 'RemoteRef' when it is no longer referenced.
554 mkFinalizedHValue :: HscEnv -> RemoteRef a -> IO (ForeignRef a)
555 mkFinalizedHValue HscEnv{..} rref = mkForeignRef rref free
556 where
557 !external = gopt Opt_ExternalInterpreter hsc_dflags
558 hvref = toHValueRef rref
559
560 free :: IO ()
561 free
562 | not external = freeRemoteRef hvref
563 | otherwise =
564 modifyMVar_ hsc_iserv $ \mb_iserv ->
565 case mb_iserv of
566 Nothing -> return Nothing -- already shut down
567 Just iserv@IServ{..} ->
568 return (Just iserv{iservPendingFrees = hvref : iservPendingFrees})
569
570 freeHValueRefs :: HscEnv -> [HValueRef] -> IO ()
571 freeHValueRefs _ [] = return ()
572 freeHValueRefs hsc_env refs = iservCmd hsc_env (FreeHValueRefs refs)
573
574 -- | Convert a 'ForeignRef' to the value it references directly. This
575 -- only works when the interpreter is running in the same process as
576 -- the compiler, so it fails when @-fexternal-interpreter@ is on.
577 wormhole :: DynFlags -> ForeignRef a -> IO a
578 wormhole dflags r = wormholeRef dflags (unsafeForeignRefToRemoteRef r)
579
580 -- | Convert an 'RemoteRef' to the value it references directly. This
581 -- only works when the interpreter is running in the same process as
582 -- the compiler, so it fails when @-fexternal-interpreter@ is on.
583 wormholeRef :: DynFlags -> RemoteRef a -> IO a
584 wormholeRef dflags r
585 | gopt Opt_ExternalInterpreter dflags
586 = throwIO (InstallationError
587 "this operation requires -fno-external-interpreter")
588 | otherwise
589 = localRef r
590
591 -- -----------------------------------------------------------------------------
592 -- Misc utils
593
594 mkEvalOpts :: DynFlags -> Bool -> EvalOpts
595 mkEvalOpts dflags step =
596 EvalOpts
597 { useSandboxThread = gopt Opt_GhciSandbox dflags
598 , singleStep = step
599 , breakOnException = gopt Opt_BreakOnException dflags
600 , breakOnError = gopt Opt_BreakOnError dflags }
601
602 fromEvalResult :: EvalResult a -> IO a
603 fromEvalResult (EvalException e) = throwIO (fromSerializableException e)
604 fromEvalResult (EvalSuccess a) = return a