Permalink
Browse files

Merge branch 'coloured-core' of https://github.com/nominolo/ghc into …

…coloured-core
  • Loading branch information...
2 parents c5f7496 + daead6b commit d45197aabb22178066a8ec50d29331786a0c518c @igfoo igfoo committed May 8, 2011
@@ -73,7 +73,6 @@ module Module
import Config
import Outputable
-import qualified Pretty
import Unique
import UniqFM
import FastString
@@ -253,9 +252,10 @@ mkModule :: PackageId -> ModuleName -> Module
mkModule = Module
pprModule :: Module -> SDoc
-pprModule mod@(Module p n) = pprPackagePrefix p mod <> pprModuleName n
+pprModule mod@(Module p n) =
+ pprPackagePrefix p mod <> pprModuleName n
-pprPackagePrefix :: PackageId -> Module -> PprStyle -> Pretty.Doc
+pprPackagePrefix :: PackageId -> Module -> SDoc
pprPackagePrefix p mod = getPprStyle doc
where
doc sty
@@ -233,5 +233,5 @@ missingArgErr f = Left ("missing argument for flag: " ++ f)
errorsToGhcException :: [Located String] -> GhcException
errorsToGhcException errs =
let errors = vcat [ ppr l <> text ": " <> text e | L l e <- errs ]
- in UsageError (showSDoc $ withPprStyle cmdlineParserStyle errors)
+ in UsageError (renderWithStyle errors cmdlineParserStyle)
@@ -804,12 +804,12 @@ defaultDynFlags mySettings =
log_action = \severity srcSpan style msg ->
case severity of
- SevOutput -> printOutput (msg style)
- SevInfo -> printErrs (msg style)
- SevFatal -> printErrs (msg style)
+ SevOutput -> printSDoc msg style
+ SevInfo -> printErrs msg style
+ SevFatal -> printErrs msg style
_ -> do
hPutChar stderr '\n'
- printErrs ((mkLocMessage srcSpan msg) style)
+ printErrs (mkLocMessage srcSpan msg) style
-- careful (#2302): printErrs prints in UTF-8, whereas
-- converting to string first and using hPutStr would
-- just emit the low 8 bits of each unicode char.
@@ -67,7 +67,8 @@ mkLocMessage locn msg
-- would look strange. Better to say explicitly "<no location info>".
printError :: SrcSpan -> Message -> IO ()
-printError span msg = printErrs (mkLocMessage span msg $ defaultErrStyle)
+printError span msg =
+ printErrs (mkLocMessage span msg) defaultErrStyle
-- -----------------------------------------------------------------------------
@@ -484,7 +484,7 @@ makeImportsDoc dflags imports
| otherwise
= Pretty.empty
- doPpr lbl = (lbl, Pretty.render $ pprCLabel lbl astyle)
+ doPpr lbl = (lbl, renderWithStyle (pprCLabel lbl) astyle)
astyle = mkCodeStyle AsmStyle
@@ -1147,7 +1147,7 @@ failIfM :: Message -> IfL a
failIfM msg
= do { env <- getLclEnv
; let full_msg = (if_loc env <> colon) $$ nest 2 msg
- ; liftIO (printErrs (full_msg defaultErrStyle))
+ ; liftIO (printErrs full_msg defaultErrStyle)
; failM }
--------------------
@@ -1182,7 +1182,7 @@ forkM_maybe doc thing_inside
; return Nothing }
}}
where
- print_errs sdoc = liftIO (printErrs (sdoc defaultErrStyle))
+ print_errs sdoc = liftIO (printErrs sdoc defaultErrStyle)
forkM :: SDoc -> IfL a -> IfL a
forkM doc thing_inside
Oops, something went wrong.

0 comments on commit d45197a

Please sign in to comment.