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