From fbafff808a215cc20934d3ea0c72b8aa0e599160 Mon Sep 17 00:00:00 2001 From: Tom Smeding Date: Tue, 21 May 2024 09:10:39 +0200 Subject: Int32 and CInt instances --- src/Data/Array/Nested/Internal.hs | 33 ++++++++++++++++++--------------- 1 file changed, 18 insertions(+), 15 deletions(-) diff --git a/src/Data/Array/Nested/Internal.hs b/src/Data/Array/Nested/Internal.hs index 308f8ce..a8db1b6 100644 --- a/src/Data/Array/Nested/Internal.hs +++ b/src/Data/Array/Nested/Internal.hs @@ -51,6 +51,7 @@ import Data.Proxy import Data.Type.Equality import qualified Data.Vector.Storable as VS import qualified Data.Vector.Storable.Mutable as VSM +import Foreign.C.Types (CInt(..)) import Foreign.Storable (Storable) import GHC.IsList (IsList) import qualified GHC.IsList as IsList @@ -435,6 +436,8 @@ class Storable a => PrimElt a where -- [PRIMITIVE ELEMENT TYPES LIST] instance PrimElt Int instance PrimElt Int64 +instance PrimElt Int32 +instance PrimElt CInt instance PrimElt Double instance PrimElt () @@ -459,14 +462,12 @@ data instance Mixed sh (Primitive a) = M_Primitive !(IShX sh) !(XArray sh a) deriving (Show) -- [PRIMITIVE ELEMENT TYPES LIST] -newtype instance Mixed sh Int = M_Int (Mixed sh (Primitive Int)) - deriving (Show) -newtype instance Mixed sh Int64 = M_Int64 (Mixed sh (Primitive Int64)) - deriving (Show) -newtype instance Mixed sh Double = M_Double (Mixed sh (Primitive Double)) - deriving (Show) -newtype instance Mixed sh () = M_Nil (Mixed sh (Primitive ())) -- no content, orthotope optimises this (via Vector) - deriving (Show) +newtype instance Mixed sh Int = M_Int (Mixed sh (Primitive Int)) deriving (Show) +newtype instance Mixed sh Int64 = M_Int64 (Mixed sh (Primitive Int64)) deriving (Show) +newtype instance Mixed sh Int32 = M_Int32 (Mixed sh (Primitive Int32)) deriving (Show) +newtype instance Mixed sh CInt = M_CInt (Mixed sh (Primitive CInt)) deriving (Show) +newtype instance Mixed sh Double = M_Double (Mixed sh (Primitive Double)) deriving (Show) +newtype instance Mixed sh () = M_Nil (Mixed sh (Primitive ())) deriving (Show) -- no content, orthotope optimises this (via Vector) -- etc. data instance Mixed sh (a, b) = M_Tup2 !(Mixed sh a) !(Mixed sh b) @@ -487,6 +488,8 @@ newtype instance MixedVecs s sh (Primitive a) = MV_Primitive (VS.MVector s a) -- [PRIMITIVE ELEMENT TYPES LIST] newtype instance MixedVecs s sh Int = MV_Int (VS.MVector s Int) newtype instance MixedVecs s sh Int64 = MV_Int64 (VS.MVector s Int64) +newtype instance MixedVecs s sh Int32 = MV_Int32 (VS.MVector s Int32) +newtype instance MixedVecs s sh CInt = MV_CInt (VS.MVector s CInt) newtype instance MixedVecs s sh Double = MV_Double (VS.MVector s Double) newtype instance MixedVecs s sh () = MV_Nil (VS.MVector s ()) -- no content, MVector optimises this -- etc. @@ -499,18 +502,14 @@ data instance MixedVecs s sh1 (Mixed sh2 a) = MV_Nest !(IShX sh2) !(MixedVecs s -- | Tree giving the shape of every array component. type family ShapeTree a where - ShapeTree (Primitive _) = () - -- [PRIMITIVE ELEMENT TYPES LIST] - ShapeTree Int = () - ShapeTree Int64 = () - ShapeTree Double = () - ShapeTree () = () - ShapeTree (a, b) = (ShapeTree a, ShapeTree b) ShapeTree (Mixed sh a) = (IShX sh, ShapeTree a) ShapeTree (Ranked n a) = (IShR n, ShapeTree a) ShapeTree (Shaped sh a) = (ShS sh, ShapeTree a) + -- to avoid having to list all of the primitive types: + ShapeTree _ = () + -- | Allowable element types in a mixed array, and by extension in a 'Ranked' or -- 'Shaped' array. Note the polymorphic instance for 'Elt' of @'Primitive' @@ -659,6 +658,8 @@ instance Storable a => Elt (Primitive a) where -- [PRIMITIVE ELEMENT TYPES LIST] deriving via Primitive Int instance Elt Int deriving via Primitive Int64 instance Elt Int64 +deriving via Primitive Int32 instance Elt Int32 +deriving via Primitive CInt instance Elt CInt deriving via Primitive Double instance Elt Double deriving via Primitive () instance Elt () @@ -670,6 +671,8 @@ instance Storable a => KnownElt (Primitive a) where -- [PRIMITIVE ELEMENT TYPES LIST] deriving via Primitive Int instance KnownElt Int deriving via Primitive Int64 instance KnownElt Int64 +deriving via Primitive Int32 instance KnownElt Int32 +deriving via Primitive CInt instance KnownElt CInt deriving via Primitive Double instance KnownElt Double deriving via Primitive () instance KnownElt () -- cgit v1.2.3-70-g09d2