module Foreign.Marshal.FixedStorableArray
( FixedStorableArray
, newFixedStorableArray
, newFixedStorableArray_
, toStorableArray
, HasBounds(..)
, fromNat
) where
import GHC.TypeLits
import Data.Array.Storable
import Data.Functor ((<$>))
import Data.Proxy (Proxy(..))
import Foreign.Storable (Storable(..))
import Foreign.Marshal.Array (copyArray)
import Foreign.Ptr (castPtr)
newtype FixedStorableArray dimensions e =
FixedStorableArray {
toStorableArray :: StorableArray (Bound dimensions) e }
class HasBounds d where
type Bound d :: *
bounds :: FixedStorableArray d e -> (Bound d, Bound d)
newFixedStorableArray :: (HasBounds d, Ix (Bound d), Storable e) =>
e -> IO (FixedStorableArray d e)
newFixedStorableArray x = do
rec let b = bounds ma
ma <- FixedStorableArray <$> newArray b x
return ma
newFixedStorableArray_ :: (HasBounds d, Ix (Bound d), Storable e) =>
IO (FixedStorableArray d e)
newFixedStorableArray_ = do
rec let b = bounds ma
ma <- FixedStorableArray <$> newArray_ b
return ma
instance (HasBounds d, Ix (Bound d), Storable e) =>
Storable (FixedStorableArray d e) where
sizeOf a = sizeOf (undefined :: e) * rangeSize (bounds a)
alignment _ = alignment (undefined :: e)
peek src' = do
ma <- newFixedStorableArray_
let sa = toStorableArray ma
src = castPtr src'
count <- rangeSize <$> getBounds sa
withStorableArray sa $ \dst -> copyArray dst src count
return ma
poke dst' ma = do
let sa = toStorableArray ma
dst = castPtr dst'
count <- rangeSize <$> getBounds sa
withStorableArray sa $ \src -> copyArray dst src count
fromNat :: forall (proxy :: Nat -> *) (n :: Nat). SingI n => proxy n -> Int
fromNat _ = fromInteger $ fromSing (sing :: Sing n)
instance SingI a => HasBounds (a :: Nat) where
type Bound (a) = Int
bounds _ = (0, fromNat (Proxy :: Proxy a) 1)
instance (SingI a, SingI b) => HasBounds ('(a, b) :: (Nat, Nat)) where
type Bound '(a, b) = (Int, Int)
bounds _ = ((0, 0),
(fromNat (Proxy :: Proxy a) 1,
fromNat (Proxy :: Proxy b) 1))
instance (SingI a, SingI b, SingI c) =>
HasBounds ('(a, b, c) :: (Nat, Nat, Nat)) where
type Bound '(a, b, c) = (Int, Int, Int)
bounds _ = ((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) =>
HasBounds ('(a, b, c, d) :: (Nat, Nat, Nat, Nat)) where
type Bound '(a, b, c, d) = (Int, Int, Int, Int)
bounds _ = ((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) =>
HasBounds ('(a, b, c, d, e) :: (Nat, Nat, Nat, Nat, Nat)) where
type Bound '(a, b, c, d, e) = (Int, Int, Int, Int, Int)
bounds _ = ((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) =>
HasBounds ('(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)
bounds _ = ((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) =>
HasBounds ('(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)
bounds _ = ((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) =>
HasBounds ('(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)
bounds _ = ((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) =>
HasBounds ('(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)
bounds _ = ((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) =>
HasBounds ('(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)
bounds _ = ((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) =>
HasBounds ('(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)
bounds _ = ((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) =>
HasBounds ('(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)
bounds _ = ((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) =>
HasBounds ('(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)
bounds _ = ((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))
instance SingI n => HasBounds ('[n] :: [Nat]) where
type Bound ('[n]) = Int
bounds _ = (0, fromNat (Proxy :: Proxy n) 1)
instance (SingI n, HasBounds (n2 ': ns)) =>
HasBounds ((n ': n2 ': ns) :: [Nat]) where
type Bound (n ': n2 ': ns) = (Int, Bound (n2 ': ns))
bounds _ = ((0, b0), (fromNat (Proxy :: Proxy n) 1, bn))
where
(b0, bn) = bounds (undefined :: FixedStorableArray (n2 ': ns) ())