compiler/utils/FastString.lhs

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