X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FOutputable.lhs;h=73c6bd3fc2a623aee4a1f4813ef92564ae246c4c;hb=5a185e27def3ee8ace1704235eb277bc60c38618;hp=b9489909539559372225b6b0697e1582a2ffebc3;hpb=00022894bbb2dfa33fd213eedbac0f28b4c4b7b4;p=ghc-hetmet.git diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs index b948990..73c6bd3 100644 --- a/compiler/utils/Outputable.lhs +++ b/compiler/utils/Outputable.lhs @@ -23,7 +23,7 @@ module Outputable ( text, ftext, ptext, int, integer, float, double, rational, parens, cparen, brackets, braces, quotes, doubleQuotes, angleBrackets, - semi, comma, colon, dcolon, space, equals, dot, arrow, + semi, comma, colon, dcolon, space, equals, dot, arrow, darrow, lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore, blankLine, (<>), (<+>), hcat, hsep, @@ -34,7 +34,7 @@ module Outputable ( speakNth, speakNTimes, speakN, speakNOf, plural, -- * Converting 'SDoc' into strings and outputing it - printSDoc, printErrs, hPrintDump, printDump, + printSDoc, printErrs, printOutput, hPrintDump, printDump, printForC, printForAsm, printForUser, printForUserPartWay, pprCode, mkCodeStyle, showSDoc, showSDocOneLine, @@ -56,7 +56,7 @@ module Outputable ( codeStyle, userStyle, debugStyle, dumpStyle, asmStyle, ifPprDebug, qualName, qualModule, mkErrStyle, defaultErrStyle, defaultDumpStyle, defaultUserStyle, - mkUserStyle, Depth(..), + mkUserStyle, cmdlineParserStyle, Depth(..), -- * Error handling and debugging utilities pprPanic, assertPprPanic, pprPanicFastInt, pprPgmError, @@ -75,6 +75,8 @@ import Pretty ( Doc, Mode(..) ) import Panic import Data.Char +import Data.Map (Map) +import qualified Data.Map as M import Data.Word import System.IO ( Handle, stderr, stdout, hFlush ) import System.FilePath @@ -186,6 +188,9 @@ mkUserStyle :: PrintUnqualified -> Depth -> PprStyle mkUserStyle unqual depth | opt_PprStyle_Debug = PprDebug | otherwise = PprUser unqual depth + +cmdlineParserStyle :: PprStyle +cmdlineParserStyle = PprUser alwaysQualify AllTheWay \end{code} Orthogonal to the above printing styles are (possibly) some @@ -284,6 +289,9 @@ printErrs :: Doc -> IO () printErrs doc = do Pretty.printDoc PageMode stderr doc hFlush stderr +printOutput :: Doc -> IO () +printOutput doc = Pretty.printDoc PageMode stdout doc + printDump :: SDoc -> IO () printDump doc = hPrintDump stdout doc @@ -398,11 +406,12 @@ quotes d sty = case show pp_d of pp_d = d sty semi, comma, colon, equals, space, dcolon, arrow, underscore, dot :: SDoc -lparen, rparen, lbrack, rbrack, lbrace, rbrace, blankLine :: SDoc +darrow, lparen, rparen, lbrack, rbrack, lbrace, rbrace, blankLine :: SDoc blankLine _sty = Pretty.ptext (sLit "") dcolon _sty = Pretty.ptext (sLit "::") arrow _sty = Pretty.ptext (sLit "->") +darrow _sty = Pretty.ptext (sLit "=>") semi _sty = Pretty.semi comma _sty = Pretty.comma colon _sty = Pretty.colon @@ -557,6 +566,9 @@ instance (Outputable a, Outputable b, Outputable c, Outputable d, Outputable e) instance Outputable FastString where ppr fs = ftext fs -- Prints an unadorned string, -- no double quotes or anything + +instance (Outputable key, Outputable elt) => Outputable (Map key elt) where + ppr m = ppr (M.toList m) \end{code} %************************************************************************