+% ------------------------------------------------------------------------------
+% $Id: PrelShow.lhs,v 1.14 2001/09/18 14:42:33 simonmar Exp $
%
-% (c) The GRAP/AQUA Project, Glasgow University, 1992-1996
+% (c) The University of Glasgow, 1992-2000
%
+
\section{Module @PrelShow@}
import {-# SOURCE #-} PrelErr ( error )
import PrelBase
+import PrelTup
import PrelMaybe
import PrelList ( (!!), break, dropWhile
#ifdef USE_REPORT_PRELUDE
showsPrec _ x s = show x ++ s
show x = shows x ""
- showList ls = showList__ shows ls
+ showList ls s = showList__ shows ls s
showList__ :: (a -> ShowS) -> [a] -> ShowS
showList__ _ [] s = "[]" ++ s
showsPrec _ c = showChar '\'' . showLitChar c . showChar '\''
showList cs = showChar '"' . showl cs
- where showl "" = showChar '"'
- showl ('"':xs) = showString "\\\"" . showl xs
- showl (x:xs) = showLitChar x . showl xs
+ where showl "" s = showChar '"' s
+ showl ('"':xs) s = showString "\\\"" (showl xs s)
+ showl (x:xs) s = showLitChar x (showl xs s)
+ -- Making 's' an explicit parameter makes it clear to GHC
+ -- that showl has arity 2, which avoids it allocating an extra lambda
+ -- The sticking point is the recursive call to (showl xs), which
+ -- it can't figure out would be ok with arity 2.
-instance Show Int where
- showsPrec p n = showSignedInt p n
+instance Show Int where
+ showsPrec = showSignedInt
instance Show a => Show (Maybe a) where
- showsPrec _p Nothing = showString "Nothing"
- showsPrec _p (Just x) = showString "Just " . shows x
- -- Not sure I have the priorities right here
+ showsPrec _p Nothing s = showString "Nothing" s
+ showsPrec (I# p#) (Just x) s
+ = (showParen (p# >=# 10#) $
+ showString "Just " .
+ showsPrec (I# 10#) x) s
instance (Show a, Show b) => Show (Either a b) where
- showsPrec _p (Left a) = showString "Left " . shows a
- showsPrec _p (Right b) = showString "Right " . shows b
- -- Not sure I have the priorities right here
+ showsPrec (I# p#) e s =
+ (showParen (p# >=# 10#) $
+ case e of
+ Left a -> showString "Left " . showsPrec (I# 10#) a
+ Right b -> showString "Right " . showsPrec (I# 10#) b)
+ s
+
\end{code}
%*********************************************************
\begin{code}
+-- The explicit 's' parameters are important
+-- Otherwise GHC thinks that "shows x" might take a lot of work to compute
+-- and generates defns like
+-- showsPrec _ (x,y) = let sx = shows x; sy = shows y in
+-- \s -> showChar '(' (sx (showChar ',' (sy (showChar ')' s))))
+
instance (Show a, Show b) => Show (a,b) where
- showsPrec _ (x,y) = showChar '(' . shows x . showChar ',' .
- shows y . showChar ')'
+ showsPrec _ (x,y) s = (showChar '(' . shows x . showChar ',' .
+ shows y . showChar ')')
+ s
instance (Show a, Show b, Show c) => Show (a, b, c) where
- showsPrec _ (x,y,z) = showChar '(' . shows x . showChar ',' .
- shows y . showChar ',' .
- shows z . showChar ')'
+ showsPrec _ (x,y,z) s = (showChar '(' . shows x . showChar ',' .
+ shows y . showChar ',' .
+ shows z . showChar ')')
+ s
instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where
- showsPrec _ (w,x,y,z) = showChar '(' . shows w . showChar ',' .
- shows x . showChar ',' .
- shows y . showChar ',' .
- shows z . showChar ')'
+ showsPrec _ (w,x,y,z) s = (showChar '(' . shows w . showChar ',' .
+ shows x . showChar ',' .
+ shows y . showChar ',' .
+ shows z . showChar ')')
+ s
instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where
- showsPrec _ (v,w,x,y,z) = showChar '(' . shows v . showChar ',' .
- shows w . showChar ',' .
- shows x . showChar ',' .
- shows y . showChar ',' .
- shows z . showChar ')'
+ showsPrec _ (v,w,x,y,z) s = (showChar '(' . shows v . showChar ',' .
+ shows w . showChar ',' .
+ shows x . showChar ',' .
+ shows y . showChar ',' .
+ shows z . showChar ')')
+ s
\end{code}
\begin{code}
showLitChar :: Char -> ShowS
-showLitChar c | c > '\DEL' = showChar '\\' . protectEsc isDigit (shows (ord c))
-showLitChar '\DEL' = showString "\\DEL"
-showLitChar '\\' = showString "\\\\"
-showLitChar c | c >= ' ' = showChar c
-showLitChar '\a' = showString "\\a"
-showLitChar '\b' = showString "\\b"
-showLitChar '\f' = showString "\\f"
-showLitChar '\n' = showString "\\n"
-showLitChar '\r' = showString "\\r"
-showLitChar '\t' = showString "\\t"
-showLitChar '\v' = showString "\\v"
-showLitChar '\SO' = protectEsc (== 'H') (showString "\\SO")
-showLitChar c = showString ('\\' : asciiTab!!ord c)
+showLitChar c s | c > '\DEL' = showChar '\\' (protectEsc isDigit (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
+ -- I've done manual eta-expansion here, becuase otherwise it's
+ -- impossible to stop (asciiTab!!ord) getting floated out as an MFE
protectEsc :: (Char -> Bool) -> ShowS -> ShowS
protectEsc p f = f . cont
intToDigit :: Int -> Char
intToDigit (I# i)
- | i >=# 0# && i <=# 9# = unsafeChr (ord '0' `plusInt` I# i)
- | i >=# 10# && i <=# 15# = unsafeChr (ord 'a' `plusInt` I# i `minusInt` I# 10#)
- | otherwise = error ("Char.intToDigit: not a digit " ++ show (I# i))
+ | i >=# 0# && i <=# 9# = unsafeChr (ord '0' `plusInt` I# i)
+ | i >=# 10# && i <=# 15# = unsafeChr (ord 'a' `minusInt` I# 10# `plusInt` I# i)
+ | otherwise = error ("Char.intToDigit: not a digit " ++ show (I# i))
\end{code}
\begin{code}
showSignedInt :: Int -> Int -> ShowS
showSignedInt (I# p) (I# n) r
- | n <# 0# && p ># 6# = '(':itos n (')':r)
- | otherwise = itos n r
+ | n <# 0# && p ># 6# = '(' : itos n (')' : r)
+ | otherwise = itos n r
itos :: Int# -> String -> String
-itos n r
- | n >=# 0# = itos' n r
- | negateInt# n <# 0# = -- n is minInt, a difficult number
- itos (n `quotInt#` 10#) (itos' (negateInt# (n `remInt#` 10#)) r)
- | otherwise = '-':itos' (negateInt# n) r
- where
- itos' :: Int# -> String -> String
- -- x >= 0
- itos' x cs
- | x <# 10# = C# (chr# (x +# ord# '0'#)) : cs
- | otherwise = itos' (x `quotInt#` 10#)
- (C# (chr# (x `remInt#` 10# +# ord# '0'#)) : cs)
+itos n# cs
+ | n# <# 0# = let
+ n'# = negateInt# n#
+ in if n'# <# 0# -- minInt?
+ then '-' : itos' (negateInt# (n'# `quotInt#` 10#))
+ (itos' (negateInt# (n'# `remInt#` 10#)) cs)
+ else '-' : itos' n'# cs
+ | otherwise = itos' n# cs
+ where
+ itos' :: Int# -> String -> String
+ itos' n# cs
+ | n# <# 10# = C# (chr# (ord# '0'# +# n#)) : cs
+ | otherwise = case chr# (ord# '0'# +# (n# `remInt#` 10#)) of { c# ->
+ itos' (n# `quotInt#` 10#) (C# c# : cs) }
\end{code}
-
-
%*********************************************************
%* *
\subsection{Character stuff}
\begin{code}
isAscii, isLatin1, isControl, isPrint, isSpace, isUpper,
- isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum :: Char -> Bool
+ isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum,
+ isAsciiUpper, isAsciiLower :: Char -> Bool
isAscii c = c < '\x80'
isLatin1 c = c <= '\xff'
isControl c = c < ' ' || c >= '\DEL' && c <= '\x9f'
projects / ghc-hetmet.git / blobdiff