Ticket #2416: LibOnly.hs

File LibOnly.hs, 1.9 KB (added by sedillard, 6 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 LibOnly where
13
14import Foreign
15
16data (:.) a b = !a :. !b
17  deriving (Eq,Ord,Read)
18
19infixr :.
20
21type Vec4 a = a:.a:.a:.a:.()
22
23
24instance Storable a => Storable (a:.()) where
25  sizeOf _ = sizeOf (undefined::a)
26  alignment _ = alignment (undefined::a)
27  peek !p = peek (castPtr p) >>= \a -> return (a:.())
28  peekByteOff !p !o = peek (p`plusPtr`o)
29  peekElemOff !p !i = peek (p`plusPtr`(i*sizeOf(undefined::a)))
30  poke !p (a:._) = poke (castPtr p) a
31  pokeByteOff !p !o !x = poke (p`plusPtr`o) x
32  pokeElemOff !p !i !x = poke (p`plusPtr`(i*sizeOf(undefined::a))) x
33  {-# INLINE sizeOf #-}
34  {-# INLINE alignment #-}
35  {-# INLINE peek #-}
36  {-# INLINE peekByteOff #-}
37  {-# INLINE peekElemOff #-}
38  {-# INLINE poke #-}
39  {-# INLINE pokeByteOff #-}
40  {-# INLINE pokeElemOff #-}
41
42instance (Storable a, Storable (a:.v)) 
43  => Storable (a:.a:.v) 
44  where
45  sizeOf _ = sizeOf (undefined::a) + sizeOf (undefined::(a:.v))
46  alignment _ = alignment (undefined::a)
47  peek !p = 
48    peek (castPtr p) >>= \a -> 
49    peek (castPtr (p`plusPtr`sizeOf(undefined::a))) >>= \v -> 
50    return (a:.v)
51  peekByteOff !p !o = peek (p`plusPtr`o)
52  peekElemOff !p !i = peek (p`plusPtr`(i*sizeOf(undefined::(a:.a:.v))))
53  poke !p (a:.v) = 
54    poke (castPtr p) a >> 
55    poke (castPtr (p`plusPtr`sizeOf(undefined::a))) v
56  pokeByteOff !p !o !x = poke (p`plusPtr`o) x
57  pokeElemOff !p !i !x = poke (p`plusPtr`(i*sizeOf(undefined::(a:.a:.v)))) x
58  {-# INLINE sizeOf #-}
59  {-# INLINE alignment #-}
60  {-# INLINE peek #-}
61  {-# INLINE peekByteOff #-}
62  {-# INLINE peekElemOff #-}
63  {-# INLINE poke #-}
64  {-# INLINE pokeByteOff #-}
65  {-# INLINE pokeElemOff #-}