From 84b00455fff01c21953262325c1b6fca69b16ff0 Mon Sep 17 00:00:00 2001 From: Tom Smeding Date: Sat, 25 May 2024 11:25:35 +0200 Subject: NFData instances --- src/Data/Array/Mixed.hs | 26 ++++++++++++++++--- src/Data/Array/Nested/Internal.hs | 53 +++++++++++++++++++++------------------ 2 files changed, 51 insertions(+), 28 deletions(-) (limited to 'src') diff --git a/src/Data/Array/Mixed.hs b/src/Data/Array/Mixed.hs index d894b85..1e8cee2 100644 --- a/src/Data/Array/Mixed.hs +++ b/src/Data/Array/Mixed.hs @@ -2,6 +2,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.Mixed where +import Control.DeepSeq (NFData(..)) import qualified Data.Array.RankedS as S import qualified Data.Array.Ranked as ORB import Data.Bifunctor (first) @@ -38,6 +40,7 @@ import Data.Type.Bool import Data.Type.Equality import qualified Data.Vector.Storable as VS import Foreign.Storable (Storable) +import GHC.Generics (Generic) import GHC.IsList (IsList) import qualified GHC.IsList as IsList import GHC.TypeError @@ -106,6 +109,10 @@ infixr 3 ::% instance (forall n. Show (f n)) => Show (ListX sh f) where showsPrec _ = showListX shows +instance (forall n. NFData (f n)) => NFData (ListX sh f) where + rnf ZX = () + rnf (x ::% l) = rnf x `seq` rnf l + data UnconsListXRes f sh1 = forall n sh. (n : sh ~ sh1) => UnconsListXRes (ListX sh f) (f n) unconsListX :: ListX sh1 f -> Maybe (UnconsListXRes f sh1) @@ -142,7 +149,7 @@ listXToList (Const i ::% is) = i : listXToList is type role IxX nominal representational type IxX :: [Maybe Nat] -> Type -> Type newtype IxX sh i = IxX (ListX sh (Const i)) - deriving (Eq, Ord) + deriving (Eq, Ord, Generic) pattern ZIX :: forall sh i. () => sh ~ '[] => IxX sh i pattern ZIX = IxX ZX @@ -168,6 +175,8 @@ instance Functor (IxX sh) where instance Foldable (IxX sh) where foldMap f (IxX l) = foldListX (f . getConst) l +instance NFData i => NFData (IxX sh i) + data SMayNat i f n where SUnknown :: i -> SMayNat i f Nothing @@ -176,6 +185,10 @@ deriving instance (Show i, forall m. Show (f m)) => Show (SMayNat i f n) deriving instance (Eq i, forall m. Eq (f m)) => Eq (SMayNat i f n) deriving instance (Ord i, forall m. Ord (f m)) => Ord (SMayNat i f n) +instance (NFData i, forall m. NFData (f m)) => NFData (SMayNat i f n) where + rnf (SUnknown i) = rnf i + rnf (SKnown x) = rnf x + fromSMayNat :: (n ~ Nothing => i -> r) -> (forall m. n ~ Just m => f m -> r) -> SMayNat i f n -> r fromSMayNat f _ (SUnknown i) = f i fromSMayNat _ g (SKnown s) = g s @@ -186,7 +199,7 @@ fromSMayNat' = fromSMayNat id fromSNat' type role ShX nominal representational type ShX :: [Maybe Nat] -> Type -> Type newtype ShX sh i = ShX (ListX sh (SMayNat i SNat)) - deriving (Eq, Ord) + deriving (Eq, Ord, Generic) pattern ZSX :: forall sh i. () => sh ~ '[] => ShX sh i pattern ZSX = ShX ZX @@ -209,6 +222,11 @@ instance Show i => Show (ShX sh i) where instance Functor (ShX sh) where fmap f (ShX l) = ShX (fmapListX (fromSMayNat (SUnknown . f) SKnown) l) +instance NFData i => NFData (ShX sh i) where + rnf (ShX ZX) = () + rnf (ShX (SUnknown i ::% l)) = rnf i `seq` rnf (ShX l) + rnf (ShX (SKnown SNat ::% l)) = rnf (ShX l) + lengthShX :: ShX sh i -> Int lengthShX (ShX l) = lengthListX l @@ -294,11 +312,13 @@ type family Rank sh where type XArray :: [Maybe Nat] -> Type -> Type newtype XArray sh a = XArray (S.Array (Rank sh) a) - deriving (Show, Eq) + deriving (Show, Eq, Generic) -- | Only on scalars, because lexicographical ordering is strange on multi-dimensional arrays. deriving instance (Ord a, Storable a) => Ord (XArray '[] a) +instance NFData a => NFData (XArray sh a) + zeroIxX :: StaticShX sh -> IIxX sh zeroIxX ZKX = ZIX zeroIxX (_ :!% ssh) = 0 :.% zeroIxX ssh diff --git a/src/Data/Array/Nested/Internal.hs b/src/Data/Array/Nested/Internal.hs index b7308fa..a440ccc 100644 --- a/src/Data/Array/Nested/Internal.hs +++ b/src/Data/Array/Nested/Internal.hs @@ -3,6 +3,7 @@ {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -27,16 +28,11 @@ {-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-} {-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-} -{-| -TODO: -(empty list) - --} - module Data.Array.Nested.Internal where import Prelude hiding (mappend) +import Control.DeepSeq (NFData) import Control.Monad (forM_, when) import Control.Monad.ST import qualified Data.Array.RankedS as S @@ -55,6 +51,7 @@ import qualified Data.Vector.Storable.Mutable as VSM import Foreign.C.Types (CInt(..)) import Foreign.Storable (Storable) import qualified GHC.Float (log1p, expm1, log1pexp, log1mexp) +import GHC.Generics (Generic) import GHC.IsList (IsList) import qualified GHC.IsList as IsList import GHC.TypeLits @@ -463,36 +460,40 @@ data family Mixed sh a -- ostensibly not exist; the full array is still empty. data instance Mixed sh (Primitive a) = M_Primitive !(IShX sh) !(XArray sh a) - deriving (Show, Eq) + deriving (Show, Eq, Generic) -- | Only on scalars, because lexicographical ordering is strange on multi-dimensional arrays. deriving instance (Ord a, Storable a) => Ord (Mixed '[] (Primitive a)) +instance NFData a => NFData (Mixed sh (Primitive a)) + -- [PRIMITIVE ELEMENT TYPES LIST] -newtype instance Mixed sh Int = M_Int (Mixed sh (Primitive Int)) deriving (Show, Eq) -newtype instance Mixed sh Int64 = M_Int64 (Mixed sh (Primitive Int64)) deriving (Show, Eq) -newtype instance Mixed sh Int32 = M_Int32 (Mixed sh (Primitive Int32)) deriving (Show, Eq) -newtype instance Mixed sh CInt = M_CInt (Mixed sh (Primitive CInt)) deriving (Show, Eq) -newtype instance Mixed sh Float = M_Float (Mixed sh (Primitive Float)) deriving (Show, Eq) -newtype instance Mixed sh Double = M_Double (Mixed sh (Primitive Double)) deriving (Show, Eq) -newtype instance Mixed sh () = M_Nil (Mixed sh (Primitive ())) deriving (Show, Eq) -- no content, orthotope optimises this (via Vector) +newtype instance Mixed sh Int = M_Int (Mixed sh (Primitive Int)) deriving (Show, Eq, Generic) +newtype instance Mixed sh Int64 = M_Int64 (Mixed sh (Primitive Int64)) deriving (Show, Eq, Generic) +newtype instance Mixed sh Int32 = M_Int32 (Mixed sh (Primitive Int32)) deriving (Show, Eq, Generic) +newtype instance Mixed sh CInt = M_CInt (Mixed sh (Primitive CInt)) deriving (Show, Eq, Generic) +newtype instance Mixed sh Float = M_Float (Mixed sh (Primitive Float)) deriving (Show, Eq, Generic) +newtype instance Mixed sh Double = M_Double (Mixed sh (Primitive Double)) deriving (Show, Eq, Generic) +newtype instance Mixed sh () = M_Nil (Mixed sh (Primitive ())) deriving (Show, Eq, Generic) -- no content, orthotope optimises this (via Vector) -- etc. -- [PRIMITIVE ELEMENT TYPES LIST] -deriving instance Ord (Mixed '[] Int) -deriving instance Ord (Mixed '[] Int64) -deriving instance Ord (Mixed '[] Int32) -deriving instance Ord (Mixed '[] CInt) -deriving instance Ord (Mixed '[] Float) -deriving instance Ord (Mixed '[] Double) -deriving instance Ord (Mixed '[] ()) - -data instance Mixed sh (a, b) = M_Tup2 !(Mixed sh a) !(Mixed sh b) +deriving instance Ord (Mixed '[] Int) ; instance NFData (Mixed sh Int) +deriving instance Ord (Mixed '[] Int64) ; instance NFData (Mixed sh Int64) +deriving instance Ord (Mixed '[] Int32) ; instance NFData (Mixed sh Int32) +deriving instance Ord (Mixed '[] CInt) ; instance NFData (Mixed sh CInt) +deriving instance Ord (Mixed '[] Float) ; instance NFData (Mixed sh Float) +deriving instance Ord (Mixed '[] Double) ; instance NFData (Mixed sh Double) +deriving instance Ord (Mixed '[] ()) ; instance NFData (Mixed sh ()) + +data instance Mixed sh (a, b) = M_Tup2 !(Mixed sh a) !(Mixed sh b) deriving (Generic) deriving instance (Show (Mixed sh a), Show (Mixed sh b)) => Show (Mixed sh (a, b)) --- etc. +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) +data instance Mixed sh1 (Mixed sh2 a) = M_Nest !(IShX sh1) !(Mixed (sh1 ++ sh2) a) deriving (Generic) deriving instance Show (Mixed (sh1 ++ sh2) a) => Show (Mixed sh1 (Mixed sh2 a)) +instance NFData (Mixed (sh1 ++ sh2) a) => NFData (Mixed sh1 (Mixed sh2 a)) -- | Internal helper data family mirroring 'Mixed' that consists of mutable @@ -1112,6 +1113,7 @@ newtype Ranked n a = Ranked (Mixed (Replicate n Nothing) a) deriving instance Show (Mixed (Replicate n Nothing) a) => Show (Ranked n a) deriving instance Eq (Mixed (Replicate n Nothing) a) => Eq (Ranked n a) deriving instance Ord (Mixed '[] a) => Ord (Ranked 0 a) +deriving instance NFData (Mixed (Replicate n Nothing) a) => NFData (Ranked n a) -- | A shape-typed array: the full shape of the array (the sizes of its -- dimensions) is represented on the type level as a list of 'Nat's. Note that @@ -1127,6 +1129,7 @@ newtype Shaped sh a = Shaped (Mixed (MapJust sh) a) deriving instance Show (Mixed (MapJust sh) a) => Show (Shaped sh a) deriving instance Eq (Mixed (MapJust sh) a) => Eq (Shaped sh a) deriving instance Ord (Mixed '[] a) => Ord (Shaped '[] a) +deriving instance NFData (Mixed (MapJust sh) a) => NFData (Shaped sh a) -- 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)) -- cgit v1.2.3-70-g09d2