content: {-# LANGUAGE DerivingStrategies #-}
  {-# LANGUAGE MagicHash #-}
  {-# LANGUAGE UnboxedTuples #-}
  {-# LANGUAGE UnliftedFFITypes #-}
  {-# LANGUAGE CPP #-}
  
  {-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
  #if MIN_VERSION_GLASGOW_HASKELL(9,8,0,0)
  {-# OPTIONS_GHC -fno-unoptimized-core-for-interpreter #-}
  #endif
  -- We always optimise this, otherwise performance of a non-optimised
  -- compiler is severely affected
  --
  -- Also important, if you load this module into GHCi then the data representation of
  -- FastString has to match that of the host compiler due to the shared FastString
  -- table. Otherwise you will get segfaults when the table is consulted and the fields
  -- from the FastString are in an incorrect order.
  
  -- |
  -- There are two principal string types used internally by GHC:
  --
  -- ['FastString']
  --
  --   * A compact, hash-consed, representation of character strings.
  --   * Generated by 'fsLit'.
  --   * You can get a 'GHC.Types.Unique.Unique' from them.
  --   * Equality test is O(1) (it uses the Unique).
  --   * Comparison is O(1) or O(n):
  --       * O(n) but deterministic with lexical comparison (`lexicalCompareFS`)
  --       * O(1) but non-deterministic with Unique comparison (`uniqCompareFS`)
  --   * Turn into 'GHC.Utils.Outputable.SDoc' with 'GHC.Utils.Outputable.ftext'.
  --
  -- ['PtrString']
  --
  --   * Pointer and size of a Latin-1 encoded string.
  --   * Practically no operations.
  --   * Outputting them is fast.
  --   * Generated by 'mkPtrString#'.
  --   * Length of string literals (mkPtrString# "abc"#) is computed statically
  --   * Turn into 'GHC.Utils.Outputable.SDoc' with 'GHC.Utils.Outputable.ptext'
  --   * Requires manual memory management.
  --     Improper use may lead to memory leaks or dangling pointers.
  --   * It assumes Latin-1 as the encoding, therefore it cannot represent
  --     arbitrary Unicode strings.
  --
  -- Use 'PtrString' unless you want the facilities of 'FastString'.
  module GHC.Data.FastString
         (
          -- * ByteString
          bytesFS,
          fastStringToByteString,
          mkFastStringByteString,
          fastZStringToByteString,
          unsafeMkByteString,
  
          -- * ShortByteString
          fastStringToShortByteString,
          mkFastStringShortByteString,
  
          -- * ShortText
          fastStringToShortText,
  
          -- * FastZString
          FastZString,
          hPutFZS,
          zString,
          zStringTakeN,
          lengthFZS,
  
          -- * FastStrings
          FastString(..),     -- not abstract, for now.
          NonDetFastString (..),
          LexicalFastString (..),
  
          -- ** Construction
          fsLit,
          mkFastString,
          mkFastStringBytes,
          mkFastStringByteList,
          mkFastString#,
  
          -- ** Deconstruction
          unpackFS,           -- :: FastString -> String
          unconsFS,           -- :: FastString -> Maybe (Char, FastString)
  
          -- ** Encoding
          zEncodeFS,
  
          -- ** Operations
          uniqueOfFS,
          lengthFS,
          nullFS,
          appendFS,
          concatFS,
          consFS,
          nilFS,
          lexicalCompareFS,
          uniqCompareFS,
  
          -- ** Outputting
          hPutFS,
  
          -- ** Internal
          getFastStringTable,
          getFastStringZEncCounter,
  
          -- * PtrStrings
          PtrString (..),
  
          -- ** Construction
          mkPtrString#,
  
          -- ** Deconstruction
          unpackPtrString,
          unpackPtrStringTakeN,
  
          -- ** Operations
          lengthPS
         ) where
  
  import GHC.Prelude.Basic as Prelude
  
  import GHC.Utils.Encoding
  import GHC.Utils.IO.Unsafe
  import GHC.Utils.Panic.Plain
  import GHC.Utils.Misc
  import GHC.Data.FastMutInt
  
  import Control.Concurrent.MVar
  import Control.DeepSeq
  import Control.Monad
  import Data.ByteString (ByteString)
  import Data.ByteString.Short (ShortByteString)
  import qualified Data.ByteString          as BS
  import qualified Data.ByteString.Char8    as BSC
  import qualified Data.ByteString.Unsafe   as BS
  import qualified Data.ByteString.Short    as SBS
  import GHC.Data.ShortText (ShortText(..))
  import Foreign.C
  import System.IO
  import Data.Data
  import Data.IORef
  import Data.Semigroup as Semi
  
  import Foreign
  
  import GHC.Conc.Sync    (sharedCAF)
  
  import GHC.Exts
  import GHC.IO
  
  -- | Gives the Modified UTF-8 encoded bytes corresponding to a 'FastString'
  bytesFS, fastStringToByteString :: FastString -> ByteString
  {-# INLINE[1] bytesFS #-}
  bytesFS f = SBS.fromShort $ fs_sbs f
  
  {-# DEPRECATED fastStringToByteString "Use `bytesFS` instead" #-}
  fastStringToByteString = bytesFS
  
  fastStringToShortByteString :: FastString -> ShortByteString
  fastStringToShortByteString = fs_sbs
  
  fastStringToShortText :: FastString -> ShortText
  fastStringToShortText = ShortText . fs_sbs
  
  fastZStringToByteString :: FastZString -> ByteString
  fastZStringToByteString (FastZString bs) = bs
  
  -- This will drop information if any character > '\xFF'
  unsafeMkByteString :: String -> ByteString
  unsafeMkByteString = BSC.pack
  
  hashFastString :: FastString -> Int
  hashFastString fs = hashStr $ fs_sbs fs
  
  -- -----------------------------------------------------------------------------
  
  newtype FastZString = FastZString ByteString
    deriving NFData
  
  hPutFZS :: Handle -> FastZString -> IO ()
  hPutFZS handle (FastZString bs) = BS.hPut handle bs
  
  zString :: FastZString -> String
  zString (FastZString bs) =
      inlinePerformIO $ BS.unsafeUseAsCStringLen bs peekCAStringLen
  
  -- | @zStringTakeN n = 'take' n . 'zString'@
  -- but is performed in \(O(\min(n,l))\) rather than \(O(l)\),
  -- where \(l\) is the length of the 'FastZString'.
  zStringTakeN :: Int -> FastZString -> String
  zStringTakeN n (FastZString bs) =
      inlinePerformIO $ BS.unsafeUseAsCStringLen bs $ \(cp, len) ->
          peekCAStringLen (cp, min n len)
  
  lengthFZS :: FastZString -> Int
  lengthFZS (FastZString bs) = BS.length bs
  
  mkFastZStringString :: String -> FastZString
  mkFastZStringString str = FastZString (BSC.pack str)
  
  -- -----------------------------------------------------------------------------
  
  {-| A 'FastString' is a Modified UTF-8 encoded string together with a unique ID.
  All 'FastString's are stored in a global hashtable to support fast O(1)
  comparison.
  
  It is also associated with a lazy reference to the Z-encoding
  of this string which is used by the compiler internally.
  -}
  data FastString = FastString {
        uniq    :: {-# UNPACK #-} !Int, -- unique id
        n_chars :: {-# UNPACK #-} !Int, -- number of chars
        fs_sbs  :: {-# UNPACK #-} !ShortByteString,
        fs_zenc :: FastZString
        -- ^ Lazily computed Z-encoding of this string. See Note [Z-Encoding] in
        -- GHC.Utils.Encoding.
        --
        -- Since 'FastString's are globally memoized this is computed at most
        -- once for any given string.
    }
  
  instance Eq FastString where
    f1 == f2  =  uniq f1 == uniq f2
  
  -- We don't provide any "Ord FastString" instance to force you to think about
  -- which ordering you want:
  --    * lexical:   deterministic,     O(n). Cf lexicalCompareFS and LexicalFastString.
  --    * by unique: non-deterministic, O(1). Cf uniqCompareFS    and NonDetFastString.
  
  instance IsString FastString where
      fromString = fsLit
  
  instance Semi.Semigroup FastString where
      (<>) = appendFS
  
  instance Monoid FastString where
      mempty = nilFS
      mappend = (Semi.<>)
      mconcat = concatFS
  
  instance Show FastString where
     show fs = show (unpackFS fs)
  
  instance Data FastString where
    -- don't traverse?
    toConstr _   = abstractConstr "FastString"
    gunfold _ _  = error "gunfold"
    dataTypeOf _ = mkNoRepType "FastString"
  
  instance NFData FastString where
    rnf fs = seq fs ()
  
  -- | Compare FastString lexically
  --
  -- If you don't care about the lexical ordering, use `uniqCompareFS` instead.
  lexicalCompareFS :: FastString -> FastString -> Ordering
  lexicalCompareFS fs1 fs2 =
    if uniq fs1 == uniq fs2 then EQ else
    utf8CompareShortByteString (fs_sbs fs1) (fs_sbs fs2)
    -- perform a lexical comparison taking into account the Modified UTF-8
    -- encoding we use (cf #18562)
  
  -- | Compare FastString by their Unique (not lexically).
  --
  -- Much cheaper than `lexicalCompareFS` but non-deterministic!
  uniqCompareFS :: FastString -> FastString -> Ordering
  uniqCompareFS fs1 fs2 = compare (uniq fs1) (uniq fs2)
  
  -- | Non-deterministic FastString
  --
  -- This is a simple FastString wrapper with an Ord instance using
  -- `uniqCompareFS` (i.e. which compares FastStrings on their Uniques). Hence it
  -- is not deterministic from one run to the other.
  newtype NonDetFastString
     = NonDetFastString FastString
     deriving newtype (Eq, Show)
     deriving stock Data
  
  instance Ord NonDetFastString where
     compare (NonDetFastString fs1) (NonDetFastString fs2) = uniqCompareFS fs1 fs2
  
  -- | Lexical FastString
  --
  -- This is a simple FastString wrapper with an Ord instance using
  -- `lexicalCompareFS` (i.e. which compares FastStrings on their String
  -- representation). Hence it is deterministic from one run to the other.
  newtype LexicalFastString
     = LexicalFastString { getLexicalFastString :: FastString }
     deriving newtype (Eq, Show)
     deriving stock Data
  
  instance Ord LexicalFastString where
     compare (LexicalFastString fs1) (LexicalFastString fs2) = lexicalCompareFS fs1 fs2
  
  instance NFData LexicalFastString where
    rnf (LexicalFastString f) = rnf f
  
  -- -----------------------------------------------------------------------------
  -- Construction
  
  {-
  Internally, the compiler will maintain a fast string symbol table, providing
  sharing and fast comparison. Creation of new @FastString@s then covertly does a
  lookup, re-using the @FastString@ if there was a hit.
  
  The design of the FastString hash table allows for lockless concurrent reads
  and updates to multiple buckets with low synchronization overhead.
  
  See Note [Updating the FastString table] on how it's updated.
  -}
  data FastStringTable = FastStringTable
    {-# UNPACK #-} !FastMutInt
    -- ^ The unique ID counter shared with all buckets
    --
    -- We unpack the 'FastMutInt' counter as it is always consumed strictly.
    {-# NOUNPACK #-} !FastMutInt
    -- ^ Number of computed z-encodings for all buckets.
    --
    -- We mark this as 'NOUNPACK' as this 'FastMutInt' is retained by a thunk
    -- in 'mkFastStringWith' and needs to be boxed any way.
    -- If this is unpacked, then we box this single 'FastMutInt' once for each
    -- allocated FastString.
    (Array# (IORef FastStringTableSegment)) -- ^  concurrent segments
  
  data FastStringTableSegment = FastStringTableSegment
    {-# UNPACK #-} !(MVar ())  -- the lock for write in each segment
    {-# UNPACK #-} !FastMutInt -- the number of elements
    (MutableArray# RealWorld [FastString]) -- buckets in this segment
  
  {-
  Following parameters are determined based on:
  
  * Benchmark based on testsuite/tests/utils/should_run/T14854.hs
  * Stats of @echo :browse | ghc --interactive -dfaststring-stats >/dev/null@:
    on 2018-10-24, we have 13920 entries.
  -}
  segmentBits, numSegments, segmentMask, initialNumBuckets :: Int
  segmentBits = 8
  numSegments = 256   -- bit segmentBits
  segmentMask = 0xff  -- bit segmentBits - 1
  initialNumBuckets = 64
  
  hashToSegment# :: Int# -> Int#
  hashToSegment# hash# = hash# `andI#` segmentMask#
    where
      !(I# segmentMask#) = segmentMask
  
  hashToIndex# :: MutableArray# RealWorld [FastString] -> Int# -> Int#
  hashToIndex# buckets# hash# =
    (hash# `uncheckedIShiftRL#` segmentBits#) `remInt#` size#
    where
      !(I# segmentBits#) = segmentBits
      size# = sizeofMutableArray# buckets#
  
  maybeResizeSegment :: IORef FastStringTableSegment -> IO FastStringTableSegment
  maybeResizeSegment segmentRef = do
    segment@(FastStringTableSegment lock counter old#) <- readIORef segmentRef
    let oldSize# = sizeofMutableArray# old#
        newSize# = oldSize# *# 2#
    (I# n#) <- readFastMutInt counter
    if isTrue# (n# <# newSize#) -- maximum load of 1
    then return segment
    else do
      resizedSegment@(FastStringTableSegment _ _ new#) <- IO $ \s1# ->
        case newArray# newSize# [] s1# of
          (# s2#, arr# #) -> (# s2#, FastStringTableSegment lock counter arr# #)
      forM_ [0 .. (I# oldSize#) - 1] $ \(I# i#) -> do
        fsList <- IO $ readArray# old# i#
        forM_ fsList $ \fs -> do
          let -- Shall we store in hash value in FastString instead?
              !(I# hash#) = hashFastString fs
              idx# = hashToIndex# new# hash#
          IO $ \s1# ->
            case readArray# new# idx# s1# of
              (# s2#, bucket #) -> case writeArray# new# idx# (fs: bucket) s2# of
                s3# -> (# s3#, () #)
      writeIORef segmentRef resizedSegment
      return resizedSegment
  
  {-# NOINLINE stringTable #-}
  stringTable :: FastStringTable
  stringTable = unsafePerformIO $ do
    let !(I# numSegments#) = numSegments
        !(I# initialNumBuckets#) = initialNumBuckets
        loop a# i# s1#
          | isTrue# (i# ==# numSegments#) = s1#
          | otherwise = case newMVar () `unIO` s1# of
              (# s2#, lock #) -> case newFastMutInt 0 `unIO` s2# of
                (# s3#, counter #) -> case newArray# initialNumBuckets# [] s3# of
                  (# s4#, buckets# #) -> case newIORef
                      (FastStringTableSegment lock counter buckets#) `unIO` s4# of
                    (# s5#, segment #) -> case writeArray# a# i# segment s5# of
                      s6# -> loop a# (i# +# 1#) s6#
    uid <- newFastMutInt 603979776 -- ord '$' * 0x01000000
    n_zencs <- newFastMutInt 0
    tab <- IO $ \s1# ->
      case newArray# numSegments# (panic "string_table") s1# of
        (# s2#, arr# #) -> case loop arr# 0# s2# of
          s3# -> case unsafeFreezeArray# arr# s3# of
            (# s4#, segments# #) ->
              (# s4#, FastStringTable uid n_zencs segments# #)
  
    -- use the support wired into the RTS to share this CAF among all images of
    -- libHSghc
    sharedCAF tab getOrSetLibHSghcFastStringTable
  
  -- from the 9.3 RTS; the previous RTS before might not have this symbol.  The
  -- right way to do this however would be to define some HAVE_FAST_STRING_TABLE
  -- or similar rather than use (odd parity) development versions.
  foreign import ccall unsafe "getOrSetLibHSghcFastStringTable"
    getOrSetLibHSghcFastStringTable :: Ptr a -> IO (Ptr a)
  
  {-
  
  We include the FastString table in the `sharedCAF` mechanism because we'd like
  FastStrings created by a Core plugin to have the same uniques as corresponding
  strings created by the host compiler itself.  For example, this allows plugins
  to lookup known names (eg `mkTcOcc "MySpecialType"`) in the GlobalRdrEnv or
  even re-invoke the parser.
  
  In particular, the following little sanity test was failing in a plugin
  prototyping safe newtype-coercions: GHC.NT.Type.NT was imported, but could not
  be looked up /by the plugin/.
  
     let rdrName = mkModuleName "GHC.NT.Type" `mkRdrQual` mkTcOcc "NT"
     putMsgS $ showSDoc dflags $ ppr $
       lookupGRE (mg_rdr_env guts) (LookupRdrName rdrName AllRelevantGREs)
  
  `mkTcOcc` involves the lookup (or creation) of a FastString.  Since the
  plugin's FastString.string_table is empty, constructing the RdrName also
  allocates new uniques for the FastStrings "GHC.NT.Type" and "NT".  These
  uniques are almost certainly unequal to the ones that the host compiler
  originally assigned to those FastStrings.  Thus the lookup fails since the
  domain of the GlobalRdrEnv is affected by the RdrName's OccName's FastString's
  unique.
  
  Maintaining synchronization of the two instances of this global is rather
  difficult because of the uses of `unsafePerformIO` in this module.  Not
  synchronizing them risks breaking the rather major invariant that two
  FastStrings with the same unique have the same string. Thus we use the
  lower-level `sharedCAF` mechanism that relies on Globals.c.
  
  -}
  
  mkFastString# :: Addr# -> FastString
  {-# INLINE mkFastString# #-}
  mkFastString# a# = mkFastStringBytes ptr (ptrStrLength ptr)
    where ptr = Ptr a#
  
  {- Note [Updating the FastString table]
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  We use a concurrent hashtable which contains multiple segments, each hash value
  always maps to the same segment. Read is lock-free, write to the a segment
  should acquire a lock for that segment to avoid race condition, writes to
  different segments are independent.
  
  The procedure goes like this:
  
  1. Find out which segment to operate on based on the hash value
  2. Read the relevant bucket and perform a look up of the string.
  3. If it exists, return it.
  4. Otherwise grab a unique ID, create a new FastString and atomically attempt
     to update the relevant segment with this FastString:
  
     * Resize the segment by doubling the number of buckets when the number of
       FastStrings in this segment grows beyond the threshold.
     * Double check that the string is not in the bucket. Another thread may have
       inserted it while we were creating our string.
     * Return the existing FastString if it exists. The one we preemptively
       created will get GCed.
     * Otherwise, insert and return the string we created.
  -}
  
  mkFastStringWith
      :: (Int -> FastMutInt-> IO FastString) -> ShortByteString -> IO FastString
  mkFastStringWith mk_fs sbs = do
    FastStringTableSegment lock _ buckets# <- readIORef segmentRef
    let idx# = hashToIndex# buckets# hash#
    bucket <- IO $ readArray# buckets# idx#
    case bucket_match bucket sbs of
      Just found -> return found
      Nothing -> do
        -- The withMVar below is not dupable. It can lead to deadlock if it is
        -- only run partially and putMVar is not called after takeMVar.
        noDuplicate
        n <- get_uid
        new_fs <- mk_fs n n_zencs
        withMVar lock $ \_ -> insert new_fs
    where
      !(FastStringTable uid n_zencs segments#) = stringTable
      get_uid = atomicFetchAddFastMut uid 1
  
      !(I# hash#) = hashStr sbs
      (# segmentRef #) = indexArray# segments# (hashToSegment# hash#)
      insert fs = do
        FastStringTableSegment _ counter buckets# <- maybeResizeSegment segmentRef
        let idx# = hashToIndex# buckets# hash#
        bucket <- IO $ readArray# buckets# idx#
        case bucket_match bucket sbs of
          -- The FastString was added by another thread after previous read and
          -- before we acquired the write lock.
          Just found -> return found
          Nothing -> do
            IO $ \s1# ->
              case writeArray# buckets# idx# (fs : bucket) s1# of
                s2# -> (# s2#, () #)
            _ <- atomicFetchAddFastMut counter 1
            return fs
  
  bucket_match :: [FastString] -> ShortByteString -> Maybe FastString
  bucket_match fs sbs = go fs
    where go [] = Nothing
          go (fs@(FastString {fs_sbs=fs_sbs}) : ls)
            | fs_sbs == sbs = Just fs
            | otherwise     = go ls
  -- bucket_match used to inline before changes to instance Eq ShortByteString
  -- in bytestring-0.12, which made it slightly larger than inlining threshold.
  -- Non-inlining causes a small, but measurable performance regression, so let's force it.
  {-# INLINE bucket_match #-}
  
  mkFastStringBytes :: Ptr Word8 -> Int -> FastString
  mkFastStringBytes !ptr !len =
      -- NB: Might as well use unsafeDupablePerformIO, since mkFastStringWith is
      -- idempotent.
      unsafeDupablePerformIO $ do
          sbs <- newSBSFromPtr ptr len
          mkFastStringWith (mkNewFastStringShortByteString sbs) sbs
  
  newSBSFromPtr :: Ptr a -> Int -> IO ShortByteString
  newSBSFromPtr (Ptr src#) (I# len#) =
    IO $ \s ->
      case newByteArray# len# s of { (# s, dst# #) ->
      case copyAddrToByteArray# src# dst# 0# len# s of { s ->
      case unsafeFreezeByteArray# dst# s of { (# s, ba# #) ->
      (# s, SBS.SBS ba# #) }}}
  
  -- | Create a 'FastString' by copying an existing 'ByteString'
  mkFastStringByteString :: ByteString -> FastString
  mkFastStringByteString bs =
    let sbs = SBS.toShort bs in
    inlinePerformIO $
        mkFastStringWith (mkNewFastStringShortByteString sbs) sbs
  
  -- | Create a 'FastString' from an existing 'ShortByteString' without
  -- copying.
  mkFastStringShortByteString :: ShortByteString -> FastString
  mkFastStringShortByteString sbs =
    inlinePerformIO $ mkFastStringWith (mkNewFastStringShortByteString sbs) sbs
  
  -- | Creates a UTF-8 encoded 'FastString' from a 'String'
  mkFastString :: String -> FastString
  {-# NOINLINE[1] mkFastString #-}
  mkFastString str =
    inlinePerformIO $ do
      let !sbs = utf8EncodeShortByteString str
      mkFastStringWith (mkNewFastStringShortByteString sbs) sbs
  
  -- The following rule is used to avoid polluting the non-reclaimable FastString
  -- table with transient strings when we only want their encoding.
  {-# RULES
  "bytesFS/mkFastString" forall x. bytesFS (mkFastString x) = utf8EncodeByteString x #-}
  
  -- | Creates a 'FastString' from a UTF-8 encoded @[Word8]@
  mkFastStringByteList :: [Word8] -> FastString
  mkFastStringByteList str = mkFastStringShortByteString (SBS.pack str)
  
  -- | Creates a (lazy) Z-encoded 'FastString' from a 'ShortByteString' and
  -- account the number of forced z-strings into the passed 'FastMutInt'.
  mkZFastString :: FastMutInt -> ShortByteString -> FastZString
  mkZFastString n_zencs sbs = unsafePerformIO $ do
    _ <- atomicFetchAddFastMut n_zencs 1
    return $ mkFastZStringString (zEncodeString (utf8DecodeShortByteString sbs))
  
  mkNewFastStringShortByteString :: ShortByteString -> Int
                                 -> FastMutInt -> IO FastString
  mkNewFastStringShortByteString sbs uid n_zencs = do
    let zstr = mkZFastString n_zencs sbs
        chars = utf8CountCharsShortByteString sbs
    return (FastString uid chars sbs zstr)
  
  hashStr  :: ShortByteString -> Int
   -- produce a hash value between 0 & m (inclusive)
  hashStr sbs@(SBS.SBS ba#) = loop 0# 0#
     where
      !(I# len#) = SBS.length sbs
      loop h n =
        if isTrue# (n ==# len#) then
          I# h
        else
          let
            -- DO NOT move this let binding! indexCharOffAddr# reads from the
            -- pointer so we need to evaluate this based on the length check
            -- above. Not doing this right caused #17909.
            !c = int8ToInt# (indexInt8Array# ba# n)
            !h2 = (h *# 16777619#) `xorI#` c
          in
            loop h2 (n +# 1#)
  
  -- -----------------------------------------------------------------------------
  -- Operations
  
  -- | Returns the length of the 'FastString' in characters
  lengthFS :: FastString -> Int
  lengthFS fs = n_chars fs
  
  -- | Returns @True@ if the 'FastString' is empty
  nullFS :: FastString -> Bool
  nullFS fs = SBS.null $ fs_sbs fs
  
  -- | Lazily unpacks and decodes the FastString
  unpackFS :: FastString -> String
  unpackFS fs = utf8DecodeShortByteString $ fs_sbs 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
  -- memoized.
  --
  zEncodeFS :: FastString -> FastZString
  zEncodeFS fs = fs_zenc fs
  
  appendFS :: FastString -> FastString -> FastString
  appendFS fs1 fs2 = mkFastStringShortByteString
                   $ (Semi.<>) (fs_sbs fs1) (fs_sbs fs2)
  
  concatFS :: [FastString] -> FastString
  concatFS = mkFastStringShortByteString . mconcat . map fs_sbs
  
  consFS :: Char -> FastString -> FastString
  consFS c fs = mkFastString (c : unpackFS fs)
  
  unconsFS :: FastString -> Maybe (Char, FastString)
  unconsFS fs =
    case unpackFS fs of
      []          -> Nothing
      (chr : str) -> Just (chr, mkFastString str)
  
  uniqueOfFS :: FastString -> Int
  uniqueOfFS fs = uniq fs
  
  nilFS :: FastString
  nilFS = mkFastString ""
  
  -- -----------------------------------------------------------------------------
  -- Stats
  
  getFastStringTable :: IO [[[FastString]]]
  getFastStringTable =
    forM [0 .. numSegments - 1] $ \(I# i#) -> do
      let (# segmentRef #) = indexArray# segments# i#
      FastStringTableSegment _ _ buckets# <- readIORef segmentRef
      let bucketSize = I# (sizeofMutableArray# buckets#)
      forM [0 .. bucketSize - 1] $ \(I# j#) ->
        IO $ readArray# buckets# j#
    where
      !(FastStringTable _ _ segments#) = stringTable
  
  getFastStringZEncCounter :: IO Int
  getFastStringZEncCounter = readFastMutInt n_zencs
    where
      !(FastStringTable _ n_zencs _) = stringTable
  
  -- -----------------------------------------------------------------------------
  -- Outputting 'FastString's
  
  -- |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 $ bytesFS fs
  
  -- ToDo: we'll probably want an hPutFSLocal, or something, to output
  -- in the current locale's encoding (for error messages and suchlike).
  
  -- -----------------------------------------------------------------------------
  -- PtrStrings, here for convenience only.
  
  -- | A 'PtrString' is a pointer to some array of Latin-1 encoded chars.
  data PtrString = PtrString !(Ptr Word8) !Int
  
  -- | Wrap an unboxed address into a 'PtrString'.
  mkPtrString# :: Addr# -> PtrString
  {-# INLINE mkPtrString# #-}
  mkPtrString# a# = PtrString (Ptr a#) (ptrStrLength (Ptr a#))
  
  -- | Decode a 'PtrString' back into a 'String' using Latin-1 encoding.
  -- This does not free the memory associated with 'PtrString'.
  unpackPtrString :: PtrString -> String
  unpackPtrString (PtrString (Ptr p#) (I# n#)) = unpackNBytes# p# n#
  
  -- | @unpackPtrStringTakeN n = 'take' n . 'unpackPtrString'@
  -- but is performed in \(O(\min(n,l))\) rather than \(O(l)\),
  -- where \(l\) is the length of the 'PtrString'.
  unpackPtrStringTakeN :: Int -> PtrString -> String
  unpackPtrStringTakeN n (PtrString (Ptr p#) len) =
    case min n len of
      I# n# -> unpackNBytes# p# n#
  
  -- | Return the length of a 'PtrString'
  lengthPS :: PtrString -> Int
  lengthPS (PtrString _ n) = n
  
  -- -----------------------------------------------------------------------------
  -- under the carpet
  
  
  ptrStrLength :: Ptr Word8 -> Int
  {-# INLINE ptrStrLength #-}
  ptrStrLength (Ptr a) = I# (cstringLength# a)
  
  {-# NOINLINE fsLit #-}
  fsLit :: String -> FastString
  fsLit x = mkFastString x
  
  {-# RULES "fslit"
      forall x . fsLit (unpackCString# x) = mkFastString# x #-}
  