diff options
Diffstat (limited to 'src/Data/Array/Nested/Internal/Mixed.hs')
| -rw-r--r-- | src/Data/Array/Nested/Internal/Mixed.hs | 41 |
1 files changed, 31 insertions, 10 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)) |