aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Data/Array/Mixed.hs4
-rw-r--r--src/Data/Array/Nested.hs6
-rw-r--r--src/Data/Array/Nested/Internal.hs32
3 files changed, 21 insertions, 21 deletions
diff --git a/src/Data/Array/Mixed.hs b/src/Data/Array/Mixed.hs
index b07f120..33c0dd6 100644
--- a/src/Data/Array/Mixed.hs
+++ b/src/Data/Array/Mixed.hs
@@ -466,8 +466,8 @@ cast ssh1 sh2 ssh' (XArray arr)
unScalar :: Storable a => XArray '[] a -> a
unScalar (XArray a) = S.unScalar a
-constant :: forall sh a. Storable a => IShX sh -> a -> XArray sh a
-constant sh x
+replicate :: forall sh a. Storable a => IShX sh -> a -> XArray sh a
+replicate sh x
| Dict <- lemKnownNatRank sh
= XArray (S.constant (shapeLshape sh) x)
diff --git a/src/Data/Array/Nested.hs b/src/Data/Array/Nested.hs
index 438f144..51754d0 100644
--- a/src/Data/Array/Nested.hs
+++ b/src/Data/Array/Nested.hs
@@ -8,7 +8,7 @@ module Data.Array.Nested (
ShR(.., ZSR, (:$:)),
rshape, rindex, rindexPartial, rgenerate, rsumOuter1,
rtranspose, rappend, rscalar, rfromVector, rtoVector, runScalar,
- rconstant, rfromList, rfromList1, rtoList, rtoList1,
+ rreplicate, rfromList, rfromList1, rtoList, rtoList1,
rslice, rrev1, rreshape,
-- ** Lifting orthotope operations to 'Ranked' arrays
rlift,
@@ -23,7 +23,7 @@ module Data.Array.Nested (
ShS(.., ZSS, (:$$)), KnownShS(..),
sshape, sindex, sindexPartial, sgenerate, ssumOuter1,
stranspose, sappend, sscalar, sfromVector, stoVector, sunScalar,
- sconstant, sfromList, sfromList1, stoList, stoList1,
+ sreplicate, sfromList, sfromList1, stoList, stoList1,
sslice, srev1, sreshape,
-- ** Lifting orthotope operations to 'Shaped' arrays
slift,
@@ -36,7 +36,7 @@ module Data.Array.Nested (
IxX(..), IIxX,
KnownShX(..), StaticShX(..),
mgenerate, mtranspose, mappend, mfromVector, mtoVector, munScalar,
- mconstant, mfromList, mtoList, mslice, mrev1, mreshape,
+ mreplicate, mfromList, mtoList, mslice, mrev1, mreshape,
-- ** Conversions
masXArrayPrim, mfromXArrayPrim,
mtoRanked, mcastToShaped,
diff --git a/src/Data/Array/Nested/Internal.hs b/src/Data/Array/Nested/Internal.hs
index 3863556..99c4a46 100644
--- a/src/Data/Array/Nested/Internal.hs
+++ b/src/Data/Array/Nested/Internal.hs
@@ -900,12 +900,12 @@ mtoList = map munScalar . mtoList1
munScalar :: Elt a => Mixed '[] a -> a
munScalar arr = mindex arr ZIX
-mconstantP :: forall sh a. Storable a => IShX sh -> a -> Mixed sh (Primitive a)
-mconstantP sh x = M_Primitive sh (X.constant sh x)
+mreplicateP :: forall sh a. Storable a => IShX sh -> a -> Mixed sh (Primitive a)
+mreplicateP sh x = M_Primitive sh (X.replicate sh x)
-mconstant :: forall sh a. (Storable a, PrimElt a)
+mreplicate :: forall sh a. (Storable a, PrimElt a)
=> IShX sh -> a -> Mixed sh a
-mconstant sh x = fromPrimitive (mconstantP sh x)
+mreplicate sh x = fromPrimitive (mreplicateP sh x)
mslice :: Elt a => SNat i -> SNat n -> Mixed (Just (i + n + k) : sh) a -> Mixed (Just n : sh) a
mslice i n arr =
@@ -954,7 +954,7 @@ instance (Storable a, Num a, PrimElt a) => Num (Mixed sh a) where
negate = mliftPrim negate
abs = mliftPrim abs
signum = mliftPrim signum
- fromInteger _ = error "Data.Array.Nested.fromIntegral: No singletons available, use explicit mconstant"
+ fromInteger _ = error "Data.Array.Nested.fromIntegral: No singletons available, use explicit mreplicate"
mtoRanked :: forall sh a. Elt a => Mixed sh a -> Ranked (X.Rank sh) a
mtoRanked arr
@@ -1238,7 +1238,7 @@ instance (Storable a, Num a, PrimElt a) => Num (Ranked n a) where
negate = arithPromoteRanked negate
abs = arithPromoteRanked abs
signum = arithPromoteRanked signum
- fromInteger _ = error "Data.Array.Nested.fromIntegral: No singletons available, use explicit mconstant"
+ fromInteger _ = error "Data.Array.Nested.fromIntegral: No singletons available, use explicit mreplicate"
zeroIxR :: SNat n -> IIxR n
zeroIxR SZ = ZIR
@@ -1389,14 +1389,14 @@ rtoList1 = map runScalar . rtoList
runScalar :: Elt a => Ranked 0 a -> a
runScalar arr = rindex arr ZIR
-rconstantP :: forall n a. Storable a => IShR n -> a -> Ranked n (Primitive a)
-rconstantP sh x
+rreplicateP :: forall n a. Storable a => IShR n -> a -> Ranked n (Primitive a)
+rreplicateP sh x
| Dict <- lemKnownReplicate (snatFromShR sh)
- = Ranked (mconstantP (shCvtRX sh) x)
+ = Ranked (mreplicateP (shCvtRX sh) x)
-rconstant :: forall n a. (Storable a, PrimElt a)
+rreplicate :: forall n a. (Storable a, PrimElt a)
=> IShR n -> a -> Ranked n a
-rconstant sh x = coerce fromPrimitive (rconstantP sh x)
+rreplicate sh x = coerce fromPrimitive (rreplicateP sh x)
rslice :: forall n a. Elt a => Int -> Int -> Ranked (n + 1) a -> Ranked (n + 1) a
rslice i n arr
@@ -1458,7 +1458,7 @@ instance (Storable a, Num a, PrimElt a) => Num (Shaped sh a) where
negate = arithPromoteShaped negate
abs = arithPromoteShaped abs
signum = arithPromoteShaped signum
- fromInteger _ = error "Data.Array.Nested.fromIntegral: No singletons available, use explicit mconstant"
+ fromInteger _ = error "Data.Array.Nested.fromIntegral: No singletons available, use explicit mreplicate"
zeroIxS :: ShS sh -> IIxS sh
zeroIxS ZSS = ZIS
@@ -1619,11 +1619,11 @@ stoList1 = map sunScalar . stoList
sunScalar :: Elt a => Shaped '[] a -> a
sunScalar arr = sindex arr ZIS
-sconstantP :: forall sh a. Storable a => ShS sh -> a -> Shaped sh (Primitive a)
-sconstantP sh x = Shaped (mconstantP (shCvtSX sh) x)
+sreplicateP :: forall sh a. Storable a => ShS sh -> a -> Shaped sh (Primitive a)
+sreplicateP sh x = Shaped (mreplicateP (shCvtSX sh) x)
-sconstant :: (Storable a, PrimElt a) => ShS sh -> a -> Shaped sh a
-sconstant sh x = coerce fromPrimitive (sconstantP sh x)
+sreplicate :: (Storable a, PrimElt a) => ShS sh -> a -> Shaped sh a
+sreplicate sh x = coerce fromPrimitive (sreplicateP sh x)
sslice :: Elt a => SNat i -> SNat n -> Shaped (i + n + k : sh) a -> Shaped (n : sh) a
sslice i n@SNat arr =