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