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 hiding   ( unsafePerformIO )
  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}