module GHC.Unboxed where
import GHC.ST ( ST(..))
import GHC.IOBase ( IO(..) )
import GHC.Base
import GHC.Word ( Word(..) )
import GHC.Ptr ( Ptr(..), FunPtr(..) )
import GHC.Float ( Float(..), Double(..) )
import GHC.Stable ( StablePtr(..) )
import GHC.Int ( Int8(..), Int16(..), Int32(..), Int64(..) )
import GHC.Word ( Word8(..), Word16(..), Word32(..), Word64(..) )
import Control.Monad.ST.Lazy ( strictToLazyST )
import qualified Control.Monad.ST.Lazy as Lazy (ST)
import Foreign.Storable
class (Monad m) => STorIO m s | m->s where
mLift :: (State# s -> (# State# s, a #)) -> m a
instance STorIO (ST s) s where
mLift = ST
instance STorIO (Lazy.ST s) s where
mLift = strictToLazyST . ST
instance STorIO IO RealWorld where
mLift = IO
type IOSpecific (a :: * -> *) = a RealWorld
type IOSpecific2 (a :: * -> * -> *) = a RealWorld
type IOSpecific3 (a :: * -> * -> * -> *) = a RealWorld
data UVec a = UVec ByteArray#
data MUVec s a = MUVec (MutableByteArray# s)
allocUnboxedBytes :: (STorIO m s, Integral bytes, Unboxed a)
=> bytes -> m (MUVec s a)
allocUnboxedBytes bytes = mLift ( \s ->
case newByteArray# (fromI# bytes) s of { (# t, arr #) ->
(# t, MUVec arr #) } )
unsafeFreezeUnboxed :: (STorIO m s) => MUVec s a -> m (UVec a)
unsafeFreezeUnboxed (MUVec marr#) = mLift ( \s ->
case unsafeFreezeByteArray# marr# s of { (# t, arr# #) ->
(# t, UVec arr# #) } )
unsafeThawUnboxed :: (STorIO m s) => UVec a -> m (MUVec s a)
unsafeThawUnboxed (UVec arr#) = mLift ( \s ->
(# s, MUVec (unsafeCoerce# arr#) #) )
freezeUnboxed :: (STorIO m s) => MUVec s a -> Int -> m (UVec a)
freezeUnboxed (MUVec marr#) (I# size) = mLift ( \s1# ->
case newByteArray# size s1# of { (# s2#, tmparr# #) ->
case unsafeCoerce# memcpy tmparr# marr# size s2# of { (# s3#, () #) ->
case unsafeFreezeByteArray# tmparr# s3# of { (# _, arr# #) ->
(# s3#, UVec arr# #) }}} )
thawUnboxed :: (STorIO m s) => UVec a -> Int -> m (MUVec s a)
thawUnboxed (UVec arr#) (I# size) = mLift ( \s1# ->
case newByteArray# size s1# of { (# s2#, marr# #) ->
case unsafeCoerce# memcpy marr# arr# size s2# of { (# s3#, () #) ->
(# s3#, MUVec marr# #) }} )
castUnboxed :: UVec a -> UVec b
castUnboxed (UVec vec) = UVec vec
castMUnboxed :: MUVec s a -> MUVec s b
castMUnboxed (MUVec mvec) = MUVec mvec
fromI# :: (Integral n) => n -> Int#
fromI# n = n# where I# n# = fromIntegral n
foreign import ccall unsafe "memcpy"
memcpy :: MutableByteArray# RealWorld -> ByteArray# -> Int# -> IO ()
class Unboxed value where
readUnboxed :: (STorIO m s, Integral index) => MUVec s value -> index -> m value
writeUnboxed :: (STorIO m s, Integral index) => MUVec s value -> index -> value -> m ()
indexUnboxed :: (Integral index) => UVec value -> index -> value
sizeOfUnboxed :: value -> Int
instance Unboxed Bool where
{
;
readUnboxed (MUVec arr) index = mLift ( \s ->
case readInt8Array# arr (fromI# index) s of { (# t, value# #) ->
(# t, tagToEnum# value# #) } );
;
writeUnboxed (MUVec arr) index value = mLift ( \s ->
case writeInt8Array# arr (fromI# index) (getTag value) s of { t ->
(# t, () #) } );
;
indexUnboxed (UVec arr) index = tagToEnum# (indexInt8Array# arr (fromI# index));
;
sizeOfUnboxed _ = 1;
}
#define InstanceUnboxed(type, cast, read, write, at) \
instance Unboxed type where \
{ \
; \
readUnboxed (MUVec arr) index = mLift ( \s -> \
case read arr (fromI# index) s of { (# t, value# #) -> \
(# t, cast value# #) } ); \
\
; \
writeUnboxed (MUVec arr) index (cast value#) = mLift ( \s -> \
case write arr (fromI# index) value# s of { t -> \
(# t, () #) } ); \
\
; \
indexUnboxed (UVec arr) index = cast (at arr (fromI# index)); \
\
; \
sizeOfUnboxed = sizeOf; \
} \
InstanceUnboxed( Char, C#, readWideCharArray#, writeWideCharArray#, indexWideCharArray#)
InstanceUnboxed( Int, I#, readIntArray#, writeIntArray#, indexIntArray#)
InstanceUnboxed( Int8, I8#, readInt8Array#, writeInt8Array#, indexInt8Array#)
InstanceUnboxed( Int16, I16#, readInt16Array#, writeInt16Array#, indexInt16Array#)
InstanceUnboxed( Int32, I32#, readInt32Array#, writeInt32Array#, indexInt32Array#)
InstanceUnboxed( Int64, I64#, readInt64Array#, writeInt64Array#, indexInt64Array#)
InstanceUnboxed( Word, W#, readWordArray#, writeWordArray#, indexWordArray#)
InstanceUnboxed( Word8, W8#, readWord8Array#, writeWord8Array#, indexWord8Array#)
InstanceUnboxed( Word16, W16#, readWord16Array#, writeWord16Array#, indexWord16Array#)
InstanceUnboxed( Word32, W32#, readWord32Array#, writeWord32Array#, indexWord32Array#)
InstanceUnboxed( Word64, W64#, readWord64Array#, writeWord64Array#, indexWord64Array#)
InstanceUnboxed( Float, F#, readFloatArray#, writeFloatArray#, indexFloatArray#)
InstanceUnboxed( Double, D#, readDoubleArray#, writeDoubleArray#, indexDoubleArray#)
InstanceUnboxed( (Ptr a), Ptr, readAddrArray#, writeAddrArray#, indexAddrArray#)
InstanceUnboxed( (FunPtr a), FunPtr, readAddrArray#, writeAddrArray#, indexAddrArray#)
InstanceUnboxed( (StablePtr a), StablePtr, readStablePtrArray#, writeStablePtrArray#, indexStablePtrArray#)