Ticket #1885: OtherP.hs

File OtherP.hs, 1.4 KB (added by simonpj, 6 years ago)
Line 
1{-# OPTIONS -fglasgow-exts -fbang-patterns -cpp -fallow-undecidable-instances #-}
2
3module OtherP where
4
5import Foreign
6
7{- to see heap explosion, snip form HERE ... -}
8data C a b = C {-# UNPACK #-} !a {-# UNPACK #-} !b deriving (Eq,Show)
9
10type Vec3 = C Double (C Double (C Double ())) 
11
12vec3 !a !b !c = C a (C b (C c ()))
13
14instance (Show a, Eq a, Num a) => Num (C a ()) where
15  (C a ()) + (C b ()) = C (a+b) ()
16
17instance (Show (C a (C a b)), Eq (C a (C a b)), Num (C a b), Num a) => Num (C a (C a b)) where
18  (C i (C j k)) + (C x (C y z)) = C (i+x) ((C j k)+(C y z))
19
20instance Storable a => Storable (C a ()) where
21  sizeOf _ = sizeOf (undefined::a)
22  alignment _ = alignment (undefined::a)
23  peek p = peek (castPtr p) >>= \a -> return (C a ())
24  poke p (C a _) = poke (castPtr p) a
25
26instance (Storable a, Storable (C a v)) => Storable (C a (C a v)) 
27  where
28  sizeOf _ = sizeOf (undefined::a) + sizeOf (undefined::(C a v))
29  alignment _ = alignment (undefined::a)
30  peek !p = 
31    peek (castPtr p) >>= \a -> 
32    peek (castPtr (p`plusPtr`sizeOf(undefined::a))) >>= \v -> 
33    return (C a v)
34  poke !p !(C a v) = 
35    poke (castPtr p) a >> 
36    poke (castPtr (p`plusPtr`sizeOf(undefined::a))) v
37
38--  also, inlining these seem to defeat unboxing
39--  {-# INLINE peek #-}
40--  {-# INLINE poke #-}
41--  {-# INLINE sizeOf #-}
42--  {-# INLINE alignment #-}
43
44{- ... TO HERE and move to another file -}