[project @ 2001-12-21 15:07:20 by simonmar]
[packages/base.git] / GHC / Storable.lhs
1 % -----------------------------------------------------------------------------
2 % $Id: Storable.lhs,v 1.3 2001/12/21 15:07:25 simonmar Exp $
3 %
4 % (c) The FFI task force, 2000
5 %
6
7 A class for primitive marshaling
8
9 \begin{code}
10 {-# OPTIONS -fno-implicit-prelude -monly-3-regs #-}
11
12 #include "MachDeps.h"
13
14 module GHC.Storable
15         ( Storable(
16              sizeOf,         -- :: a -> Int
17              alignment,      -- :: a -> Int
18              peekElemOff,    -- :: Ptr a -> Int      -> IO a
19              pokeElemOff,    -- :: Ptr a -> Int -> a -> IO ()
20              peekByteOff,    -- :: Ptr b -> Int      -> IO a
21              pokeByteOff,    -- :: Ptr b -> Int -> a -> IO ()
22              peek,           -- :: Ptr a             -> IO a
23              poke,           -- :: Ptr a        -> a -> IO ()
24              destruct)       -- :: Ptr a             -> IO ()
25         ) where
26 \end{code}
27
28 \begin{code}
29 import Control.Monad            ( liftM )
30 import Foreign.C.Types
31 import Foreign.C.TypesISO
32
33 #ifdef __GLASGOW_HASKELL__
34 import GHC.Stable       ( StablePtr )
35 import GHC.Num
36 import GHC.Int
37 import GHC.Word
38 import GHC.Stable
39 import Foreign.Ptr
40 import GHC.Float
41 import GHC.Err
42 import GHC.IOBase
43 import GHC.Base
44 #endif
45 \end{code}
46
47 Primitive marshaling
48
49 Minimal complete definition: sizeOf, alignment, and one definition
50 in each of the peek/poke families.
51
52 \begin{code}
53 class Storable a where
54
55    -- sizeOf/alignment *never* use their first argument
56    sizeOf      :: a -> Int
57    alignment   :: a -> Int
58
59    -- replacement for read-/write???OffAddr
60    peekElemOff :: Ptr a -> Int      -> IO a
61    pokeElemOff :: Ptr a -> Int -> a -> IO ()
62
63    -- the same with *byte* offsets
64    peekByteOff :: Ptr b -> Int      -> IO a
65    pokeByteOff :: Ptr b -> Int -> a -> IO ()
66
67    -- ... and with no offsets at all
68    peek        :: Ptr a      -> IO a
69    poke        :: Ptr a -> a -> IO ()
70
71    -- free memory associated with the object
72    -- (except the object pointer itself)
73    destruct    :: Ptr a -> IO ()
74
75    -- circular default instances
76    peekElemOff = peekElemOff_ undefined
77       where peekElemOff_ :: a -> Ptr a -> Int -> IO a
78             peekElemOff_ undef ptr off = peekByteOff ptr (off * sizeOf undef)
79    pokeElemOff ptr off val = pokeByteOff ptr (off * sizeOf val) val
80
81    peekByteOff ptr off = peek (ptr `plusPtr` off)
82    pokeByteOff ptr off = poke (ptr `plusPtr` off)
83
84    peek ptr = peekElemOff ptr 0
85    poke ptr = pokeElemOff ptr 0
86
87    destruct _ = return ()
88 \end{code}
89
90 System-dependent, but rather obvious instances
91
92 \begin{code}
93 instance Storable Bool where
94    sizeOf _          = sizeOf (undefined::CInt)
95    alignment _       = alignment (undefined::CInt)
96    peekElemOff p i   = liftM (/= (0::CInt)) $ peekElemOff (castPtr p) i
97    pokeElemOff p i x = pokeElemOff (castPtr p) i (if x then 1 else 0::CInt)
98
99 #define STORABLE(T,size,align,read,write)       \
100 instance Storable (T) where {                   \
101     sizeOf    _ = size;                         \
102     alignment _ = align;                        \
103     peekElemOff = read;                         \
104     pokeElemOff = write }
105
106 STORABLE(Char,SIZEOF_INT32,ALIGNMENT_INT32,
107          readWideCharOffPtr,writeWideCharOffPtr)
108
109 STORABLE(Int,SIZEOF_HSINT,ALIGNMENT_HSINT,
110          readIntOffPtr,writeIntOffPtr)
111
112 STORABLE(Word,SIZEOF_HSWORD,ALIGNMENT_HSWORD,
113          readWordOffPtr,writeWordOffPtr)
114
115 STORABLE((Ptr a),SIZEOF_HSPTR,ALIGNMENT_HSPTR,
116          readPtrOffPtr,writePtrOffPtr)
117
118 STORABLE((FunPtr a),SIZEOF_HSFUNPTR,ALIGNMENT_HSFUNPTR,
119          readFunPtrOffPtr,writeFunPtrOffPtr)
120
121 STORABLE((StablePtr a),SIZEOF_HSSTABLEPTR,ALIGNMENT_HSSTABLEPTR,
122          readStablePtrOffPtr,writeStablePtrOffPtr)
123
124 STORABLE(Float,SIZEOF_HSFLOAT,ALIGNMENT_HSFLOAT,
125          readFloatOffPtr,writeFloatOffPtr)
126
127 STORABLE(Double,SIZEOF_HSDOUBLE,ALIGNMENT_HSDOUBLE,
128          readDoubleOffPtr,writeDoubleOffPtr)
129
130 STORABLE(Word8,SIZEOF_WORD8,ALIGNMENT_WORD8,
131          readWord8OffPtr,writeWord8OffPtr)
132
133 STORABLE(Word16,SIZEOF_WORD16,ALIGNMENT_WORD16,
134          readWord16OffPtr,writeWord16OffPtr)
135
136 STORABLE(Word32,SIZEOF_WORD32,ALIGNMENT_WORD32,
137          readWord32OffPtr,writeWord32OffPtr)
138
139 STORABLE(Word64,SIZEOF_WORD64,ALIGNMENT_WORD64,
140          readWord64OffPtr,writeWord64OffPtr)
141
142 STORABLE(Int8,SIZEOF_INT8,ALIGNMENT_INT8,
143          readInt8OffPtr,writeInt8OffPtr)
144
145 STORABLE(Int16,SIZEOF_INT16,ALIGNMENT_INT16,
146          readInt16OffPtr,writeInt16OffPtr)
147
148 STORABLE(Int32,SIZEOF_INT32,ALIGNMENT_INT32,
149          readInt32OffPtr,writeInt32OffPtr)
150
151 STORABLE(Int64,SIZEOF_INT64,ALIGNMENT_INT64,
152          readInt64OffPtr,writeInt64OffPtr)
153
154 #define NSTORABLE(T) \
155 instance Storable T where { \
156    sizeOf    (T x)       = sizeOf x ; \
157    alignment (T x)       = alignment x ; \
158    peekElemOff a i       = liftM T (peekElemOff (castPtr a) i) ; \
159    pokeElemOff a i (T x) = pokeElemOff (castPtr a) i x }
160
161 NSTORABLE(CChar)
162 NSTORABLE(CSChar)
163 NSTORABLE(CUChar)
164 NSTORABLE(CShort)
165 NSTORABLE(CUShort)
166 NSTORABLE(CInt)
167 NSTORABLE(CUInt)
168 NSTORABLE(CLong)
169 NSTORABLE(CULong)
170 NSTORABLE(CLLong)
171 NSTORABLE(CULLong)
172 NSTORABLE(CFloat)
173 NSTORABLE(CDouble)
174 NSTORABLE(CLDouble)
175 NSTORABLE(CPtrdiff)
176 NSTORABLE(CSize)
177 NSTORABLE(CWchar)
178 NSTORABLE(CSigAtomic)
179 NSTORABLE(CClock)
180 NSTORABLE(CTime)
181 \end{code}
182
183 Helper functions
184
185 \begin{code}
186 #ifdef __GLASGOW_HASKELL__
187
188 readWideCharOffPtr  :: Ptr Char          -> Int -> IO Char
189 readIntOffPtr       :: Ptr Int           -> Int -> IO Int
190 readWordOffPtr      :: Ptr Word          -> Int -> IO Word
191 readPtrOffPtr       :: Ptr (Ptr a)       -> Int -> IO (Ptr a)
192 readFunPtrOffPtr    :: Ptr (FunPtr a)    -> Int -> IO (FunPtr a)
193 readFloatOffPtr     :: Ptr Float         -> Int -> IO Float
194 readDoubleOffPtr    :: Ptr Double        -> Int -> IO Double
195 readStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> IO (StablePtr a)
196 readInt8OffPtr      :: Ptr Int8          -> Int -> IO Int8
197 readInt16OffPtr     :: Ptr Int16         -> Int -> IO Int16
198 readInt32OffPtr     :: Ptr Int32         -> Int -> IO Int32
199 readInt64OffPtr     :: Ptr Int64         -> Int -> IO Int64
200 readWord8OffPtr     :: Ptr Word8         -> Int -> IO Word8
201 readWord16OffPtr    :: Ptr Word16        -> Int -> IO Word16
202 readWord32OffPtr    :: Ptr Word32        -> Int -> IO Word32
203 readWord64OffPtr    :: Ptr Word64        -> Int -> IO Word64
204
205 readWideCharOffPtr (Ptr a) (I# i)
206   = IO $ \s -> case readWideCharOffAddr# a i s  of (# s2, x #) -> (# s2, C# x #)
207 readIntOffPtr (Ptr a) (I# i)
208   = IO $ \s -> case readIntOffAddr# a i s       of (# s2, x #) -> (# s2, I# x #)
209 readWordOffPtr (Ptr a) (I# i)
210   = IO $ \s -> case readWordOffAddr# a i s      of (# s2, x #) -> (# s2, W# x #)
211 readPtrOffPtr (Ptr a) (I# i)
212   = IO $ \s -> case readAddrOffAddr# a i s      of (# s2, x #) -> (# s2, Ptr x #)
213 readFunPtrOffPtr (Ptr a) (I# i)
214   = IO $ \s -> case readAddrOffAddr# a i s      of (# s2, x #) -> (# s2, FunPtr x #)
215 readFloatOffPtr (Ptr a) (I# i)
216   = IO $ \s -> case readFloatOffAddr# a i s     of (# s2, x #) -> (# s2, F# x #)
217 readDoubleOffPtr (Ptr a) (I# i)
218   = IO $ \s -> case readDoubleOffAddr# a i s    of (# s2, x #) -> (# s2, D# x #)
219 readStablePtrOffPtr (Ptr a) (I# i)
220   = IO $ \s -> case readStablePtrOffAddr# a i s of (# s2, x #) -> (# s2, StablePtr x #)
221 readInt8OffPtr (Ptr a) (I# i)
222   = IO $ \s -> case readInt8OffAddr# a i s      of (# s2, x #) -> (# s2, I8# x #)
223 readWord8OffPtr (Ptr a) (I# i)
224   = IO $ \s -> case readWord8OffAddr# a i s     of (# s2, x #) -> (# s2, W8# x #)
225 readInt16OffPtr (Ptr a) (I# i)
226   = IO $ \s -> case readInt16OffAddr# a i s     of (# s2, x #) -> (# s2, I16# x #)
227 readWord16OffPtr (Ptr a) (I# i)
228   = IO $ \s -> case readWord16OffAddr# a i s    of (# s2, x #) -> (# s2, W16# x #)
229 readInt32OffPtr (Ptr a) (I# i)
230   = IO $ \s -> case readInt32OffAddr# a i s     of (# s2, x #) -> (# s2, I32# x #)
231 readWord32OffPtr (Ptr a) (I# i)
232   = IO $ \s -> case readWord32OffAddr# a i s    of (# s2, x #) -> (# s2, W32# x #)
233 readInt64OffPtr (Ptr a) (I# i)
234   = IO $ \s -> case readInt64OffAddr# a i s     of (# s2, x #) -> (# s2, I64# x #)
235 readWord64OffPtr (Ptr a) (I# i)
236   = IO $ \s -> case readWord64OffAddr# a i s    of (# s2, x #) -> (# s2, W64# x #)
237
238 writeWideCharOffPtr  :: Ptr Char          -> Int -> Char        -> IO ()
239 writeIntOffPtr       :: Ptr Int           -> Int -> Int         -> IO ()
240 writeWordOffPtr      :: Ptr Word          -> Int -> Word        -> IO ()
241 writePtrOffPtr       :: Ptr (Ptr a)       -> Int -> Ptr a       -> IO ()
242 writeFunPtrOffPtr    :: Ptr (FunPtr a)    -> Int -> FunPtr a    -> IO ()
243 writeFloatOffPtr     :: Ptr Float         -> Int -> Float       -> IO ()
244 writeDoubleOffPtr    :: Ptr Double        -> Int -> Double      -> IO ()
245 writeStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> StablePtr a -> IO ()
246 writeInt8OffPtr      :: Ptr Int8          -> Int -> Int8        -> IO ()
247 writeInt16OffPtr     :: Ptr Int16         -> Int -> Int16       -> IO ()
248 writeInt32OffPtr     :: Ptr Int32         -> Int -> Int32       -> IO ()
249 writeInt64OffPtr     :: Ptr Int64         -> Int -> Int64       -> IO ()
250 writeWord8OffPtr     :: Ptr Word8         -> Int -> Word8       -> IO ()
251 writeWord16OffPtr    :: Ptr Word16        -> Int -> Word16      -> IO ()
252 writeWord32OffPtr    :: Ptr Word32        -> Int -> Word32      -> IO ()
253 writeWord64OffPtr    :: Ptr Word64        -> Int -> Word64      -> IO ()
254
255 writeWideCharOffPtr (Ptr a) (I# i) (C# x)
256   = IO $ \s -> case writeWideCharOffAddr# a i x s  of s2 -> (# s2, () #)
257 writeIntOffPtr (Ptr a) (I# i) (I# x)
258   = IO $ \s -> case writeIntOffAddr# a i x s       of s2 -> (# s2, () #)
259 writeWordOffPtr (Ptr a) (I# i) (W# x)
260   = IO $ \s -> case writeWordOffAddr# a i x s      of s2 -> (# s2, () #)
261 writePtrOffPtr (Ptr a) (I# i) (Ptr x)
262   = IO $ \s -> case writeAddrOffAddr# a i x s      of s2 -> (# s2, () #)
263 writeFunPtrOffPtr (Ptr a) (I# i) (FunPtr x)
264   = IO $ \s -> case writeAddrOffAddr# a i x s      of s2 -> (# s2, () #)
265 writeFloatOffPtr (Ptr a) (I# i) (F# x)
266   = IO $ \s -> case writeFloatOffAddr# a i x s     of s2 -> (# s2, () #)
267 writeDoubleOffPtr (Ptr a) (I# i) (D# x)
268   = IO $ \s -> case writeDoubleOffAddr# a i x s    of s2 -> (# s2, () #)
269 writeStablePtrOffPtr (Ptr a) (I# i) (StablePtr x)
270   = IO $ \s -> case writeStablePtrOffAddr# a i x s of s2 -> (# s2 , () #)
271 writeInt8OffPtr (Ptr a) (I# i) (I8# x)
272   = IO $ \s -> case writeInt8OffAddr# a i x s      of s2 -> (# s2, () #)
273 writeWord8OffPtr (Ptr a) (I# i) (W8# x)
274   = IO $ \s -> case writeWord8OffAddr# a i x s     of s2 -> (# s2, () #)
275 writeInt16OffPtr (Ptr a) (I# i) (I16# x)
276   = IO $ \s -> case writeInt16OffAddr# 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 writeInt32OffPtr (Ptr a) (I# i) (I32# x)
280   = IO $ \s -> case writeInt32OffAddr# a i x s     of s2 -> (# s2, () #)
281 writeWord32OffPtr (Ptr a) (I# i) (W32# x)
282   = IO $ \s -> case writeWord32OffAddr# a i x s    of s2 -> (# s2, () #)
283 writeInt64OffPtr (Ptr a) (I# i) (I64# x)
284   = IO $ \s -> case writeInt64OffAddr# a i x s     of s2 -> (# s2, () #)
285 writeWord64OffPtr (Ptr a) (I# i) (W64# x)
286   = IO $ \s -> case writeWord64OffAddr# a i x s    of s2 -> (# s2, () #)
287
288 #endif /* __GLASGOW_HASKELL__ */
289 \end{code}