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
|
-- -*-haskell-*-
import Control.Monad
import Foreign
import Foreign.C
cIntConv :: (Integral a, Integral b) => a -> b
cIntConv = fromIntegral
{#pointer string as MyCString foreign newtype#}
cconcat :: MyCString -> MyCString -> IO MyCString
cconcat s1 s2 = do
ptr <- withMyCString s1 $ \s1' ->
withMyCString s2 $ \s2' -> {#call concat as _concat#} s1' s2'
liftM MyCString $ newForeignPtr finalizerFree ptr
data Point = Point {
x :: Int,
y :: Int
}
{#pointer *Point as CPoint foreign -> Point#}
-- this is just to exercise some more paths in GenBind.hs
{#pointer *_Point as C_Point foreign -> Point#}
{#pointer PointPtr#}
makeCPoint :: Int -> Int -> IO CPoint
makeCPoint x y = do
ptr <- {#call unsafe make_point#} (cIntConv x) (cIntConv y)
newForeignPtr finalizerFree ptr
transCPoint :: CPoint -> Int -> Int -> IO CPoint
transCPoint pnt x y = do
ptr <- withForeignPtr pnt $ \pnt' ->
{#call unsafe trans_point#} pnt' (cIntConv x) (cIntConv y)
newForeignPtr finalizerFree ptr
-- test function pointers
{#pointer FunPtrFun#}
-- test pointer to pointer
type PtrString = {#type stringPtr#}
checkType :: PtrString -> Ptr (Ptr CChar)
checkType = id
-- test classes
{#pointer *Point as APoint newtype#}
{#class APointClass APoint#}
{#pointer *ColourPoint as AColourPoint newtype#}
{#class APointClass => AColourPointClass AColourPoint#}
-- test suppression of code generation
{#pointer *Point as APoint2 newtype nocode#}
main = putStrLn "This test doesn't compute much; it's all about the generated \
\types."
|
