X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FShow.lhs;h=f01e29b91cec200011bddc7fefa2989120bbdb02;hb=d9a0d6f44a930da4ae49678908e37793d693467c;hp=2edd0383deb1600053446c6c0643ae56b35eb5bb;hpb=7f1f4e7a695c402ddd3a1dc2cc7114e649a78ebc;p=ghc-base.git diff --git a/GHC/Show.lhs b/GHC/Show.lhs index 2edd038..f01e29b 100644 --- a/GHC/Show.lhs +++ b/GHC/Show.lhs @@ -1,15 +1,20 @@ -% ------------------------------------------------------------------------------ -% $Id: Show.lhs,v 1.1 2001/06/28 14:15:03 simonmar Exp $ -% -% (c) The University of Glasgow, 1992-2000 -% - -\section{Module @GHC.Show@} - - \begin{code} -{-# OPTIONS -fno-implicit-prelude #-} - +{-# OPTIONS_GHC -fno-implicit-prelude #-} +----------------------------------------------------------------------------- +-- | +-- Module : GHC.Show +-- Copyright : (c) The University of Glasgow, 1992-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc@haskell.org +-- Stability : internal +-- Portability : non-portable (GHC Extensions) +-- +-- The 'Show' class, and related operations. +-- +----------------------------------------------------------------------------- + +-- #hide module GHC.Show ( Show(..), ShowS, @@ -20,23 +25,19 @@ module GHC.Show shows, showChar, showString, showParen, showList__, showSpace, showLitChar, protectEsc, intToDigit, showSignedInt, + appPrec, appPrec1, -- Character operations - isAscii, isLatin1, isControl, isPrint, isSpace, isUpper, - isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum, - toUpper, toLower, asciiTab, - - -- String operations - lines, unlines, words, unwords ) where import {-# SOURCE #-} GHC.Err ( error ) import GHC.Base -import GHC.Tup -import GHC.Maybe -import GHC.List ( (!!), break, dropWhile +import GHC.Enum +import Data.Maybe +import Data.Either +import GHC.List ( (!!), #ifdef USE_REPORT_PRELUDE , concatMap, foldr1 #endif @@ -52,11 +53,92 @@ import GHC.List ( (!!), break, dropWhile %********************************************************* \begin{code} +-- | The @shows@ functions return a function that prepends the +-- output 'String' to an existing 'String'. This allows constant-time +-- concatenation of results using function composition. type ShowS = String -> String +-- | Conversion of values to readable 'String's. +-- +-- Minimal complete definition: 'showsPrec' or 'show'. +-- +-- Derived instances of 'Show' have the following properties, which +-- are compatible with derived instances of 'Text.Read.Read': +-- +-- * The result of 'show' is a syntactically correct Haskell +-- expression containing only constants, given the fixity +-- declarations in force at the point where the type is declared. +-- It contains only the constructor names defined in the data type, +-- parentheses, and spaces. When labelled constructor fields are +-- used, braces, commas, field names, and equal signs are also used. +-- +-- * If the constructor is defined to be an infix operator, then +-- 'showsPrec' will produce infix applications of the constructor. +-- +-- * the representation will be enclosed in parentheses if the +-- precedence of the top-level constructor in @x@ is less than @d@ +-- (associativity is ignored). Thus, if @d@ is @0@ then the result +-- is never surrounded in parentheses; if @d@ is @11@ it is always +-- surrounded in parentheses, unless it is an atomic expression. +-- +-- * If the constructor is defined using record syntax, then 'show' +-- will produce the record-syntax form, with the fields given in the +-- same order as the original declaration. +-- +-- For example, given the declarations +-- +-- > infixr 5 :^: +-- > data Tree a = Leaf a | Tree a :^: Tree a +-- +-- the derived instance of 'Show' is equivalent to +-- +-- > instance (Show a) => Show (Tree a) where +-- > +-- > showsPrec d (Leaf m) = showParen (d > app_prec) $ +-- > showString "Leaf " . showsPrec (app_prec+1) m +-- > where app_prec = 10 +-- > +-- > showsPrec d (u :^: v) = showParen (d > up_prec) $ +-- > showsPrec (up_prec+1) u . +-- > showString " :^: " . +-- > showsPrec (up_prec+1) v +-- > where up_prec = 5 +-- +-- Note that right-associativity of @:^:@ is ignored. For example, +-- +-- * @'show' (Leaf 1 :^: Leaf 2 :^: Leaf 3)@ produces the string +-- @\"Leaf 1 :^: (Leaf 2 :^: Leaf 3)\"@. + class Show a where - showsPrec :: Int -> a -> ShowS + -- | Convert a value to a readable 'String'. + -- + -- 'showsPrec' should satisfy the law + -- + -- > showsPrec d x r ++ s == showsPrec d x (r ++ s) + -- + -- Derived instances of 'Text.Read.Read' and 'Show' satisfy the following: + -- + -- * @(x,\"\")@ is an element of + -- @('Text.Read.readsPrec' d ('showsPrec' d x \"\"))@. + -- + -- That is, 'Text.Read.readsPrec' parses the string produced by + -- 'showsPrec', and delivers the value that 'showsPrec' started with. + + showsPrec :: Int -- ^ the operator precedence of the enclosing + -- context (a number from @0@ to @11@). + -- Function application has precedence @10@. + -> a -- ^ the value to be converted to a 'String' + -> ShowS + + -- | A specialised variant of 'showsPrec', using precedence context + -- zero, and returning an ordinary 'String'. show :: a -> String + + -- | The method 'showList' is provided to allow the programmer to + -- give a specialised way of showing lists of values. + -- For example, this is used by the predefined 'Show' instance of + -- the 'Char' type, where values of type 'String' should be shown + -- in double quotes, rather than between square brackets. showList :: [a] -> ShowS showsPrec _ x s = show x ++ s @@ -69,6 +151,12 @@ showList__ showx (x:xs) s = '[' : showx x (showl xs) where showl [] = ']' : s showl (y:ys) = ',' : showx y (showl ys) + +appPrec, appPrec1 :: Int + -- Use unboxed stuff because we don't have overloaded numerics yet +appPrec = I# 10# -- Precedence of application: + -- one more than the maximum operator precedence of 9 +appPrec1 = I# 11# -- appPrec + 1 \end{code} %********************************************************* @@ -112,19 +200,18 @@ instance Show Int where instance Show a => Show (Maybe a) where showsPrec _p Nothing s = showString "Nothing" s - showsPrec (I# p#) (Just x) s - = (showParen (p# >=# 10#) $ + showsPrec p (Just x) s + = (showParen (p > appPrec) $ showString "Just " . - showsPrec (I# 10#) x) s + showsPrec appPrec1 x) s instance (Show a, Show b) => Show (Either a b) where - showsPrec (I# p#) e s = - (showParen (p# >=# 10#) $ + showsPrec p e s = + (showParen (p > appPrec) $ case e of - Left a -> showString "Left " . showsPrec (I# 10#) a - Right b -> showString "Right " . showsPrec (I# 10#) b) + Left a -> showString "Left " . showsPrec appPrec1 a + Right b -> showString "Right " . showsPrec appPrec1 b) s - \end{code} @@ -176,15 +263,22 @@ instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where %********************************************************* \begin{code} +-- | equivalent to 'showsPrec' with a precedence of 0. shows :: (Show a) => a -> ShowS shows = showsPrec zeroInt +-- | utility function converting a 'Char' to a show function that +-- simply prepends the character unchanged. showChar :: Char -> ShowS showChar = (:) +-- | utility function converting a 'String' to a show function that +-- simply prepends the string unchanged. showString :: String -> ShowS showString = (++) +-- | utility function that surrounds the inner show function with +-- parentheses when the 'Bool' parameter is 'True'. showParen :: Bool -> ShowS -> ShowS showParen b p = if b then showChar '(' . p . showChar ')' else p @@ -195,8 +289,13 @@ showSpace = {-showChar ' '-} \ xs -> ' ' : xs Code specific for characters \begin{code} +-- | Convert a character to a string using only printable characters, +-- using Haskell source-language escape conventions. For example: +-- +-- > showLitChar '\n' s = "\\n" ++ s +-- showLitChar :: Char -> ShowS -showLitChar c s | c > '\DEL' = showChar '\\' (protectEsc isDigit (shows (ord c)) s) +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 @@ -212,22 +311,37 @@ 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 +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 -intToDigit :: Int -> Char -intToDigit (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)) +asciiTab :: [String] +asciiTab = -- Using an array drags in the array module. listArray ('\NUL', ' ') + ["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} +-- | Convert an 'Int' in the range @0@..@15@ to the corresponding single +-- digit 'Char'. This function fails on other inputs, and generates +-- lower-case hexadecimal digits. +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 = I# 10# + showSignedInt :: Int -> Int -> ShowS showSignedInt (I# p) (I# n) r | n <# 0# && p ># 6# = '(' : itos n (')' : r) @@ -246,133 +360,6 @@ itos n# cs itos' :: Int# -> String -> String itos' n# cs | n# <# 10# = C# (chr# (ord# '0'# +# n#)) : cs - | otherwise = itos' (n# `quotInt#` 10#) - (C# (chr# (ord# '0'# +# (n# `remInt#` 10#))) : cs) -\end{code} - -%********************************************************* -%* * -\subsection{Character stuff} -%* * -%********************************************************* - -\begin{code} -isAscii, isLatin1, isControl, isPrint, isSpace, isUpper, - 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' -isPrint c = not (isControl c) - --- isSpace includes non-breaking space --- Done with explicit equalities both for efficiency, and to avoid a tiresome --- recursion with GHC.List elem -isSpace c = c == ' ' || - c == '\t' || - c == '\n' || - c == '\r' || - c == '\f' || - c == '\v' || - c == '\xa0' - --- The upper case ISO characters have the multiplication sign dumped --- randomly in the middle of the range. Go figure. -isUpper c = c >= 'A' && c <= 'Z' || - c >= '\xC0' && c <= '\xD6' || - c >= '\xD8' && c <= '\xDE' --- The lower case ISO characters have the division sign dumped --- randomly in the middle of the range. Go figure. -isLower c = c >= 'a' && c <= 'z' || - c >= '\xDF' && c <= '\xF6' || - c >= '\xF8' && c <= '\xFF' -isAsciiLower c = c >= 'a' && c <= 'z' -isAsciiUpper c = c >= 'A' && c <= 'Z' - -isAlpha c = isLower c || isUpper c -isDigit c = c >= '0' && c <= '9' -isOctDigit c = c >= '0' && c <= '7' -isHexDigit c = isDigit c || c >= 'A' && c <= 'F' || - c >= 'a' && c <= 'f' -isAlphaNum c = isAlpha c || isDigit c - --- Case-changing operations - -toUpper, toLower :: Char -> Char -toUpper c@(C# c#) - | isAsciiLower c = C# (chr# (ord# c# -# 32#)) - | isAscii c = c - -- fall-through to the slower stuff. - | isLower c && c /= '\xDF' && c /= '\xFF' - = unsafeChr (ord c `minusInt` ord 'a' `plusInt` ord 'A') - | otherwise - = c - - - -toLower c@(C# c#) - | isAsciiUpper c = C# (chr# (ord# c# +# 32#)) - | isAscii c = c - | isUpper c = unsafeChr (ord c `minusInt` ord 'A' `plusInt` ord 'a') - | otherwise = c - -asciiTab :: [String] -asciiTab = -- Using an array drags in the array module. listArray ('\NUL', ' ') - ["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} - -%********************************************************* -%* * -\subsection{Functions on strings} -%* * -%********************************************************* - -lines breaks a string up into a list of strings at newline characters. -The resulting strings do not contain newlines. Similary, words -breaks a string up into a list of words, which were delimited by -white space. unlines and unwords are the inverse operations. -unlines joins lines with terminating newlines, and unwords joins -words with separating spaces. - -\begin{code} -lines :: String -> [String] -lines "" = [] -lines s = let (l, s') = break (== '\n') s - in l : case s' of - [] -> [] - (_:s'') -> lines s'' - -words :: String -> [String] -words s = case dropWhile {-partain:Char.-}isSpace s of - "" -> [] - s' -> w : words s'' - where (w, s'') = - break {-partain:Char.-}isSpace s' - -unlines :: [String] -> String -#ifdef USE_REPORT_PRELUDE -unlines = concatMap (++ "\n") -#else --- HBC version (stolen) --- here's a more efficient version -unlines [] = [] -unlines (l:ls) = l ++ '\n' : unlines ls -#endif - -unwords :: [String] -> String -#ifdef USE_REPORT_PRELUDE -unwords [] = "" -unwords ws = foldr1 (\w s -> w ++ ' ':s) ws -#else --- HBC version (stolen) --- here's a more efficient version -unwords [] = "" -unwords [w] = w -unwords (w:ws) = w ++ ' ' : unwords ws -#endif - + | otherwise = case chr# (ord# '0'# +# (n# `remInt#` 10#)) of { c# -> + itos' (n# `quotInt#` 10#) (C# c# : cs) } \end{code}