Add setOffAddr#
[darcs-mirrors/primitive.git] / Data / Primitive / Types.hs
1 {-# LANGUAGE UnboxedTuples, MagicHash, DeriveDataTypeable #-}
2
3 -- |
4 -- Module : Data.Primitive.Types
5 -- Copyright : (c) Roman Leshchinskiy 2009-2010
6 -- License : BSD-style
7 --
8 -- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au>
9 -- Portability : non-portable
10 --
11 -- Basic types and classes for primitive array operations
12 --
13
14 module Data.Primitive.Types (
15 Prim(..),
16
17 Addr(..),
18 ) where
19
20 import Control.Monad.Primitive
21 import Data.Primitive.MachDeps
22 import Data.Primitive.Internal.Operations
23
24 import GHC.Base (
25 unsafeCoerce#,
26 Int(..), Char(..),
27 )
28 import GHC.Float (
29 Float(..), Double(..)
30 )
31 import GHC.Word (
32 Word(..), Word8(..), Word16(..), Word32(..), Word64(..)
33 )
34 import GHC.Int (
35 Int8(..), Int16(..), Int32(..), Int64(..)
36 )
37
38 import GHC.Prim
39
40 import Data.Typeable ( Typeable )
41 import Data.Data ( Data(..) )
42 import Data.Primitive.Internal.Compat ( mkNoRepType )
43
44 -- | A machine address
45 data Addr = Addr Addr# deriving ( Typeable )
46
47 instance Eq Addr where
48 Addr a# == Addr b# = eqAddr# a# b#
49 Addr a# /= Addr b# = neAddr# a# b#
50
51 instance Ord Addr where
52 Addr a# > Addr b# = gtAddr# a# b#
53 Addr a# >= Addr b# = geAddr# a# b#
54 Addr a# < Addr b# = ltAddr# a# b#
55 Addr a# <= Addr b# = leAddr# a# b#
56
57 instance Data Addr where
58 toConstr _ = error "toConstr"
59 gunfold _ _ = error "gunfold"
60 dataTypeOf _ = mkNoRepType "Data.Primitive.Types.Addr"
61
62
63 -- | Class of types supporting primitive array operations
64 class Prim a where
65
66 -- | Size of values of type @a@. The argument is not used.
67 sizeOf# :: a -> Int#
68
69 -- | Alignment of values of type @a@. The argument is not used.
70 alignment# :: a -> Int#
71
72 -- | Read a value from the array. The offset is in elements of type
73 -- @a@ rather than in bytes.
74 indexByteArray# :: ByteArray# -> Int# -> a
75
76 -- | Read a value from the mutable array. The offset is in elements of type
77 -- @a@ rather than in bytes.
78 readByteArray# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
79
80 -- | Write a value to the mutable array. The offset is in elements of type
81 -- @a@ rather than in bytes.
82 writeByteArray# :: MutableByteArray# s -> Int# -> a -> State# s -> State# s
83
84 -- | Fill a slice of the mutable array with a value. The offset and length
85 -- of the chunk are in elements of type @a@ rather than in bytes.
86 setByteArray# :: MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s
87
88 -- | Read a value from a memory position given by an address and an offset.
89 -- The memory block the address refers to must be immutable. The offset is in
90 -- elements of type @a@ rather than in bytes.
91 indexOffAddr# :: Addr# -> Int# -> a
92
93 -- | Read a value from a memory position given by an address and an offset.
94 -- The offset is in elements of type @a@ rather than in bytes.
95 readOffAddr# :: Addr# -> Int# -> State# s -> (# State# s, a #)
96
97 -- | Write a value to a memory position given by an address and an offset.
98 -- The offset is in elements of type @a@ rather than in bytes.
99 writeOffAddr# :: Addr# -> Int# -> a -> State# s -> State# s
100
101 -- | Fill a memory block given by an address, an offset and a length.
102 -- The offset and length are in elements of type @a@ rather than in bytes.
103 setOffAddr# :: Addr# -> Int# -> Int# -> a -> State# s -> State# s
104
105 #define derivePrim(ty, ctr, sz, align, idx_arr, rd_arr, wr_arr, set_arr, idx_addr, rd_addr, wr_addr, set_addr) \
106 instance Prim ty where { \
107 sizeOf# _ = unI# sz \
108 ; alignment# _ = unI# align \
109 ; indexByteArray# arr# i# = ctr (idx_arr arr# i#) \
110 ; readByteArray# arr# i# s# = case rd_arr arr# i# s# of \
111 { (# s1#, x# #) -> (# s1#, ctr x# #) } \
112 ; writeByteArray# arr# i# (ctr x#) s# = wr_arr arr# i# x# s# \
113 ; setByteArray# arr# i# n# (ctr x#) s# \
114 = case internal (set_arr arr# i# n# x#) (unsafeCoerce# s#) of \
115 { (# s1#, _ #) -> unsafeCoerce# s1# } \
116 \
117 ; indexOffAddr# addr# i# = ctr (idx_addr addr# i#) \
118 ; readOffAddr# addr# i# s# = case rd_addr addr# i# s# of \
119 { (# s1#, x# #) -> (# s1#, ctr x# #) } \
120 ; writeOffAddr# addr# i# (ctr x#) s# = wr_addr addr# i# x# s# \
121 ; setOffAddr# addr# i# n# (ctr x#) s# \
122 = case internal (set_addr addr# i# n# x#) (unsafeCoerce# s#) of \
123 { (# s1#, _ #) -> unsafeCoerce# s1# } \
124 ; {-# INLINE sizeOf# #-} \
125 ; {-# INLINE alignment# #-} \
126 ; {-# INLINE indexByteArray# #-} \
127 ; {-# INLINE readByteArray# #-} \
128 ; {-# INLINE writeByteArray# #-} \
129 ; {-# INLINE setByteArray# #-} \
130 ; {-# INLINE indexOffAddr# #-} \
131 ; {-# INLINE readOffAddr# #-} \
132 ; {-# INLINE writeOffAddr# #-} \
133 ; {-# INLINE setOffAddr# #-} \
134 }
135
136 unI# :: Int -> Int#
137 unI# (I# n#) = n#
138
139 derivePrim(Word, W#, sIZEOF_WORD, aLIGNMENT_WORD,
140 indexWordArray#, readWordArray#, writeWordArray#, setWordArray#,
141 indexWordOffAddr#, readWordOffAddr#, writeWordOffAddr#, setWordOffAddr#)
142 derivePrim(Word8, W8#, sIZEOF_WORD8, aLIGNMENT_WORD8,
143 indexWord8Array#, readWord8Array#, writeWord8Array#, setWord8Array#,
144 indexWord8OffAddr#, readWord8OffAddr#, writeWord8OffAddr#, setWord8OffAddr#)
145 derivePrim(Word16, W16#, sIZEOF_WORD16, aLIGNMENT_WORD16,
146 indexWord16Array#, readWord16Array#, writeWord16Array#, setWord16Array#,
147 indexWord16OffAddr#, readWord16OffAddr#, writeWord16OffAddr#, setWord16OffAddr#)
148 derivePrim(Word32, W32#, sIZEOF_WORD32, aLIGNMENT_WORD32,
149 indexWord32Array#, readWord32Array#, writeWord32Array#, setWord32Array#,
150 indexWord32OffAddr#, readWord32OffAddr#, writeWord32OffAddr#, setWord32OffAddr#)
151 derivePrim(Word64, W64#, sIZEOF_WORD64, aLIGNMENT_WORD64,
152 indexWord64Array#, readWord64Array#, writeWord64Array#, setWord64Array#,
153 indexWord64OffAddr#, readWord64OffAddr#, writeWord64OffAddr#, setWord64OffAddr#)
154 derivePrim(Int, I#, sIZEOF_INT, aLIGNMENT_INT,
155 indexIntArray#, readIntArray#, writeIntArray#, setIntArray#,
156 indexIntOffAddr#, readIntOffAddr#, writeIntOffAddr#, setIntOffAddr#)
157 derivePrim(Int8, I8#, sIZEOF_INT8, aLIGNMENT_INT8,
158 indexInt8Array#, readInt8Array#, writeInt8Array#, setInt8Array#,
159 indexInt8OffAddr#, readInt8OffAddr#, writeInt8OffAddr#, setInt8OffAddr#)
160 derivePrim(Int16, I16#, sIZEOF_INT16, aLIGNMENT_INT16,
161 indexInt16Array#, readInt16Array#, writeInt16Array#, setInt16Array#,
162 indexInt16OffAddr#, readInt16OffAddr#, writeInt16OffAddr#, setInt16OffAddr#)
163 derivePrim(Int32, I32#, sIZEOF_INT32, aLIGNMENT_INT32,
164 indexInt32Array#, readInt32Array#, writeInt32Array#, setInt32Array#,
165 indexInt32OffAddr#, readInt32OffAddr#, writeInt32OffAddr#, setInt32OffAddr#)
166 derivePrim(Int64, I64#, sIZEOF_INT64, aLIGNMENT_INT64,
167 indexInt64Array#, readInt64Array#, writeInt64Array#, setInt64Array#,
168 indexInt64OffAddr#, readInt64OffAddr#, writeInt64OffAddr#, setInt64OffAddr#)
169 derivePrim(Float, F#, sIZEOF_FLOAT, aLIGNMENT_FLOAT,
170 indexFloatArray#, readFloatArray#, writeFloatArray#, setFloatArray#,
171 indexFloatOffAddr#, readFloatOffAddr#, writeFloatOffAddr#, setFloatOffAddr#)
172 derivePrim(Double, D#, sIZEOF_DOUBLE, aLIGNMENT_DOUBLE,
173 indexDoubleArray#, readDoubleArray#, writeDoubleArray#, setDoubleArray#,
174 indexDoubleOffAddr#, readDoubleOffAddr#, writeDoubleOffAddr#, setDoubleOffAddr#)
175 derivePrim(Char, C#, sIZEOF_CHAR, aLIGNMENT_CHAR,
176 indexWideCharArray#, readWideCharArray#, writeWideCharArray#, setWideCharArray#,
177 indexWideCharOffAddr#, readWideCharOffAddr#, writeWideCharOffAddr#, setWideCharOffAddr#)
178 derivePrim(Addr, Addr, sIZEOF_PTR, aLIGNMENT_PTR,
179 indexAddrArray#, readAddrArray#, writeAddrArray#, setAddrArray#,
180 indexAddrOffAddr#, readAddrOffAddr#, writeAddrOffAddr#, setAddrOffAddr#)
181