Use ByteString to represent Cmm string literals (#16198)

Also used ByteString in some other relevant places

compiler/basicTypes/DataCon.hs

@@ -84,9 +84,11 @@ import Binary
 import UniqSet
 import Unique( mkAlphaTyVarUnique )
 
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Builder as BSB
+import qualified Data.ByteString.Lazy    as LBS
 import qualified Data.Data as Data
 import Data.Char
-import Data.Word
 import Data.List( find )
 
 {-
@@ -1356,11 +1358,15 @@ dataConRepArgTys (MkData { dcRep = rep
 
 -- | The string @package:module.name@ identifying a constructor, which is attached
 -- to its info table and used by the GHCi debugger and the heap profiler
-dataConIdentity :: DataCon -> [Word8]
+dataConIdentity :: DataCon -> ByteString
 -- We want this string to be UTF-8, so we get the bytes directly from the FastStrings.
-dataConIdentity dc = bytesFS (unitIdFS (moduleUnitId mod)) ++
-                  fromIntegral (ord ':') : bytesFS (moduleNameFS (moduleName mod)) ++
-                  fromIntegral (ord '.') : bytesFS (occNameFS (nameOccName name))
+dataConIdentity dc = LBS.toStrict $ BSB.toLazyByteString $ mconcat
+   [ BSB.byteString $ bytesFS (unitIdFS (moduleUnitId mod))
+   , BSB.int8 $ fromIntegral (ord ':')
+   , BSB.byteString $ bytesFS (moduleNameFS (moduleName mod))
+   , BSB.int8 $ fromIntegral (ord '.')
+   , BSB.byteString $ bytesFS (occNameFS (nameOccName name))
+   ]
   where name = dataConName dc
         mod  = ASSERT( isExternalName name ) nameModule name
 

compiler/basicTypes/Literal.hs

@@ -418,7 +418,7 @@ mkLitChar = LitChar
 -- e.g. some of the \"error\" functions in GHC.Err such as @GHC.Err.runtimeError@
 mkLitString :: String -> Literal
 -- stored UTF-8 encoded
-mkLitString s = LitString (fastStringToByteString $ mkFastString s)
+mkLitString s = LitString (bytesFS $ mkFastString s)
 
 mkLitInteger :: Integer -> Type -> Literal
 mkLitInteger x ty = LitNumber LitNumInteger x ty

compiler/basicTypes/Module.hs

@@ -344,7 +344,7 @@ instance Binary ModuleName where
 
 instance BinaryStringRep ModuleName where
   fromStringRep = mkModuleNameFS . mkFastStringByteString
-  toStringRep   = fastStringToByteString . moduleNameFS
+  toStringRep   = bytesFS . moduleNameFS
 
 instance Data ModuleName where
   -- don't traverse?
@@ -519,7 +519,7 @@ newtype ComponentId        = ComponentId        FastString deriving (Eq, Ord)
 
 instance BinaryStringRep ComponentId where
   fromStringRep = ComponentId . mkFastStringByteString
-  toStringRep (ComponentId s) = fastStringToByteString s
+  toStringRep (ComponentId s) = bytesFS s
 
 instance Uniquable ComponentId where
   getUnique (ComponentId n) = getUnique n
@@ -849,7 +849,7 @@ rawHashUnitId sorted_holes =
   . BS.concat $ do
         (m, b) <- sorted_holes
         [ toStringRep m,                BS.Char8.singleton ' ',
-          fastStringToByteString (unitIdFS (moduleUnitId b)), BS.Char8.singleton ':',
+          bytesFS (unitIdFS (moduleUnitId b)), BS.Char8.singleton ':',
           toStringRep (moduleName b),   BS.Char8.singleton '\n']
 
 fingerprintUnitId :: BS.ByteString -> Fingerprint -> BS.ByteString

compiler/cmm/Cmm.hs

@@ -39,8 +39,7 @@ import Hoopl.Collections
 import Hoopl.Graph
 import Hoopl.Label
 import Outputable
-
-import Data.Word        ( Word8 )
+import Data.ByteString (ByteString)
 
 -----------------------------------------------------------------------------
 --  Cmm, GenCmm
@@ -159,7 +158,7 @@ data CmmInfoTable
 
 data ProfilingInfo
   = NoProfilingInfo
-  | ProfilingInfo [Word8] [Word8] -- closure_type, closure_desc
+  | ProfilingInfo ByteString ByteString -- closure_type, closure_desc
 
 -----------------------------------------------------------------------------
 --              Static Data
@@ -195,7 +194,7 @@ data CmmStatic
         -- a literal value, size given by cmmLitRep of the literal.
   | CmmUninitialised Int
         -- uninitialised data, N bytes long
-  | CmmString [Word8]
+  | CmmString ByteString
         -- string of 8-bit values only, not zero terminated.
 
 data CmmStatics

compiler/cmm/CmmInfo.hs

@@ -54,8 +54,8 @@ import MonadUtils
 import Util
 import Outputable
 
+import Data.ByteString (ByteString)
 import Data.Bits
-import Data.Word
 
 -- When we split at proc points, we need an empty info table.
 mkEmptyContInfoTable :: CLabel -> CmmInfoTable
@@ -416,7 +416,7 @@ mkProfLits _ (ProfilingInfo td cd)
        ; (cd_lit, cd_decl) <- newStringLit cd
        ; return ((td_lit,cd_lit), [td_decl,cd_decl]) }
 
-newStringLit :: [Word8] -> UniqSM (CmmLit, GenCmmDecl CmmStatics info stmt)
+newStringLit :: ByteString -> UniqSM (CmmLit, GenCmmDecl CmmStatics info stmt)
 newStringLit bytes
   = do { uniq <- getUniqueM
        ; return (mkByteStringCLit (mkStringLitLabel uniq) bytes) }

compiler/cmm/CmmParse.y

@@ -257,6 +257,7 @@ import Data.Char        ( ord )
 import System.Exit
 import Data.Maybe
 import qualified Data.Map as M
+import qualified Data.ByteString.Char8 as BS8
 
 #include "HsVersions.h"
 }
@@ -497,7 +498,7 @@ info    :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
                    do dflags <- getDynFlags
                       let prof = profilingInfo dflags $13 $15
                           ty  = Constr (fromIntegral $9)  -- Tag
-                                       (stringToWord8s $13)
+                                       (BS8.pack $13)
                           rep = mkRTSRep (fromIntegral $11) $
                                   mkHeapRep dflags False (fromIntegral $5)
                                                   (fromIntegral $7) ty
@@ -868,7 +869,7 @@ section "bss"       = UninitialisedData
 section s           = OtherSection s
 
 mkString :: String -> CmmStatic
-mkString s = CmmString (map (fromIntegral.ord) s)
+mkString s = CmmString (BS8.pack s)
 
 -- |
 -- Given an info table, decide what the entry convention for the proc
@@ -1165,8 +1166,7 @@ reserveStackFrame psize preg body = do
 profilingInfo dflags desc_str ty_str
   = if not (gopt Opt_SccProfilingOn dflags)
     then NoProfilingInfo
-    else ProfilingInfo (stringToWord8s desc_str)
-                       (stringToWord8s ty_str)
+    else ProfilingInfo (BS8.pack desc_str) (BS8.pack ty_str)
 
 staticClosure :: UnitId -> FastString -> FastString -> [CmmLit] -> CmmParse ()
 staticClosure pkg cl_label info payload

compiler/cmm/CmmUtils.hs

@@ -78,7 +78,8 @@ import Outputable
 import DynFlags
 import CodeGen.Platform
 
-import Data.Word
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
 import Data.Bits
 import Hoopl.Graph
 import Hoopl.Label
@@ -181,7 +182,7 @@ mkWordCLit :: DynFlags -> Integer -> CmmLit
 mkWordCLit dflags wd = CmmInt wd (wordWidth dflags)
 
 mkByteStringCLit
-  :: CLabel -> [Word8] -> (CmmLit, GenCmmDecl CmmStatics info stmt)
+  :: CLabel -> ByteString -> (CmmLit, GenCmmDecl CmmStatics info stmt)
 -- We have to make a top-level decl for the string,
 -- and return a literal pointing to it
 mkByteStringCLit lbl bytes
@@ -189,7 +190,7 @@ mkByteStringCLit lbl bytes
   where
     -- This can not happen for String literals (as there \NUL is replaced by
     -- C0 80). However, it can happen with Addr# literals.
-    sec = if 0 `elem` bytes then ReadOnlyData else CString
+    sec = if 0 `BS.elem` bytes then ReadOnlyData else CString
 
 mkDataLits :: Section -> CLabel -> [CmmLit] -> GenCmmDecl CmmStatics info stmt
 -- Build a data-segment data block

compiler/cmm/PprC.hs

@@ -51,6 +51,8 @@ import Unique
 import Util
 
 -- The rest
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
 import Control.Monad.ST
 import Data.Bits
 import Data.Char
@@ -1224,8 +1226,8 @@ machRep_S_CType w
 -- ---------------------------------------------------------------------
 -- print strings as valid C strings
 
-pprStringInCStyle :: [Word8] -> SDoc
-pprStringInCStyle s = doubleQuotes (text (concatMap charToC s))
+pprStringInCStyle :: ByteString -> SDoc
+pprStringInCStyle s = doubleQuotes (text (concatMap charToC (BS.unpack s)))
 
 -- ---------------------------------------------------------------------------
 -- Initialising static objects with floating-point numbers.  We can't

compiler/cmm/PprCmmDecl.hs

@@ -50,8 +50,7 @@ import FastString
 import Data.List
 import System.IO
 
--- Temp Jan08
-import SMRep
+import qualified Data.ByteString as BS
 
 
 pprCmms :: (Outputable info, Outputable g)
@@ -121,8 +120,8 @@ pprInfoTable (CmmInfoTable { cit_lbl = lbl, cit_rep = rep
          , case prof_info of
              NoProfilingInfo -> empty
              ProfilingInfo ct cd ->
-               vcat [ text "type: " <> pprWord8String ct
-                    , text "desc: " <> pprWord8String cd ]
+               vcat [ text "type: " <> text (show (BS.unpack ct))
+                    , text "desc: " <> text (show (BS.unpack cd)) ]
          , text "srt: " <> ppr srt ]
 
 instance Outputable ForeignHint where

compiler/cmm/SMRep.hs

@@ -41,10 +41,7 @@ module SMRep (
         aRG_GEN, aRG_GEN_BIG,
 
         -- ** Arrays
-        card, cardRoundUp, cardTableSizeB, cardTableSizeW,
-
-        -- * Operations over [Word8] strings that don't belong here
-        pprWord8String, stringToWord8s
+        card, cardRoundUp, cardTableSizeB, cardTableSizeW
     ) where
 
 import GhcPrelude
@@ -55,9 +52,9 @@ import Outputable
 import Platform
 import FastString
 
-import Data.Char( ord )
 import Data.Word
 import Data.Bits
+import Data.ByteString (ByteString)
 
 {-
 ************************************************************************
@@ -195,7 +192,7 @@ data ClosureTypeInfo
   | BlackHole
   | IndStatic
 
-type ConstrDescription = [Word8] -- result of dataConIdentity
+type ConstrDescription = ByteString -- result of dataConIdentity
 type FunArity          = Int
 type SelectorOffset    = Int
 
@@ -564,11 +561,3 @@ pprTypeInfo (ThunkSelector offset)
 pprTypeInfo Thunk     = text "Thunk"
 pprTypeInfo BlackHole = text "BlackHole"
 pprTypeInfo IndStatic = text "IndStatic"
-
--- XXX Does not belong here!!
-stringToWord8s :: String -> [Word8]
-stringToWord8s s = map (fromIntegral . ord) s
-
-pprWord8String :: [Word8] -> SDoc
--- Debug printing.  Not very clever right now.
-pprWord8String ws = text (show ws)

compiler/codeGen/StgCmm.hs

@@ -50,7 +50,6 @@ import VarSet ( isEmptyDVarSet )
 import OrdList
 import MkGraph
 
-import qualified Data.ByteString as BS
 import Data.IORef
 import Control.Monad (when,void)
 import Util
@@ -141,7 +140,7 @@ cgTopBinding dflags (StgTopLifted (StgRec pairs))
 cgTopBinding dflags (StgTopStringLit id str)
   = do  { id' <- maybeExternaliseId dflags id
         ; let label = mkBytesLabel (idName id')
-        ; let (lit, decl) = mkByteStringCLit label (BS.unpack str)
+        ; let (lit, decl) = mkByteStringCLit label str
         ; emitDecl decl
         ; addBindC (litIdInfo dflags id' mkLFStringLit lit)
         }

compiler/codeGen/StgCmmClosure.hs

@@ -91,6 +91,7 @@ import DynFlags
 import Util
 
 import Data.Coerce (coerce)
+import qualified Data.ByteString.Char8 as BS8
 
 -----------------------------------------------------------------------------
 --                Data types and synonyms
@@ -916,10 +917,9 @@ enterIdLabel dflags id c
 mkProfilingInfo :: DynFlags -> Id -> String -> ProfilingInfo
 mkProfilingInfo dflags id val_descr
   | not (gopt Opt_SccProfilingOn dflags) = NoProfilingInfo
-  | otherwise = ProfilingInfo ty_descr_w8 val_descr_w8
+  | otherwise = ProfilingInfo ty_descr_w8 (BS8.pack val_descr)
   where
-    ty_descr_w8  = stringToWord8s (getTyDescription (idType id))
-    val_descr_w8 = stringToWord8s val_descr
+    ty_descr_w8  = BS8.pack (getTyDescription (idType id))
 
 getTyDescription :: Type -> String
 getTyDescription ty
@@ -966,8 +966,8 @@ mkDataConInfoTable dflags data_con is_static ptr_wds nonptr_wds
    prof | not (gopt Opt_SccProfilingOn dflags) = NoProfilingInfo
         | otherwise                            = ProfilingInfo ty_descr val_descr
 
-   ty_descr  = stringToWord8s $ occNameString $ getOccName $ dataConTyCon data_con
-   val_descr = stringToWord8s $ occNameString $ getOccName data_con
+   ty_descr  = BS8.pack $ occNameString $ getOccName $ dataConTyCon data_con
+   val_descr = BS8.pack $ occNameString $ getOccName data_con
 
 -- We need a black-hole closure info to pass to @allocDynClosure@ when we
 -- want to allocate the black hole on entry to a CAF.

compiler/codeGen/StgCmmUtils.hs

@@ -71,12 +71,12 @@ import FastString
 import Outputable
 import RepType
 
-import qualified Data.ByteString as BS
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Char8 as BS8
 import qualified Data.Map as M
 import Data.Char
 import Data.List
 import Data.Ord
-import Data.Word
 
 
 -------------------------------------------------------------------------
@@ -86,7 +86,7 @@ import Data.Word
 -------------------------------------------------------------------------
 
 cgLit :: Literal -> FCode CmmLit
-cgLit (LitString s) = newByteStringCLit (BS.unpack s)
+cgLit (LitString s) = newByteStringCLit s
  -- not unpackFS; we want the UTF-8 byte stream.
 cgLit other_lit     = do dflags <- getDynFlags
                          return (mkSimpleLit dflags other_lit)
@@ -320,9 +320,9 @@ emitRODataLits lbl lits = emitDecl (mkRODataLits lbl lits)
 newStringCLit :: String -> FCode CmmLit
 -- Make a global definition for the string,
 -- and return its label
-newStringCLit str = newByteStringCLit (map (fromIntegral . ord) str)
+newStringCLit str = newByteStringCLit (BS8.pack str)
 
-newByteStringCLit :: [Word8] -> FCode CmmLit
+newByteStringCLit :: ByteString -> FCode CmmLit
 newByteStringCLit bytes
   = do  { uniq <- newUnique
         ; let (lit, decl) = mkByteStringCLit (mkStringLitLabel uniq) bytes

compiler/coreSyn/CoreOpt.hs

@@ -852,7 +852,7 @@ dealWithStringLiteral fun str co
   = let strFS = mkFastStringByteString str
 
         char = mkConApp charDataCon [mkCharLit (headFS strFS)]
-        charTail = fastStringToByteString (tailFS strFS)
+        charTail = bytesFS (tailFS strFS)
 
         -- In singleton strings, just add [] instead of unpackCstring# ""#.
         rest = if BS.null charTail

compiler/coreSyn/MkCore.hs

@@ -302,7 +302,7 @@ mkStringExprFSWith lookupM str
   where
     chars = unpackFS str
     safeChar c = ord c >= 1 && ord c <= 0x7F
-    lit = Lit (LitString (fastStringToByteString str))
+    lit = Lit (LitString (bytesFS str))
 
 {-
 ************************************************************************

compiler/deSugar/Coverage.hs

@@ -49,6 +49,7 @@ import System.Directory
 import Trace.Hpc.Mix
 import Trace.Hpc.Util
 
+import qualified Data.ByteString as BS
 import Data.Map (Map)
 import qualified Data.Map as Map
 
@@ -1352,9 +1353,9 @@ hpcInitCode this_mod (HpcInfo tickCount hashNo)
   where
     tickboxes = ppr (mkHpcTicksLabel $ this_mod)
 
-    module_name  = hcat (map (text.charToC) $
+    module_name  = hcat (map (text.charToC) $ BS.unpack $
                          bytesFS (moduleNameFS (Module.moduleName this_mod)))
-    package_name = hcat (map (text.charToC) $
+    package_name = hcat (map (text.charToC) $ BS.unpack $
                          bytesFS (unitIdFS  (moduleUnitId this_mod)))
     full_name_str
        | moduleUnitId this_mod == mainUnitId

compiler/deSugar/MatchLit.hs

@@ -456,7 +456,7 @@ hsLitKey dflags (HsWord64Prim _ w) = mkLitWord64Wrap dflags w
 hsLitKey _      (HsCharPrim   _ c) = mkLitChar            c
 hsLitKey _      (HsFloatPrim  _ f) = mkLitFloat           (fl_value f)
 hsLitKey _      (HsDoublePrim _ d) = mkLitDouble          (fl_value d)
-hsLitKey _      (HsString _ s)     = LitString (fastStringToByteString s)
+hsLitKey _      (HsString _ s)     = LitString (bytesFS s)
 hsLitKey _      l                  = pprPanic "hsLitKey" (ppr l)
 
 {-

compiler/hsSyn/HsUtils.hs

@@ -370,8 +370,7 @@ mkHsString :: String -> HsLit (GhcPass p)
 mkHsString s = HsString NoSourceText (mkFastString s)
 
 mkHsStringPrimLit :: FastString -> HsLit (GhcPass p)
-mkHsStringPrimLit fs
-  = HsStringPrim NoSourceText (fastStringToByteString fs)
+mkHsStringPrimLit fs = HsStringPrim NoSourceText (bytesFS fs)
 
 -------------
 userHsLTyVarBndrs :: SrcSpan -> [Located (IdP (GhcPass p))]

compiler/llvmGen/LlvmCodeGen/Data.hs

@@ -22,6 +22,7 @@ import Platform
 
 import FastString
 import Outputable
+import qualified Data.ByteString as BS
 
 -- ----------------------------------------------------------------------------
 -- * Constants
@@ -102,7 +103,8 @@ llvmSection (Section t suffix) = do
 genData :: CmmStatic -> LlvmM LlvmStatic
 
 genData (CmmString str) = do
-    let v  = map (\x -> LMStaticLit $ LMIntLit (fromIntegral x) i8) str
+    let v  = map (\x -> LMStaticLit $ LMIntLit (fromIntegral x) i8)
+                 (BS.unpack str)
         ve = v ++ [LMStaticLit $ LMIntLit 0 i8]
     return $ LMStaticArray ve (LMArray (length ve) i8)
 

compiler/main/PackageConfig.hs

@@ -62,11 +62,11 @@ newtype PackageName        = PackageName        FastString deriving (Eq, Ord)
 
 instance BinaryStringRep SourcePackageId where
   fromStringRep = SourcePackageId . mkFastStringByteString
-  toStringRep (SourcePackageId s) = fastStringToByteString s
+  toStringRep (SourcePackageId s) = bytesFS s
 
 instance BinaryStringRep PackageName where
   fromStringRep = PackageName . mkFastStringByteString
-  toStringRep (PackageName s) = fastStringToByteString s
+  toStringRep (PackageName s) = bytesFS s
 
 instance Uniquable SourcePackageId where
   getUnique (SourcePackageId n) = getUnique n

compiler/nativeGen/Dwarf/Types.hs

@@ -38,6 +38,7 @@ import Util
 
 import Dwarf.Constants
 
+import qualified Data.ByteString as BS
 import qualified Control.Monad.Trans.State.Strict as S
 import Control.Monad (zipWithM, join)
 import Data.Bits
@@ -583,7 +584,7 @@ pprString str
   = pprString' $ hcat $ map escapeChar $
     if str `lengthIs` utf8EncodedLength str
     then str
-    else map (chr . fromIntegral) $ bytesFS $ mkFastString str
+    else map (chr . fromIntegral) $ BS.unpack $ bytesFS $ mkFastString str
 
 -- | Escape a single non-unicode character
 escapeChar :: Char -> SDoc

compiler/nativeGen/PprBase.hs

@@ -34,6 +34,8 @@ import Control.Monad.ST
 
 import Data.Word
 import Data.Char
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
 
 
 
@@ -90,13 +92,13 @@ doubleToBytes d
 -- Print as a string and escape non-printable characters.
 -- This is similar to charToC in Utils.
 
-pprASCII :: [Word8] -> SDoc
+pprASCII :: ByteString -> SDoc
 pprASCII str
   -- Transform this given literal bytestring to escaped string and construct
   -- the literal SDoc directly.
   -- See Trac #14741
   -- and Note [Pretty print ASCII when AsmCodeGen]
-  = text $ foldr (\w s -> (do1 . fromIntegral) w ++ s) "" str
+  = text $ foldr (\w s -> (do1 . fromIntegral) w ++ s) "" (BS.unpack str)
     where
        do1 :: Int -> String
        do1 w | '\t' <- chr w = "\\t"

compiler/nativeGen/SPARC/Ppr.hs

@@ -50,6 +50,7 @@ import Outputable
 import Platform
 import FastString
 import Data.Word
+import qualified Data.ByteString as BS
 
 -- -----------------------------------------------------------------------------
 -- Printing this stuff out
@@ -110,7 +111,7 @@ pprDatas (Statics lbl dats) = vcat (pprLabel lbl : map pprData dats)
 
 pprData :: CmmStatic -> SDoc
 pprData (CmmString str)
-  = vcat (map do1 str) $$ do1 0
+  = vcat (map do1 (BS.unpack str)) $$ do1 0
     where
        do1 :: Word8 -> SDoc
        do1 w = text "\t.byte\t" <> int (fromIntegral w)

compiler/prelude/TysWiredIn.hs

@@ -738,7 +738,7 @@ isBuiltInOcc_maybe occ =
                 in Just $ dataConName $ sumDataCon alt arity
       _ -> Nothing
   where
-    name = fastStringToByteString $ occNameFS occ
+    name = bytesFS $ occNameFS occ
 
     choose_ns :: Name -> Name -> Name
     choose_ns tc dc

compiler/typecheck/TcEvTerm.hs

@@ -29,7 +29,7 @@ evDelayedError ty msg
     Var errorId `mkTyApps` [getRuntimeRep ty, ty] `mkApps` [litMsg]
   where
     errorId = tYPE_ERROR_ID
-    litMsg  = Lit (LitString (fastStringToByteString msg))
+    litMsg  = Lit (LitString (bytesFS msg))
 
 -- Dictionary for CallStack implicit parameters
 evCallStack :: (MonadThings m, HasModule m, HasDynFlags m) =>

compiler/typecheck/TcTyDecls.hs

@@ -938,7 +938,7 @@ mkOneRecordSelector all_cons idDetails fl
     inst_tys = substTyVars eq_subst univ_tvs
 
     unit_rhs = mkLHsTupleExpr []
-    msg_lit = HsStringPrim NoSourceText (fastStringToByteString lbl)
+    msg_lit = HsStringPrim NoSourceText (bytesFS lbl)
 
 {-
 Note [Polymorphic selectors]

compiler/utils/Binary.hs

@@ -916,7 +916,7 @@ type SymbolTable = Array Int Name
 ---------------------------------------------------------
 
 putFS :: BinHandle -> FastString -> IO ()
-putFS bh fs = putBS bh $ fastStringToByteString fs
+putFS bh fs = putBS bh $ bytesFS fs
 
 getFS :: BinHandle -> IO FastString
 getFS bh = do

compiler/utils/BufWrite.hs

@@ -77,7 +77,7 @@ bPutStr (BufHandle buf r hdl) !str = do
                 loop cs (i+1)
 
 bPutFS :: BufHandle -> FastString -> IO ()
-bPutFS b fs = bPutBS b $ fastStringToByteString fs
+bPutFS b fs = bPutBS b $ bytesFS fs
 
 bPutFZS :: BufHandle -> FastZString -> IO ()
 bPutFZS b fs = bPutBS b $ fastZStringToByteString fs

compiler/utils/FastString.hs

@@ -32,7 +32,8 @@
 module FastString
        (
         -- * ByteString
-        fastStringToByteString,
+        bytesFS,            -- :: FastString -> ByteString
+        fastStringToByteString, -- = bytesFS (kept for haddock)
         mkFastStringByteString,
         fastZStringToByteString,
         unsafeMkByteString,
@@ -56,7 +57,6 @@ module FastString
 
         -- ** Deconstruction
         unpackFS,           -- :: FastString -> String
-        bytesFS,            -- :: FastString -> [Word8]
 
         -- ** Encoding
         zEncodeFS,
@@ -132,8 +132,13 @@ import GHC.Conc.Sync    (sharedCAF)
 import GHC.Base         ( unpackCString#, unpackNBytes# )
 
 
+-- | Gives the UTF-8 encoded bytes corresponding to a 'FastString'
+bytesFS :: FastString -> ByteString
+bytesFS f = fs_bs f
+
+{-# DEPRECATED fastStringToByteString "Use `bytesFS` instead" #-}
 fastStringToByteString :: FastString -> ByteString
-fastStringToByteString f = fs_bs f
+fastStringToByteString = bytesFS
 
 fastZStringToByteString :: FastZString -> ByteString
 fastZStringToByteString (FastZString bs) = bs
@@ -221,7 +226,7 @@ instance Data FastString where
 cmpFS :: FastString -> FastString -> Ordering
 cmpFS f1@(FastString u1 _ _ _) f2@(FastString u2 _ _ _) =
   if u1 == u2 then EQ else
-  compare (fastStringToByteString f1) (fastStringToByteString f2)
+  compare (bytesFS f1) (bytesFS f2)
 
 foreign import ccall unsafe "memcmp"
   memcmp :: Ptr a -> Ptr b -> Int -> IO Int
@@ -475,13 +480,7 @@ mkFastString str =
 
 -- | Creates a 'FastString' from a UTF-8 encoded @[Word8]@
 mkFastStringByteList :: [Word8] -> FastString
-mkFastStringByteList str =
-  inlinePerformIO $ do
-    let l = Prelude.length str
-    buf <- mallocForeignPtrBytes l
-    withForeignPtr buf $ \ptr -> do
-      pokeArray (castPtr ptr) str
-      mkFastStringForeignPtr ptr buf l
+mkFastStringByteList str = mkFastStringByteString (BS.pack str)
 
 -- | Creates a Z-encoded 'FastString' from a 'String'
 mkZFastString :: String -> FastZString
@@ -553,10 +552,6 @@ nullFS f = BS.null (fs_bs f)