2 % (c) The GRASP Project, Glasgow University, 1992-1996
4 \section[Outputable]{Classes for pretty-printing}
6 Defines classes for pretty-printing and forcing, both forms of
10 #include "HsVersions.h"
13 Outputable(..), -- class
16 codeStyle, ifaceStyle, userStyle,
19 ifPprShowAll, ifnotPprShowAll,
23 printDoc, printErrs, pprCols, pprDumpStyle, pprErrorsStyle,
25 interppSP, interpp'SP,
29 #if __GLASGOW_HASKELL__ <= 200
35 #if __GLASGOW_HASKELL__ >= 202
38 # if __GLASGOW_HASKELL__ >= 209
43 import Ubiq ( Uniquable(..), Unique, Name ) -- FastString mentions it; todo: rm
47 import CmdLineOpts ( opt_PprStyle_All, opt_PprStyle_Debug, opt_PprStyle_User )
50 import Util ( cmpPString )
54 %************************************************************************
56 \subsection{The @PprStyle@ data type}
58 %************************************************************************
62 = PprForUser Int -- Pretty-print in a way that will
63 -- make sense to the ordinary user;
64 -- must be very close to Haskell
66 -- Parameterised over how much to expand
67 -- a pretty-printed value (<= 0 => stop pp).
68 | PprQuote -- Like PprForUser, but also quote the whole thing
70 | PprDebug -- Standard debugging output
71 | PprShowAll -- Debugging output which leaves
72 -- nothing to the imagination
74 | PprInterface -- Interface generation
76 | PprForC -- must print out C-acceptable names
78 | PprForAsm -- must print out assembler-acceptable names
79 Bool -- prefix CLabel with underscore?
80 (String -> String) -- format AsmTempLabel
84 Orthogonal to the above printing styles are (possibly) some
85 command-line flags that affect printing (often carried with the
86 style). The most likely ones are variations on how much type info is
89 The following test decides whether or not we are actually generating
90 code (either C or assembly), or generating interface files.
92 codeStyle :: PprStyle -> Bool
93 codeStyle PprForC = True
94 codeStyle (PprForAsm _ _) = True
97 ifaceStyle :: PprStyle -> Bool
98 ifaceStyle PprInterface = True
99 ifaceStyle other = False
101 userStyle :: PprStyle -> Bool
102 userStyle PprQuote = True
103 userStyle (PprForUser _) = True
104 userStyle other = False
108 ifPprDebug sty p = case sty of PprDebug -> p ; _ -> empty
109 ifPprShowAll sty p = case sty of PprShowAll -> p ; _ -> empty
110 ifPprInterface sty p = case sty of PprInterface -> p ; _ -> empty
112 ifnotPprForUser sty p = case sty of { PprForUser _ -> empty ; PprQuote -> empty; _ -> p }
113 ifnotPprShowAll sty p = case sty of { PprShowAll -> empty ; _ -> p }
117 pprQuote :: PprStyle -> (PprStyle -> Doc) -> Doc
118 pprQuote PprQuote fn = quotes (fn (PprForUser 5{-opt_PprUserLength-}))
119 pprQuote sty fn = fn sty
124 %************************************************************************
126 \subsection[Outputable-class]{The @Outputable@ class}
128 %************************************************************************
131 class Outputable a where
132 ppr :: PprStyle -> a -> Doc
136 instance Outputable Bool where
137 ppr sty True = ptext SLIT("True")
138 ppr sty False = ptext SLIT("False")
140 instance Outputable Int where
143 instance (Outputable a) => Outputable [a] where
144 ppr sty xs = brackets (fsep (punctuate comma (map (ppr sty) xs)))
146 instance (Outputable a, Outputable b) => Outputable (a, b) where
148 hang (hcat [lparen, ppr sty x, comma]) 4 ((<>) (ppr sty y) rparen)
150 -- ToDo: may not be used
151 instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c) where
153 parens (sep [ (<>) (ppr sty x) comma,
154 (<>) (ppr sty y) comma,
159 %************************************************************************
161 \subsection{Other helper functions}
163 %************************************************************************
166 pprCols = (100 :: Int) -- could make configurable
168 -- pprErrorsStyle is the style to print ordinary error messages with
169 -- pprDumpStyle is the style to print -ddump-xx information in
170 (pprDumpStyle, pprErrorsStyle)
171 | opt_PprStyle_All = (PprShowAll, PprShowAll)
172 | opt_PprStyle_Debug = (PprDebug, PprDebug)
173 | otherwise = (PprDebug, PprQuote)
175 printDoc :: Mode -> Handle -> Doc -> IO ()
176 printDoc mode hdl doc
177 = fullRender mode pprCols 1.5 put done doc
179 put (Chr c) next = hPutChar hdl c >> next
180 put (Str s) next = hPutStr hdl s >> next
181 put (PStr s) next = hPutFS hdl s >> next
183 done = hPutChar hdl '\n'
185 -- I'm not sure whether the direct-IO approach of printDoc
186 -- above is better or worse than the put-big-string approach here
187 printErrs :: Doc -> IO ()
188 printErrs doc = hPutStr stderr (show (doc $$ text ""))
193 interppSP :: Outputable a => PprStyle -> [a] -> Doc
194 interppSP sty xs = hsep (map (ppr sty) xs)
196 interpp'SP :: Outputable a => PprStyle -> [a] -> Doc
198 = hsep (punctuate comma (map (ppr sty) xs))
204 %************************************************************************
206 \subsection{Printing numbers verbally}
208 %************************************************************************
210 @speakNth@ converts an integer to a verbal index; eg 1 maps to
214 speakNth :: Int -> Doc
216 speakNth 1 = ptext SLIT("first")
217 speakNth 2 = ptext SLIT("second")
218 speakNth 3 = ptext SLIT("third")
219 speakNth 4 = ptext SLIT("fourth")
220 speakNth 5 = ptext SLIT("fifth")
221 speakNth 6 = ptext SLIT("sixth")
222 speakNth n = hcat [ int n, text st_nd_rd_th ]
224 st_nd_rd_th | n_rem_10 == 1 = "st"
225 | n_rem_10 == 2 = "nd"
226 | n_rem_10 == 3 = "rd"
229 n_rem_10 = n `rem` 10