blob: 7a0a5cce197b445c9c8fefdc756c25fb090e2f75 (
plain)
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
|
{-# language ForeignFunctionInterface #-}
{-# language GADTSyntax #-}
{-# language KindSignatures #-}
{-# language MagicHash #-}
{-# language UnboxedTuples #-}
{-# language UnliftedFFITypes #-}
{-# language UnliftedNewtypes #-}
{-# OPTIONS_GHC -O2 #-}
import Data.Kind (Type)
import Data.Word
import GHC.Exts
import GHC.IO
import GHC.Word
foreign import ccall unsafe "head_bytearray"
c_head_bytearray_a :: MutableByteArray# RealWorld -> IO Word8
foreign import ccall unsafe "head_bytearray"
c_head_bytearray_b :: MyArray# -> IO Word8
newtype MyArray# :: TYPE ('BoxedRep 'Unlifted) where
MyArray# :: MutableByteArray# RealWorld -> MyArray#
data MutableByteArray :: Type where
MutableByteArray :: MutableByteArray# RealWorld -> MutableByteArray
main :: IO ()
main = do
ba@(MutableByteArray ba#) <- luckySingleton
print =<< readByteArray ba 0
print =<< c_head_bytearray_a ba#
print =<< c_head_bytearray_b (MyArray# ba#)
readByteArray :: MutableByteArray -> Int -> IO Word8
readByteArray (MutableByteArray b#) (I# i#) = IO $ \s0 ->
case readWord8Array# b# i# s0 of
(# s1, w #) -> (# s1, W8# (narrowWord8# w) #)
-- Create a new mutable byte array of length 1 with the sole byte
-- set to the 105.
luckySingleton :: IO MutableByteArray
luckySingleton = IO $ \s0 -> case newByteArray# 1# s0 of
(# s1, marr# #) -> case writeWord8Array# marr# 0# 105## s1 of
s2 -> (# s2, MutableByteArray marr# #)
|
