X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Futils%2FOutputable.lhs;h=c6ba81c225bbe57c04dcfc4781bf2cdb570e40db;hb=1caf694c7d5ea3699cfb988b25f0c850cedcd3e4;hp=84e8b9d1d48b0db7e307f305d363968166401db0;hpb=3545603ca61d81093151307477bdecb7910cb1b7;p=ghc-hetmet.git diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs index 84e8b9d..c6ba81c 100644 --- a/compiler/utils/Outputable.lhs +++ b/compiler/utils/Outputable.lhs @@ -17,7 +17,7 @@ module Outputable ( -- * Pretty printing combinators SDoc, docToSDoc, - interppSP, interpp'SP, pprQuotedList, pprWithCommas, + interppSP, interpp'SP, pprQuotedList, pprWithCommas, quotedListWithOr, empty, nest, char, text, ftext, ptext, @@ -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, @@ -186,6 +186,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 +287,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 @@ -660,7 +666,15 @@ interpp'SP xs = sep (punctuate comma (map ppr xs)) -- -- > [x,y,z] ==> `x', `y', `z' pprQuotedList :: Outputable a => [a] -> SDoc -pprQuotedList xs = hsep (punctuate comma (map (quotes . ppr) xs)) +pprQuotedList = quotedList . map ppr + +quotedList :: [SDoc] -> SDoc +quotedList xs = hsep (punctuate comma (map quotes xs)) + +quotedListWithOr :: [SDoc] -> SDoc +-- [x,y,z] ==> `x', `y' or `z' +quotedListWithOr xs@(_:_:_) = quotedList (init xs) <+> ptext (sLit "or") <+> quotes (last xs) +quotedListWithOr xs = quotedList xs \end{code}