@@ -0,0 +1,220 @@
1+-- C->Haskell Compiler: Marshalling library
2+--
3+-- Copyright (c) [1999...2005] Manuel M T Chakravarty
4+--
5+-- Redistribution and use in source and binary forms, with or without
6+-- modification, are permitted provided that the following conditions are met:
7+--
8+-- 1. Redistributions of source code must retain the above copyright notice,
9+-- this list of conditions and the following disclaimer.
10+-- 2. Redistributions in binary form must reproduce the above copyright
11+-- notice, this list of conditions and the following disclaimer in the
12+-- documentation and/or other materials provided with the distribution.
13+-- 3. The name of the author may not be used to endorse or promote products
14+-- derived from this software without specific prior written permission.
15+--
16+-- THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
17+-- IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
18+-- OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN
19+-- NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
20+-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
21+-- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
22+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
23+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
24+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
25+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
26+--
27+--- Description ---------------------------------------------------------------
28+--
29+-- Language: Haskell 98
30+--
31+-- This module provides the marshaling routines for Haskell files produced by
32+-- C->Haskell for binding to C library interfaces. It exports all of the
33+-- low-level FFI (language-independent plus the C-specific parts) together
34+-- with the C->HS-specific higher-level marshalling routines.
35+--
36+
37+module C2HS (
38+
39+ -- * Re-export the language-independent component of the FFI
40+ module Foreign,
41+
42+ -- * Re-export the C language component of the FFI
43+ module CForeign,
44+
45+ -- * Composite marshalling functions
46+ withCStringLenIntConv, peekCStringLenIntConv, withIntConv, withFloatConv,
47+ peekIntConv, peekFloatConv, withBool, peekBool, withEnum, peekEnum,
48+
49+ -- * Conditional results using 'Maybe'
50+ nothingIf, nothingIfNull,
51+
52+ -- * Bit masks
53+ combineBitMasks, containsBitMask, extractBitMasks,
54+
55+ -- * Conversion between C and Haskell types
56+ cIntConv, cFloatConv, cToBool, cFromBool, cToEnum, cFromEnum
57+) where
58+
59+
60+import Foreign
61+ hiding (Word)
62+ -- Should also hide the Foreign.Marshal.Pool exports in
63+ -- compilers that export them
64+import CForeign
65+
66+import Monad (when, liftM)
67+
68+
69+-- Composite marshalling functions
70+-- -------------------------------
71+
72+-- Strings with explicit length
73+--
74+withCStringLenIntConv s f = withCStringLen s $ \(p, n) -> f (p, cIntConv n)
75+peekCStringLenIntConv (s, n) = peekCStringLen (s, cIntConv n)
76+
77+-- Marshalling of numerals
78+--
79+
80+withIntConv :: (Storable b, Integral a, Integral b)
81+ => a -> (Ptr b -> IO c) -> IO c
82+withIntConv = with . cIntConv
83+
84+withFloatConv :: (Storable b, RealFloat a, RealFloat b)
85+ => a -> (Ptr b -> IO c) -> IO c
86+withFloatConv = with . cFloatConv
87+
88+peekIntConv :: (Storable a, Integral a, Integral b)
89+ => Ptr a -> IO b
90+peekIntConv = liftM cIntConv . peek
91+
92+peekFloatConv :: (Storable a, RealFloat a, RealFloat b)
93+ => Ptr a -> IO b
94+peekFloatConv = liftM cFloatConv . peek
95+
96+-- Passing Booleans by reference
97+--
98+
99+withBool :: (Integral a, Storable a) => Bool -> (Ptr a -> IO b) -> IO b
100+withBool = with . fromBool
101+
102+peekBool :: (Integral a, Storable a) => Ptr a -> IO Bool
103+peekBool = liftM toBool . peek
104+
105+
106+-- Passing enums by reference
107+--
108+
109+withEnum :: (Enum a, Integral b, Storable b) => a -> (Ptr b -> IO c) -> IO c
110+withEnum = with . cFromEnum
111+
112+peekEnum :: (Enum a, Integral b, Storable b) => Ptr b -> IO a
113+peekEnum = liftM cToEnum . peek
114+
115+
116+-- Storing of 'Maybe' values
117+-- -------------------------
118+
119+instance Storable a => Storable (Maybe a) where
120+ sizeOf _ = sizeOf (undefined :: Ptr ())
121+ alignment _ = alignment (undefined :: Ptr ())
122+
123+ peek p = do
124+ ptr <- peek (castPtr p)
125+ if ptr == nullPtr
126+ then return Nothing
127+ else liftM Just $ peek ptr
128+
129+ poke p v = do
130+ ptr <- case v of
131+ Nothing -> return nullPtr
132+ Just v' -> new v'
133+ poke (castPtr p) ptr
134+
135+
136+-- Conditional results using 'Maybe'
137+-- ---------------------------------
138+
139+-- Wrap the result into a 'Maybe' type.
140+--
141+-- * the predicate determines when the result is considered to be non-existing,
142+-- ie, it is represented by `Nothing'
143+--
144+-- * the second argument allows to map a result wrapped into `Just' to some
145+-- other domain
146+--
147+nothingIf :: (a -> Bool) -> (a -> b) -> a -> Maybe b
148+nothingIf p f x = if p x then Nothing else Just $ f x
149+
150+-- |Instance for special casing null pointers.
151+--
152+nothingIfNull :: (Ptr a -> b) -> Ptr a -> Maybe b
153+nothingIfNull = nothingIf (== nullPtr)
154+
155+
156+-- Support for bit masks
157+-- ---------------------
158+
159+-- Given a list of enumeration values that represent bit masks, combine these
160+-- masks using bitwise disjunction.
161+--
162+combineBitMasks :: (Enum a, Bits b) => [a] -> b
163+combineBitMasks = foldl (.|.) 0 . map (fromIntegral . fromEnum)
164+
165+-- Tests whether the given bit mask is contained in the given bit pattern
166+-- (i.e., all bits set in the mask are also set in the pattern).
167+--
168+containsBitMask :: (Bits a, Enum b) => a -> b -> Bool
169+bits `containsBitMask` bm = let bm' = fromIntegral . fromEnum $ bm
170+ in
171+ bm' .&. bits == bm'
172+
173+-- |Given a bit pattern, yield all bit masks that it contains.
174+--
175+-- * This does *not* attempt to compute a minimal set of bit masks that when
176+-- combined yield the bit pattern, instead all contained bit masks are
177+-- produced.
178+--
179+extractBitMasks :: (Bits a, Enum b, Bounded b) => a -> [b]
180+extractBitMasks bits =
181+ [bm | bm <- [minBound..maxBound], bits `containsBitMask` bm]
182+
183+
184+-- Conversion routines
185+-- -------------------
186+
187+-- |Integral conversion
188+--
189+cIntConv :: (Integral a, Integral b) => a -> b
190+cIntConv = fromIntegral
191+
192+-- |Floating conversion
193+--
194+cFloatConv :: (RealFloat a, RealFloat b) => a -> b
195+cFloatConv = realToFrac
196+-- As this conversion by default goes via `Rational', it can be very slow...
197+{-# RULES
198+ "cFloatConv/Float->Float" forall (x::Float). cFloatConv x = x;
199+ "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x
200+ #-}
201+
202+-- |Obtain C value from Haskell 'Bool'.
203+--
204+cFromBool :: Num a => Bool -> a
205+cFromBool = fromBool
206+
207+-- |Obtain Haskell 'Bool' from C value.
208+--
209+cToBool :: Num a => a -> Bool
210+cToBool = toBool
211+
212+-- |Convert a C enumeration to Haskell.
213+--
214+cToEnum :: (Integral i, Enum e) => i -> e
215+cToEnum = toEnum . cIntConv
216+
217+-- |Convert a Haskell enumeration to C.
218+--
219+cFromEnum :: (Enum e, Integral i) => e -> i
220+cFromEnum = cIntConv . fromEnum