easytensor 2.1.0.0 → 2.1.1.0

raw patch · 16 files changed

+335/−79 lines, 16 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• bench/misc.hs +3/−0
• easytensor.cabal +3/−3
• src-base/Numeric/DataFrame/Internal/Backend/Family.hs +2/−1
• src/Numeric/DataFrame/Internal/Mutable.hs +2/−1
• src/Numeric/DataFrame/Type.hs +42/−15
• src/Numeric/Matrix/Internal.hs +3/−2
• src/Numeric/Matrix/QR.hs +8/−3
• src/Numeric/PrimBytes.hs +141/−22
• src/Numeric/Subroutine/Sort.hs +5/−2
• test/Numeric/Arbitraries.hs +9/−1
• test/Numeric/Matrix/BidiagonalTest.hs +5/−2
• test/Numeric/Matrix/LUTest.hs +3/−0
• test/Numeric/Matrix/QRTest.hs +6/−1
• test/Numeric/Matrix/SVDTest.hs +4/−1
• test/Numeric/PrimBytesTest.hs +82/−24
• test/Spec/Util.hs +17/−1

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP              #-} {-# LANGUAGE DataKinds        #-} {-# LANGUAGE GADTs            #-} {-# LANGUAGE TypeApplications #-}@@ -39,7 +40,9 @@               -- Amazing inference!               -- m :: KnownNat k => DataFrame '[k,2,4]             -> print $ m %* vec4 1 2.25 3 0.162+#if !MIN_VERSION_GLASGOW_HASKELL(8,10,0,0)         _ -> print "Failed to construct a DataFrame!"+#endif     putStrLn "Constructing larger matrices"     let x :: DataFrame Double '[4,5,2]         x =  DF4 (transpose $ DF2

@@ -1,13 +1,13 @@ cabal-version: 1.24 --- This file has been generated from package.yaml by hpack version 0.31.1.+-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: 75fa5546720cb775f5ce9a26382fcd60253bba851441e469156242ee52655f97+-- hash: 3c6d02c6fd2233f54c11cad29fb86ebe9dd802a64c7a3d880ee6d3bd047673ca  name:           easytensor-version:        2.1.0.0+version:        2.1.1.0 synopsis:       Pure, type-indexed haskell vector, matrix, and tensor library. description:    Pure, type-indexed haskell vector, matrix, and tensor library. Features dimensionality type-checking for all operations. Generic n-dimensional versions are implemented using low-level prim ops. Allows ad-hoc replacement with fixed low-dimensionality vectors and matrices without changing user interface. Please see the README on GitHub at <https://github.com/achirkin/easytensor#readme> category:       math, geometry

