-- (c) The University of Glasgow, 1997-2006 {-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples, GeneralizedNewtypeDeriving, RecordWildCards, BangPatterns #-} {-# OPTIONS_GHC -O2 -funbox-strict-fields #-} -- We always optimise this, otherwise performance of a non-optimised -- compiler is severely affected -- | -- There are two principal string types used internally by GHC: -- -- ['FastString'] -- -- * A compact, hash-consed, representation of character strings. -- * Comparison is O(1), and you can get a 'Unique.Unique' from them. -- * Generated by 'fsLit'. -- * Turn into 'Outputable.SDoc' with 'Outputable.ftext'. -- -- ['PtrString'] -- -- * Pointer and size of a Latin-1 encoded string. -- * Practically no operations. -- * Outputing them is fast. -- * Generated by 'sLit'. -- * Turn into 'Outputable.SDoc' with '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 FastString ( -- * ByteString bytesFS, -- :: FastString -> ByteString fastStringToByteString, -- = bytesFS (kept for haddock) mkFastStringByteString, fastZStringToByteString, unsafeMkByteString, -- * FastZString FastZString, hPutFZS, zString, lengthFZS, -- * FastStrings FastString, -- not abstract, for now. -- ** Construction fsLit, mkFastString, mkFastStringBytes, mkFastStringByteList, mkFastString#, -- ** Deconstruction unpackFS, -- :: FastString -> String -- ** Encoding zEncodeFS, -- ** Operations lengthFS, nullFS, appendFS, headFS, tailFS, concatFS, consFS, nilFS, isUnderscoreFS, -- ** Class HasFastString(..), -- ** Outputing hPutFS, -- ** Internal getFastStringTable, fastStringGcCounter, uniqueOfFS, gcTable, FastStringTable(..), FastStringTableSegment(..), stringTable, -- * PtrStrings PtrString (..), -- ** Construction sLit, mkPtrString#, mkPtrString, -- ** Deconstruction unpackPtrString, -- ** Operations lengthPS ) where #include "HsVersions.h" import GhcPrelude as Prelude import Encoding import FastFunctions import PlainPanic import Util import GHC.Prim import GHC.ST import Control.Concurrent.MVar import Control.DeepSeq import Control.Monad import Data.ByteString (ByteString) import Data.ByteString.Short.Internal (ShortByteString(..)) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Internal as BS import qualified Data.ByteString.Unsafe as BS import qualified Data.ByteString.Short as BSS import Foreign.C import GHC.Exts import System.IO import Data.Data import Data.IORef import Data.Char import Data.Semigroup as Semi import System.Mem.Weak import GHC.IO import Foreign #if STAGE >= 2 import GHC.Conc.Sync (sharedCAF) #endif import GHC.Base ( unpackCString#, unpackNBytes# ) import GHC.ForeignPtr import GHC.Weak import System.Mem import MonadUtils -- | Gives the UTF-8 encoded bytes corresponding to a 'FastString' bytesFS :: FastString -> ByteString bytesFS (FastString f) = BSS.fromShort f {-# DEPRECATED fastStringToByteString "Use `bytesFS` instead" #-} fastStringToByteString :: FastString -> ByteString fastStringToByteString = bytesFS 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 (FastString bs) = hashStr bs (BSS.length bs) -- ----------------------------------------------------------------------------- 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 lengthFZS :: FastZString -> Int lengthFZS (FastZString bs) = BS.length bs mkFastZStringString :: String -> FastZString mkFastZStringString str = FastZString (BSC.pack str) -- ----------------------------------------------------------------------------- class HasFastString a where getFastString :: a -> FastString instance HasFastString FastString where getFastString = id {-| A 'FastString' is an array of bytes, hashed to support fast O(1) comparison. It is also associated with a character encoding, so that we know how to convert a 'FastString' to the local encoding, or to the Z-encoding used by the compiler internally. 'FastString's support a memoized conversion to the Z-encoding via zEncodeFS. -} newtype FastString = FastString { -- A pinned ByteArray# fs_bs :: ShortByteString } -- It is sufficient to test pointer equality as we guarantee that -- each string is uniquely allocated. instance Eq FastString where (FastString (SBS ba)) == (FastString (SBS ba')) = case reallyUnsafePtrEquality# (unsafeCoerce# ba) (unsafeCoerce# ba') of 0# -> False 1# -> True _ -> panic "FastString Eq" {-# NOINLINE (==) #-} instance Ord FastString where -- Compares lexicographically, not by unique a <= b = case cmpFS a b of { LT -> True; EQ -> True; GT -> False } a < b = case cmpFS a b of { LT -> True; EQ -> False; GT -> False } a >= b = case cmpFS a b of { LT -> False; EQ -> True; GT -> True } a > b = case cmpFS a b of { LT -> False; EQ -> False; GT -> True } max x y | x >= y = x | otherwise = y min x y | x <= y = x | otherwise = y compare a b = cmpFS a b 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" cmpFS :: FastString -> FastString -> Ordering cmpFS f1@(FastString u1) f2@(FastString u2) = if f1 == f2 then EQ else compare u1 u2 -- ----------------------------------------------------------------------------- -- 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 #-} !(IORef Int) -- the unique ID counter shared with all buckets (Array# (IORef FastStringTableSegment)) -- concurrent segments data FastStringTableSegment = FastStringTableSegment {-# UNPACK #-} !(MVar ()) -- the lock for write in each segment {-# UNPACK #-} !(IORef Int) -- the number of elements (MutableArray# RealWorld [Either FastString (Weak 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 [Either FastString (Weak FastString)] -> Int# -> Int# hashToIndex# buckets# hash# = (hash# `uncheckedIShiftRL#` segmentBits#) `remInt#` size# where !(I# segmentBits#) = segmentBits size# = sizeofMutableArray# buckets# mkWeakFS :: FastString -> IO (Weak FastString) mkWeakFS !fs = IO $ \s -> case mkWeak# fpc fs fin s of (# s1, w #) -> (# s1, Weak w #) where (IO fin) = atomicModifyIORef' fastStringGcCounter (\x -> (x +1, ())) fpc = case fs of (FastString (SBS ba)) -> ba unweakFS :: Weak FastString -> IO (Maybe FastString) unweakFS x = do w <- deRefWeak x case w of Just fs -> return (Just fs) Nothing -> print "GC" >> return Nothing gcTable :: IO () gcTable = do forM_ [0 .. (I# sz) - 1] $ \(I# i#) -> do let (# iref #) = indexArray# segments# i# gcSegment iref performGC forM_ [0 .. (I# sz) - 1] $ \(I# i#) -> do let (# iref #) = indexArray# segments# i# collectSegment iref where !(FastStringTable _uid segments#) = stringTable sz = sizeofArray# segments# gcSegment :: IORef FastStringTableSegment -> IO () gcSegment segmentRef = do (FastStringTableSegment _lock _counter old#) <- readIORef segmentRef let size# = sizeofMutableArray# old# forM_ [0 .. (I# size#) - 1] $ \(I# i#) -> do fsList <- IO $ readArray# old# i# new_list <- mapM (fmap Right . either mkWeakFS return) fsList IO $ \s -> case writeArray# old# i# new_list s of s2# -> (# s2#, () #) collectSegment :: IORef FastStringTableSegment -> IO () collectSegment segmentRef = do (FastStringTableSegment _lock _counter old#) <- readIORef segmentRef let size# = sizeofMutableArray# old# forM_ [0 .. (I# size#) - 1] $ \(I# i#) -> do fsList <- IO $ readArray# old# i# new_fs_list <- map Left <$> mapMaybeM (either (return . Just) unweakFS) fsList IO $ \s -> case writeArray# old# i# new_fs_list s of s3# -> (# s3#, () #) maybeResizeSegment :: IORef FastStringTableSegment -> IO FastStringTableSegment maybeResizeSegment segmentRef = do segment@(FastStringTableSegment lock counter old#) <- readIORef segmentRef let oldSize# = sizeofMutableArray# old# newSize# = oldSize# *# 2# (I# n#) <- readIORef 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 $ \wfs -> do mfs <- either (return . Just) deRefWeak wfs case mfs of Just 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# (wfs: bucket) s2# of s3# -> (# s3#, () #) -- WeakPTRs get GCd on resize Nothing -> return () 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 newIORef 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 <- newIORef 603979776 -- ord '$' * 0x01000000 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 segments# #) -- use the support wired into the RTS to share this CAF among all images of -- libHSghc #if STAGE < 2 return tab #else return tab -- sharedCAF tab getOrSetLibHSghcFastStringTable -- from the RTS; thus we cannot use this mechanism when STAGE<2; the previous -- RTS might not have this symbol foreign import ccall unsafe "getOrSetLibHSghcFastStringTable" getOrSetLibHSghcFastStringTable :: Ptr a -> IO (Ptr a) #endif {- 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_RdrName rdrName $ mg_rdr_env guts `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 mkFastString# a# = mkFastStringBytes ptr (ptrStrLength ptr) where ptr = Ptr a# fastStringGcCounter :: IORef Int fastStringGcCounter = unsafePerformIO $ newIORef 0 {-# NOINLINE fastStringGcCounter #-} {- 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 :: ShortByteString -> IO FastString mkFastStringWith sbs = do FastStringTableSegment lock _ buckets# <- readIORef segmentRef let idx# = hashToIndex# buckets# hash# bucket <- IO $ readArray# buckets# idx# res <- bucket_match bucket len sbs case res 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 withMVar lock $ \_ -> insert (FastString sbs) where len = BSS.length sbs !(FastStringTable _uid segments#) = stringTable !(I# hash#) = hashStr sbs len (# segmentRef #) = indexArray# segments# (hashToSegment# hash#) insert !fs = do FastStringTableSegment _ counter buckets# <- maybeResizeSegment segmentRef let idx# = hashToIndex# buckets# hash# bucket <- IO $ readArray# buckets# idx# res <- bucket_match bucket len sbs case res of -- The FastString was added by another thread after previous read and -- before we acquired the write lock. Just found -> return found Nothing -> do -- print $ "NOT FOUND:" <> (show fs) -- let !(BS.PS (ForeignPtr fptr _) _ _) = fs_bs fs v <- mkWeakFS fs IO $ \s1# -> case writeArray# buckets# idx# (Right v: bucket) s1# of s2# -> (# s2#, () #) modifyIORef' counter succ return fs {- delete_fs :: Int -> IO () delete_fs fs = do FastStringTableSegment _ _ buckets# <- readIORef segmentRef let idx# = hashToIndex# buckets# hash# bucket <- IO $ readArray# buckets# idx# IO $ \s1# -> do case writeArray# buckets# idx# (filter ((/= fs) . uniqueOfFS) bucket) s1# of s2# -> (# s2#, () #) -} bucket_match :: [Either FastString (Weak FastString)] -> Int -> ShortByteString -> IO (Maybe FastString) bucket_match [] _ _ = return Nothing bucket_match (v:ls) len sbs = do mv <- either (return . Just) deRefWeak v case mv of Just fs@(FastString hbs) -> if hbs == sbs then return (Just fs) else bucket_match ls len sbs Nothing -> bucket_match ls len sbs data MBA a = MBA (MutableByteArray# a) newPinnedByteArray :: Int -> ST s (MBA s) newPinnedByteArray (I# len#) = ST $ \s -> case newPinnedByteArray# len# s of (# s, mba# #) -> (# s, MBA mba# #) toShort :: ByteString -> ShortByteString toShort !bs = unsafeDupablePerformIO (toShortIO bs) toShortIO :: ByteString -> IO ShortByteString toShortIO (BS.PS fptr off len) = do m@(MBA mba) <- stToIO (newPinnedByteArray len) let ptr = unsafeForeignPtrToPtr fptr stToIO (copyAddrToByteArray (ptr `plusPtr` off) m 0 len) touchForeignPtr fptr ba <- IO $ \s -> case unsafeFreezeByteArray# mba s of (# s, ba# #) -> (# s, SBS ba# #) return ba copyAddrToByteArray :: Ptr a -> MBA s -> Int -> Int -> ST s () copyAddrToByteArray (Ptr src#) (MBA dst#) (I# dst_off#) (I# len#) = ST $ \s -> case copyAddrToByteArray# src# dst# dst_off# len# s of s -> (# s, () #) createFromPtr :: Ptr a -- ^ source data -> Int -- ^ number of bytes to copy -> IO ShortByteString createFromPtr !ptr len = do stToIO $ do m@(MBA mba) <- newPinnedByteArray len copyAddrToByteArray ptr m 0 len ST $ \s -> case unsafeFreezeByteArray# mba s of (# s, ba# #) -> (# s, SBS ba# #) mkFastStringBytes :: Ptr Word8 -> Int -> FastString mkFastStringBytes !ptr !len = -- NB: Might as well use unsafeDupablePerformIO, since mkFastStringWith is -- idempotent. unsafeDupablePerformIO $ mkFastStringWith =<< createFromPtr ptr len -- | Create a 'FastString' from an existing 'ForeignPtr'; the difference -- between this and 'mkFastStringBytes' is that we don't have to copy -- the bytes if the string is new to the table. mkFastStringByteString :: ByteString -> FastString mkFastStringByteString bs = unsafeDupablePerformIO $ mkFastStringWith (toShort bs) -- Need to convert to a pinned array mkFastStringShortByteString :: ShortByteString -> FastString mkFastStringShortByteString sbs = unsafeDupablePerformIO $ mkFastStringWith (toShort $ BSS.fromShort sbs) -- | Creates a UTF-8 encoded 'FastString' from a 'String' mkFastString :: String -> FastString mkFastString str = unsafeDupablePerformIO $ do let l = utf8EncodedLength str buf <- mallocForeignPtrBytes l withForeignPtr buf $ \ptr -> do utf8EncodeString ptr str return $ mkFastStringBytes ptr l -- | Creates a 'FastString' from a UTF-8 encoded @[Word8]@ mkFastStringByteList :: [Word8] -> FastString mkFastStringByteList str = mkFastStringByteString (BS.pack str) -- | Creates a Z-encoded 'FastString' from a 'String' mkZFastString :: String -> FastZString mkZFastString = mkFastZStringString hashStr :: ShortByteString -> Int -> Int -- use the Addr to produce a hash value between 0 & m (inclusive) hashStr (SBS ba#) (I# len#) = loop 0# 0# where loop h n | isTrue# (n ==# len#) = I# h | otherwise = loop h2 (n +# 1#) where !c = ord# (indexCharArray# ba# n) !h2 = (h *# 16777619#) `xorI#` c -- ----------------------------------------------------------------------------- -- Operations -- | Returns the length of the 'FastString' in characters lengthFS :: FastString -> Int lengthFS (FastString fs) = BSS.length fs -- | Returns @True@ if the 'FastString' is empty nullFS :: FastString -> Bool nullFS f = BSS.null (fs_bs f) -- | Unpacks and decodes the FastString unpackFS :: FastString -> String unpackFS fs = utf8DecodeByteString (bytesFS fs) zEncodeFS :: FastString -> FastZString zEncodeFS fs = mkZFastString (zEncodeString (unpackFS fs)) appendFS :: FastString -> FastString -> FastString appendFS fs1 fs2 = mkFastStringShortByteString $ mappend (fs_bs fs1) (fs_bs fs2) concatFS :: [FastString] -> FastString concatFS = mkFastStringShortByteString . mconcat . map fs_bs headFS :: FastString -> Char headFS fs = head $ unpackFS fs tailFS :: FastString -> FastString tailFS fs = mkFastString (tail $ unpackFS fs) consFS :: Char -> FastString -> FastString consFS c fs = mkFastString (c : unpackFS fs) -- MP: I think this is safe because the bytestring will take up -- the start position + (length * words) space, so adding the offset will -- still be a memory position within the bytestring uniqueOfFS :: FastString -> Int uniqueOfFS (FastString (SBS ba#)) = (I# (addr2Int# (byteArrayContents# ba#))) nilFS :: FastString nilFS = mkFastString "" isUnderscoreFS :: FastString -> Bool isUnderscoreFS fs = fs == fsLit "_" -- ----------------------------------------------------------------------------- -- Stats getFastStringTable :: IO [[[Either FastString (Weak 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 -- ----------------------------------------------------------------------------- -- 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 mkPtrString# a# = PtrString (Ptr a#) (ptrStrLength (Ptr a#)) -- | Encode a 'String' into a newly allocated 'PtrString' using Latin-1 -- encoding. The original string must not contain non-Latin-1 characters -- (above codepoint @0xff@). {-# INLINE mkPtrString #-} mkPtrString :: String -> PtrString mkPtrString s = -- we don't use `unsafeDupablePerformIO` here to avoid potential memory leaks -- and because someone might be using `eqAddr#` to check for string equality. unsafePerformIO (do let len = length s p <- mallocBytes len let loop :: Int -> String -> IO () loop !_ [] = return () loop n (c:cs) = do pokeByteOff p n (fromIntegral (ord c) :: Word8) loop (1+n) cs loop 0 s return (PtrString p len) ) -- | 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# -- | Return the length of a 'PtrString' lengthPS :: PtrString -> Int lengthPS (PtrString _ n) = n -- ----------------------------------------------------------------------------- -- under the carpet foreign import ccall unsafe "strlen" ptrStrLength :: Ptr Word8 -> Int {-# NOINLINE sLit #-} sLit :: String -> PtrString sLit x = mkPtrString x {-# NOINLINE fsLit #-} fsLit :: String -> FastString fsLit x = mkFastString x {-# RULES "slit" forall x . sLit (unpackCString# x) = mkPtrString# x #-} {-# RULES "fslit" forall x . fsLit (unpackCString# x) = mkFastString# x #-}