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