| ... |
... |
@@ -320,7 +320,7 @@ data FastStringTable = FastStringTable |
|
320
|
320
|
-- ^ Number of computed z-encodings for all buckets.
|
|
321
|
321
|
--
|
|
322
|
322
|
-- We mark this as 'NOUNPACK' as this 'FastMutInt' is retained by a thunk
|
|
323
|
|
- -- in 'mkFastStringWith' and needs to be boxed any way.
|
|
|
323
|
+ -- in 'intern' and needs to be boxed any way.
|
|
324
|
324
|
-- If this is unpacked, then we box this single 'FastMutInt' once for each
|
|
325
|
325
|
-- allocated FastString.
|
|
326
|
326
|
(Array# (IORef FastStringTableSegment)) -- ^ concurrent segments
|
| ... |
... |
@@ -474,9 +474,10 @@ The procedure goes like this: |
|
474
|
474
|
* Otherwise, insert and return the string we created.
|
|
475
|
475
|
-}
|
|
476
|
476
|
|
|
477
|
|
-mkFastStringWith
|
|
478
|
|
- :: (Int -> FastMutInt-> IO FastString) -> ShortByteString -> IO FastString
|
|
479
|
|
-mkFastStringWith mk_fs sbs = do
|
|
|
477
|
+-- | Return the interned 'FastString' for the given bytes, creating and
|
|
|
478
|
+-- inserting one on a table miss.
|
|
|
479
|
+intern :: ShortByteString -> IO FastString
|
|
|
480
|
+intern sbs = do
|
|
480
|
481
|
FastStringTableSegment lock _ buckets# <- readIORef segmentRef
|
|
481
|
482
|
let idx# = hashToIndex# buckets# hash#
|
|
482
|
483
|
bucket <- IO $ readArray# buckets# idx#
|
| ... |
... |
@@ -487,7 +488,7 @@ mkFastStringWith mk_fs sbs = do |
|
487
|
488
|
-- only run partially and putMVar is not called after takeMVar.
|
|
488
|
489
|
noDuplicate
|
|
489
|
490
|
n <- get_uid
|
|
490
|
|
- new_fs <- mk_fs n n_zencs
|
|
|
491
|
+ new_fs <- mkNewFastStringShortByteString sbs n n_zencs
|
|
491
|
492
|
withMVar lock $ \_ -> insert new_fs
|
|
492
|
493
|
where
|
|
493
|
494
|
!(FastStringTable uid n_zencs segments#) = stringTable
|
| ... |
... |
@@ -523,11 +524,11 @@ bucket_match fs sbs = go fs |
|
523
|
524
|
|
|
524
|
525
|
mkFastStringBytes :: Ptr Word8 -> Int -> FastString
|
|
525
|
526
|
mkFastStringBytes !ptr !len =
|
|
526
|
|
- -- NB: Might as well use unsafeDupablePerformIO, since mkFastStringWith is
|
|
|
527
|
+ -- NB: Might as well use unsafeDupablePerformIO, since intern is
|
|
527
|
528
|
-- idempotent.
|
|
528
|
529
|
unsafeDupablePerformIO $ do
|
|
529
|
530
|
sbs <- newSBSFromPtr ptr len
|
|
530
|
|
- mkFastStringWith (mkNewFastStringShortByteString sbs) sbs
|
|
|
531
|
+ intern sbs
|
|
531
|
532
|
|
|
532
|
533
|
newSBSFromPtr :: Ptr a -> Int -> IO ShortByteString
|
|
533
|
534
|
newSBSFromPtr (Ptr src#) (I# len#) =
|
| ... |
... |
@@ -541,14 +542,13 @@ newSBSFromPtr (Ptr src#) (I# len#) = |
|
541
|
542
|
mkFastStringByteString :: ByteString -> FastString
|
|
542
|
543
|
mkFastStringByteString bs =
|
|
543
|
544
|
let sbs = SBS.toShort bs in
|
|
544
|
|
- inlinePerformIO $
|
|
545
|
|
- mkFastStringWith (mkNewFastStringShortByteString sbs) sbs
|
|
|
545
|
+ inlinePerformIO $ intern sbs
|
|
546
|
546
|
|
|
547
|
547
|
-- | Create a 'FastString' from an existing 'ShortByteString' without
|
|
548
|
548
|
-- copying.
|
|
549
|
549
|
mkFastStringShortByteString :: ShortByteString -> FastString
|
|
550
|
550
|
mkFastStringShortByteString sbs =
|
|
551
|
|
- inlinePerformIO $ mkFastStringWith (mkNewFastStringShortByteString sbs) sbs
|
|
|
551
|
+ inlinePerformIO $ intern sbs
|
|
552
|
552
|
|
|
553
|
553
|
-- | Create a 'FastString' from an 'HText'
|
|
554
|
554
|
mkFastStringShortText :: ShortText -> FastString
|
| ... |
... |
@@ -560,7 +560,7 @@ mkFastString :: String -> FastString |
|
560
|
560
|
mkFastString str =
|
|
561
|
561
|
inlinePerformIO $ do
|
|
562
|
562
|
let !sbs = utf8EncodeShortByteString str
|
|
563
|
|
- mkFastStringWith (mkNewFastStringShortByteString sbs) sbs
|
|
|
563
|
+ intern sbs
|
|
564
|
564
|
|
|
565
|
565
|
-- The following rule is used to avoid polluting the non-reclaimable FastString
|
|
566
|
566
|
-- table with transient strings when we only want their encoding.
|