[commit: ghc] master: Make mkFastStringByteString pure and fix up uses (1bc2a55)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/1bc2a55542c487ff97455da5f39597bc25bbfa49/ghc

>---------------------------------------------------------------

commit 1bc2a55542c487ff97455da5f39597bc25bbfa49
Author: Duncan Coutts <duncan at well-typed.com>
Date:   Sun Aug 24 21:46:17 2014 +0100

    Make mkFastStringByteString pure and fix up uses
    
    It's morally pure, and we'll need it in a pure context.


>---------------------------------------------------------------

1bc2a55542c487ff97455da5f39597bc25bbfa49
 compiler/deSugar/MatchLit.lhs |  3 +--
 compiler/utils/Binary.hs      |  2 +-
 compiler/utils/FastString.lhs | 15 ++++++++-------
 3 files changed, 10 insertions(+), 10 deletions(-)

diff --git a/compiler/deSugar/MatchLit.lhs b/compiler/deSugar/MatchLit.lhs
index 71a5e10..38ed3af 100644
--- a/compiler/deSugar/MatchLit.lhs
+++ b/compiler/deSugar/MatchLit.lhs
@@ -38,7 +38,6 @@ import TysWiredIn
 import Literal
 import SrcLoc
 import Data.Ratio
-import MonadUtils
 import Outputable
 import BasicTypes
 import DynFlags
@@ -365,7 +364,7 @@ matchLiterals (var:vars) ty sub_groups
     wrap_str_guard eq_str (MachStr s, mr)
         = do { -- We now have to convert back to FastString. Perhaps there
                -- should be separate MachBytes and MachStr constructors?
-               s'     <- liftIO $ mkFastStringByteString s
+               let s'  = mkFastStringByteString s
              ; lit    <- mkStringExprFS s'
              ; let pred = mkApps (Var eq_str) [Var var, lit]
              ; return (mkGuardedMatchResult pred mr) }
diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index 0aa8c64..53ee903 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -681,7 +681,7 @@ putFS bh fs = putBS bh $ fastStringToByteString fs
 
 getFS :: BinHandle -> IO FastString
 getFS bh = do bs <- getBS bh
-              mkFastStringByteString bs
+              return $! mkFastStringByteString bs
 
 putBS :: BinHandle -> ByteString -> IO ()
 putBS bh bs =
diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs
index 157e5f0..a38d87e 100644
--- a/compiler/utils/FastString.lhs
+++ b/compiler/utils/FastString.lhs
@@ -380,10 +380,12 @@ mkFastStringForeignPtr ptr !fp len
 -- | Create a 'FastString' from an existing 'ForeignPtr'; the difference
 -- between this and 'mkFastStringBytes' is that we don't have to copy
 -- the bytes if the string is new to the table.
-mkFastStringByteString :: ByteString -> IO FastString
-mkFastStringByteString bs = BS.unsafeUseAsCStringLen bs $ \(ptr, len) -> do
-  let ptr' = castPtr ptr
-  mkFastStringWith (mkNewFastStringByteString bs ptr' len) ptr' len
+mkFastStringByteString :: ByteString -> FastString
+mkFastStringByteString bs =
+    inlinePerformIO $
+      BS.unsafeUseAsCStringLen bs $ \(ptr, len) -> do
+        let ptr' = castPtr ptr
+        mkFastStringWith (mkNewFastStringByteString bs ptr' len) ptr' len
 
 -- | Creates a UTF-8 encoded 'FastString' from a 'String'
 mkFastString :: String -> FastString
@@ -510,8 +512,7 @@ zEncodeFS fs@(FastString _ _ _ ref) =
               Just zfs -> (m', zfs)
 
 appendFS :: FastString -> FastString -> FastString
-appendFS fs1 fs2 = inlinePerformIO
-                 $ mkFastStringByteString
+appendFS fs1 fs2 = mkFastStringByteString
                  $ BS.append (fastStringToByteString fs1)
                              (fastStringToByteString fs2)
 
@@ -530,7 +531,7 @@ tailFS (FastString _ _ bs _) =
     inlinePerformIO $ BS.unsafeUseAsCString bs $ \ptr ->
     do let (_, ptr') = utf8DecodeChar (castPtr ptr)
            n = ptr' `minusPtr` ptr
-       mkFastStringByteString $ BS.drop n bs
+       return $! mkFastStringByteString (BS.drop n bs)
 
 consFS :: Char -> FastString -> FastString
 consFS c fs = mkFastString (c : unpackFS fs)