compiler/utils/FastString.lhs

   1 %
   2 % (c) The University of Glasgow, 1997-2006
   3 %
   4 \begin{code}
   5 {-# OPTIONS -fno-warn-unused-imports #-}
   6 -- XXX GHC 6.9 seems to be confused by unpackCString# being used only in
   7 --     a RULE
   8
   9 {-# OPTIONS_GHC -O -funbox-strict-fields #-}
  10 -- We always optimise this, otherwise performance of a non-optimised
  11 -- compiler is severely affected
  12
  13 -- |
  14 -- There are two principal string types used internally by GHC:
  15 --
  16 -- 'FastString':
  17 --               * A compact, hash-consed, representation of character strings.
  18 --               * Comparison is O(1), and you can get a 'Unique.Unique' from them.
  19 --               * Generated by 'fsLit'.
  20 --               * Turn into 'Outputable.SDoc' with 'Outputable.ftext'.
  21 --
  22 -- 'LitString':
  23 --               * Just a wrapper for the @Addr#@ of a C string (@Ptr CChar@).
  24 --               * Practically no operations.
  25 --               * Outputing them is fast.
  26 --               * Generated by 'sLit'.
  27 --               * Turn into 'Outputable.SDoc' with 'Outputable.ptext'
  28 --
  29 -- Use 'LitString' unless you want the facilities of 'FastString'.
  30 module FastString
  31        (
  32         -- * FastStrings
  33         FastString(..),     -- not abstract, for now.
  34
  35         -- ** Construction
  36         fsLit,
  37         mkFastString,
  38         mkFastStringBytes,
  39         mkFastStringByteList,
  40         mkFastStringForeignPtr,
  41 #if defined(__GLASGOW_HASKELL__)
  42         mkFastString#,
  43 #endif
  44         mkZFastString,
  45         mkZFastStringBytes,
  46
  47         -- ** Deconstruction
  48         unpackFS,           -- :: FastString -> String
  49         bytesFS,            -- :: FastString -> [Word8]
  50
  51         -- ** Encoding
  52         isZEncoded,
  53         zEncodeFS,
  54
  55         -- ** Operations
  56         uniqueOfFS,
  57         lengthFS,
  58         nullFS,
  59         appendFS,
  60         headFS,
  61         tailFS,
  62         concatFS,
  63         consFS,
  64         nilFS,
  65
  66         -- ** Outputing
  67         hPutFS,
  68
  69         -- ** Internal
  70         getFastStringTable,
  71         hasZEncoding,
  72
  73         -- * LitStrings
  74         LitString,
  75
  76         -- ** Construction
  77         sLit,
  78 #if defined(__GLASGOW_HASKELL__)
  79         mkLitString#,
  80 #endif
  81         mkLitString,
  82
  83         -- ** Deconstruction
  84         unpackLitString,
  85
  86         -- ** Operations
  87         lengthLS
  88        ) where
  89
  90 #include "HsVersions.h"
  91
  92 import Encoding
  93 import FastTypes
  94 import FastFunctions
  95 import Panic
  96
  97 import Foreign
  98 import Foreign.C
  99 import GHC.Exts
 100 import System.IO
 101 import System.IO.Unsafe ( unsafePerformIO )
 102 import Data.IORef       ( IORef, newIORef, readIORef, writeIORef )
 103 import Data.Maybe       ( isJust )
 104 import Data.Char        ( ord )
 105
 106 #if __GLASGOW_HASKELL__ >= 611
 107 import GHC.IO ( IO(..) )
 108 #else
 109 import GHC.IOBase ( IO(..) )
 110 #endif
 111
 112 import GHC.Ptr          ( Ptr(..) )
 113 #if defined(__GLASGOW_HASKELL__)
 114 import GHC.Base         ( unpackCString# )
 115 #endif
 116
 117 #define hASH_TBL_SIZE          4091
 118 #define hASH_TBL_SIZE_UNBOXED  4091#
 119
 120
 121 {-|
 122 A 'FastString' is an array of bytes, hashed to support fast O(1)
 123 comparison.  It is also associated with a character encoding, so that
 124 we know how to convert a 'FastString' to the local encoding, or to the
 125 Z-encoding used by the compiler internally.
 126
 127 'FastString's support a memoized conversion to the Z-encoding via zEncodeFS.
 128 -}
 129
 130 data FastString = FastString {
 131       uniq    :: {-# UNPACK #-} !Int, -- unique id
 132       n_bytes :: {-# UNPACK #-} !Int, -- number of bytes
 133       n_chars :: {-# UNPACK #-} !Int, -- number of chars
 134       buf     :: {-# UNPACK #-} !(ForeignPtr Word8),
 135       enc     :: FSEncoding
 136   }
 137
 138 data FSEncoding
 139     -- including strings that don't need any encoding
 140   = ZEncoded
 141     -- A UTF-8 string with a memoized Z-encoding
 142   | UTF8Encoded {-# UNPACK #-} !(IORef (Maybe FastString))
 143
 144 instance Eq FastString where
 145   f1 == f2  =  uniq f1 == uniq f2
 146
 147 instance Ord FastString where
 148     -- Compares lexicographically, not by unique
 149     a <= b = case cmpFS a b of { LT -> True;  EQ -> True;  GT -> False }
 150     a <  b = case cmpFS a b of { LT -> True;  EQ -> False; GT -> False }
 151     a >= b = case cmpFS a b of { LT -> False; EQ -> True;  GT -> True  }
 152     a >  b = case cmpFS a b of { LT -> False; EQ -> False; GT -> True  }
 153     max x y | x >= y    =  x
 154             | otherwise =  y
 155     min x y | x <= y    =  x
 156             | otherwise =  y
 157     compare a b = cmpFS a b
 158
 159 instance Show FastString where
 160    show fs = show (unpackFS fs)
 161
 162 cmpFS :: FastString -> FastString -> Ordering
 163 cmpFS (FastString u1 l1 _ buf1 _) (FastString u2 l2 _ buf2 _) =
 164   if u1 == u2 then EQ else
 165   case unsafeMemcmp buf1 buf2 (min l1 l2) `compare` 0 of
 166      LT -> LT
 167      EQ -> compare l1 l2
 168      GT -> GT
 169
 170 unsafeMemcmp :: ForeignPtr a -> ForeignPtr b -> Int -> Int
 171 unsafeMemcmp buf1 buf2 l =
 172       inlinePerformIO $
 173         withForeignPtr buf1 $ \p1 ->
 174         withForeignPtr buf2 $ \p2 ->
 175           memcmp p1 p2 l
 176
 177 #ifndef __HADDOCK__
 178 foreign import ccall unsafe "ghc_memcmp"
 179   memcmp :: Ptr a -> Ptr b -> Int -> IO Int
 180 #endif
 181
 182 -- -----------------------------------------------------------------------------
 183 -- Construction
 184
 185 {-
 186 Internally, the compiler will maintain a fast string symbol
 187 table, providing sharing and fast comparison. Creation of
 188 new @FastString@s then covertly does a lookup, re-using the
 189 @FastString@ if there was a hit.
 190 -}
 191
 192 data FastStringTable =
 193  FastStringTable
 194     {-# UNPACK #-} !Int
 195     (MutableArray# RealWorld [FastString])
 196
 197 {-# NOINLINE string_table #-}
 198 string_table :: IORef FastStringTable
 199 string_table =
 200  unsafePerformIO $ do
 201    tab <- IO $ \s1# -> case newArray# hASH_TBL_SIZE_UNBOXED [] s1# of
 202                            (# s2#, arr# #) ->
 203                                (# s2#, FastStringTable 0 arr# #)
 204    newIORef tab
 205
 206 lookupTbl :: FastStringTable -> Int -> IO [FastString]
 207 lookupTbl (FastStringTable _ arr#) (I# i#) =
 208   IO $ \ s# -> readArray# arr# i# s#
 209
 210 updTbl :: IORef FastStringTable -> FastStringTable -> Int -> [FastString] -> IO ()
 211 updTbl fs_table_var (FastStringTable uid arr#) (I# i#) ls = do
 212   (IO $ \ s# -> case writeArray# arr# i# ls s# of { s2# -> (# s2#, () #) })
 213   writeIORef fs_table_var (FastStringTable (uid+1) arr#)
 214
 215 mkFastString# :: Addr# -> FastString
 216 mkFastString# a# = mkFastStringBytes ptr (ptrStrLength ptr)
 217   where ptr = Ptr a#
 218
 219 mkFastStringBytes :: Ptr Word8 -> Int -> FastString
 220 mkFastStringBytes ptr len = unsafePerformIO $ do
 221   ft@(FastStringTable uid _) <- readIORef string_table
 222   let
 223    h = hashStr ptr len
 224    add_it ls = do
 225         fs <- copyNewFastString uid ptr len
 226         updTbl string_table ft h (fs:ls)
 227         {- _trace ("new: " ++ show f_str)   $ -}
 228         return fs
 229   --
 230   lookup_result <- lookupTbl ft h
 231   case lookup_result of
 232     [] -> add_it []
 233     ls -> do
 234        b <- bucket_match ls len ptr
 235        case b of
 236          Nothing -> add_it ls
 237          Just v  -> {- _trace ("re-use: "++show v) $ -} return v
 238
 239 mkZFastStringBytes :: Ptr Word8 -> Int -> FastString
 240 mkZFastStringBytes ptr len = unsafePerformIO $ do
 241   ft@(FastStringTable uid _) <- readIORef string_table
 242   let
 243    h = hashStr ptr len
 244    add_it ls = do
 245         fs <- copyNewZFastString uid ptr len
 246         updTbl string_table ft h (fs:ls)
 247         {- _trace ("new: " ++ show f_str)   $ -}
 248         return fs
 249   --
 250   lookup_result <- lookupTbl ft h
 251   case lookup_result of
 252     [] -> add_it []
 253     ls -> do
 254        b <- bucket_match ls len ptr
 255        case b of
 256          Nothing -> add_it ls
 257          Just v  -> {- _trace ("re-use: "++show v) $ -} return v
 258
 259 -- | Create a 'FastString' from an existing 'ForeignPtr'; the difference
 260 -- between this and 'mkFastStringBytes' is that we don't have to copy
 261 -- the bytes if the string is new to the table.
 262 mkFastStringForeignPtr :: Ptr Word8 -> ForeignPtr Word8 -> Int -> IO FastString
 263 mkFastStringForeignPtr ptr fp len = do
 264   ft@(FastStringTable uid _) <- readIORef string_table
 265 --  _trace ("hashed: "++show (I# h)) $
 266   let
 267     h = hashStr ptr len
 268     add_it ls = do
 269         fs <- mkNewFastString uid ptr fp len
 270         updTbl string_table ft h (fs:ls)
 271         {- _trace ("new: " ++ show f_str)   $ -}
 272         return fs
 273   --
 274   lookup_result <- lookupTbl ft h
 275   case lookup_result of
 276     [] -> add_it []
 277     ls -> do
 278        b <- bucket_match ls len ptr
 279        case b of
 280          Nothing -> add_it ls
 281          Just v  -> {- _trace ("re-use: "++show v) $ -} return v
 282
 283 mkZFastStringForeignPtr :: Ptr Word8 -> ForeignPtr Word8 -> Int -> IO FastString
 284 mkZFastStringForeignPtr ptr fp len = do
 285   ft@(FastStringTable uid _) <- readIORef string_table
 286 --  _trace ("hashed: "++show (I# h)) $
 287   let
 288     h = hashStr ptr len
 289     add_it ls = do
 290         fs <- mkNewZFastString uid ptr fp len
 291         updTbl string_table ft h (fs:ls)
 292         {- _trace ("new: " ++ show f_str)   $ -}
 293         return fs
 294   --
 295   lookup_result <- lookupTbl ft h
 296   case lookup_result of
 297     [] -> add_it []
 298     ls -> do
 299        b <- bucket_match ls len ptr
 300        case b of
 301          Nothing -> add_it ls
 302          Just v  -> {- _trace ("re-use: "++show v) $ -} return v
 303
 304
 305 -- | Creates a UTF-8 encoded 'FastString' from a 'String'
 306 mkFastString :: String -> FastString
 307 mkFastString str =
 308   inlinePerformIO $ do
 309     let l = utf8EncodedLength str
 310     buf <- mallocForeignPtrBytes l
 311     withForeignPtr buf $ \ptr -> do
 312       utf8EncodeString ptr str
 313       mkFastStringForeignPtr ptr buf l
 314
 315 -- | Creates a 'FastString' from a UTF-8 encoded @[Word8]@
 316 mkFastStringByteList :: [Word8] -> FastString
 317 mkFastStringByteList str =
 318   inlinePerformIO $ do
 319     let l = Prelude.length str
 320     buf <- mallocForeignPtrBytes l
 321     withForeignPtr buf $ \ptr -> do
 322       pokeArray (castPtr ptr) str
 323       mkFastStringForeignPtr ptr buf l
 324
 325 -- | Creates a Z-encoded 'FastString' from a 'String'
 326 mkZFastString :: String -> FastString
 327 mkZFastString str =
 328   inlinePerformIO $ do
 329     let l = Prelude.length str
 330     buf <- mallocForeignPtrBytes l
 331     withForeignPtr buf $ \ptr -> do
 332       pokeCAString (castPtr ptr) str
 333       mkZFastStringForeignPtr ptr buf l
 334
 335 bucket_match :: [FastString] -> Int -> Ptr Word8 -> IO (Maybe FastString)
 336 bucket_match [] _ _ = return Nothing
 337 bucket_match (v@(FastString _ l _ buf _):ls) len ptr
 338       | len == l  =  do
 339          b <- cmpStringPrefix ptr buf len
 340          if b then return (Just v)
 341               else bucket_match ls len ptr
 342       | otherwise =
 343          bucket_match ls len ptr
 344
 345 mkNewFastString :: Int -> Ptr Word8 -> ForeignPtr Word8 -> Int
 346                 -> IO FastString
 347 mkNewFastString uid ptr fp len = do
 348   ref <- newIORef Nothing
 349   n_chars <- countUTF8Chars ptr len
 350   return (FastString uid len n_chars fp (UTF8Encoded ref))
 351
 352 mkNewZFastString :: Int -> Ptr Word8 -> ForeignPtr Word8 -> Int
 353                  -> IO FastString
 354 mkNewZFastString uid _ fp len = do
 355   return (FastString uid len len fp ZEncoded)
 356
 357 copyNewFastString :: Int -> Ptr Word8 -> Int -> IO FastString
 358 copyNewFastString uid ptr len = do
 359   fp <- copyBytesToForeignPtr ptr len
 360   ref <- newIORef Nothing
 361   n_chars <- countUTF8Chars ptr len
 362   return (FastString uid len n_chars fp (UTF8Encoded ref))
 363
 364 copyNewZFastString :: Int -> Ptr Word8 -> Int -> IO FastString
 365 copyNewZFastString uid ptr len = do
 366   fp <- copyBytesToForeignPtr ptr len
 367   return (FastString uid len len fp ZEncoded)
 368
 369 copyBytesToForeignPtr :: Ptr Word8 -> Int -> IO (ForeignPtr Word8)
 370 copyBytesToForeignPtr ptr len = do
 371   fp <- mallocForeignPtrBytes len
 372   withForeignPtr fp $ \ptr' -> copyBytes ptr' ptr len
 373   return fp
 374
 375 cmpStringPrefix :: Ptr Word8 -> ForeignPtr Word8 -> Int -> IO Bool
 376 cmpStringPrefix ptr fp len =
 377   withForeignPtr fp $ \ptr' -> do
 378     r <- memcmp ptr ptr' len
 379     return (r == 0)
 380
 381
 382 hashStr  :: Ptr Word8 -> Int -> Int
 383  -- use the Addr to produce a hash value between 0 & m (inclusive)
 384 hashStr (Ptr a#) (I# len#) = loop 0# 0#
 385    where
 386     loop h n | n GHC.Exts.==# len# = I# h
 387              | otherwise  = loop h2 (n GHC.Exts.+# 1#)
 388           where !c = ord# (indexCharOffAddr# a# n)
 389                 !h2 = (c GHC.Exts.+# (h GHC.Exts.*# 128#)) `remInt#`
 390                       hASH_TBL_SIZE#
 391
 392 -- -----------------------------------------------------------------------------
 393 -- Operations
 394
 395 -- | Returns the length of the 'FastString' in characters
 396 lengthFS :: FastString -> Int
 397 lengthFS f = n_chars f
 398
 399 -- | Returns @True@ if the 'FastString' is Z-encoded
 400 isZEncoded :: FastString -> Bool
 401 isZEncoded fs | ZEncoded <- enc fs = True
 402               | otherwise          = False
 403
 404 -- | Returns @True@ if this 'FastString' is not Z-encoded but already has
 405 -- a Z-encoding cached (used in producing stats).
 406 hasZEncoding :: FastString -> Bool
 407 hasZEncoding (FastString _ _ _ _ enc) =
 408   case enc of
 409     ZEncoded -> False
 410     UTF8Encoded ref ->
 411       inlinePerformIO $ do
 412         m <- readIORef ref
 413         return (isJust m)
 414
 415 -- | Returns @True@ if the 'FastString' is empty
 416 nullFS :: FastString -> Bool
 417 nullFS f  =  n_bytes f == 0
 418
 419 -- | Unpacks and decodes the FastString
 420 unpackFS :: FastString -> String
 421 unpackFS (FastString _ n_bytes _ buf enc) =
 422   inlinePerformIO $ withForeignPtr buf $ \ptr ->
 423     case enc of
 424         ZEncoded      -> peekCAStringLen (castPtr ptr,n_bytes)
 425         UTF8Encoded _ -> utf8DecodeString ptr n_bytes
 426
 427 bytesFS :: FastString -> [Word8]
 428 bytesFS (FastString _ n_bytes _ buf _) =
 429   inlinePerformIO $ withForeignPtr buf $ \ptr ->
 430     peekArray n_bytes ptr
 431
 432 -- | Returns a Z-encoded version of a 'FastString'.  This might be the
 433 -- original, if it was already Z-encoded.  The first time this
 434 -- function is applied to a particular 'FastString', the results are
 435 -- memoized.
 436 --
 437 zEncodeFS :: FastString -> FastString
 438 zEncodeFS fs@(FastString _ _ _ _ enc) =
 439   case enc of
 440     ZEncoded -> fs
 441     UTF8Encoded ref ->
 442       inlinePerformIO $ do
 443         m <- readIORef ref
 444         case m of
 445           Just fs -> return fs
 446           Nothing -> do
 447             let efs = mkZFastString (zEncodeString (unpackFS fs))
 448             writeIORef ref (Just efs)
 449             return efs
 450
 451 appendFS :: FastString -> FastString -> FastString
 452 appendFS fs1 fs2 =
 453   inlinePerformIO $ do
 454     r <- mallocForeignPtrBytes len
 455     withForeignPtr r $ \ r' -> do
 456     withForeignPtr (buf fs1) $ \ fs1Ptr -> do
 457     withForeignPtr (buf fs2) $ \ fs2Ptr -> do
 458         copyBytes r' fs1Ptr len1
 459         copyBytes (advancePtr r' len1) fs2Ptr len2
 460         mkFastStringForeignPtr r' r len
 461   where len  = len1 + len2
 462         len1 = lengthFS fs1
 463         len2 = lengthFS fs2
 464
 465 concatFS :: [FastString] -> FastString
 466 concatFS ls = mkFastString (Prelude.concat (map unpackFS ls)) -- ToDo: do better
 467
 468 headFS :: FastString -> Char
 469 headFS (FastString _ 0 _ _ _) = panic "headFS: Empty FastString"
 470 headFS (FastString _ _ _ buf enc) =
 471   inlinePerformIO $ withForeignPtr buf $ \ptr -> do
 472     case enc of
 473       ZEncoded -> do
 474          w <- peek (castPtr ptr)
 475          return (castCCharToChar w)
 476       UTF8Encoded _ ->
 477          return (fst (utf8DecodeChar ptr))
 478
 479 tailFS :: FastString -> FastString
 480 tailFS (FastString _ 0 _ _ _) = panic "tailFS: Empty FastString"
 481 tailFS (FastString _ n_bytes _ buf enc) =
 482   inlinePerformIO $ withForeignPtr buf $ \ptr -> do
 483     case enc of
 484       ZEncoded -> do
 485         return $! mkZFastStringBytes (ptr `plusPtr` 1) (n_bytes - 1)
 486       UTF8Encoded _ -> do
 487          let (_,ptr') = utf8DecodeChar ptr
 488          let off = ptr' `minusPtr` ptr
 489          return $! mkFastStringBytes (ptr `plusPtr` off) (n_bytes - off)
 490
 491 consFS :: Char -> FastString -> FastString
 492 consFS c fs = mkFastString (c : unpackFS fs)
 493
 494 uniqueOfFS :: FastString -> FastInt
 495 uniqueOfFS (FastString u _ _ _ _) = iUnbox u
 496
 497 nilFS :: FastString
 498 nilFS = mkFastString ""
 499
 500 -- -----------------------------------------------------------------------------
 501 -- Stats
 502
 503 getFastStringTable :: IO [[FastString]]
 504 getFastStringTable = do
 505   tbl <- readIORef string_table
 506   buckets <- mapM (lookupTbl tbl) [0 .. hASH_TBL_SIZE]
 507   return buckets
 508
 509 -- -----------------------------------------------------------------------------
 510 -- Outputting 'FastString's
 511
 512 -- |Outputs a 'FastString' with /no decoding at all/, that is, you
 513 -- get the actual bytes in the 'FastString' written to the 'Handle'.
 514 hPutFS :: Handle -> FastString -> IO ()
 515 hPutFS handle (FastString _ len _ fp _)
 516   | len == 0  = return ()
 517   | otherwise = do withForeignPtr fp $ \ptr -> hPutBuf handle ptr len
 518
 519 -- ToDo: we'll probably want an hPutFSLocal, or something, to output
 520 -- in the current locale's encoding (for error messages and suchlike).
 521
 522 -- -----------------------------------------------------------------------------
 523 -- LitStrings, here for convenience only.
 524
 525 -- hmm, not unboxed (or rather FastPtr), interesting
 526 --a.k.a. Ptr CChar, Ptr Word8, Ptr (), hmph.  We don't
 527 --really care about C types in naming, where we can help it.
 528 type LitString = Ptr Word8
 529 --Why do we recalculate length every time it's requested?
 530 --If it's commonly needed, we should perhaps have
 531 --data LitString = LitString {-#UNPACK#-}!(FastPtr Word8) {-#UNPACK#-}!FastInt
 532
 533 #if defined(__GLASGOW_HASKELL__)
 534 mkLitString# :: Addr# -> LitString
 535 mkLitString# a# = Ptr a#
 536 #endif
 537 --can/should we use FastTypes here?
 538 --Is this likely to be memory-preserving if only used on constant strings?
 539 --should we inline it? If lucky, that would make a CAF that wouldn't
 540 --be computationally repeated... although admittedly we're not
 541 --really intending to use mkLitString when __GLASGOW_HASKELL__...
 542 --(I wonder, is unicode / multi-byte characters allowed in LitStrings
 543 -- at all?)
 544 {-# INLINE mkLitString #-}
 545 mkLitString :: String -> LitString
 546 mkLitString s =
 547  unsafePerformIO (do
 548    p <- mallocBytes (length s + 1)
 549    let
 550      loop :: Int -> String -> IO ()
 551      loop n cs | n `seq` null cs = pokeByteOff p n (0 :: Word8)
 552      loop n (c:cs) = do
 553         pokeByteOff p n (fromIntegral (ord c) :: Word8)
 554         loop (1+n) cs
 555      -- XXX GHC isn't smart enough to know that we have already covered
 556      -- this case.
 557      loop _ [] = panic "mkLitString"
 558    loop 0 s
 559    return p
 560  )
 561
 562 unpackLitString :: LitString -> String
 563 unpackLitString p_ = case pUnbox p_ of
 564  p -> unpack (_ILIT(0))
 565   where
 566     unpack n = case indexWord8OffFastPtrAsFastChar p n of
 567       ch -> if ch `eqFastChar` _CLIT('\0')
 568             then [] else cBox ch : unpack (n +# _ILIT(1))
 569
 570 lengthLS :: LitString -> Int
 571 lengthLS = ptrStrLength
 572
 573 -- for now, use a simple String representation
 574 --no, let's not do that right now - it's work in other places
 575 #if 0
 576 type LitString = String
 577
 578 mkLitString :: String -> LitString
 579 mkLitString = id
 580
 581 unpackLitString :: LitString -> String
 582 unpackLitString = id
 583
 584 lengthLS :: LitString -> Int
 585 lengthLS = length
 586
 587 #endif
 588
 589 -- -----------------------------------------------------------------------------
 590 -- under the carpet
 591
 592 foreign import ccall unsafe "ghc_strlen"
 593   ptrStrLength :: Ptr Word8 -> Int
 594
 595 -- NB. does *not* add a '\0'-terminator.
 596 -- We only use CChar here to be parallel to the imported
 597 -- peekC(A)StringLen.
 598 pokeCAString :: Ptr CChar -> String -> IO ()
 599 pokeCAString ptr str =
 600   let
 601         go [] _     = return ()
 602         go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
 603   in
 604   go str 0
 605
 606 {-# NOINLINE sLit #-}
 607 sLit :: String -> LitString
 608 sLit x  = mkLitString x
 609
 610 {-# NOINLINE fsLit #-}
 611 fsLit :: String -> FastString
 612 fsLit x = mkFastString x
 613
 614 {-# RULES "slit"
 615     forall x . sLit  (unpackCString# x) = mkLitString#  x #-}
 616 {-# RULES "fslit"
 617     forall x . fsLit (unpackCString# x) = mkFastString# x #-}
 618 \end{code}