FastString.lhs 18.5 KB
Newer Older
1
%
2
% (c) The University of Glasgow, 1997-2006
3
%
4
\begin{code}
5
{-# LANGUAGE BangPatterns #-}
6 7 8 9
{-# OPTIONS_GHC -O -funbox-strict-fields #-}
-- We always optimise this, otherwise performance of a non-optimised
-- compiler is severely affected

10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
-- |
-- There are two principal string types used internally by GHC:
--
-- 'FastString':
--               * A compact, hash-consed, representation of character strings.
--               * Comparison is O(1), and you can get a 'Unique.Unique' from them.
--               * Generated by 'fsLit'.
--               * Turn into 'Outputable.SDoc' with 'Outputable.ftext'.
--
-- 'LitString':
--               * Just a wrapper for the @Addr#@ of a C string (@Ptr CChar@).
--               * Practically no operations.
--               * Outputing them is fast.
--               * Generated by 'sLit'.
--               * Turn into 'Outputable.SDoc' with 'Outputable.ptext'
--
-- Use 'LitString' unless you want the facilities of 'FastString'.
27 28
module FastString
       (
29
        -- * FastBytes
30
        FastBytes,
31 32 33
        mkFastStringFastBytes,
        foreignPtrToFastBytes,
        fastStringToFastBytes,
34
        fastZStringToByteString,
35
        unsafeMkFastBytesString,
36
        hashByteString,
37

Ian Lynagh's avatar
Ian Lynagh committed
38 39 40 41 42 43
        -- * FastZString
        FastZString,
        hPutFZS,
        zString,
        lengthFZS,

Ian Lynagh's avatar
Ian Lynagh committed
44 45
        -- * FastStrings
        FastString(..),     -- not abstract, for now.
46

Ian Lynagh's avatar
Ian Lynagh committed
47
        -- ** Construction
48
        fsLit,
49
        mkFastString,
Ian Lynagh's avatar
Ian Lynagh committed
50
        mkFastStringBytes,
51
        mkFastStringByteList,
Ian Lynagh's avatar
Ian Lynagh committed
52
        mkFastStringForeignPtr,
53
#if defined(__GLASGOW_HASKELL__)
Ian Lynagh's avatar
Ian Lynagh committed
54
        mkFastString#,
55
#endif
56

Ian Lynagh's avatar
Ian Lynagh committed
57 58 59
        -- ** Deconstruction
        unpackFS,           -- :: FastString -> String
        bytesFS,            -- :: FastString -> [Word8]
60

Ian Lynagh's avatar
Ian Lynagh committed
61 62
        -- ** Encoding
        zEncodeFS,
63

Ian Lynagh's avatar
Ian Lynagh committed
64
        -- ** Operations
65
        uniqueOfFS,
Ian Lynagh's avatar
Ian Lynagh committed
66 67 68
        lengthFS,
        nullFS,
        appendFS,
69 70
        headFS,
        tailFS,
Ian Lynagh's avatar
Ian Lynagh committed
71
        concatFS,
72
        consFS,
Ian Lynagh's avatar
Ian Lynagh committed
73
        nilFS,
74

Ian Lynagh's avatar
Ian Lynagh committed
75
        -- ** Outputing
76 77
        hPutFS,

Ian Lynagh's avatar
Ian Lynagh committed
78 79 80
        -- ** Internal
        getFastStringTable,
        hasZEncoding,
81

Ian Lynagh's avatar
Ian Lynagh committed
82 83
        -- * LitStrings
        LitString,
84 85 86
        
        -- ** Construction
        sLit,
87
#if defined(__GLASGOW_HASKELL__)
Ian Lynagh's avatar
Ian Lynagh committed
88
        mkLitString#,
89
#endif
Ian Lynagh's avatar
Ian Lynagh committed
90
        mkLitString,
91 92
        
        -- ** Deconstruction
Ian Lynagh's avatar
Ian Lynagh committed
93
        unpackLitString,
94 95 96
        
        -- ** Operations
        lengthLS
97 98
       ) where

99
#include "HsVersions.h"
100

101
import Encoding
102 103
import FastTypes
import FastFunctions
104
import Panic
105
import Util
106

107
import Data.ByteString (ByteString)
108 109 110 111
import qualified Data.ByteString          as BS
import qualified Data.ByteString.Char8    as BSC
import qualified Data.ByteString.Internal as BS
import qualified Data.ByteString.Unsafe   as BS
112
import Foreign.C
113
import GHC.Exts
114
import System.IO
115
import System.IO.Unsafe ( unsafePerformIO )
116
import Data.Data
117
import Data.IORef       ( IORef, newIORef, readIORef, writeIORef )
Ian Lynagh's avatar
Ian Lynagh committed
118
import Data.Maybe       ( isJust )
119
import Data.Char
120

121
import GHC.IO           ( IO(..) )
122

123
import Foreign.Safe
124

Ian Lynagh's avatar
Ian Lynagh committed
125 126 127
#if defined(__GLASGOW_HASKELL__)
import GHC.Base         ( unpackCString# )
#endif
128

129 130
#define hASH_TBL_SIZE          4091
#define hASH_TBL_SIZE_UNBOXED  4091#
131 132


133
type FastBytes = ByteString
134

135
foreignPtrToFastBytes :: ForeignPtr Word8 -> Int -> FastBytes
136
foreignPtrToFastBytes fp len = BS.fromForeignPtr fp 0 len
137 138

mkFastStringFastBytes :: FastBytes -> IO FastString
139
mkFastStringFastBytes bs = mkFastStringByteString bs
140 141

fastStringToFastBytes :: FastString -> FastBytes
142
fastStringToFastBytes f = fs_fb f
143

144 145
fastZStringToByteString :: FastZString -> ByteString
fastZStringToByteString (FastZString bs) = bs
Ian Lynagh's avatar
Ian Lynagh committed
146

147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164
-- This will drop information if any character > '\xFF'
unsafeMkFastBytesString :: String -> FastBytes
unsafeMkFastBytesString str =
  inlinePerformIO $ do
    let l = Prelude.length str
    buf <- mallocForeignPtrBytes l
    withForeignPtr buf $ \ptr -> do
      pokeCAString (castPtr ptr) str
      return $ foreignPtrToFastBytes buf l

pokeCAString :: Ptr CChar -> String -> IO ()
pokeCAString ptr str =
  let
        go []     !_ = return ()
        go (c:cs) n  = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
  in
  go str 0

165 166
hashByteString :: ByteString -> Int
hashByteString bs
167 168
    = inlinePerformIO $ BS.unsafeUseAsCStringLen bs $ \(ptr, len) ->
      return $ hashStr (castPtr ptr) len
169

Ian Lynagh's avatar
Ian Lynagh committed
170 171
-- -----------------------------------------------------------------------------

172
newtype FastZString = FastZString ByteString
Ian Lynagh's avatar
Ian Lynagh committed
173 174

hPutFZS :: Handle -> FastZString -> IO ()
175
hPutFZS handle (FastZString bs) = BS.hPut handle bs
Ian Lynagh's avatar
Ian Lynagh committed
176 177

zString :: FastZString -> String
178 179
zString (FastZString bs) =
    inlinePerformIO $ BS.unsafeUseAsCStringLen bs peekCAStringLen
Ian Lynagh's avatar
Ian Lynagh committed
180 181

lengthFZS :: FastZString -> Int
182
lengthFZS (FastZString bs) = BS.length bs
Ian Lynagh's avatar
Ian Lynagh committed
183

184
mkFastZStringString :: String -> FastZString
185
mkFastZStringString str = FastZString (BSC.pack str)
186

Ian Lynagh's avatar
Ian Lynagh committed
187
-- -----------------------------------------------------------------------------
188

189 190 191 192 193
{-|
A 'FastString' is an array of bytes, hashed to support fast O(1)
comparison.  It is also associated with a character encoding, so that
we know how to convert a 'FastString' to the local encoding, or to the
Z-encoding used by the compiler internally.
194

195 196 197 198
'FastString's support a memoized conversion to the Z-encoding via zEncodeFS.
-}

data FastString = FastString {
Ian Lynagh's avatar
Ian Lynagh committed
199 200
      uniq    :: {-# UNPACK #-} !Int, -- unique id
      n_chars :: {-# UNPACK #-} !Int, -- number of chars
201
      fs_fb   :: {-# UNPACK #-} !FastBytes,
202
      fs_ref  :: {-# UNPACK #-} !(IORef (Maybe FastZString))
203
  } deriving Typeable
204 205 206

instance Eq FastString where
  f1 == f2  =  uniq f1 == uniq f2
207

208
instance Ord FastString where
Ian Lynagh's avatar
Ian Lynagh committed
209
    -- Compares lexicographically, not by unique
210
    a <= b = case cmpFS a b of { LT -> True;  EQ -> True;  GT -> False }
Ian Lynagh's avatar
Ian Lynagh committed
211
    a <  b = case cmpFS a b of { LT -> True;  EQ -> False; GT -> False }
212
    a >= b = case cmpFS a b of { LT -> False; EQ -> True;  GT -> True  }
Ian Lynagh's avatar
Ian Lynagh committed
213 214 215 216 217
    a >  b = case cmpFS a b of { LT -> False; EQ -> False; GT -> True  }
    max x y | x >= y    =  x
            | otherwise =  y
    min x y | x <= y    =  x
            | otherwise =  y
218
    compare a b = cmpFS a b
219

220 221 222
instance Show FastString where
   show fs = show (unpackFS fs)

223 224 225 226 227 228
instance Data FastString where
  -- don't traverse?
  toConstr _   = abstractConstr "FastString"
  gunfold _ _  = error "gunfold"
  dataTypeOf _ = mkNoRepType "FastString"

229
cmpFS :: FastString -> FastString -> Ordering
230
cmpFS f1@(FastString u1 _ _ _) f2@(FastString u2 _ _ _) =
231
  if u1 == u2 then EQ else
232
  compare (fastStringToFastBytes f1) (fastStringToFastBytes f2)
233

234
#ifndef __HADDOCK__
Ian Lynagh's avatar
Ian Lynagh committed
235
foreign import ccall unsafe "ghc_memcmp"
236 237
  memcmp :: Ptr a -> Ptr b -> Int -> IO Int
#endif
238

239 240
-- -----------------------------------------------------------------------------
-- Construction
241

242
{-
243 244 245 246
Internally, the compiler will maintain a fast string symbol
table, providing sharing and fast comparison. Creation of
new @FastString@s then covertly does a lookup, re-using the
@FastString@ if there was a hit.
247
-}
248

Ian Lynagh's avatar
Ian Lynagh committed
249
data FastStringTable =
250
 FastStringTable
251
    {-# UNPACK #-} !Int
252
    (MutableArray# RealWorld [FastString])
253

254
{-# NOINLINE string_table #-}
255
string_table :: IORef FastStringTable
Ian Lynagh's avatar
Ian Lynagh committed
256
string_table =
257
 unsafePerformIO $ do
258 259 260 261
   tab <- IO $ \s1# -> case newArray# hASH_TBL_SIZE_UNBOXED [] s1# of
                           (# s2#, arr# #) ->
                               (# s2#, FastStringTable 0 arr# #)
   newIORef tab
262 263 264 265 266

lookupTbl :: FastStringTable -> Int -> IO [FastString]
lookupTbl (FastStringTable _ arr#) (I# i#) =
  IO $ \ s# -> readArray# arr# i# s#

267 268
updTbl :: IORef FastStringTable -> FastStringTable -> Int -> [FastString] -> IO ()
updTbl fs_table_var (FastStringTable uid arr#) (I# i#) ls = do
269
  (IO $ \ s# -> case writeArray# arr# i# ls s# of { s2# -> (# s2#, () #) })
270
  writeIORef fs_table_var (FastStringTable (uid+1) arr#)
271

272
mkFastString# :: Addr# -> FastString
273
mkFastString# a# = mkFastStringBytes ptr (ptrStrLength ptr)
274
  where ptr = Ptr a#
275

276
mkFastStringBytes :: Ptr Word8 -> Int -> FastString
277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294
mkFastStringBytes ptr len = unsafePerformIO $ do
  ft@(FastStringTable uid _) <- readIORef string_table
  let
   h = hashStr ptr len
   add_it ls = do
        fs <- copyNewFastString uid ptr len
        updTbl string_table ft h (fs:ls)
        {- _trace ("new: " ++ show f_str)   $ -}
        return fs
  --
  lookup_result <- lookupTbl ft h
  case lookup_result of
    [] -> add_it []
    ls -> do
       b <- bucket_match ls len ptr
       case b of
         Nothing -> add_it ls
         Just v  -> {- _trace ("re-use: "++show v) $ -} return v
295 296 297 298 299 300

-- | Create a 'FastString' from an existing 'ForeignPtr'; the difference
-- between this and 'mkFastStringBytes' is that we don't have to copy
-- the bytes if the string is new to the table.
mkFastStringForeignPtr :: Ptr Word8 -> ForeignPtr Word8 -> Int -> IO FastString
mkFastStringForeignPtr ptr fp len = do
301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318
  ft@(FastStringTable uid _) <- readIORef string_table
--  _trace ("hashed: "++show (I# h)) $
  let
    h = hashStr ptr len
    add_it ls = do
        fs <- mkNewFastString uid ptr fp len
        updTbl string_table ft h (fs:ls)
        {- _trace ("new: " ++ show f_str)   $ -}
        return fs
  --
  lookup_result <- lookupTbl ft h
  case lookup_result of
    [] -> add_it []
    ls -> do
       b <- bucket_match ls len ptr
       case b of
         Nothing -> add_it ls
         Just v  -> {- _trace ("re-use: "++show v) $ -} return v
319

320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344
-- | Create a 'FastString' from an existing 'ForeignPtr'; the difference
-- between this and 'mkFastStringBytes' is that we don't have to copy
-- the bytes if the string is new to the table.
mkFastStringByteString :: ByteString -> IO FastString
mkFastStringByteString bs = BS.unsafeUseAsCStringLen bs $ \(ptr, len) -> do
  ft@(FastStringTable uid _) <- readIORef string_table
--  _trace ("hashed: "++show (I# h)) $
  let
    ptr' = castPtr ptr
    h = hashStr ptr' len
    add_it ls = do
        fs <- mkNewFastStringByteString uid ptr' len bs
        updTbl string_table ft h (fs:ls)
        {- _trace ("new: " ++ show f_str)   $ -}
        return fs
  --
  lookup_result <- lookupTbl ft h
  case lookup_result of
    [] -> add_it []
    ls -> do
       b <- bucket_match ls len ptr'
       case b of
         Nothing -> add_it ls
         Just v  -> {- _trace ("re-use: "++show v) $ -} return v

345 346
-- | Creates a UTF-8 encoded 'FastString' from a 'String'
mkFastString :: String -> FastString
Ian Lynagh's avatar
Ian Lynagh committed
347
mkFastString str =
348 349 350 351 352
  inlinePerformIO $ do
    let l = utf8EncodedLength str
    buf <- mallocForeignPtrBytes l
    withForeignPtr buf $ \ptr -> do
      utf8EncodeString ptr str
Ian Lynagh's avatar
Ian Lynagh committed
353
      mkFastStringForeignPtr ptr buf l
354

355 356
-- | Creates a 'FastString' from a UTF-8 encoded @[Word8]@
mkFastStringByteList :: [Word8] -> FastString
Ian Lynagh's avatar
Ian Lynagh committed
357
mkFastStringByteList str =
358 359 360 361 362
  inlinePerformIO $ do
    let l = Prelude.length str
    buf <- mallocForeignPtrBytes l
    withForeignPtr buf $ \ptr -> do
      pokeArray (castPtr ptr) str
Ian Lynagh's avatar
Ian Lynagh committed
363
      mkFastStringForeignPtr ptr buf l
364 365

-- | Creates a Z-encoded 'FastString' from a 'String'
Ian Lynagh's avatar
Ian Lynagh committed
366
mkZFastString :: String -> FastZString
367
mkZFastString = mkFastZStringString
368

369
bucket_match :: [FastString] -> Int -> Ptr Word8 -> IO (Maybe FastString)
370
bucket_match [] _ _ = return Nothing
371 372 373 374
bucket_match (v@(FastString _ _ bs _):ls) len ptr
      | len == BS.length bs = do
         b <- BS.unsafeUseAsCString bs $ \buf ->
             cmpStringPrefix ptr (castPtr buf) len
Ian Lynagh's avatar
Ian Lynagh committed
375 376 377 378
         if b then return (Just v)
              else bucket_match ls len ptr
      | otherwise =
         bucket_match ls len ptr
379

380 381
mkNewFastString :: Int -> Ptr Word8 -> ForeignPtr Word8 -> Int
                -> IO FastString
382 383 384
mkNewFastString uid ptr fp len = do
  ref <- newIORef Nothing
  n_chars <- countUTF8Chars ptr len
385 386 387 388 389 390 391 392
  return (FastString uid n_chars (BS.fromForeignPtr fp 0 len) ref)

mkNewFastStringByteString :: Int -> Ptr Word8 -> Int -> ByteString
                          -> IO FastString
mkNewFastStringByteString uid ptr len bs = do
  ref <- newIORef Nothing
  n_chars <- countUTF8Chars ptr len
  return (FastString uid n_chars bs ref)
393

394
copyNewFastString :: Int -> Ptr Word8 -> Int -> IO FastString
395 396 397 398
copyNewFastString uid ptr len = do
  fp <- copyBytesToForeignPtr ptr len
  ref <- newIORef Nothing
  n_chars <- countUTF8Chars ptr len
399
  return (FastString uid n_chars (BS.fromForeignPtr fp 0 len) ref)
400

401
copyBytesToForeignPtr :: Ptr Word8 -> Int -> IO (ForeignPtr Word8)
402 403 404 405 406
copyBytesToForeignPtr ptr len = do
  fp <- mallocForeignPtrBytes len
  withForeignPtr fp $ \ptr' -> copyBytes ptr' ptr len
  return fp

407 408 409
cmpStringPrefix :: Ptr Word8 -> Ptr Word8 -> Int -> IO Bool
cmpStringPrefix ptr1 ptr2 len =
 do r <- memcmp ptr1 ptr2 len
410 411 412 413
    return (r == 0)


hashStr  :: Ptr Word8 -> Int -> Int
414
 -- use the Addr to produce a hash value between 0 & m (inclusive)
415
hashStr (Ptr a#) (I# len#) = loop 0# 0#
Ian Lynagh's avatar
Ian Lynagh committed
416
   where
417
    loop h n | n GHC.Exts.==# len# = I# h
Ian Lynagh's avatar
Ian Lynagh committed
418
             | otherwise  = loop h2 (n GHC.Exts.+# 1#)
419 420 421
          where !c = ord# (indexCharOffAddr# a# n)
                !h2 = (c GHC.Exts.+# (h GHC.Exts.*# 128#)) `remInt#`
                      hASH_TBL_SIZE#
422

423 424
-- -----------------------------------------------------------------------------
-- Operations
425

426 427 428
-- | Returns the length of the 'FastString' in characters
lengthFS :: FastString -> Int
lengthFS f = n_chars f
429

430
-- | Returns @True@ if this 'FastString' is not Z-encoded but already has
431 432
-- a Z-encoding cached (used in producing stats).
hasZEncoding :: FastString -> Bool
433
hasZEncoding (FastString _ _ _ ref) =
434 435
      inlinePerformIO $ do
        m <- readIORef ref
Ian Lynagh's avatar
Ian Lynagh committed
436
        return (isJust m)
437

438
-- | Returns @True@ if the 'FastString' is empty
439
nullFS :: FastString -> Bool
440
nullFS f = BS.null (fs_fb f)
441

442
-- | Unpacks and decodes the FastString
443
unpackFS :: FastString -> String
444 445 446
unpackFS (FastString _ _ bs _) =
  inlinePerformIO $ BS.unsafeUseAsCStringLen bs $ \(ptr, len) ->
        utf8DecodeString (castPtr ptr) len
447

448
-- | Gives the UTF-8 encoded bytes corresponding to a 'FastString'
449
bytesFS :: FastString -> [Word8]
450
bytesFS fs = BS.unpack $ fastStringToFastBytes fs
451

452
-- | Returns a Z-encoded version of a 'FastString'.  This might be the
453 454 455 456
-- original, if it was already Z-encoded.  The first time this
-- function is applied to a particular 'FastString', the results are
-- memoized.
--
Ian Lynagh's avatar
Ian Lynagh committed
457
zEncodeFS :: FastString -> FastZString
458
zEncodeFS fs@(FastString _ _ _ ref) =
459
      inlinePerformIO $ do
460 461
        m <- readIORef ref
        case m of
Ian Lynagh's avatar
Ian Lynagh committed
462
          Just zfs -> return zfs
463
          Nothing -> do
Ian Lynagh's avatar
Ian Lynagh committed
464 465 466
            let zfs = mkZFastString (zEncodeString (unpackFS fs))
            writeIORef ref (Just zfs)
            return zfs
467 468

appendFS :: FastString -> FastString -> FastString
469 470
appendFS fs1 fs2 = inlinePerformIO
                 $ mkFastStringFastBytes
471 472
                 $ BS.append (fastStringToFastBytes fs1)
                             (fastStringToFastBytes fs2)
473 474 475 476 477

concatFS :: [FastString] -> FastString
concatFS ls = mkFastString (Prelude.concat (map unpackFS ls)) -- ToDo: do better

headFS :: FastString -> Char
478
headFS (FastString _ 0 _ _) = panic "headFS: Empty FastString"
479 480 481
headFS (FastString _ _ bs _) =
  inlinePerformIO $ BS.unsafeUseAsCString bs $ \ptr ->
         return (fst (utf8DecodeChar (castPtr ptr)))
482 483

tailFS :: FastString -> FastString
484
tailFS (FastString _ 0 _ _) = panic "tailFS: Empty FastString"
485 486 487 488 489
tailFS (FastString _ _ bs _) =
    inlinePerformIO $ BS.unsafeUseAsCString bs $ \ptr ->
    do let (_, ptr') = utf8DecodeChar (castPtr ptr)
           n = ptr' `minusPtr` ptr
       mkFastStringByteString $ BS.drop n bs
490 491 492 493

consFS :: Char -> FastString -> FastString
consFS c fs = mkFastString (c : unpackFS fs)

494
uniqueOfFS :: FastString -> FastInt
495
uniqueOfFS (FastString u _ _ _) = iUnbox u
496

497
nilFS :: FastString
498
nilFS = mkFastString ""
499

500 501 502 503 504 505
-- -----------------------------------------------------------------------------
-- Stats

getFastStringTable :: IO [[FastString]]
getFastStringTable = do
  tbl <- readIORef string_table
506
  buckets <- mapM (lookupTbl tbl) [0 .. hASH_TBL_SIZE]
507 508
  return buckets

509 510 511
-- -----------------------------------------------------------------------------
-- Outputting 'FastString's

512 513
-- |Outputs a 'FastString' with /no decoding at all/, that is, you
-- get the actual bytes in the 'FastString' written to the 'Handle'.
514
hPutFS :: Handle -> FastString -> IO ()
515
hPutFS handle fs = BS.hPut handle $ fastStringToFastBytes fs
516

517 518
-- ToDo: we'll probably want an hPutFSLocal, or something, to output
-- in the current locale's encoding (for error messages and suchlike).
519

520 521
-- -----------------------------------------------------------------------------
-- LitStrings, here for convenience only.
522

523 524 525 526 527 528 529
-- hmm, not unboxed (or rather FastPtr), interesting
--a.k.a. Ptr CChar, Ptr Word8, Ptr (), hmph.  We don't
--really care about C types in naming, where we can help it.
type LitString = Ptr Word8
--Why do we recalculate length every time it's requested?
--If it's commonly needed, we should perhaps have
--data LitString = LitString {-#UNPACK#-}!(FastPtr Word8) {-#UNPACK#-}!FastInt
530

531
#if defined(__GLASGOW_HASKELL__)
532
mkLitString# :: Addr# -> LitString
533
mkLitString# a# = Ptr a#
Ian Lynagh's avatar
Ian Lynagh committed
534
#endif
535 536 537 538 539 540 541 542 543 544 545 546 547 548
--can/should we use FastTypes here?
--Is this likely to be memory-preserving if only used on constant strings?
--should we inline it? If lucky, that would make a CAF that wouldn't
--be computationally repeated... although admittedly we're not
--really intending to use mkLitString when __GLASGOW_HASKELL__...
--(I wonder, is unicode / multi-byte characters allowed in LitStrings
-- at all?)
{-# INLINE mkLitString #-}
mkLitString :: String -> LitString
mkLitString s =
 unsafePerformIO (do
   p <- mallocBytes (length s + 1)
   let
     loop :: Int -> String -> IO ()
Ian Lynagh's avatar
Ian Lynagh committed
549
     loop !n [] = pokeByteOff p n (0 :: Word8)
550 551 552 553 554 555 556 557 558 559 560 561 562 563 564
     loop n (c:cs) = do
        pokeByteOff p n (fromIntegral (ord c) :: Word8)
        loop (1+n) cs
   loop 0 s
   return p
 )

unpackLitString :: LitString -> String
unpackLitString p_ = case pUnbox p_ of
 p -> unpack (_ILIT(0))
  where
    unpack n = case indexWord8OffFastPtrAsFastChar p n of
      ch -> if ch `eqFastChar` _CLIT('\0')
            then [] else cBox ch : unpack (n +# _ILIT(1))

565 566
lengthLS :: LitString -> Int
lengthLS = ptrStrLength
567 568 569 570 571 572 573 574 575 576 577 578

-- for now, use a simple String representation
--no, let's not do that right now - it's work in other places
#if 0
type LitString = String

mkLitString :: String -> LitString
mkLitString = id

unpackLitString :: LitString -> String
unpackLitString = id

579 580
lengthLS :: LitString -> Int
lengthLS = length
581 582

#endif
583 584 585 586

-- -----------------------------------------------------------------------------
-- under the carpet

Ian Lynagh's avatar
Ian Lynagh committed
587
foreign import ccall unsafe "ghc_strlen"
588
  ptrStrLength :: Ptr Word8 -> Int
589

Ian Lynagh's avatar
Ian Lynagh committed
590 591 592 593 594 595 596 597 598 599 600 601
{-# NOINLINE sLit #-}
sLit :: String -> LitString
sLit x  = mkLitString x

{-# NOINLINE fsLit #-}
fsLit :: String -> FastString
fsLit x = mkFastString x

{-# RULES "slit"
    forall x . sLit  (unpackCString# x) = mkLitString#  x #-}
{-# RULES "fslit"
    forall x . fsLit (unpackCString# x) = mkFastString# x #-}
602
\end{code}