X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FPrelShow.lhs;h=409ab93a7841034be5129f5b77b2bf7fe0d9025e;hb=239e9471e104fd88ec93bf42623c3a68a496657a;hp=42c6250b4398c379cdc21ff4ee85549ad8237195;hpb=cc4d138db7ea5b8bbd4767f665158fbf9bb97611;p=ghc-hetmet.git diff --git a/ghc/lib/std/PrelShow.lhs b/ghc/lib/std/PrelShow.lhs index 42c6250..409ab93 100644 --- a/ghc/lib/std/PrelShow.lhs +++ b/ghc/lib/std/PrelShow.lhs @@ -1,6 +1,9 @@ +% ------------------------------------------------------------------------------ +% $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@} @@ -31,6 +34,7 @@ module PrelShow import {-# SOURCE #-} PrelErr ( error ) import PrelBase +import PrelTup import PrelMaybe import PrelList ( (!!), break, dropWhile #ifdef USE_REPORT_PRELUDE @@ -57,7 +61,7 @@ class Show a where 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 @@ -95,22 +99,32 @@ instance Show Char where 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} @@ -121,27 +135,37 @@ instance (Show a, Show b) => Show (Either a b) where %********************************************************* \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} @@ -172,19 +196,21 @@ Code specific for characters \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 @@ -193,9 +219,9 @@ 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} @@ -204,26 +230,26 @@ Code specific for Ints. \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} @@ -232,7 +258,8 @@ itos n r \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'