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