X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FDebugger.hs;h=9c7c1f9f5a58e3a88a3c518526b9311b4d8dff95;hb=84923cc7de2a93c22a2f72daf9ac863959efae13;hp=7135359cb454bb1cef997a2b7239b68c4e42bfc0;hpb=121da25a0d638bbe6c7f90525ff50b3a20949bbc;p=ghc-hetmet.git diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs index 7135359..9c7c1f9 100644 --- a/compiler/ghci/Debugger.hs +++ b/compiler/ghci/Debugger.hs @@ -38,12 +38,12 @@ import ErrUtils import FastString import SrcLoc import Util +import Maybes import Control.Exception import Control.Monad import qualified Data.Map as Map import Data.Array.Unboxed -import Data.Traversable ( traverse ) import Data.Typeable ( Typeable ) import Data.Maybe import Data.IORef @@ -77,9 +77,9 @@ pprintClosureCommand bindThings force str = do -- Give names to suspensions and bind them in the local env mb_terms' <- if bindThings - then io$ mapM (traverse (bindSuspensions cms)) mb_terms + then io$ mapM (fmapMMaybe (bindSuspensions cms)) mb_terms else return mb_terms - ppr_terms <- io$ mapM (traverse (printTerm cms)) mb_terms' + ppr_terms <- io$ mapM (fmapMMaybe (printTerm cms)) mb_terms' let docs = [ ppr id <+> char '=' <+> t | (Just t,id) <- zip ppr_terms ids] unqual <- io$ GHC.getPrintUnqual cms io . putStrLn . showSDocForUser unqual $ Outputable.vcat docs @@ -534,7 +534,7 @@ refreshBkptTable :: [ModSummary] -> GHCi () refreshBkptTable [] = return () refreshBkptTable (ms:mod_sums) = do sess <- getSession - when (Opt_Debugging `elem` flags (GHC.ms_hspp_opts ms)) $ do + when isDebugging $ do old_table <- getBkptTable new_table <- addModuleGHC sess old_table (GHC.ms_mod ms) setBkptTable new_table @@ -547,3 +547,8 @@ refreshBkptTable (ms:mod_sums) = do (ppr mod <> text ": inserted " <> int (length sites) <> text " breakpoints") return$ addModule mod sites bt +#if defined(GHCI) && defined(DEBUGGER) + isDebugging = Opt_Debugging `elem` flags (GHC.ms_hspp_opts ms) +#else + isDebugging = False +#endif \ No newline at end of file