+\begin{code}
+type SDoc = PprStyle -> Doc
+
+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)))
+pprDeeper d other_sty = d other_sty
+
+getPprStyle :: (PprStyle -> SDoc) -> SDoc
+getPprStyle df sty = df sty sty
+\end{code}
+
+\begin{code}
+unqualStyle :: PprStyle -> Name -> Bool
+unqualStyle (PprUser unqual _) n = unqual n
+unqualStyle other n = False
+
+codeStyle :: PprStyle -> Bool
+codeStyle (PprCode _) = True
+codeStyle _ = False
+
+asmStyle :: PprStyle -> Bool
+asmStyle (PprCode AsmStyle) = True
+asmStyle other = False
+
+debugStyle :: PprStyle -> Bool
+debugStyle PprDebug = True
+debugStyle other = False
+
+userStyle :: PprStyle -> Bool
+userStyle (PprUser _ _) = True
+userStyle other = False
+
+ifPprDebug :: SDoc -> SDoc -- Empty for non-debug style
+ifPprDebug d sty@PprDebug = d sty
+ifPprDebug d sty = Pretty.empty
+\end{code}
+
+\begin{code}
+-- Unused [7/02 sof]
+printSDoc :: SDoc -> PprStyle -> IO ()
+printSDoc d sty = do
+ Pretty.printDoc PageMode stdout (d sty)
+ hFlush stdout
+
+-- 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 :: Doc -> IO ()
+printErrs doc = do Pretty.printDoc PageMode stderr doc
+ hFlush stderr
+
+printDump :: SDoc -> IO ()
+printDump doc = do
+ Pretty.printDoc PageMode stdout (better_doc defaultUserStyle)
+ hFlush stdout
+ where
+ better_doc = doc $$ text ""
+ -- We used to always print in debug style, but I want
+ -- to try the effect of a more user-ish style (unless you
+ -- say -dppr-debug)
+
+printForUser :: Handle -> PrintUnqualified -> SDoc -> IO ()
+printForUser handle unqual doc
+ = Pretty.printDoc PageMode handle (doc (mkUserStyle unqual AllTheWay))
+
+-- printForC, printForAsm do what they sound like
+printForC :: Handle -> SDoc -> IO ()
+printForC handle doc = Pretty.printDoc LeftMode handle (doc (PprCode CStyle))
+
+printForAsm :: Handle -> SDoc -> IO ()
+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)
+
+showSDocDebug :: SDoc -> String
+showSDocDebug d = show (d PprDebug)
+\end{code}