1 % -----------------------------------------------------------------------------
2 % $Id: PrelStorable.lhs,v 1.6 2001/04/14 22:28:22 qrczak Exp $
4 % (c) The FFI task force, 2000
7 A class for primitive marshaling
14 sizeOf, -- :: a -> Int
15 alignment, -- :: a -> Int
16 peekElemOff, -- :: Ptr a -> Int -> IO a
17 pokeElemOff, -- :: Ptr a -> Int -> a -> IO ()
18 peekByteOff, -- :: Ptr b -> Int -> IO a
19 pokeByteOff, -- :: Ptr b -> Int -> a -> IO ()
20 peek, -- :: Ptr a -> IO a
21 poke, -- :: Ptr a -> a -> IO ()
22 destruct) -- :: Ptr a -> IO ()
27 import Monad ( liftM )
29 #ifdef __GLASGOW_HASKELL__
30 import PrelStable ( StablePtr )
45 Minimal complete definition: sizeOf, alignment, and one definition
46 in each of the peek/poke families.
49 class Storable a where
51 -- sizeOf/alignment *never* use their first argument
55 -- replacement for read-/write???OffAddr
56 peekElemOff :: Ptr a -> Int -> IO a
57 pokeElemOff :: Ptr a -> Int -> a -> IO ()
59 -- the same with *byte* offsets
60 peekByteOff :: Ptr b -> Int -> IO a
61 pokeByteOff :: Ptr b -> Int -> a -> IO ()
63 -- ... and with no offsets at all
65 poke :: Ptr a -> a -> IO ()
67 -- free memory associated with the object
68 -- (except the object pointer itself)
69 destruct :: Ptr a -> IO ()
71 -- circular default instances
72 peekElemOff = peekElemOff_ undefined
73 where peekElemOff_ :: a -> Ptr a -> Int -> IO a
74 peekElemOff_ undef ptr off = peekByteOff ptr (off * sizeOf undef)
75 pokeElemOff ptr off val = pokeByteOff ptr (off * sizeOf val) val
77 peekByteOff ptr off = peek (ptr `plusPtr` off)
78 pokeByteOff ptr off = poke (ptr `plusPtr` off)
80 peek ptr = peekElemOff ptr 0
81 poke ptr = pokeElemOff ptr 0
83 destruct _ = return ()
86 System-dependent, but rather obvious instances
89 instance Storable Bool where
90 sizeOf _ = sizeOf (undefined::CInt)
91 alignment _ = alignment (undefined::CInt)
92 peekElemOff p i = liftM (/= (0::CInt)) $ peekElemOff (castPtr p) i
93 pokeElemOff p i x = pokeElemOff (castPtr p) i (if x then 1 else 0::CInt)
95 #define STORABLE(T,size,align,read,write) \
96 instance Storable (T) where { \
98 alignment _ = align; \
100 pokeElemOff = write }
102 STORABLE(Char,SIZEOF_INT32,ALIGNMENT_INT32,
103 readWideCharOffPtr,writeWideCharOffPtr)
105 STORABLE(Int,SIZEOF_LONG,ALIGNMENT_LONG,
106 readIntOffPtr,writeIntOffPtr)
108 STORABLE(Word,SIZEOF_LONG,ALIGNMENT_LONG,
109 readWordOffPtr,writeWordOffPtr)
111 STORABLE((Ptr a),SIZEOF_VOID_P,ALIGNMENT_VOID_P,
112 readPtrOffPtr,writePtrOffPtr)
114 STORABLE((FunPtr a),SIZEOF_VOID_P,ALIGNMENT_VOID_P,
115 readFunPtrOffPtr,writeFunPtrOffPtr)
117 STORABLE((StablePtr a),SIZEOF_VOID_P,ALIGNMENT_VOID_P,
118 readStablePtrOffPtr,writeStablePtrOffPtr)
120 STORABLE(Float,SIZEOF_FLOAT,ALIGNMENT_FLOAT,
121 readFloatOffPtr,writeFloatOffPtr)
123 STORABLE(Double,SIZEOF_DOUBLE,ALIGNMENT_DOUBLE,
124 readDoubleOffPtr,writeDoubleOffPtr)
126 STORABLE(Word8,SIZEOF_WORD8,ALIGNMENT_WORD8,
127 readWord8OffPtr,writeWord8OffPtr)
129 STORABLE(Word16,SIZEOF_WORD16,ALIGNMENT_WORD16,
130 readWord16OffPtr,writeWord16OffPtr)
132 STORABLE(Word32,SIZEOF_WORD32,ALIGNMENT_WORD32,
133 readWord32OffPtr,writeWord32OffPtr)
135 STORABLE(Word64,SIZEOF_WORD64,ALIGNMENT_WORD64,
136 readWord64OffPtr,writeWord64OffPtr)
138 STORABLE(Int8,SIZEOF_INT8,ALIGNMENT_INT8,
139 readInt8OffPtr,writeInt8OffPtr)
141 STORABLE(Int16,SIZEOF_INT16,ALIGNMENT_INT16,
142 readInt16OffPtr,writeInt16OffPtr)
144 STORABLE(Int32,SIZEOF_INT32,ALIGNMENT_INT32,
145 readInt32OffPtr,writeInt32OffPtr)
147 STORABLE(Int64,SIZEOF_INT64,ALIGNMENT_INT64,
148 readInt64OffPtr,writeInt64OffPtr)
150 #define NSTORABLE(T) \
151 instance Storable T where { \
152 sizeOf (T x) = sizeOf x ; \
153 alignment (T x) = alignment x ; \
154 peekElemOff a i = liftM T (peekElemOff (castPtr a) i) ; \
155 pokeElemOff a i (T x) = pokeElemOff (castPtr a) i x }
174 NSTORABLE(CSigAtomic)
182 #ifdef __GLASGOW_HASKELL__
184 readWideCharOffPtr :: Ptr Char -> Int -> IO Char
185 readIntOffPtr :: Ptr Int -> Int -> IO Int
186 readWordOffPtr :: Ptr Word -> Int -> IO Word
187 readPtrOffPtr :: Ptr (Ptr a) -> Int -> IO (Ptr a)
188 readFunPtrOffPtr :: Ptr (FunPtr a) -> Int -> IO (FunPtr a)
189 readFloatOffPtr :: Ptr Float -> Int -> IO Float
190 readDoubleOffPtr :: Ptr Double -> Int -> IO Double
191 readStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> IO (StablePtr a)
192 readInt8OffPtr :: Ptr Int8 -> Int -> IO Int8
193 readInt16OffPtr :: Ptr Int16 -> Int -> IO Int16
194 readInt32OffPtr :: Ptr Int32 -> Int -> IO Int32
195 readInt64OffPtr :: Ptr Int64 -> Int -> IO Int64
196 readWord8OffPtr :: Ptr Word8 -> Int -> IO Word8
197 readWord16OffPtr :: Ptr Word16 -> Int -> IO Word16
198 readWord32OffPtr :: Ptr Word32 -> Int -> IO Word32
199 readWord64OffPtr :: Ptr Word64 -> Int -> IO Word64
201 readWideCharOffPtr (Ptr a) (I# i)
202 = IO $ \s -> case readWideCharOffAddr# a i s of (# s2, x #) -> (# s2, C# x #)
203 readIntOffPtr (Ptr a) (I# i)
204 = IO $ \s -> case readIntOffAddr# a i s of (# s2, x #) -> (# s2, I# x #)
205 readWordOffPtr (Ptr a) (I# i)
206 = IO $ \s -> case readWordOffAddr# a i s of (# s2, x #) -> (# s2, W# x #)
207 readPtrOffPtr (Ptr a) (I# i)
208 = IO $ \s -> case readAddrOffAddr# a i s of (# s2, x #) -> (# s2, Ptr x #)
209 readFunPtrOffPtr (Ptr a) (I# i)
210 = IO $ \s -> case readAddrOffAddr# a i s of (# s2, x #) -> (# s2, FunPtr x #)
211 readFloatOffPtr (Ptr a) (I# i)
212 = IO $ \s -> case readFloatOffAddr# a i s of (# s2, x #) -> (# s2, F# x #)
213 readDoubleOffPtr (Ptr a) (I# i)
214 = IO $ \s -> case readDoubleOffAddr# a i s of (# s2, x #) -> (# s2, D# x #)
215 readStablePtrOffPtr (Ptr a) (I# i)
216 = IO $ \s -> case readStablePtrOffAddr# a i s of (# s2, x #) -> (# s2, StablePtr x #)
217 readInt8OffPtr (Ptr a) (I# i)
218 = IO $ \s -> case readInt8OffAddr# a i s of (# s2, x #) -> (# s2, I8# x #)
219 readInt16OffPtr (Ptr a) (I# i)
220 = IO $ \s -> case readInt16OffAddr# a i s of (# s2, x #) -> (# s2, I16# x #)
221 readInt32OffPtr (Ptr a) (I# i)
222 = IO $ \s -> case readInt32OffAddr# a i s of (# s2, x #) -> (# s2, I32# x #)
223 readInt64OffPtr (Ptr a) (I# i)
224 = IO $ \s -> case readInt64OffAddr# a i s of (# s2, x #) -> (# s2, I64# x #)
225 readWord8OffPtr (Ptr a) (I# i)
226 = IO $ \s -> case readWord8OffAddr# a i s of (# s2, x #) -> (# s2, W8# x #)
227 readWord16OffPtr (Ptr a) (I# i)
228 = IO $ \s -> case readWord16OffAddr# a i s of (# s2, x #) -> (# s2, W16# x #)
229 readWord32OffPtr (Ptr a) (I# i)
230 = IO $ \s -> case readWord32OffAddr# a i s of (# s2, x #) -> (# s2, W32# x #)
231 readWord64OffPtr (Ptr a) (I# i)
232 = IO $ \s -> case readWord64OffAddr# a i s of (# s2, x #) -> (# s2, W64# x #)
234 writeWideCharOffPtr :: Ptr Char -> Int -> Char -> IO ()
235 writeIntOffPtr :: Ptr Int -> Int -> Int -> IO ()
236 writeWordOffPtr :: Ptr Word -> Int -> Word -> IO ()
237 writePtrOffPtr :: Ptr (Ptr a) -> Int -> Ptr a -> IO ()
238 writeFunPtrOffPtr :: Ptr (FunPtr a) -> Int -> FunPtr a -> IO ()
239 writeFloatOffPtr :: Ptr Float -> Int -> Float -> IO ()
240 writeDoubleOffPtr :: Ptr Double -> Int -> Double -> IO ()
241 writeStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> StablePtr a -> IO ()
242 writeInt8OffPtr :: Ptr Int8 -> Int -> Int8 -> IO ()
243 writeInt16OffPtr :: Ptr Int16 -> Int -> Int16 -> IO ()
244 writeInt32OffPtr :: Ptr Int32 -> Int -> Int32 -> IO ()
245 writeInt64OffPtr :: Ptr Int64 -> Int -> Int64 -> IO ()
246 writeWord8OffPtr :: Ptr Word8 -> Int -> Word8 -> IO ()
247 writeWord16OffPtr :: Ptr Word16 -> Int -> Word16 -> IO ()
248 writeWord32OffPtr :: Ptr Word32 -> Int -> Word32 -> IO ()
249 writeWord64OffPtr :: Ptr Word64 -> Int -> Word64 -> IO ()
251 writeWideCharOffPtr (Ptr a) (I# i) (C# x)
252 = IO $ \s -> case writeWideCharOffAddr# a i x s of s2 -> (# s2, () #)
253 writeIntOffPtr (Ptr a) (I# i) (I# x)
254 = IO $ \s -> case writeIntOffAddr# a i x s of s2 -> (# s2, () #)
255 writeWordOffPtr (Ptr a) (I# i) (W# x)
256 = IO $ \s -> case writeWordOffAddr# a i x s of s2 -> (# s2, () #)
257 writePtrOffPtr (Ptr a) (I# i) (Ptr x)
258 = IO $ \s -> case writeAddrOffAddr# a i x s of s2 -> (# s2, () #)
259 writeFunPtrOffPtr (Ptr a) (I# i) (FunPtr x)
260 = IO $ \s -> case writeAddrOffAddr# a i x s of s2 -> (# s2, () #)
261 writeFloatOffPtr (Ptr a) (I# i) (F# x)
262 = IO $ \s -> case writeFloatOffAddr# a i x s of s2 -> (# s2, () #)
263 writeDoubleOffPtr (Ptr a) (I# i) (D# x)
264 = IO $ \s -> case writeDoubleOffAddr# a i x s of s2 -> (# s2, () #)
265 writeStablePtrOffPtr (Ptr a) (I# i) (StablePtr x)
266 = IO $ \s -> case writeStablePtrOffAddr# a i x s of s2 -> (# s2 , () #)
267 writeInt8OffPtr (Ptr a) (I# i) (I8# x)
268 = IO $ \s -> case writeInt8OffAddr# a i x s of s2 -> (# s2, () #)
269 writeInt16OffPtr (Ptr a) (I# i) (I16# x)
270 = IO $ \s -> case writeInt16OffAddr# a i x s of s2 -> (# s2, () #)
271 writeInt32OffPtr (Ptr a) (I# i) (I32# x)
272 = IO $ \s -> case writeInt32OffAddr# a i x s of s2 -> (# s2, () #)
273 writeInt64OffPtr (Ptr a) (I# i) (I64# x)
274 = IO $ \s -> case writeInt64OffAddr# a i x s of s2 -> (# s2, () #)
275 writeWord8OffPtr (Ptr a) (I# i) (W8# x)
276 = IO $ \s -> case writeWord8OffAddr# a i x s of s2 -> (# s2, () #)
277 writeWord16OffPtr (Ptr a) (I# i) (W16# x)
278 = IO $ \s -> case writeWord16OffAddr# a i x s of s2 -> (# s2, () #)
279 writeWord32OffPtr (Ptr a) (I# i) (W32# x)
280 = IO $ \s -> case writeWord32OffAddr# a i x s of s2 -> (# s2, () #)
281 writeWord64OffPtr (Ptr a) (I# i) (W64# x)
282 = IO $ \s -> case writeWord64OffAddr# a i x s of s2 -> (# s2, () #)
284 #endif /* __GLASGOW_HASKELL__ */