BindingSite(..),
- PprStyle, CodeStyle(..), PrintUnqualified, alwaysQualify, QualifyName(..),
+ PprStyle, CodeStyle(..), PrintUnqualified, alwaysQualify, neverQualify,
+ QualifyName(..),
getPprStyle, withPprStyle, withPprStyleDoc,
pprDeeper, pprDeeperList, pprSetDepth,
codeStyle, userStyle, debugStyle, dumpStyle, asmStyle,
ifPprDebug, qualName, qualModule,
mkErrStyle, defaultErrStyle, defaultDumpStyle, defaultUserStyle,
+ mkUserStyle,
SDoc, -- Abstract
docToSDoc,
speakNth, speakNTimes, speakN, speakNOf, plural,
printSDoc, printErrs, hPrintDump, printDump,
- printForC, printForAsm, printForUser,
+ printForC, printForAsm, printForUser, printForUserPartWay,
pprCode, mkCodeStyle,
showSDoc, showSDocForUser, showSDocDebug, showSDocDump,
showSDocUnqual, showsPrecSDoc,
pprHsChar, pprHsString,
-- error handling
- pprPanic, assertPprPanic, pprPanic#, pprPgmError,
+ pprPanic, assertPprPanic, pprPanicFastInt, pprPgmError,
pprTrace, warnPprTrace,
- trace, pgmError, panic, panic#, assertPanic
+ trace, pgmError, panic, panicFastInt, assertPanic
) where
-#include "HsVersions.h"
-
-
import {-# SOURCE #-} Module( Module, ModuleName, moduleName )
import {-# SOURCE #-} OccName( OccName )
-import StaticFlags ( opt_PprStyle_Debug, opt_PprUserLength )
+import StaticFlags
import FastString
import FastTypes
-import GHC.Ptr
import qualified Pretty
import Pretty ( Doc, Mode(..) )
import Panic
printForUser handle unqual doc
= Pretty.printDoc PageMode handle (doc (mkUserStyle unqual AllTheWay))
+printForUserPartWay :: Handle -> Int -> PrintUnqualified -> SDoc -> IO ()
+printForUserPartWay handle d unqual doc
+ = Pretty.printDoc PageMode handle (doc (mkUserStyle unqual (PartWay d)))
+
-- printForC, printForAsm do what they sound like
printForC :: Handle -> SDoc -> IO ()
printForC handle doc = Pretty.printDoc LeftMode handle (doc (PprCode CStyle))
text :: String -> SDoc
char :: Char -> SDoc
ftext :: FastString -> SDoc
-ptext :: Ptr t -> SDoc
+ptext :: LitString -> SDoc
int :: Int -> SDoc
integer :: Integer -> SDoc
float :: Float -> SDoc
colon _sty = Pretty.colon
equals _sty = Pretty.equals
space _sty = Pretty.space
-dcolon _sty = Pretty.ptext SLIT("::")
-arrow _sty = Pretty.ptext SLIT("->")
+dcolon _sty = Pretty.ptext (sLit "::")
+arrow _sty = Pretty.ptext (sLit "->")
underscore = char '_'
dot = char '.'
lparen _sty = Pretty.lparen
\begin{code}
instance Outputable Bool where
- ppr True = ptext SLIT("True")
- ppr False = ptext SLIT("False")
+ ppr True = ptext (sLit "True")
+ ppr False = ptext (sLit "False")
instance Outputable Int where
ppr n = int n
+instance Outputable Word32 where
+ ppr n = integer $ fromIntegral n
+
instance Outputable () where
ppr _ = text "()"
ppr (x,y) = parens (sep [ppr x <> comma, ppr y])
instance Outputable a => Outputable (Maybe a) where
- ppr Nothing = ptext SLIT("Nothing")
- ppr (Just x) = ptext SLIT("Just") <+> ppr x
+ ppr Nothing = ptext (sLit "Nothing")
+ ppr (Just x) = ptext (sLit "Just") <+> ppr x
instance (Outputable a, Outputable b) => Outputable (Either a b) where
- ppr (Left x) = ptext SLIT("Left") <+> ppr x
- ppr (Right y) = ptext SLIT("Right") <+> ppr y
+ ppr (Left x) = ptext (sLit "Left") <+> ppr x
+ ppr (Right y) = ptext (sLit "Right") <+> ppr y
-- ToDo: may not be used
instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c) where
instance (Outputable a, Outputable b, Outputable c, Outputable d) =>
Outputable (a, b, c, d) where
- ppr (x,y,z,w) =
- parens (sep [ppr x <> comma,
- ppr y <> comma,
- ppr z <> comma,
- ppr w])
+ ppr (a,b,c,d) =
+ parens (sep [ppr a <> comma,
+ ppr b <> comma,
+ ppr c <> comma,
+ ppr d])
+
+instance (Outputable a, Outputable b, Outputable c, Outputable d, Outputable e) =>
+ Outputable (a, b, c, d, e) where
+ ppr (a,b,c,d,e) =
+ parens (sep [ppr a <> comma,
+ ppr b <> comma,
+ ppr c <> comma,
+ ppr d <> comma,
+ ppr e])
instance Outputable FastString where
ppr fs = ftext fs -- Prints an unadorned string,
\begin{code}
speakNth :: Int -> SDoc
-speakNth 1 = ptext SLIT("first")
-speakNth 2 = ptext SLIT("second")
-speakNth 3 = ptext SLIT("third")
-speakNth 4 = ptext SLIT("fourth")
-speakNth 5 = ptext SLIT("fifth")
-speakNth 6 = ptext SLIT("sixth")
+speakNth 1 = ptext (sLit "first")
+speakNth 2 = ptext (sLit "second")
+speakNth 3 = ptext (sLit "third")
+speakNth 4 = ptext (sLit "fourth")
+speakNth 5 = ptext (sLit "fifth")
+speakNth 6 = ptext (sLit "sixth")
speakNth n = hcat [ int n, text suffix ]
where
suffix | n <= 20 = "th" -- 11,12,13 are non-std
last_dig = n `rem` 10
speakN :: Int -> SDoc
-speakN 0 = ptext SLIT("none") -- E.g. "he has none"
-speakN 1 = ptext SLIT("one") -- E.g. "he has one"
-speakN 2 = ptext SLIT("two")
-speakN 3 = ptext SLIT("three")
-speakN 4 = ptext SLIT("four")
-speakN 5 = ptext SLIT("five")
-speakN 6 = ptext SLIT("six")
+speakN 0 = ptext (sLit "none") -- E.g. "he has none"
+speakN 1 = ptext (sLit "one") -- E.g. "he has one"
+speakN 2 = ptext (sLit "two")
+speakN 3 = ptext (sLit "three")
+speakN 4 = ptext (sLit "four")
+speakN 5 = ptext (sLit "five")
+speakN 6 = ptext (sLit "six")
speakN n = int n
speakNOf :: Int -> SDoc -> SDoc
-speakNOf 0 d = ptext SLIT("no") <+> d <> char 's' -- E.g. "no arguments"
-speakNOf 1 d = ptext SLIT("one") <+> d -- E.g. "one argument"
+speakNOf 0 d = ptext (sLit "no") <+> d <> char 's' -- E.g. "no arguments"
+speakNOf 1 d = ptext (sLit "one") <+> d -- E.g. "one argument"
speakNOf n d = speakN n <+> d <> char 's' -- E.g. "three arguments"
speakNTimes :: Int {- >=1 -} -> SDoc
-speakNTimes t | t == 1 = ptext SLIT("once")
- | t == 2 = ptext SLIT("twice")
- | otherwise = speakN t <+> ptext SLIT("times")
+speakNTimes t | t == 1 = ptext (sLit "once")
+ | t == 2 = ptext (sLit "twice")
+ | otherwise = speakN t <+> ptext (sLit "times")
plural :: [a] -> SDoc
plural [_] = empty -- a bit frightening, but there you are
pprPgmError = pprAndThen pgmError -- Throw an exn saying "bug in pgm being compiled"
-- (used for unusual pgm errors)
-pprTrace = pprAndThen trace
+pprTrace str doc x
+ | opt_NoDebugOutput = x
+ | otherwise = pprAndThen trace str doc x
-pprPanic# :: String -> SDoc -> FastInt
-pprPanic# heading pretty_msg = panic# (show (doc PprDebug))
+pprPanicFastInt :: String -> SDoc -> FastInt
+pprPanicFastInt heading pretty_msg = panicFastInt (show (doc PprDebug))
where
doc = text heading <+> pretty_msg
msg]
warnPprTrace :: Bool -> String -> Int -> SDoc -> a -> a
+warnPprTrace _ _file _line _msg x | opt_NoDebugOutput = x
warnPprTrace False _file _line _msg x = x
warnPprTrace True file line msg x
= trace (show (doc PprDebug)) x