aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Data/Array/Mixed/XArray.hs4
-rw-r--r--src/Data/Array/Nested/Internal/Mixed.hs33
-rw-r--r--src/Data/Array/Nested/Internal/Ranked.hs8
-rw-r--r--src/Data/Array/Nested/Internal/Shaped.hs8
4 files changed, 34 insertions, 19 deletions
diff --git a/src/Data/Array/Mixed/XArray.hs b/src/Data/Array/Mixed/XArray.hs
index 81b92c5..b564e14 100644
--- a/src/Data/Array/Mixed/XArray.hs
+++ b/src/Data/Array/Mixed/XArray.hs
@@ -14,7 +14,7 @@
{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
module Data.Array.Mixed.XArray where
-import Control.DeepSeq (NFData(..))
+import Control.DeepSeq (NFData)
import Data.Array.Ranked qualified as ORB
import Data.Array.RankedS qualified as S
import Data.Coerce
@@ -43,7 +43,7 @@ newtype XArray sh a = XArray (S.Array (Rank sh) a)
-- | Only on scalars, because lexicographical ordering is strange on multi-dimensional arrays.
deriving instance (Ord a, Storable a) => Ord (XArray sh a)
-instance NFData a => NFData (XArray sh a)
+instance NFData (XArray sh a)
shape :: forall sh a. StaticShX sh -> XArray sh a -> IShX sh
diff --git a/src/Data/Array/Nested/Internal/Mixed.hs b/src/Data/Array/Nested/Internal/Mixed.hs
index b155da5..d3e8088 100644
--- a/src/Data/Array/Nested/Internal/Mixed.hs
+++ b/src/Data/Array/Nested/Internal/Mixed.hs
@@ -20,7 +20,7 @@ module Data.Array.Nested.Internal.Mixed where
import Prelude hiding (mconcat)
-import Control.DeepSeq (NFData)
+import Control.DeepSeq (NFData(..))
import Control.Monad (forM_, when)
import Control.Monad.ST
import Data.Array.RankedS qualified as S
@@ -143,8 +143,6 @@ data instance Mixed sh (Primitive a) = M_Primitive !(IShX sh) !(XArray sh a)
-- | Only on scalars, because lexicographical ordering is strange on multi-dimensional arrays.
deriving instance (Ord a, Storable a) => Ord (Mixed sh (Primitive a))
-instance NFData a => NFData (Mixed sh (Primitive a))
-
-- [PRIMITIVE ELEMENT TYPES LIST]
newtype instance Mixed sh Bool = M_Bool (Mixed sh (Primitive Bool)) deriving (Eq, Generic)
newtype instance Mixed sh Int = M_Int (Mixed sh (Primitive Int)) deriving (Eq, Generic)
@@ -157,21 +155,19 @@ newtype instance Mixed sh () = M_Nil (Mixed sh (Primitive ())) deriving (Eq, Gen
-- etc.
-- [PRIMITIVE ELEMENT TYPES LIST]
-deriving instance Ord (Mixed sh Bool) ; instance NFData (Mixed sh Bool)
-deriving instance Ord (Mixed sh Int) ; instance NFData (Mixed sh Int)
-deriving instance Ord (Mixed sh Int64) ; instance NFData (Mixed sh Int64)
-deriving instance Ord (Mixed sh Int32) ; instance NFData (Mixed sh Int32)
-deriving instance Ord (Mixed sh CInt) ; instance NFData (Mixed sh CInt)
-deriving instance Ord (Mixed sh Float) ; instance NFData (Mixed sh Float)
-deriving instance Ord (Mixed sh Double) ; instance NFData (Mixed sh Double)
-deriving instance Ord (Mixed sh ()) ; instance NFData (Mixed sh ())
+deriving instance Ord (Mixed sh Bool)
+deriving instance Ord (Mixed sh Int)
+deriving instance Ord (Mixed sh Int64)
+deriving instance Ord (Mixed sh Int32)
+deriving instance Ord (Mixed sh CInt)
+deriving instance Ord (Mixed sh Float)
+deriving instance Ord (Mixed sh Double)
+deriving instance Ord (Mixed sh ())
data instance Mixed sh (a, b) = M_Tup2 !(Mixed sh a) !(Mixed sh b) deriving (Generic)
-instance (NFData (Mixed sh a), NFData (Mixed sh b)) => NFData (Mixed sh (a, b))
-- etc., larger tuples (perhaps use generics to allow arbitrary product types)
data instance Mixed sh1 (Mixed sh2 a) = M_Nest !(IShX sh1) !(Mixed (sh1 ++ sh2) a) deriving (Generic)
-instance NFData (Mixed (sh1 ++ sh2) a) => NFData (Mixed sh1 (Mixed sh2 a))
-- | Internal helper data family mirroring 'Mixed' that consists of mutable
@@ -218,6 +214,9 @@ instance (Show a, Storable a) => Show (ShowViaPrimitive sh a) where
deriving via (ShowViaToListLinear sh a) instance (Show a, Elt a) => Show (Mixed sh a)
+instance Elt a => NFData (Mixed sh a) where
+ rnf = mrnf
+
mliftNumElt1 :: (PrimElt a, PrimElt b)
=> (SNat (Rank sh) -> S.Array (Rank sh) a -> S.Array (Rank sh) b)
@@ -330,6 +329,8 @@ class Elt a where
-- inside their elements.
mconcat :: NonEmpty (Mixed (Nothing : sh) a) -> Mixed (Nothing : sh) a
+ mrnf :: Mixed sh a -> ()
+
-- ====== PRIVATE METHODS ====== --
-- | Tree giving the shape of every array component.
@@ -432,6 +433,8 @@ instance Storable a => Elt (Primitive a) where
let result = X.concat (ssxFromShape sh) (fmap (\(M_Primitive _ arr) -> arr) l)
in M_Primitive (X.shape (SUnknown () :!% ssxFromShape sh) result) result
+ mrnf (M_Primitive sh a) = rnf sh `seq` rnf a
+
type ShapeTree (Primitive a) = ()
mshapeTree _ = ()
mshapeTreeEq _ () () = True
@@ -503,6 +506,8 @@ instance (Elt a, Elt b) => Elt (a, b) where
unzipT2 (M_Tup2 a b :| l) = let (l1, l2) = unzipT2l l in (a :| l1, b :| l2)
in uncurry M_Tup2 . bimap mconcat mconcat . unzipT2
+ mrnf (M_Tup2 a b) = mrnf a `seq` mrnf b
+
type ShapeTree (a, b) = (ShapeTree a, ShapeTree b)
mshapeTree (x, y) = (mshapeTree x, mshapeTree y)
mshapeTreeEq _ (t1, t2) (t1', t2') = mshapeTreeEq (Proxy @a) t1 t1' && mshapeTreeEq (Proxy @b) t2 t2'
@@ -627,6 +632,8 @@ instance Elt a => Elt (Mixed sh' a) where
let result = mconcat (fmap (\(M_Nest _ arr) -> arr) l)
in M_Nest (fst (shxSplitApp (Proxy @sh') (ssxFromShape sh1) (mshape result))) result
+ mrnf (M_Nest sh arr) = rnf sh `seq` mrnf arr
+
type ShapeTree (Mixed sh' a) = (IShX sh', ShapeTree a)
mshapeTree :: Mixed sh' a -> ShapeTree (Mixed sh' a)
diff --git a/src/Data/Array/Nested/Internal/Ranked.hs b/src/Data/Array/Nested/Internal/Ranked.hs
index 54094cc..b3d4f91 100644
--- a/src/Data/Array/Nested/Internal/Ranked.hs
+++ b/src/Data/Array/Nested/Internal/Ranked.hs
@@ -21,7 +21,7 @@ module Data.Array.Nested.Internal.Ranked where
import Prelude hiding (mappend, mconcat)
-import Control.DeepSeq (NFData)
+import Control.DeepSeq (NFData(..))
import Control.Monad.ST
import Data.Array.RankedS qualified as S
import Data.Bifunctor (first)
@@ -61,13 +61,15 @@ type Ranked :: Nat -> Type -> Type
newtype Ranked n a = Ranked (Mixed (Replicate n Nothing) a)
deriving instance Eq (Mixed (Replicate n Nothing) a) => Eq (Ranked n a)
deriving instance Ord (Mixed (Replicate n Nothing) a) => Ord (Ranked n a)
-deriving instance NFData (Mixed (Replicate n Nothing) a) => NFData (Ranked n a)
instance (Show a, Elt a) => Show (Ranked n a) where
showsPrec d arr = showParen (d > 10) $
showString "rfromListLinear " . shows (toList (rshape arr)) . showString " "
. shows (rtoListLinear arr)
+instance Elt a => NFData (Ranked n a) where
+ rnf (Ranked arr) = rnf arr
+
-- just unwrap the newtype and defer to the general instance for nested arrays
newtype instance Mixed sh (Ranked n a) = M_Ranked (Mixed sh (Mixed (Replicate n Nothing) a))
@@ -125,6 +127,8 @@ instance Elt a => Elt (Ranked n a) where
mconcat l = M_Ranked (mconcat (coerce l))
+ mrnf (M_Ranked arr) = mrnf arr
+
type ShapeTree (Ranked n a) = (IShR n, ShapeTree a)
mshapeTree (Ranked arr) = first shCvtXR' (mshapeTree arr)
diff --git a/src/Data/Array/Nested/Internal/Shaped.hs b/src/Data/Array/Nested/Internal/Shaped.hs
index efeb618..ece4272 100644
--- a/src/Data/Array/Nested/Internal/Shaped.hs
+++ b/src/Data/Array/Nested/Internal/Shaped.hs
@@ -20,7 +20,7 @@ module Data.Array.Nested.Internal.Shaped where
import Prelude hiding (mappend, mconcat)
-import Control.DeepSeq (NFData)
+import Control.DeepSeq (NFData(..))
import Control.Monad.ST
import Data.Array.Internal.ShapedS qualified as SS
import Data.Array.Internal.ShapedG qualified as SG
@@ -62,13 +62,15 @@ type Shaped :: [Nat] -> Type -> Type
newtype Shaped sh a = Shaped (Mixed (MapJust sh) a)
deriving instance Eq (Mixed (MapJust sh) a) => Eq (Shaped sh a)
deriving instance Ord (Mixed (MapJust sh) a) => Ord (Shaped sh a)
-deriving instance NFData (Mixed (MapJust sh) a) => NFData (Shaped sh a)
instance (Show a, Elt a) => Show (Shaped sh a) where
showsPrec d arr = showParen (d > 10) $
showString "sfromListLinear " . shows (shsToList (sshape arr)) . showString " "
. shows (stoListLinear arr)
+instance Elt a => NFData (Shaped sh a) where
+ rnf (Shaped arr) = rnf arr
+
-- just unwrap the newtype and defer to the general instance for nested arrays
newtype instance Mixed sh (Shaped sh' a) = M_Shaped (Mixed sh (Mixed (MapJust sh') a))
@@ -123,6 +125,8 @@ instance Elt a => Elt (Shaped sh a) where
mconcat l = M_Shaped (mconcat (coerce l))
+ mrnf (M_Shaped arr) = mrnf arr
+
type ShapeTree (Shaped sh a) = (ShS sh, ShapeTree a)
mshapeTree (Shaped arr) = first shCvtXS' (mshapeTree arr)
generated by cgit v1.2.3-70-g09d2 (git 2.48.1) at 2025-02-22 09:41:35 +0100