1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
|
{-# OPTIONS -fno-implicit-prelude #-}
-----------------------------------------------------------------------------
-- |
-- Module : Foreign.Marshal.Utils
-- Copyright : (c) The FFI task force 2001
-- License : BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer : ffi@haskell.org
-- Stability : provisional
-- Portability : portable
--
-- Utilities for primitive marshaling
--
-----------------------------------------------------------------------------
module Foreign.Marshal.Utils (
-- * General marshalling utilities
-- ** Combined allocation and marshalling
--
withObject, -- :: Storable a => a -> (Ptr a -> IO b) -> IO b
{- FIXME: should be `with' -}
new, -- :: Storable a => a -> IO (Ptr a)
-- ** Marshalling of Boolean values (non-zero corresponds to 'True')
--
fromBool, -- :: Num a => Bool -> a
toBool, -- :: Num a => a -> Bool
-- ** Marshalling of Maybe values
--
maybeNew, -- :: ( a -> IO (Ptr a))
-- -> (Maybe a -> IO (Ptr a))
maybeWith, -- :: ( a -> (Ptr b -> IO c) -> IO c)
-- -> (Maybe a -> (Ptr b -> IO c) -> IO c)
maybePeek, -- :: (Ptr a -> IO b )
-- -> (Ptr a -> IO (Maybe b))
-- ** Marshalling lists of storable objects
--
withMany, -- :: (a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res
-- ** Haskellish interface to memcpy and memmove
-- | (argument order: destination, source)
copyBytes, -- :: Ptr a -> Ptr a -> Int -> IO ()
moveBytes -- :: Ptr a -> Ptr a -> Int -> IO ()
) where
import Data.Maybe
#ifdef __GLASGOW_HASKELL__
import Foreign.Ptr ( Ptr, nullPtr )
import GHC.Storable ( Storable(poke) )
import Foreign.C.TypesISO ( CSize )
import Foreign.Marshal.Alloc ( malloc, alloca )
import GHC.IOBase
import GHC.Real ( fromIntegral )
import GHC.Num
import GHC.Base
#endif
-- combined allocation and marshalling
-- -----------------------------------
-- |Allocate storage for a value and marshal it into this storage
--
new :: Storable a => a -> IO (Ptr a)
new val =
do
ptr <- malloc
poke ptr val
return ptr
-- |Allocate temporary storage for a value and marshal it into this storage
--
-- * see the life time constraints imposed by 'alloca'
--
{- FIXME: should be called `with' -}
withObject :: Storable a => a -> (Ptr a -> IO b) -> IO b
withObject val f =
alloca $ \ptr -> do
poke ptr val
res <- f ptr
return res
-- marshalling of Boolean values (non-zero corresponds to 'True')
-- -----------------------------
-- |Convert a Haskell 'Bool' to its numeric representation
--
fromBool :: Num a => Bool -> a
fromBool False = 0
fromBool True = 1
-- |Convert a Boolean in numeric representation to a Haskell value
--
toBool :: Num a => a -> Bool
toBool = (/= 0)
-- marshalling of Maybe values
-- ---------------------------
-- |Allocate storage and marshall a storable value wrapped into a 'Maybe'
--
-- * the 'nullPtr' is used to represent 'Nothing'
--
maybeNew :: ( a -> IO (Ptr a))
-> (Maybe a -> IO (Ptr a))
maybeNew = maybe (return nullPtr)
-- |Converts a @withXXX@ combinator into one marshalling a value wrapped into a
-- 'Maybe'
--
maybeWith :: ( a -> (Ptr b -> IO c) -> IO c)
-> (Maybe a -> (Ptr b -> IO c) -> IO c)
maybeWith = maybe ($ nullPtr)
-- |Convert a peek combinator into a one returning 'Nothing' if applied to a
-- 'nullPtr'
--
maybePeek :: (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek peek ptr | ptr == nullPtr = return Nothing
| otherwise = do a <- peek ptr; return (Just a)
-- marshalling lists of storable objects
-- -------------------------------------
-- |Replicates a @withXXX@ combinator over a list of objects, yielding a list of
-- marshalled objects
--
withMany :: (a -> (b -> res) -> res) -- withXXX combinator for one object
-> [a] -- storable objects
-> ([b] -> res) -- action on list of marshalled obj.s
-> res
withMany _ [] f = f []
withMany withFoo (x:xs) f = withFoo x $ \x' ->
withMany withFoo xs (\xs' -> f (x':xs'))
-- Haskellish interface to memcpy and memmove
-- ------------------------------------------
-- |Copies the given number of bytes from the second area (source) into the
-- first (destination); the copied areas may /not/ overlap
--
copyBytes :: Ptr a -> Ptr a -> Int -> IO ()
copyBytes dest src size = memcpy dest src (fromIntegral size)
-- |Copies the given number of elements from the second area (source) into the
-- first (destination); the copied areas /may/ overlap
--
moveBytes :: Ptr a -> Ptr a -> Int -> IO ()
moveBytes dest src size = memmove dest src (fromIntegral size)
-- auxilliary routines
-- -------------------
-- |Basic C routines needed for memory copying
--
foreign import ccall unsafe memcpy :: Ptr a -> Ptr a -> CSize -> IO ()
foreign import ccall unsafe memmove :: Ptr a -> Ptr a -> CSize -> IO ()
|
