module Data.Vector.Heterogenous
( HVector(..)
, vec
, ValidHVector(..)
, toHList
, module Data.Vector.Heterogenous.HList
, module Data.Vector.Heterogenous.Unsafe
)
where
import Data.Monoid
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
import qualified Data.Vector.Generic as G
import GHC.ST
import GHC.TypeLits
import Data.Vector.Heterogenous.HList
import Data.Vector.Heterogenous.Unsafe
newtype HVector box (xs::[a]) = HVector { getvec :: V.Vector box }
instance (Show box) => Show (HVector box xs) where
show (HVector vec) = "vec "++boxname++" $ "++(go $ n1)++"HNil"
where
boxname = "ShowBox"
n = V.length vec
go i = if i >= 0
then show (vec V.! i)++":::"++go (i1)
else ""
vec :: (HLength (HList xs), Downcast (HList xs) box) => (a->box) -> HList xs -> HVector box (xs::[*])
vec box xs = HVector $ V.create $ do
v <- VM.new n
vecwrite v (n1) (downcastAs box xs)
return $ v
where
n = hlength xs
vecwrite v i [] = return ()
vecwrite v i (x:xs) = (seq x $ VM.write v i x) >> vecwrite v (i1) xs
class
( Downcast (HList xs) box
, HLength (HList xs)
, HListBuilder (Indexer (HVector box xs)) (HList xs)
) => ValidHVector box xs
instance
( Downcast (HList xs) box
, HLength (HList xs)
, HListBuilder (Indexer (HVector box xs)) (HList xs)
) => ValidHVector box xs
data Indexer xs = Indexer !xs !Int
toHList :: HListBuilder (Indexer (HVector box xs)) ys => HVector box xs -> ys
toHList hv = buildHList $ Indexer hv (V.length (getvec hv) 1)
class HListBuilder xs ys | xs -> ys where
buildHList :: xs -> ys
instance HListBuilder (Indexer (HVector box '[])) (HList '[]) where
buildHList _ = HNil
instance
( ConstraintBox box x
, HListBuilder (Indexer (HVector box xs)) (HList xs)
) => HListBuilder (Indexer (HVector box (x ': xs))) (HList (x ': xs))
where
buildHList (Indexer (HVector v) i) =
(unsafeUnbox $ v V.! i):::(buildHList (Indexer (HVector v) (i1) :: Indexer (HVector box xs)))
instance
( Monoid (HList xs)
, Downcast (HList xs) box
, HLength (HList xs)
, HListBuilder (Indexer (HVector box xs)) (HList xs)
) => Monoid (HVector box xs) where
mempty = vec (undefined::a->box) $ mempty
v1 `mappend` v2 = vec (undefined::a->box) $ (toHList v1) `mappend` (toHList v2)
data Empty a
class View vec i ret | vec i -> ret where
view :: vec -> i -> ret
instance (ConstraintBox box x) => View (Indexer (HVector box (x ': xs))) (Empty Zero) x where
view (Indexer (HVector v) i) _ = unsafeUnbox $ v V.! i
instance (ConstraintBox box ret, View (Indexer (HVector box xs)) (Empty n) ret) => View (Indexer (HVector box (x ': xs))) (Empty (Succ n)) ret where
view (Indexer (HVector v) i) _ = unsafeUnbox $ v V.! i
instance
( View (Indexer (HVector box xs)) (Empty (ToNat1 n)) ret
, SingI n
) => View (HVector box xs) (Sing n) ret where
view hv _ = Indexer hv (V.length (getvec hv) n1) `view` (undefined::Empty (ToNat1 n))
where
n = fromIntegral $ fromSing (sing :: Sing n)