storable-static-array 0.5.0.1 → 0.6.0.0
raw patch · 5 files changed
+382/−597 lines, 5 filesdep +vector
Dependencies added: vector
Files
- Data/Ix/Static.hs +190/−0
- Foreign/Marshal/StaticArray.hs +71/−306
- Foreign/Marshal/StaticArray/Unpromoted.hs +0/−287
- Foreign/Marshal/StaticVector.hs +113/−0
- storable-static-array.cabal +8/−4
+ Data/Ix/Static.hs view
@@ -0,0 +1,190 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE EmptyDataDecls #-}+{-|++'IxStatic' is a class that uses type-level constraints to generate the+values used by an 'Ix' instance.++This module contains instances of 'IxStatic' for types of kind 'Nat',+types of the promoted kind \'['Nat'], and promoted tuples of 'Nat' up+to 5 elements. This is the largest size of tuple that has an 'Ix'+instance.++There are also data types provided to simulate promoted tuples and+lists. These are less syntactically pleasant to use, but are sometimes+helpful. In particular, the single @'@ used by promoted types can+interfere with @CPP@ operation, so alternate means of specifying+multiple dimensions are provided.++-}+module Data.Ix.Static+ ( IxStatic(..)+ , fromNat+ , (:.)+ , Nil+ , D2+ , D3+ , D4+ , D5+ ) where++import GHC.TypeLits++import Data.Ix++import Data.Proxy+import Data.Tagged++-- | A conversion function for converting type-level naturals to+-- value-level. This is being exposed to aid in the creation of+-- additional 'IxStatic' instances for those who might desire to do+-- so.+--+-- Haddock is currently eating the important qualification that the+-- type variable @n@ must have the kind 'Nat'. The 'SingI' instance is+-- automatically fulfilled for all types of kind 'Nat'. Its explicit+-- presence in the signature is an artifact of how GHC implements+-- dictionary passing and type erasure.+fromNat :: forall (proxy :: Nat -> *) (n :: Nat). SingI n => proxy n -> Int+fromNat _ = fromInteger $ fromSing (sing :: Sing n)++-- | This class connects dimension description types with 'IArray'+-- index types and values.+class Ix (Index d) => IxStatic d where+ -- | The index type for this dimension description+ type Index d :: *+ -- | The concrete bounds for an array of this+ -- dimensionality, tagged with the dimensionality.+ taggedBounds :: Tagged d (Index d, Index d)++instance SingI n => IxStatic ('[n] :: [Nat]) where+ type Index ('[n]) = Int+ taggedBounds = Tagged (0, fromNat (Proxy :: Proxy n) - 1)++instance (SingI n, IxStatic (n2 ': ns)) =>+ IxStatic ((n ': n2 ': ns) :: [Nat]) where+ type Index (n ': n2 ': ns) = (Int, Index (n2 ': ns))+ taggedBounds = Tagged ((0, b0), (fromNat (Proxy :: Proxy n) - 1, bn))+ where+ (b0, bn) = untag (taggedBounds :: Tagged (n2 ': ns)+ (Index (n2 ': ns),+ Index (n2 ': ns)))++instance SingI a => IxStatic (a :: Nat) where+ type Index a = Int+ taggedBounds = Tagged (0, fromNat (Proxy :: Proxy a) - 1)++instance (SingI a, SingI b) => IxStatic ('(a, b) :: (Nat, Nat)) where+ type Index '(a, b) = (Int, Int)+ taggedBounds = Tagged ((0, 0),+ (fromNat (Proxy :: Proxy a) - 1,+ fromNat (Proxy :: Proxy b) - 1))++instance (SingI a, SingI b, SingI c) =>+ IxStatic ('(a, b, c) :: (Nat, Nat, Nat)) where+ type Index '(a, b, c) = (Int, Int, Int)+ taggedBounds = Tagged ((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) =>+ IxStatic ('(a, b, c, d) :: (Nat, Nat, Nat, Nat)) where+ type Index '(a, b, c, d) = (Int, Int, Int, Int)+ taggedBounds = Tagged ((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) =>+ IxStatic ('(a, b, c, d, e) :: (Nat, Nat, Nat, Nat, Nat)) where+ type Index '(a, b, c, d, e) = (Int, Int, Int, Int, Int)+ taggedBounds = Tagged ((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))++-- | ':.' is provided as an alternative means of constructing a+-- type-level list of dimensions. @DataKinds@-promoted lists are also+-- supported and easier to use in almost all cases. The exception is+-- when @CPP@ is involved, when a single @'@ on a line causes @CPP@ to+-- fail.+--+-- With @TypeOperators@ and @DataKinds@ enabled, @'StaticArray'+-- 'UArray' (2:.10:.25:.'Nil') 'Int'@ is equivalent to @'StaticArray'+-- 'UArray' \'[2,10,25] 'Int'@ and both wrap a @'UArray'+-- ('Int',('Int','Int')) 'Int'@ with bounds @((0,(0,0)),(1,(9,24)))@.+--+-- Neither promoted lists nor this approach support creating+-- 0-dimensional arrays, because they make no sense with+-- 'Foreign.Storable.Storable'.+data a :. b+infixr 3 :.++-- | 'Nil' is the terminator for type-level lists created with ':.'+data Nil++instance SingI n => IxStatic ((n :: Nat) :. Nil) where+ type Index (n :. Nil) = Int+ taggedBounds = Tagged (0, fromNat (Proxy :: Proxy n) - 1)++instance (SingI n, IxStatic (n2 :. ns)) =>+ IxStatic ((n :: Nat) :. n2 :. ns) where+ type Index (n :. n2 :. ns) = (Int, Index (n2 :. ns))+ taggedBounds = Tagged ((0, b0), (fromNat (Proxy :: Proxy n) - 1, bn))+ where+ (b0, bn) = untag (taggedBounds :: Tagged (n2 :. ns)+ (Index (n2 :. ns), Index (n2 :. ns)))++-- | An alternative dimension type to promoted pairs, provided for+-- syntactic compatibility with @CPP@.+data D2 (a :: Nat) (b :: Nat)+instance (SingI a, SingI b) => IxStatic (D2 a b) where+ type Index (D2 a b) = (Int, Int)+ taggedBounds = Tagged ((0, 0),+ (fromNat (Proxy :: Proxy a) - 1,+ fromNat (Proxy :: Proxy b) - 1))++-- | An alternative dimension type to promoted triples, provided for+-- syntactic compatibility with @CPP@.+data D3 (a :: Nat) (b :: Nat) (c :: Nat)+instance (SingI a, SingI b, SingI c) => IxStatic (D3 a b c) where+ type Index (D3 a b c) = (Int, Int, Int)+ taggedBounds = Tagged ((0, 0, 0),+ (fromNat (Proxy :: Proxy a) - 1,+ fromNat (Proxy :: Proxy b) - 1,+ fromNat (Proxy :: Proxy c) - 1))++-- | An alternative dimension type to promoted 4-tuples, provided for+-- syntactic compatibility with @CPP@.+data D4 (a :: Nat) (b :: Nat) (c :: Nat) (d :: Nat)+instance (SingI a, SingI b, SingI c, SingI d) => IxStatic (D4 a b c d) where+ type Index (D4 a b c d) = (Int, Int, Int, Int)+ taggedBounds = Tagged ((0, 0, 0, 0),+ (fromNat (Proxy :: Proxy a) - 1,+ fromNat (Proxy :: Proxy b) - 1,+ fromNat (Proxy :: Proxy c) - 1,+ fromNat (Proxy :: Proxy d) - 1))++-- | An alternative dimension type to promoted 5-tuples, provided for+-- syntactic compatibility with @CPP@.+data D5 (a :: Nat) (b :: Nat) (c :: Nat) (d :: Nat) (e :: Nat)+instance (SingI a, SingI b, SingI c, SingI d, SingI e) =>+ IxStatic (D5 a b c d e) where+ type Index (D5 a b c d e) = (Int, Int, Int, Int, Int)+ taggedBounds = Tagged ((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))
Foreign/Marshal/StaticArray.hs view
@@ -1,21 +1,17 @@-{-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE RecursiveDo #-}-{-# LANGUAGE UndecidableInstances #-} {-| -This module defines 'StaticArray', a simple wrapper around instances-of 'IArray' with its dimensions encoded in the type. 'StaticArray'-provides a 'Storable' instance that uses the type-level dimensions,-and significantly eases writing FFI bindings to fixed-size native-arrays. For example, @'StaticArray' 'UArray' 10 CInt@ has a 'Storable'-instance that is directly compatible with @int foo[10]@ in native-code.+This module defines 'StaticArray', a simple wrapper around arrays with+their dimensions in the type. 'StaticArray' provides 'Storable'+instances using the type-level dimensions. This eases writing FFI+bindings to fixed-size native arrays. For example, @'StaticArray'+'UArray' 10 CInt@ has a 'Storable' instance that is directly+compatible with @int foo[10]@ in native code. Multidimensional native arrays are also supported. @'StaticArray' 'UArray' \'(10,20,100) CUChar@ is compatible with @unsigned char@@ -35,92 +31,93 @@ ( -- * Basic interface StaticArray , toArray+ , staticBounds , staticArray , listStaticArray -- * Adding new Storable instances- --- -- | This module only has 'Storable' instances for 'UArray'- -- and 'Array' as backing types. This is the result of- -- ensuring that 'peek' is not implemented with an additional- -- copy. The mutable temporary array needs to have a- -- representation compatible with that of the result array to- -- avoid that extra copy.- --- -- The following functions provide a minimum complete,- -- correct 'Storable' implementation for 'StaticArray'. The- -- helper function required by 'peek'' is the part necessary- -- for efficient implementations which prevent creation of a- -- fully polymorphic instance.+ -- $NewStorable , sizeOf' , alignment' , poke' , peek'- -- * Adding new StaticSize instances- --- -- | This module contains instances of 'StaticSize' for types- -- of kind 'Nat', types of the promoted kind \'['Nat'], and- -- promoted tuples of 'Nat' up to 13 elements. For instances- -- not relying on promoted data types, see the- -- "Foreign.Marshal.StaticArray.Unpromoted" module.- , fromNat- , StaticSize(..) ) where -import GHC.TypeLits- import Control.Monad+import Data.Functor ((<$>)) -import Data.Array (Array)+import Data.Array (Array) import Data.Array.Base-import Data.Array.IO hiding (unsafeFreeze)-import Data.Functor ((<$>))-import Data.Proxy (Proxy(..))+import Data.Array.IO hiding (unsafeFreeze) -import Foreign.Storable (Storable(..))-import Foreign.Marshal.Array (advancePtr)-import Foreign.Ptr (Ptr, castPtr)+import Data.Ix.Static +import Data.Tagged +import Foreign.Ptr+import Foreign.Storable+import Foreign.Marshal.Array++ -- | A minimal array wrapper that encodes the full dimensions of the -- array in the type. Intended for interfacing with -- (possibly-)multidimensional arrays of fixed size in native code. ----- The constructor is not exported to prevent creating a StaticArray+-- The constructor is not exported to prevent creating a 'StaticArray' -- with a size that doesn't match its dimensions. newtype StaticArray backing dimensions (elements :: *) = StaticArray {- -- | Returns the backing 'Array' of this 'StaticArray'.- toArray :: backing (Bound dimensions) elements+ -- | Returns the backing value of this 'StaticArray'.+ toArray :: backing (Index dimensions) elements } deriving Eq -instance (IArray b e, Ix (Bound d), Show e) => Show (StaticArray b d e) where+instance (IArray b e, IxStatic d, Show e) => Show (StaticArray b d e) where show = ("listStaticArray " ++) . show . elems . toArray +-- | Get the compile-time bounds from a 'StaticArray'. Does not examine its+-- argument.+{-# INLINEABLE staticBounds #-}+staticBounds :: forall b d e. IxStatic d =>+ StaticArray b d e -> (Index d, Index d)+staticBounds _ = untag (taggedBounds :: Tagged d (Index d, Index d))+ -- | Create a new 'StaticArray' from a list of indices and -- elements. This has all the semantic caveats of 'array', except that--- the bounds are as good as those provided by the 'StaticSize'+-- the bounds are as good as those provided by the 'IxStatic' -- instance. {-# INLINEABLE staticArray #-}-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+staticArray :: (IArray b e, IxStatic d) => [(Index d, e)] -> StaticArray b d e+staticArray ls = let a = StaticArray $ array (staticBounds a) ls in a -- | Create a new 'StaticArray' from a list of elements in index--- order. Implemented in terms of 'listArray'.+-- order. Implemented in terms of 'listArray', with the same caveats. {-# INLINEABLE listStaticArray #-}-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+listStaticArray :: (IxStatic d, IArray b e) => [e] -> StaticArray b d e+listStaticArray ls = let a = StaticArray $ listArray (staticBounds a) ls in a + ------------------------------------------------------------------------+-- $NewStorable+--+-- This module only has 'Storable' instances for 'UArray' and 'Array'+-- as backing types. This is the result of ensuring that 'peek' is not+-- implemented with an additional copy. The mutable temporary array+-- needs to have a representation compatible with that of the result+-- array to avoid that extra copy.+--+-- The following functions provide a minimum complete, correct+-- 'Storable' implementation for 'StaticArray'. They can be used to+-- add more instances of 'Storable', if required. The helper function+-- required by 'peek'' is the part necessary for efficient+-- implementations which prevent creation of a fully polymorphic+-- instance. -- | Get the size, in bytes, of the native representation of this -- 'StaticArray'. {-# INLINEABLE sizeOf' #-}-sizeOf' :: forall b d e. (StaticSize d, Ix (Bound d), Storable e) =>+sizeOf' :: forall b d e. (IxStatic d, Storable e) => StaticArray b d e -> Int-sizeOf' a = sizeOf (undefined :: e) * rangeSize (extent a)+sizeOf' a = sizeOf (undefined :: e) * rangeSize (staticBounds a) -- | Get the alignment, in bytes, of the native representation of this -- 'StaticArray'@@ -131,28 +128,26 @@ -- | Write the contents of this 'StaticArray' to the given location in -- memory. {-# INLINEABLE poke' #-}-poke' :: forall b d e. (Ix (Bound d), IArray b e, Storable e) =>+poke' :: forall b d e. (IxStatic 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+poke' dst' (StaticArray a) = do+ let upper = rangeSize (bounds a) - 1+ dst = castPtr dst'+ forM_ [0..upper] $ \i -> poke (advancePtr dst i) $ unsafeAt a i -- | Create a new 'StaticArray' from the contents of the given -- location in memory. Uses a temporary mutable array to build up the--- result, then freezes it. The first argument is the--- freezing function. Non-copying implementations of 'unsafeFreeze'--- are safe as this argument, and preferred.+-- result, then freezes it. The first argument is the freezing+-- function. Non-copying implementations of 'unsafeFreeze' are safe as+-- this argument, and preferred. {-# INLINEABLE peek' #-}-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)) ->+peek' :: forall b d e m. (IxStatic d, Storable e, IArray b e,+ MArray m e IO) =>+ (m (Index d) e -> IO (b (Index d) e)) -> Ptr (StaticArray b d e) -> IO (StaticArray b d e) peek' freeze' src' = do- rec let b = extent arr+ rec let b = staticBounds arr m <- newArray_ b let src = castPtr src'@@ -163,8 +158,7 @@ arr <- StaticArray <$> freeze' m return arr -instance (StaticSize d, Ix (Bound d), Storable e,- IArray UArray e, MArray IOUArray e IO) =>+instance (IxStatic d, Storable e, IArray UArray e, MArray IOUArray e IO) => Storable (StaticArray UArray d e) where {-# INLINEABLE sizeOf#-} sizeOf = sizeOf'@@ -173,11 +167,10 @@ {-# INLINEABLE poke #-} poke = poke' {-# INLINEABLE peek #-}- peek = peek' (unsafeFreeze :: IOUArray (Bound d) e ->- IO (UArray (Bound d) e))+ peek = peek' (unsafeFreeze :: IOUArray (Index d) e ->+ IO (UArray (Index d) e)) -instance (StaticSize d, Ix (Bound d), Storable e) =>- Storable (StaticArray Array d e) where+instance (IxStatic d, Storable e) => Storable (StaticArray Array d e) where {-# INLINEABLE sizeOf #-} sizeOf = sizeOf' {-# INLINEABLE alignment #-}@@ -185,233 +178,5 @@ {-# INLINEABLE poke #-} poke = poke' {-# INLINEABLE peek #-}- peek = peek' (unsafeFreeze :: IOArray (Bound d) e ->- IO (Array (Bound d) e))------------------------------------------------------------------------------ | A conversion function for converting type-level naturals to--- value-level. This is being exposed to aid in the creation of--- additional 'StaticSize' instances for those who might desire to do--- so.------ Haddock is currently eating the important qualification that the--- type variable @n@ must have the kind 'Nat'. The 'SingI' instance is--- automatically fulfilled for all types of kind 'Nat'. Its explicit--- presence in the signature is an artifact of how GHC implements--- dictionary passing and type erasure.-{-# INLINEABLE fromNat #-}-fromNat :: forall (proxy :: Nat -> *) (n :: Nat). SingI n => proxy n -> Int-fromNat _ = fromInteger $ fromSing (sing :: Sing n)---- | This class connects dimension description types with 'IArray'--- index types and values.-class StaticSize d where- -- | The bounding type for this dimension description- type Bound d :: *- -- | The concrete bounds for an array of this- -- dimensionality. Implementations of this function should not- -- examine their argument in any way.- extent :: StaticArray b d e -> (Bound d, Bound d)--instance SingI n => StaticSize ('[n] :: [Nat]) where- type Bound ('[n]) = Int- {-# INLINEABLE extent #-}- 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))- {-# INLINEABLE extent #-}- 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- {-# INLINEABLE extent #-}- extent _ = (0, fromNat (Proxy :: Proxy a) - 1)--instance (SingI a, SingI b) => StaticSize ('(a, b) :: (Nat, Nat)) where- type Bound '(a, b) = (Int, Int)- {-# INLINEABLE extent #-}- 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)- {-# INLINEABLE extent #-}- 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)- {-# INLINEABLE extent #-}- 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)- {-# INLINEABLE extent #-}- 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)- {-# INLINEABLE extent #-}- 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)- {-# INLINEABLE extent #-}- 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)- {-# INLINEABLE extent #-}- 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)- {-# INLINEABLE extent #-}- 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)- {-# INLINEABLE extent #-}- 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)- {-# INLINEABLE extent #-}- 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)- {-# INLINEABLE extent #-}- 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)- {-# INLINEABLE extent #-}- 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))+ peek = peek' (unsafeFreeze :: IOArray (Index d) e ->+ IO (Array (Index d) e))
− Foreign/Marshal/StaticArray/Unpromoted.hs
@@ -1,287 +0,0 @@-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE EmptyDataDecls #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-|--This module contains a collection of data types for describing-dimensions of 'StaticArray' that do not depend on promoted lists and-tuples.--For convenience, it re-exports all of "Foreign.Marshal.StaticArray".---}-module Foreign.Marshal.StaticArray.Unpromoted- ( module Foreign.Marshal.StaticArray- , (:.)- , Nil- , D2- , D3- , D4- , D5- , D6- , D7- , D8- , D9- , D10- , D11- , D12- , D13- ) where--import Data.Proxy--import GHC.TypeLits--import Foreign.Marshal.StaticArray---- | ':.' is provided as an alternative means of constructing a--- type-level list of dimensions. @DataKinds@-promoted lists are also--- supported and easier to use in almost all cases. The exception is--- when @CPP@ is involved, when a single @'@ on a line causes @CPP@ to--- fail.------ With @TypeOperators@ and @DataKinds@ enabled, @'StaticArray'--- 'UArray' (2:.10:.25:.'Nil') 'Int'@ is equivalent to @'StaticArray'--- 'UArray' \'[2,10,25] 'Int'@ and both wrap a @'UArray'--- ('Int',('Int','Int')) 'Int'@ with bounds @((0,(0,0)),(1,(9,24)))@.------ Neither promoted lists nor this approach support creating--- 0-dimensional arrays, because they make no sense with--- 'Foreign.Storable.Storable'.-data a :. b-infixr 3 :.---- | 'Nil' is the terminator for type-level lists created with ':.'-data Nil--instance SingI n => StaticSize ((n :: Nat) :. Nil) where- type Bound (n :. Nil) = Int- {-# INLINEABLE extent #-}- extent _ = (0, fromNat (Proxy :: Proxy n) - 1)--instance (SingI n, StaticSize (n2 :. ns)) =>- StaticSize ((n :: Nat) :. n2 :. ns) where- type Bound (n :. n2 :. ns) = (Int, Bound (n2 :. ns))- {-# INLINEABLE extent #-}- extent _ = ((0, b0), (fromNat (Proxy :: Proxy n) - 1, bn))- where- (b0, bn) = extent (undefined :: StaticArray a (n2 :. ns) b)---- | An alternative dimension type to promoted pairs, provided for--- syntactic compatibility with @CPP@.-data D2 (a :: Nat) (b :: Nat)-instance (SingI a, SingI b) => StaticSize (D2 a b) where- type Bound (D2 a b) = (Int, Int)- {-# INLINEABLE extent #-}- extent _ = ((0, 0),- (fromNat (Proxy :: Proxy a) - 1,- fromNat (Proxy :: Proxy b) - 1))---- | An alternative dimension type to promoted triples, provided for--- syntactic compatibility with @CPP@.-data D3 (a :: Nat) (b :: Nat) (c :: Nat)-instance (SingI a, SingI b, SingI c) => StaticSize (D3 a b c) where- type Bound (D3 a b c) = (Int, Int, Int)- {-# INLINEABLE extent #-}- extent _ = ((0, 0, 0),- (fromNat (Proxy :: Proxy a) - 1,- fromNat (Proxy :: Proxy b) - 1,- fromNat (Proxy :: Proxy c) - 1))---- | An alternative dimension type to promoted 4-tuples, provided for--- syntactic compatibility with @CPP@.-data D4 (a :: Nat) (b :: Nat) (c :: Nat) (d :: Nat)-instance (SingI a, SingI b, SingI c, SingI d) => StaticSize (D4 a b c d) where- type Bound (D4 a b c d) = (Int, Int, Int, Int)- {-# INLINEABLE extent #-}- 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))---- | An alternative dimension type to promoted 5-tuples, provided for--- syntactic compatibility with @CPP@.-data D5 (a :: Nat) (b :: Nat) (c :: Nat) (d :: Nat) (e :: Nat)-instance (SingI a, SingI b, SingI c, SingI d, SingI e) =>- StaticSize (D5 a b c d e) where- type Bound (D5 a b c d e) = (Int, Int, Int, Int, Int)- {-# INLINEABLE extent #-}- 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))---- | An alternative dimension type to promoted 6-tuples, provided for--- syntactic compatibility with @CPP@.-data D6 (a :: Nat) (b :: Nat) (c :: Nat) (d :: Nat) (e :: Nat) (f :: Nat)-instance (SingI a, SingI b, SingI c, SingI d, SingI e, SingI f) =>- StaticSize (D6 a b c d e f) where- type Bound (D6 a b c d e f) = (Int, Int, Int, Int, Int, Int)- {-# INLINEABLE extent #-}- 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))---- | An alternative dimension type to promoted 7-tuples, provided for--- syntactic compatibility with @CPP@.-data D7 (a :: Nat) (b :: Nat) (c :: Nat) (d :: Nat) (e :: Nat) (f :: Nat)- (g :: Nat)-instance (SingI a, SingI b, SingI c, SingI d, SingI e, SingI f, SingI g) =>- StaticSize (D7 a b c d e f g) where- type Bound (D7 a b c d e f g) = (Int, Int, Int, Int, Int, Int, Int)- {-# INLINEABLE extent #-}- 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))---- | An alternative dimension type to promoted 8-tuples, provided for--- syntactic compatibility with @CPP@.-data D8 (a :: Nat) (b :: Nat) (c :: Nat) (d :: Nat) (e :: Nat) (f :: Nat)- (g :: Nat) (h :: Nat)-instance (SingI a, SingI b, SingI c, SingI d, SingI e, SingI f, SingI g,- SingI h) =>- StaticSize (D8 a b c d e f g h) where- type Bound (D8 a b c d e f g h) = (Int, Int, Int, Int, Int, Int, Int, Int)- {-# INLINEABLE extent #-}- 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))---- | An alternative dimension type to promoted 9-tuples, provided for--- syntactic compatibility with @CPP@.-data D9 (a :: Nat) (b :: Nat) (c :: Nat) (d :: Nat) (e :: Nat) (f :: Nat)- (g :: Nat) (h :: Nat) (i :: Nat)-instance (SingI a, SingI b, SingI c, SingI d, SingI e, SingI f, SingI g,- SingI h, SingI i) =>- StaticSize (D9 a b c d e f g h i) where- type Bound (D9 a b c d e f g h i) =- (Int, Int, Int, Int, Int, Int, Int, Int, Int)- {-# INLINEABLE extent #-}- 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))---- | An alternative dimension type to promoted 10-tuples, provided for--- syntactic compatibility with @CPP@.-data D10 (a :: Nat) (b :: Nat) (c :: Nat) (d :: Nat) (e :: Nat) (f :: Nat)- (g :: Nat) (h :: Nat) (i :: Nat) (j :: Nat)-instance (SingI a, SingI b, SingI c, SingI d, SingI e, SingI f, SingI g,- SingI h, SingI i, SingI j) =>- StaticSize (D10 a b c d e f g h i j) where- type Bound (D10 a b c d e f g h i j) =- (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)- {-# INLINEABLE extent #-}- 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))---- | An alternative dimension type to promoted 11-tuples, provided for--- syntactic compatibility with @CPP@.-data D11 (a :: Nat) (b :: Nat) (c :: Nat) (d :: Nat) (e :: Nat) (f :: Nat)- (g :: Nat) (h :: Nat) (i :: Nat) (j :: Nat) (k :: Nat)-instance (SingI a, SingI b, SingI c, SingI d, SingI e, SingI f, SingI g,- SingI h, SingI i, SingI j, SingI k) =>- StaticSize (D11 a b c d e f g h i j k) where- type Bound (D11 a b c d e f g h i j k) =- (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)- {-# INLINEABLE extent #-}- 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))---- | An alternative dimension type to promoted 12-tuples, provided for--- syntactic compatibility with @CPP@.-data D12 (a :: Nat) (b :: Nat) (c :: Nat) (d :: Nat) (e :: Nat) (f :: Nat)- (g :: Nat) (h :: Nat) (i :: Nat) (j :: Nat) (k :: Nat) (l :: Nat)-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 (D12 a b c d e f g h i j k l) where- type Bound (D12 a b c d e f g h i j k l) =- (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)- {-# INLINEABLE extent #-}- 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))---- | An alternative dimension type to promoted 13-tuples, provided for--- syntactic compatibility with @CPP@.-data D13 (a :: Nat) (b :: Nat) (c :: Nat) (d :: Nat) (e :: Nat) (f :: Nat)- (g :: Nat) (h :: Nat) (i :: Nat) (j :: Nat) (k :: Nat) (l :: Nat)- (m :: Nat)-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 (D13 a b c d e f g h i j k l m) where- type Bound (D13 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)- {-# INLINEABLE extent #-}- 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))
+ Foreign/Marshal/StaticVector.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RecursiveDo #-}+{-|++This module defines 'StaticVector', a simple wrapper around+'VG.Vector' with the dimensions in the type. 'StaticVector' provides a+'Storable' instance using the type-level dimensions. This eases+writing FFI bindings to fixed-size native arrays.++Support for interop with multi-dimensional native arrays is provided+via the 'IxStatic' class. This results in the slightly unnatural case+where you might need to convert 'Ix' coordinates to `VG.Vector`+indices, but it felt like an acceptable tradeoff when interfacing with+multi-dimensional native arrays.++-}+module Foreign.Marshal.StaticVector+ ( StaticVector+ , toVector+ , staticBounds+ , staticSize+ , fromList+ ) where++import Control.Monad+import Data.Functor ((<$>))++import Data.Ix+import Data.Ix.Static++import qualified Data.Vector.Generic as VG+import qualified Data.Vector.Generic.Mutable as VGM++import Data.Tagged++import Foreign.Ptr+import Foreign.Storable+import Foreign.Marshal.Array+++-- | A minimal 'VG.Vector' wrapper that encodes the full dimensions of+-- the array in the type. Intended for interfacing with+-- (possibly-)multidimensional arrays of fixed size in native code.+--+-- If this is used with multidimensional arrays, it will be up to+-- users to deal with converting 'Ix' coordinates to internal+-- 'VG.Vector' indices.+--+-- The constructor is not exported to prevent creating a+-- 'StaticVector' with a size that doesn't match its dimensions.+newtype StaticVector backing dimensions (elements :: *) =+ StaticVector {+ -- | Returns the backing value of this 'StaticVector'.+ toVector :: backing elements+ }+ deriving (Eq)++instance (VG.Vector b e, Show e) => Show (StaticVector b d e) where+ show = ("fromList " ++) . show . VG.toList . toVector++-- | Get the compile-time bounds from a 'StaticVector'. Does not+-- examine its argument.+{-# INLINEABLE staticBounds #-}+staticBounds :: forall b d e. IxStatic d =>+ StaticVector b d e -> (Index d, Index d)+staticBounds _ = untag (taggedBounds :: Tagged d (Index d, Index d))++-- | Get the compile-time size from a 'StaticVector'. Does not examine+-- its argument.+{-# INLINEABLE staticSize #-}+staticSize :: IxStatic d => StaticVector b d e -> Int+staticSize = rangeSize . staticBounds++-- | Create a new 'StaticVector' with the contents of the list. If the+-- list passed in contains too many elements, the result will be+-- truncated. If it contains too few elements, they will be cycled to+-- pad out the remaining space. If it contains 0 elements, this will+-- result in an error.+{-# INLINEABLE fromList #-}+fromList :: (VG.Vector b e, IxStatic d) => [e] -> StaticVector b d e+fromList els | null els = error "empty input to fromList"+ | otherwise = sv+ where+ size = staticSize sv+ sv = StaticVector . VG.fromListN size . cycle $ els++instance (IxStatic d, Storable e, VG.Vector b e) =>+ Storable (StaticVector b d e) where+ {-# INLINEABLE sizeOf #-}+ sizeOf a = sizeOf (undefined :: e) * rangeSize (staticBounds a)+ {-# INLINEABLE alignment #-}+ alignment _ = alignment (undefined :: e)+ {-# INLINEABLE poke #-}+ poke dst' sv@(StaticVector v) = do+ let upper = staticSize sv - 1+ dst = castPtr dst'+ forM_ [0..upper] $ \i -> poke (advancePtr dst i) $ VG.unsafeIndex v i+ {-# INLINEABLE peek #-}+ peek src' = do+ rec let size = staticSize sv+ v <- VGM.unsafeNew size++ let src = castPtr src'+ forM_ [0 .. size - 1] $ \i -> do+ x <- peek $ advancePtr src i+ VGM.unsafeWrite v i x++ sv <- StaticVector <$> VG.unsafeFreeze v+ return sv
storable-static-array.cabal view
@@ -1,5 +1,5 @@ name: storable-static-array-version: 0.5.0.1+version: 0.6.0.0 synopsis: Statically-sized array wrappers with Storable instances for FFI marshaling description: Uses type-level numeric literals to wrap arrays in a type@@ -20,7 +20,11 @@ location: https://github.com/chowells79/storable-static-array.git library- exposed-modules: Foreign.Marshal.StaticArray,- Foreign.Marshal.StaticArray.Unpromoted- build-depends: base ==4.6.*, array ==0.4.*, tagged ==0.6.*+ exposed-modules: Data.Ix.Static,+ Foreign.Marshal.StaticArray,+ Foreign.Marshal.StaticVector+ build-depends: base ==4.6.*,+ array ==0.4.*,+ tagged ==0.6.*,+ vector == 0.10.* ghc-options: -Wall -O2