[Git][ghc/ghc][wip/js-th] Remove now useless HasInterpProcess class

[Sylvain Henry (@hsyl20)]

Sylvain Henry pushed to branch wip/js-th at Glasgow Haskell Compiler / GHC


Commits:
3a97efd9 by Sylvain Henry at 2023-01-20T11:14:56+01:00
Remove now useless HasInterpProcess class

- - - - -


2 changed files:

- compiler/GHC/Runtime/Interpreter/Process.hs
- compiler/GHC/Tc/Gen/Splice.hs


Changes:

=====================================
compiler/GHC/Runtime/Interpreter/Process.hs
=====================================
@@ -1,8 +1,7 @@
 module GHC.Runtime.Interpreter.Process
-  ( HasInterpProcess (..)
-
+  (
   -- * Low-level API
-  , callInterpProcess
+    callInterpProcess
   , readInterpProcess
   , writeInterpProcess
 
@@ -33,49 +32,44 @@ import Data.Binary
 import System.Exit
 import System.Process
 
-class HasInterpProcess i where
-  getInterpProcess :: i -> InterpProcess
-
-instance HasInterpProcess (ExtInterpInstance a) where
-  getInterpProcess = instProcess
-
 data DelayedResponse a = DelayedResponse
 
 -- | Send a message to the interpreter process that doesn't expect a response
-sendMessageNoResponse :: (HasInterpProcess i) => i -> Message () -> IO ()
-sendMessageNoResponse i m = writeInterpProcess (getInterpProcess i) (putMessage m)
+sendMessageNoResponse :: ExtInterpInstance d -> Message () -> IO ()
+sendMessageNoResponse i m = writeInterpProcess (instProcess i) (putMessage m)
 
 -- | Send a message to the interpreter that excepts a response
-sendMessage :: (HasInterpProcess i, Binary a) => i -> Message a -> IO a
-sendMessage i m = callInterpProcess (getInterpProcess i) m
+sendMessage :: Binary a => ExtInterpInstance d -> Message a -> IO a
+sendMessage i m = callInterpProcess (instProcess i) m
 
 -- | Send a message to the interpreter process whose response is expected later
 --
 -- This is useful to avoid forgetting to receive the value and to ensure that
 -- the type of the response isn't lost. Use receiveDelayedResponse to read it.
-sendMessageDelayedResponse :: (HasInterpProcess i) => i -> Message a -> IO (DelayedResponse a) 
+sendMessageDelayedResponse :: ExtInterpInstance d -> Message a -> IO (DelayedResponse a) 
 sendMessageDelayedResponse i m = do
-  writeInterpProcess (getInterpProcess i) (putMessage m)
+  writeInterpProcess (instProcess i) (putMessage m)
   pure DelayedResponse
 
 -- | Send any value
-sendAnyValue :: (HasInterpProcess i, Binary a) => i -> a -> IO ()
-sendAnyValue i m = writeInterpProcess (getInterpProcess i) (put m)
+sendAnyValue :: Binary a => ExtInterpInstance d -> a -> IO ()
+sendAnyValue i m = writeInterpProcess (instProcess i) (put m)
 
 -- | Expect a value to be received
-receiveAnyValue :: HasInterpProcess i => i -> Get a -> IO a
-receiveAnyValue i get = readInterpProcess (getInterpProcess i) get
+receiveAnyValue :: ExtInterpInstance d -> Get a -> IO a
+receiveAnyValue i get = readInterpProcess (instProcess i) get
 
 -- | Expect a delayed result to be received now
-receiveDelayedResponse :: (HasInterpProcess i, Binary a) => i -> DelayedResponse a -> IO a
-receiveDelayedResponse i DelayedResponse = readInterpProcess (getInterpProcess i) get
+receiveDelayedResponse :: Binary a => ExtInterpInstance d -> DelayedResponse a -> IO a
+receiveDelayedResponse i DelayedResponse = readInterpProcess (instProcess i) get
 
 -- | Expect a value to be received
-receiveTHMessage :: HasInterpProcess i => i -> IO THMsg
+receiveTHMessage :: ExtInterpInstance d -> IO THMsg
 receiveTHMessage i = receiveAnyValue i getTHMessage
 
+
 -- -----------------------------------------------------------------------------
--- Raw calls and messages
+-- Low-level API
 
 -- | Send a 'Message' and receive the response from the interpreter process
 callInterpProcess :: Binary a => InterpProcess -> Message a -> IO a
@@ -106,4 +100,3 @@ handleInterpProcessFailure i e = do
       terminateProcess hdl
       _ <- waitForProcess hdl
       throw e
-


=====================================
compiler/GHC/Tc/Gen/Splice.hs
=====================================
@@ -1715,19 +1715,18 @@ runTH ty fhv = do
 -- | communicate with a remotely-running TH computation until it finishes.
 -- See Note [Remote Template Haskell] in libraries/ghci/GHCi/TH.hs.
 runRemoteTH
-  :: HasInterpProcess i
-  => i
+  :: ExtInterpInstance d
   -> [Messages TcRnMessage]   --  saved from nested calls to qRecover
   -> TcM ()
-runRemoteTH iserv recovers = do
-  THMsg msg <- liftIO $ receiveTHMessage iserv
+runRemoteTH inst recovers = do
+  THMsg msg <- liftIO $ receiveTHMessage inst
   case msg of
     RunTHDone -> return ()
     StartRecover -> do -- Note [TH recover with -fexternal-interpreter]
       v <- getErrsVar
       msgs <- readTcRef v
       writeTcRef v emptyMessages
-      runRemoteTH iserv (msgs : recovers)
+      runRemoteTH inst (msgs : recovers)
     EndRecover caught_error -> do
       let (prev_msgs, rest) = case recovers of
              [] -> panic "EndRecover"
@@ -1738,11 +1737,11 @@ runRemoteTH iserv recovers = do
       writeTcRef v $ if caught_error
         then prev_msgs
         else mkMessages warn_msgs `unionMessages` prev_msgs
-      runRemoteTH iserv rest
+      runRemoteTH inst rest
     _other -> do
       r <- handleTHMessage msg
-      liftIO $ sendAnyValue iserv r
-      runRemoteTH iserv recovers
+      liftIO $ sendAnyValue inst r
+      runRemoteTH inst recovers
 
 -- | Check a QResult
 checkQResult :: QResult a -> TcM a
@@ -1793,15 +1792,15 @@ Back in GHC, when we receive:
 --
 -- The TH state is stored in tcg_th_remote_state in the TcGblEnv.
 --
-getTHState :: HasInterpProcess i => i -> TcM (FinalizedHeapRef (IORef QState))
-getTHState i = do
+getTHState :: ExtInterpInstance d -> TcM (FinalizedHeapRef (IORef QState))
+getTHState inst = do
   tcg <- getGblEnv
   th_state <- readTcRef (tcg_th_remote_state tcg)
   case th_state of
     Just rhv -> return rhv
     Nothing -> do
       interp <- tcGetInterp
-      fhv <- liftIO $ addHeapRefFinalizer interp =<< sendMessage i StartTH
+      fhv <- liftIO $ addHeapRefFinalizer interp =<< sendMessage inst StartTH
       writeTcRef (tcg_th_remote_state tcg) (Just fhv)
       return fhv
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3a97efd9fcf4aa9c5783f6496231c73271b4b8de

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3a97efd9fcf4aa9c5783f6496231c73271b4b8de
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230120/aa9db25f/attachment-0001.html>