import Foreign
import Foreign.C
import GHC.Exts
-import GHC.Conc ( ThreadId(..) )
import Data.Array
import Control.Exception as Exception
import Control.Concurrent
sandboxIO :: MVar Status -> IO [HValue] -> IO Status
sandboxIO statusMVar thing =
withInterruptsSentTo
- (forkIO (do res <- Exception.try thing
+ (forkIO (do res <- Exception.try (rethrow thing)
putMVar statusMVar (Complete res)))
(takeMVar statusMVar)
+-- We want to turn ^C into a break when -fbreak-on-exception is on,
+-- but it's an async exception and we only break for sync exceptions.
+-- Idea: if we catch and re-throw it, then the re-throw will trigger
+-- a break. Great - but we don't want to re-throw all exceptions, because
+-- then we'll get a double break for ordinary sync exceptions (you'd have
+-- to :continue twice, which looks strange). So if the exception is
+-- not "Interrupted", we unset the exception flag before throwing.
+--
+rethrow :: IO a -> IO a
+rethrow io = Exception.catch io $ \e -> -- NB. not catchDyn
+ case e of
+ DynException d | Just Interrupted <- fromDynamic d
+ -> Exception.throwIO e
+ _ -> do poke exceptionFlag 0; Exception.throwIO e
+
+
withInterruptsSentTo :: IO ThreadId -> IO r -> IO r
withInterruptsSentTo io get_result = do
ts <- takeMVar interruptTargetThread
nameSetToGlobalRdrEnv :: NameSet -> ModuleName -> GlobalRdrEnv
nameSetToGlobalRdrEnv names mod =
- mkGlobalRdrEnv [ GRE { gre_name = name, gre_prov = vanillaProv mod }
+ mkGlobalRdrEnv [ GRE { gre_name = name, gre_par = NoParent, gre_prov = vanillaProv mod }
| name <- nameSetToList names ]
vanillaProv :: ModuleName -> Provenance
where
obj_linkable = isObjectLinkable (expectJust "showModule" (hm_linkable mod_info))
-obtainTerm1 :: Session -> Bool -> Maybe Type -> a -> IO Term
-obtainTerm1 sess force mb_ty x = withSession sess $ \hsc_env -> cvObtainTerm hsc_env force mb_ty (unsafeCoerce# x)
+obtainTerm1 :: HscEnv -> Bool -> Maybe Type -> a -> IO Term
+obtainTerm1 hsc_env force mb_ty x = cvObtainTerm hsc_env force mb_ty (unsafeCoerce# x)
-obtainTerm :: Session -> Bool -> Id -> IO Term
-obtainTerm sess force id = withSession sess $ \hsc_env -> do
+obtainTerm :: HscEnv -> Bool -> Id -> IO Term
+obtainTerm hsc_env force id = do
hv <- Linker.getHValue hsc_env (varName id)
cvObtainTerm hsc_env force (Just$ idType id) hv