#include "MachDeps.h"
#if SIZEOF_HSWORD == 4
#define DIGITS 9
#define BASE 1000000000
#elif SIZEOF_HSWORD == 8
#define DIGITS 18
#define BASE 1000000000000000000
#else
#error Please define DIGITS and BASE
#endif
module GHC.Show
(
Show(..), ShowS,
shows, showChar, showString, showMultiLineString,
showParen, showList__, showSpace,
showLitChar, showLitString, protectEsc,
intToDigit, showSignedInt,
appPrec, appPrec1,
asciiTab,
)
where
import GHC.Base
import GHC.Num
import Data.Maybe
import GHC.List ((!!), foldr1, break)
import GHC.Generics (Arity(..), Associativity(..), Fixity(..))
\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 '"' . showLitString cs . showChar '"'
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
showLitString :: String -> ShowS
showLitString [] s = s
showLitString ('"' : cs) s = showString "\\\"" (showLitString cs s)
showLitString (c : cs) s = showLitChar c (showLitString cs s)
showMultiLineString :: String -> [String]
showMultiLineString str
= go '\"' str
where
go ch s = case break (== '\n') s of
(l, _:s'@(_:_)) -> (ch : showLitString l "\\") : go '\\' s'
(l, _) -> [ch : showLitString l "\""]
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} Instances for types of the generic deriving mechanism. \begin{code}
deriving instance Show Arity deriving instance Show Associativity deriving instance Show Fixity\end{code} %********************************************************* %* * \subsection{The @Integer@ instances for @Show@} %* * %********************************************************* \begin{code}
instance Show Integer where
showsPrec p n r
| p > 6 && n < 0 = '(' : integerToString n (')' : r)
| otherwise = integerToString n r
showList = showList__ (showsPrec 0)
integerToString :: Integer -> String -> String
integerToString n0 cs0
| n0 < 0 = '-' : integerToString' ( n0) cs0
| otherwise = integerToString' n0 cs0
where
integerToString' :: Integer -> String -> String
integerToString' n cs
| n < BASE = jhead (fromInteger n) cs
| otherwise = jprinth (jsplitf (BASE*BASE) n) cs
jsplitf :: Integer -> Integer -> [Integer]
jsplitf p n
| p > n = [n]
| otherwise = jsplith p (jsplitf (p*p) n)
jsplith :: Integer -> [Integer] -> [Integer]
jsplith p (n:ns) =
case n `quotRemInteger` p of
(# q, r #) ->
if q > 0 then q : r : jsplitb p ns
else r : jsplitb p ns
jsplith _ [] = error "jsplith: []"
jsplitb :: Integer -> [Integer] -> [Integer]
jsplitb _ [] = []
jsplitb p (n:ns) = case n `quotRemInteger` p of
(# q, r #) ->
q : r : jsplitb p ns
jprinth :: [Integer] -> String -> String
jprinth (n:ns) cs =
case n `quotRemInteger` BASE of
(# q', r' #) ->
let q = fromInteger q'
r = fromInteger r'
in if q > 0 then jhead q $ jblock r $ jprintb ns cs
else jhead r $ jprintb ns cs
jprinth [] _ = error "jprinth []"
jprintb :: [Integer] -> String -> String
jprintb [] cs = cs
jprintb (n:ns) cs = case n `quotRemInteger` BASE of
(# q', r' #) ->
let q = fromInteger q'
r = fromInteger r'
in jblock q $ jblock r $ jprintb ns cs
jhead :: Int -> String -> String
jhead n cs
| n < 10 = case unsafeChr (ord '0' + n) of
c@(C# _) -> c : cs
| otherwise = case unsafeChr (ord '0' + r) of
c@(C# _) -> jhead q (c : cs)
where
(q, r) = n `quotRemInt` 10
jblock = jblock' DIGITS
jblock' :: Int -> Int -> String -> String
jblock' d n cs
| d == 1 = case unsafeChr (ord '0' + n) of
c@(C# _) -> c : cs
| otherwise = case unsafeChr (ord '0' + r) of
c@(C# _) -> jblock' (d 1) q (c : cs)
where
(q, r) = n `quotRemInt` 10
\end{code}
RetroSearch is an open source project built by @garambo | Open a GitHub Issue
Search and Browse the WWW like it's 1997 | Search results from DuckDuckGo
HTML:
3.2
| Encoding:
UTF-8
| Version:
0.7.4