aboutsummaryrefslogtreecommitdiff
path: root/src/Data/Array/Nested
diff options
context:
space:
mode:
authorMikolaj Konarski <mikolaj.konarski@gmail.com>2024-04-21 17:22:38 +0200
committerMikolaj Konarski <mikolaj.konarski@gmail.com>2024-04-21 18:11:11 +0200
commitd4397160c5c5476dc4d93a169b06f6a03f1dab02 (patch)
tree1320b540d2c57329eeabbe27ac561d08602403d9 /src/Data/Array/Nested
parent3a82a91be0f1b18f071cdb35526b2b2d0b8e093f (diff)
Rename sized lists constructors according to the Convention
Diffstat (limited to 'src/Data/Array/Nested')
-rw-r--r--src/Data/Array/Nested/Internal.hs86
1 files changed, 43 insertions, 43 deletions
diff --git a/src/Data/Array/Nested/Internal.hs b/src/Data/Array/Nested/Internal.hs
index 9a87389..0582a14 100644
--- a/src/Data/Array/Nested/Internal.hs
+++ b/src/Data/Array/Nested/Internal.hs
@@ -59,7 +59,7 @@ import Data.INat
-- array. For example, for this array:
--
-- arr :: Ranked I3 (Ranked I2 Int, Ranked I1 Float)
--- rshape arr == 0 ::: 0 ::: 0 ::: IZR
+-- rshape arr == 0 :.: 0 :.: 0 :.: ZIR
--
-- the two underlying XArrays have a shape, and those shapes might be anything.
-- The invariant is that these element shapes are unobservable in the API.
@@ -87,7 +87,7 @@ lemKnownReplicate :: forall n. KnownINat n => Proxy n -> Dict KnownShapeX (Repli
lemKnownReplicate _ = X.lemKnownShapeX (go (inatSing @n))
where
go :: SINat m -> StaticShapeX (Replicate m Nothing)
- go SZ = SZX
+ go SZ = ZSX
go (SS n) = () :$? go n
lemRankReplicate :: forall n. KnownINat n => Proxy n -> X.Rank (Replicate n (Nothing @Nat)) :~: n
@@ -106,9 +106,9 @@ lemReplicatePlusApp _ _ _ = go (inatSing @n)
go (SS n) | Refl <- go n = Refl
ixAppSplit :: Proxy sh' -> StaticShapeX sh -> IIxX (sh ++ sh') -> (IIxX sh, IIxX sh')
-ixAppSplit _ SZX idx = (IZX, idx)
-ixAppSplit p (_ :$@ ssh) (i ::@ idx) = first (i ::@) (ixAppSplit p ssh idx)
-ixAppSplit p (_ :$? ssh) (i ::? idx) = first (i ::?) (ixAppSplit p ssh idx)
+ixAppSplit _ ZSX idx = (ZIX, idx)
+ixAppSplit p (_ :$@ ssh) (i :.@ idx) = first (i :.@) (ixAppSplit p ssh idx)
+ixAppSplit p (_ :$? ssh) (i :.? idx) = first (i :.?) (ixAppSplit p ssh idx)
-- | Wrapper type used as a tag to attach instances on. The instances on arrays
@@ -429,9 +429,9 @@ instance (Elt a, KnownShapeX sh') => Elt (Mixed sh' a) where
-- | Check whether a given shape corresponds on the statically-known components of the shape.
checkBounds :: IIxX sh' -> StaticShapeX sh' -> Bool
-checkBounds IZX SZX = True
-checkBounds (n ::@ sh') (n' :$@ ssh') = n == fromIntegral (fromSNat n') && checkBounds sh' ssh'
-checkBounds (_ ::? sh') (() :$? ssh') = checkBounds sh' ssh'
+checkBounds ZIX ZSX = True
+checkBounds (n :.@ sh') (n' :$@ ssh') = n == fromIntegral (fromSNat n') && checkBounds sh' ssh'
+checkBounds (_ :.? sh') (() :$? ssh') = checkBounds sh' ssh'
-- | Create an array given a size and a function that computes the element at a
-- given index.
@@ -441,8 +441,8 @@ checkBounds (_ ::? sh') (() :$? ssh') = checkBounds sh' ssh'
-- runtime error:
--
-- > foo :: Mixed [Nothing] (Mixed [Nothing] Double)
--- > foo = mgenerate (10 ::: IZR) $ \(i ::: IZR) ->
--- > mgenerate (i ::: IZR) $ \(j ::: IZR) ->
+-- > foo = mgenerate (10 :.: ZIR) $ \(i :.: ZIR) ->
+-- > mgenerate (i :.: ZIR) $ \(j :.: ZIR) ->
-- > ...
--
-- because the size of the inner 'mgenerate' is not always the same (it depends
@@ -502,7 +502,7 @@ mtoList1 :: Elt a => Mixed '[n] a -> [a]
mtoList1 = map munScalar . mtoList
munScalar :: Elt a => Mixed '[] a -> a
-munScalar arr = mindex arr IZX
+munScalar arr = mindex arr ZIX
mconstantP :: forall sh a. (KnownShapeX sh, Storable a) => IIxX sh -> a -> Mixed sh (Primitive a)
mconstantP sh x
@@ -708,7 +708,7 @@ lemKnownMapJust :: forall sh. KnownShape sh => Proxy sh -> Dict KnownShapeX (Map
lemKnownMapJust _ = X.lemKnownShapeX (go (knownShape @sh))
where
go :: SShape sh' -> StaticShapeX (MapJust sh')
- go ShNil = SZX
+ go ShNil = ZSX
go (ShCons n sh) = n :$@ go sh
lemMapJustPlusApp :: forall sh1 sh2. KnownShape sh1 => Proxy sh1 -> Proxy sh2
@@ -852,34 +852,34 @@ deriving via Ranked n (Primitive Double) instance KnownINat n => Num (Ranked n D
-- | An index into a rank-typed array.
type IxR :: Type -> INat -> Type
data IxR i n where
- IZR :: IxR i Z
- (:::) :: forall n i. i -> IxR i n -> IxR i (S n)
+ ZIR :: IxR i Z
+ (:.:) :: forall n i. i -> IxR i n -> IxR i (S n)
deriving instance Show i => Show (IxR i n)
deriving instance Eq i => Eq (IxR i n)
-infixr 3 :::
+infixr 3 :.:
type IIxR = IxR Int
zeroIxR :: SINat n -> IIxR n
-zeroIxR SZ = IZR
-zeroIxR (SS n) = 0 ::: zeroIxR n
+zeroIxR SZ = ZIR
+zeroIxR (SS n) = 0 :.: zeroIxR n
ixCvtXR :: IIxX sh -> IIxR (X.Rank sh)
-ixCvtXR IZX = IZR
-ixCvtXR (n ::@ idx) = n ::: ixCvtXR idx
-ixCvtXR (n ::? idx) = n ::: ixCvtXR idx
+ixCvtXR ZIX = ZIR
+ixCvtXR (n :.@ idx) = n :.: ixCvtXR idx
+ixCvtXR (n :.? idx) = n :.: ixCvtXR idx
ixCvtRX :: IIxR n -> IIxX (Replicate n Nothing)
-ixCvtRX IZR = IZX
-ixCvtRX (n ::: idx) = n ::? ixCvtRX idx
+ixCvtRX ZIR = ZIX
+ixCvtRX (n :.: idx) = n :.? ixCvtRX idx
knownIxR :: IIxR n -> Dict KnownINat n
-knownIxR IZR = Dict
-knownIxR (_ ::: idx) | Dict <- knownIxR idx = Dict
+knownIxR ZIR = Dict
+knownIxR (_ :.: idx) | Dict <- knownIxR idx = Dict
shapeSizeR :: IIxR n -> Int
-shapeSizeR IZR = 1
-shapeSizeR (n ::: sh) = n * shapeSizeR sh
+shapeSizeR ZIR = 1
+shapeSizeR (n :.: sh) = n * shapeSizeR sh
rshape :: forall n a. (KnownINat n, Elt a) => Ranked n a -> IIxR n
@@ -921,7 +921,7 @@ rsumOuter1 (Ranked arr)
| Dict <- lemKnownReplicate (Proxy @n)
= Ranked
. coerce @(XArray (Replicate n 'Nothing) a) @(Mixed (Replicate n 'Nothing) (Primitive a))
- . X.sumOuter (() :$? SZX) (knownShapeX @(Replicate n Nothing))
+ . X.sumOuter (() :$? ZSX) (knownShapeX @(Replicate n Nothing))
. coerce @(Mixed (Replicate (S n) Nothing) (Primitive a)) @(XArray (Replicate (S n) Nothing) a)
$ arr
@@ -957,7 +957,7 @@ rtoList1 :: Elt a => Ranked I1 a -> [a]
rtoList1 = map runScalar . rtoList
runScalar :: Elt a => Ranked I0 a -> a
-runScalar arr = rindex arr IZR
+runScalar arr = rindex arr ZIR
rconstantP :: forall n a. (KnownINat n, Storable a) => IIxR n -> a -> Ranked n (Primitive a)
rconstantP sh x
@@ -1004,33 +1004,33 @@ deriving via Shaped sh (Primitive Double) instance KnownShape sh => Num (Shaped
-- from a 'KnownShape' dictionary.
type IxS :: Type -> [Nat] -> Type
data IxS i sh where
- IZS :: IxS i '[]
- (::$) :: forall n sh i. i -> IxS i sh -> IxS i (n : sh)
+ ZIS :: IxS i '[]
+ (:.$) :: forall n sh i. i -> IxS i sh -> IxS i (n : sh)
deriving instance Show i => Show (IxS i n)
deriving instance Eq i => Eq (IxS i n)
-infixr 3 ::$
+infixr 3 :.$
type IIxS = IxS Int
zeroIxS :: SShape sh -> IIxS sh
-zeroIxS ShNil = IZS
-zeroIxS (ShCons _ sh) = 0 ::$ zeroIxS sh
+zeroIxS ShNil = ZIS
+zeroIxS (ShCons _ sh) = 0 :.$ zeroIxS sh
cvtSShapeIxS :: SShape sh -> IIxS sh
-cvtSShapeIxS ShNil = IZS
-cvtSShapeIxS (ShCons n sh) = fromIntegral (fromSNat n) ::$ cvtSShapeIxS sh
+cvtSShapeIxS ShNil = ZIS
+cvtSShapeIxS (ShCons n sh) = fromIntegral (fromSNat n) :.$ cvtSShapeIxS sh
ixCvtXS :: SShape sh -> IIxX (MapJust sh) -> IIxS sh
-ixCvtXS ShNil IZX = IZS
-ixCvtXS (ShCons _ sh) (n ::@ idx) = n ::$ ixCvtXS sh idx
+ixCvtXS ShNil ZIX = ZIS
+ixCvtXS (ShCons _ sh) (n :.@ idx) = n :.$ ixCvtXS sh idx
ixCvtSX :: IIxS sh -> IIxX (MapJust sh)
-ixCvtSX IZS = IZX
-ixCvtSX (n ::$ sh) = n ::@ ixCvtSX sh
+ixCvtSX ZIS = ZIX
+ixCvtSX (n :.$ sh) = n :.@ ixCvtSX sh
shapeSizeS :: IIxS sh -> Int
-shapeSizeS IZS = 1
-shapeSizeS (n ::$ sh) = n * shapeSizeS sh
+shapeSizeS ZIS = 1
+shapeSizeS (n :.$ sh) = n * shapeSizeS sh
-- | This does not touch the passed array, all information comes from 'KnownShape'.
@@ -1068,7 +1068,7 @@ ssumOuter1 (Shaped arr)
| Dict <- lemKnownMapJust (Proxy @sh)
= Shaped
. coerce @(XArray (MapJust sh) a) @(Mixed (MapJust sh) (Primitive a))
- . X.sumOuter (natSing @n :$@ SZX) (knownShapeX @(MapJust sh))
+ . X.sumOuter (natSing @n :$@ ZSX) (knownShapeX @(MapJust sh))
. coerce @(Mixed (Just n : MapJust sh) (Primitive a)) @(XArray (Just n : MapJust sh) a)
$ arr
@@ -1105,7 +1105,7 @@ stoList1 :: Elt a => Shaped '[n] a -> [a]
stoList1 = map sunScalar . stoList
sunScalar :: Elt a => Shaped '[] a -> a
-sunScalar arr = sindex arr IZS
+sunScalar arr = sindex arr ZIS
sconstantP :: forall sh a. (KnownShape sh, Storable a) => a -> Shaped sh (Primitive a)
sconstantP x