hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

removing tracingDynFlags.

Browse Source
This commit is contained in:
Kazu Yamamoto 2013-03-13 10:54:50 +09:00
parent c354001577
commit 9226c5e741
2 changed files with 15 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
ErrMsg.hs
View File

@ -8,6 +8,7 @@ import Bag
import Control.Applicative import Control.Applicative
import Data.IORef import Data.IORef
import Data.Maybe import Data.Maybe
import Doc
import DynFlags import DynFlags
import ErrUtils import ErrUtils
import GHC import GHC
@ -31,27 +32,29 @@ setLogger True df = do
let newdf = Gap.setLogAction df $ appendLog ref let newdf = Gap.setLogAction df $ appendLog ref
return (newdf, reverse <$> readIORef ref) return (newdf, reverse <$> readIORef ref)
where where
appendLog ref _ sev src stl msg = modifyIORef ref (\ls -> ppMsg src sev msg stl : ls) appendLog ref _ sev src _ msg = modifyIORef ref (\ls -> ppMsg src sev df msg : ls)
---------------------------------------------------------------- ----------------------------------------------------------------
handleErrMsg :: SourceError -> Ghc [String] handleErrMsg :: SourceError -> Ghc [String]
handleErrMsg = return . errBagToStrList . srcErrorMessages handleErrMsg err = do
dflag <- getSessionDynFlags
return . errBagToStrList dflag . srcErrorMessages $ err
errBagToStrList :: Bag ErrMsg -> [String] errBagToStrList :: DynFlags -> Bag ErrMsg -> [String]
errBagToStrList = map ppErrMsg . reverse . bagToList errBagToStrList dflag = map (ppErrMsg dflag) . reverse . bagToList
---------------------------------------------------------------- ----------------------------------------------------------------
ppErrMsg :: ErrMsg -> String ppErrMsg :: DynFlags -> ErrMsg -> String
ppErrMsg err = ppMsg spn SevError msg defaultUserStyle ++ ext ppErrMsg dflag err = ppMsg spn SevError dflag msg ++ ext
where where
spn = head (errMsgSpans err) spn = head (errMsgSpans err)
msg = errMsgShortDoc err msg = errMsgShortDoc err
ext = showMsg (errMsgExtraInfo err) defaultUserStyle ext = showMsg dflag (errMsgExtraInfo err)
ppMsg :: SrcSpan -> Severity-> SDoc -> PprStyle -> String ppMsg :: SrcSpan -> Severity-> DynFlags -> SDoc -> String
ppMsg spn sev msg stl = fromMaybe def $ do ppMsg spn sev dflag msg = fromMaybe def $ do
(line,col,_,_) <- Gap.getSrcSpan spn (line,col,_,_) <- Gap.getSrcSpan spn
file <- normalise <$> Gap.getSrcFile spn file <- normalise <$> Gap.getSrcFile spn
let severityCaption = Gap.showSeverityCaption sev let severityCaption = Gap.showSeverityCaption sev
@ -59,12 +62,12 @@ ppMsg spn sev msg stl = fromMaybe def $ do
++ show col ++ ":" ++ severityCaption ++ cts ++ "\0" ++ show col ++ ":" ++ severityCaption ++ cts ++ "\0"
where where
def = "ghc-mod:0:0:Probably mutual module import occurred\0" def = "ghc-mod:0:0:Probably mutual module import occurred\0"
cts = showMsg msg stl cts = showMsg dflag msg
---------------------------------------------------------------- ----------------------------------------------------------------
showMsg :: SDoc -> PprStyle -> String showMsg :: DynFlags -> SDoc -> String
showMsg d stl = map toNull $ Gap.renderMsg d stl showMsg dflag sdoc = map toNull $ showQualifiedPage dflag sdoc
where where
toNull '\n' = '\0' toNull '\n' = '\0'
toNull x = x toNull x = x

12
Gap.hs
View File

@ -8,7 +8,6 @@ module Gap (
, supportedExtensions , supportedExtensions
, getSrcSpan , getSrcSpan
, getSrcFile , getSrcFile
, renderMsg
, setCtx , setCtx
, fOptions , fOptions
, toStringBuffer , toStringBuffer
@ -127,17 +126,6 @@ getSrcFile _ = Nothing
---------------------------------------------------------------- ----------------------------------------------------------------
renderMsg :: SDoc -> PprStyle -> String
#if __GLASGOW_HASKELL__ >= 706
renderMsg d stl = renderWithStyle tracingDynFlags d stl
#elif __GLASGOW_HASKELL__ >= 702
renderMsg d stl = renderWithStyle d stl
#else
renderMsg d stl = Pretty.showDocWith PageMode $ d stl
#endif
----------------------------------------------------------------
toStringBuffer :: [String] -> Ghc StringBuffer toStringBuffer :: [String] -> Ghc StringBuffer
#if __GLASGOW_HASKELL__ >= 702 #if __GLASGOW_HASKELL__ >= 702
toStringBuffer = return . stringToStringBuffer . unlines toStringBuffer = return . stringToStringBuffer . unlines