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,
mkUserStyle, cmdlineParserStyle, Depth(..),
-- * Error handling and debugging utilities
- pprPanic, assertPprPanic, pprPanicFastInt, pprPgmError,
+ pprPanic, pprSorry, assertPprPanic, pprPanicFastInt, pprPgmError,
pprTrace, warnPprTrace,
- trace, pgmError, panic, panicFastInt, assertPanic
+ trace, pgmError, panic, sorry, panicFastInt, assertPanic
) where
import {-# SOURCE #-} Module( Module, ModuleName, moduleName )
import Panic
import Data.Char
+import qualified Data.Map as M
+import qualified Data.IntMap as IM
import Data.Word
import System.IO ( Handle, stderr, stdout, hFlush )
import System.FilePath
+
+
+#if __GLASGOW_HASKELL__ >= 701
+import GHC.Show ( showMultiLineString )
+#else
+showMultiLineString :: String -> [String]
+-- Crude version
+showMultiLineString s = [ showList s "" ]
+#endif
\end{code}
+
%************************************************************************
%* *
\subsection{The @PprStyle@ data type}
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
instance Outputable FastString where
ppr fs = ftext fs -- Prints an unadorned string,
-- no double quotes or anything
+
+instance (Outputable key, Outputable elt) => Outputable (M.Map key elt) where
+ ppr m = ppr (M.toList m)
+instance (Outputable elt) => Outputable (IM.IntMap elt) where
+ ppr m = ppr (IM.toList m)
\end{code}
%************************************************************************
-- | Special combinator for showing string literals.
pprHsString :: FastString -> SDoc
-pprHsString fs = text (show (unpackFS fs))
+pprHsString fs = vcat (map text (showMultiLineString (unpackFS fs)))
---------------------
-- Put a name in parens if it's an operator
%************************************************************************
\begin{code}
+
pprPanic :: String -> SDoc -> a
-- ^ Throw an exception saying "bug in GHC"
-pprPgmError :: String -> SDoc -> a
--- ^ Throw an exception saying "bug in pgm being compiled" (used for unusual program errors)
-pprTrace :: String -> SDoc -> a -> a
--- ^ If debug output is on, show some 'SDoc' on the screen
-
pprPanic = pprAndThen panic
+pprSorry :: String -> SDoc -> a
+-- ^ Throw an exceptio saying "this isn't finished yet"
+pprSorry = pprAndThen sorry
+
+
+pprPgmError :: String -> SDoc -> a
+-- ^ Throw an exception saying "bug in pgm being compiled" (used for unusual program errors)
pprPgmError = pprAndThen pgmError
+
+pprTrace :: String -> SDoc -> a -> a
+-- ^ If debug output is on, show some 'SDoc' on the screen
pprTrace str doc x
| opt_NoDebugOutput = x
| otherwise = pprAndThen trace str doc x
+
pprPanicFastInt :: String -> SDoc -> FastInt
-- ^ Specialization of pprPanic that can be safely used with 'FastInt'
pprPanicFastInt heading pretty_msg = panicFastInt (show (doc PprDebug))
where
doc = text heading <+> pretty_msg
+
pprAndThen :: (String -> a) -> String -> SDoc -> a
pprAndThen cont heading pretty_msg = cont (show (doc PprDebug))
where