/usr/lib/hugs/packages/hugsbase/Hugs/ByteArray.hs is in hugs 98.200609.21-5.3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 | -- Mutable and immutable byte arrays (identical internally), usable for
-- unboxed arrays, and built from FFI primitives.
module Hugs.ByteArray (
MutableByteArray,
newMutableByteArray, readMutableByteArray, writeMutableByteArray,
ByteArray,
unsafeFreezeMutableByteArray, thawByteArray, readByteArray
) where
import Data.Word ( Word8 )
import Foreign.ForeignPtr ( ForeignPtr,
mallocForeignPtrBytes, withForeignPtr )
import Foreign.Marshal.Utils ( copyBytes )
import Foreign.Ptr ( castPtr )
import Foreign.Storable ( Storable( peekElemOff, pokeElemOff ))
import Hugs.IOExts ( unsafeCoerce )
import Hugs.ST ( ST, unsafeRunST )
-- This implementation is based on the principle that the FFI primitives
-- used, though declared as IO actions, actually only manipulate local
-- state, and thus could have been declared in the strict ST monad:
--
-- mallocForeignPtrBytes :: Int -> ST s (STForeignPtr s a)
-- withForeignPtr :: STForeignPtr s a -> (STPtr s a -> ST s b) -> ST s b
-- copyBytes :: STPtr s a -> STPtr s a -> Int -> ST s ()
-- castPtr :: STPtr s a -> STPtr s b
-- peekElemOff :: Storable a => STPtr s a -> Int -> ST s a
-- pokeElemOff :: Storable a => STPtr s a -> Int -> a -> ST s ()
--
-- (where STPtr s and STForeignPtr s are just like Ptr and ForeignPtr,
-- but confined to the region s)
--
-- Since the strict ST monad has the same representation as the IO monad,
-- we are justified in coercing such actions to the ST monad.
-- This conversion may be safely applied to computations that manipulate
-- only local state, but will give a runtime error if the IO action does
-- any concurrency.
specialIOToST :: IO a -> ST s a
specialIOToST = unsafeCoerce
type BytePtr = ForeignPtr Word8
data MutableByteArray s = MutableByteArray !Int !BytePtr
newMutableByteArray :: Int -> ST s (MutableByteArray s)
newMutableByteArray size = do
fp <- specialIOToST (mallocForeignPtrBytes size)
return (MutableByteArray size fp)
readMutableByteArray :: Storable e => MutableByteArray s -> Int -> ST s e
readMutableByteArray (MutableByteArray _ fp) i =
specialIOToST $ withForeignPtr fp $ \a -> peekElemOff (castPtr a) i
writeMutableByteArray :: Storable e => MutableByteArray s -> Int -> e -> ST s ()
writeMutableByteArray (MutableByteArray _ fp) i e =
specialIOToST $ withForeignPtr fp $ \a -> pokeElemOff (castPtr a) i e
data ByteArray = ByteArray !Int !BytePtr
-- Don't change the MutableByteArray after calling this.
unsafeFreezeMutableByteArray :: MutableByteArray s -> ST s ByteArray
unsafeFreezeMutableByteArray (MutableByteArray size fp) =
return (ByteArray size fp)
thawByteArray :: ByteArray -> ST s (MutableByteArray s)
thawByteArray (ByteArray size fp) = specialIOToST $ do
fp' <- mallocForeignPtrBytes size
withForeignPtr fp $ \p ->
withForeignPtr fp' $ \p' ->
copyBytes p' p size
return (MutableByteArray size fp')
-- This one is safe because ByteArrays are immutable
-- (cf. unsafeFreezeMutableByteArray)
readByteArray :: Storable a => ByteArray -> Int -> a
readByteArray (ByteArray _ fp) i = unsafeRunST $ specialIOToST $
withForeignPtr fp $ \p -> peekElemOff (castPtr p) i
|