Ticket #2416: MainAndLib.hs

File MainAndLib.hs, 2.1 KB (added by sedillard, 7 years ago)
Line 
1{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FunctionalDependencies #-}
5{-# LANGUAGE MultiParamTypeClasses #-}
6{-# LANGUAGE NoMonomorphismRestriction #-}
7{-# LANGUAGE ScopedTypeVariables #-}
8{-# LANGUAGE TypeOperators #-}
9{-# LANGUAGE TypeSynonymInstances #-}
10{-# LANGUAGE UndecidableInstances #-}
11
12module MainAndLib where
13
14import Foreign
15import System
16
17data (:.) a b = !a :. !b
18  deriving (Eq,Ord,Read)
19
20infixr :.
21
22type Vec4 a = a:.a:.a:.a:.()
23
24
25instance Storable a => Storable (a:.()) where
26  sizeOf _ = sizeOf (undefined::a)
27  alignment _ = alignment (undefined::a)
28  peek !p = peek (castPtr p) >>= \a -> return (a:.())
29  peekByteOff !p !o = peek (p`plusPtr`o)
30  peekElemOff !p !i = peek (p`plusPtr`(i*sizeOf(undefined::a)))
31  poke !p (a:._) = poke (castPtr p) a
32  pokeByteOff !p !o !x = poke (p`plusPtr`o) x
33  pokeElemOff !p !i !x = poke (p`plusPtr`(i*sizeOf(undefined::a))) x
34  {-# INLINE sizeOf #-}
35  {-# INLINE alignment #-}
36  {-# INLINE peek #-}
37  {-# INLINE peekByteOff #-}
38  {-# INLINE peekElemOff #-}
39  {-# INLINE poke #-}
40  {-# INLINE pokeByteOff #-}
41  {-# INLINE pokeElemOff #-}
42
43instance (Storable a, Storable (a:.v)) 
44  => Storable (a:.a:.v) 
45  where
46  sizeOf _ = sizeOf (undefined::a) + sizeOf (undefined::(a:.v))
47  alignment _ = alignment (undefined::a)
48  peek !p = 
49    peek (castPtr p) >>= \a -> 
50    peek (castPtr (p`plusPtr`sizeOf(undefined::a))) >>= \v -> 
51    return (a:.v)
52  peekByteOff !p !o = peek (p`plusPtr`o)
53  peekElemOff !p !i = peek (p`plusPtr`(i*sizeOf(undefined::(a:.a:.v))))
54  poke !p (a:.v) = 
55    poke (castPtr p) a >> 
56    poke (castPtr (p`plusPtr`sizeOf(undefined::a))) v
57  pokeByteOff !p !o !x = poke (p`plusPtr`o) x
58  pokeElemOff !p !i !x = poke (p`plusPtr`(i*sizeOf(undefined::(a:.a:.v)))) x
59  {-# INLINE sizeOf #-}
60  {-# INLINE alignment #-}
61  {-# INLINE peek #-}
62  {-# INLINE peekByteOff #-}
63  {-# INLINE peekElemOff #-}
64  {-# INLINE poke #-}
65  {-# INLINE pokeByteOff #-}
66  {-# INLINE pokeElemOff #-}
67
68
69
70loop :: Int -> Ptr (Vec4 Double) -> Ptr (Vec4 Double) -> IO ()
71loop n a b = mapM_ (\i -> peekElemOff a i >>= pokeElemOff b i) [0..n-1]
72   
73