Ticket #1885: Unpacked.hs

File Unpacked.hs, 3.1 KB (added by simonpj, 7 years ago)
Line 
1{-# OPTIONS -fglasgow-exts -fbang-patterns -cpp -fallow-undecidable-instances #-}
2
3import Foreign
4import Control.Monad
5
6
7#ifdef POLY_OTHER
8import OtherP
9version = "Polymorphic version, other file"
10#endif
11
12#ifdef POLY_SAME
13
14{- POLYMORPHIC TYPE
15 - when these definitions are in this file, it runs in constant space
16 - when you move them to another module, it uses heap proportional to n
17 -}
18
19{- to see heap explosion, snip form HERE ... -}
20-- data C a b = C {-# UNPACK #-} !a {-# UNPACK #-} !b deriving (Eq,Show)
21data C a b = C !a !b deriving (Eq,Show)
22
23type Vec3 = C Double (C Double (C Double ())) 
24
25vec3 !a !b !c = C a (C b (C c ()))
26
27instance (Show a, Eq a, Num a) => Num (C a ()) where
28  (C a ()) + (C b ()) = C (a+b) ()
29
30instance (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
31  (C i (C j k)) + (C x (C y z)) = C (i+x) ((C j k)+(C y z))
32
33instance Storable a => Storable (C a ()) where
34  sizeOf _ = sizeOf (undefined::a)
35  alignment _ = alignment (undefined::a)
36  peek p = peek (castPtr p) >>= \a -> return (C a ())
37  poke p (C a _) = poke (castPtr p) a
38
39instance (Storable a, Storable (C a v)) => Storable (C a (C a v)) 
40  where
41  sizeOf _ = sizeOf (undefined::a) + sizeOf (undefined::(C a v))
42  alignment _ = alignment (undefined::a)
43  peek !p = 
44    peek (castPtr p) >>= \a -> 
45    peek (castPtr (p`plusPtr`sizeOf(undefined::a))) >>= \v -> 
46    return (C a v)
47  poke !p !(C a v) = 
48    poke (castPtr p) a >> 
49    poke (castPtr (p`plusPtr`sizeOf(undefined::a))) v
50
51--  also, inlining these seem to defeat unboxing
52--  {-# INLINE peek #-}
53--  {-# INLINE poke #-}
54--  {-# INLINE sizeOf #-}
55--  {-# INLINE alignment #-}
56
57{- ... TO HERE and move to another file -}
58version = "Polymorphic version, same file"
59#endif
60
61#ifdef MONO_OTHER
62import OtherM
63version = "Monomorphic version, other file"
64#endif
65
66#ifdef MONO_SAME
67
68{- MONOMORPHIC TYPE -}
69
70data Vec3 = Vec3 {-# UNPACK #-} !Double
71                 {-# UNPACK #-} !Double
72                 {-# UNPACK #-} !Double
73  deriving (Eq,Show)
74
75vec3 !x !y !z = Vec3 x y z
76
77instance Num Vec3 where
78  (Vec3 a b c) + (Vec3 x y z) = Vec3 (a+x) (b+y) (c+z)
79
80instance Storable Vec3 where
81  sizeOf _ = 3 * sizeOf(undefined::Double)
82  alignment _ = alignment (undefined::Double)
83  peek !ptr = peek  (castPtr ptr)               >>= \x -> 
84              peek ((castPtr ptr)`advancePtr`1) >>= \y -> 
85              peek ((castPtr ptr)`advancePtr`2) >>= \z -> return (Vec3 x y z)
86
87  poke !ptr !(Vec3 x y z) = 
88             poke  (castPtr ptr)               x >>
89             poke ((castPtr ptr)`advancePtr`1) y >>
90             poke ((castPtr ptr)`advancePtr`2) z
91
92
93version = "Monomorphic version, same file"
94
95#endif
96
97n = 10000000
98
99main = 
100  do
101  a <- mallocArray n  :: IO( Ptr Vec3 )
102  b <- mallocArray n 
103  c <- mallocArray n 
104
105  forM_ [0..n-1] $ \i ->
106    pokeElemOff a i (vec3 1 2 3) >> pokeElemOff b i (vec3 4 5 6)
107
108  forM_ [0..n-1] $ \i ->
109    peekElemOff a i >>= \x -> peekElemOff b i >>= \y -> pokeElemOff c i (x+y)
110
111  forM_ [1..n-1] $ \i ->
112    peekElemOff c (i-1) >>= \x -> peekElemOff c i >>= \y -> pokeElemOff c i (x+y)
113 
114  print =<< peekElemOff c (n-1)
115
116  putStrLn version
117
118
119
120