Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/7085b8419033f74a985b824b63d85aae65b55882 >--------------------------------------------------------------- commit 7085b8419033f74a985b824b63d85aae65b55882 Author: Ian Lynagh <i...@well-typed.com> Date: Fri Dec 14 00:42:54 2012 +0000 Inline some FastBytes/ByteString wrappers Working towards removing FastBytes >--------------------------------------------------------------- compiler/codeGen/StgCmmUtils.hs | 3 ++- compiler/coreSyn/CoreUnfold.lhs | 3 ++- compiler/coreSyn/MkExternalCore.lhs | 3 ++- compiler/prelude/PrelRules.lhs | 3 ++- compiler/utils/FastString.lhs | 19 +++---------------- compiler/utils/Outputable.lhs | 3 ++- 6 files changed, 13 insertions(+), 21 deletions(-) diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs index 138e00e..cc55ae2 100644 --- a/compiler/codeGen/StgCmmUtils.hs +++ b/compiler/codeGen/StgCmmUtils.hs @@ -65,6 +65,7 @@ import DynFlags import FastString import Outputable +import qualified Data.ByteString as BS import Data.Char import Data.List import Data.Ord @@ -79,7 +80,7 @@ import Data.Maybe ------------------------------------------------------------------------- cgLit :: Literal -> FCode CmmLit -cgLit (MachStr s) = newByteStringCLit (bytesFB s) +cgLit (MachStr s) = newByteStringCLit (BS.unpack s) -- not unpackFS; we want the UTF-8 byte stream. cgLit other_lit = do dflags <- getDynFlags return (mkSimpleLit dflags other_lit) diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs index 7ed5d2b..70ddc9a 100644 --- a/compiler/coreSyn/CoreUnfold.lhs +++ b/compiler/coreSyn/CoreUnfold.lhs @@ -68,6 +68,7 @@ import FastString import Outputable import ForeignCall +import qualified Data.ByteString as BS import Data.Maybe \end{code} @@ -535,7 +536,7 @@ sizeExpr dflags bOMB_OUT_SIZE top_args expr litSize :: Literal -> Int -- Used by CoreUnfold.sizeExpr litSize (LitInteger {}) = 100 -- Note [Size of literal integers] -litSize (MachStr str) = 10 + 10 * ((lengthFB str + 3) `div` 4) +litSize (MachStr str) = 10 + 10 * ((BS.length str + 3) `div` 4) -- If size could be 0 then @f "x"@ might be too small -- [Sept03: make literal strings a bit bigger to avoid fruitless -- duplication of little strings] diff --git a/compiler/coreSyn/MkExternalCore.lhs b/compiler/coreSyn/MkExternalCore.lhs index 4c1d435..164146a 100644 --- a/compiler/coreSyn/MkExternalCore.lhs +++ b/compiler/coreSyn/MkExternalCore.lhs @@ -39,6 +39,7 @@ import FastString import Exception import Control.Monad +import qualified Data.ByteString as BS import Data.Char import System.IO @@ -221,7 +222,7 @@ make_lit dflags l = -- For a character bigger than 0xff, we represent it in ext-core -- as an int lit with a char type. MachChar i -> C.Lint (fromIntegral $ ord i) t - MachStr s -> C.Lstring (bytesFB s) t + MachStr s -> C.Lstring (BS.unpack s) t MachNullAddr -> C.Lint 0 t MachInt i -> C.Lint i t MachInt64 i -> C.Lint i t diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs index 2ee1467..b58eb0a 100644 --- a/compiler/prelude/PrelRules.lhs +++ b/compiler/prelude/PrelRules.lhs @@ -49,6 +49,7 @@ import Util import Control.Monad import Data.Bits as Bits +import qualified Data.ByteString as BS import Data.Int import Data.Ratio import Data.Word @@ -932,7 +933,7 @@ match_append_lit _ [Type ty1, c1 `cheapEqExpr` c2 = ASSERT( ty1 `eqType` ty2 ) Just (Var unpk `App` Type ty1 - `App` Lit (MachStr (s1 `appendFB` s2)) + `App` Lit (MachStr (s1 `BS.append` s2)) `App` c1 `App` n) diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs index 42bcb0b..0a23792 100644 --- a/compiler/utils/FastString.lhs +++ b/compiler/utils/FastString.lhs @@ -34,10 +34,7 @@ module FastString fastZStringToByteString, mkFastBytesByteList, unsafeMkFastBytesString, - bytesFB, hashFB, - lengthFB, - appendFB, -- * FastZString FastZString, @@ -175,21 +172,11 @@ pokeCAString ptr str = in go str 0 --- | Gives the UTF-8 encoded bytes corresponding to a 'FastString' -bytesFB :: FastBytes -> [Word8] -bytesFB = BS.unpack - hashFB :: FastBytes -> Int hashFB bs = inlinePerformIO $ BS.unsafeUseAsCStringLen bs $ \(ptr, len) -> return $ hashStr (castPtr ptr) len -lengthFB :: FastBytes -> Int -lengthFB f = BS.length f - -appendFB :: FastBytes -> FastBytes -> FastBytes -appendFB = BS.append - hPutFB :: Handle -> FastBytes -> IO () hPutFB = BS.hPut @@ -473,7 +460,7 @@ unpackFS (FastString _ _ bs _) = -- | Gives the UTF-8 encoded bytes corresponding to a 'FastString' bytesFS :: FastString -> [Word8] -bytesFS fs = bytesFB $ fastStringToFastBytes fs +bytesFS fs = BS.unpack $ fastStringToFastBytes fs -- | Returns a Z-encoded version of a 'FastString'. This might be the -- original, if it was already Z-encoded. The first time this @@ -494,8 +481,8 @@ zEncodeFS fs@(FastString _ _ _ ref) = appendFS :: FastString -> FastString -> FastString appendFS fs1 fs2 = inlinePerformIO $ mkFastStringFastBytes - $ appendFB (fastStringToFastBytes fs1) - (fastStringToFastBytes fs2) + $ BS.append (fastStringToFastBytes fs1) + (fastStringToFastBytes fs2) concatFS :: [FastString] -> FastString concatFS ls = mkFastString (Prelude.concat (map unpackFS ls)) -- ToDo: do better diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs index ad0b9d7..a56037b 100644 --- a/compiler/utils/Outputable.lhs +++ b/compiler/utils/Outputable.lhs @@ -84,6 +84,7 @@ import Platform import Pretty ( Doc, Mode(..) ) import Panic +import qualified Data.ByteString as BS import Data.Char import qualified Data.Map as M import qualified Data.IntMap as IM @@ -740,7 +741,7 @@ pprHsString fs = vcat (map text (showMultiLineString (unpackFS fs))) -- | Special combinator for showing string literals. pprHsBytes :: FastBytes -> SDoc -pprHsBytes fb = let escaped = concatMap escape $ bytesFB fb +pprHsBytes fb = let escaped = concatMap escape $ BS.unpack fb in vcat (map text (showMultiLineString escaped)) <> char '#' where escape :: Word8 -> String escape w = let c = chr (fromIntegral w) _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc