vector-heterogenous 0.1.2 → 0.2.0
raw patch · 3 files changed
+62/−56 lines, 3 files
Files
- src/Data/Vector/Heterogenous.hs +17/−17
- src/Data/Vector/Heterogenous/HList.hs +37/−31
- vector-heterogenous.cabal +8/−8
src/Data/Vector/Heterogenous.hs view
@@ -18,13 +18,13 @@ ( HVector(..) , vec , View (..)- + -- * Construction helpers , ValidHVector(..) , toHList -- , HListBuilder(..) -- , Indexer (..)- + -- * Modules , module Data.Vector.Heterogenous.HList , module Data.Vector.Heterogenous.Unsafe@@ -72,13 +72,13 @@ ------------------------------------------------------------------------------- -class +class ( Downcast (HList xs) box , HLength (HList xs) , HListBuilder (Indexer (HVector box xs)) (HList xs) ) => ValidHVector box xs -instance +instance ( Downcast (HList xs) box , HLength (HList xs) , HListBuilder (Indexer (HVector box xs)) (HList xs)@@ -93,19 +93,19 @@ 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)) + ) => HListBuilder (Indexer (HVector box (x ': xs))) (HList (x ': xs)) where- buildHList (Indexer (HVector v) i) = - (unsafeUnbox $ v V.! i):::(buildHList (Indexer (HVector v) (i-1) :: Indexer (HVector box xs))) - -instance + buildHList (Indexer (HVector v) i) =+ (unsafeUnbox $ v V.! i):::(buildHList (Indexer (HVector v) (i-1) :: Indexer (HVector box xs)))++instance ( Monoid (HList xs) , Downcast (HList xs) box , HLength (HList xs)@@ -121,17 +121,17 @@ 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 ++instance ( View (Indexer (HVector box xs)) (Empty (ToNat1 n)) ret- , SingI n- ) => View (HVector box xs) (Sing n) ret where+ , KnownNat n+ ) => View (HVector box xs) (proxy n) ret where view hv _ = Indexer hv (V.length (getvec hv) -n-1) `view` (undefined::Empty (ToNat1 n)) where- n = fromIntegral $ fromSing (sing :: Sing n)+ n = fromIntegral $ natVal (undefined :: proxy n)
src/Data/Vector/Heterogenous/HList.hs view
@@ -12,9 +12,10 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE CPP #-} module Data.Vector.Heterogenous.HList- ( + ( -- * Heterogenous List HList (..) , HLength (..)@@ -22,25 +23,25 @@ , HList2List (..) , HTake1 (..) , HDrop1 (..)- + -- ** Typeable , TypeList(..)- + -- * Downcasting , ConstraintBox (..) , Downcast (..)- + -- * Boxes , ShowBox (..) , AnyBox (..)- + -- * Type functions- + -- ** HList , HCons (..) , UnHList (..) , HAppend- + -- ** Type Lists , Distribute (..) , Replicate (..)@@ -49,11 +50,11 @@ , (:!) (..) , Index (..) , (++) (..)- , ($) (..)+-- , ($) (..) , Concat (..) , Length (..) , Length1 (..)- + -- ** Type Nats , Nat1(..) , Nat1Box(..)@@ -74,9 +75,17 @@ data HList :: [*] -> * where HNil :: HList '[] (:::) :: t -> HList ts -> HList (t ': ts)- + infixr 5 ::: +#if __GLASGOW_HASKELL__ >= 708+-- deriving instance Typeable+-- typeRep _ = mkTyConApp (hlistTyCon $ typeList (undefined::HList xs)) []+#else+instance (TypeList (HList xs)) => Typeable (HList xs) where+ typeOf _ = mkTyConApp (hlistTyCon $ typeList (undefined::HList xs)) []+#endif+ instance Show (HList '[]) where show _ = "HNil" instance (Show x, Show (HList xs)) => Show (HList (x ': xs)) where@@ -86,11 +95,11 @@ xs==ys = True instance (Eq x, Eq (HList xs)) => Eq (HList (x ': xs)) where (x:::xs)==(y:::ys) = (x==y)&&(xs==ys)- + instance Ord (HList '[]) where compare HNil HNil = EQ instance (Ord x, Ord (HList xs)) => Ord (HList (x ': xs)) where- compare (x:::xs) (y:::ys) = + compare (x:::xs) (y:::ys) = case compare x y of EQ -> compare xs ys LT -> LT@@ -109,12 +118,9 @@ hlistTyCon :: [TypeRep] -> TyCon hlistTyCon xs = mkTyCon3 "vector-heterogenous" "Data.Vector.Heterogenous.HList" ("HList '"++show xs) -instance (TypeList (HList xs)) => Typeable (HList xs) where- typeOf _ = mkTyConApp (hlistTyCon $ typeList (undefined::HList xs)) []- class TypeList t where typeList :: t -> [TypeRep]- + instance TypeList (HList '[]) where typeList _ = [] instance (TypeList (HList xs), Typeable x) => TypeList (HList (x ': xs)) where@@ -133,16 +139,16 @@ class HList2List xs a | xs -> a where hlist2list :: xs -> [a]-instance HList2List (HList '[]) a where- hlist2list xs = []+instance HList2List (HList '[a]) a where+ hlist2list (x:::HNil) = [x] instance (HList2List (HList xs) a) => HList2List (HList (a ':xs)) a where- hlist2list (x:::xs) = x:(hlist2list xs) + hlist2list (x:::xs) = x:(hlist2list xs) -- | For construction from lists class List2HList x xs where list2hlist :: [x] -> HList (x ': xs)- + instance List2HList x '[] where list2hlist [] = error "List2HList x HNil: cannot append empty list" list2hlist (x:[]) = x:::HNil@@ -155,11 +161,11 @@ -- | Equivalent to prelude's "drop" class HDrop1 n xs1 xs2 | n xs1 -> xs2 where hdrop1 :: n -> xs1 -> xs2- + instance HDrop1 (Nat1Box Zero) (HList xs1) (HList xs1) where hdrop1 n xs = xs- -instance (HDrop1 (Nat1Box n) (HList xs1) (HList xs2)) => ++instance (HDrop1 (Nat1Box n) (HList xs1) (HList xs2)) => HDrop1 (Nat1Box (Succ n)) (HList (x ': xs1)) (HList xs2) where hdrop1 _ (x:::xs) = hdrop1 (Nat1Box :: Nat1Box n) xs @@ -169,10 +175,10 @@ instance HTake1 (Nat1Box Zero) (HList xs1) (HList '[]) where htake1 _ _ = HNil- + instance (HTake1 (Nat1Box n) (HList xs1) (HList xs2)) => HTake1 (Nat1Box (Succ n)) (HList (x ': xs1)) (HList (x ': xs2)) where htake1 _ (x:::xs) = x:::(htake1 (Nat1Box :: Nat1Box n) xs)- + -- instance (HTake1 (Nat1Box (ToNat1 n)) (HList xs1) (HList xs2)) => HTake1 (Sing n) (HList xs1) (HList xs2) where -- htake1 _ xs = htake1 (Nat1Box :: Nat1Box (ToNat1 n)) xs @@ -186,10 +192,10 @@ class ConstraintBox box a where box :: a -> box unsafeUnbox :: box -> a- + class Downcast h box where downcast :: h -> [box]- + downcastAs :: (a->box) -> h -> [box] downcastAs box = downcast @@ -267,13 +273,13 @@ type instance Index (x ': xs) Zero = x type instance Index (x ': xs) (Succ i) = Index xs i -type family ($) (f :: a -> b) (a :: a) :: b-type instance f $ a = f a- +-- type family ($) (f :: a -> b) (a :: a) :: b+-- type instance f $ a = f a+ type family (xs :: [a]) ++ (ys :: [a]) :: [a] type instance '[] ++ ys = ys type instance (x ': xs) ++ ys = x ': (xs ++ ys)- + type family Concat (xs :: [[a]]) :: [a] type instance Concat '[] = '[] type instance Concat (x ': xs) = x ++ Concat xs
vector-heterogenous.cabal view
@@ -1,7 +1,7 @@ Name: vector-heterogenous-Version: 0.1.2+Version: 0.2.0 Synopsis: A type-safe library for vectors whose elements can be of any type, or any type satisfying some constraints-Description: +Description: Category: Data, Data Structures License: BSD3 --License-file: LICENSE@@ -13,17 +13,17 @@ bug-reports: http://github.com/mikeizbicki/vector-heterogenous/issues Library- Build-Depends: + Build-Depends: base >= 3 && < 5, vector >= 0.9- + hs-source-dirs: src- ghc-options: - -rtsopts - -O2 + ghc-options:+ -rtsopts+ -O2 -- -fllvm Exposed-modules: Data.Vector.Heterogenous Data.Vector.Heterogenous.HList Data.Vector.Heterogenous.Unsafe- +