From bea5d9a24302d57165f3158a16fc072af2d2c82f Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Tue, 24 Mar 2020 20:55:52 +0000 Subject: Use FastString instead of ByteString in LitString Not sure this is the best choice but manipulating ShortByteStrings is also awkward --- compiler/GHC/ByteCode/Asm.hs | 2 +- compiler/GHC/Core/Make.hs | 2 +- compiler/GHC/Core/Opt/ConstantFold.hs | 3 +-- compiler/GHC/Core/SimpleOpt.hs | 14 ++++++-------- compiler/GHC/Core/Unfold.hs | 4 ++-- compiler/GHC/Core/Utils.hs | 2 +- compiler/GHC/HsToCore/Match/Literal.hs | 7 +++---- compiler/GHC/HsToCore/PmCheck/Types.hs | 2 +- compiler/GHC/StgToCmm/Utils.hs | 2 +- compiler/GHC/Tc/Types/EvTerm.hs | 2 +- compiler/GHC/Types/Literal.hs | 7 +++---- 11 files changed, 21 insertions(+), 26 deletions(-) diff --git a/compiler/GHC/ByteCode/Asm.hs b/compiler/GHC/ByteCode/Asm.hs index 9ed0283394..54a136814e 100644 --- a/compiler/GHC/ByteCode/Asm.hs +++ b/compiler/GHC/ByteCode/Asm.hs @@ -451,7 +451,7 @@ assembleI platform i = case i of literal (LitFloat r) = float (fromRational r) literal (LitDouble r) = double (fromRational r) literal (LitChar c) = int (ord c) - literal (LitString bs) = lit [BCONPtrStr bs] + literal (LitString bs) = lit [BCONPtrStr (bytesFS bs)] -- LitString requires a zero-terminator when emitted literal (LitNumber nt i _) = case nt of LitNumInt -> int (fromIntegral i) diff --git a/compiler/GHC/Core/Make.hs b/compiler/GHC/Core/Make.hs index 8ba0b8f65d..b0726af41a 100644 --- a/compiler/GHC/Core/Make.hs +++ b/compiler/GHC/Core/Make.hs @@ -313,7 +313,7 @@ mkStringExprFSWith lookupM str where chars = unpackFS str safeChar c = ord c >= 1 && ord c <= 0x7F - lit = Lit (LitString (bytesFS str)) + lit = Lit (LitString str) {- ************************************************************************ diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs index 7c18f27003..b41db80078 100644 --- a/compiler/GHC/Core/Opt/ConstantFold.hs +++ b/compiler/GHC/Core/Opt/ConstantFold.hs @@ -62,7 +62,6 @@ import Control.Applicative ( Alternative(..) ) import Control.Monad import Data.Bits as Bits -import qualified Data.ByteString as BS import Data.Int import Data.Ratio import Data.Word @@ -1456,7 +1455,7 @@ match_append_lit _ id_unf _ = ASSERT( ty1 `eqType` ty2 ) Just $ mkTicks strTicks $ Var unpk `App` Type ty1 - `App` Lit (LitString (s1 `BS.append` s2)) + `App` Lit (LitString (s1 `appendFS` s2)) `App` mkTicks (c1Ticks ++ c2Ticks) c1' `App` n diff --git a/compiler/GHC/Core/SimpleOpt.hs b/compiler/GHC/Core/SimpleOpt.hs index 7b923f89f9..9fdaf2a464 100644 --- a/compiler/GHC/Core/SimpleOpt.hs +++ b/compiler/GHC/Core/SimpleOpt.hs @@ -1158,24 +1158,22 @@ exprIsConApp_maybe (in_scope, id_unf) expr -- See Note [exprIsConApp_maybe on literal strings] -dealWithStringLiteral :: Var -> BS.ByteString -> Coercion +dealWithStringLiteral :: Var -> FastString -> Coercion -> Maybe (DataCon, [Type], [CoreExpr]) -- This is not possible with user-supplied empty literals, GHC.Core.Make.mkStringExprFS -- turns those into [] automatically, but just in case something else in GHC -- generates a string literal directly. dealWithStringLiteral _ str co - | BS.null str + | nullFS str = pushCoDataCon nilDataCon [Type charTy] co -dealWithStringLiteral fun str co - = let strFS = mkFastStringByteString str - - char = mkConApp charDataCon [mkCharLit (headFS strFS)] - charTail = BS.tail (bytesFS strFS) +dealWithStringLiteral fun strFS co + = let char = mkConApp charDataCon [mkCharLit (headFS strFS)] + charTail = mkFastStringByteString (BS.tail (bytesFS strFS)) -- In singleton strings, just add [] instead of unpackCstring# ""#. - rest = if BS.null charTail + rest = if nullFS charTail then mkConApp nilDataCon [Type charTy] else App (Var fun) (Lit (LitString charTail)) diff --git a/compiler/GHC/Core/Unfold.hs b/compiler/GHC/Core/Unfold.hs index f619e36f8a..680cf428a5 100644 --- a/compiler/GHC/Core/Unfold.hs +++ b/compiler/GHC/Core/Unfold.hs @@ -46,6 +46,7 @@ module GHC.Core.Unfold ( import GHC.Prelude +import GHC.Data.FastString import GHC.Driver.Session import GHC.Core import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr ) @@ -69,7 +70,6 @@ import GHC.Types.ForeignCall import GHC.Types.Name import GHC.Utils.Error -import qualified Data.ByteString as BS import Data.List {- @@ -793,7 +793,7 @@ litSize :: Literal -> Int -- Used by GHC.Core.Unfold.sizeExpr litSize (LitNumber LitNumInteger _ _) = 100 -- Note [Size of literal integers] litSize (LitNumber LitNumNatural _ _) = 100 -litSize (LitString str) = 10 + 10 * ((BS.length str + 3) `div` 4) +litSize (LitString str) = 10 + 10 * ((lengthFS 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/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs index 6faf179489..2e2cc1c283 100644 --- a/compiler/GHC/Core/Utils.hs +++ b/compiler/GHC/Core/Utils.hs @@ -1922,7 +1922,7 @@ exprIsTickedString = isJust . exprIsTickedString_maybe -- different shape. -- Used to "look through" Ticks in places that need to handle literal strings. exprIsTickedString_maybe :: CoreExpr -> Maybe ByteString -exprIsTickedString_maybe (Lit (LitString bs)) = Just bs +exprIsTickedString_maybe (Lit (LitString bs)) = Just (bytesFS bs) exprIsTickedString_maybe (Tick t e) -- we don't tick literals with CostCentre ticks, compare to mkTick | tickishPlace t == PlaceCostCentre = Nothing diff --git a/compiler/GHC/HsToCore/Match/Literal.hs b/compiler/GHC/HsToCore/Match/Literal.hs index 600af91468..f2b138aa31 100644 --- a/compiler/GHC/HsToCore/Match/Literal.hs +++ b/compiler/GHC/HsToCore/Match/Literal.hs @@ -91,7 +91,7 @@ dsLit l = do dflags <- getDynFlags let platform = targetPlatform dflags case l of - HsStringPrim _ s -> return (Lit (LitString s)) + HsStringPrim _ s -> return (Lit (LitString (mkFastStringByteString s))) HsCharPrim _ c -> return (Lit (LitChar c)) HsIntPrim _ i -> return (Lit (mkLitIntWrap platform i)) HsWordPrim _ w -> return (Lit (mkLitWordWrap platform w)) @@ -437,8 +437,7 @@ matchLiterals (var :| vars) ty sub_groups wrap_str_guard eq_str (LitString s, mr) = do { -- We now have to convert back to FastString. Perhaps there -- should be separate LitBytes and LitString constructors? - let s' = mkFastStringByteString s - ; lit <- mkStringExprFS s' + ; lit <- mkStringExprFS s ; let pred = mkApps (Var eq_str) [Var var, lit] ; return (mkGuardedMatchResult pred mr) } wrap_str_guard _ (l, _) = pprPanic "matchLiterals/wrap_str_guard" (ppr l) @@ -462,7 +461,7 @@ hsLitKey platform (HsWord64Prim _ w) = mkLitWord64Wrap platform w hsLitKey _ (HsCharPrim _ c) = mkLitChar c hsLitKey _ (HsFloatPrim _ f) = mkLitFloat (fl_value f) hsLitKey _ (HsDoublePrim _ d) = mkLitDouble (fl_value d) -hsLitKey _ (HsString _ s) = LitString (bytesFS s) +hsLitKey _ (HsString _ s) = LitString s hsLitKey _ l = pprPanic "hsLitKey" (ppr l) {- diff --git a/compiler/GHC/HsToCore/PmCheck/Types.hs b/compiler/GHC/HsToCore/PmCheck/Types.hs index 310786b01c..29712abd5a 100644 --- a/compiler/GHC/HsToCore/PmCheck/Types.hs +++ b/compiler/GHC/HsToCore/PmCheck/Types.hs @@ -287,7 +287,7 @@ literalToPmLit ty l = PmLit ty <$> go l go (LitChar c) = Just (PmLitChar c) go (LitFloat r) = Just (PmLitRat r) go (LitDouble r) = Just (PmLitRat r) - go (LitString s) = Just (PmLitString (mkFastStringByteString s)) + go (LitString s) = Just (PmLitString s) go (LitNumber _ i _) = Just (PmLitInt i) go _ = Nothing diff --git a/compiler/GHC/StgToCmm/Utils.hs b/compiler/GHC/StgToCmm/Utils.hs index 18a69c9509..bc2f801653 100644 --- a/compiler/GHC/StgToCmm/Utils.hs +++ b/compiler/GHC/StgToCmm/Utils.hs @@ -94,7 +94,7 @@ import Data.Ord ------------------------------------------------------------------------- cgLit :: Literal -> FCode CmmLit -cgLit (LitString s) = newByteStringCLit s +cgLit (LitString s) = newByteStringCLit (bytesFS s) -- not unpackFS; we want the UTF-8 byte stream. cgLit other_lit = do platform <- getPlatform return (mkSimpleLit platform other_lit) diff --git a/compiler/GHC/Tc/Types/EvTerm.hs b/compiler/GHC/Tc/Types/EvTerm.hs index 9bcccb4f7a..3c97d142a7 100644 --- a/compiler/GHC/Tc/Types/EvTerm.hs +++ b/compiler/GHC/Tc/Types/EvTerm.hs @@ -29,7 +29,7 @@ evDelayedError ty msg Var errorId `mkTyApps` [getRuntimeRep ty, ty] `mkApps` [litMsg] where errorId = tYPE_ERROR_ID - litMsg = Lit (LitString (bytesFS msg)) + litMsg = Lit (LitString msg) -- Dictionary for CallStack implicit parameters evCallStack :: (MonadThings m, HasModule m, HasDynFlags m) => diff --git a/compiler/GHC/Types/Literal.hs b/compiler/GHC/Types/Literal.hs index bb6b58a84d..40bbb688f9 100644 --- a/compiler/GHC/Types/Literal.hs +++ b/compiler/GHC/Types/Literal.hs @@ -67,7 +67,6 @@ import GHC.Platform import GHC.Types.Unique.FM import GHC.Utils.Misc -import Data.ByteString (ByteString) import Data.Int import Data.Word import Data.Char @@ -118,7 +117,7 @@ data LiteralX a -- See Note [Types of LitNumbers] below for the -- Type field. - | LitString ByteString -- ^ A string-literal: stored and emitted + | LitString FastString -- ^ A string-literal: stored and emitted -- UTF-8 encoded, we'll arrange to decode it -- at runtime. Also emitted with a @\'\\0\'@ -- terminator. Create with 'mkLitString' @@ -421,7 +420,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 (bytesFS $ mkFastString s) +mkLitString s = LitString (mkFastString s) mkLitInteger :: Integer -> Type -> Literal mkLitInteger x ty = LitNumber LitNumInteger x ty @@ -722,7 +721,7 @@ litTag (LitRubbish) = 8 pprLiteral :: (SDoc -> SDoc) -> LiteralX a -> SDoc pprLiteral _ (LitChar c) = pprPrimChar c -pprLiteral _ (LitString s) = pprHsBytes s +pprLiteral _ (LitString s) = pprHsBytes (bytesFS s) pprLiteral _ (LitNullAddr) = text "__NULL" pprLiteral _ (LitFloat f) = float (fromRat f) <> primFloatSuffix pprLiteral _ (LitDouble d) = double (fromRat d) <> primDoubleSuffix -- cgit v1.2.1