From fbafff808a215cc20934d3ea0c72b8aa0e599160 Mon Sep 17 00:00:00 2001
From: Tom Smeding <tom@tomsmeding.com>
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(-)

(limited to 'src/Data/Array')

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