X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FOutputable.lhs;h=548dc2ca8b53b72f94675506318e22d9a579f0b8;hb=c35325dd60a671e6e7fcc513fc3ae02586106c4c;hp=79a491717641f36251526bb3f6d351a5a0b12531;hpb=befdf6ad2c5ede7a30f2aa31eeb506562928fbe0;p=ghc-hetmet.git diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs index 79a4917..548dc2c 100644 --- a/compiler/utils/Outputable.lhs +++ b/compiler/utils/Outputable.lhs @@ -41,6 +41,7 @@ module Outputable ( pprInfixVar, pprPrefixVar, pprHsChar, pprHsString, pprHsInfix, pprHsVar, + pprFastFilePath, -- * Controlling the style in which output is printed BindingSite(..), @@ -52,7 +53,7 @@ module Outputable ( codeStyle, userStyle, debugStyle, dumpStyle, asmStyle, ifPprDebug, qualName, qualModule, mkErrStyle, defaultErrStyle, defaultDumpStyle, defaultUserStyle, - mkUserStyle, + mkUserStyle, Depth(..), -- * Error handling and debugging utilities pprPanic, assertPprPanic, pprPanicFastInt, pprPgmError, @@ -74,6 +75,7 @@ import Panic import Data.Word ( Word32 ) import System.IO ( Handle, stderr, stdout, hFlush ) import Data.Char ( ord ) +import System.FilePath \end{code} @@ -154,9 +156,7 @@ alwaysQualifyModules _ = True neverQualifyModules :: QueryQualifyModule neverQualifyModules _ = False -type QueryQualifies = (QueryQualifyName, QueryQualifyModule) - -alwaysQualify, neverQualify :: QueryQualifies +alwaysQualify, neverQualify :: PrintUnqualified alwaysQualify = (alwaysQualifyNames, alwaysQualifyModules) neverQualify = (neverQualifyNames, neverQualifyModules) @@ -179,7 +179,7 @@ defaultErrStyle | opt_PprStyle_Debug = mkUserStyle alwaysQualify AllTheWay | otherwise = mkUserStyle alwaysQualify (PartWay opt_PprUserLength) -mkUserStyle :: QueryQualifies -> Depth -> PprStyle +mkUserStyle :: PrintUnqualified -> Depth -> PprStyle mkUserStyle unqual depth | opt_PprStyle_Debug = PprDebug | otherwise = PprUser unqual depth @@ -601,6 +601,9 @@ isOperator ppr_v ('_':_) -> False -- Not an operator (c:_) -> not (isAlpha c) -- Starts with non-alpha _ -> False + +pprFastFilePath :: FastString -> SDoc +pprFastFilePath path = text $ normalise $ unpackFS path \end{code} %************************************************************************