91236cce1135bd5894ba0d2cf9cc9044bb8f55f4
[ghc.git] / compiler / utils / FastString.lhs
1 %
2 % (c) The University of Glasgow, 1997-2006
3 %
4 \begin{code}
5 {-# LANGUAGE BangPatterns, CPP, DeriveDataTypeable, MagicHash, UnboxedTuples #-}
6 {-# OPTIONS_GHC -O -funbox-strict-fields #-}
7 -- We always optimise this, otherwise performance of a non-optimised
8 -- compiler is severely affected
9
10 -- |
11 -- There are two principal string types used internally by GHC:
12 --
13 -- ['FastString']
14 --
15 --   * A compact, hash-consed, representation of character strings.
16 --   * Comparison is O(1), and you can get a 'Unique.Unique' from them.
17 --   * Generated by 'fsLit'.
18 --   * Turn into 'Outputable.SDoc' with 'Outputable.ftext'.
19 --
20 -- ['LitString']
21 --
22 --   * Just a wrapper for the @Addr#@ of a C string (@Ptr CChar@).
23 --   * Practically no operations.
24 --   * Outputing them is fast.
25 --   * Generated by 'sLit'.
26 --   * Turn into 'Outputable.SDoc' with 'Outputable.ptext'
27 --
28 -- Use 'LitString' unless you want the facilities of 'FastString'.
29 module FastString
30        (
31         -- * ByteString
32         fastStringToByteString,
33         mkFastStringByteString,
34         fastZStringToByteString,
35         unsafeMkByteString,
36         hashByteString,
37
38         -- * FastZString
39         FastZString,
40         hPutFZS,
41         zString,
42         lengthFZS,
43
44         -- * FastStrings
45         FastString(..),     -- not abstract, for now.
46
47         -- ** Construction
48         fsLit,
49         mkFastString,
50         mkFastStringBytes,
51         mkFastStringByteList,
52         mkFastStringForeignPtr,
53 #if defined(__GLASGOW_HASKELL__)
54         mkFastString#,
55 #endif
56
57         -- ** Deconstruction
58         unpackFS,           -- :: FastString -> String
59         bytesFS,            -- :: FastString -> [Word8]
60
61         -- ** Encoding
62         zEncodeFS,
63
64         -- ** Operations
65         uniqueOfFS,
66         lengthFS,
67         nullFS,
68         appendFS,
69         headFS,
70         tailFS,
71         concatFS,
72         consFS,
73         nilFS,
74
75         -- ** Outputing
76         hPutFS,
77
78         -- ** Internal
79         getFastStringTable,
80         hasZEncoding,
81
82         -- * LitStrings
83         LitString,
84
85         -- ** Construction
86         sLit,
87 #if defined(__GLASGOW_HASKELL__)
88         mkLitString#,
89 #endif
90         mkLitString,
91
92         -- ** Deconstruction
93         unpackLitString,
94
95         -- ** Operations
96         lengthLS
97        ) where
98
99 #include "HsVersions.h"
100
101 import Encoding
102 import FastTypes
103 import FastFunctions
104 import Panic
105 import Util
106
107 import Control.Monad
108 import Data.ByteString (ByteString)
109 import qualified Data.ByteString          as BS
110 import qualified Data.ByteString.Char8    as BSC
111 import qualified Data.ByteString.Internal as BS
112 import qualified Data.ByteString.Unsafe   as BS
113 import Foreign.C
114 import ExtsCompat46
115 import System.IO
116 import System.IO.Unsafe ( unsafePerformIO )
117 import Data.Data
118 import Data.IORef       ( IORef, newIORef, readIORef, atomicModifyIORef )
119 import Data.Maybe       ( isJust )
120 import Data.Char
121 import Data.List        ( elemIndex )
122
123 import GHC.IO           ( IO(..), unsafeDupablePerformIO )
124
125 import Foreign.Safe
126
127 #if STAGE >= 2
128 import GHC.Conc.Sync    (sharedCAF)
129 #endif
130
131 #if defined(__GLASGOW_HASKELL__)
132 import GHC.Base         ( unpackCString# )
133 #endif
134
135 #define hASH_TBL_SIZE          4091
136 #define hASH_TBL_SIZE_UNBOXED  4091#
137
138
139 fastStringToByteString :: FastString -> ByteString
140 fastStringToByteString f = fs_bs f
141
142 fastZStringToByteString :: FastZString -> ByteString
143 fastZStringToByteString (FastZString bs) = bs
144
145 -- This will drop information if any character > '\xFF'
146 unsafeMkByteString :: String -> ByteString
147 unsafeMkByteString = BSC.pack
148
149 hashByteString :: ByteString -> Int
150 hashByteString bs
151     = inlinePerformIO $ BS.unsafeUseAsCStringLen bs $ \(ptr, len) ->
152       return $ hashStr (castPtr ptr) len
153
154 -- -----------------------------------------------------------------------------
155
156 newtype FastZString = FastZString ByteString
157
158 hPutFZS :: Handle -> FastZString -> IO ()
159 hPutFZS handle (FastZString bs) = BS.hPut handle bs
160
161 zString :: FastZString -> String
162 zString (FastZString bs) =
163     inlinePerformIO $ BS.unsafeUseAsCStringLen bs peekCAStringLen
164
165 lengthFZS :: FastZString -> Int
166 lengthFZS (FastZString bs) = BS.length bs
167
168 mkFastZStringString :: String -> FastZString
169 mkFastZStringString str = FastZString (BSC.pack str)
170
171 -- -----------------------------------------------------------------------------
172
173 {-|
174 A 'FastString' is an array of bytes, hashed to support fast O(1)
175 comparison.  It is also associated with a character encoding, so that
176 we know how to convert a 'FastString' to the local encoding, or to the
177 Z-encoding used by the compiler internally.
178
179 'FastString's support a memoized conversion to the Z-encoding via zEncodeFS.
180 -}
181
182 data FastString = FastString {
183       uniq    :: {-# UNPACK #-} !Int, -- unique id
184       n_chars :: {-# UNPACK #-} !Int, -- number of chars
185       fs_bs   :: {-# UNPACK #-} !ByteString,
186       fs_ref  :: {-# UNPACK #-} !(IORef (Maybe FastZString))
187   } deriving Typeable
188
189 instance Eq FastString where
190   f1 == f2  =  uniq f1 == uniq f2
191
192 instance Ord FastString where
193     -- Compares lexicographically, not by unique
194     a <= b = case cmpFS a b of { LT -> True;  EQ -> True;  GT -> False }
195     a <  b = case cmpFS a b of { LT -> True;  EQ -> False; GT -> False }
196     a >= b = case cmpFS a b of { LT -> False; EQ -> True;  GT -> True  }
197     a >  b = case cmpFS a b of { LT -> False; EQ -> False; GT -> True  }
198     max x y | x >= y    =  x
199             | otherwise =  y
200     min x y | x <= y    =  x
201             | otherwise =  y
202     compare a b = cmpFS a b
203
204 instance Show FastString where
205    show fs = show (unpackFS fs)
206
207 instance Data FastString where
208   -- don't traverse?
209   toConstr _   = abstractConstr "FastString"
210   gunfold _ _  = error "gunfold"
211   dataTypeOf _ = mkNoRepType "FastString"
212
213 cmpFS :: FastString -> FastString -> Ordering
214 cmpFS f1@(FastString u1 _ _ _) f2@(FastString u2 _ _ _) =
215   if u1 == u2 then EQ else
216   compare (fastStringToByteString f1) (fastStringToByteString f2)
217
218 foreign import ccall unsafe "ghc_memcmp"
219   memcmp :: Ptr a -> Ptr b -> Int -> IO Int
220
221 -- -----------------------------------------------------------------------------
222 -- Construction
223
224 {-
225 Internally, the compiler will maintain a fast string symbol table, providing
226 sharing and fast comparison. Creation of new @FastString@s then covertly does a
227 lookup, re-using the @FastString@ if there was a hit.
228
229 The design of the FastString hash table allows for lockless concurrent reads
230 and updates to multiple buckets with low synchronization overhead.
231
232 See Note [Updating the FastString table] on how it's updated.
233 -}
234 data FastStringTable =
235  FastStringTable
236     {-# UNPACK #-} !(IORef Int)  -- the unique ID counter shared with all buckets
237     (MutableArray# RealWorld (IORef [FastString])) -- the array of mutable buckets
238
239 string_table :: FastStringTable
240 {-# NOINLINE string_table #-}
241 string_table = unsafePerformIO $ do
242   uid <- newIORef 603979776 -- ord '$' * 0x01000000
243   tab <- IO $ \s1# -> case newArray# hASH_TBL_SIZE_UNBOXED (panic "string_table") s1# of
244                           (# s2#, arr# #) ->
245                               (# s2#, FastStringTable uid arr# #)
246   forM_ [0.. hASH_TBL_SIZE-1] $ \i -> do
247      bucket <- newIORef []
248      updTbl tab i bucket
249
250   -- use the support wired into the RTS to share this CAF among all images of
251   -- libHSghc
252 #if STAGE < 2
253   return tab
254 #else
255   sharedCAF tab getOrSetLibHSghcFastStringTable
256
257 -- from the RTS; thus we cannot use this mechanism when STAGE<2; the previous
258 -- RTS might not have this symbol
259 foreign import ccall unsafe "getOrSetLibHSghcFastStringTable"
260   getOrSetLibHSghcFastStringTable :: Ptr a -> IO (Ptr a)
261 #endif
262
263 {-
264
265 We include the FastString table in the `sharedCAF` mechanism because we'd like
266 FastStrings created by a Core plugin to have the same uniques as corresponding
267 strings created by the host compiler itself.  For example, this allows plugins
268 to lookup known names (eg `mkTcOcc "MySpecialType"`) in the GlobalRdrEnv or
269 even re-invoke the parser.
270
271 In particular, the following little sanity test was failing in a plugin
272 prototyping safe newtype-coercions: GHC.NT.Type.NT was imported, but could not
273 be looked up /by the plugin/.
274
275    let rdrName = mkModuleName "GHC.NT.Type" `mkRdrQual` mkTcOcc "NT"
276    putMsgS $ showSDoc dflags $ ppr $ lookupGRE_RdrName rdrName $ mg_rdr_env guts
277
278 `mkTcOcc` involves the lookup (or creation) of a FastString.  Since the
279 plugin's FastString.string_table is empty, constructing the RdrName also
280 allocates new uniques for the FastStrings "GHC.NT.Type" and "NT".  These
281 uniques are almost certainly unequal to the ones that the host compiler
282 originally assigned to those FastStrings.  Thus the lookup fails since the
283 domain of the GlobalRdrEnv is affected by the RdrName's OccName's FastString's
284 unique.
285
286 The old `reinitializeGlobals` mechanism is enough to provide the plugin with
287 read-access to the table, but it insufficient in the general case where the
288 plugin may allocate FastStrings. This mutates the supply for the FastStrings'
289 unique, and that needs to be propagated back to the compiler's instance of the
290 global variable.  Such propagation is beyond the `reinitializeGlobals`
291 mechanism.
292
293 Maintaining synchronization of the two instances of this global is rather
294 difficult because of the uses of `unsafePerformIO` in this module.  Not
295 synchronizing them risks breaking the rather major invariant that two
296 FastStrings with the same unique have the same string. Thus we use the
297 lower-level `sharedCAF` mechanism that relies on Globals.c.
298
299 -}
300
301 lookupTbl :: FastStringTable -> Int -> IO (IORef [FastString])
302 lookupTbl (FastStringTable _ arr#) (I# i#) =
303   IO $ \ s# -> readArray# arr# i# s#
304
305 updTbl :: FastStringTable -> Int -> IORef [FastString] -> IO ()
306 updTbl (FastStringTable _uid arr#) (I# i#) ls = do
307   (IO $ \ s# -> case writeArray# arr# i# ls s# of { s2# -> (# s2#, () #) })
308
309 mkFastString# :: Addr# -> FastString
310 mkFastString# a# = mkFastStringBytes ptr (ptrStrLength ptr)
311   where ptr = Ptr a#
312
313 {- Note [Updating the FastString table]
314
315 The procedure goes like this:
316
317 1. Read the relevant bucket and perform a look up of the string.
318 2. If it exists, return it.
319 3. Otherwise grab a unique ID, create a new FastString and atomically attempt
320    to update the relevant bucket with this FastString:
321
322    * Double check that the string is not in the bucket. Another thread may have
323      inserted it while we were creating our string.
324    * Return the existing FastString if it exists. The one we preemptively
325      created will get GCed.
326    * Otherwise, insert and return the string we created.
327 -}
328
329 {- Note [Double-checking the bucket]
330
331 It is not necessary to check the entire bucket the second time. We only have to
332 check the strings that are new to the bucket since the last time we read it.
333 -}
334
335 mkFastStringWith :: (Int -> IO FastString) -> Ptr Word8 -> Int -> IO FastString
336 mkFastStringWith mk_fs !ptr !len = do
337     let hash = hashStr ptr len
338     bucket <- lookupTbl string_table hash
339     ls1 <- readIORef bucket
340     res <- bucket_match ls1 len ptr
341     case res of
342         Just v  -> return v
343         Nothing -> do
344             n <- get_uid
345             new_fs <- mk_fs n
346
347             atomicModifyIORef bucket $ \ls2 ->
348                 -- Note [Double-checking the bucket]
349                 let delta_ls = case ls1 of
350                         []  -> ls2
351                         l:_ -> case l `elemIndex` ls2 of
352                             Nothing  -> panic "mkFastStringWith"
353                             Just idx -> take idx ls2
354
355                 -- NB: Might as well use inlinePerformIO, since the call to
356                 -- bucket_match doesn't perform any IO that could be floated
357                 -- out of this closure or erroneously duplicated.
358                 in case inlinePerformIO (bucket_match delta_ls len ptr) of
359                     Nothing -> (new_fs:ls2, new_fs)
360                     Just fs -> (ls2,fs)
361   where
362     !(FastStringTable uid _arr) = string_table
363
364     get_uid = atomicModifyIORef uid $ \n -> (n+1,n)
365
366 mkFastStringBytes :: Ptr Word8 -> Int -> FastString
367 mkFastStringBytes !ptr !len =
368     -- NB: Might as well use unsafeDupablePerformIO, since mkFastStringWith is
369     -- idempotent.
370     unsafeDupablePerformIO $
371         mkFastStringWith (copyNewFastString ptr len) ptr len
372
373 -- | Create a 'FastString' from an existing 'ForeignPtr'; the difference
374 -- between this and 'mkFastStringBytes' is that we don't have to copy
375 -- the bytes if the string is new to the table.
376 mkFastStringForeignPtr :: Ptr Word8 -> ForeignPtr Word8 -> Int -> IO FastString
377 mkFastStringForeignPtr ptr !fp len
378     = mkFastStringWith (mkNewFastString fp ptr len) ptr len
379
380 -- | Create a 'FastString' from an existing 'ForeignPtr'; the difference
381 -- between this and 'mkFastStringBytes' is that we don't have to copy
382 -- the bytes if the string is new to the table.
383 mkFastStringByteString :: ByteString -> FastString
384 mkFastStringByteString bs =
385     inlinePerformIO $
386       BS.unsafeUseAsCStringLen bs $ \(ptr, len) -> do
387         let ptr' = castPtr ptr
388         mkFastStringWith (mkNewFastStringByteString bs ptr' len) ptr' len
389
390 -- | Creates a UTF-8 encoded 'FastString' from a 'String'
391 mkFastString :: String -> FastString
392 mkFastString str =
393   inlinePerformIO $ do
394     let l = utf8EncodedLength str
395     buf <- mallocForeignPtrBytes l
396     withForeignPtr buf $ \ptr -> do
397       utf8EncodeString ptr str
398       mkFastStringForeignPtr ptr buf l
399
400 -- | Creates a 'FastString' from a UTF-8 encoded @[Word8]@
401 mkFastStringByteList :: [Word8] -> FastString
402 mkFastStringByteList str =
403   inlinePerformIO $ do
404     let l = Prelude.length str
405     buf <- mallocForeignPtrBytes l
406     withForeignPtr buf $ \ptr -> do
407       pokeArray (castPtr ptr) str
408       mkFastStringForeignPtr ptr buf l
409
410 -- | Creates a Z-encoded 'FastString' from a 'String'
411 mkZFastString :: String -> FastZString
412 mkZFastString = mkFastZStringString
413
414 bucket_match :: [FastString] -> Int -> Ptr Word8 -> IO (Maybe FastString)
415 bucket_match [] _ _ = return Nothing
416 bucket_match (v@(FastString _ _ bs _):ls) len ptr
417       | len == BS.length bs = do
418          b <- BS.unsafeUseAsCString bs $ \buf ->
419              cmpStringPrefix ptr (castPtr buf) len
420          if b then return (Just v)
421               else bucket_match ls len ptr
422       | otherwise =
423          bucket_match ls len ptr
424
425 mkNewFastString :: ForeignPtr Word8 -> Ptr Word8 -> Int -> Int
426                 -> IO FastString
427 mkNewFastString fp ptr len uid = do
428   ref <- newIORef Nothing
429   n_chars <- countUTF8Chars ptr len
430   return (FastString uid n_chars (BS.fromForeignPtr fp 0 len) ref)
431
432 mkNewFastStringByteString :: ByteString -> Ptr Word8 -> Int -> Int
433                           -> IO FastString
434 mkNewFastStringByteString bs ptr len uid = do
435   ref <- newIORef Nothing
436   n_chars <- countUTF8Chars ptr len
437   return (FastString uid n_chars bs ref)
438
439 copyNewFastString :: Ptr Word8 -> Int -> Int -> IO FastString
440 copyNewFastString ptr len uid = do
441   fp <- copyBytesToForeignPtr ptr len
442   ref <- newIORef Nothing
443   n_chars <- countUTF8Chars ptr len
444   return (FastString uid n_chars (BS.fromForeignPtr fp 0 len) ref)
445
446 copyBytesToForeignPtr :: Ptr Word8 -> Int -> IO (ForeignPtr Word8)
447 copyBytesToForeignPtr ptr len = do
448   fp <- mallocForeignPtrBytes len
449   withForeignPtr fp $ \ptr' -> copyBytes ptr' ptr len
450   return fp
451
452 cmpStringPrefix :: Ptr Word8 -> Ptr Word8 -> Int -> IO Bool
453 cmpStringPrefix ptr1 ptr2 len =
454  do r <- memcmp ptr1 ptr2 len
455     return (r == 0)
456
457
458 hashStr  :: Ptr Word8 -> Int -> Int
459  -- use the Addr to produce a hash value between 0 & m (inclusive)
460 hashStr (Ptr a#) (I# len#) = loop 0# 0#
461    where
462     loop h n | n ExtsCompat46.==# len# = I# h
463              | otherwise  = loop h2 (n ExtsCompat46.+# 1#)
464           where !c = ord# (indexCharOffAddr# a# n)
465                 !h2 = (c ExtsCompat46.+# (h ExtsCompat46.*# 128#)) `remInt#`
466                       hASH_TBL_SIZE#
467
468 -- -----------------------------------------------------------------------------
469 -- Operations
470
471 -- | Returns the length of the 'FastString' in characters
472 lengthFS :: FastString -> Int
473 lengthFS f = n_chars f
474
475 -- | Returns @True@ if this 'FastString' is not Z-encoded but already has
476 -- a Z-encoding cached (used in producing stats).
477 hasZEncoding :: FastString -> Bool
478 hasZEncoding (FastString _ _ _ ref) =
479       inlinePerformIO $ do
480         m <- readIORef ref
481         return (isJust m)
482
483 -- | Returns @True@ if the 'FastString' is empty
484 nullFS :: FastString -> Bool
485 nullFS f = BS.null (fs_bs f)
486
487 -- | Unpacks and decodes the FastString
488 unpackFS :: FastString -> String
489 unpackFS (FastString _ _ bs _) =
490   inlinePerformIO $ BS.unsafeUseAsCStringLen bs $ \(ptr, len) ->
491         utf8DecodeString (castPtr ptr) len
492
493 -- | Gives the UTF-8 encoded bytes corresponding to a 'FastString'
494 bytesFS :: FastString -> [Word8]
495 bytesFS fs = BS.unpack $ fastStringToByteString fs
496
497 -- | Returns a Z-encoded version of a 'FastString'.  This might be the
498 -- original, if it was already Z-encoded.  The first time this
499 -- function is applied to a particular 'FastString', the results are
500 -- memoized.
501 --
502 zEncodeFS :: FastString -> FastZString
503 zEncodeFS fs@(FastString _ _ _ ref) =
504       inlinePerformIO $ do
505         m <- readIORef ref
506         case m of
507           Just zfs -> return zfs
508           Nothing -> do
509             atomicModifyIORef ref $ \m' -> case m' of
510               Nothing  -> let zfs = mkZFastString (zEncodeString (unpackFS fs))
511                           in (Just zfs, zfs)
512               Just zfs -> (m', zfs)
513
514 appendFS :: FastString -> FastString -> FastString
515 appendFS fs1 fs2 = mkFastStringByteString
516                  $ BS.append (fastStringToByteString fs1)
517                              (fastStringToByteString fs2)
518
519 concatFS :: [FastString] -> FastString
520 concatFS ls = mkFastString (Prelude.concat (map unpackFS ls)) -- ToDo: do better
521
522 headFS :: FastString -> Char
523 headFS (FastString _ 0 _ _) = panic "headFS: Empty FastString"
524 headFS (FastString _ _ bs _) =
525   inlinePerformIO $ BS.unsafeUseAsCString bs $ \ptr ->
526          return (fst (utf8DecodeChar (castPtr ptr)))
527
528 tailFS :: FastString -> FastString
529 tailFS (FastString _ 0 _ _) = panic "tailFS: Empty FastString"
530 tailFS (FastString _ _ bs _) =
531     inlinePerformIO $ BS.unsafeUseAsCString bs $ \ptr ->
532     do let (_, n) = utf8DecodeChar (castPtr ptr)
533        return $! mkFastStringByteString (BS.drop n bs)
534
535 consFS :: Char -> FastString -> FastString
536 consFS c fs = mkFastString (c : unpackFS fs)
537
538 uniqueOfFS :: FastString -> FastInt
539 uniqueOfFS (FastString u _ _ _) = iUnbox u
540
541 nilFS :: FastString
542 nilFS = mkFastString ""
543
544 -- -----------------------------------------------------------------------------
545 -- Stats
546
547 getFastStringTable :: IO [[FastString]]
548 getFastStringTable = do
549   buckets <- forM [0.. hASH_TBL_SIZE-1] $ \idx -> do
550     bucket <- lookupTbl string_table idx
551     readIORef bucket
552   return buckets
553
554 -- -----------------------------------------------------------------------------
555 -- Outputting 'FastString's
556
557 -- |Outputs a 'FastString' with /no decoding at all/, that is, you
558 -- get the actual bytes in the 'FastString' written to the 'Handle'.
559 hPutFS :: Handle -> FastString -> IO ()
560 hPutFS handle fs = BS.hPut handle $ fastStringToByteString fs
561
562 -- ToDo: we'll probably want an hPutFSLocal, or something, to output
563 -- in the current locale's encoding (for error messages and suchlike).
564
565 -- -----------------------------------------------------------------------------
566 -- LitStrings, here for convenience only.
567
568 -- hmm, not unboxed (or rather FastPtr), interesting
569 --a.k.a. Ptr CChar, Ptr Word8, Ptr (), hmph.  We don't
570 --really care about C types in naming, where we can help it.
571 type LitString = Ptr Word8
572 --Why do we recalculate length every time it's requested?
573 --If it's commonly needed, we should perhaps have
574 --data LitString = LitString {-#UNPACK#-}!(FastPtr Word8) {-#UNPACK#-}!FastInt
575
576 #if defined(__GLASGOW_HASKELL__)
577 mkLitString# :: Addr# -> LitString
578 mkLitString# a# = Ptr a#
579 #endif
580 --can/should we use FastTypes here?
581 --Is this likely to be memory-preserving if only used on constant strings?
582 --should we inline it? If lucky, that would make a CAF that wouldn't
583 --be computationally repeated... although admittedly we're not
584 --really intending to use mkLitString when __GLASGOW_HASKELL__...
585 --(I wonder, is unicode / multi-byte characters allowed in LitStrings
586 -- at all?)
587 {-# INLINE mkLitString #-}
588 mkLitString :: String -> LitString
589 mkLitString s =
590  unsafePerformIO (do
591    p <- mallocBytes (length s + 1)
592    let
593      loop :: Int -> String -> IO ()
594      loop !n [] = pokeByteOff p n (0 :: Word8)
595      loop n (c:cs) = do
596         pokeByteOff p n (fromIntegral (ord c) :: Word8)
597         loop (1+n) cs
598    loop 0 s
599    return p
600  )
601
602 unpackLitString :: LitString -> String
603 unpackLitString p_ = case pUnbox p_ of
604  p -> unpack (_ILIT(0))
605   where
606     unpack n = case indexWord8OffFastPtrAsFastChar p n of
607       ch -> if ch `eqFastChar` _CLIT('\0')
608             then [] else cBox ch : unpack (n +# _ILIT(1))
609
610 lengthLS :: LitString -> Int
611 lengthLS = ptrStrLength
612
613 -- for now, use a simple String representation
614 --no, let's not do that right now - it's work in other places
615 #if 0
616 type LitString = String
617
618 mkLitString :: String -> LitString
619 mkLitString = id
620
621 unpackLitString :: LitString -> String
622 unpackLitString = id
623
624 lengthLS :: LitString -> Int
625 lengthLS = length
626
627 #endif
628
629 -- -----------------------------------------------------------------------------
630 -- under the carpet
631
632 foreign import ccall unsafe "ghc_strlen"
633   ptrStrLength :: Ptr Word8 -> Int
634
635 {-# NOINLINE sLit #-}
636 sLit :: String -> LitString
637 sLit x  = mkLitString x
638
639 {-# NOINLINE fsLit #-}
640 fsLit :: String -> FastString
641 fsLit x = mkFastString x
642
643 {-# RULES "slit"
644     forall x . sLit  (unpackCString# x) = mkLitString#  x #-}
645 {-# RULES "fslit"
646     forall x . fsLit (unpackCString# x) = mkFastString# x #-}
647 \end{code}