X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FShow.lhs;h=bbfe45849b56f0affa5fc0e59817993e77cf8997;hb=a4f3f0790c84739ab08ee0e41a4b7a7132cdba0b;hp=30858da226769e79321cd52b9e3acfce20904e66;hpb=ad2f35188663652eca67184e744419478ac4b601;p=ghc-base.git

diff --git a/GHC/Show.lhs b/GHC/Show.lhs
index 30858da..bbfe458 100644
--- a/GHC/Show.lhs
+++ b/GHC/Show.lhs
@@ -1,6 +1,7 @@
 \begin{code}
-{-# OPTIONS_GHC -fno-implicit-prelude #-}
+{-# LANGUAGE NoImplicitPrelude, BangPatterns, MagicHash, StandaloneDeriving #-}
 {-# OPTIONS_HADDOCK hide #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.Show
@@ -23,8 +24,9 @@ module GHC.Show
         -- Instances for Show: (), [], Bool, Ordering, Int, Char
 
         -- Show support code
-        shows, showChar, showString, showParen, showList__, showSpace,
-        showLitChar, protectEsc,
+        shows, showChar, showString, showMultiLineString,
+        showParen, showList__, showSpace,
+        showLitChar, showLitString, protectEsc,
         intToDigit, showSignedInt,
         appPrec, appPrec1,
 
@@ -35,12 +37,9 @@ module GHC.Show
 
 import GHC.Base
 import Data.Maybe
-import Data.Either
-import GHC.List ( (!!), foldr1
-#ifdef USE_REPORT_PRELUDE
-                , concatMap
-#endif
-                )
+import GHC.List ((!!), foldr1, break)
+-- For defining instances for the generic deriving mechanism
+import GHC.Generics (Arity(..), Associativity(..), Fixity(..))
 \end{code}
 
 
@@ -185,14 +184,7 @@ 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)
-                -- 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.
+    showList cs = showChar '"' . showLitString cs . showChar '"'
 
 instance Show Int where
     showsPrec = showSignedInt
@@ -203,14 +195,6 @@ instance Show a => Show (Maybe a) where
                           = (showParen (p > appPrec) $ 
                              showString "Just " . 
                              showsPrec appPrec1 x) s
-
-instance (Show a, Show b) => Show (Either a b) where
-    showsPrec p e s =
-       (showParen (p > appPrec) $
-        case e of
-         Left  a -> showString "Left "  . showsPrec appPrec1 a
-         Right b -> showString "Right " . showsPrec appPrec1 b)
-       s
 \end{code}
 
 
@@ -360,6 +344,38 @@ 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
 
+showLitString :: String -> ShowS
+-- | Same as 'showLitChar', but for strings
+-- It converts the string to a string using Haskell escape conventions
+-- for non-printable characters. Does not add double-quotes around the
+-- whole thing; the caller should do that.
+-- The main difference from showLitChar (apart from the fact that the
+-- argument is a string not a list) is that we must escape double-quotes 
+showLitString []         s = s
+showLitString ('"' : cs) s = showString "\\\"" (showLitString cs s)
+showLitString (c   : cs) s = showLitChar c (showLitString cs s)
+   -- Making 's' an explicit parameter makes it clear to GHC that
+   -- showLitString has arity 2, which avoids it allocating an extra lambda
+   -- The sticking point is the recursive call to (showLitString cs), which
+   -- it can't figure out would be ok with arity 2.
+
+showMultiLineString :: String -> [String]
+-- | Like 'showLitString' (expand escape characters using Haskell
+-- escape conventions), but 
+--   * break the string into multiple lines
+--   * wrap the entire thing in double quotes
+-- Example:  @breakMultiLineString "hello\ngoodbye\nblah"@ 
+-- returns   @["\"hello\\", "\\goodbye\\", "\\blah\"" ]@
+-- where those "\\" are really just a single backslash
+-- (but I'm writing them here as Haskell literals)
+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
@@ -389,6 +405,7 @@ intToDigit (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
@@ -399,7 +416,7 @@ showSignedInt (I# p) (I# n) r
 itos :: Int# -> String -> String
 itos n# cs
     | n# <# 0# =
-        let I# minInt# = minInt in
+        let !(I# minInt#) = minInt in
         if n# ==# minInt#
                 -- negateInt# minInt overflows, so we can't do that:
            then '-' : itos' (negateInt# (n# `quotInt#` 10#))
@@ -408,8 +425,16 @@ 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) }
+    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}