Add conversions between ShortByteString and CString
[packages/bytestring.git] / Data / ByteString / Short / Internal.hs
1 {-# LANGUAGE DeriveDataTypeable, CPP, BangPatterns, RankNTypes,
2 ForeignFunctionInterface, MagicHash, UnboxedTuples,
3 UnliftedFFITypes #-}
4 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
5 #if __GLASGOW_HASKELL__ >= 703
6 {-# LANGUAGE Unsafe #-}
7 #endif
8 {-# OPTIONS_HADDOCK hide #-}
9
10 -- |
11 -- Module : Data.ByteString.Short.Internal
12 -- Copyright : (c) Duncan Coutts 2012-2013
13 -- License : BSD-style
14 --
15 -- Maintainer : duncan@community.haskell.org
16 -- Stability : stable
17 -- Portability : ghc only
18 --
19 -- Internal representation of ShortByteString
20 --
21 module Data.ByteString.Short.Internal (
22
23 -- * The @ShortByteString@ type and representation
24 ShortByteString(..),
25
26 -- * Conversions
27 toShort,
28 fromShort,
29 pack,
30 unpack,
31
32 -- * Other operations
33 empty, null, length, index, unsafeIndex,
34
35 -- * Low level operations
36 createFromPtr, copyToPtr,
37
38 -- * Low level conversions
39 -- ** Packing 'CString's and pointers
40 packCString,
41 packCStringLen,
42
43 -- ** Using ByteStrings as 'CString's
44 useAsCString,
45 useAsCStringLen
46 ) where
47
48 import Data.ByteString.Internal (ByteString(..), accursedUnutterablePerformIO, c_strlen)
49
50 import Data.Typeable (Typeable)
51 import Data.Data (Data(..), mkNoRepType)
52 #if MIN_VERSION_base(4,9,0)
53 import Data.Semigroup (Semigroup((<>)))
54 #endif
55 import Data.Monoid (Monoid(..))
56 import Data.String (IsString(..))
57 import Control.DeepSeq (NFData(..))
58 import qualified Data.List as List (length)
59 import Foreign.C.String (CString, CStringLen)
60 #if MIN_VERSION_base(4,7,0)
61 import Foreign.C.Types (CSize(..), CInt(..))
62 #elif MIN_VERSION_base(4,4,0)
63 import Foreign.C.Types (CSize(..), CInt(..), CLong(..))
64 #else
65 import Foreign.C.Types (CSize, CInt, CLong)
66 #endif
67 import Foreign.Marshal.Alloc (allocaBytes)
68 import Foreign.Ptr
69 import Foreign.ForeignPtr (touchForeignPtr)
70 #if MIN_VERSION_base(4,5,0)
71 import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
72 #else
73 import Foreign.ForeignPtr (unsafeForeignPtrToPtr)
74 #endif
75 import Foreign.Storable (pokeByteOff)
76
77 #if MIN_VERSION_base(4,5,0)
78 import qualified GHC.Exts
79 #endif
80 import GHC.Exts ( Int(I#), Int#, Ptr(Ptr), Addr#, Char(C#)
81 , State#, RealWorld
82 , ByteArray#, MutableByteArray#
83 , newByteArray#
84 #if MIN_VERSION_base(4,6,0)
85 , newPinnedByteArray#
86 , byteArrayContents#
87 , unsafeCoerce#
88 #endif
89 #if MIN_VERSION_base(4,3,0)
90 , sizeofByteArray#
91 #endif
92 , indexWord8Array#, indexCharArray#
93 , writeWord8Array#, writeCharArray#
94 , unsafeFreezeByteArray# )
95 import GHC.IO
96 #if MIN_VERSION_base(4,6,0)
97 import GHC.ForeignPtr (ForeignPtr(ForeignPtr), ForeignPtrContents(PlainPtr))
98 #else
99 import GHC.ForeignPtr (mallocPlainForeignPtrBytes)
100 #endif
101 import GHC.ST (ST(ST), runST)
102 import GHC.Word
103
104 import Prelude ( Eq(..), Ord(..), Ordering(..), Read(..), Show(..)
105 , ($), error, (++), (.)
106 , String, userError
107 , Bool(..), (&&), otherwise
108 , (+), (-), fromIntegral
109 , return )
110
111
112 -- | A compact representation of a 'Word8' vector.
113 --
114 -- It has a lower memory overhead than a 'ByteString' and and does not
115 -- contribute to heap fragmentation. It can be converted to or from a
116 -- 'ByteString' (at the cost of copying the string data). It supports very few
117 -- other operations.
118 --
119 -- It is suitable for use as an internal representation for code that needs
120 -- to keep many short strings in memory, but it /should not/ be used as an
121 -- interchange type. That is, it should not generally be used in public APIs.
122 -- The 'ByteString' type is usually more suitable for use in interfaces; it is
123 -- more flexible and it supports a wide range of operations.
124 --
125 data ShortByteString = SBS ByteArray#
126 #if !(MIN_VERSION_base(4,3,0))
127 {-# UNPACK #-} !Int -- ^ Prior to ghc-7.0.x, 'ByteArray#'s reported
128 -- their length rounded up to the nearest word.
129 -- This means we have to store the true length
130 -- separately, wasting a word.
131 #define LEN(x) (x)
132 #else
133 #define _len /* empty */
134 #define LEN(x) /* empty */
135 #endif
136 deriving Typeable
137
138 -- The ByteArray# representation is always word sized and aligned but with a
139 -- known byte length. Our representation choice for ShortByteString is to leave
140 -- the 0--3 trailing bytes undefined. This means we can use word-sized writes,
141 -- but we have to be careful with reads, see equateBytes and compareBytes below.
142
143
144 instance Eq ShortByteString where
145 (==) = equateBytes
146
147 instance Ord ShortByteString where
148 compare = compareBytes
149
150 #if MIN_VERSION_base(4,9,0)
151 instance Semigroup ShortByteString where
152 (<>) = append
153 #endif
154
155 instance Monoid ShortByteString where
156 mempty = empty
157 #if MIN_VERSION_base(4,9,0)
158 mappend = (<>)
159 #else
160 mappend = append
161 #endif
162 mconcat = concat
163
164 instance NFData ShortByteString where
165 rnf SBS{} = ()
166
167 instance Show ShortByteString where
168 showsPrec p ps r = showsPrec p (unpackChars ps) r
169
170 instance Read ShortByteString where
171 readsPrec p str = [ (packChars x, y) | (x, y) <- readsPrec p str ]
172
173 instance IsString ShortByteString where
174 fromString = packChars
175
176 instance Data ShortByteString where
177 gfoldl f z txt = z packBytes `f` unpackBytes txt
178 toConstr _ = error "Data.ByteString.Short.ShortByteString.toConstr"
179 gunfold _ _ = error "Data.ByteString.Short.ShortByteString.gunfold"
180 dataTypeOf _ = mkNoRepType "Data.ByteString.Short.ShortByteString"
181
182 ------------------------------------------------------------------------
183 -- Simple operations
184
185 -- | /O(1)/. The empty 'ShortByteString'.
186 empty :: ShortByteString
187 empty = create 0 (\_ -> return ())
188
189 -- | /O(1)/ The length of a 'ShortByteString'.
190 length :: ShortByteString -> Int
191 #if MIN_VERSION_base(4,3,0)
192 length (SBS barr#) = I# (sizeofByteArray# barr#)
193 #else
194 length (SBS _ len) = len
195 #endif
196
197 -- | /O(1)/ Test whether a 'ShortByteString' is empty.
198 null :: ShortByteString -> Bool
199 null sbs = length sbs == 0
200
201 -- | /O(1)/ 'ShortByteString' index (subscript) operator, starting from 0.
202 index :: ShortByteString -> Int -> Word8
203 index sbs i
204 | i >= 0 && i < length sbs = unsafeIndex sbs i
205 | otherwise = indexError sbs i
206
207 unsafeIndex :: ShortByteString -> Int -> Word8
208 unsafeIndex sbs = indexWord8Array (asBA sbs)
209
210 indexError :: ShortByteString -> Int -> a
211 indexError sbs i =
212 error $ "Data.ByteString.Short.index: error in array index; " ++ show i
213 ++ " not in range [0.." ++ show (length sbs) ++ ")"
214
215
216 ------------------------------------------------------------------------
217 -- Internal utils
218
219 asBA :: ShortByteString -> BA
220 asBA (SBS ba# _len) = BA# ba#
221
222 create :: Int -> (forall s. MBA s -> ST s ()) -> ShortByteString
223 create len fill =
224 runST (do
225 mba <- newByteArray len
226 fill mba
227 BA# ba# <- unsafeFreezeByteArray mba
228 return (SBS ba# LEN(len)))
229 {-# INLINE create #-}
230
231 ------------------------------------------------------------------------
232 -- Conversion to and from ByteString
233
234 -- | /O(n)/. Convert a 'ByteString' into a 'ShortByteString'.
235 --
236 -- This makes a copy, so does not retain the input string.
237 --
238 toShort :: ByteString -> ShortByteString
239 toShort !bs = unsafeDupablePerformIO (toShortIO bs)
240
241 toShortIO :: ByteString -> IO ShortByteString
242 toShortIO (PS fptr off len) = do
243 mba <- stToIO (newByteArray len)
244 let ptr = unsafeForeignPtrToPtr fptr
245 stToIO (copyAddrToByteArray (ptr `plusPtr` off) mba 0 len)
246 touchForeignPtr fptr
247 BA# ba# <- stToIO (unsafeFreezeByteArray mba)
248 return (SBS ba# LEN(len))
249
250
251 -- | /O(n)/. Convert a 'ShortByteString' into a 'ByteString'.
252 --
253 fromShort :: ShortByteString -> ByteString
254 fromShort !sbs = unsafeDupablePerformIO (fromShortIO sbs)
255
256 fromShortIO :: ShortByteString -> IO ByteString
257 fromShortIO sbs = do
258 #if MIN_VERSION_base(4,6,0)
259 let len = length sbs
260 mba@(MBA# mba#) <- stToIO (newPinnedByteArray len)
261 stToIO (copyByteArray (asBA sbs) 0 mba 0 len)
262 let fp = ForeignPtr (byteArrayContents# (unsafeCoerce# mba#))
263 (PlainPtr mba#)
264 return (PS fp 0 len)
265 #else
266 -- Before base 4.6 ForeignPtrContents is not exported from GHC.ForeignPtr
267 -- so we cannot get direct access to the mbarr#
268 let len = length sbs
269 fptr <- mallocPlainForeignPtrBytes len
270 let ptr = unsafeForeignPtrToPtr fptr
271 stToIO (copyByteArrayToAddr (asBA sbs) 0 ptr len)
272 touchForeignPtr fptr
273 return (PS fptr 0 len)
274 #endif
275
276
277 ------------------------------------------------------------------------
278 -- Packing and unpacking from lists
279
280 -- | /O(n)/. Convert a list into a 'ShortByteString'
281 pack :: [Word8] -> ShortByteString
282 pack = packBytes
283
284 -- | /O(n)/. Convert a 'ShortByteString' into a list.
285 unpack :: ShortByteString -> [Word8]
286 unpack = unpackBytes
287
288 packChars :: [Char] -> ShortByteString
289 packChars cs = packLenChars (List.length cs) cs
290
291 packBytes :: [Word8] -> ShortByteString
292 packBytes cs = packLenBytes (List.length cs) cs
293
294 packLenChars :: Int -> [Char] -> ShortByteString
295 packLenChars len cs0 =
296 create len (\mba -> go mba 0 cs0)
297 where
298 go :: MBA s -> Int -> [Char] -> ST s ()
299 go !_ !_ [] = return ()
300 go !mba !i (c:cs) = do
301 writeCharArray mba i c
302 go mba (i+1) cs
303
304 packLenBytes :: Int -> [Word8] -> ShortByteString
305 packLenBytes len ws0 =
306 create len (\mba -> go mba 0 ws0)
307 where
308 go :: MBA s -> Int -> [Word8] -> ST s ()
309 go !_ !_ [] = return ()
310 go !mba !i (w:ws) = do
311 writeWord8Array mba i w
312 go mba (i+1) ws
313
314 -- Unpacking bytestrings into lists effeciently is a tradeoff: on the one hand
315 -- we would like to write a tight loop that just blats the list into memory, on
316 -- the other hand we want it to be unpacked lazily so we don't end up with a
317 -- massive list data structure in memory.
318 --
319 -- Our strategy is to combine both: we will unpack lazily in reasonable sized
320 -- chunks, where each chunk is unpacked strictly.
321 --
322 -- unpackChars does the lazy loop, while unpackAppendBytes and
323 -- unpackAppendChars do the chunks strictly.
324
325 unpackChars :: ShortByteString -> [Char]
326 unpackChars bs = unpackAppendCharsLazy bs []
327
328 unpackBytes :: ShortByteString -> [Word8]
329 unpackBytes bs = unpackAppendBytesLazy bs []
330
331 -- Why 100 bytes you ask? Because on a 64bit machine the list we allocate
332 -- takes just shy of 4k which seems like a reasonable amount.
333 -- (5 words per list element, 8 bytes per word, 100 elements = 4000 bytes)
334
335 unpackAppendCharsLazy :: ShortByteString -> [Char] -> [Char]
336 unpackAppendCharsLazy sbs cs0 = go 0 (length sbs) cs0
337 where
338 sz = 100
339
340 go off len cs
341 | len <= sz = unpackAppendCharsStrict sbs off len cs
342 | otherwise = unpackAppendCharsStrict sbs off sz remainder
343 where remainder = go (off+sz) (len-sz) cs
344
345 unpackAppendBytesLazy :: ShortByteString -> [Word8] -> [Word8]
346 unpackAppendBytesLazy sbs ws0 = go 0 (length sbs) ws0
347 where
348 sz = 100
349
350 go off len ws
351 | len <= sz = unpackAppendBytesStrict sbs off len ws
352 | otherwise = unpackAppendBytesStrict sbs off sz remainder
353 where remainder = go (off+sz) (len-sz) ws
354
355 -- For these unpack functions, since we're unpacking the whole list strictly we
356 -- build up the result list in an accumulator. This means we have to build up
357 -- the list starting at the end. So our traversal starts at the end of the
358 -- buffer and loops down until we hit the sentinal:
359
360 unpackAppendCharsStrict :: ShortByteString -> Int -> Int -> [Char] -> [Char]
361 unpackAppendCharsStrict !sbs off len cs = go (off-1) (off-1 + len) cs
362 where
363 go !sentinal !i !acc
364 | i == sentinal = acc
365 | otherwise = let !c = indexCharArray (asBA sbs) i
366 in go sentinal (i-1) (c:acc)
367
368 unpackAppendBytesStrict :: ShortByteString -> Int -> Int -> [Word8] -> [Word8]
369 unpackAppendBytesStrict !sbs off len ws = go (off-1) (off-1 + len) ws
370 where
371 go !sentinal !i !acc
372 | i == sentinal = acc
373 | otherwise = let !w = indexWord8Array (asBA sbs) i
374 in go sentinal (i-1) (w:acc)
375
376
377 ------------------------------------------------------------------------
378 -- Eq and Ord implementations
379
380 equateBytes :: ShortByteString -> ShortByteString -> Bool
381 equateBytes sbs1 sbs2 =
382 let !len1 = length sbs1
383 !len2 = length sbs2
384 in len1 == len2
385 && 0 == accursedUnutterablePerformIO
386 (memcmp_ByteArray (asBA sbs1) (asBA sbs2) len1)
387
388 compareBytes :: ShortByteString -> ShortByteString -> Ordering
389 compareBytes sbs1 sbs2 =
390 let !len1 = length sbs1
391 !len2 = length sbs2
392 !len = min len1 len2
393 in case accursedUnutterablePerformIO
394 (memcmp_ByteArray (asBA sbs1) (asBA sbs2) len) of
395 i | i < 0 -> LT
396 | i > 0 -> GT
397 | len2 > len1 -> LT
398 | len2 < len1 -> GT
399 | otherwise -> EQ
400
401
402 ------------------------------------------------------------------------
403 -- Appending and concatenation
404
405 append :: ShortByteString -> ShortByteString -> ShortByteString
406 append src1 src2 =
407 let !len1 = length src1
408 !len2 = length src2
409 in create (len1 + len2) $ \dst -> do
410 copyByteArray (asBA src1) 0 dst 0 len1
411 copyByteArray (asBA src2) 0 dst len1 len2
412
413 concat :: [ShortByteString] -> ShortByteString
414 concat sbss =
415 create (totalLen 0 sbss) (\dst -> copy dst 0 sbss)
416 where
417 totalLen !acc [] = acc
418 totalLen !acc (sbs: sbss) = totalLen (acc + length sbs) sbss
419
420 copy :: MBA s -> Int -> [ShortByteString] -> ST s ()
421 copy !_ !_ [] = return ()
422 copy !dst !off (src : sbss) = do
423 let !len = length src
424 copyByteArray (asBA src) 0 dst off len
425 copy dst (off + len) sbss
426
427
428 ------------------------------------------------------------------------
429 -- Exported low level operations
430
431 copyToPtr :: ShortByteString -- ^ source data
432 -> Int -- ^ offset into source
433 -> Ptr a -- ^ destination
434 -> Int -- ^ number of bytes to copy
435 -> IO ()
436 copyToPtr src off dst len =
437 stToIO $
438 copyByteArrayToAddr (asBA src) off dst len
439
440 createFromPtr :: Ptr a -- ^ source data
441 -> Int -- ^ number of bytes to copy
442 -> IO ShortByteString
443 createFromPtr !ptr len =
444 stToIO $ do
445 mba <- newByteArray len
446 copyAddrToByteArray ptr mba 0 len
447 BA# ba# <- unsafeFreezeByteArray mba
448 return (SBS ba# LEN(len))
449
450
451 ------------------------------------------------------------------------
452 -- Primop wrappers
453
454 data BA = BA# ByteArray#
455 data MBA s = MBA# (MutableByteArray# s)
456
457 indexCharArray :: BA -> Int -> Char
458 indexCharArray (BA# ba#) (I# i#) = C# (indexCharArray# ba# i#)
459
460 indexWord8Array :: BA -> Int -> Word8
461 indexWord8Array (BA# ba#) (I# i#) = W8# (indexWord8Array# ba# i#)
462
463 newByteArray :: Int -> ST s (MBA s)
464 newByteArray (I# len#) =
465 ST $ \s -> case newByteArray# len# s of
466 (# s, mba# #) -> (# s, MBA# mba# #)
467
468 #if MIN_VERSION_base(4,6,0)
469 newPinnedByteArray :: Int -> ST s (MBA s)
470 newPinnedByteArray (I# len#) =
471 ST $ \s -> case newPinnedByteArray# len# s of
472 (# s, mba# #) -> (# s, MBA# mba# #)
473 #endif
474
475 unsafeFreezeByteArray :: MBA s -> ST s BA
476 unsafeFreezeByteArray (MBA# mba#) =
477 ST $ \s -> case unsafeFreezeByteArray# mba# s of
478 (# s, ba# #) -> (# s, BA# ba# #)
479
480 writeCharArray :: MBA s -> Int -> Char -> ST s ()
481 writeCharArray (MBA# mba#) (I# i#) (C# c#) =
482 ST $ \s -> case writeCharArray# mba# i# c# s of
483 s -> (# s, () #)
484
485 writeWord8Array :: MBA s -> Int -> Word8 -> ST s ()
486 writeWord8Array (MBA# mba#) (I# i#) (W8# w#) =
487 ST $ \s -> case writeWord8Array# mba# i# w# s of
488 s -> (# s, () #)
489
490 copyAddrToByteArray :: Ptr a -> MBA RealWorld -> Int -> Int -> ST RealWorld ()
491 copyAddrToByteArray (Ptr src#) (MBA# dst#) (I# dst_off#) (I# len#) =
492 ST $ \s -> case copyAddrToByteArray# src# dst# dst_off# len# s of
493 s -> (# s, () #)
494
495 copyByteArrayToAddr :: BA -> Int -> Ptr a -> Int -> ST RealWorld ()
496 copyByteArrayToAddr (BA# src#) (I# src_off#) (Ptr dst#) (I# len#) =
497 ST $ \s -> case copyByteArrayToAddr# src# src_off# dst# len# s of
498 s -> (# s, () #)
499
500 copyByteArray :: BA -> Int -> MBA s -> Int -> Int -> ST s ()
501 copyByteArray (BA# src#) (I# src_off#) (MBA# dst#) (I# dst_off#) (I# len#) =
502 ST $ \s -> case copyByteArray# src# src_off# dst# dst_off# len# s of
503 s -> (# s, () #)
504
505
506 ------------------------------------------------------------------------
507 -- FFI imports
508
509 memcmp_ByteArray :: BA -> BA -> Int -> IO CInt
510 memcmp_ByteArray (BA# ba1#) (BA# ba2#) len =
511 c_memcmp_ByteArray ba1# ba2# (fromIntegral len)
512
513 foreign import ccall unsafe "string.h memcmp"
514 c_memcmp_ByteArray :: ByteArray# -> ByteArray# -> CSize -> IO CInt
515
516
517 ------------------------------------------------------------------------
518 -- Primop replacements
519
520 copyAddrToByteArray# :: Addr#
521 -> MutableByteArray# RealWorld -> Int#
522 -> Int#
523 -> State# RealWorld -> State# RealWorld
524
525 copyByteArrayToAddr# :: ByteArray# -> Int#
526 -> Addr#
527 -> Int#
528 -> State# RealWorld -> State# RealWorld
529
530 copyByteArray# :: ByteArray# -> Int#
531 -> MutableByteArray# s -> Int#
532 -> Int#
533 -> State# s -> State# s
534
535 #if MIN_VERSION_base(4,7,0)
536
537 -- These exist as real primops in ghc-7.8, and for before that we use
538 -- FFI to C memcpy.
539 copyAddrToByteArray# = GHC.Exts.copyAddrToByteArray#
540 copyByteArrayToAddr# = GHC.Exts.copyByteArrayToAddr#
541
542 #else
543
544 copyAddrToByteArray# src dst dst_off len s =
545 unIO_ (memcpy_AddrToByteArray dst (clong dst_off) src 0 (csize len)) s
546
547 copyAddrToByteArray0 :: Addr# -> MutableByteArray# s -> Int#
548 -> State# RealWorld -> State# RealWorld
549 copyAddrToByteArray0 src dst len s =
550 unIO_ (memcpy_AddrToByteArray0 dst src (csize len)) s
551
552 {-# INLINE [0] copyAddrToByteArray# #-}
553 {-# RULES "copyAddrToByteArray# dst_off=0"
554 forall src dst len s.
555 copyAddrToByteArray# src dst 0# len s
556 = copyAddrToByteArray0 src dst len s #-}
557
558 foreign import ccall unsafe "fpstring.h fps_memcpy_offsets"
559 memcpy_AddrToByteArray :: MutableByteArray# s -> CLong -> Addr# -> CLong -> CSize -> IO ()
560
561 foreign import ccall unsafe "string.h memcpy"
562 memcpy_AddrToByteArray0 :: MutableByteArray# s -> Addr# -> CSize -> IO ()
563
564
565 copyByteArrayToAddr# src src_off dst len s =
566 unIO_ (memcpy_ByteArrayToAddr dst 0 src (clong src_off) (csize len)) s
567
568 copyByteArrayToAddr0 :: ByteArray# -> Addr# -> Int#
569 -> State# RealWorld -> State# RealWorld
570 copyByteArrayToAddr0 src dst len s =
571 unIO_ (memcpy_ByteArrayToAddr0 dst src (csize len)) s
572
573 {-# INLINE [0] copyByteArrayToAddr# #-}
574 {-# RULES "copyByteArrayToAddr# src_off=0"
575 forall src dst len s.
576 copyByteArrayToAddr# src 0# dst len s
577 = copyByteArrayToAddr0 src dst len s #-}
578
579 foreign import ccall unsafe "fpstring.h fps_memcpy_offsets"
580 memcpy_ByteArrayToAddr :: Addr# -> CLong -> ByteArray# -> CLong -> CSize -> IO ()
581
582 foreign import ccall unsafe "string.h memcpy"
583 memcpy_ByteArrayToAddr0 :: Addr# -> ByteArray# -> CSize -> IO ()
584
585
586 unIO_ :: IO () -> State# RealWorld -> State# RealWorld
587 unIO_ io s = case unIO io s of (# s, _ #) -> s
588
589 clong :: Int# -> CLong
590 clong i# = fromIntegral (I# i#)
591
592 csize :: Int# -> CSize
593 csize i# = fromIntegral (I# i#)
594 #endif
595
596 #if MIN_VERSION_base(4,5,0)
597 copyByteArray# = GHC.Exts.copyByteArray#
598 #else
599 copyByteArray# src src_off dst dst_off len s =
600 unST_ (unsafeIOToST
601 (memcpy_ByteArray dst (clong dst_off) src (clong src_off) (csize len))) s
602 where
603 unST (ST st) = st
604 unST_ st s = case unST st s of (# s, _ #) -> s
605
606 foreign import ccall unsafe "fpstring.h fps_memcpy_offsets"
607 memcpy_ByteArray :: MutableByteArray# s -> CLong
608 -> ByteArray# -> CLong -> CSize -> IO ()
609 #endif
610
611 -- | /O(n)./ Construct a new @ShortByteString@ from a @CString@. The
612 -- resulting @ShortByteString@ is an immutable copy of the original
613 -- @CString@, and is managed on the Haskell heap. The original
614 -- @CString@ must be null terminated.
615 --
616 -- @since 0.10.10.0
617 packCString :: CString -> IO ShortByteString
618 packCString cstr = do
619 len <- c_strlen cstr
620 packCStringLen (cstr, fromIntegral len)
621
622 -- | /O(n)./ Construct a new @ShortByteString@ from a @CStringLen@. The
623 -- resulting @ShortByteString@ is an immutable copy of the original @CStringLen@.
624 -- The @ShortByteString@ is a normal Haskell value and will be managed on the
625 -- Haskell heap.
626 --
627 -- @since 0.10.10.0
628 packCStringLen :: CStringLen -> IO ShortByteString
629 packCStringLen (cstr, len) | len >= 0 = createFromPtr cstr len
630 packCStringLen (_, len) =
631 moduleErrorIO "packCStringLen" ("negative length: " ++ show len)
632
633 -- | /O(n) construction./ Use a @ShortByteString@ with a function requiring a
634 -- null-terminated @CString@. The @CString@ is a copy and will be freed
635 -- automatically; it must not be stored or used after the
636 -- subcomputation finishes.
637 --
638 -- @since 0.10.10.0
639 useAsCString :: ShortByteString -> (CString -> IO a) -> IO a
640 useAsCString bs action =
641 allocaBytes (l+1) $ \buf -> do
642 copyToPtr bs 0 buf (fromIntegral l)
643 pokeByteOff buf l (0::Word8)
644 action buf
645 where l = length bs
646
647 -- | /O(n) construction./ Use a @ShortByteString@ with a function requiring a @CStringLen@.
648 -- As for @useAsCString@ this function makes a copy of the original @ShortByteString@.
649 -- It must not be stored or used after the subcomputation finishes.
650 --
651 -- @since 0.10.10.0
652 useAsCStringLen :: ShortByteString -> (CStringLen -> IO a) -> IO a
653 useAsCStringLen bs action =
654 allocaBytes l $ \buf -> do
655 copyToPtr bs 0 buf (fromIntegral l)
656 action (buf, l)
657 where l = length bs
658
659 -- ---------------------------------------------------------------------
660 -- Internal utilities
661
662 moduleErrorIO :: String -> String -> IO a
663 moduleErrorIO fun msg = throwIO . userError $ moduleErrorMsg fun msg
664 {-# NOINLINE moduleErrorIO #-}
665
666 moduleErrorMsg :: String -> String -> String
667 moduleErrorMsg fun msg = "Data.ByteString.Short." ++ fun ++ ':':' ':msg