-\begin{code}
-forkM :: SDoc -> TcM a -> TcM (Maybe a)
--- Run thing_inside in an interleaved thread. It gets a separate
--- * errs_var, and
--- * unique supply,
--- * LIE var is set to bottom (should never be used)
--- but everything else is shared, so this is DANGEROUS.
---
--- It returns Nothing if the computation fails
---
--- It's used for lazily type-checking interface
--- signatures, which is pretty benign
-
-forkM doc thing_inside
- = do { us <- newUniqueSupply ;
- unsafeInterleaveM $
- do { us_var <- newMutVar us ;
- (msgs, mb_res) <- tryTc (setLIEVar (panic "forkM: LIE used") $
- setUsVar us_var thing_inside) ;
- case mb_res of
- Just r -> return (Just r)
- Nothing -> do {
-
- -- Bleat about errors in the forked thread, if -ddump-tc-trace is on
- -- Otherwise we silently discard errors. Errors can legitimately
- -- happen when compiling interface signatures (see tcInterfaceSigs)
- ifOptM Opt_D_dump_tc_trace
- (ioToTcRn (do { printErrs (hdr_doc defaultErrStyle) ;
- printErrorsAndWarnings msgs })) ;
-
- return Nothing }
- }}
- where
- hdr_doc = text "forkM failed:" <+> doc
-\end{code}
-
-
-%************************************************************************
-%* *
- Unique supply
-%* *
-%************************************************************************
-
-\begin{code}
-getUsVar :: TcRn m (TcRef UniqSupply)
-getUsVar = do { env <- getTopEnv; return (top_us env) }
-
-setUsVar :: TcRef UniqSupply -> TcRn m a -> TcRn m a
-setUsVar v = updEnv (\ env@(Env { env_top = top_env }) ->
- env { env_top = top_env { top_us = v }})
-
-newUnique :: TcRn m Unique
-newUnique = do { us <- newUniqueSupply ;
- return (uniqFromSupply us) }
-
-newUniqueSupply :: TcRn m UniqSupply
-newUniqueSupply
- = do { u_var <- getUsVar ;
- us <- readMutVar u_var ;
- let { (us1, us2) = splitUniqSupply us } ;
- writeMutVar u_var us1 ;
- return us2 }
-\end{code}
-
-
-\begin{code}
-getNameCache :: TcRn m NameCache
-getNameCache = do { TopEnv { top_nc = nc_var } <- getTopEnv;
- readMutVar nc_var }
-
-setNameCache :: NameCache -> TcRn m ()
-setNameCache nc = do { TopEnv { top_nc = nc_var } <- getTopEnv;
- writeMutVar nc_var nc }
-\end{code}
-
-
-%************************************************************************
-%* *
- Debugging
-%* *
-%************************************************************************
-
-\begin{code}
-traceTc, traceRn :: SDoc -> TcRn a ()
-traceRn = dumpOptTcRn Opt_D_dump_rn_trace
-traceTc = dumpOptTcRn Opt_D_dump_tc_trace
-traceSplice = dumpOptTcRn Opt_D_dump_splices
-traceHiDiffs = dumpOptTcRn Opt_D_dump_hi_diffs
-
-dumpOptTcRn :: DynFlag -> SDoc -> TcRn a ()
-dumpOptTcRn flag doc = ifOptM flag (dumpTcRn doc)
-
-dumpTcRn :: SDoc -> TcRn a ()
-dumpTcRn doc = do { rdr_env <- getGlobalRdrEnv ;
- ioToTcRn (printForUser stderr (unQualInScope rdr_env) doc) }
-\end{code}
-