Outputable(..), -- Class
PprStyle, CodeStyle(..), PrintUnqualified, alwaysQualify,
- getPprStyle, withPprStyle, pprDeeper,
- codeStyle, ifaceStyle, userStyle, debugStyle, asmStyle,
+ getPprStyle, withPprStyle, withPprStyleDoc, pprDeeper,
+ codeStyle, userStyle, debugStyle, asmStyle,
ifPprDebug, unqualStyle,
SDoc, -- Abstract
+ docToSDoc,
interppSP, interpp'SP, pprQuotedList, pprWithCommas,
empty, nest,
- text, char, ptext,
+ text, char, ftext, ptext,
int, integer, float, double, rational,
parens, brackets, braces, quotes, doubleQuotes, angleBrackets,
semi, comma, colon, dcolon, space, equals, dot,
speakNth, speakNTimes,
printSDoc, printErrs, printDump,
- printForC, printForAsm, printForIface, printForUser,
- pprCode, pprCols,
- showSDoc, showSDocDebug, showSDocIface, showSDocUnqual, showsPrecSDoc,
+ printForC, printForAsm, printForUser,
+ pprCode, mkCodeStyle,
+ showSDoc, showSDocForUser, showSDocDebug,
+ showSDocUnqual, showsPrecSDoc,
pprHsChar, pprHsString,
import {-# SOURCE #-} Name( Name )
-import IO ( Handle, hPutChar, hPutStr, stderr, stdout )
import CmdLineOpts ( opt_PprStyle_Debug, opt_PprUserLength )
import FastString
import qualified Pretty
-import Pretty ( Doc, Mode(..), TextDetails(..), fullRender )
+import Pretty ( Doc, Mode(..) )
import Panic
-import Char ( chr, ord, isDigit )
+
+import Word ( Word32 )
+import IO ( Handle, stderr, stdout )
+import Char ( chr )
+#if __GLASGOW_HASKELL__ < 410
+import Char ( ord, isDigit )
+#endif
\end{code}
withPprStyle :: PprStyle -> SDoc -> SDoc
withPprStyle sty d sty' = d sty
+withPprStyleDoc :: PprStyle -> SDoc -> Doc
+withPprStyleDoc sty d = d sty
+
pprDeeper :: SDoc -> SDoc
pprDeeper d (PprUser unqual (PartWay 0)) = Pretty.text "..."
pprDeeper d (PprUser unqual (PartWay n)) = d (PprUser unqual (PartWay (n-1)))
asmStyle (PprCode AsmStyle) = True
asmStyle other = False
-ifaceStyle :: PprStyle -> Bool
-ifaceStyle (PprInterface _) = True
-ifaceStyle other = False
-
debugStyle :: PprStyle -> Bool
debugStyle PprDebug = True
debugStyle other = False
\begin{code}
printSDoc :: SDoc -> PprStyle -> IO ()
-printSDoc d sty = printDoc PageMode stdout (d sty)
+printSDoc d sty = Pretty.printDoc PageMode stdout (d sty)
--- I'm not sure whether the direct-IO approach of printDoc
+-- I'm not sure whether the direct-IO approach of Pretty.printDoc
-- above is better or worse than the put-big-string approach here
printErrs :: PrintUnqualified -> SDoc -> IO ()
-printErrs unqual doc = printDoc PageMode stderr (doc style)
+printErrs unqual doc = Pretty.printDoc PageMode stderr (doc style)
where
style = mkUserStyle unqual (PartWay opt_PprUserLength)
printDump :: SDoc -> IO ()
-printDump doc = printDoc PageMode stdout (better_doc defaultUserStyle)
+printDump doc = Pretty.printDoc PageMode stdout (better_doc defaultUserStyle)
where
better_doc = doc $$ text ""
-- We used to always print in debug style, but I want
printForUser :: Handle -> PrintUnqualified -> SDoc -> IO ()
printForUser handle unqual doc
- = printDoc PageMode handle (doc (mkUserStyle unqual AllTheWay))
-
--- printForIface prints all on one line for interface files.
--- It's called repeatedly for successive lines
-printForIface :: Handle -> PrintUnqualified -> SDoc -> IO ()
-printForIface handle unqual doc
- = printDoc LeftMode handle (doc (PprInterface unqual))
+ = Pretty.printDoc PageMode handle (doc (mkUserStyle unqual AllTheWay))
-- printForC, printForAsm do what they sound like
printForC :: Handle -> SDoc -> IO ()
-printForC handle doc = printDoc LeftMode handle (doc (PprCode CStyle))
+printForC handle doc = Pretty.printDoc LeftMode handle (doc (PprCode CStyle))
printForAsm :: Handle -> SDoc -> IO ()
-printForAsm handle doc = printDoc LeftMode handle (doc (PprCode AsmStyle))
+printForAsm handle doc = Pretty.printDoc LeftMode handle (doc (PprCode AsmStyle))
pprCode :: CodeStyle -> SDoc -> SDoc
pprCode cs d = withPprStyle (PprCode cs) d
+mkCodeStyle :: CodeStyle -> PprStyle
+mkCodeStyle = PprCode
+
-- Can't make SDoc an instance of Show because SDoc is just a function type
-- However, Doc *is* an instance of Show
-- showSDoc just blasts it out as a string
showSDoc :: SDoc -> String
showSDoc d = show (d defaultUserStyle)
+showSDocForUser :: PrintUnqualified -> SDoc -> String
+showSDocForUser unqual doc = show (doc (mkUserStyle unqual AllTheWay))
+
showSDocUnqual :: SDoc -> String
-- Only used in the gruesome HsExpr.isOperator
showSDocUnqual d = show (d (mkUserStyle neverQualify AllTheWay))
showsPrecSDoc :: Int -> SDoc -> ShowS
showsPrecSDoc p d = showsPrec p (d defaultUserStyle)
-showSDocIface :: SDoc -> String
-showSDocIface doc = showDocWith OneLineMode (doc (PprInterface alwaysQualify))
-
showSDocDebug :: SDoc -> String
showSDocDebug d = show (d PprDebug)
\end{code}
\begin{code}
+docToSDoc :: Doc -> SDoc
+docToSDoc d = \_ -> d
+
empty sty = Pretty.empty
text s sty = Pretty.text s
char c sty = Pretty.char c
+ftext s sty = Pretty.ftext s
ptext s sty = Pretty.ptext s
int n sty = Pretty.int n
integer n sty = Pretty.integer n
pprHsChar :: Int -> SDoc
pprHsChar c = char '\'' <> text (showCharLit c "") <> char '\''
-pprHsString :: FAST_STRING -> SDoc
-pprHsString fs = doubleQuotes (text (foldr showCharLit "" (_UNPK_INT_ fs)))
+pprHsString :: FastString -> SDoc
+pprHsString fs = doubleQuotes (text (foldr showCharLit "" (unpackIntFS fs)))
showCharLit :: Int -> String -> String
showCharLit c rest
| c == ord '\r' = "\\r" ++ rest
| c == ord '\t' = "\\t" ++ rest
| c == ord '\v' = "\\v" ++ rest
- | otherwise = ('\\':) $ shows c $ case rest of
+ | otherwise = ('\\':) $ shows (fromIntegral c :: Word32) $ case rest of
d:_ | isDigit d -> "\\&" ++ rest
_ -> rest
-- of Char and String.
pprHsChar :: Int -> SDoc
-pprHsChar c = text (show (chr c))
+pprHsChar c | c > 0x10ffff = char '\\' <> text (show (fromIntegral c :: Word32))
+ | otherwise = text (show (chr c))
pprHsString :: FastString -> SDoc
pprHsString fs = text (show (unpackFS fs))
%************************************************************************
\begin{code}
-pprCols = (100 :: Int) -- could make configurable
-
-printDoc :: Mode -> Handle -> Doc -> IO ()
-printDoc mode hdl doc
- = fullRender mode pprCols 1.5 put done doc
- where
- put (Chr c) next = hPutChar hdl c >> next
- put (Str s) next = hPutStr hdl s >> next
- put (PStr s) next = hPutFS hdl s >> next
-
- done = hPutChar hdl '\n'
-
-showDocWith :: Mode -> Doc -> String
-showDocWith mode doc
- = fullRender mode 100 1.5 put "" doc
- where
- put (Chr c) s = c:s
- put (Str s1) s2 = s1 ++ s2
- put (PStr s1) s2 = _UNPK_ s1 ++ s2
-\end{code}
-
-
-\begin{code}
pprWithCommas :: (a -> SDoc) -> [a] -> SDoc
pprWithCommas pp xs = hsep (punctuate comma (map pp xs))
projects / ghc-hetmet.git / blobdiff