some updates to prune migration related warnings on ghc 9.4

numerical.cabal

@@ -117,7 +117,7 @@ library
                         ,monad-ste >= 0.1 && < 0.2
                         ,transformers >= 0.4 && < 0.6
                         ,transformers-compat >= 0.4 && < 0.6
-                        ,ghc-prim >=0.2 && <0.7
+                        ,ghc-prim >=0.2 && <0.10
                         ,vector-algorithms >= 0.6.0.1 && < 0.9
                         ,semigroups >= 0.19.1 && < 0.20
                         -- ,pqueue >= 1.2 && < 1.3

src/Control/NumericalMonad/State/Strict.hs

@@ -54,7 +54,7 @@ instance Applicative Identity where
     {-# INLINE (<*>) #-}
 
 instance Monad Identity where
-    return a = Identity a
+    return  =  pure 
     {-# INLINE return #-}
     m >>= k  = k (runIdentity m)
     {-# INLINE (>>=)#-}

src/Numerical/Array/Layout/Base.hs

@@ -52,7 +52,7 @@ module Numerical.Array.Layout.Base(
 
 
 import Data.Data
-
+import Data.Kind(Type)
 import Numerical.Nat
 import Numerical.Array.Address
 import Numerical.Array.Locality
@@ -119,7 +119,7 @@ shapeCompareRightToLeft =   \  ls rs -> foldl majorCompareRightToLeft EQ  $ map2
 
 
 -- | this is kinda a hack
-newtype TaggedShape (form :: *) (rank::Nat) = TaggedShape {unTagShape:: Shape rank Int }
+newtype TaggedShape (form :: Type) (rank::Nat) = TaggedShape {unTagShape:: Shape rank Int }
 instance Eq (Shape rank Int)=> Eq (TaggedShape f rank) where
   (==) l r =  (==) (unTagShape l) (unTagShape r )
 
@@ -139,7 +139,7 @@ instance forall form  rank . (Eq (Shape rank Int),Layout form rank)
 -- at least in general. For formats that aren't "rectilinear dense",
 -- this COULD be used as a description format for traversing
 -- over various rectilinear subsets of points though?
-data GDSlice (from :: Nat) (to :: Nat) :: *  where
+data GDSlice (from :: Nat) (to :: Nat) :: Type  where
   GDNil :: GDSlice 'Z 'Z
   GDPick :: Int -> !(GDSlice from to) -> GDSlice ('S from) to
   GDRange :: (Int,Int,Int) {- this is a nonempty interval or error -} -> !(GDSlice from to) -> GDSlice ('S from) ('S to)
@@ -177,7 +177,7 @@ In some (moderately precise sense)
 --computeSlicePlan:: GDSlice from to -> Shape from Int -> Shape from (Either Int (AffineRange Int))
 --computeSlicePlan GDNil  Nil = Nil
 --computeSlicePlan  ( ix `GDPick` gdRest )
---                  (bd:* shpRest)| ix < bd   && ix >= 0 = Left ix :* computeSlicePlan gdRest shpRest
+--                  (bd:Type shpRest)| ix < bd   && ix >= 0 = Left ix :* computeSlicePlan gdRest shpRest
 --                      | otherwise = error
 --                          $ "bad indices for computeSlicePlan " ++ show (ix,bd)
 --computeSlicePlan ( (strt,step,end) `GDRange` grest) (bd:* shprest)
@@ -188,13 +188,13 @@ data family Format  lay (contiguity:: Locality)  (rank :: Nat) rep
 
 deriving instance Typeable Format
 
-type family FormatStorageRep ( a:: * ) :: *
+type family FormatStorageRep ( a:: Type ) :: Type
 
 type instance FormatStorageRep (Format lay ctg rnk rep)= rep
 
-type family  Transposed (form :: *) :: *
+type family  Transposed (form :: Type) :: Type
 
-type family  LayoutAddress (form :: *) :: *
+type family  LayoutAddress (form :: Type) :: Type
 
 -- TODO / FIXME remove the basic* prefix  from all the operations
 -- this was done originally because
@@ -206,7 +206,7 @@ type family  LayoutAddress (form :: *) :: *
 -- when the underlying buffer layer is contiguous and packed. So it could be claimed
 -- that  any type that obeys @a~'LayoutLogicalFormat' a@ is one that an be a legal
 -- instance of LayoutBuilder?
-type family LayoutLogicalFormat (form :: *) :: *
+type family LayoutLogicalFormat (form :: Type) :: Type
 
 -- | the 'Layout' type class
 class Layout form  (rank :: Nat) | form -> rank  where
@@ -303,9 +303,9 @@ data SMajorOrientation (o :: MajorOrientation) where
 -- 'RectOrientationForm', 'RectDownRankForm', and 'InnerContigForm'
 type family RectOrientationForm form :: MajorOrientation
 
-type family RectDownRankForm   form :: *
+type family RectDownRankForm   form :: Type
 
-type family InnerContigForm form :: *
+type family InnerContigForm form :: Type
 
 {- | 'RectilinearLayout' is the type class that supports the modle widely
   usable class of slicing operations in Numerical.

src/Numerical/Array/Layout/Sparse.hs

@@ -81,7 +81,7 @@ data instance Format DirectSparse 'Contiguous ('S 'Z) rep =
     FormatDirectSparseContiguous {
       _logicalShapeDirectSparse:: {-# UNPACK#-} !Int
       ,_logicalBaseIndexShiftDirectSparse::{-# UNPACK#-} !Int
-      ,_indexTableDirectSparse :: ! (BufferPure rep Int )  }
+      ,_indexTableDirectSparse :: !(BufferPure rep Int )  }
 
 
 deriving instance Show  (BufferPure rep Int )  => Show (Format DirectSparse 'Contiguous ('S 'Z) rep)
@@ -201,7 +201,7 @@ data ContiguousCompressedSparseMatrix rep =
       _outerDimContiguousSparseFormat ::  {-# UNPACK #-} !Int
       ,_innerDimContiguousSparseFormat ::  {-# UNPACK #-} !Int
       ,_innerDimIndexContiguousSparseFormat :: !(BufferPure rep Int)
-      ,_outerDim2InnerDimContiguousSparseFormat:: ! (BufferPure rep Int )
+      ,_outerDim2InnerDimContiguousSparseFormat:: !(BufferPure rep Int )
   }
   deriving (Typeable)
 
@@ -227,8 +227,8 @@ data  InnerContiguousCompressedSparseMatrix rep =
       ,_innerDimIndexShiftInnerContiguousSparseFormat:: {-# UNPACK #-} !Int
 
       ,_innerDimIndexInnerContiguousSparseFormat :: !(BufferPure rep Int)
-      ,_outerDim2InnerDimStartInnerContiguousSparseFormat:: ! (BufferPure rep Int )
-      ,_outerDim2InnerDimEndInnerContiguousSparseFormat:: ! (BufferPure rep Int )
+      ,_outerDim2InnerDimStartInnerContiguousSparseFormat:: !(BufferPure rep Int )
+      ,_outerDim2InnerDimEndInnerContiguousSparseFormat:: !(BufferPure rep Int )
          }
      deriving Typeable
 

src/Numerical/Array/Mutable.hs

@@ -50,6 +50,8 @@ import Control.Monad (liftM)
 --import qualified Data.Vector.Unboxed.Mutable as UM
 --import qualified Data.Vector.Mutable as BM
 
+import Data.Kind
+
 {-
 For now we're going to just crib the vector style api and Lift it
 up into a multi dimensional setting.
@@ -100,31 +102,31 @@ data family MArray world rep lay (view::Locality) (rank :: Nat ) st  el
 
 data instance  MArray Native rep lay locality rank st el =
   MutableNativeArray {
-          nativeBuffer  :: ! (S.BufferMut rep st el  )
-          ,nativeFormat :: ! (Format lay locality rank rep)
+          nativeBuffer  :: !(S.BufferMut rep st el  )
+          ,nativeFormat :: !(Format lay locality rank rep)
     }
 
 
 -- | Every 'MutableArray'  instance has a contiguous version
 -- of itself, This contiguous version will ALWAYS have a Builder instance.
-type family MutableArrayContiguous (marr :: * -> * -> *) :: * ->  * -> *
+type family MutableArrayContiguous (marr :: Type -> Type -> Type) :: Type ->  Type -> Type
 type instance  MutableArrayContiguous (MArray world rep layout locality rank)= MArray world rep layout 'Contiguous rank
 
 -- | Sadly 'ArrMutable'  will have to have instances written by hand for now
 -- May later migrate the freeze / thaw machinery to Array.Phased, but lets
-type  family  ArrMutable ( arr :: * -> * )  :: * -> * -> *
+type  family  ArrMutable ( arr :: Type -> Type )  :: Type -> Type -> Type
 
 class P.PureArray (ArrPure marr)  rank a => Array marr (rank:: Nat)  a | marr -> rank  where
 
-    type   ArrPure (marr :: * -> * -> * ) :: * -> *
+    type   ArrPure (marr :: Type -> Type -> Type ) :: Type -> Type
 
     -- the type of the underlying storage buffer
-    --type MutableArrayBuffer marr :: * -> * -> *
+    --type MutableArrayBuffer marr :: Type -> Type -> Type
 
     -- really shouldnt appear in end user code, will only
     -- come up in writing new combinators
     -- the abstraction here is a reflection of the need for
-    type MArrayAddress (marr :: * -> * -> * ) ::  *
+    type MArrayAddress (marr :: Type -> Type -> Type ) ::  Type
 
     -- | 'basicUnsafeAffineAddressShift' is needed to handle abstracting access in popcount space
     basicUnsafeAffineAddressShift :: (address ~ MArrayAddress marr) => marr st a -> Int -> address -> address
@@ -287,9 +289,9 @@ instance (Buffer rep el, Layout (Format  lay locality  rank rep) rank )
 {-
 
 
-type ArrPure marr :: * -> *
+type ArrPure marr :: Type -> Type
 
-type MArrayAddress marr :: *
+type MArrayAddress marr :: Type
 
 basicUnsafeAffineAddressShift :: (address ~ MArrayAddress marr) => marr st a -> Int -> address -> address
 
@@ -375,16 +377,16 @@ class RectilinearArray marr rank a | marr -> rank   where
     -- @'MutableRectilinearOrientation' marr~Row)=> marr -> b @
     -- for operations where majorAxix projections are correct only for Row
     -- major formats. Such  as Row based forward/backward substitution (triangular solvers)
-    type MutableRectilinearOrientation marr :: *
+    type MutableRectilinearOrientation marr :: Type
 
-    type MutableArrayDownRank  marr ( st:: * ) a
+    type MutableArrayDownRank  marr ( st:: Type ) a
 
 
     -- | MutableInnerContigArray is the "meet" (minimum) of the locality level of marr and InnerContiguous.
     -- Thus both Contiguous and InnerContiguous are made InnerContiguous, and Strided stays Strided
     -- for now this makes sense to have in the MutableRectilinear class, though that may change.
     -- This could also be thought of as being the GLB (greatest lower bound) on locality
-    type MutableInnerContigArray (marr :: * ->  * -> *)  st  a
+    type MutableInnerContigArray (marr :: Type ->  Type -> Type)  st  a
 
 
 

src/Numerical/Array/Pure.hs

@@ -23,7 +23,7 @@ import Numerical.Array.Shape
 import Numerical.Array.Range
 import Numerical.Array.Storage as S
 import Numerical.World
-
+import Data.Kind (Type)
 import qualified Data.Vector.Generic as VG
 
 
@@ -54,13 +54,13 @@ data family ImmArray world rep lay (view::Locality) (rank :: Nat )   el
 
 data instance  ImmArray Native rep lay locality rank  el =
   ImMutableNativeArray {
-          nativeBufferPure  :: ! (S.BufferPure rep  el  )
-          ,nativeFormatPure :: ! (L.Format lay locality rank rep)
+          nativeBufferPure  :: !(S.BufferPure rep  el  )
+          ,nativeFormatPure :: !(L.Format lay locality rank rep)
     }
 
 
 class  PureArray arr   (rank:: Nat)   a |  arr -> rank   where
-    type PureArrayAddress (arr :: *  -> * ) ::  *
+    type PureArrayAddress (arr :: Type  -> Type ) ::  Type
 
     -- | gives the shape, a 'rank' length list of the dimensions
     basicShape :: arr   a -> Index rank
@@ -70,27 +70,27 @@ class  PureArray arr   (rank:: Nat)   a |  arr -> rank   where
     --  | basicMutableSparseIndexToAddres checks if a index is present or not
     -- helpful primitive for authoring codes for (un)structured sparse array format
     -- FIXME : THIS IS A TERRIBLE NAME
-    basicSparseIndexToAddress :: ( address ~PureArrayAddress  arr) => arr a -> Index rank  -> (Maybe address)
+    basicSparseIndexToAddress :: ( address ~ PureArrayAddress  arr) => arr a -> Index rank  -> (Maybe address)
 
     -- |
-    basicAddressToIndex :: (address ~PureArrayAddress  arr) => arr a -> address ->  (Index rank  )
+    basicAddressToIndex :: (address ~ PureArrayAddress  arr) => arr a -> address ->  (Index rank  )
 
     -- |  return the Range of valid logical addresses
-    basicAddressRange :: (address ~PureArrayAddress  arr)=>  arr a -> Maybe (Range address)
+    basicAddressRange :: (address ~ PureArrayAddress  arr)=>  arr a -> Maybe (Range address)
 
 
 
     -- | gives the next valid logical address
     -- undefined on invalid addresses and the greatest valid address.
     -- Note that for invalid addresses in between minAddress and maxAddress,
     -- will return the next valid address
-    basicNextAddress :: (address ~PureArrayAddress  arr)=>  arr a -> address -> Maybe address
+    basicNextAddress :: (address ~ PureArrayAddress  arr)=>  arr a -> address -> Maybe address
 
     -- I think the case could be made for a basicPreviousAddress opeeration
 
     -- | gives the next valid array index
     -- undefined on invalid indices and the greatest valid index
-    basicNextIndex :: (address ~PureArrayAddress  arr)=>
+    basicNextIndex :: (address ~ PureArrayAddress  arr)=>
       arr a ->  Index rank -> Maybe address  -> Maybe ( Index rank, address)
 
 
@@ -104,7 +104,7 @@ class  PureArray arr   (rank:: Nat)   a |  arr -> rank   where
 
     ---- | Yield the element at the given position. This method should not be
     ---- called directly, use 'unsafeRead' instead.
-    basicUnsafeAddressRead  :: (Monad m , address ~PureArrayAddress  arr)=>  arr   a -> address-> m  a
+    basicUnsafeAddressRead  :: (Monad m , address ~ PureArrayAddress  arr)=>  arr   a -> address-> m  a
 
 
 
@@ -155,7 +155,7 @@ class PureArray arr rank a => PureDenseArray arr rank a where
     basicIndexInBounds :: arr a -> Index rank -> Bool
 
     -- |
-    basicUnsafeAddressDenseRead  :: (address ~PureArrayAddress  arr,Monad m) => arr  a -> address-> m a
+    basicUnsafeAddressDenseRead  :: (address ~ PureArrayAddress  arr,Monad m) => arr  a -> address-> m a
 
 
 

src/Numerical/Array/Range.hs

@@ -57,7 +57,7 @@ _rangeMax =  \ fun rec -> fmap (\mup -> rec{_RangeMax= mup}) $ fun (_RangeMax re
 
 -- | this is uniform address interval by any other name
 data AffineRange a = AffineRange{_AffineRangeMin :: !a
-                                ,_AffineRangeStride :: ! Int
+                                ,_AffineRangeStride :: !Int
                                 ,_AffineRangeMax :: !a}
         deriving (Eq,Show,Data,Generic,Typeable,Functor,Foldable,Traversable )
 

src/Numerical/Array/Shape.hs

@@ -326,8 +326,9 @@ instance (Semigroup a, A.Applicative (Shape n))=> (Semigroup (Shape n a)) where
 
 instance (Monoid.Monoid a, A.Applicative (Shape n))=> Monoid.Monoid (Shape n a) where
   mempty = A.pure Monoid.mempty
+#if !(MIN_VERSION_base(4,11,0))
   mappend = \ a b -> A.pure Monoid.mappend A.<*> a A.<*> b
-
+#endif 
 
 
 

src/Numerical/Array/Storage.hs

@@ -228,7 +228,7 @@ instance VG.Vector BV.Vector  a  => VG.Vector (BufferPure Boxed) a   where
 instance (SV.Storable a)  => VG.Vector (BufferPure Stored) a   where
 
   basicUnsafeFreeze =
-     \(StorableBufferMut mv) -> (\x ->return $StorableBuffer x) =<<  VG.basicUnsafeFreeze mv
+     \(StorableBufferMut mv) -> (\x ->return $ StorableBuffer x) =<<  VG.basicUnsafeFreeze mv
   basicUnsafeThaw=
     \(StorableBuffer v) -> (\x -> return $ StorableBufferMut x) =<< VG.basicUnsafeThaw v
   basicLength = \(StorableBuffer v) -> VG.basicLength v

src/Numerical/Data/Vector/HPair.hs

@@ -29,7 +29,7 @@ import qualified Data.Vector.Generic.Mutable as MV
 
 import Control.Monad.Primitive (PrimMonad)
 
-
+import Data.Kind (Type)
 
 --type instance V.Mutable (VPair v) = MVPair (V.Mutable v)
 
@@ -62,11 +62,11 @@ data HProd a  where
     HPair :: HProd a-> HProd a  -> HProd a
     HUnit :: a -> HProd a
 
-data  VHProd  (prd:: HProd ( * -> * )) val where
+data  VHProd  (prd:: HProd ( Type -> Type )) val where
     VHLeaf ::  !(v a) -> VHProd   ('HUnit v) a
     VHNode  :: !(VHProd  pra a) -> !(VHProd  prb b ) ->VHProd  ('HPair  pra prb) (a,b)
 
-data  MVHProd   (prd:: HProd (* -> * -> *) ) (st :: * ) val where
+data  MVHProd   (prd:: HProd (Type -> Type -> Type) ) (st :: Type ) val where
     MVHLeaf :: !(mv  st a) -> MVHProd   ('HUnit mv) st  a
     MVHNode  :: !(MVHProd pra st a) -> !(MVHProd   prb   st b ) -> MVHProd  ('HPair pra prb) st (a,b)
 
@@ -81,7 +81,7 @@ vUnHPair = \ (VHNode (VHLeaf va) (VHLeaf vb))-> (va,vb)
 
 type instance  V.Mutable (VHProd  prod)= MVHProd  (MutableHProdTree prod)
 
-type family MutableHProdTree (a :: HProd (* -> *))  = r | r -> a where
+type family MutableHProdTree (a :: HProd (Type -> Type))  = r | r -> a where
   MutableHProdTree ('HUnit v ) = 'HUnit (V.Mutable v)
   MutableHProdTree ('HPair left right) = 'HPair (MutableHProdTree left) (MutableHProdTree right )
 

src/Numerical/Data/Vector/Pair.hs

@@ -24,6 +24,7 @@ module  Numerical.Data.Vector.Pair(
     --,mvPair
       ) where
 
+import Data.Kind (Type )
 import qualified Data.Vector.Generic as V
 import qualified Data.Vector.Generic.Mutable as MV
 
@@ -36,14 +37,14 @@ import qualified Data.Vector.Generic.Mutable as MV
 data Prod = Pair Prod Prod | Unit
 
 
-data family   VProd  (vect :: * -> * ) (prd:: Prod ) val  -- where
+data family   VProd  (vect :: Type -> Type ) (prd:: Prod ) val  -- where
 data instance VProd v 'Unit a where
     VLeaf ::  !(v a) -> VProd v   'Unit a
 
 data instance VProd v ('Pair pra prb )  (a,b) where
     VPair  :: !(VProd v pra a) -> !(VProd v prb b ) ->VProd v ('Pair  pra prb) (a,b)
 
-data family   MVProd  (vect :: * -> * -> * )  (prd:: Prod ) (st :: * ) val  -- where
+data family   MVProd  (vect :: Type -> Type -> Type  )  (prd:: Prod ) (st :: Type ) val  -- where
 data instance   MVProd mv 'Unit  st a where
   MVLeaf :: !(mv  st a) -> MVProd mv  'Unit st  a
 data instance   MVProd mv ('Pair pra prb)  st (a,b) where

src/Numerical/Nat.hs

@@ -18,6 +18,12 @@ import Data.Type.Equality(gcastWith)
 import Data.Proxy
 #endif
 
+
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 904
+import Data.Kind (Type)
+#endif 
+
+
 type LitNat = TL.Nat
 
 data Nat = S !Nat  | Z
@@ -64,12 +70,17 @@ type family n1 + n2 where
 
 
 -- singleton for Nat
-
+#if __GLASGOW_HASKELL__ < 904
 
 data SNat :: Nat -> * where
   SZero :: SNat 'Z
   SSucc :: SNat n -> SNat ('S n)
+#else   
 
+data SNat :: Nat -> Type where
+  SZero :: SNat 'Z
+  SSucc :: SNat n -> SNat ('S n)
+#endif 
 
 
 -- inductive proof of right-identity of +