diff options
| -rw-r--r-- | compiler/deSugar/MatchLit.lhs | 3 | ||||
| -rw-r--r-- | compiler/utils/Binary.hs | 2 | ||||
| -rw-r--r-- | 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 71a5e10636..38ed3af44f 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 0aa8c648b8..53ee903f2f 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 157e5f08b0..a38d87e1b5 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) |