diff options
Diffstat (limited to 'compiler/ghci')
| -rw-r--r-- | compiler/ghci/Debugger.hs | 2 | ||||
| -rw-r--r-- | compiler/ghci/Linker.hs | 11 |
2 files changed, 9 insertions, 4 deletions
diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs index 81aab36ea9..64244729c4 100644 --- a/compiler/ghci/Debugger.hs +++ b/compiler/ghci/Debugger.hs @@ -170,7 +170,7 @@ showTerm term = do -- XXX: this tries to disable logging of errors -- does this still do what it is intended to do -- with the changed error handling and logging? - let noop_log _ _ _ _ _ = return () + let noop_log _ _ _ _ _ _ = return () expr = "show " ++ showPpr dflags bname _ <- GHC.setSessionDynFlags dflags{log_action=noop_log} fhv <- liftIO $ mkFinalizedHValue hsc_env =<< mkRemoteRef val diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs index 2b471ee0ee..4b8a322f58 100644 --- a/compiler/ghci/Linker.hs +++ b/compiler/ghci/Linker.hs @@ -235,7 +235,7 @@ withExtendedLinkEnv new_env action showLinkerState :: DynFlags -> IO () showLinkerState dflags = do pls <- readIORef v_PersistentLinkerState >>= readMVar - log_action dflags dflags SevDump noSrcSpan defaultDumpStyle + log_action dflags dflags NoReason SevDump noSrcSpan defaultDumpStyle (vcat [text "----- Linker state -----", text "Pkgs:" <+> ppr (pkgs_loaded pls), text "Objs:" <+> ppr (objs_loaded pls), @@ -374,7 +374,7 @@ classifyLdInput dflags f | isObjectFilename platform f = return (Just (Object f)) | isDynLibFilename platform f = return (Just (DLLPath f)) | otherwise = do - log_action dflags dflags SevInfo noSrcSpan defaultUserStyle + log_action dflags dflags NoReason SevInfo noSrcSpan defaultUserStyle (text ("Warning: ignoring unrecognised input `" ++ f ++ "'")) return Nothing where platform = targetPlatform dflags @@ -1397,7 +1397,12 @@ maybePutStr :: DynFlags -> String -> IO () maybePutStr dflags s = when (verbosity dflags > 1) $ do let act = log_action dflags - act dflags SevInteractive noSrcSpan defaultUserStyle (text s) + act dflags + NoReason + SevInteractive + noSrcSpan + defaultUserStyle + (text s) maybePutStrLn :: DynFlags -> String -> IO () maybePutStrLn dflags s = maybePutStr dflags (s ++ "\n") |