X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FShow.lhs;h=6cb8bf35f71a3945877c97e272024006f98358cb;hb=41e8fba828acbae1751628af50849f5352b27873;hp=a00ff4829607c038ee4c575d6e0f58f742d06ede;hpb=3b8746d947788e5286f5b3dd1fb0929af109fe64;p=ghc-base.git

diff --git a/GHC/Show.lhs b/GHC/Show.lhs
index a00ff48..6cb8bf3 100644
--- a/GHC/Show.lhs
+++ b/GHC/Show.lhs
@@ -1,6 +1,7 @@
 \begin{code}
-{-# OPTIONS_GHC -XNoImplicitPrelude #-}
+{-# LANGUAGE NoImplicitPrelude, BangPatterns, MagicHash #-}
 {-# 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,11 +37,7 @@ module GHC.Show
 
 import GHC.Base
 import Data.Maybe
-import GHC.List ( (!!), foldr1
-#ifdef USE_REPORT_PRELUDE
-                , concatMap
-#endif
-                )
+import GHC.List ((!!), foldr1, break)
 \end{code}
 
 
@@ -184,14 +182,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
@@ -351,6 +342,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
@@ -380,6 +403,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
@@ -390,7 +414,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#))
@@ -399,8 +423,9 @@ 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}
+