aboutsummaryrefslogtreecommitdiff
path: root/src/Data/Array
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data/Array')
-rw-r--r--src/Data/Array/Mixed/Shape.hs5
-rw-r--r--src/Data/Array/Nested/Internal/Shape.hs29
2 files changed, 30 insertions, 4 deletions
diff --git a/src/Data/Array/Mixed/Shape.hs b/src/Data/Array/Mixed/Shape.hs
index 80bd55e..99a137d 100644
--- a/src/Data/Array/Mixed/Shape.hs
+++ b/src/Data/Array/Mixed/Shape.hs
@@ -452,6 +452,11 @@ infixr 3 :!%
instance Show (StaticShX sh) where
showsPrec _ (StaticShX l) = listxShow (fromSMayNat shows (shows . fromSNat)) l
+instance NFData (StaticShX sh) where
+ rnf (StaticShX ZX) = ()
+ rnf (StaticShX (SUnknown () ::% l)) = rnf (StaticShX l)
+ rnf (StaticShX (SKnown SNat ::% l)) = rnf (StaticShX l)
+
instance TestEquality StaticShX where
testEquality (StaticShX l1) (StaticShX l2) = listxEqType l1 l2
diff --git a/src/Data/Array/Nested/Internal/Shape.hs b/src/Data/Array/Nested/Internal/Shape.hs
index 878ea7e..5d5f8e3 100644
--- a/src/Data/Array/Nested/Internal/Shape.hs
+++ b/src/Data/Array/Nested/Internal/Shape.hs
@@ -1,6 +1,7 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
@@ -25,6 +26,7 @@
{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
module Data.Array.Nested.Internal.Shape where
+import Control.DeepSeq (NFData (..))
import Data.Array.Shape qualified as O
import Data.Array.Mixed.Types
import Data.Coerce (coerce)
@@ -35,6 +37,7 @@ import Data.Monoid (Sum(..))
import Data.Proxy
import Data.Type.Equality
import GHC.Exts (withDict)
+import GHC.Generics (Generic)
import GHC.IsList (IsList)
import GHC.IsList qualified as IsList
import GHC.TypeLits
@@ -59,6 +62,10 @@ infixr 3 :::
instance Show i => Show (ListR n i) where
showsPrec _ = listrShow shows
+instance NFData i => NFData (ListR n i) where
+ rnf ZR = ()
+ rnf (x ::: l) = rnf x `seq` rnf l
+
data UnconsListRRes i n1 =
forall n. (n + 1 ~ n1) => UnconsListRRes (ListR n i) i
listrUncons :: ListR n1 i -> Maybe (UnconsListRRes i n1)
@@ -157,7 +164,7 @@ listrPermutePrefix = \perm sh ->
type role IxR nominal representational
type IxR :: Nat -> Type -> Type
newtype IxR n i = IxR (ListR n i)
- deriving (Eq, Ord)
+ deriving (Eq, Ord, Generic)
deriving newtype (Functor, Foldable)
pattern ZIR :: forall n i. () => n ~ 0 => IxR n i
@@ -178,6 +185,8 @@ type IIxR n = IxR n Int
instance Show i => Show (IxR n i) where
showsPrec _ (IxR l) = listrShow shows l
+instance NFData i => NFData (IxR sh i)
+
ixrLength :: IxR sh i -> Int
ixrLength (IxR l) = listrLength l
@@ -220,7 +229,7 @@ ixrPermutePrefix = coerce (listrPermutePrefix @i)
type role ShR nominal representational
type ShR :: Nat -> Type -> Type
newtype ShR n i = ShR (ListR n i)
- deriving (Eq, Ord)
+ deriving (Eq, Ord, Generic)
deriving newtype (Functor, Foldable)
pattern ZSR :: forall n i. () => n ~ 0 => ShR n i
@@ -241,6 +250,8 @@ type IShR n = ShR n Int
instance Show i => Show (ShR n i) where
showsPrec _ (ShR l) = listrShow shows l
+instance NFData i => NFData (ShR sh i)
+
shCvtXR' :: forall n. IShX (Replicate n Nothing) -> IShR n
shCvtXR' ZSX =
castWith (subst2 (unsafeCoerceRefl :: 0 :~: n))
@@ -346,6 +357,10 @@ infixr 3 ::$
instance (forall n. Show (f n)) => Show (ListS sh f) where
showsPrec _ = listsShow shows
+instance (forall m. NFData (f m)) => NFData (ListS n f) where
+ rnf ZS = ()
+ rnf (x ::$ l) = rnf x `seq` rnf l
+
data UnconsListSRes f sh1 =
forall n sh. (KnownNat n, n : sh ~ sh1) => UnconsListSRes (ListS sh f) (f n)
listsUncons :: ListS sh1 f -> Maybe (UnconsListSRes f sh1)
@@ -454,7 +469,7 @@ listsPermutePrefix perm sh = listsAppend (listsPermute perm (listsTakeLenPerm pe
type role IxS nominal representational
type IxS :: [Nat] -> Type -> Type
newtype IxS sh i = IxS (ListS sh (Const i))
- deriving (Eq, Ord)
+ deriving (Eq, Ord, Generic)
pattern ZIS :: forall sh i. () => sh ~ '[] => IxS sh i
pattern ZIS = IxS ZS
@@ -480,6 +495,8 @@ instance Functor (IxS sh) where
instance Foldable (IxS sh) where
foldMap f (IxS l) = listsFold (f . getConst) l
+instance NFData i => NFData (IxS sh i)
+
ixsLength :: IxS sh i -> Int
ixsLength (IxS l) = listsLength l
@@ -524,7 +541,7 @@ ixsPermutePrefix = coerce (listsPermutePrefix @(Const i))
type role ShS nominal
type ShS :: [Nat] -> Type
newtype ShS sh = ShS (ListS sh SNat)
- deriving (Eq, Ord)
+ deriving (Eq, Ord, Generic)
pattern ZSS :: forall sh. () => sh ~ '[] => ShS sh
pattern ZSS = ShS ZS
@@ -543,6 +560,10 @@ infixr 3 :$$
instance Show (ShS sh) where
showsPrec _ (ShS l) = listsShow (shows . fromSNat) l
+instance NFData (ShS sh) where
+ rnf (ShS ZS) = ()
+ rnf (ShS (SNat ::$ l)) = rnf (ShS l)
+
instance TestEquality ShS where
testEquality (ShS l1) (ShS l2) = listsEqType l1 l2