Rodrigo Mesquita pushed to branch wip/romes/async-rpc at Glasgow Haskell Compiler / GHC Commits: 61f0d8e0 by Andrea Vezzosi at 2026-10-27T11:00:15+00:00 interp: do not terminate ext. interp. process on exception `sendMessage` throwing an exception does not warrant terminating the external interpreter process anymore, because communication can keep going no matter what. `stopInterp` now resets the whole `Interp` state, so that a new ExtInterpInstance can be later created and work correctly. `withExtInterp` now calls `stopInterp` on a `PipeClosedException` and rethrows. Fixes #18852 - - - - - 5 changed files: - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Interpreter/Process.hs - compiler/GHC/Tc/Gen/Splice.hs - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/Message/Async.hs Changes: ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -105,7 +105,7 @@ import GHCi.Run import Control.Concurrent import Control.Monad import Control.Monad.IO.Class -import Control.Monad.Catch as MC (mask) +import Control.Monad.Catch as MC (mask, handle, MonadThrow (..)) import Data.Binary import Data.ByteString (ByteString) import qualified Data.ByteString.Short as SBS @@ -196,14 +196,16 @@ interpCmd interp msg = case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) InternalInterp -> run msg -- Just run it directly #endif - ExternalInterp ext -> withExtInterp ext $ \inst -> + ExternalInterp ext -> withExtInterp interp ext $ \inst -> sendMessage inst msg -withExtInterp :: ExceptionMonad m => ExtInterp -> (forall d. ExtInterpInstance d -> m a) -> m a -withExtInterp ext action = case ext of +withExtInterp :: ExceptionMonad m => Interp -> ExtInterp -> (forall d. ExtInterpInstance d -> m a) -> m a +withExtInterp interp ext action = stopInterpOnPipeClosed $ case ext of ExtJS i -> withJSInterp i action ExtWasm i -> withWasmInterp i action ExtIServ i -> withIServ i action + where + stopInterpOnPipeClosed = MC.handle $ \ (e :: PipeClosedException) -> liftIO (stopInterp interp) >> MC.throwM e withExtInterpStatus :: ExtInterp -> (forall d. ExtInterpStatusVar d -> m a) -> m a withExtInterpStatus ext action = case ext of @@ -642,6 +644,9 @@ stopInterp interp = case interpInstance interp of else sendMessage i Shutdown -- We asked the server to shutdown, so we will also shutdown any communication. closePipe (interpPipe (instProcess i)) + modifyMVar_ (loader_state (interpLoader interp)) (const $ pure Nothing) + purgeInterpSymbolCache (interpSymbolCache interp) + modifyMVar_ (interpStringCache interp) (const $ pure emptyFsEnv) pure InterpPending -- ----------------------------------------------------------------------------- ===================================== compiler/GHC/Runtime/Interpreter/Process.hs ===================================== @@ -12,13 +12,10 @@ import GHC.Prelude import GHC.Runtime.Interpreter.Types import GHCi.Message -import GHC.IO (catchException) import GHC.Utils.Panic import GHC.Utils.Exception as Ex import Data.Binary -import System.Exit -import System.Process import Control.Concurrent import Data.IORef import Control.Concurrent.STM @@ -34,7 +31,6 @@ import Control.Concurrent.STM sendMessage :: Binary a => ExtInterpInstance d -> Message a -> IO a sendMessage i msg = remoteCall (interpPipe proc) msg - `catchException` \(e :: SomeException) -> handleInterpProcessFailure proc e where proc = instProcess i @@ -77,18 +73,6 @@ sendTHComputation i msg reqHandler = mask $ \restore -> do else loop in loop -handleInterpProcessFailure :: InterpProcess -> SomeException -> IO a -handleInterpProcessFailure i e = do - let hdl = interpHandle i - ex <- getProcessExitCode hdl - case ex of - Just (ExitFailure n) -> - throwIO (InstallationError ("External interpreter terminated (" ++ show n ++ ")")) - _ -> do - terminateProcess hdl - _ <- waitForProcess hdl - throw e - data CancelTHHandler = CancelTHHandler deriving Show instance Exception CancelTHHandler where fromException = asyncExceptionFromException ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -1160,7 +1160,7 @@ runRemoteModFinalizers (ThModFinalizers finRefs) = do runQinTcM $ sequence_ qs #endif - ExternalInterp ext -> withExtInterp ext $ \inst -> do + ExternalInterp ext -> withExtInterp interp ext $ \inst -> do tcg <- getGblEnv th_state <- readTcRef (tcg_th_remote_state tcg) case th_state of @@ -1817,7 +1817,7 @@ runTH ty fhv = do return r #endif - ExternalInterp ext -> withExtInterp ext $ \inst -> do + ExternalInterp ext -> withExtInterp interp ext $ \inst -> do -- Run it on the server. For an overview of how TH works with -- Remote GHCi, see Note [Remote Template Haskell] in -- libraries/ghci/GHCi/TH.hs. ===================================== libraries/ghci/GHCi/Message.hs ===================================== @@ -27,7 +27,7 @@ module GHCi.Message , Pipe(..), mkPipeFromHandles, mkPipeFromContinuations, closePipe , remoteCall, remoteTHCall , handleRemoteCall, handleRemoteTHCall, writeReply - , RemoteProcessException(..), PipeReadClosedException(..) + , RemoteProcessException(..), PipeClosedException(..) , InboxId(..) , newMailbox ===================================== libraries/ghci/GHCi/Message/Async.hs ===================================== @@ -7,7 +7,7 @@ module GHCi.Message.Async ( -- * Pipes Pipe(..), mkPipeFromHandles, mkPipeFromContinuations - , closePipe, PipeReadClosedException(..) + , closePipe, PipeClosedException(..) -- * Interface for async bidirectional RPC , remoteAsyncReq, handleAsyncReq @@ -145,13 +145,13 @@ closePipe p@Pipe{..} = do unless writeAlreadyClosed (throwTo (asyncFillTid pipeAsyncMngr) PipeWriteClosedException) --- | We've closed the pipe read end on this process -data PipeReadClosedException = PipeReadClosedException deriving Show -instance Exception PipeReadClosedException +data PipeClosedException + = PipeReadClosedException -- ^ We've closed the pipe read end on this process + + | PipeWriteClosedException -- ^ We've closed the pipe write end on this process + deriving Show +instance Exception PipeClosedException --- | We've closed the pipe write end on this process -data PipeWriteClosedException = PipeWriteClosedException deriving Show -instance Exception PipeWriteClosedException -------------------------------------------------------------------------------- -- ** Pipe thread-safe read/write View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/61f0d8e0feddeb1f9f49d5b7a8d30bd0... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/61f0d8e0feddeb1f9f49d5b7a8d30bd0... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help