Use FastString instead of ByteString in LitString

Not sure this is the best choice but manipulating ShortByteStrings is
also awkward

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