aboutsummaryrefslogtreecommitdiff
path: root/src/Data/Array
diff options
context:
space:
mode:
authorTom Smeding <tom@tomsmeding.com>2024-06-14 12:13:16 +0200
committerTom Smeding <tom@tomsmeding.com>2024-06-14 12:13:16 +0200
commit46af04ce96ba9c9b0067039c822427db71074e57 (patch)
treeb75093b70b0eabdd00073e25332f02d73c74f7f8 /src/Data/Array
parent827ffbfe7e346750936fee0e65e41bb524d97164 (diff)
Show instances via toListLinear
Diffstat (limited to 'src/Data/Array')
-rw-r--r--src/Data/Array/Nested/Internal/Mixed.hs41
-rw-r--r--src/Data/Array/Nested/Internal/Ranked.hs10
-rw-r--r--src/Data/Array/Nested/Internal/Shaped.hs9
3 files changed, 46 insertions, 14 deletions
diff --git a/src/Data/Array/Nested/Internal/Mixed.hs b/src/Data/Array/Nested/Internal/Mixed.hs
index d548794..ddc075c 100644
--- a/src/Data/Array/Nested/Internal/Mixed.hs
+++ b/src/Data/Array/Nested/Internal/Mixed.hs
@@ -100,6 +100,7 @@ import Data.Array.Mixed.Lemmas
-- this library does not (directly), it may just work if you use an array of
-- @'Primitive' T@ instead.
newtype Primitive a = Primitive a
+ deriving (Show)
-- | Element types that are primitive; arrays of these types are just a newtype
-- wrapper over an array.
@@ -140,7 +141,8 @@ 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, Generic)
+ deriving (Eq, Generic)
+ deriving (Show) via (ShowViaToListLinear sh (Primitive a))
-- | Only on scalars, because lexicographical ordering is strange on multi-dimensional arrays.
deriving instance (Ord a, Storable a) => Ord (Mixed sh (Primitive a))
@@ -148,13 +150,13 @@ 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 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)
+newtype instance Mixed sh Int = M_Int (Mixed sh (Primitive Int)) deriving (Eq, Generic) deriving (Show) via (ShowViaPrimitive sh Int)
+newtype instance Mixed sh Int64 = M_Int64 (Mixed sh (Primitive Int64)) deriving (Eq, Generic) deriving (Show) via (ShowViaPrimitive sh Int64)
+newtype instance Mixed sh Int32 = M_Int32 (Mixed sh (Primitive Int32)) deriving (Eq, Generic) deriving (Show) via (ShowViaPrimitive sh Int32)
+newtype instance Mixed sh CInt = M_CInt (Mixed sh (Primitive CInt)) deriving (Eq, Generic) deriving (Show) via (ShowViaPrimitive sh CInt)
+newtype instance Mixed sh Float = M_Float (Mixed sh (Primitive Float)) deriving (Eq, Generic) deriving (Show) via (ShowViaPrimitive sh Float)
+newtype instance Mixed sh Double = M_Double (Mixed sh (Primitive Double)) deriving (Eq, Generic) deriving (Show) via (ShowViaPrimitive sh Double)
+newtype instance Mixed sh () = M_Nil (Mixed sh (Primitive ())) deriving (Eq, Generic) deriving (Show) via (ShowViaPrimitive sh ()) -- no content, orthotope optimises this (via Vector)
-- etc.
-- [PRIMITIVE ELEMENT TYPES LIST]
@@ -167,12 +169,12 @@ deriving instance Ord (Mixed sh Double) ; instance NFData (Mixed sh Double)
deriving instance Ord (Mixed sh ()) ; 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))
+deriving via (ShowViaToListLinear sh (a, b)) instance (Show a, Elt a, Show b, Elt b) => Show (Mixed sh (a, b))
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)
-deriving instance Show (Mixed (sh1 ++ sh2) a) => Show (Mixed sh1 (Mixed sh2 a))
+deriving via (ShowViaToListLinear sh1 (Mixed sh2 a)) instance (Show (Mixed sh2 a), Elt a) => Show (Mixed sh1 (Mixed sh2 a))
instance NFData (Mixed (sh1 ++ sh2) a) => NFData (Mixed sh1 (Mixed sh2 a))
@@ -199,6 +201,25 @@ data instance MixedVecs s sh (a, b) = MV_Tup2 !(MixedVecs s sh a) !(MixedVecs s
data instance MixedVecs s sh1 (Mixed sh2 a) = MV_Nest !(IShX sh2) !(MixedVecs s (sh1 ++ sh2) a)
+-- Helpers for Show instances for the Mixed arrays
+
+newtype ShowViaToListLinear sh a = ShowViaToListLinear (Mixed sh a)
+
+instance (Show a, Elt a) => Show (ShowViaToListLinear sh a) where
+ showsPrec d (ShowViaToListLinear arr) = showParen (d > 10) $
+ -- TODO: to avoid ambiguity, this should type-apply the shape to mfromListLinear
+ showString "mfromListLinear " . shows (shxToList (mshape arr)) . showString " "
+ . shows (mtoListLinear arr)
+
+newtype ShowViaPrimitive sh a = ShowViaPrimitive (Mixed sh (Primitive a))
+
+instance (Show a, Storable a) => Show (ShowViaPrimitive sh a) where
+ showsPrec d (ShowViaPrimitive parr@(M_Primitive sh _)) = showParen (d > 10) $
+ -- TODO: to avoid ambiguity, this should type-apply the shape to mfromListLinear
+ showString "mfromListLinear " . shows (shxToList sh) . showString " "
+ . shows (coerce @[Primitive a] @[a] (mtoListLinear parr))
+
+
mliftNumElt1 :: PrimElt a => (SNat (Rank sh) -> S.Array (Rank sh) a -> S.Array (Rank sh) a) -> Mixed sh a -> Mixed sh a
mliftNumElt1 f (toPrimitive -> M_Primitive sh (XArray arr)) = fromPrimitive $ M_Primitive sh (XArray (f (shxRank sh) arr))
diff --git a/src/Data/Array/Nested/Internal/Ranked.hs b/src/Data/Array/Nested/Internal/Ranked.hs
index 98014b0..e59ac0c 100644
--- a/src/Data/Array/Nested/Internal/Ranked.hs
+++ b/src/Data/Array/Nested/Internal/Ranked.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -25,6 +26,7 @@ import Control.Monad.ST
import Data.Array.RankedS qualified as S
import Data.Bifunctor (first)
import Data.Coerce (coerce)
+import Data.Foldable (toList)
import Data.Kind (Type)
import Data.List.NonEmpty (NonEmpty)
import Data.Proxy
@@ -57,14 +59,18 @@ import Data.Array.Nested.Internal.Shape
-- 'Ranked' is a newtype around a 'Mixed' of 'Nothing's.
type Ranked :: Nat -> Type -> Type
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 (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)
+
-- 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))
-deriving instance Show (Mixed sh (Mixed (Replicate n Nothing) a)) => Show (Mixed sh (Ranked n a))
+deriving via (ShowViaToListLinear sh (Ranked n a)) instance (Show a, Elt a) => Show (Mixed sh (Ranked n a))
newtype instance MixedVecs s sh (Ranked n a) = MV_Ranked (MixedVecs s sh (Mixed (Replicate n Nothing) a))
diff --git a/src/Data/Array/Nested/Internal/Shaped.hs b/src/Data/Array/Nested/Internal/Shaped.hs
index 9abce4f..be56030 100644
--- a/src/Data/Array/Nested/Internal/Shaped.hs
+++ b/src/Data/Array/Nested/Internal/Shaped.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -59,14 +60,18 @@ import Data.Array.Nested.Internal.Shape
-- 'Shaped' is a newtype around a 'Mixed' of 'Just's.
type Shaped :: [Nat] -> Type -> Type
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 (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)
+
-- 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))
-deriving instance Show (Mixed sh (Mixed (MapJust sh') a)) => Show (Mixed sh (Shaped sh' a))
+deriving via (ShowViaToListLinear sh (Shaped sh' a)) instance (Show a, Elt a) => Show (Mixed sh (Shaped sh' a))
newtype instance MixedVecs s sh (Shaped sh' a) = MV_Shaped (MixedVecs s sh (Mixed (MapJust sh') a))