
There's a couple of things going on here: -If you use storablevector and storable-tuple, or uvector, you can store tuples of things. So your stupidArrayElement could be mimicked by (Int, Int). -But what you want to do is store a variable-sized data type. How would you do that in C? If you can spare another bit of memory, it might be better to define type T = (Bool, Bitmask) and use storablevector. Or maybe you want a sparse array of Bitmasks? -Yes it is a shame that Haskell does not have good support for unbounded polymorphic arrays. What if I want an array of functions? Here's a little trick that can make it a bit easier to store any data type in an unboxed array. I don't know, for instance, of any other way to define unrestricted functor/applicative for unboxed arrays. This trick should work with any other array library. {-# LANGUAGE GADTs#-} module FArray where import Data.StorableVector import Foreign.Storable import Control.Applicative data EqOrF a b where Eq :: EqOrF a a F :: (a->b) -> EqOrF a b data FArray a where FArray :: Storable a => Vector a -> EqOrF a b -> FArray b ConstArr :: a -> FArray a instance Functor FArray where fmap f (ConstArr x) = ConstArr $ f x fmap f (FArray sv Eq) = FArray sv $ F f fmap f (FArray sv (F g)) = FArray sv $ F $ f . g instance Applicative FArray where pure x = ConstArr x (ConstArr f) <*> farr = fmap f farr -- other cases left as an exercise. Which is to say, my bladder is bursting and I also need lunch. arrayOfInts = FArray (pack [1..10]) Eq arrayOfAdders = (+) `fmap` arrayOfInts Tom