Have addModFinalizer expose the local type environment.

Summary:
This annotates the splice point with 'HsSpliced ref e' where 'e' is the
result of the splice. 'ref' is a reference that the typechecker will fill with
the local type environment.

The finalizer then reads the ref and uses the local type environment, which
causes 'reify' to find local variables when run in the finalizer.

Test Plan: ./validate

Reviewers: simonpj, simonmar, bgamari, austin, goldfire

Reviewed By: goldfire

Subscribers: simonmar, thomie, mboes

Differential Revision: https://phabricator.haskell.org/D2286

GHC Trac Issues: #11832

1 files changed, 18 insertions, 18 deletions

diff --git a/libraries/ghci/GHCi/TH.hs b/libraries/ghci/GHCi/TH.hs
index 3495162a12..def6aee33e 100644
--- a/libraries/ghci/GHCi/TH.hs
+++ b/libraries/ghci/GHCi/TH.hs
@@ -5,7 +5,12 @@
 -- |
 -- Running TH splices
 --
-module GHCi.TH (startTH, finishTH, runTH, GHCiQException(..)) where
+module GHCi.TH
+  ( startTH
+  , runModFinalizerRefs
+  , runTH
+  , GHCiQException(..)
+  ) where
 
 {- Note [Remote Template Haskell]
 
@@ -110,14 +115,7 @@ import Unsafe.Coerce
 
 -- | Create a new instance of 'QState'
 initQState :: Pipe -> QState
-initQState p = QState M.empty [] Nothing p
-
-runModFinalizers :: GHCiQ ()
-runModFinalizers = go =<< getState
-  where
-    go s | (f:ff) <- qsFinalizers s = do
-      putState (s { qsFinalizers = ff}) >> TH.runQ f >> getState >>= go
-    go _ = return ()
+initQState p = QState M.empty Nothing p
 
 -- | The monad in which we run TH computations on the server
 newtype GHCiQ a = GHCiQ { runGHCiQ :: QState -> IO (a, QState) }
@@ -151,9 +149,6 @@ instance Fail.MonadFail GHCiQ where
 getState :: GHCiQ QState
 getState = GHCiQ $ \s -> return (s,s)
 
-putState :: QState -> GHCiQ ()
-putState s = GHCiQ $ \_ -> return ((),s)
-
 noLoc :: TH.Loc
 noLoc = TH.Loc "<no file>" "<no package>" "<no module>" (0,0) (0,0)
 
@@ -198,8 +193,8 @@ instance TH.Quasi GHCiQ where
   qRunIO m = GHCiQ $ \s -> fmap (,s) m
   qAddDependentFile file = ghcCmd (AddDependentFile file)
   qAddTopDecls decls = ghcCmd (AddTopDecls decls)
-  qAddModFinalizer fin = GHCiQ $ \s ->
-    return ((), s { qsFinalizers = fin : qsFinalizers s })
+  qAddModFinalizer fin = GHCiQ (\s -> mkRemoteRef fin >>= return . (, s)) >>=
+                         ghcCmd . AddModFinalizer
   qGetQ = GHCiQ $ \s ->
     let lookup :: forall a. Typeable a => Map TypeRep Dynamic -> Maybe a
         lookup m = fromDynamic =<< M.lookup (typeOf (undefined::a)) m
@@ -216,12 +211,17 @@ startTH = do
   r <- newIORef (initQState (error "startTH: no pipe"))
   mkRemoteRef r
 
--- | The implementation of the 'FinishTH' message.
-finishTH :: Pipe -> RemoteRef (IORef QState) -> IO ()
-finishTH pipe rstate = do
+-- | Runs the mod finalizers.
+--
+-- The references must be created on the caller process.
+runModFinalizerRefs :: Pipe -> RemoteRef (IORef QState)
+                    -> [RemoteRef (TH.Q ())]
+                    -> IO ()
+runModFinalizerRefs pipe rstate qrefs = do
+  qs <- mapM localRef qrefs
   qstateref <- localRef rstate
   qstate <- readIORef qstateref
-  _ <- runGHCiQ runModFinalizers qstate { qsPipe = pipe }
+  _ <- runGHCiQ (TH.runQ $ sequence_ qs) qstate { qsPipe = pipe }
   return ()
 
 -- | The implementation of the 'RunTH' message