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, interppSP, interpp'SP,
27 #if __GLASGOW_HASKELL__ <= 200
33 #if __GLASGOW_HASKELL__ >= 202
37 import Ubiq ( Uniquable(..), Unique, Name ) -- FastString mentions it; todo: rm
43 import Util ( cmpPString )
47 %************************************************************************
49 \subsection{The @PprStyle@ data type}
51 %************************************************************************
55 = PprForUser Int -- Pretty-print in a way that will
56 -- make sense to the ordinary user;
57 -- must be very close to Haskell
59 -- Parameterised over how much to expand
60 -- a pretty-printed value (<= 0 => stop pp).
61 | PprQuote -- Like PprForUser, but also quote the whole thing
63 | PprDebug -- Standard debugging output
64 | PprShowAll -- Debugging output which leaves
65 -- nothing to the imagination
67 | PprInterface -- Interface generation
69 | PprForC -- must print out C-acceptable names
71 | PprForAsm -- must print out assembler-acceptable names
72 Bool -- prefix CLabel with underscore?
73 (String -> String) -- format AsmTempLabel
77 Orthogonal to the above printing styles are (possibly) some
78 command-line flags that affect printing (often carried with the
79 style). The most likely ones are variations on how much type info is
82 The following test decides whether or not we are actually generating
83 code (either C or assembly), or generating interface files.
85 codeStyle :: PprStyle -> Bool
86 codeStyle PprForC = True
87 codeStyle (PprForAsm _ _) = True
90 ifaceStyle :: PprStyle -> Bool
91 ifaceStyle PprInterface = True
92 ifaceStyle other = False
94 userStyle :: PprStyle -> Bool
95 userStyle PprQuote = True
96 userStyle (PprForUser _) = True
97 userStyle other = False
101 ifPprDebug sty p = case sty of PprDebug -> p ; _ -> empty
102 ifPprShowAll sty p = case sty of PprShowAll -> p ; _ -> empty
103 ifPprInterface sty p = case sty of PprInterface -> p ; _ -> empty
105 ifnotPprForUser sty p = case sty of { PprForUser _ -> empty ; PprQuote -> empty; _ -> p }
106 ifnotPprShowAll sty p = case sty of { PprShowAll -> empty ; _ -> p }
110 pprQuote :: PprStyle -> (PprStyle -> Doc) -> Doc
111 pprQuote PprQuote fn = quotes (fn (PprForUser 5{-opt_PprUserLength-}))
112 pprQuote sty fn = fn sty
117 %************************************************************************
119 \subsection[Outputable-class]{The @Outputable@ class}
121 %************************************************************************
124 class Outputable a where
125 ppr :: PprStyle -> a -> Doc
129 instance Outputable Bool where
130 ppr sty True = ptext SLIT("True")
131 ppr sty False = ptext SLIT("False")
133 instance Outputable Int where
136 instance (Outputable a) => Outputable [a] where
137 ppr sty xs = brackets (fsep (punctuate comma (map (ppr sty) xs)))
139 instance (Outputable a, Outputable b) => Outputable (a, b) where
141 hang (hcat [lparen, ppr sty x, comma]) 4 ((<>) (ppr sty y) rparen)
143 -- ToDo: may not be used
144 instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c) where
146 parens (sep [ (<>) (ppr sty x) comma,
147 (<>) (ppr sty y) comma,
152 %************************************************************************
154 \subsection{Other helper functions}
156 %************************************************************************
159 printDoc :: Mode -> Handle -> Doc -> IO ()
160 printDoc mode hdl doc
161 = fullRender mode 100 1.5 put done doc
163 put (Chr c) next = hPutChar hdl c >> next
164 put (Str s) next = hPutStr hdl s >> next
165 put (PStr s) next = hPutFS hdl s >> next
167 done = hPutChar hdl '\n'
172 interppSP :: Outputable a => PprStyle -> [a] -> Doc
173 interppSP sty xs = hsep (map (ppr sty) xs)
175 interpp'SP :: Outputable a => PprStyle -> [a] -> Doc
177 = hsep (punctuate comma (map (ppr sty) xs))
183 %************************************************************************
185 \subsection{Printing numbers verbally}
187 %************************************************************************
189 @speakNth@ converts an integer to a verbal index; eg 1 maps to
193 speakNth :: Int -> Doc
195 speakNth 1 = ptext SLIT("first")
196 speakNth 2 = ptext SLIT("second")
197 speakNth 3 = ptext SLIT("third")
198 speakNth 4 = ptext SLIT("fourth")
199 speakNth 5 = ptext SLIT("fifth")
200 speakNth 6 = ptext SLIT("sixth")
201 speakNth n = hcat [ int n, text st_nd_rd_th ]
203 st_nd_rd_th | n_rem_10 == 1 = "st"
204 | n_rem_10 == 2 = "nd"
205 | n_rem_10 == 3 = "rd"
208 n_rem_10 = n `rem` 10