aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ox-arrays.cabal1
-rw-r--r--src/Data/Array/Mixed.hs26
-rw-r--r--src/Data/Array/Nested/Internal.hs51
3 files changed, 51 insertions, 27 deletions
diff --git a/ox-arrays.cabal b/ox-arrays.cabal
index 1eea23d..192471a 100644
--- a/ox-arrays.cabal
+++ b/ox-arrays.cabal
@@ -15,6 +15,7 @@ library
Data.Array.Nested.Internal.Arith.Lists
build-depends:
base >=4.18 && <4.20,
+ deepseq,
ghc-typelits-knownnat,
ghc-typelits-natnormalise,
orthotope,
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 '[] ())
+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)
+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))
generated by cgit v1.2.3-70-g09d2 (git 2.51.0) at 2025-10-31 19:43:14 +0100