ox-arrays-0.1.0.0: An efficient CPU-based multidimensional array (tensor) library
Safe HaskellNone
LanguageHaskell2010

Data.Array.Nested.Shaped.Shape

Synopsis

Shaped lists

data ListS (sh :: [Nat]) (f :: Nat -> Type) where Source #

Note: The KnownNat constraint on (::$) is deprecated and should be removed in a future release.

Constructors

ZS :: forall (f :: Nat -> Type). ListS ('[] :: [Nat]) f 
(::$) :: forall (n :: Nat) (sh1 :: [Nat]) {f :: Nat -> Type}. KnownNat n => f n -> ListS sh1 f -> ListS (n ': sh1) f infixr 3 

Instances

Instances details
KnownShS sh => IsList (ListS sh (Const i :: Nat -> Type)) Source #

Untyped: length is checked at runtime.

Instance details

Defined in Data.Array.Nested.Shaped.Shape

Associated Types

type Item (ListS sh (Const i :: Nat -> Type)) 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

type Item (ListS sh (Const i :: Nat -> Type)) = i

Methods

fromList :: [Item (ListS sh (Const i :: Nat -> Type))] -> ListS sh (Const i :: Nat -> Type) #

fromListN :: Int -> [Item (ListS sh (Const i :: Nat -> Type))] -> ListS sh (Const i :: Nat -> Type) #

toList :: ListS sh (Const i :: Nat -> Type) -> [Item (ListS sh (Const i :: Nat -> Type))] #

(forall (n :: Nat). Show (f n)) => Show (ListS sh f) Source # 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

Methods

showsPrec :: Int -> ListS sh f -> ShowS #

show :: ListS sh f -> String #

showList :: [ListS sh f] -> ShowS #

(forall (m :: Nat). NFData (f m)) => NFData (ListS n f) Source # 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

Methods

rnf :: ListS n f -> () #

(forall (n :: Nat). Eq (f n)) => Eq (ListS sh f) Source # 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

Methods

(==) :: ListS sh f -> ListS sh f -> Bool #

(/=) :: ListS sh f -> ListS sh f -> Bool #

(forall (n :: Nat). Ord (f n)) => Ord (ListS sh f) Source # 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

Methods

compare :: ListS sh f -> ListS sh f -> Ordering #

(<) :: ListS sh f -> ListS sh f -> Bool #

(<=) :: ListS sh f -> ListS sh f -> Bool #

(>) :: ListS sh f -> ListS sh f -> Bool #

(>=) :: ListS sh f -> ListS sh f -> Bool #

max :: ListS sh f -> ListS sh f -> ListS sh f #

min :: ListS sh f -> ListS sh f -> ListS sh f #

type Item (ListS sh (Const i :: Nat -> Type)) Source # 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

type Item (ListS sh (Const i :: Nat -> Type)) = i

data UnconsListSRes (f :: Nat -> Type) (sh1 :: [Nat]) Source #

Constructors

(KnownNat n, (n ': sh) ~ sh1) => UnconsListSRes (ListS sh f) (f n) 

listsUncons :: forall (sh1 :: [Nat]) (f :: Nat -> Type). ListS sh1 f -> Maybe (UnconsListSRes f sh1) Source #

listsEqType :: forall (f :: Nat -> Type) (sh :: [Nat]) (sh' :: [Nat]). TestEquality f => ListS sh f -> ListS sh' f -> Maybe (sh :~: sh') Source #

This checks only whether the types are equal; if the elements of the list are not singletons, their values may still differ. This corresponds to testEquality, except on the penultimate type parameter.

listsEqual :: forall (f :: Nat -> Type) (sh :: [Nat]) (sh' :: [Nat]). (TestEquality f, forall (n :: Nat). Eq (f n)) => ListS sh f -> ListS sh' f -> Maybe (sh :~: sh') Source #

This checks whether the two lists actually contain equal values. This is more than testEquality, and corresponds to geq from Data.GADT.Compare in the some package (except on the penultimate type parameter).

listsFmap :: forall f g (sh :: [Nat]). (forall (n :: Nat). f n -> g n) -> ListS sh f -> ListS sh g Source #

listsFold :: forall m f (sh :: [Nat]). Monoid m => (forall (n :: Nat). f n -> m) -> ListS sh f -> m Source #

listsShow :: forall (sh :: [Nat]) f. (forall (n :: Nat). f n -> ShowS) -> ListS sh f -> ShowS Source #

listsLength :: forall (sh :: [Nat]) (f :: Nat -> Type). ListS sh f -> Int Source #

listsRank :: forall (sh :: [Nat]) (f :: Nat -> Type). ListS sh f -> SNat (Rank sh) Source #

listsToList :: forall (sh :: [Nat]) i. ListS sh (Const i :: Nat -> Type) -> [i] Source #

listsHead :: forall (n :: Nat) (sh :: [Nat]) f. ListS (n ': sh) f -> f n Source #

listsTail :: forall (n :: Nat) (sh :: [Nat]) (f :: Nat -> Type). ListS (n ': sh) f -> ListS sh f Source #

listsInit :: forall (n :: Nat) (sh :: [Nat]) (f :: Nat -> Type). ListS (n ': sh) f -> ListS (Init (n ': sh)) f Source #

listsLast :: forall (n :: Nat) (sh :: [Nat]) f. ListS (n ': sh) f -> f (Last (n ': sh)) Source #

listsAppend :: forall (sh :: [Nat]) (f :: Nat -> Type) (sh' :: [Nat]). ListS sh f -> ListS sh' f -> ListS (sh ++ sh') f Source #

listsZip :: forall (sh :: [Nat]) (f :: Nat -> Type) (g :: Nat -> Type). ListS sh f -> ListS sh g -> ListS sh (Product f g) Source #

listsZipWith :: forall f g h (sh :: [Nat]). (forall (a :: Nat). f a -> g a -> h a) -> ListS sh f -> ListS sh g -> ListS sh h Source #

listsTakeLenPerm :: forall (f :: Nat -> Type) (is :: [Nat]) (sh :: [Nat]). Perm is -> ListS sh f -> ListS (TakeLen is sh) f Source #

listsDropLenPerm :: forall (f :: Nat -> Type) (is :: [Nat]) (sh :: [Nat]). Perm is -> ListS sh f -> ListS (DropLen is sh) f Source #

listsPermute :: forall (f :: Nat -> Type) (is :: [Nat]) (sh :: [Nat]). Perm is -> ListS sh f -> ListS (Permute is sh) f Source #

listsIndex :: forall {k1} {k2} f (i :: Nat) (is :: k1) (sh :: [Nat]) (shT :: k2). Proxy is -> Proxy shT -> SNat i -> ListS sh f -> (f (Index i sh), SNat (Index i sh)) Source #

listsPermutePrefix :: forall (f :: Nat -> Type) (is :: [Nat]) (sh :: [Nat]). Perm is -> ListS sh f -> ListS (PermutePrefix is sh) f Source #

Shaped indices

newtype IxS (sh :: [Nat]) i Source #

An index into a shape-typed array.

Constructors

IxS (ListS sh (Const i :: Nat -> Type)) 

Instances

Instances details
Foldable (IxS sh) Source # 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

Methods

fold :: Monoid m => IxS sh m -> m #

foldMap :: Monoid m => (a -> m) -> IxS sh a -> m #

foldMap' :: Monoid m => (a -> m) -> IxS sh a -> m #

foldr :: (a -> b -> b) -> b -> IxS sh a -> b #

foldr' :: (a -> b -> b) -> b -> IxS sh a -> b #

foldl :: (b -> a -> b) -> b -> IxS sh a -> b #

foldl' :: (b -> a -> b) -> b -> IxS sh a -> b #

foldr1 :: (a -> a -> a) -> IxS sh a -> a #

foldl1 :: (a -> a -> a) -> IxS sh a -> a #

toList :: IxS sh a -> [a] #

null :: IxS sh a -> Bool #

length :: IxS sh a -> Int #

elem :: Eq a => a -> IxS sh a -> Bool #

maximum :: Ord a => IxS sh a -> a #

minimum :: Ord a => IxS sh a -> a #

sum :: Num a => IxS sh a -> a #

product :: Num a => IxS sh a -> a #

Functor (IxS sh) Source # 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

Methods

fmap :: (a -> b) -> IxS sh a -> IxS sh b #

(<$) :: a -> IxS sh b -> IxS sh a #

Generic (IxS sh i) Source # 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

Associated Types

type Rep (IxS sh i) 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

type Rep (IxS sh i) = D1 ('MetaData "IxS" "Data.Array.Nested.Shaped.Shape" "ox-arrays-0.1.0.0-G9rS3ky7ORtC6G06Mvzq1I" 'True) (C1 ('MetaCons "IxS" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (ListS sh (Const i :: Nat -> Type)))))

Methods

from :: IxS sh i -> Rep (IxS sh i) x #

to :: Rep (IxS sh i) x -> IxS sh i #

KnownShS sh => IsList (IxS sh i) Source #

Very untyped: only length is checked (at runtime), index bounds are not checked.

Instance details

Defined in Data.Array.Nested.Shaped.Shape

Associated Types

type Item (IxS sh i) 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

type Item (IxS sh i) = i

Methods

fromList :: [Item (IxS sh i)] -> IxS sh i #

fromListN :: Int -> [Item (IxS sh i)] -> IxS sh i #

toList :: IxS sh i -> [Item (IxS sh i)] #

Show i => Show (IxS sh i) Source # 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

Methods

showsPrec :: Int -> IxS sh i -> ShowS #

show :: IxS sh i -> String #

showList :: [IxS sh i] -> ShowS #

NFData i => NFData (IxS sh i) Source # 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

Methods

rnf :: IxS sh i -> () #

Eq i => Eq (IxS sh i) Source # 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

Methods

(==) :: IxS sh i -> IxS sh i -> Bool #

(/=) :: IxS sh i -> IxS sh i -> Bool #

Ord i => Ord (IxS sh i) Source # 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

Methods

compare :: IxS sh i -> IxS sh i -> Ordering #

(<) :: IxS sh i -> IxS sh i -> Bool #

(<=) :: IxS sh i -> IxS sh i -> Bool #

(>) :: IxS sh i -> IxS sh i -> Bool #

(>=) :: IxS sh i -> IxS sh i -> Bool #

max :: IxS sh i -> IxS sh i -> IxS sh i #

min :: IxS sh i -> IxS sh i -> IxS sh i #

type Rep (IxS sh i) Source # 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

type Rep (IxS sh i) = D1 ('MetaData "IxS" "Data.Array.Nested.Shaped.Shape" "ox-arrays-0.1.0.0-G9rS3ky7ORtC6G06Mvzq1I" 'True) (C1 ('MetaCons "IxS" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (ListS sh (Const i :: Nat -> Type)))))
type Item (IxS sh i) Source # 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

type Item (IxS sh i) = i

pattern ZIS :: () => sh ~ ('[] :: [Nat]) => IxS sh i Source #

pattern (:.$) :: forall {sh1} {i} (n :: Nat) sh. () => forall. (KnownNat n, (n ': sh) ~ sh1) => i -> IxS sh i -> IxS sh1 i infixr 3 Source #

Note: The KnownNat constraint on (:.$) is deprecated and should be removed in a future release.

type IIxS (sh :: [Nat]) = IxS sh Int Source #

ixsLength :: forall (sh :: [Nat]) i. IxS sh i -> Int Source #

ixsRank :: forall (sh :: [Nat]) i. IxS sh i -> SNat (Rank sh) Source #

ixsZero :: forall (sh :: [Nat]). ShS sh -> IIxS sh Source #

ixsHead :: forall (n :: Nat) (sh :: [Nat]) i. IxS (n ': sh) i -> i Source #

ixsTail :: forall (n :: Nat) (sh :: [Nat]) i. IxS (n ': sh) i -> IxS sh i Source #

ixsInit :: forall (n :: Nat) (sh :: [Nat]) i. IxS (n ': sh) i -> IxS (Init (n ': sh)) i Source #

ixsLast :: forall (n :: Nat) (sh :: [Nat]) i. IxS (n ': sh) i -> i Source #

ixsCast :: forall (sh' :: [Nat]) (sh :: [Nat]) i. ShS sh' -> IxS sh i -> IxS sh' i Source #

ixsAppend :: forall (sh :: [Nat]) (sh' :: [Nat]) i. IxS sh i -> IxS sh' i -> IxS (sh ++ sh') i Source #

ixsZip :: forall (n :: [Nat]) i j. IxS n i -> IxS n j -> IxS n (i, j) Source #

ixsZipWith :: forall i j k (n :: [Nat]). (i -> j -> k) -> IxS n i -> IxS n j -> IxS n k Source #

ixsPermutePrefix :: forall i (is :: [Nat]) (sh :: [Nat]). Perm is -> IxS sh i -> IxS (PermutePrefix is sh) i Source #

Shaped shapes

newtype ShS (sh :: [Nat]) Source #

The shape of a shape-typed array given as a list of SNat values.

Note that because the shape of a shape-typed array is known statically, you can also retrieve the array shape from a KnownShS dictionary.

Constructors

ShS (ListS sh SNat) 

Instances

Instances details
Generic (ShS sh) Source # 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

Associated Types

type Rep (ShS sh) 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

type Rep (ShS sh) = D1 ('MetaData "ShS" "Data.Array.Nested.Shaped.Shape" "ox-arrays-0.1.0.0-G9rS3ky7ORtC6G06Mvzq1I" 'True) (C1 ('MetaCons "ShS" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (ListS sh SNat))))

Methods

from :: ShS sh -> Rep (ShS sh) x #

to :: Rep (ShS sh) x -> ShS sh #

KnownShS sh => IsList (ShS sh) Source #

Untyped: length and values are checked at runtime.

Instance details

Defined in Data.Array.Nested.Shaped.Shape

Associated Types

type Item (ShS sh) 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

type Item (ShS sh) = Int

Methods

fromList :: [Item (ShS sh)] -> ShS sh #

fromListN :: Int -> [Item (ShS sh)] -> ShS sh #

toList :: ShS sh -> [Item (ShS sh)] #

Show (ShS sh) Source # 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

Methods

showsPrec :: Int -> ShS sh -> ShowS #

show :: ShS sh -> String #

showList :: [ShS sh] -> ShowS #

NFData (ShS sh) Source # 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

Methods

rnf :: ShS sh -> () #

Eq (ShS sh) Source # 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

Methods

(==) :: ShS sh -> ShS sh -> Bool #

(/=) :: ShS sh -> ShS sh -> Bool #

Ord (ShS sh) Source # 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

Methods

compare :: ShS sh -> ShS sh -> Ordering #

(<) :: ShS sh -> ShS sh -> Bool #

(<=) :: ShS sh -> ShS sh -> Bool #

(>) :: ShS sh -> ShS sh -> Bool #

(>=) :: ShS sh -> ShS sh -> Bool #

max :: ShS sh -> ShS sh -> ShS sh #

min :: ShS sh -> ShS sh -> ShS sh #

TestEquality ShS Source # 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

Methods

testEquality :: forall (a :: [Nat]) (b :: [Nat]). ShS a -> ShS b -> Maybe (a :~: b) #

type Rep (ShS sh) Source # 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

type Rep (ShS sh) = D1 ('MetaData "ShS" "Data.Array.Nested.Shaped.Shape" "ox-arrays-0.1.0.0-G9rS3ky7ORtC6G06Mvzq1I" 'True) (C1 ('MetaCons "ShS" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (ListS sh SNat))))
type Item (ShS sh) Source # 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

type Item (ShS sh) = Int

pattern ZSS :: () => sh ~ ('[] :: [Nat]) => ShS sh Source #

pattern (:$$) :: forall {sh1} (n :: Nat) sh. () => (KnownNat n, (n ': sh) ~ sh1) => SNat n -> ShS sh -> ShS sh1 infixr 3 Source #

shsEqual :: forall (sh :: [Nat]) (sh' :: [Nat]). ShS sh -> ShS sh' -> Maybe (sh :~: sh') Source #

shsEqual = testEquality. (Because ShS is a singleton, types are equal if and only if values are equal.)

shsLength :: forall (sh :: [Nat]). ShS sh -> Int Source #

shsRank :: forall (sh :: [Nat]). ShS sh -> SNat (Rank sh) Source #

shsSize :: forall (sh :: [Nat]). ShS sh -> Int Source #

shsToList :: forall (sh :: [Nat]). ShS sh -> [Int] Source #

shsHead :: forall (n :: Nat) (sh :: [Nat]). ShS (n ': sh) -> SNat n Source #

shsTail :: forall (n :: Nat) (sh :: [Nat]). ShS (n ': sh) -> ShS sh Source #

shsInit :: forall (n :: Nat) (sh :: [Nat]). ShS (n ': sh) -> ShS (Init (n ': sh)) Source #

shsLast :: forall (n :: Nat) (sh :: [Nat]). ShS (n ': sh) -> SNat (Last (n ': sh)) Source #

shsAppend :: forall (sh :: [Nat]) (sh' :: [Nat]). ShS sh -> ShS sh' -> ShS (sh ++ sh') Source #

shsTakeLen :: forall (is :: [Nat]) (sh :: [Nat]). Perm is -> ShS sh -> ShS (TakeLen is sh) Source #

shsPermute :: forall (is :: [Nat]) (sh :: [Nat]). Perm is -> ShS sh -> ShS (Permute is sh) Source #

shsIndex :: forall {k1} {k2} (is :: k1) (shT :: k2) (i :: Nat) (sh :: [Nat]). Proxy is -> Proxy shT -> SNat i -> ShS sh -> SNat (Index i sh) Source #

shsPermutePrefix :: forall (is :: [Nat]) (sh :: [Nat]). Perm is -> ShS sh -> ShS (PermutePrefix is sh) Source #

type family Product (sh :: [Natural]) :: Natural where ... Source #

Equations

Product ('[] :: [Natural]) = 1 
Product (n ': ns) = n * Product ns 

shsProduct :: forall (sh :: [Nat]). ShS sh -> SNat (Product sh) Source #

class KnownShS (sh :: [Nat]) where Source #

Evidence for the static part of a shape. This pops up only when you are polymorphic in the element type of an array.

Methods

knownShS :: ShS sh Source #

Instances

Instances details
KnownShS ('[] :: [Nat]) Source # 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

Methods

knownShS :: ShS ('[] :: [Nat]) Source #

(KnownNat n, KnownShS sh) => KnownShS (n ': sh) Source # 
Instance details

Defined in Data.Array.Nested.Shaped.Shape

Methods

knownShS :: ShS (n ': sh) Source #

withKnownShS :: forall (sh :: [Nat]) r. ShS sh -> (KnownShS sh => r) -> r Source #

shsKnownShS :: forall (sh :: [Nat]). ShS sh -> Dict KnownShS sh Source #

shsOrthotopeShape :: forall (sh :: [Nat]). ShS sh -> Dict Shape sh Source #

shsFromListS :: forall (sh :: [Nat]) (f :: Nat -> Type). ListS sh f -> ShS sh Source #

This function is a hack made possible by the KnownNat inside ListS. This function may be removed in a future release.

shsFromIxS :: forall (sh :: [Nat]) i. IxS sh i -> ShS sh Source #

This function is a hack made possible by the KnownNat inside IxS. This function may be removed in a future release.