e59e7e4c083c9dcb3117d3b2cc47019048a4cd5d
[packages/old-time.git] / Foreign / Storable.hs
1 {-# OPTIONS -fno-implicit-prelude #-}
2 -----------------------------------------------------------------------------
3 -- |
4 -- Module : Foreign.Storable
5 -- Copyright : (c) The FFI task force 2001
6 -- License : see libraries/base/LICENSE
7 --
8 -- Maintainer : ffi@haskell.org
9 -- Stability : provisional
10 -- Portability : portable
11 --
12 -- The module "Foreign.Storable" provides most elementary support for
13 -- marshalling and is part of the language-independent portion of the
14 -- Foreign Function Interface (FFI), and will normally be imported via
15 -- the "Foreign" module.
16 --
17 -----------------------------------------------------------------------------
18
19 module Foreign.Storable
20 ( Storable(
21 sizeOf, -- :: a -> Int
22 alignment, -- :: a -> Int
23 peekElemOff, -- :: Ptr a -> Int -> IO a
24 pokeElemOff, -- :: Ptr a -> Int -> a -> IO ()
25 peekByteOff, -- :: Ptr b -> Int -> IO a
26 pokeByteOff, -- :: Ptr b -> Int -> a -> IO ()
27 peek, -- :: Ptr a -> IO a
28 poke) -- :: Ptr a -> a -> IO ()
29 ) where
30
31
32 import Control.Monad ( liftM )
33 import Foreign.Ptr
34 import Foreign.C.Types
35 import Foreign.C.TypesISO
36
37 #include "MachDeps.h"
38
39 #ifdef __GLASGOW_HASKELL__
40 import GHC.Storable
41 import GHC.Stable ( StablePtr )
42 import GHC.Num
43 import GHC.Int
44 import GHC.Word
45 import GHC.Stable
46 import GHC.Ptr
47 import GHC.Float
48 import GHC.Err
49 import GHC.IOBase
50 import GHC.Base
51 #elif defined(__HUGS__)
52 import Hugs.Storable
53 #endif
54
55 {- |
56 The member functions of this class facilitate writing values of
57 primitive types to raw memory (which may have been allocated with the
58 above mentioned routines) and reading values from blocks of raw
59 memory. The class, furthermore, includes support for computing the
60 storage requirements and alignment restrictions of storable types.
61
62 Memory addresses are represented as values of type @'Ptr' a@, for some
63 @a@ which is an instance of class 'Storable'. The type argument to
64 'Ptr' helps provide some valuable type safety in FFI code (you can\'t
65 mix pointers of different types without an explicit cast), while
66 helping the Haskell type system figure out which marshalling method is
67 needed for a given pointer.
68
69 All marshalling between Haskell and a foreign language ultimately
70 boils down to translating Haskell data structures into the binary
71 representation of a corresponding data structure of the foreign
72 language and vice versa. To code this marshalling in Haskell, it is
73 necessary to manipulate primtive data types stored in unstructured
74 memory blocks. The class 'Storable' facilitates this manipulation on
75 all types for which it is instantiated, which are the standard basic
76 types of Haskell, the fixed size @Int@ types ('Int8', 'Int16',
77 'Int32', 'Int64'), the fixed size @Word@ types ('Word8', 'Word16',
78 'Word32', 'Word64'), 'StablePtr', all types from "CTypes" and
79 "CTypesISO", as well as 'Ptr'.
80
81 Minimal complete definition: 'sizeOf', 'alignment', one of 'peek',
82 'peekElemOff' and 'peekByteOff', and one of 'poke', 'pokeElemOff' and
83 'pokeByteOff'.
84 -}
85
86 class Storable a where
87
88 sizeOf :: a -> Int
89 -- ^ Computes the storage requirements (in bytes) of the argument.
90 -- The value of the argument is not used.
91
92 alignment :: a -> Int
93 -- ^ Computes the alignment constraint of the argument. An
94 -- alignment constraint @x@ is fulfilled by any address divisible
95 -- by @x@. The value of the argument is not used.
96
97 peekElemOff :: Ptr a -> Int -> IO a
98 -- ^ Read a value from a memory area regarded as an array
99 -- of values of the same kind. The first argument specifies
100 -- the start address of the array and the second the index into
101 -- the array (the first element of the array has index
102 -- @0@). The following equality holds,
103 --
104 -- > peekElemOff addr idx = IOExts.fixIO $ \result ->
105 -- > peek (addr \`plusPtr\` (idx * sizeOf result))
106 --
107 -- Note that this is only a specification, not
108 -- necessarily the concrete implementation of the
109 -- function.
110
111 pokeElemOff :: Ptr a -> Int -> a -> IO ()
112 -- ^ Write a value to a memory area regarded as an array of
113 -- values of the same kind. The following equality holds:
114 --
115 -- > pokeElemOff addr idx x =
116 -- > poke (addr \`plusPtr\` (idx * sizeOf x)) x
117
118 peekByteOff :: Ptr b -> Int -> IO a
119 -- ^ Read a value from a memory location given by a base
120 -- address and offset. The following equality holds:
121 --
122 -- > peekByteOff addr off = peek (addr \`plusPtr\` off)
123
124 pokeByteOff :: Ptr b -> Int -> a -> IO ()
125 -- ^ Write a value to a memory location given by a base
126 -- address and offset. The following equality holds:
127 --
128 -- > pokeByteOff addr off x = poke (addr \`plusPtr\` off) x
129
130 peek :: Ptr a -> IO a
131 -- ^ Read a value from the given memory location.
132 --
133 -- Note that the peek and poke functions might require properly
134 -- aligned addresses to function correctly. This is architecture
135 -- dependent; thus, portable code should ensure that when peeking or
136 -- poking values of some type @a@, the alignment
137 -- constraint for @a@, as given by the function
138 -- 'alignment' is fulfilled.
139
140 poke :: Ptr a -> a -> IO ()
141 -- ^ Write the given value to the given memory location. Alignment
142 -- restrictions might apply; see 'peek'.
143
144 -- circular default instances
145 #ifdef __GLASGOW_HASKELL__
146 peekElemOff = peekElemOff_ undefined
147 where peekElemOff_ :: a -> Ptr a -> Int -> IO a
148 peekElemOff_ undef ptr off = peekByteOff ptr (off * sizeOf undef)
149 #else
150 peekElemOff ptr off = peekByteOff ptr (off * sizeOfPtr ptr undefined)
151 #endif
152 pokeElemOff ptr off val = pokeByteOff ptr (off * sizeOf val) val
153
154 peekByteOff ptr off = peek (ptr `plusPtr` off)
155 pokeByteOff ptr off = poke (ptr `plusPtr` off)
156
157 peek ptr = peekElemOff ptr 0
158 poke ptr = pokeElemOff ptr 0
159
160 #ifndef __GLASGOW_HASKELL__
161 sizeOfPtr :: Storable a => Ptr a -> a -> Int
162 sizeOfPtr px x = sizeOf x
163 #endif
164
165 -- System-dependent, but rather obvious instances
166
167 instance Storable Bool where
168 sizeOf _ = sizeOf (undefined::CInt)
169 alignment _ = alignment (undefined::CInt)
170 peekElemOff p i = liftM (/= (0::CInt)) $ peekElemOff (castPtr p) i
171 pokeElemOff p i x = pokeElemOff (castPtr p) i (if x then 1 else 0::CInt)
172
173 #define STORABLE(T,size,align,read,write) \
174 instance Storable (T) where { \
175 sizeOf _ = size; \
176 alignment _ = align; \
177 peekElemOff = read; \
178 pokeElemOff = write }
179
180 #ifdef __GLASGOW_HASKELL__
181 STORABLE(Char,SIZEOF_INT32,ALIGNMENT_INT32,
182 readWideCharOffPtr,writeWideCharOffPtr)
183 #elif defined(__HUGS__)
184 STORABLE(Char,SIZEOF_CHAR,ALIGNMENT_HSCHAR,
185 readCharOffPtr,writeCharOffPtr)
186 #endif
187
188 STORABLE(Int,SIZEOF_HSINT,ALIGNMENT_HSINT,
189 readIntOffPtr,writeIntOffPtr)
190
191 #ifdef __GLASGOW_HASKELL__
192 STORABLE(Word,SIZEOF_HSWORD,ALIGNMENT_HSWORD,
193 readWordOffPtr,writeWordOffPtr)
194 #endif
195
196 STORABLE((Ptr a),SIZEOF_HSPTR,ALIGNMENT_HSPTR,
197 readPtrOffPtr,writePtrOffPtr)
198
199 STORABLE((FunPtr a),SIZEOF_HSFUNPTR,ALIGNMENT_HSFUNPTR,
200 readFunPtrOffPtr,writeFunPtrOffPtr)
201
202 STORABLE((StablePtr a),SIZEOF_HSSTABLEPTR,ALIGNMENT_HSSTABLEPTR,
203 readStablePtrOffPtr,writeStablePtrOffPtr)
204
205 STORABLE(Float,SIZEOF_HSFLOAT,ALIGNMENT_HSFLOAT,
206 readFloatOffPtr,writeFloatOffPtr)
207
208 STORABLE(Double,SIZEOF_HSDOUBLE,ALIGNMENT_HSDOUBLE,
209 readDoubleOffPtr,writeDoubleOffPtr)
210
211 STORABLE(Word8,SIZEOF_WORD8,ALIGNMENT_WORD8,
212 readWord8OffPtr,writeWord8OffPtr)
213
214 STORABLE(Word16,SIZEOF_WORD16,ALIGNMENT_WORD16,
215 readWord16OffPtr,writeWord16OffPtr)
216
217 STORABLE(Word32,SIZEOF_WORD32,ALIGNMENT_WORD32,
218 readWord32OffPtr,writeWord32OffPtr)
219
220 STORABLE(Word64,SIZEOF_WORD64,ALIGNMENT_WORD64,
221 readWord64OffPtr,writeWord64OffPtr)
222
223 STORABLE(Int8,SIZEOF_INT8,ALIGNMENT_INT8,
224 readInt8OffPtr,writeInt8OffPtr)
225
226 STORABLE(Int16,SIZEOF_INT16,ALIGNMENT_INT16,
227 readInt16OffPtr,writeInt16OffPtr)
228
229 STORABLE(Int32,SIZEOF_INT32,ALIGNMENT_INT32,
230 readInt32OffPtr,writeInt32OffPtr)
231
232 STORABLE(Int64,SIZEOF_INT64,ALIGNMENT_INT64,
233 readInt64OffPtr,writeInt64OffPtr)
234
235 #define NSTORABLE(T) \
236 instance Storable T where { \
237 sizeOf (T x) = sizeOf x ; \
238 alignment (T x) = alignment x ; \
239 peekElemOff a i = liftM T (peekElemOff (castPtr a) i) ; \
240 pokeElemOff a i (T x) = pokeElemOff (castPtr a) i x }
241
242 NSTORABLE(CChar)
243 NSTORABLE(CSChar)
244 NSTORABLE(CUChar)
245 NSTORABLE(CShort)
246 NSTORABLE(CUShort)
247 NSTORABLE(CInt)
248 NSTORABLE(CUInt)
249 NSTORABLE(CLong)
250 NSTORABLE(CULong)
251 #ifndef __HUGS__
252 NSTORABLE(CLLong)
253 NSTORABLE(CULLong)
254 #endif
255 NSTORABLE(CFloat)
256 NSTORABLE(CDouble)
257 NSTORABLE(CLDouble)
258 NSTORABLE(CPtrdiff)
259 NSTORABLE(CSize)
260 NSTORABLE(CWchar)
261 NSTORABLE(CSigAtomic)
262 NSTORABLE(CClock)
263 NSTORABLE(CTime)