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