@@ -34,7 +34,8 @@   import Data.Constraint-import GHC.Base+import GHC.Base (Type)+import GHC.Exts (unsafeCoerce#)  import Numeric.DataFrame.Internal.Backend.Family.ArrayBase import Numeric.DataFrame.Internal.Backend.Family.DoubleX2

@@ -40,7 +40,8 @@     , getDataFrameSteps#     ) where -import GHC.Base+import GHC.Base (Type)+import GHC.Exts import Numeric.DataFrame.Internal.PrimArray import Numeric.DataFrame.Type import Numeric.Dimensions

@@ -88,7 +88,8 @@ import           Numeric.DataFrame.Internal.BackendI (DFBackend, KnownBackend) import qualified Numeric.DataFrame.Internal.BackendI as Backend -+-- See dimensions:Numeric.Dimensions.Dim+#define IS_UNSOUND_MATCHING_810_900 (MIN_VERSION_GLASGOW_HASKELL(8,10,0,0) && !MIN_VERSION_GLASGOW_HASKELL(9,1,0,0))  -- | Keep data in a primitive data frame --    and maintain information about Dimensions in the type system@@ -241,7 +242,7 @@       | D :* (Dims :: Dims ns) <- dims `inSpaceOf` df       , Dict <- inferKnownBackend @t @ns         = XFrame (df ! i)-    (!) _ _ = error "IndexFrame: impossible pattern"+    (!) _ _ = error "IndexFrame: impossible arguments"  instance (RepresentableList ts, All PrimBytes ts)       => IndexFrame (ts :: [Type]) (xd :: XNat) xds where@@ -259,7 +260,7 @@         getTsEvs ((_ :: Proxy a) :* as')           | Dict <- getTsEvs @_ @d @ds as'           , Dict <- inferKnownBackend @a @ds = Dict-    (!) _ _ = error "IndexFrame: impossible pattern"+    (!) _ _ = error "IndexFrame: impossible arguments"  {- | This type family describes two strategies for dealing with dimensions when@@ -496,6 +497,9 @@   = Read.parens . Read.prec 10 $ do     Read.lift . Read.expect . Read.Ident $ "DF" ++ show (dimVal d)     packDF' (<*> Read.step (readPrecFixedDF ds)) pure+#if IS_UNSOUND_MATCHING_810_900+readPrecFixedDF _ = error "Numeric.DataFrame.Type.readPrecFixedDF: impossible arguments"+#endif  {- The first argument is, in fact, a @dimsBound@, but covered in the same @[XNat]@@@ -621,6 +625,9 @@     xs <- readFixedMultiDF ts (dims @ns)     case inferKnownBackend @ts @ns of       Dict -> return $ XFrame (x :*: xs)+#if IS_UNSOUND_MATCHING_810_900+readBoundedMultiDF _ _ = error "Numeric.DataFrame.Type.readBoundedMultiDF: impossible arguments"+#endif  readSomeMultiDF :: forall (ts :: [Type])                  . (All Read ts, All PrimBytes ts)@@ -811,7 +818,7 @@   , Dict <- inferKnownBackend @t @(d ': ds)   , Dict <- inferKnownBackend @t @ds     = go d-  | otherwise = error "Numeric.DataFrame.Type.packDF: impossible args"+  | otherwise = error "Numeric.DataFrame.Type.packDF: impossible arguments"   where     go :: (Dimensions ds, KnownBackend t ds, KnownBackend t (d ': ds))        => Dim d@@ -876,7 +883,7 @@ unpackDF c   | d :* Dims <- dims @(d ': ds)     = unpackDF' (go d)-  | otherwise = error "Numeric.DataFrame.Type.unpackDF: impossible args"+  | otherwise = error "Numeric.DataFrame.Type.unpackDF: impossible arguments"   where     go :: forall a . (a ~ Dict (Dimensions ds, KnownBackend t ds))        => Dim d -> a@@ -906,7 +913,9 @@ packDF' k z   | d :* _ <- dims @(d ': ds)     = go d (z (packDF @t @d @ds))-  | otherwise = error "Numeric.DataFrame.Type.packDF': impossible args"+#if !MIN_VERSION_GLASGOW_HASKELL(9,0,0,0)+  | otherwise = error "Numeric.DataFrame.Type.packDF': impossible arguments"+#endif   where     go :: forall n . Dim n        -> c (PackDF t ds n (DataFrame t (d ': ds))) -> c (DataFrame t (d ': ds))@@ -949,7 +958,7 @@           f consume (I# o) = consume (I# (o -# td)) (fromElems cd o arr)       in k Dict f (I# (off +# td *# (n -# 1#)))     )-  | otherwise = error "Numeric.DataFrame.Type.unpackDF: impossible args"+  | otherwise = error "Numeric.DataFrame.Type.unpackDF: impossible arguments"   -- | Append one DataFrame to another, sum up the first dimension.@@ -968,7 +977,9 @@   , Dict <- inferKnownBackend @t @(m :+ ds)   , Dict <- inferKnownBackend @t @((n + m) :+ ds)               = unsafeAppendPB-  | otherwise = error "Numeri.DataFrame.Type/appendDF: impossible arguments"+#if !MIN_VERSION_GLASGOW_HASKELL(9,0,0,0)+  | otherwise = error "Numeri.DataFrame.Type.appendDF: impossible arguments"+#endif  -- | Append a small DataFrame to a big DataFrame on the left. --@@ -986,7 +997,9 @@   , Dict <- inferKnownBackend @t @ds   , Dict <- inferKnownBackend @t @((n + 1) :+ ds)               = unsafeAppendPB-  | otherwise = error "Numeri.DataFrame.Type/consDF: impossible arguments"+#if !MIN_VERSION_GLASGOW_HASKELL(9,0,0,0)+  | otherwise = error "Numeri.DataFrame.Type.consDF: impossible arguments"+#endif  -- | Append a small DataFrame to a big DataFrame on the right. --@@ -1004,8 +1017,9 @@   , Dict <- inferKnownBackend @t @ds   , Dict <- inferKnownBackend @t @((n + 1) :+ ds)               = unsafeAppendPB-  | otherwise = error "Numeri.DataFrame.Type/snocDF: impossible arguments"-+#if !MIN_VERSION_GLASGOW_HASKELL(9,0,0,0)+  | otherwise = error "Numeri.DataFrame.Type.snocDF: impossible arguments"+#endif  -- | Unsafely copy two PrimBytes values into a third one. unsafeAppendPB :: forall x y z@@ -1049,14 +1063,15 @@          => [DataFrame t ds] -> DataFrame t (XN 0 ': xds) fromList xs     | Dx (D :: Dim n) <- someDimVal . fromIntegral $ length xs+    , Dict <- Dict @(ds ~ UnMap N xds) -- just to make GHC not complain about unused constraints.     , Dict <- inferKnownBackend @t @(n ': ds)     , Dict <- unsafeEqTypes @_ @ds @(DimsBound xds)     , Dict <- inferExactFixedDims (dims @ds)       = XFrame (fromListWithDefault @t @n @ds undefined xs)+#if !MIN_VERSION_GLASGOW_HASKELL(9,0,0,0)     | otherwise-      = case Dict @(ds ~ UnMap N xds) of-          Dict -> -- just make GHC not complain about unused constraints.-            error "Numeri.DataFrame.Type/fromList: impossible arguments"+      = error "Numeri.DataFrame.Type.fromList: impossible arguments"+#endif  -- | Try to convert between @XNat@-indexed DataFrames. --@@ -1112,7 +1127,7 @@        ) of (# _, r #) -> fromElems steps 0# r   | otherwise-    = error "Numeri.DataFrame.Type/asDiag: impossible arguments"+    = error "Numeri.DataFrame.Type.asDiag: impossible arguments" {-# INLINE asDiag #-}  -- Need this for @packDF'@ to make @Int -> c z@ a proper second-order type@@ -1136,10 +1151,16 @@                            (\g -> Off . f $ k . runOff g)                            (Off . const . z)                        ) v+#if IS_UNSOUND_MATCHING_810_900+      _ -> error "DataFrame.gfoldl: impossible arguments"+#endif     gunfold k z _ = case typeableDims @ds of       U      -> k (z S)       D :* (Dims :: Dims ns)         -> case inferTypeableCons @ds of Dict -> packDF' k z+#if IS_UNSOUND_MATCHING_810_900+      _ -> error "DataFrame.gunfold: impossible arguments"+#endif     toConstr _ = case typeableDims @ds of       U      -> scalarFrameConstr       d :* _ -> singleFrameConstr $ dimVal d@@ -1241,6 +1262,9 @@       where         d2  = divDim d D2         d2' = d2 `plusDim` modDim d D2+#if IS_UNSOUND_MATCHING_810_900+fromSingleFrame _ _ = error "fromSingleFrame: impossible arguments"+#endif  toSingleFrame :: forall (t :: Type) (ds :: [Nat]) (x :: Type)                . PrimBytes t@@ -1280,6 +1304,9 @@       where         d2  = divDim d D2         d2' = d2 `plusDim` modDim d D2+#if IS_UNSOUND_MATCHING_810_900+toSingleFrame _ _ = error "toSingleFrame: impossible arguments"+#endif {-# INLINE toSingleFrame #-}  type family MultiFrameRepNil (ts :: [Type]) :: (Type -> Type) where

@@ -1,12 +1,11 @@+{-# LANGUAGE CPP                   #-} {-# LANGUAGE DataKinds             #-} {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MagicHash             #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds             #-}-{-# LANGUAGE RecordWildCards       #-} {-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE StandaloneDeriving    #-} {-# LANGUAGE TypeApplications      #-} {-# LANGUAGE TypeFamilies          #-} {-# LANGUAGE TypeOperators         #-}@@ -205,7 +204,9 @@       | ((D :: Dim n) :* (D :: Dim m) :* U) <- dims @ns       , Dict <- inferPrimElem df       = XFrame (transpose df :: Matrix t m n)+#if !MIN_VERSION_GLASGOW_HASKELL(8,10,0,0)     transpose _ = error "MatrixTranspose/transpose: impossible argument"+#endif  instance (KnownDim n, PrimArray t (Matrix t n n), Num t)       => SquareMatrix t n where

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP                   #-} {-# LANGUAGE DataKinds             #-} {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-}@@ -173,7 +174,9 @@     solveLowerTriangularR lqL (subDataFrameView i0 xPtr)     (transpose lqQ %*) <$> unsafeFreezeDataFrame xPtr       -- NB: make a stateful product for transposed mat-  _ -> error "qrSolveR: impossible pattern"+#if !MIN_VERSION_GLASGOW_HASKELL(8,10,0,0)+  _ -> error "Numeric.Matrix.QR.qrSolveR: impossible pattern"+#endif   where     dn = dim @n     dm = dim @m@@ -224,8 +227,10 @@     solveLowerTriangularL xPtr lqL     ewmap @t @ds @'[n] (sslice i0)       <$> unsafeFreezeDataFrame xPtr-  _ -> error "qrSolveL/compareDim: impossible pattern"-  | otherwise = error "qrSolveL: impossible pattern"+#if !MIN_VERSION_GLASGOW_HASKELL(8,10,0,0)+  _ -> error "Numeric.Matrix.QR.qrSolveL/compareDim: impossible pattern"+#endif+  | otherwise = error "Numeric.Matrix.QR.qrSolveL: impossible pattern"   where     dn = dim @n     dm = dim @m

@@ -1,20 +1,22 @@-{-# LANGUAGE AllowAmbiguousTypes   #-}-{-# LANGUAGE CPP                   #-}-{-# LANGUAGE DataKinds             #-}-{-# LANGUAGE DefaultSignatures     #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE GADTs                 #-}-{-# LANGUAGE MagicHash             #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds             #-}-{-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE StandaloneDeriving    #-}-{-# LANGUAGE TypeApplications      #-}-{-# LANGUAGE TypeFamilies          #-}-{-# LANGUAGE TypeOperators         #-}-{-# LANGUAGE UnboxedTuples         #-}-{-# LANGUAGE UndecidableInstances  #-}+{-# LANGUAGE AllowAmbiguousTypes        #-}+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE DefaultSignatures          #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GADTs                      #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MagicHash                  #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE PolyKinds                  #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE TypeApplications           #-}+{-# LANGUAGE TypeInType                 #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE TypeOperators              #-}+{-# LANGUAGE UnboxedTuples              #-}+{-# LANGUAGE UndecidableInstances       #-} {- | Module      :  Numeric.PrimBytes Copyright   :  (c) Artem Chirkin@@ -86,10 +88,12 @@ import           Data.Type.Equality   ((:~:) (..)) import qualified Data.Type.List       as L import           Data.Type.Lits+import           Foreign.C.Types import           GHC.Exts import           GHC.Generics import           GHC.Int import           GHC.IO               (IO (..))+import           GHC.Stable import           GHC.Word import           Numeric.Dimensions import qualified Numeric.Tuple.Lazy   as TL@@ -304,7 +308,7 @@                 . ( PrimBytes a, Elem name (PrimFields a)                   , KnownSymbol name, Num b)                => a -> b-bFieldOffsetOf a = fromIntegral (I# (byteFieldOffset (proxy# @Symbol @name) a))+bFieldOffsetOf a = fromIntegral (I# (byteFieldOffset (proxy# :: Proxy# name) a))  -- | Same as `Foreign.Storable.peekElemOff`: peek an element @a@ by the offset --   measured in @byteSize a@.@@ -494,7 +498,11 @@     gwriteAddr p = coerce (gwriteAddr @f p)     gbyteSize p = coerce (gbyteSize @f p)     gbyteAlign p = coerce (gbyteAlign @f p)-    gbyteFieldOffset p = coerce (gbyteFieldOffset @f p)+    gbyteFieldOffset p = coerce' (gbyteFieldOffset @f p)+      where+        coerce' :: (Word# -> Int# -> Proxy# name -> f p -> Int#)+                -> Word# -> Int# -> Proxy# name -> M1 i c f p -> Int#+        coerce' = coerce  instance (GPrimBytes f, GPrimBytes g) => GPrimBytes (f :*: g) where     gfromBytes p t ps i ba = x :*: y@@ -932,7 +940,6 @@     writeArray mba i (D# x) = writeDoubleArray# mba i x     {-# INLINE writeArray #-} - instance PrimBytes (Ptr a) where     type PrimFields (Ptr a) = '[]     getBytes (Ptr x) = case runRW#@@ -970,7 +977,80 @@     writeArray mba i (Ptr x) = writeAddrArray# mba i x     {-# INLINE writeArray #-} +instance PrimBytes (FunPtr a) where+    type PrimFields (FunPtr a) = '[]+    getBytes (FunPtr x) = case runRW#+      ( \s0 -> case newByteArray# SIZEOF_HSFUNPTR# s0 of+         (# s1, marr #) -> case writeAddrArray# marr 0# x s1 of+             s2 -> unsafeFreezeByteArray# marr s2+      ) of (# _, a #) -> a+    {-# NOINLINE getBytes #-}+    fromBytes off ba+      = FunPtr (indexWord8ArrayAsAddr# ba off)+    {-# INLINE fromBytes #-}+    readBytes mba off s+      = case readWord8ArrayAsAddr# mba off s of (# s', r #) -> (# s', FunPtr r #)+    {-# INLINE readBytes #-}+    writeBytes mba off (FunPtr x)+      = writeWord8ArrayAsAddr# mba off x+    {-# INLINE writeBytes #-}+    readAddr a s+      = case readAddrOffAddr# a 0# s of (# s', x #) -> (# s', FunPtr x #)+    {-# INLINE readAddr #-}+    writeAddr (FunPtr x) a+      = writeAddrOffAddr# a 0# x+    {-# INLINE writeAddr #-}+    byteSize _ = SIZEOF_HSFUNPTR#+    {-# INLINE byteSize #-}+    byteAlign _ = ALIGNMENT_HSFUNPTR#+    {-# INLINE byteAlign #-}+    byteFieldOffset _ _ = negateInt# 1#+    {-# INLINE byteFieldOffset #-}+    indexArray ba i = FunPtr (indexAddrArray# ba i)+    {-# INLINE indexArray #-}+    readArray mba i s+      = case readAddrArray# mba i s of (# s', x #) -> (# s', FunPtr x #)+    {-# INLINE readArray #-}+    writeArray mba i (FunPtr x) = writeAddrArray# mba i x+    {-# INLINE writeArray #-} +instance PrimBytes (StablePtr a) where+    type PrimFields (StablePtr a) = '[]+    getBytes (StablePtr x) = case runRW#+      ( \s0 -> case newByteArray# SIZEOF_HSSTABLEPTR# s0 of+         (# s1, marr #) -> case writeStablePtrArray# marr 0# x s1 of+             s2 -> unsafeFreezeByteArray# marr s2+      ) of (# _, a #) -> a+    {-# NOINLINE getBytes #-}+    fromBytes off ba+      = StablePtr (indexWord8ArrayAsStablePtr# ba off)+    {-# INLINE fromBytes #-}+    readBytes mba off s+      = case readWord8ArrayAsStablePtr# mba off s of (# s', r #) -> (# s', StablePtr r #)+    {-# INLINE readBytes #-}+    writeBytes mba off (StablePtr x)+      = writeWord8ArrayAsStablePtr# mba off x+    {-# INLINE writeBytes #-}+    readAddr a s+      = case readStablePtrOffAddr# a 0# s of (# s', x #) -> (# s', StablePtr x #)+    {-# INLINE readAddr #-}+    writeAddr (StablePtr x) a+      = writeStablePtrOffAddr# a 0# x+    {-# INLINE writeAddr #-}+    byteSize _ = SIZEOF_HSSTABLEPTR#+    {-# INLINE byteSize #-}+    byteAlign _ = ALIGNMENT_HSSTABLEPTR#+    {-# INLINE byteAlign #-}+    byteFieldOffset _ _ = negateInt# 1#+    {-# INLINE byteFieldOffset #-}+    indexArray ba i = StablePtr (indexStablePtrArray# ba i)+    {-# INLINE indexArray #-}+    readArray mba i s+      = case readStablePtrArray# mba i s of (# s', x #) -> (# s', StablePtr x #)+    {-# INLINE readArray #-}+    writeArray mba i (StablePtr x) = writeStablePtrArray# mba i x+    {-# INLINE writeArray #-}+ instance PrimBytes Int8 where     type PrimFields Int8 = '[]     getBytes (I8# x) = case runRW#@@ -1325,6 +1405,33 @@     writeArray = unsafeCoerce# (writeArray @Word)     {-# INLINE writeArray #-} +deriving instance PrimBytes CChar+deriving instance PrimBytes CSChar+deriving instance PrimBytes CUChar+deriving instance PrimBytes CShort+deriving instance PrimBytes CUShort+deriving instance PrimBytes CInt+deriving instance PrimBytes CUInt+deriving instance PrimBytes CLong+deriving instance PrimBytes CULong+deriving instance PrimBytes CPtrdiff+deriving instance PrimBytes CSize+deriving instance PrimBytes CWchar+deriving instance PrimBytes CSigAtomic+deriving instance PrimBytes CLLong+deriving instance PrimBytes CULLong+deriving instance PrimBytes CBool+deriving instance PrimBytes CIntPtr+deriving instance PrimBytes CUIntPtr+deriving instance PrimBytes CIntMax+deriving instance PrimBytes CUIntMax+deriving instance PrimBytes CClock+deriving instance PrimBytes CTime+deriving instance PrimBytes CUSeconds+deriving instance PrimBytes CSUSeconds+deriving instance PrimBytes CFloat+deriving instance PrimBytes CDouble+ anyList :: forall (k :: Type) (xs :: [k])         . RepresentableList xs => [Any] anyList = unsafeCoerce# (tList @xs)@@ -1463,10 +1570,10 @@       where         go :: L.All PrimBytes ds => MutableByteArray# s            -> Int# -> TS.Tuple ds -> TypeList ds -> State# s -> State# s-        go _ _ _ Empty s = s         go mb n (TS.Id x :* xs) (_ :* ts@TypeList) s           | n' <- roundUpInt n (byteAlign x)           = go mb (n' +# byteSize x) xs ts (writeBytes mb (off +# n') x s)+        go _ _ _ _ s = s     {-# INLINE writeBytes #-}     readAddr addr = go 0# (tList @xs)       where@@ -1484,10 +1591,10 @@       where         go :: L.All PrimBytes ds            => Int# -> TS.Tuple ds -> TypeList ds -> State# s -> State# s-        go _ _ Empty s = s         go n (TS.Id x :* xs) (_ :* ts@TypeList) s           | n' <- roundUpInt n (byteAlign x)           = go (n' +# byteSize x) xs ts (writeAddr x (plusAddr# addr n') s)+        go _ _ _ s = s     {-# INLINE writeAddr #-}     byteSize _ = go 0# 1# (tList @xs)       where@@ -1652,6 +1759,10 @@ writeWord8ArrayAsAddr# mba off = writeAddrArray# mba (uncheckedIShiftRL# off OFFSHIFT_P#) {-# INLINE writeWord8ArrayAsAddr# #-} +writeWord8ArrayAsStablePtr# :: MutableByteArray# d -> Int# -> StablePtr# a -> State# d -> State# d+writeWord8ArrayAsStablePtr# mba off = writeStablePtrArray# mba (uncheckedIShiftRL# off OFFSHIFT_P#)+{-# INLINE writeWord8ArrayAsStablePtr# #-}+ writeWord8ArrayAsFloat# :: MutableByteArray# d -> Int# -> Float# -> State# d -> State# d writeWord8ArrayAsFloat# mba off = writeFloatArray# mba (uncheckedIShiftRL# off OFFSHIFT_F#) {-# INLINE writeWord8ArrayAsFloat# #-}@@ -1700,6 +1811,10 @@ readWord8ArrayAsAddr# mba off = readAddrArray# mba (uncheckedIShiftRL# off OFFSHIFT_P#) {-# INLINE readWord8ArrayAsAddr# #-} +readWord8ArrayAsStablePtr# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, StablePtr# a #)+readWord8ArrayAsStablePtr# mba off = readStablePtrArray# mba (uncheckedIShiftRL# off OFFSHIFT_P#)+{-# INLINE readWord8ArrayAsStablePtr# #-}+ readWord8ArrayAsFloat# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, Float# #) readWord8ArrayAsFloat# mba off = readFloatArray# mba (uncheckedIShiftRL# off OFFSHIFT_F#) {-# INLINE readWord8ArrayAsFloat# #-}@@ -1747,6 +1862,10 @@ indexWord8ArrayAsAddr# :: ByteArray# -> Int# -> Addr# indexWord8ArrayAsAddr# ba off = indexAddrArray# ba (uncheckedIShiftRL# off OFFSHIFT_P#) {-# INLINE indexWord8ArrayAsAddr# #-}++indexWord8ArrayAsStablePtr# :: ByteArray# -> Int# -> StablePtr# a+indexWord8ArrayAsStablePtr# ba off = indexStablePtrArray# ba (uncheckedIShiftRL# off OFFSHIFT_P#)+{-# INLINE indexWord8ArrayAsStablePtr# #-}  indexWord8ArrayAsFloat# :: ByteArray# -> Int# -> Float# indexWord8ArrayAsFloat# ba off = indexFloatArray# ba (uncheckedIShiftRL# off OFFSHIFT_F#)

@@ -1,10 +1,10 @@+{-# LANGUAGE CPP                   #-} {-# LANGUAGE DataKinds             #-} {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE LambdaCase            #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds             #-}-{-# LANGUAGE RecordWildCards       #-} {-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE TypeApplications      #-} {-# LANGUAGE TypeFamilies          #-}@@ -50,6 +50,7 @@           -> XFrame (sortBy compare df')         | otherwise           -> error "sort/DimXNat -- impossible pattern"+{-# ANN sort "HLint: ignore Use sort" #-}  -- | Sort a @DataFrame@ along the first dimension using given comparison function. sortBy :: forall (t :: Type) n ns@@ -110,7 +111,7 @@  instance SortBy 3 where     sortByInplace cmp xs = join $-        go <$> (unsafeDupableInterleaveST (oneMoreDataFrame a))+        go <$> unsafeDupableInterleaveST (oneMoreDataFrame a)            <*> cmp a b <*> cmp b c <*> cmp a c       where         a = subDataFrameView' (Idx 0 :* U) xs@@ -220,7 +221,9 @@     sortByInplace cmp (XSTFrame xs)       | D :* _ <- dims `inSpaceOf` xs         = sortByInplace (\x y -> cmp (castDataFrame x) (castDataFrame y)) xs+#if !MIN_VERSION_GLASGOW_HASKELL(9,0,0,0)       | otherwise = error "sortByInplace: impossible pattern"+#endif   -- | Swap contents of two DataFrames

@@ -7,7 +7,6 @@ {-# LANGUAGE FlexibleInstances         #-} {-# LANGUAGE FunctionalDependencies    #-} {-# LANGUAGE GADTs                     #-}-{-# LANGUAGE MultiParamTypeClasses     #-} {-# LANGUAGE PartialTypeSignatures     #-} {-# LANGUAGE PolyKinds                 #-} {-# LANGUAGE QuasiQuotes               #-}@@ -41,6 +40,9 @@ import qualified Numeric.Tuple.Lazy   as LT import qualified Numeric.Tuple.Strict as ST +-- See dimensions:Numeric.Dimensions.Dim+#define IS_UNSOUND_MATCHING_810_900 (MIN_VERSION_GLASGOW_HASKELL(8,10,0,0) && !MIN_VERSION_GLASGOW_HASKELL(9,1,0,0))+ -- | Maximum number of elements in SomeDims lists maxDims :: Word maxDims = 5@@ -514,6 +516,9 @@       case ds of         (Dims :: Dims ds) -> case inferKnownBackend @ts @ds of           Dict -> SomeDataFrame <$> arbitrary @(DataFrame ts ds)+#if IS_UNSOUND_MATCHING_810_900+        _ -> error "Numeric.Arbitraries.Arbitrary.arbitratry/ds: impossible pattern"+#endif     shrink (SomeDataFrame df) = SomeDataFrame <$> shrink df  @@ -534,6 +539,9 @@       case ds of         XDims (Dims :: Dims ds) -> case inferKnownBackend @ts @ds of           Dict -> XFrame <$> arbitrary @(DataFrame ts ds)+#if IS_UNSOUND_MATCHING_810_900+        _ -> error "Numeric.Arbitraries.Arbitrary.arbitratry/ds: impossible pattern"+#endif     shrink (XFrame df) = XFrame <$> shrink df  

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP                 #-} {-# LANGUAGE DataKinds           #-} {-# LANGUAGE FlexibleContexts    #-} {-# LANGUAGE GADTs               #-}@@ -99,9 +100,9 @@     v = bdV  prop_bidiagonalSimple :: Property-prop_bidiagonalSimple = once . conjoin $ map prop_bidiagonal $ xs+prop_bidiagonalSimple = once . conjoin $ map prop_bidiagonal xs   where-    mkM :: Dims ([n,m]) -> [Double] -> DataFrame Double '[XN 1, XN 1]+    mkM :: Dims [n,m] -> [Double] -> DataFrame Double '[XN 1, XN 1]     mkM ds       | Just (XDims ds'@Dims) <- constrainDims ds :: Maybe (Dims '[XN 1, XN 1])         = XFrame . fromFlatList ds' 0@@ -133,7 +134,9 @@   | n@D :* m@D :* U <- dims `inSpaceOf` x   , D <- minDim n m     = validateBidiagonal x (bidiagonalHouseholder x)+#if !MIN_VERSION_GLASGOW_HASKELL(8,10,0,0) prop_bidiagonal _ = property False+#endif   

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP                 #-} {-# LANGUAGE DataKinds           #-} {-# LANGUAGE FlexibleContexts    #-} {-# LANGUAGE GADTs               #-}@@ -86,7 +87,9 @@   where     mkM :: Dim (n :: Nat) -> [t] -> SomeSquareMatrix AnyMatrix t     mkM (d@D :: Dim n) = SSM . fromFlatList (d :* d :* U) 0+#if !MIN_VERSION_GLASGOW_HASKELL(8,10,0,0)     mkM _              = error "manualMats: bad dims"+#endif     variants :: Num a => [a] -> [[a]]     variants as = rotateList as ++ rotateList (map negate as) 

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP                 #-} {-# LANGUAGE DataKinds           #-} {-# LANGUAGE FlexibleContexts    #-} {-# LANGUAGE GADTs               #-}@@ -115,7 +116,7 @@                 ]       ]   where-    mkM :: Dims ([n,m]) -> [Double] -> DataFrame Double '[XN 1, XN 1]+    mkM :: Dims [n,m] -> [Double] -> DataFrame Double '[XN 1, XN 1]     mkM ds       | Just (XDims ds'@Dims) <- constrainDims ds :: Maybe (Dims '[XN 1, XN 1])         = XFrame . fromFlatList ds' 0@@ -131,7 +132,9 @@   | n@D :* m@D :* U <- dims `inSpaceOf` x   , D <- minDim n m     = validateLQ x (lq x)+#if !MIN_VERSION_GLASGOW_HASKELL(8,10,0,0) prop_lq _ = property False+#endif  prop_qrSimple :: Property prop_qrSimple = once . conjoin $ map prop_qr manualMats@@ -141,7 +144,9 @@   | n@D :* m@D :* U <- dims `inSpaceOf` x   , D <- minDim n m     = validateQR x (qr x)+#if !MIN_VERSION_GLASGOW_HASKELL(8,10,0,0) prop_qr _ = property False+#endif   testQRSolve :: forall t n m

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP                 #-} {-# LANGUAGE DataKinds           #-} {-# LANGUAGE FlexibleContexts    #-} {-# LANGUAGE GADTs               #-}@@ -142,7 +143,7 @@ dfs :: [DataFrame Double '[XN 1, XN 1]] dfs = xs   where-    mkM :: Dims ([n,m]) -> [Double] -> DataFrame Double '[XN 1, XN 1]+    mkM :: Dims [n,m] -> [Double] -> DataFrame Double '[XN 1, XN 1]     mkM ds       | Just (XDims ds'@Dims) <- constrainDims ds :: Maybe (Dims '[XN 1, XN 1])         = XFrame . fromFlatList ds' 0@@ -173,7 +174,9 @@ prop_svd (XFrame x)   | n@D :* m@D :* U <- dims `inSpaceOf` x   , D <- minDim n m = validateSVD 1 x (svd x)+#if !MIN_VERSION_GLASGOW_HASKELL(8,10,0,0) prop_svd _ = error "prop_svd: impossible pattern"+#endif   return []

@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -Wno-orphans #-} {-# LANGUAGE AllowAmbiguousTypes   #-} {-# LANGUAGE DataKinds             #-} {-# LANGUAGE DefaultSignatures     #-}@@ -22,6 +23,7 @@ import           Data.Int import           Data.Type.Lits import           Data.Word+import           Foreign.C.Types import           Foreign.Marshal import           Foreign.Ptr import           Foreign.Storable@@ -107,6 +109,9 @@     peek = bPeek     poke = bPoke +instance Arbitrary CBool where+    arbitrary = CBool <$> arbitrary+ instance Arbitrary (Ptr Dummy) where     arbitrary = intPtrToPtr . IntPtr <$> arbitrary @@ -300,13 +305,13 @@   , off <- byteOffset v     = conjoin     [ counterexample "pos" $ pos v === fromBytes-        (off +# byteFieldOffset (proxy# @Symbol @"pos") v) ba+        (off +# byteFieldOffset (proxy# :: Proxy# "pos") v) ba     , counterexample "norm" $ norm v === fromBytes-       (off +# byteFieldOffset (proxy# @Symbol @"norm") v) ba+       (off +# byteFieldOffset (proxy# :: Proxy# "norm") v) ba     , counterexample "tex" $ tex v === fromBytes-       (off +# byteFieldOffset (proxy# @Symbol @"tex") v) ba+       (off +# byteFieldOffset (proxy# :: Proxy# "tex") v) ba     , counterexample "extraFloats" $ extraFloats v === fromBytes-       (off +# byteFieldOffset (proxy# @Symbol @"extraFloats") v) ba+       (off +# byteFieldOffset (proxy# :: Proxy# "extraFloats") v) ba     ]  @@ -316,6 +321,12 @@    '[ Word8, Word16, Word32, Word64, Word     , Int8, Int16, Int32, Int64, Int     , Char, Double, Float+    , CChar, CSChar, CUChar, CShort, CUShort+    , CInt, CUInt, CLong, CULong+    , CPtrdiff, CSize, CWchar, CSigAtomic+    , CLLong, CULLong, CBool, CIntPtr, CUIntPtr+    , CIntMax, CUIntMax, CClock, CTime+    , CUSeconds, CSUSeconds, CFloat, CDouble     , Vertex Double Float Char     , Vertex Word8 Double Int16     , Vertex Word16 Word32 Word64@@ -343,34 +354,74 @@    , '(Word16, Word32, Word64)    , '(Int64, Int8, Int32)    , '(Float, Char, Char)+   , '(CChar, CInt, CPtrdiff)+   , '(CSChar, CUInt, CSize)+   , '(CUChar, CLong, CWchar)+   , '(CShort, CULong, CSigAtomic)+   , '(CUShort, CLLong, CIntMax)+   , '(CULLong, CUIntMax, CUSeconds)+   , '(CBool, CClock, CSUSeconds)+   , '(CIntPtr, CTime, CFloat)+   , '(CUIntPtr, CDouble, CDouble)    ] -instance SamePrimRep a (ST.Tuple '[a]) where-  convert a = a ST.:$ U-instance SamePrimRep (a,b) (ST.Tuple '[a,b]) where-  convert (a, b) = a ST.:$ b ST.:$ U-instance SamePrimRep (a,b,c) (ST.Tuple '[a,b,c]) where-  convert (a, b, c) = a ST.:$ b ST.:$ c ST.:$ U-instance SamePrimRep (a,b,c,d) (ST.Tuple '[a,b,c,d]) where-  convert (a, b, c, d) = a ST.:$ b ST.:$ c ST.:$ d ST.:$ U-instance SamePrimRep (a,b,c,d,e) (ST.Tuple '[a,b,c,d,e]) where-  convert (a, b, c, d, e) = a ST.:$ b ST.:$ c ST.:$ d ST.:$ e ST.:$ U+instance SamePrimRep a a where+  convert = id -instance SamePrimRep a (LT.Tuple '[a]) where-  convert a = a LT.:$ U-instance SamePrimRep (a,b) (LT.Tuple '[a,b]) where-  convert (a, b) = a LT.:$ b LT.:$ U-instance SamePrimRep (a,b,c) (LT.Tuple '[a,b,c]) where-  convert (a, b, c) = a LT.:$ b LT.:$ c LT.:$ U-instance SamePrimRep (a,b,c,d) (LT.Tuple '[a,b,c,d]) where-  convert (a, b, c, d) = a LT.:$ b LT.:$ c LT.:$ d LT.:$ U-instance SamePrimRep (a,b,c,d,e) (LT.Tuple '[a,b,c,d,e]) where-  convert (a, b, c, d, e) = a LT.:$ b LT.:$ c LT.:$ d LT.:$ e LT.:$ U+instance SamePrimRep a a' => SamePrimRep a (ST.Tuple '[a']) where+  convert a = convert a ST.:$ U+instance (SamePrimRep a a', SamePrimRep b b') => SamePrimRep (a,b) (ST.Tuple '[a',b']) where+  convert (a, b) = convert a ST.:$ convert b ST.:$ U+instance (SamePrimRep a a', SamePrimRep b b', SamePrimRep c c') => SamePrimRep (a,b,c) (ST.Tuple '[a',b',c']) where+  convert (a, b, c) = convert a ST.:$ convert b ST.:$ convert c ST.:$ U+instance (SamePrimRep a a', SamePrimRep b b', SamePrimRep c c', SamePrimRep d d') => SamePrimRep (a,b,c,d) (ST.Tuple '[a',b',c',d']) where+  convert (a, b, c, d) = convert a ST.:$ convert b ST.:$ convert c ST.:$ convert d ST.:$ U+instance (SamePrimRep a a', SamePrimRep b b', SamePrimRep c c', SamePrimRep d d', SamePrimRep e e') => SamePrimRep (a,b,c,d,e) (ST.Tuple '[a',b',c',d',e']) where+  convert (a, b, c, d, e) = convert a ST.:$ convert b ST.:$ convert c ST.:$ convert d ST.:$ convert e ST.:$ U +instance SamePrimRep a a' => SamePrimRep a (LT.Tuple '[a']) where+  convert a = convert a LT.:$ U+instance (SamePrimRep a a', SamePrimRep b b') => SamePrimRep (a,b) (LT.Tuple '[a',b']) where+  convert (a, b) = convert a LT.:$ convert b LT.:$ U+instance (SamePrimRep a a', SamePrimRep b b', SamePrimRep c c') => SamePrimRep (a,b,c) (LT.Tuple '[a',b',c']) where+  convert (a, b, c) = convert a LT.:$ convert b LT.:$ convert c LT.:$ U+instance (SamePrimRep a a', SamePrimRep b b', SamePrimRep c c', SamePrimRep d d') => SamePrimRep (a,b,c,d) (LT.Tuple '[a',b',c',d']) where+  convert (a, b, c, d) = convert a LT.:$ convert b LT.:$ convert c LT.:$ convert d LT.:$ U+instance (SamePrimRep a a', SamePrimRep b b', SamePrimRep c c', SamePrimRep d d', SamePrimRep e e') => SamePrimRep (a,b,c,d,e) (LT.Tuple '[a',b',c',d',e']) where+  convert (a, b, c, d, e) = convert a LT.:$ convert b LT.:$ convert c LT.:$ convert d LT.:$ convert e LT.:$ U+ instance SamePrimRep (Maybe a) (Either () a) where   convert (Just a) = Right a   convert Nothing  = Left () +instance SamePrimRep CChar Int8 where convert (CChar v) = v+instance SamePrimRep CSChar Int8 where convert (CSChar v) = v+instance SamePrimRep CSChar CChar where convert (CSChar v) = CChar v+instance SamePrimRep CUChar Word8 where convert (CUChar v) = v+instance SamePrimRep CShort Int16 where convert (CShort v) = v+instance SamePrimRep CUShort Word16 where convert (CUShort v) = v+instance SamePrimRep CInt Int32 where convert (CInt v) = v+instance SamePrimRep CUInt Word32 where convert (CUInt v) = v+instance SamePrimRep CLong Int64 where convert (CLong v) = v+instance SamePrimRep CULong Word64 where convert (CULong v) = v+instance SamePrimRep CPtrdiff Int64 where convert (CPtrdiff v) = v+instance SamePrimRep CSize Word64 where convert (CSize v) = v+instance SamePrimRep CWchar Int32 where convert (CWchar v) = v+instance SamePrimRep CSigAtomic Int32 where convert (CSigAtomic v) = v+instance SamePrimRep CLLong Int64 where convert (CLLong v) = v+instance SamePrimRep CULLong Word64 where convert (CULLong v) = v+instance SamePrimRep CBool Word8 where convert (CBool v) = v+instance SamePrimRep CIntPtr Int64 where convert (CIntPtr v) = v+instance SamePrimRep CUIntPtr Word64 where convert (CUIntPtr v) = v+instance SamePrimRep CIntMax Int64 where convert (CIntMax v) = v+instance SamePrimRep CUIntMax Word64 where convert (CUIntMax v) = v+instance SamePrimRep CClock Int64 where convert (CClock v) = v+instance SamePrimRep CTime Int64 where convert (CTime v) = v+instance SamePrimRep CUSeconds Word32 where convert (CUSeconds v) = v+instance SamePrimRep CSUSeconds Int64 where convert (CSUSeconds v) = v+instance SamePrimRep CFloat Float where convert (CFloat v) = v+instance SamePrimRep CDouble Double where convert (CDouble v) = v+ type SamePrimRepTypes =   '[ '( (Word, Double), ST.Tuple '[Word, Double] )    , '( (Double, Word8, Word8, Word8, Maybe Float)@@ -379,6 +430,13 @@       , LT.Tuple '[Word8, Int16, Word32, Either (Either Double Float) Int] )    , '( Maybe Float, Either () Float)    , '( Maybe Double, Either () Double)+   , '( (CChar, CSChar, CSChar, CUChar), ST.Tuple '[Int8, Int8, CChar, Word8] )+   , '( (CShort, CUShort, CInt, CUInt), LT.Tuple '[Int16, Word16, Int32, Word32] )+   , '( (CLong, CULong, CPtrdiff, CSize), ST.Tuple '[Int64, Word64, Int64, Word64] )+   , '( (CWchar, CSigAtomic, CLLong, CULLong), LT.Tuple '[Int32, Int32, Int64, Word64] )+   , '( (CBool, CIntPtr, CUIntPtr, CIntMax, CUIntMax), ST.Tuple '[Word8, Int64, Word64, Int64, Word64] )+   , '( (CClock, CTime, CUSeconds, CSUSeconds), LT.Tuple '[Int64, Int64, Word32, Int64] )+   , '( (CFloat, CDouble), ST.Tuple '[Float, Double] )    ]  return [] -- this is for $testWithTypes

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP             #-} {-# LANGUAGE QuasiQuotes     #-} {-# LANGUAGE TemplateHaskell #-} @@ -29,7 +30,9 @@   where     mkProp :: [Type] -> Exp -> ExpQ     mkProp ts ex-     = let qe = pure ex :: ExpQ+     = let qe :: ExpQ+           qe = pure ex+           qs :: ExpQ            qs = litE . stringL $ unlines ["Tested with types:", pprint ts]        in [e| property ( counterexample $qs $qe ) |] @@ -87,6 +90,7 @@     funTypes :: [TypeQ]     funTypes       = (\ns -> fmap (subtTyVars (map ConT ns)) ) <$> tyNames <*> [infoType <$> reify fName]+    mkDecl :: Q Name -> Q Type -> Q Exp -> DecsQ     mkDecl qn qt qe = do       n <- qn       sequence@@ -124,10 +128,17 @@ substTyVar x y (ForallT vs ctx t)     = ForallT (remVar vs) (ctx >>= substOrRemove) (substTyVar x y t)   where+#if __GLASGOW_HASKELL__ >= 900+    thisVar :: TyVarBndr a -> Bool+    thisVar (PlainTV n _)    = n == x+    thisVar (KindedTV n _ _) = n == x+    remVar :: [TyVarBndr a] -> [TyVarBndr a]+#else     thisVar :: TyVarBndr -> Bool     thisVar (PlainTV n)    = n == x     thisVar (KindedTV n _) = n == x     remVar :: [TyVarBndr] -> [TyVarBndr]+#endif     remVar = filter (not . thisVar)     substOrRemove p       = let p' = substTyVar x y p@@ -141,8 +152,13 @@ substTyVar _ _ t = t  findFirstTyVar :: Type -> Maybe Name+#if __GLASGOW_HASKELL__ >= 900+findFirstTyVar (ForallT (PlainTV n _:_) _ _) = Just n+findFirstTyVar (ForallT (KindedTV n _ _:_) _ _) = Just n+#else findFirstTyVar (ForallT (PlainTV n:_) _ _) = Just n findFirstTyVar (ForallT (KindedTV n _:_) _ _) = Just n+#endif findFirstTyVar (ForallT [] ctx t)   = getFirst (foldMap (First . findFirstTyVar) ctx) <|> findFirstTyVar t findFirstTyVar (AppT t1 t2) = findFirstTyVar t1 <|> findFirstTyVar t2