+initIfaceTc :: ModIface
+ -> (TcRef TypeEnv -> IfL a) -> TcRnIf gbl lcl a
+-- Used when type-checking checking an up-to-date interface file
+-- No type envt from the current module, but we do know the module dependencies
+initIfaceTc iface do_this
+ = do { tc_env_var <- newMutVar emptyTypeEnv
+ ; let { gbl_env = IfGblEnv { if_rec_types = Just (mod, readMutVar tc_env_var) } ;
+ ; if_lenv = mkIfLclEnv mod doc
+ }
+ ; setEnvs (gbl_env, if_lenv) (do_this tc_env_var)
+ }
+ where
+ mod = mi_module iface
+ doc = ptext SLIT("The interface for") <+> quotes (ppr mod)
+
+initIfaceRules :: HscEnv -> ModGuts -> IfG a -> IO a
+-- Used when sucking in new Rules in SimplCore
+-- We have available the type envt of the module being compiled, and we must use it
+initIfaceRules hsc_env guts do_this
+ = do { let {
+ type_info = (mg_module guts, return (mg_types guts))
+ ; gbl_env = IfGblEnv { if_rec_types = Just type_info } ;
+ }
+
+ -- Run the thing; any exceptions just bubble out from here
+ ; initTcRnIf 'i' hsc_env gbl_env () do_this
+ }
+
+initIfaceLcl :: Module -> SDoc -> IfL a -> IfM lcl a
+initIfaceLcl mod loc_doc thing_inside
+ = setLclEnv (mkIfLclEnv mod loc_doc) thing_inside
+
+getIfModule :: IfL Module
+getIfModule = do { env <- getLclEnv; return (if_mod env) }
+
+--------------------
+failIfM :: Message -> IfL a
+-- The Iface monad doesn't have a place to accumulate errors, so we
+-- just fall over fast if one happens; it "shouldnt happen".
+-- We use IfL here so that we can get context info out of the local env
+failIfM msg
+ = do { env <- getLclEnv
+ ; let full_msg = if_loc env $$ nest 2 msg
+ ; ioToIOEnv (printErrs (full_msg defaultErrStyle))
+ ; failM }
+
+--------------------
+forkM_maybe :: SDoc -> IfL a -> IfL (Maybe a)
+-- Run thing_inside in an interleaved thread.
+-- It shares everything with the parent thread, 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_maybe doc thing_inside
+ = do { unsafeInterleaveM $
+ do { traceIf (text "Starting fork {" <+> doc)
+ ; mb_res <- tryM thing_inside ;
+ case mb_res of
+ Right r -> do { traceIf (text "} ending fork" <+> doc)
+ ; return (Just r) }
+ Left exn -> do {
+
+ -- Bleat about errors in the forked thread, if -ddump-if-trace is on
+ -- Otherwise we silently discard errors. Errors can legitimately
+ -- happen when compiling interface signatures (see tcInterfaceSigs)
+ ifOptM Opt_D_dump_if_trace
+ (print_errs (hang (text "forkM failed:" <+> doc)
+ 4 (text (show exn))))
+
+ ; traceIf (text "} ending fork (badly)" <+> doc)
+ ; return Nothing }
+ }}
+ where
+ print_errs sdoc = ioToIOEnv (printErrs (sdoc defaultErrStyle))
+
+forkM :: SDoc -> IfL a -> IfL a
+forkM doc thing_inside
+ = do { mb_res <- forkM_maybe doc thing_inside
+ ; return (case mb_res of
+ Nothing -> pprPanic "forkM" doc
+ Just r -> r) }