FastString: add fastStringToShorText

2 files changed, 23 insertions, 19 deletions

diff --git a/compiler/GHC/Data/FastString.hs b/compiler/GHC/Data/FastString.hs
index 5b9baa5c82..dcb6901b2c 100644
--- a/compiler/GHC/Data/FastString.hs
+++ b/compiler/GHC/Data/FastString.hs
@@ -52,6 +52,9 @@ module GHC.Data.FastString
         fastStringToShortByteString,
         mkFastStringShortByteString,
 
+        -- * ShortText
+        fastStringToShortText,
+
         -- * FastZString
         FastZString,
         hPutFZS,
@@ -130,6 +133,7 @@ import qualified Data.ByteString.Short    as SBS
 #if !MIN_VERSION_bytestring(0,11,0)
 import qualified Data.ByteString.Short.Internal as SBS
 #endif
+import GHC.Data.ShortText (ShortText(..))
 import Foreign.C
 import System.IO
 import Data.Data
@@ -159,6 +163,9 @@ fastStringToByteString = bytesFS
 fastStringToShortByteString :: FastString -> ShortByteString
 fastStringToShortByteString = fs_sbs
 
+fastStringToShortText :: FastString -> ShortText
+fastStringToShortText = ShortText . fs_sbs
+
 fastZStringToByteString :: FastZString -> ByteString
 fastZStringToByteString (FastZString bs) = bs
 
diff --git a/compiler/GHC/StgToCmm/InfoTableProv.hs b/compiler/GHC/StgToCmm/InfoTableProv.hs
index 56feeb0271..20e2056116 100644
--- a/compiler/GHC/StgToCmm/InfoTableProv.hs
+++ b/compiler/GHC/StgToCmm/InfoTableProv.hs
@@ -3,10 +3,9 @@ module GHC.StgToCmm.InfoTableProv (emitIpeBufferListNode) where
 import GHC.Prelude
 import GHC.Platform
 import GHC.Unit.Module
-import GHC.Utils.Encoding
 import GHC.Utils.Outputable
 import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile)
-import GHC.Data.FastString (fastStringToShortByteString)
+import GHC.Data.FastString (fastStringToShortText)
 
 import GHC.Cmm.CLabel
 import GHC.Cmm.Expr
@@ -16,8 +15,8 @@ import GHC.StgToCmm.Lit (newByteStringCLit)
 import GHC.StgToCmm.Monad
 import GHC.StgToCmm.Utils
 
-import Data.ByteString.Short (ShortByteString)
-import qualified Data.ByteString.Short          as ST
+import GHC.Data.ShortText (ShortText)
+import qualified GHC.Data.ShortText as ST
 
 import qualified Data.Map.Strict as M
 import Control.Monad.Trans.State.Strict
@@ -35,9 +34,7 @@ emitIpeBufferListNode this_mod ents = do
         platform = stgToCmmPlatform cfg
 
     let (cg_ipes, strtab) = flip runState emptyStringTable $ do
-            module_name <- lookupStringTable
-                           $ utf8EncodeShortByteString
-                           $ renderWithContext ctx (ppr this_mod)
+            module_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (ppr this_mod)
             mapM (toCgIPE platform ctx module_name) ents
 
     let -- Emit the fields of an IpeBufferEntry struct.
@@ -67,20 +64,20 @@ emitIpeBufferListNode this_mod ents = do
 
 toCgIPE :: Platform -> SDocContext -> StrTabOffset -> InfoProvEnt -> State StringTable CgInfoProvEnt
 toCgIPE platform ctx module_name ipe = do
-    table_name   <- lookupStringTable $ utf8EncodeShortByteString $ renderWithContext ctx (pprCLabel platform (infoTablePtr ipe))
-    closure_desc <- lookupStringTable $ utf8EncodeShortByteString $ show (infoProvEntClosureType ipe)
-    type_desc <- lookupStringTable $ utf8EncodeShortByteString $ infoTableType ipe
+    table_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (pprCLabel platform (infoTablePtr ipe))
+    closure_desc <- lookupStringTable $ ST.pack $ show (infoProvEntClosureType ipe)
+    type_desc <- lookupStringTable $ ST.pack $ infoTableType ipe
     let label_str = maybe "" snd (infoTableProv ipe)
     let (src_loc_file, src_loc_span) =
             case infoTableProv ipe of
               Nothing -> (mempty, "")
               Just (span, _) ->
-                  let file = fastStringToShortByteString $ srcSpanFile span
+                  let file = fastStringToShortText $ srcSpanFile span
                       coords = renderWithContext ctx (pprUserRealSpan False span)
                   in (file, coords)
-    label    <- lookupStringTable $ utf8EncodeShortByteString label_str
-    src_file <- lookupStringTable src_loc_file
-    src_span <- lookupStringTable $ utf8EncodeShortByteString src_loc_span
+    label    <- lookupStringTable $ ST.pack label_str
+    src_file <- lookupStringTable $ src_loc_file
+    src_span <- lookupStringTable $ ST.pack src_loc_span
     return $ CgInfoProvEnt { ipeInfoTablePtr = infoTablePtr ipe
                            , ipeTableName = table_name
                            , ipeClosureDesc = closure_desc
@@ -102,9 +99,9 @@ data CgInfoProvEnt = CgInfoProvEnt
                                , ipeSrcSpan :: !StrTabOffset
                                }
 
-data StringTable = StringTable { stStrings :: DList ShortByteString
+data StringTable = StringTable { stStrings :: DList ShortText
                                , stLength :: !Int
-                               , stLookup :: !(M.Map ShortByteString StrTabOffset)
+                               , stLookup :: !(M.Map ShortText StrTabOffset)
                                }
 
 newtype StrTabOffset = StrTabOffset Int
@@ -121,15 +118,15 @@ getStringTableStrings st =
     BSL.toStrict $ BSB.toLazyByteString
     $ foldMap f $ dlistToList (stStrings st)
   where
-    f x = BSB.shortByteString x `mappend` BSB.word8 0
+    f x = BSB.shortByteString (ST.contents x) `mappend` BSB.word8 0
 
-lookupStringTable :: ShortByteString -> State StringTable StrTabOffset
+lookupStringTable :: ShortText -> State StringTable StrTabOffset
 lookupStringTable str = state $ \st ->
     case M.lookup str (stLookup st) of
       Just off -> (off, st)
       Nothing ->
           let !st' = st { stStrings = stStrings st `snoc` str
-                        , stLength  = stLength st + ST.length str + 1
+                        , stLength  = stLength st + ST.byteLength str + 1
                         , stLookup  = M.insert str res (stLookup st)
                         }
               res = StrTabOffset (stLength st)