\begin{code}
module GHC.Show
(
Show(..), ShowS,
shows, showChar, showString, showParen, showList__, showSpace,
showLitChar, protectEsc,
intToDigit, showSignedInt,
appPrec, appPrec1,
asciiTab,
)
where
import GHC.Base
import Data.Maybe
import GHC.List ((!!), foldr1)
\end{code}
%*********************************************************
%* *
\subsection{The @Show@ class}
%* *
%*********************************************************
\begin{code}
type ShowS = String -> String
class Show a where
showsPrec :: Int
-> a
-> ShowS
show :: a -> String
showList :: [a] -> ShowS
showsPrec _ x s = show x ++ s
show x = shows x ""
showList ls s = showList__ shows ls s
showList__ :: (a -> ShowS) -> [a] -> ShowS
showList__ _ [] s = "[]" ++ s
showList__ showx (x:xs) s = '[' : showx x (showl xs)
where
showl [] = ']' : s
showl (y:ys) = ',' : showx y (showl ys)
appPrec, appPrec1 :: Int
appPrec = I# 10#
appPrec1 = I# 11#
\end{code}
%*********************************************************
%* *
\subsection{Simple Instances}
%* *
%*********************************************************
\begin{code}
instance Show () where
showsPrec _ () = showString "()"
instance Show a => Show [a] where
showsPrec _ = showList
instance Show Bool where
showsPrec _ True = showString "True"
showsPrec _ False = showString "False"
instance Show Ordering where
showsPrec _ LT = showString "LT"
showsPrec _ EQ = showString "EQ"
showsPrec _ GT = showString "GT"
instance Show Char where
showsPrec _ '\'' = showString "'\\''"
showsPrec _ c = showChar '\'' . showLitChar c . showChar '\''
showList cs = showChar '"' . showl cs
where showl "" s = showChar '"' s
showl ('"':xs) s = showString "\\\"" (showl xs s)
showl (x:xs) s = showLitChar x (showl xs s)
instance Show Int where
showsPrec = showSignedInt
instance Show a => Show (Maybe a) where
showsPrec _p Nothing s = showString "Nothing" s
showsPrec p (Just x) s
= (showParen (p > appPrec) $
showString "Just " .
showsPrec appPrec1 x) s
\end{code}
%*********************************************************
%* *
\subsection{Show instances for the first few tuples
%* *
%*********************************************************
\begin{code}
instance (Show a, Show b) => Show (a,b) where
showsPrec _ (a,b) s = show_tuple [shows a, shows b] s
instance (Show a, Show b, Show c) => Show (a, b, c) where
showsPrec _ (a,b,c) s = show_tuple [shows a, shows b, shows c] s
instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where
showsPrec _ (a,b,c,d) s = show_tuple [shows a, shows b, shows c, shows d] s
instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where
showsPrec _ (a,b,c,d,e) s = show_tuple [shows a, shows b, shows c, shows d, shows e] s
instance (Show a, Show b, Show c, Show d, Show e, Show f) => Show (a,b,c,d,e,f) where
showsPrec _ (a,b,c,d,e,f) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f] s
instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g)
=> Show (a,b,c,d,e,f,g) where
showsPrec _ (a,b,c,d,e,f,g) s
= show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g] s
instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h)
=> Show (a,b,c,d,e,f,g,h) where
showsPrec _ (a,b,c,d,e,f,g,h) s
= show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h] s
instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i)
=> Show (a,b,c,d,e,f,g,h,i) where
showsPrec _ (a,b,c,d,e,f,g,h,i) s
= show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,
shows i] s
instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j)
=> Show (a,b,c,d,e,f,g,h,i,j) where
showsPrec _ (a,b,c,d,e,f,g,h,i,j) s
= show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,
shows i, shows j] s
instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k)
=> Show (a,b,c,d,e,f,g,h,i,j,k) where
showsPrec _ (a,b,c,d,e,f,g,h,i,j,k) s
= show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,
shows i, shows j, shows k] s
instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k,
Show l)
=> Show (a,b,c,d,e,f,g,h,i,j,k,l) where
showsPrec _ (a,b,c,d,e,f,g,h,i,j,k,l) s
= show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,
shows i, shows j, shows k, shows l] s
instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k,
Show l, Show m)
=> Show (a,b,c,d,e,f,g,h,i,j,k,l,m) where
showsPrec _ (a,b,c,d,e,f,g,h,i,j,k,l,m) s
= show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,
shows i, shows j, shows k, shows l, shows m] s
instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k,
Show l, Show m, Show n)
=> Show (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where
showsPrec _ (a,b,c,d,e,f,g,h,i,j,k,l,m,n) s
= show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,
shows i, shows j, shows k, shows l, shows m, shows n] s
instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k,
Show l, Show m, Show n, Show o)
=> Show (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where
showsPrec _ (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) s
= show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,
shows i, shows j, shows k, shows l, shows m, shows n, shows o] s
show_tuple :: [ShowS] -> ShowS
show_tuple ss = showChar '('
. foldr1 (\s r -> s . showChar ',' . r) ss
. showChar ')'
\end{code}
%*********************************************************
%* *
\subsection{Support code for @Show@}
%* *
%*********************************************************
\begin{code}
shows :: (Show a) => a -> ShowS
shows = showsPrec zeroInt
showChar :: Char -> ShowS
showChar = (:)
showString :: String -> ShowS
showString = (++)
showParen :: Bool -> ShowS -> ShowS
showParen b p = if b then showChar '(' . p . showChar ')' else p
showSpace :: ShowS
showSpace = \ xs -> ' ' : xs
\end{code}
Code specific for characters
\begin{code}
showLitChar :: Char -> ShowS
showLitChar c s | c > '\DEL' = showChar '\\' (protectEsc isDec (shows (ord c)) s)
showLitChar '\DEL' s = showString "\\DEL" s
showLitChar '\\' s = showString "\\\\" s
showLitChar c s | c >= ' ' = showChar c s
showLitChar '\a' s = showString "\\a" s
showLitChar '\b' s = showString "\\b" s
showLitChar '\f' s = showString "\\f" s
showLitChar '\n' s = showString "\\n" s
showLitChar '\r' s = showString "\\r" s
showLitChar '\t' s = showString "\\t" s
showLitChar '\v' s = showString "\\v" s
showLitChar '\SO' s = protectEsc (== 'H') (showString "\\SO") s
showLitChar c s = showString ('\\' : asciiTab!!ord c) s
isDec :: Char -> Bool
isDec c = c >= '0' && c <= '9'
protectEsc :: (Char -> Bool) -> ShowS -> ShowS
protectEsc p f = f . cont
where cont s@(c:_) | p c = "\\&" ++ s
cont s = s
asciiTab :: [String]
asciiTab =
["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",
"BS", "HT", "LF", "VT", "FF", "CR", "SO", "SI",
"DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",
"CAN", "EM", "SUB", "ESC", "FS", "GS", "RS", "US",
"SP"]
\end{code}
Code specific for Ints.
\begin{code}
intToDigit :: Int -> Char
intToDigit (I# i)
| i >=# 0# && i <=# 9# = unsafeChr (ord '0' `plusInt` I# i)
| i >=# 10# && i <=# 15# = unsafeChr (ord 'a' `minusInt` ten `plusInt` I# i)
| otherwise = error ("Char.intToDigit: not a digit " ++ show (I# i))
ten :: Int
ten = I# 10#
showSignedInt :: Int -> Int -> ShowS
showSignedInt (I# p) (I# n) r
| n <# 0# && p ># 6# = '(' : itos n (')' : r)
| otherwise = itos n r
itos :: Int# -> String -> String
itos n# cs
| n# <# 0# =
let !(I# minInt#) = minInt in
if n# ==# minInt#
then '-' : itos' (negateInt# (n# `quotInt#` 10#))
(itos' (negateInt# (n# `remInt#` 10#)) cs)
else '-' : itos' (negateInt# n#) cs
| otherwise = itos' n# cs
where
itos' :: Int# -> String -> String
itos' x# cs'
| x# <# 10# = C# (chr# (ord# '0'# +# x#)) : cs'
| otherwise = case chr# (ord# '0'# +# (x# `remInt#` 10#)) of { c# ->
itos' (x# `quotInt#` 10#) (C# c# : cs') }
\end{code}