module Foreign.Marshal.StaticArray
(
StaticArray
, toArray
, staticArray
, listStaticArray
, sizeOf'
, alignment'
, poke'
, peek'
, fromNat
, StaticSize(..)
) where
import GHC.TypeLits
import Control.Monad
import Data.Array (Array)
import Data.Array.Base
import Data.Array.IO hiding (unsafeFreeze)
import Data.Functor ((<$>))
import Data.Proxy (Proxy(..))
import Foreign.Storable (Storable(..))
import Foreign.Marshal.Array (advancePtr)
import Foreign.Ptr (Ptr, castPtr)
newtype StaticArray backing dimensions (elements :: *) =
StaticArray {
toArray :: backing (Bound dimensions) elements
}
deriving Eq
instance (IArray b e, Ix (Bound d), Show e) => Show (StaticArray b d e) where
show = ("listStaticArray " ++) . show . elems . toArray
staticArray :: (Ix (Bound d), IArray b e, StaticSize d) =>
[(Bound d, e)] -> StaticArray b d e
staticArray ls = let a = StaticArray $ array (extent a) ls in a
listStaticArray :: (StaticSize d, Ix (Bound d), IArray b e) =>
[e] -> StaticArray b d e
listStaticArray ls = let a = StaticArray $ listArray (extent a) ls in a
sizeOf' :: forall b d e. (StaticSize d, Ix (Bound d), Storable e) =>
StaticArray b d e -> Int
sizeOf' a = sizeOf (undefined :: e) * rangeSize (extent a)
alignment' :: forall b d e. Storable e => StaticArray b d e -> Int
alignment' _ = alignment (undefined :: e)
poke' :: forall b d e. (Ix (Bound d), IArray b e, Storable e) =>
Ptr (StaticArray b d e) -> StaticArray b d e -> IO ()
poke' dst' arr = do
let a = toArray arr
b = bounds a
dst = castPtr dst'
forM_ [0 .. rangeSize b 1] $ \i ->
poke (advancePtr dst i) $ unsafeAt a i
peek' :: forall b d e m . (StaticSize d, Ix (Bound d), Storable e,
IArray b e, MArray m e IO) =>
(m (Bound d) e -> IO (b (Bound d) e)) ->
Ptr (StaticArray b d e) ->
IO (StaticArray b d e)
peek' freeze' src' = do
rec let b = extent arr
m <- newArray_ b
let src = castPtr src'
forM_ [0 .. rangeSize b 1] $ \i -> do
x <- peek $ advancePtr src i
unsafeWrite m i x
arr <- StaticArray <$> freeze' m
return arr
instance (StaticSize d, Ix (Bound d), Storable e,
IArray UArray e, MArray IOUArray e IO) =>
Storable (StaticArray UArray d e) where
sizeOf = sizeOf'
alignment = alignment'
poke = poke'
peek = peek' (unsafeFreeze :: IOUArray (Bound d) e ->
IO (UArray (Bound d) e))
instance (StaticSize d, Ix (Bound d), Storable e) =>
Storable (StaticArray Array d e) where
sizeOf = sizeOf'
alignment = alignment'
poke = poke'
peek = peek' (unsafeFreeze :: IOArray (Bound d) e ->
IO (Array (Bound d) e))
fromNat :: forall (proxy :: Nat -> *) (n :: Nat). SingI n => proxy n -> Int
fromNat _ = fromInteger $ fromSing (sing :: Sing n)
class StaticSize d where
type Bound d :: *
extent :: StaticArray b d e -> (Bound d, Bound d)
instance SingI n => StaticSize ('[n] :: [Nat]) where
type Bound ('[n]) = Int
extent _ = (0, fromNat (Proxy :: Proxy n) 1)
instance (SingI n, StaticSize (n2 ': ns)) =>
StaticSize ((n ': n2 ': ns) :: [Nat]) where
type Bound (n ': n2 ': ns) = (Int, Bound (n2 ': ns))
extent _ = ((0, b0), (fromNat (Proxy :: Proxy n) 1, bn))
where
(b0, bn) = extent (undefined :: StaticArray a (n2 ': ns) b)
instance SingI a => StaticSize (a :: Nat) where
type Bound a = Int
extent _ = (0, fromNat (Proxy :: Proxy a) 1)
instance (SingI a, SingI b) => StaticSize ('(a, b) :: (Nat, Nat)) where
type Bound '(a, b) = (Int, Int)
extent _ = ((0, 0),
(fromNat (Proxy :: Proxy a) 1,
fromNat (Proxy :: Proxy b) 1))
instance (SingI a, SingI b, SingI c) =>
StaticSize ('(a, b, c) :: (Nat, Nat, Nat)) where
type Bound '(a, b, c) = (Int, Int, Int)
extent _ = ((0, 0, 0),
(fromNat (Proxy :: Proxy a) 1,
fromNat (Proxy :: Proxy b) 1,
fromNat (Proxy :: Proxy c) 1))
instance (SingI a, SingI b, SingI c, SingI d) =>
StaticSize ('(a, b, c, d) :: (Nat, Nat, Nat, Nat)) where
type Bound '(a, b, c, d) = (Int, Int, Int, Int)
extent _ = ((0, 0, 0, 0),
(fromNat (Proxy :: Proxy a) 1,
fromNat (Proxy :: Proxy b) 1,
fromNat (Proxy :: Proxy c) 1,
fromNat (Proxy :: Proxy d) 1))
instance (SingI a, SingI b, SingI c, SingI d, SingI e) =>
StaticSize ('(a, b, c, d, e) :: (Nat, Nat, Nat, Nat, Nat)) where
type Bound '(a, b, c, d, e) = (Int, Int, Int, Int, Int)
extent _ = ((0, 0, 0, 0, 0),
(fromNat (Proxy :: Proxy a) 1,
fromNat (Proxy :: Proxy b) 1,
fromNat (Proxy :: Proxy c) 1,
fromNat (Proxy :: Proxy d) 1,
fromNat (Proxy :: Proxy e) 1))
instance (SingI a, SingI b, SingI c, SingI d, SingI e, SingI f) =>
StaticSize ('(a, b, c, d, e, f) ::
(Nat, Nat, Nat, Nat, Nat, Nat)) where
type Bound '(a, b, c, d, e, f) = (Int, Int, Int, Int, Int, Int)
extent _ = ((0, 0, 0, 0, 0, 0),
(fromNat (Proxy :: Proxy a) 1,
fromNat (Proxy :: Proxy b) 1,
fromNat (Proxy :: Proxy c) 1,
fromNat (Proxy :: Proxy d) 1,
fromNat (Proxy :: Proxy e) 1,
fromNat (Proxy :: Proxy f) 1))
instance (SingI a, SingI b, SingI c, SingI d, SingI e, SingI f, SingI g) =>
StaticSize ('(a, b, c, d, e, f, g) ::
(Nat, Nat, Nat, Nat, Nat, Nat, Nat)) where
type Bound '(a, b, c, d, e, f, g) = (Int, Int, Int, Int, Int, Int, Int)
extent _ = ((0, 0, 0, 0, 0, 0, 0),
(fromNat (Proxy :: Proxy a) 1,
fromNat (Proxy :: Proxy b) 1,
fromNat (Proxy :: Proxy c) 1,
fromNat (Proxy :: Proxy d) 1,
fromNat (Proxy :: Proxy e) 1,
fromNat (Proxy :: Proxy f) 1,
fromNat (Proxy :: Proxy g) 1))
instance (SingI a, SingI b, SingI c, SingI d, SingI e, SingI f, SingI g,
SingI h) =>
StaticSize ('(a, b, c, d, e, f, g, h) ::
(Nat, Nat, Nat, Nat, Nat, Nat, Nat, Nat)) where
type Bound '(a, b, c, d, e, f, g, h) =
(Int, Int, Int, Int, Int, Int, Int, Int)
extent _ = ((0, 0, 0, 0, 0, 0, 0, 0),
(fromNat (Proxy :: Proxy a) 1,
fromNat (Proxy :: Proxy b) 1,
fromNat (Proxy :: Proxy c) 1,
fromNat (Proxy :: Proxy d) 1,
fromNat (Proxy :: Proxy e) 1,
fromNat (Proxy :: Proxy f) 1,
fromNat (Proxy :: Proxy g) 1,
fromNat (Proxy :: Proxy h) 1))
instance (SingI a, SingI b, SingI c, SingI d, SingI e, SingI f, SingI g,
SingI h, SingI i) =>
StaticSize ('(a, b, c, d, e, f, g, h, i) ::
(Nat, Nat, Nat, Nat, Nat, Nat, Nat, Nat, Nat)) where
type Bound '(a, b, c, d, e, f, g, h, i) =
(Int, Int, Int, Int, Int, Int, Int, Int, Int)
extent _ = ((0, 0, 0, 0, 0, 0, 0, 0, 0),
(fromNat (Proxy :: Proxy a) 1,
fromNat (Proxy :: Proxy b) 1,
fromNat (Proxy :: Proxy c) 1,
fromNat (Proxy :: Proxy d) 1,
fromNat (Proxy :: Proxy e) 1,
fromNat (Proxy :: Proxy f) 1,
fromNat (Proxy :: Proxy g) 1,
fromNat (Proxy :: Proxy h) 1,
fromNat (Proxy :: Proxy i) 1))
instance (SingI a, SingI b, SingI c, SingI d, SingI e, SingI f, SingI g,
SingI h, SingI i, SingI j) =>
StaticSize ('(a, b, c, d, e, f, g, h, i, j) ::
(Nat, Nat, Nat, Nat, Nat, Nat, Nat, Nat, Nat, Nat)) where
type Bound '(a, b, c, d, e, f, g, h, i, j) =
(Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)
extent _ = ((0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
(fromNat (Proxy :: Proxy a) 1,
fromNat (Proxy :: Proxy b) 1,
fromNat (Proxy :: Proxy c) 1,
fromNat (Proxy :: Proxy d) 1,
fromNat (Proxy :: Proxy e) 1,
fromNat (Proxy :: Proxy f) 1,
fromNat (Proxy :: Proxy g) 1,
fromNat (Proxy :: Proxy h) 1,
fromNat (Proxy :: Proxy i) 1,
fromNat (Proxy :: Proxy j) 1))
instance (SingI a, SingI b, SingI c, SingI d, SingI e, SingI f, SingI g,
SingI h, SingI i, SingI j, SingI k) =>
StaticSize ('(a, b, c, d, e, f, g, h, i, j, k) ::
(Nat, Nat, Nat, Nat, Nat, Nat, Nat, Nat, Nat, Nat, Nat))
where
type Bound '(a, b, c, d, e, f, g, h, i, j, k) =
(Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)
extent _ = ((0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
(fromNat (Proxy :: Proxy a) 1,
fromNat (Proxy :: Proxy b) 1,
fromNat (Proxy :: Proxy c) 1,
fromNat (Proxy :: Proxy d) 1,
fromNat (Proxy :: Proxy e) 1,
fromNat (Proxy :: Proxy f) 1,
fromNat (Proxy :: Proxy g) 1,
fromNat (Proxy :: Proxy h) 1,
fromNat (Proxy :: Proxy i) 1,
fromNat (Proxy :: Proxy j) 1,
fromNat (Proxy :: Proxy k) 1))
instance (SingI a, SingI b, SingI c, SingI d, SingI e, SingI f, SingI g,
SingI h, SingI i, SingI j, SingI k, SingI l) =>
StaticSize ('(a, b, c, d, e, f, g, h, i, j, k, l) ::
(Nat, Nat, Nat, Nat, Nat, Nat, Nat, Nat, Nat, Nat, Nat,
Nat)) where
type Bound '(a, b, c, d, e, f, g, h, i, j, k, l) =
(Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)
extent _ = ((0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
(fromNat (Proxy :: Proxy a) 1,
fromNat (Proxy :: Proxy b) 1,
fromNat (Proxy :: Proxy c) 1,
fromNat (Proxy :: Proxy d) 1,
fromNat (Proxy :: Proxy e) 1,
fromNat (Proxy :: Proxy f) 1,
fromNat (Proxy :: Proxy g) 1,
fromNat (Proxy :: Proxy h) 1,
fromNat (Proxy :: Proxy i) 1,
fromNat (Proxy :: Proxy j) 1,
fromNat (Proxy :: Proxy k) 1,
fromNat (Proxy :: Proxy l) 1))
instance (SingI a, SingI b, SingI c, SingI d, SingI e, SingI f, SingI g,
SingI h, SingI i, SingI j, SingI k, SingI l, SingI m) =>
StaticSize ('(a, b, c, d, e, f, g, h, i, j, k, l, m) ::
(Nat, Nat, Nat, Nat, Nat, Nat, Nat, Nat, Nat, Nat, Nat,
Nat, Nat)) where
type Bound '(a, b, c, d, e, f, g, h, i, j, k, l, m) =
(Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)
extent _ = ((0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
(fromNat (Proxy :: Proxy a) 1,
fromNat (Proxy :: Proxy b) 1,
fromNat (Proxy :: Proxy c) 1,
fromNat (Proxy :: Proxy d) 1,
fromNat (Proxy :: Proxy e) 1,
fromNat (Proxy :: Proxy f) 1,
fromNat (Proxy :: Proxy g) 1,
fromNat (Proxy :: Proxy h) 1,
fromNat (Proxy :: Proxy i) 1,
fromNat (Proxy :: Proxy j) 1,
fromNat (Proxy :: Proxy k) 1,
fromNat (Proxy :: Proxy l) 1,
fromNat (Proxy :: Proxy m) 1))