hvect-0.4.0.0: Simple strict heterogeneous lists
Safe HaskellNone
LanguageHaskell2010

Data.HVect

Synopsis

typesafe strict vector

data HVect (ts :: [*]) where Source #

Heterogeneous vector

Constructors

HNil :: HVect '[] 
(:&:) :: !t -> !(HVect ts) -> HVect (t ': ts) infixr 5 

Instances

Instances details
(Eq (HVect ts), Eq t) => Eq (HVect (t ': ts)) Source # 
Instance details

Defined in Data.HVect

Methods

(==) :: HVect (t ': ts) -> HVect (t ': ts) -> Bool #

(/=) :: HVect (t ': ts) -> HVect (t ': ts) -> Bool #

Eq (HVect ('[] :: [Type])) Source # 
Instance details

Defined in Data.HVect

Methods

(==) :: HVect '[] -> HVect '[] -> Bool #

(/=) :: HVect '[] -> HVect '[] -> Bool #

(Ord (HVect ts), Ord t) => Ord (HVect (t ': ts)) Source # 
Instance details

Defined in Data.HVect

Methods

compare :: HVect (t ': ts) -> HVect (t ': ts) -> Ordering #

(<) :: HVect (t ': ts) -> HVect (t ': ts) -> Bool #

(<=) :: HVect (t ': ts) -> HVect (t ': ts) -> Bool #

(>) :: HVect (t ': ts) -> HVect (t ': ts) -> Bool #

(>=) :: HVect (t ': ts) -> HVect (t ': ts) -> Bool #

max :: HVect (t ': ts) -> HVect (t ': ts) -> HVect (t ': ts) #

min :: HVect (t ': ts) -> HVect (t ': ts) -> HVect (t ': ts) #

Ord (HVect ('[] :: [Type])) Source # 
Instance details

Defined in Data.HVect

Methods

compare :: HVect '[] -> HVect '[] -> Ordering #

(<) :: HVect '[] -> HVect '[] -> Bool #

(<=) :: HVect '[] -> HVect '[] -> Bool #

(>) :: HVect '[] -> HVect '[] -> Bool #

(>=) :: HVect '[] -> HVect '[] -> Bool #

max :: HVect '[] -> HVect '[] -> HVect '[] #

min :: HVect '[] -> HVect '[] -> HVect '[] #

(Show (HVect ts), Show t) => Show (HVect (t ': ts)) Source # 
Instance details

Defined in Data.HVect

Methods

showsPrec :: Int -> HVect (t ': ts) -> ShowS #

show :: HVect (t ': ts) -> String #

showList :: [HVect (t ': ts)] -> ShowS #

Show (HVect ('[] :: [Type])) Source # 
Instance details

Defined in Data.HVect

Methods

showsPrec :: Int -> HVect '[] -> ShowS #

show :: HVect '[] -> String #

showList :: [HVect '[]] -> ShowS #

head :: HVect (t ': ts) -> t Source #

tail :: HVect (t ': ts) -> HVect ts Source #

singleton :: a -> HVect '[a] Source #

type family HVectLen (ts :: [*]) :: Nat where ... Source #

Equations

HVectLen '[] = 'Zero 
HVectLen (t ': ts) = 'Succ (HVectLen ts) 

findFirst :: forall x ts n. ListContains n x ts => HVect ts -> x Source #

Find first element in HVect of type x

type family InList (x :: *) (xs :: [*]) :: Nat where ... Source #

Equations

InList x (x ': ys) = 'Zero 
InList x (y ': ys) = 'Succ (InList x ys) 

type ListContains n x ts = (SNatRep n, InList x ts ~ n, HVectIdx n ts ~ x) Source #

type family NotInList (x :: *) (xs :: [*]) :: Bool where ... Source #

Equations

NotInList x (x ': ys) = 'False 
NotInList x (y ': ys) = NotInList x ys 
NotInList x '[] = 'True 

type family MaybeToList (a :: Maybe *) :: [*] where ... Source #

Equations

MaybeToList ('Just r) = '[r] 
MaybeToList 'Nothing = '[] 

(!!) :: SNat n -> HVect as -> HVectIdx n as infixl 9 Source #

type family HVectIdx (n :: Nat) (ts :: [*]) :: * where ... Source #

Equations

HVectIdx 'Zero (a ': as) = a 
HVectIdx ('Succ n) (a ': as) = HVectIdx n as 

type family HVectElim (ts :: [*]) (a :: *) :: * where ... Source #

Equations

HVectElim '[] a = a 
HVectElim (t ': ts) a = t -> HVectElim ts a 

type family Append (as :: [*]) (bs :: [*]) :: [*] where ... Source #

Equations

Append '[] bs = bs 
Append (a ': as) bs = a ': Append as bs 

(<++>) :: HVect as -> HVect bs -> HVect (Append as bs) infixr 5 Source #

type family ReverseLoop (as :: [*]) (bs :: [*]) :: [*] where ... Source #

Equations

ReverseLoop '[] bs = bs 
ReverseLoop (a ': as) bs = ReverseLoop as (a ': bs) 

type Reverse as = ReverseLoop as '[] Source #

uncurry :: HVectElim ts a -> HVect ts -> a Source #

data Rep (ts :: [*]) where Source #

Constructors

RNil :: Rep '[] 
RCons :: Rep ts -> Rep (t ': ts) 

class HasRep (ts :: [*]) where Source #

Methods

hasRep :: Rep ts Source #

Instances

Instances details
HasRep ('[] :: [Type]) Source # 
Instance details

Defined in Data.HVect

Methods

hasRep :: Rep '[] Source #

HasRep ts => HasRep (t ': ts) Source # 
Instance details

Defined in Data.HVect

Methods

hasRep :: Rep (t ': ts) Source #

curryExpl :: Rep ts -> (HVect ts -> a) -> HVectElim ts a Source #

curry :: HasRep ts => (HVect ts -> a) -> HVectElim ts a Source #

packExpl :: Rep ts -> (forall a. HVectElim ts a -> a) -> HVect ts Source #

pack :: HasRep ts => (forall a. HVectElim ts a -> a) -> HVect ts Source #

type class constraints on list elements

type family AllHave (c :: * -> Constraint) (xs :: [*]) :: Constraint where ... Source #

Equations

AllHave c '[] = 'True ~ 'True 
AllHave c (x ': xs) = (c x, AllHave c xs) 

type level numeric utilities

data Nat where Source #

Constructors

Zero :: Nat 
Succ :: Nat -> Nat 

data SNat (n :: Nat) where Source #

Constructors

SZero :: SNat 'Zero 
SSucc :: SNat n -> SNat ('Succ n) 

data AnySNat where Source #

Constructors

AnySNat :: forall n. SNat n -> AnySNat 

type family (m :: Nat) :< (n :: Nat) :: Bool where ... Source #

Equations

m :< 'Zero = 'False 
'Zero :< ('Succ n) = 'True 
('Succ m) :< ('Succ n) = m :< n