diff options
32 files changed, 97 insertions, 97 deletions
diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs index 5f72b51a35..f34a6cb74d 100644 --- a/compiler/basicTypes/DataCon.hs +++ b/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 diff --git a/compiler/basicTypes/Literal.hs b/compiler/basicTypes/Literal.hs index 7e49816d1f..aa1dc3f9f3 100644 --- a/compiler/basicTypes/Literal.hs +++ b/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 diff --git a/compiler/basicTypes/Module.hs b/compiler/basicTypes/Module.hs index 45fd4c19b5..ec3a9462cf 100644 --- a/compiler/basicTypes/Module.hs +++ b/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 diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs index eb34618e38..60fe874b2f 100644 --- a/compiler/cmm/Cmm.hs +++ b/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 diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs index 43cba2526d..345f3facaa 100644 --- a/compiler/cmm/CmmInfo.hs +++ b/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) } diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y index 8cc988383e..e5803682ad 100644 --- a/compiler/cmm/CmmParse.y +++ b/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 diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs index a5d1a8e375..5cfc5f482e 100644 --- a/compiler/cmm/CmmUtils.hs +++ b/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 diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs index 6ebfd20291..4763c5db31 100644 --- a/compiler/cmm/PprC.hs +++ b/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 diff --git a/compiler/cmm/PprCmmDecl.hs b/compiler/cmm/PprCmmDecl.hs index c4ee6fd068..ea01c29345 100644 --- a/compiler/cmm/PprCmmDecl.hs +++ b/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 diff --git a/compiler/cmm/SMRep.hs b/compiler/cmm/SMRep.hs index 743631527e..8cd9c3e497 100644 --- a/compiler/cmm/SMRep.hs +++ b/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) diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs index acd2aee5f4..ff63b555ac 100644 --- a/compiler/codeGen/StgCmm.hs +++ b/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) } diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 65e7cf7dab..8ad8951a21 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/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. diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs index 4a6135607e..64af5c579c 100644 --- a/compiler/codeGen/StgCmmUtils.hs +++ b/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 diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs index f4fc94d2ae..ca82d9ab23 100644 --- a/compiler/coreSyn/CoreOpt.hs +++ b/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 diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs index 1d07399293..b1046c9a84 100644 --- a/compiler/coreSyn/MkCore.hs +++ b/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)) {- ************************************************************************ diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs index bea0172a69..d140829544 100644 --- a/compiler/deSugar/Coverage.hs +++ b/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 diff --git a/compiler/deSugar/MatchLit.hs b/compiler/deSugar/MatchLit.hs index 824dce138b..d0db91d93a 100644 --- a/compiler/deSugar/MatchLit.hs +++ b/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) {- diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs index c5cac539ab..2219ca62c5 100644 --- a/compiler/hsSyn/HsUtils.hs +++ b/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))] diff --git a/compiler/llvmGen/LlvmCodeGen/Data.hs b/compiler/llvmGen/LlvmCodeGen/Data.hs index 36d51e9e18..cabfe76762 100644 --- a/compiler/llvmGen/LlvmCodeGen/Data.hs +++ b/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) diff --git a/compiler/main/PackageConfig.hs b/compiler/main/PackageConfig.hs index b003f5fa5a..7d096895b4 100644 --- a/compiler/main/PackageConfig.hs +++ b/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 diff --git a/compiler/nativeGen/Dwarf/Types.hs b/compiler/nativeGen/Dwarf/Types.hs index 05b5b7faad..57ff0b2478 100644 --- a/compiler/nativeGen/Dwarf/Types.hs +++ b/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 diff --git a/compiler/nativeGen/PprBase.hs b/compiler/nativeGen/PprBase.hs index 58566cf812..4cdcceec9e 100644 --- a/compiler/nativeGen/PprBase.hs +++ b/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" diff --git a/compiler/nativeGen/SPARC/Ppr.hs b/compiler/nativeGen/SPARC/Ppr.hs index 7fc3e2111f..705fc31153 100644 --- a/compiler/nativeGen/SPARC/Ppr.hs +++ b/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) diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs index 6fea0e4f05..5ea1fd04d2 100644 --- a/compiler/prelude/TysWiredIn.hs +++ b/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 diff --git a/compiler/typecheck/TcEvTerm.hs b/compiler/typecheck/TcEvTerm.hs index 7ccd018e26..60adb82839 100644 --- a/compiler/typecheck/TcEvTerm.hs +++ b/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) => diff --git a/compiler/typecheck/TcTyDecls.hs b/compiler/typecheck/TcTyDecls.hs index a973cafa8d..dc983ca403 100644 --- a/compiler/typecheck/TcTyDecls.hs +++ b/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] diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 4bd05da485..d7b446c6ea 100644 --- a/compiler/utils/Binary.hs +++ b/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 diff --git a/compiler/utils/BufWrite.hs b/compiler/utils/BufWrite.hs index f4b406fe90..8a28f470f4 100644 --- a/compiler/utils/BufWrite.hs +++ b/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 diff --git a/compiler/utils/FastString.hs b/compiler/utils/FastString.hs index 588486bf46..4f16624537 100644 --- a/compiler/utils/FastString.hs +++ b/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) unpackFS :: FastString -> String unpackFS (FastString _ _ bs _) = utf8DecodeByteString bs --- | Gives the UTF-8 encoded bytes corresponding to a 'FastString' -bytesFS :: FastString -> [Word8] -bytesFS fs = BS.unpack $ fastStringToByteString fs - -- | Returns a Z-encoded version of a 'FastString'. This might be the -- original, if it was already Z-encoded. The first time this -- function is applied to a particular 'FastString', the results are @@ -576,8 +571,7 @@ zEncodeFS fs@(FastString _ _ _ ref) = appendFS :: FastString -> FastString -> FastString appendFS fs1 fs2 = mkFastStringByteString - $ BS.append (fastStringToByteString fs1) - (fastStringToByteString fs2) + $ BS.append (bytesFS fs1) (bytesFS fs2) concatFS :: [FastString] -> FastString concatFS = mkFastStringByteString . BS.concat . map fs_bs @@ -627,7 +621,7 @@ getFastStringTable = -- |Outputs a 'FastString' with /no decoding at all/, that is, you -- get the actual bytes in the 'FastString' written to the 'Handle'. hPutFS :: Handle -> FastString -> IO () -hPutFS handle fs = BS.hPut handle $ fastStringToByteString fs +hPutFS handle fs = BS.hPut handle $ bytesFS fs -- ToDo: we'll probably want an hPutFSLocal, or something, to output -- in the current locale's encoding (for error messages and suchlike). diff --git a/libraries/ghci/GHCi/InfoTable.hsc b/libraries/ghci/GHCi/InfoTable.hsc index ec3c18ae06..87d8f8f167 100644 --- a/libraries/ghci/GHCi/InfoTable.hsc +++ b/libraries/ghci/GHCi/InfoTable.hsc @@ -22,6 +22,8 @@ import Foreign.C import GHC.Ptr import GHC.Exts import GHC.Exts.Heap +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS #endif ghciTablesNextToCode :: Bool @@ -40,7 +42,7 @@ mkConInfoTable -> Int -- non-ptr words -> Int -- constr tag -> Int -- pointer tag - -> [Word8] -- con desc + -> ByteString -- con desc -> IO (Ptr StgInfoTable) -- resulting info table is allocated with allocateExec(), and -- should be freed with freeExec(). @@ -344,10 +346,10 @@ sizeOfEntryCode Right xs -> sizeOf (head xs) * length xs -- Note: Must return proper pointer for use in a closure -newExecConItbl :: StgInfoTable -> [Word8] -> IO (FunPtr ()) +newExecConItbl :: StgInfoTable -> ByteString -> IO (FunPtr ()) newExecConItbl obj con_desc = alloca $ \pcode -> do - let lcon_desc = length con_desc + 1{- null terminator -} + let lcon_desc = BS.length con_desc + 1{- null terminator -} -- SCARY -- This size represents the number of bytes in an StgConInfoTable. sz = fromIntegral (conInfoTableSizeB + sizeOfEntryCode) @@ -360,7 +362,10 @@ newExecConItbl obj con_desc let cinfo = StgConInfoTable { conDesc = ex_ptr `plusPtr` fromIntegral sz , infoTable = obj } pokeConItbl wr_ptr ex_ptr cinfo - pokeArray0 0 (castPtr wr_ptr `plusPtr` fromIntegral sz) con_desc + BS.useAsCStringLen con_desc $ \(src, len) -> + copyBytes (castPtr wr_ptr `plusPtr` fromIntegral sz) src len + let null_off = fromIntegral sz + fromIntegral (BS.length con_desc) + poke (castPtr wr_ptr `plusPtr` null_off) (0 :: Word8) _flushExec sz ex_ptr -- Cache flush (if needed) #if defined(TABLES_NEXT_TO_CODE) return (castPtrToFunPtr (ex_ptr `plusPtr` conInfoTableSizeB)) diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs index bc0a19ca62..959942e858 100644 --- a/libraries/ghci/GHCi/Message.hs +++ b/libraries/ghci/GHCi/Message.hs @@ -107,7 +107,7 @@ data Message a where -> Int -- non-ptr words -> Int -- constr tag -> Int -- pointer tag - -> [Word8] -- constructor desccription + -> ByteString -- constructor desccription -> Message (RemotePtr StgInfoTable) -- | Evaluate a statement diff --git a/testsuite/tests/plugins/simple-plugin/Simple/Plugin.hs b/testsuite/tests/plugins/simple-plugin/Simple/Plugin.hs index 9c0fdcbb5a..938d23586c 100644 --- a/testsuite/tests/plugins/simple-plugin/Simple/Plugin.hs +++ b/testsuite/tests/plugins/simple-plugin/Simple/Plugin.hs @@ -71,7 +71,7 @@ changeExpr anns mb_replacement e = let go = changeExpr anns mb_replacement in ca Nothing -> return e Just replacement -> do putMsgS "Performing Replacement" - return $ Lit (LitString (fastStringToByteString (mkFastString replacement))) + return $ Lit (LitString (bytesFS (mkFastString replacement))) App e1 e2 -> liftM2 App (go e1) (go e2) Lam b e -> liftM (Lam b) (go e) Let bind e -> liftM2 Let (changeBind anns mb_replacement bind) (go e) |