Ticket #1885: OtherM.hs

File OtherM.hs, 858 bytes (added by simonpj, 7 years ago)
Line 
1{-# OPTIONS -fglasgow-exts -fbang-patterns  #-}
2
3module OtherM where
4
5import Foreign
6
7{- MONOMORPHIC TYPE -}
8
9data Vec3 = Vec3 {-# UNPACK #-} !Double
10                 {-# UNPACK #-} !Double
11                 {-# UNPACK #-} !Double
12  deriving (Eq,Show)
13
14vec3 !x !y !z = Vec3 x y z
15
16instance Num Vec3 where
17  (Vec3 a b c) + (Vec3 x y z) = Vec3 (a+x) (b+y) (c+z)
18
19instance Storable Vec3 where
20  sizeOf _ = 3 * sizeOf(undefined::Double)
21  alignment _ = alignment (undefined::Double)
22  peek !ptr = peek  (castPtr ptr)               >>= \x -> 
23              peek ((castPtr ptr)`advancePtr`1) >>= \y -> 
24              peek ((castPtr ptr)`advancePtr`2) >>= \z -> return (Vec3 x y z)
25
26  poke !ptr !(Vec3 x y z) = 
27             poke  (castPtr ptr)               x >>
28             poke ((castPtr ptr)`advancePtr`1) y >>
29             poke ((castPtr ptr)`advancePtr`2) z