Use explicit language extensions & remove extension fields from base.cabal

[ghc-base.git] / GHC / Show.lhs

diff --git a/GHC/Show.lhs b/GHC/Show.lhs
index ffcd013..6cb8bf3 100644 (file)
--- 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,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
 
+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'
 
@@ -392,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#))
@@ -406,3 +428,4 @@ itos n# cs
         | otherwise = case chr# (ord# '0'# +# (x# `remInt#` 10#)) of { c# ->
                       itos' (x# `quotInt#` 10#) (C# c# : cs') }
 \end{code}
+