utils: detabify/dewhitespace GraphPpr
[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 -> IO FastString
384 mkFastStringByteString bs = BS.unsafeUseAsCStringLen bs $ \(ptr, len) -> do
385   let ptr' = castPtr ptr
386   mkFastStringWith (mkNewFastStringByteString bs ptr' len) ptr' len
387
388 -- | Creates a UTF-8 encoded 'FastString' from a 'String'
389 mkFastString :: String -> FastString
390 mkFastString str =
391   inlinePerformIO $ do
392     let l = utf8EncodedLength str
393     buf <- mallocForeignPtrBytes l
394     withForeignPtr buf $ \ptr -> do
395       utf8EncodeString ptr str
396       mkFastStringForeignPtr ptr buf l
397
398 -- | Creates a 'FastString' from a UTF-8 encoded @[Word8]@
399 mkFastStringByteList :: [Word8] -> FastString
400 mkFastStringByteList str =
401   inlinePerformIO $ do
402     let l = Prelude.length str
403     buf <- mallocForeignPtrBytes l
404     withForeignPtr buf $ \ptr -> do
405       pokeArray (castPtr ptr) str
406       mkFastStringForeignPtr ptr buf l
407
408 -- | Creates a Z-encoded 'FastString' from a 'String'
409 mkZFastString :: String -> FastZString
410 mkZFastString = mkFastZStringString
411
412 bucket_match :: [FastString] -> Int -> Ptr Word8 -> IO (Maybe FastString)
413 bucket_match [] _ _ = return Nothing
414 bucket_match (v@(FastString _ _ bs _):ls) len ptr
415       | len == BS.length bs = do
416          b <- BS.unsafeUseAsCString bs $ \buf ->
417              cmpStringPrefix ptr (castPtr buf) len
418          if b then return (Just v)
419               else bucket_match ls len ptr
420       | otherwise =
421          bucket_match ls len ptr
422
423 mkNewFastString :: ForeignPtr Word8 -> Ptr Word8 -> Int -> Int
424                 -> IO FastString
425 mkNewFastString fp ptr len uid = do
426   ref <- newIORef Nothing
427   n_chars <- countUTF8Chars ptr len
428   return (FastString uid n_chars (BS.fromForeignPtr fp 0 len) ref)
429
430 mkNewFastStringByteString :: ByteString -> Ptr Word8 -> Int -> Int
431                           -> IO FastString
432 mkNewFastStringByteString bs ptr len uid = do
433   ref <- newIORef Nothing
434   n_chars <- countUTF8Chars ptr len
435   return (FastString uid n_chars bs ref)
436
437 copyNewFastString :: Ptr Word8 -> Int -> Int -> IO FastString
438 copyNewFastString ptr len uid = do
439   fp <- copyBytesToForeignPtr ptr len
440   ref <- newIORef Nothing
441   n_chars <- countUTF8Chars ptr len
442   return (FastString uid n_chars (BS.fromForeignPtr fp 0 len) ref)
443
444 copyBytesToForeignPtr :: Ptr Word8 -> Int -> IO (ForeignPtr Word8)
445 copyBytesToForeignPtr ptr len = do
446   fp <- mallocForeignPtrBytes len
447   withForeignPtr fp $ \ptr' -> copyBytes ptr' ptr len
448   return fp
449
450 cmpStringPrefix :: Ptr Word8 -> Ptr Word8 -> Int -> IO Bool
451 cmpStringPrefix ptr1 ptr2 len =
452  do r <- memcmp ptr1 ptr2 len
453     return (r == 0)
454
455
456 hashStr  :: Ptr Word8 -> Int -> Int
457  -- use the Addr to produce a hash value between 0 & m (inclusive)
458 hashStr (Ptr a#) (I# len#) = loop 0# 0#
459    where
460     loop h n | n ExtsCompat46.==# len# = I# h
461              | otherwise  = loop h2 (n ExtsCompat46.+# 1#)
462           where !c = ord# (indexCharOffAddr# a# n)
463                 !h2 = (c ExtsCompat46.+# (h ExtsCompat46.*# 128#)) `remInt#`
464                       hASH_TBL_SIZE#
465
466 -- -----------------------------------------------------------------------------
467 -- Operations
468
469 -- | Returns the length of the 'FastString' in characters
470 lengthFS :: FastString -> Int
471 lengthFS f = n_chars f
472
473 -- | Returns @True@ if this 'FastString' is not Z-encoded but already has
474 -- a Z-encoding cached (used in producing stats).
475 hasZEncoding :: FastString -> Bool
476 hasZEncoding (FastString _ _ _ ref) =
477       inlinePerformIO $ do
478         m <- readIORef ref
479         return (isJust m)
480
481 -- | Returns @True@ if the 'FastString' is empty
482 nullFS :: FastString -> Bool
483 nullFS f = BS.null (fs_bs f)
484
485 -- | Unpacks and decodes the FastString
486 unpackFS :: FastString -> String
487 unpackFS (FastString _ _ bs _) =
488   inlinePerformIO $ BS.unsafeUseAsCStringLen bs $ \(ptr, len) ->
489         utf8DecodeString (castPtr ptr) len
490
491 -- | Gives the UTF-8 encoded bytes corresponding to a 'FastString'
492 bytesFS :: FastString -> [Word8]
493 bytesFS fs = BS.unpack $ fastStringToByteString fs
494
495 -- | Returns a Z-encoded version of a 'FastString'.  This might be the
496 -- original, if it was already Z-encoded.  The first time this
497 -- function is applied to a particular 'FastString', the results are
498 -- memoized.
499 --
500 zEncodeFS :: FastString -> FastZString
501 zEncodeFS fs@(FastString _ _ _ ref) =
502       inlinePerformIO $ do
503         m <- readIORef ref
504         case m of
505           Just zfs -> return zfs
506           Nothing -> do
507             atomicModifyIORef ref $ \m' -> case m' of
508               Nothing  -> let zfs = mkZFastString (zEncodeString (unpackFS fs))
509                           in (Just zfs, zfs)
510               Just zfs -> (m', zfs)
511
512 appendFS :: FastString -> FastString -> FastString
513 appendFS fs1 fs2 = inlinePerformIO
514                  $ mkFastStringByteString
515                  $ BS.append (fastStringToByteString fs1)
516                              (fastStringToByteString fs2)
517
518 concatFS :: [FastString] -> FastString
519 concatFS ls = mkFastString (Prelude.concat (map unpackFS ls)) -- ToDo: do better
520
521 headFS :: FastString -> Char
522 headFS (FastString _ 0 _ _) = panic "headFS: Empty FastString"
523 headFS (FastString _ _ bs _) =
524   inlinePerformIO $ BS.unsafeUseAsCString bs $ \ptr ->
525          return (fst (utf8DecodeChar (castPtr ptr)))
526
527 tailFS :: FastString -> FastString
528 tailFS (FastString _ 0 _ _) = panic "tailFS: Empty FastString"
529 tailFS (FastString _ _ bs _) =
530     inlinePerformIO $ BS.unsafeUseAsCString bs $ \ptr ->
531     do let (_, ptr') = utf8DecodeChar (castPtr ptr)
532            n = ptr' `minusPtr` ptr
533        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}