diff options
| -rw-r--r-- | compiler/typecheck/TcRnMonad.lhs | 6 | ||||
| -rw-r--r-- | compiler/typecheck/TcRnTypes.lhs | 7 | ||||
| -rw-r--r-- | compiler/typecheck/TcSplice.lhs | 14 |
3 files changed, 27 insertions, 0 deletions
diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index 3ceebab733..b4b3f38ea0 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -53,6 +53,10 @@ import Util import Data.IORef import qualified Data.Set as Set import Control.Monad + +#ifdef GHCI +import qualified Data.Map as Map +#endif \end{code} @@ -95,6 +99,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod do_this th_topdecls_var <- newIORef [] ; th_topnames_var <- newIORef emptyNameSet ; th_modfinalizers_var <- newIORef [] ; + th_state_var <- newIORef Map.empty ; #endif /* GHCI */ let { maybe_rn_syntax :: forall a. a -> Maybe a ; @@ -107,6 +112,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod do_this tcg_th_topdecls = th_topdecls_var, tcg_th_topnames = th_topnames_var, tcg_th_modfinalizers = th_modfinalizers_var, + tcg_th_state = th_state_var, #endif /* GHCI */ tcg_mod = mod, diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs index a4be867dc5..c6f03f6cea 100644 --- a/compiler/typecheck/TcRnTypes.lhs +++ b/compiler/typecheck/TcRnTypes.lhs @@ -118,6 +118,10 @@ import Util import Data.Set (Set) #ifdef GHCI +import Data.Map ( Map ) +import Data.Dynamic ( Dynamic ) +import Data.Typeable ( TypeRep ) + import qualified Language.Haskell.TH as TH #endif \end{code} @@ -309,6 +313,9 @@ data TcGblEnv tcg_th_modfinalizers :: TcRef [TH.Q ()], -- ^ Template Haskell module finalizers + + tcg_th_state :: TcRef (Map TypeRep Dynamic), + -- ^ Template Haskell state #endif /* GHCI */ tcg_ev_binds :: Bag EvBind, -- Top-level evidence bindings diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs index 7807f58af7..c8063d9092 100644 --- a/compiler/typecheck/TcSplice.lhs +++ b/compiler/typecheck/TcSplice.lhs @@ -84,6 +84,10 @@ import qualified Language.Haskell.TH.Syntax as TH #ifdef GHCI -- Because GHC.Desugar might not be in the base library of the bootstrapping compiler import GHC.Desugar ( AnnotationWrapper(..) ) + +import qualified Data.Map as Map +import Data.Dynamic ( fromDynamic, toDyn ) +import Data.Typeable ( typeOf ) #endif import GHC.Exts ( unsafeCoerce# ) @@ -1089,6 +1093,16 @@ instance TH.Quasi (IOEnv (Env TcGblEnv TcLclEnv)) where qAddModFinalizer fin = do th_modfinalizers_var <- fmap tcg_th_modfinalizers getGblEnv updTcRef th_modfinalizers_var (\fins -> fin:fins) + + qGetQ = do + th_state_var <- fmap tcg_th_state getGblEnv + th_state <- readTcRef th_state_var + let x = Map.lookup (typeOf x) th_state >>= fromDynamic + return x + + qPutQ x = do + th_state_var <- fmap tcg_th_state getGblEnv + updTcRef th_state_var (\m -> Map.insert (typeOf x) (toDyn x) m) \end{code} |