easytensor 2.0.1.0 → 2.1.0.0

raw patch · 61 files changed

+8508/−3074 lines, 61 filesdep ~constraints-derivingbuild-type:Customsetup-changedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: constraints-deriving

API changes (from Hackage documentation)

Files

• Setup.hs +31/−1
• bench/subspacefolds.hs +10/−10
• easytensor.cabal +31/−12
• src-base/Numeric/DataFrame/Internal/Backend/Family.hs +28/−22
• src-base/Numeric/DataFrame/Internal/Backend/Family/ArrayBase.hs +119/−140
• src-base/Numeric/DataFrame/Internal/Backend/Family/DoubleX2.hs +6/−8
• src-base/Numeric/DataFrame/Internal/Backend/Family/DoubleX3.hs +6/−7
• src-base/Numeric/DataFrame/Internal/Backend/Family/DoubleX4.hs +6/−7
• src-base/Numeric/DataFrame/Internal/Backend/Family/FloatX2.hs +6/−7
• src-base/Numeric/DataFrame/Internal/Backend/Family/FloatX3.hs +6/−7
• src-base/Numeric/DataFrame/Internal/Backend/Family/FloatX4.hs +11/−13
• src-base/Numeric/DataFrame/Internal/Backend/Family/ScalarBase.hs +11/−10
• src/Numeric/Basics.hs +238/−0
• src/Numeric/DataFrame.hs +6/−0
• src/Numeric/DataFrame/Contraction.hs +14/−13
• src/Numeric/DataFrame/IO.hs +276/−138
• src/Numeric/DataFrame/Internal/Backend.hs +63/−37
• src/Numeric/DataFrame/Internal/Backend.hs-boot +42/−46
• src/Numeric/DataFrame/Internal/BackendI.hs +38/−11
• src/Numeric/DataFrame/Internal/BackendI.hs-boot +0/−9
• src/Numeric/DataFrame/Internal/Mutable.hs +401/−153
• src/Numeric/DataFrame/Internal/PrimArray.hs +218/−24
• src/Numeric/DataFrame/ST.hs +271/−126
• src/Numeric/DataFrame/SubSpace.hs +1265/−503
• src/Numeric/DataFrame/Type.hs +503/−88
• src/Numeric/Matrix.hs +2/−4
• src/Numeric/Matrix/Bidiagonal.hs +123/−0
• src/Numeric/Matrix/Internal.hs +0/−243
• src/Numeric/Matrix/Internal/Double.hs +199/−0
• src/Numeric/Matrix/Internal/Float.hs +199/−0
• src/Numeric/Matrix/Internal/Mat44d.hs +0/−186
• src/Numeric/Matrix/Internal/Mat44f.hs +0/−186
• src/Numeric/Matrix/LU.hs +201/−0
• src/Numeric/Matrix/QR.hs +231/−0
• src/Numeric/Matrix/SVD.hs +799/−0
• src/Numeric/PrimBytes.hs +11/−12
• src/Numeric/ProductOrd/NonTransitive.hs +0/−2
• src/Numeric/ProductOrd/Partial.hs +0/−2
• src/Numeric/Quaternion/Internal.hs +7/−1
• src/Numeric/Quaternion/Internal/QDouble.hs +228/−152
• src/Numeric/Quaternion/Internal/QFloat.hs +228/−152
• src/Numeric/Scalar/Internal.hs +5/−20
• src/Numeric/Subroutine/Householder.hs +278/−0
• src/Numeric/Subroutine/SolveTriangular.hs +173/−0
• src/Numeric/Subroutine/Sort.hs +250/−0
• src/Numeric/Vector/Internal.hs +40/−39
• test/Numeric/Arbitraries.hs +614/−0
• test/Numeric/DataFrame/Arbitraries.hs +0/−274
• test/Numeric/DataFrame/BasicTest.hs +1/−2
• test/Numeric/DataFrame/SubSpaceTest.hs +110/−31
• test/Numeric/Matrix/BidiagonalTest.hs +144/−0
• test/Numeric/Matrix/LUTest.hs +104/−0
• test/Numeric/Matrix/QRTest.hs +203/−0
• test/Numeric/Matrix/SVDTest.hs +182/−0
• test/Numeric/MatrixDoubleTest.hs +101/−126
• test/Numeric/MatrixFloatTest.hs +101/−132
• test/Numeric/PrimBytesTest.hs +3/−3
• test/Numeric/QuaterDoubleTest.hs +52/−57
• test/Numeric/QuaterFloatTest.hs +52/−57
• test/Numeric/Subroutine/SolveTriangularTest.hs +249/−0
• test/Spec.hs +12/−1

@@ -1,2 +1,32 @@+{-+Disable some errors and warnings during the haddock pass+  (caused by compiler plugins and hs-boot)+ -}+{-# OPTIONS_GHC -Wall #-}+module Main (main) where+ import Distribution.Simple-main = defaultMain+import Distribution.Simple.Setup++main :: IO ()+main = defaultMainWithHooks simpleUserHooks+  { confHook = \a -> confHook simpleUserHooks a . tweakFlags }++tweakFlags :: ConfigFlags -> ConfigFlags+tweakFlags flags = flags+  { configProgramArgs = addHaddockArgs (configProgramArgs flags) }++addHaddockArgs :: [(String, [String])] -> [(String, [String])]+addHaddockArgs []+  = [("haddock", newHaddockGhcArgs)]+addHaddockArgs (("haddock", args):otherProgsArgs)+  = ("haddock", args ++ newHaddockGhcArgs) : otherProgsArgs+addHaddockArgs (progArgs:otherProgsArgs)+  = progArgs : addHaddockArgs otherProgsArgs++newHaddockGhcArgs :: [String]+newHaddockGhcArgs =+  [ "--optghc=-fdefer-type-errors"+  , "--optghc=-fno-warn-deferred-type-errors"+  , "--optghc=-fno-warn-missing-home-modules"+  ]

@@ -23,47 +23,47 @@     seq t1 putStrLn $ "Created DataFrame, elapsed time is " ++ show (diffUTCTime t1 t0)      putStrLn "\nRunning a ewfoldl on scalar elements..."-    let rezEwf = ewfoldl @Float @DList @'[] (\a x -> return $! fromMaybe x a + fromMaybe 0 a / (x+1)) (Just 1)  df+    let rezEwf = ewfoldl' @Float @DList @'[] (\a x -> return $! fromMaybe x a + fromMaybe 0 a / (x+1)) (Just 1)  df     t2 <- rezEwf `seq` getCurrentTime     seq t2 putStrLn $ "Done; elapsed time = " ++ show (diffUTCTime t2 t1)     print rezEwf      putStrLn "\nRunning a iwfoldl on scalar elements (not using idx)..."-    let rezIwf = iwfoldl @Float  @DList @'[] (\_ a x -> a +  a / (x+1)) 1 df+    let rezIwf = iwfoldl' @Float  @DList @'[] (\_ a x -> a +  a / (x+1)) 1 df     t3 <- rezIwf `seq` getCurrentTime     seq t3 putStrLn $ "Done; elapsed time = " ++ show (diffUTCTime t3 t2)     print rezIwf      putStrLn "\nRunning a iwfoldr on scalar elements (using fromEnum idx)..."-    let rezIwf2 = iwfoldr @Float @DList @'[] (\i x a -> return $! fromMaybe 0 a + x / ((1+) . fromIntegral $ fromEnum i)) (Just 0) df+    let rezIwf2 = iwfoldr' @Float @DList @'[] (\i x a -> return $! fromMaybe 0 a + x / ((1+) . fromIntegral $ fromEnum i)) (Just 0) df     t4 <- rezIwf2 `seq` getCurrentTime     seq t4 putStrLn $ "Done; elapsed time = " ++ show (diffUTCTime t4 t3)     print rezIwf2      putStrLn "\nRunning a iwfoldl on scalar elements (enforcing idx)..."-    let rezIwf3 = iwfoldl @Float @DList @'[] (\i a x -> i `seq` return $! fromMaybe 0 a + fromMaybe x a / (x+1)) (Just 1) df+    let rezIwf3 = iwfoldl' @Float @DList @'[] (\i a x -> i `seq` return $! fromMaybe 0 a + fromMaybe x a / (x+1)) (Just 1) df     t5 <- rezIwf3 `seq` getCurrentTime     seq t5 putStrLn $ "Done; elapsed time = " ++ show (diffUTCTime t5 t4)     print rezIwf3      putStrLn "\nRunning a ewfoldl on vector4 elements..."-    let rezEwv1 = ewfoldl @Float @(Init DList) @'[Last DList]-                          (\a x -> return $! fromMaybe 2 a + fromMaybe 0 a / (1 + iwgen @_ @_ @'[] (\(Idx i:*U) -> x ! Idx (i+1) :* U )) )+    let rezEwv1 = ewfoldl' @Float @(Init DList) @'[Last DList]+                          (\a x -> return $! fromMaybe 2 a + fromMaybe 0 a / (1 + iwgen @_ @_ @'[] (\(Idx i:*U) -> x ! (i+1) )) )                           (Just (3 :: DataFrame Float '[4])) df     t6 <- rezEwv1 `seq` getCurrentTime     seq t6 putStrLn $ "Done; elapsed time = " ++ show (diffUTCTime t6 t5)     print rezEwv1      putStrLn "\nRunning a ewfoldr on vector3 elements..."-    let rezEwv2 = ewfoldr @Float @(Init DList) @'[Last DList]-                          (\x a -> return $! fromMaybe 2 a + fromMaybe 1 a / (1 + iwgen @_ @_ @'[] (\(Idx i:*U) -> x ! Idx (i+1):* U )))+    let rezEwv2 = ewfoldr' @Float @(Init DList) @'[Last DList]+                          (\x a -> return $! fromMaybe 2 a + fromMaybe 1 a / (1 + iwgen @_ @_ @'[] (\(Idx i:*U) -> x ! (i+1) )))                           (Just (3 :: DataFrame Float '[3])) df     t7 <- rezEwv2 `seq` getCurrentTime     seq t7 putStrLn $ "Done; elapsed time = " ++ show (diffUTCTime t7 t6)     print rezEwv2      putStrLn "\nRunning a ewfoldr with matrix products..."-    let rezEwm = ewfoldr @Float @(Take 3 DList) @(Drop 3 DList)+    let rezEwm = ewfoldr' @Float @(Take 3 DList) @(Drop 3 DList)                           (\x a ->  a + x %* (DF5 1 0.5 0.1 0.01 0.001)  )                           (1 :: DataFrame Float (Init (Drop 3 DList) +: 3)) df     t8 <- rezEwm `seq` getCurrentTime@@ -74,4 +74,4 @@       putStrLn "Checking indexes"-    print $ df ! (2:*1:*1:*3:*1:*U :: Idxs (Take 5 DList))+    print $ df.!2.!1.!1.!3.!1

@@ -1,11 +1,13 @@--- This file has been generated from package.yaml by hpack version 0.28.2.+cabal-version: 1.24++-- This file has been generated from package.yaml by hpack version 0.31.1. -- -- see: https://github.com/sol/hpack ----- hash: c1b3d6ebe751438aebdd514a166566c79aa2a98083755f019015772fc95cb34e+-- hash: 75fa5546720cb775f5ce9a26382fcd60253bba851441e469156242ee52655f97  name:           easytensor-version:        2.0.1.0+version:        2.1.0.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@@ -16,14 +18,18 @@ copyright:      Copyright: (c) 2019 Artem Chirkin license:        BSD3 license-file:   LICENSE-build-type:     Simple-cabal-version:  >= 1.10+build-type:     Custom  source-repository head   type: git   location: https://github.com/achirkin/easytensor   subdir: easytensor +custom-setup+  setup-depends:+      Cabal+    , base+ flag unsafeindices   description: Disable bound checks when accessing elements of a tensor, matrix, or vector.   manual: True@@ -31,6 +37,7 @@  library   exposed-modules:+      Numeric.Basics       Numeric.DataFrame       Numeric.DataFrame.Contraction       Numeric.DataFrame.Internal.Backend@@ -41,17 +48,24 @@       Numeric.DataFrame.SubSpace       Numeric.DataFrame.Type       Numeric.Matrix+      Numeric.Matrix.Bidiagonal+      Numeric.Matrix.LU+      Numeric.Matrix.QR+      Numeric.Matrix.SVD       Numeric.PrimBytes       Numeric.ProductOrd       Numeric.ProductOrd.NonTransitive       Numeric.ProductOrd.Partial       Numeric.Quaternion       Numeric.Scalar+      Numeric.Subroutine.Householder+      Numeric.Subroutine.SolveTriangular+      Numeric.Subroutine.Sort       Numeric.Vector   other-modules:       Numeric.Matrix.Internal-      Numeric.Matrix.Internal.Mat44d-      Numeric.Matrix.Internal.Mat44f+      Numeric.Matrix.Internal.Double+      Numeric.Matrix.Internal.Float       Numeric.Scalar.Internal       Numeric.Vector.Internal       Numeric.Quaternion.Internal@@ -73,7 +87,7 @@   ghc-options: -Wall -Wcompat -Wtabs -Wmonomorphism-restriction -Wmissing-local-signatures -Wmissing-home-modules -Widentities -Wredundant-constraints   build-depends:       base >=4.11 && <5-    , constraints-deriving >=1.0.4.0 && <2+    , constraints-deriving >=1.1.1.0 && <2     , dimensions >=2 && <3   if flag(unsafeindices)     cpp-options: -DUNSAFE_INDICES@@ -83,14 +97,19 @@   type: exitcode-stdio-1.0   main-is: Spec.hs   other-modules:-      Numeric.DataFrame.Arbitraries+      Numeric.Arbitraries       Numeric.DataFrame.BasicTest       Numeric.DataFrame.SubSpaceTest+      Numeric.Matrix.BidiagonalTest+      Numeric.Matrix.LUTest+      Numeric.Matrix.QRTest+      Numeric.Matrix.SVDTest       Numeric.MatrixDoubleTest       Numeric.MatrixFloatTest       Numeric.PrimBytesTest       Numeric.QuaterDoubleTest       Numeric.QuaterFloatTest+      Numeric.Subroutine.SolveTriangularTest       Spec.Util       Paths_easytensor   hs-source-dirs:@@ -100,7 +119,7 @@       Cabal     , QuickCheck     , base >=4.11 && <5-    , constraints-deriving >=1.0.4.0 && <2+    , constraints-deriving >=1.1.1.0 && <2     , dimensions >=2 && <3     , easytensor     , template-haskell@@ -116,7 +135,7 @@   ghc-options: -Wall -Wcompat -Wtabs -Wmonomorphism-restriction -Wmissing-local-signatures -Wmissing-home-modules -Widentities -Wredundant-constraints   build-depends:       base >=4.11 && <5-    , constraints-deriving >=1.0.4.0 && <2+    , constraints-deriving >=1.1.1.0 && <2     , dimensions >=2 && <3     , easytensor   default-language: Haskell2010@@ -131,7 +150,7 @@   ghc-options: -Wall -Wcompat -Wtabs -Wmonomorphism-restriction -Wmissing-local-signatures -Wmissing-home-modules -Widentities -Wredundant-constraints   build-depends:       base >=4.11 && <5-    , constraints-deriving >=1.0.4.0 && <2+    , constraints-deriving >=1.1.1.0 && <2     , dimensions >=2 && <3     , easytensor     , time

@@ -14,6 +14,8 @@ {-# LANGUAGE TypeFamilyDependencies #-} {-# LANGUAGE TypeInType             #-} {-# LANGUAGE TypeOperators          #-}+-- Combined GADT patterns are a bit of a trouble+{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-} -- Constraints @b ~ BackendFamily t ds@ is not redundant; they allows to avoid AllowAmbigousTypes. {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} {- |@@ -66,10 +68,6 @@     BackendFamily Double '[4]   = DoubleX4     BackendFamily t       ds    = ArrayBase t ds --- | Promise that we are sure the backend is ArrayBase.-unsafeDefault :: forall t ds . Dict (BackendFamily t ds ~ ArrayBase t ds)-unsafeDefault = unsafeCoerce# (Dict @(ArrayBase t ds ~ ArrayBase t ds))- -- | Singleton type used to determine the currently used DataFrame backend; --   establishes a good bijection @b <~> t ds@ (better than just using @BackendFamily@ everywhere). data BackendSing (t :: Type) (ds :: [Nat]) (backend :: Type) where@@ -99,33 +97,41 @@ #if defined(__HADDOCK__) || defined(__HADDOCK_VERSION__) instance KnownBackend t ds b where bSing = undefined #else-instance KnownBackend t      '[]  (ScalarBase t)   where bSing = BSC-instance KnownBackend Float  '[2]  FloatX2         where bSing = BF2-instance KnownBackend Float  '[3]  FloatX3         where bSing = BF3-instance KnownBackend Float  '[4]  FloatX4         where bSing = BF4-instance KnownBackend Double '[2]  DoubleX2        where bSing = BD2-instance KnownBackend Double '[3]  DoubleX3        where bSing = BD3-instance KnownBackend Double '[4]  DoubleX4        where bSing = BD4+instance KnownBackend t      '[]  (ScalarBase t)   where bSing = BSC; {-# INLINE bSing #-}+instance KnownBackend Float  '[2]  FloatX2         where bSing = BF2; {-# INLINE bSing #-}+instance KnownBackend Float  '[3]  FloatX3         where bSing = BF3; {-# INLINE bSing #-}+instance KnownBackend Float  '[4]  FloatX4         where bSing = BF4; {-# INLINE bSing #-}+instance KnownBackend Double '[2]  DoubleX2        where bSing = BD2; {-# INLINE bSing #-}+instance KnownBackend Double '[3]  DoubleX3        where bSing = BD3; {-# INLINE bSing #-}+instance KnownBackend Double '[4]  DoubleX4        where bSing = BD4; {-# INLINE bSing #-} instance PrimBytes t       => KnownBackend t       ds  (ArrayBase t ds) where     bSing = case unsafeDefault @t @ds of Dict -> BPB+    {-# INLINE bSing #-}+instance {-# INCOHERENT #-}+         (PrimBytes t, Dimensions ds, b ~ BackendFamily t ds)+      => KnownBackend t ds b where+    bSing = case (dims @ds, primTag @t undefined) of+      (U, _)                -> BSC+      (D2 :* U, PTagFloat)  -> BF2+      (D3 :* U, PTagFloat)  -> BF3+      (D4 :* U, PTagFloat)  -> BF4+      (D2 :* U, PTagDouble) -> BD2+      (D3 :* U, PTagDouble) -> BD3+      (D4 :* U, PTagDouble) -> BD4+      _                     -> case unsafeDefault @t @ds of Dict -> BPB+    {-# INLINE bSing #-}++-- | Promise that we are sure the backend is ArrayBase.+unsafeDefault :: forall t ds . Dict (BackendFamily t ds ~ ArrayBase t ds)+unsafeDefault = unsafeCoerce# (Dict @(ArrayBase t ds ~ ArrayBase t ds)) #endif  -- | Find an instance of `KnownBackend` class using `PrimBytes` and `Dimensions`. inferKnownBackend :: forall t ds b                   . (PrimBytes t, Dimensions ds, b ~ BackendFamily t ds)                   => Dict (KnownBackend t ds b)-inferKnownBackend = case (dims @ds, primTag @t undefined) of-  (U, _) -> Dict-  (d :* U, PTagFloat)-      | Just Dict <- sameDim (D @2) d -> Dict-      | Just Dict <- sameDim (D @3) d -> Dict-      | Just Dict <- sameDim (D @4) d -> Dict-  (d :* U, PTagDouble)-      | Just Dict <- sameDim (D @2) d -> Dict-      | Just Dict <- sameDim (D @3) d -> Dict-      | Just Dict <- sameDim (D @4) d -> Dict-  _ -> case unsafeDefault @t @ds of Dict -> Dict+inferKnownBackend = Dict {-# INLINE inferKnownBackend #-}  

@@ -1,9 +1,9 @@+{-# LANGUAGE AllowAmbiguousTypes       #-} {-# LANGUAGE ConstraintKinds           #-} {-# LANGUAGE DataKinds                 #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts          #-} {-# LANGUAGE FlexibleInstances         #-}-{-# LANGUAGE GADTs                     #-} {-# LANGUAGE MagicHash                 #-} {-# LANGUAGE MultiParamTypeClasses     #-} {-# LANGUAGE PolyKinds                 #-}@@ -24,6 +24,7 @@ import           Data.Int import           Data.Word import           GHC.Base                             hiding (foldr)+import           GHC.Exts                             (TYPE) import           Numeric.DataFrame.Internal.PrimArray import           Numeric.Dimensions import           Numeric.PrimBytes@@ -40,24 +41,23 @@     (# t --  Same value for each element;          --  this is the cheapest way to initialize an array.          --  It is also used for Num instances to avoid dependency on Dimensions.-     | (# Int#  -- Offset in Content array (measured in elements)+     | (# CumulDims  -- Steps array; [Word]+                     -- similar to steps in OpenCV::Mat, but counted in elements+                     --        rather than in bytes.+                     -- e.g. 0th element is the size of the content in elements+                     --      (data must be contiguous)+                     --      1th element is the size of subspace data minus outer dim.+        , Int#  -- Offset in Content array (measured in elements)         , ByteArray# -- Content;                      -- elements are stored row-by-row, plane-by-plane;                      -- (C-style, rather than Fortran-style);                      -- similar to C, OpenCV, etc.                      -- The data must be contiguous!                      -- (i.e. stride must be the same size as the element size).-        , CumulDims  -- Steps array; [Word]-                     -- similar to steps in OpenCV::Mat, but counted in elements-                     --        rather than in bytes.-                     -- e.g. 0th element is the size of the content in elements-                     --      (data must be contiguous)-                     --      1th element is the size of subspace data minus outer dim.         , Dict (PrimBytes t)         #)      #) - instance (PrimBytes t, Dimensions ds) => PrimBytes (ArrayBase t ds) where     {-# SPECIALIZE instance Dimensions ds => PrimBytes (ArrayBase Float ds)  #-}     {-# SPECIALIZE instance Dimensions ds => PrimBytes (ArrayBase Double ds) #-}@@ -72,16 +72,13 @@     {-# SPECIALIZE instance Dimensions ds => PrimBytes (ArrayBase Word32 ds) #-}     {-# SPECIALIZE instance Dimensions ds => PrimBytes (ArrayBase Word64 ds) #-} -    getBytes (ArrayBase a ) = case a of-        (# t | #)-          | W# nw <- totalDim' @ds-          , n <- word2Int# nw-          , tbs <- byteSize t -> go tbs (tbs *# n) t-        (# | (# _, arr, _, _ #) #) ->-          -- very weird trick with touch# allows to workaround GHC bug-          --  "internal error: ARR_WORDS object entered!"-          -- TODO: report this-          case runRW# (\s -> (# touch# arr s, arr #)) of (# _, ba #) -> ba+    getBytes = withArrayContent'+      (\t -> let tbs = byteSize t+             in go tbs (tbs *# totalDim# @ds) t)+      -- very weird trick with touch# allows to workaround GHC bug+      --  "internal error: ARR_WORDS object entered!"+      -- TODO: report this+      (\_ _ arr -> case runRW# (\s -> (# touch# arr s, arr #)) of (# _, ba #) -> ba)       where         go :: Int# -> Int# -> t -> ByteArray#         go tbs bsize t = case runRW#@@ -89,34 +86,29 @@              (# s1, mba #) -> unsafeFreezeByteArray# mba                ( loop# 0# tbs bsize (\i -> writeBytes mba i t) s1 )          ) of (# _, ba #) -> ba-        {-# NOINLINE go #-}     {-# INLINE getBytes #-} -    getBytesPinned (ArrayBase a) = case a of-        (# t | #)-          | W# nw <- totalDim' @ds-          , n <- word2Int# nw-          , tbs <- byteSize t -> go tbs (tbs *# n) t-        (# | (# off, arr, _, _ #) #) ->-          if isTrue# (isByteArrayPinned# arr)-          then case runRW# (\s -> (# touch# arr s, arr #)) of (# _, ba #) -> ba-          else case runRW#-           ( \s0 -> case (# sizeofByteArray# arr-                          , byteAlign @t undefined-                          #) of-               (# bsize, tba #)-                 | (# s1, mba #) <- newAlignedPinnedByteArray# bsize tba s0-                 , s2 <- copyByteArray# arr off mba off bsize s1-                   -> unsafeFreezeByteArray# mba s2-           ) of (# _, ba #) -> ba+    getBytesPinned = withArrayContent' f+      (const $ \off arr -> case runRW# (g off arr) of (# _, ba #) -> ba)       where-        go :: Int# -> Int# -> t -> ByteArray#-        go tbs bsize t = case runRW#-         ( \s0 -> case newAlignedPinnedByteArray# bsize (byteAlign t) s0 of-             (# s1, mba #) -> unsafeFreezeByteArray# mba-               ( loop# 0# tbs bsize (\i -> writeBytes mba i t) s1 )-         ) of (# _, ba #) -> ba-        {-# NOINLINE go #-}+        g :: Int# -> ByteArray# -> State# RealWorld -> (# State# RealWorld, ByteArray# #)+        g off arr s0+          | isTrue# (isByteArrayPinned# arr)+            = (# touch# arr s0, arr #)+          | tba <- byteAlign @t undefined+          , bsize <- sizeofByteArray# arr+          , (# s1, mba #) <- newAlignedPinnedByteArray# bsize tba s0+          , s2 <- copyByteArray# arr off mba off bsize s1+            = unsafeFreezeByteArray# mba s2+        f :: t -> ByteArray#+        f t+          | tbs <- byteSize t+          , bsize <- totalDim# @ds *# tbs+            = case runRW#+             ( \s0 -> case newAlignedPinnedByteArray# bsize (byteAlign t) s0 of+                 (# s1, mba #) -> unsafeFreezeByteArray# mba+                   ( loop# 0# tbs bsize (\i -> writeBytes mba i t) s1 )+             ) of (# _, ba #) -> ba     {-# INLINE getBytesPinned #-}  @@ -124,7 +116,7 @@       | tbs <- byteSize (undefined :: t)       , (# offN, offRem #) <- quotRemInt# bOff tbs       = case offRem of-          0# -> ArrayBase (# | (#  offN, ba, steps, Dict #) #)+          0# -> fromElems' steps offN ba           _  -> case cdTotalDim# steps of n -> go (tbs *# n)       where         steps = cumulDims $ dims @ds@@ -137,8 +129,7 @@                   of             (# s1, mba #) -> unsafeFreezeByteArray# mba                               (copyByteArray# ba bOff mba 0# bsize s1)-         ) of (# _, r #) -> ArrayBase (# | (# 0#, r, steps, Dict #) #)-        {-# NOINLINE go #-}+         ) of (# _, r #) -> fromElems' steps 0# r     {-# INLINE fromBytes #-}      readBytes mba bOff s0@@ -149,16 +140,17 @@       = case newByteArray# bsize s0 of          (# s1, mba1 #) -> case unsafeFreezeByteArray# mba1                                 (copyMutableByteArray# mba bOff mba1 0# bsize s1) of-           (# s2, ba #) -> (# s2, ArrayBase (# | (# 0#, ba, steps, Dict #) #) #)+           (# s2, ba #) -> (# s2, fromElems' steps 0# ba #)     {-# INLINE readBytes #-} -    writeBytes mba bOff (ArrayBase c)-      | tbs <- byteSize (undefined :: t) = case c of-        (# t | #) | W# n <- totalDim' @ds ->-          loop# bOff tbs (bOff +# word2Int# n *# tbs) (\i -> writeBytes mba i t)-        (# | (# offContent, arrContent, steps, _ #) #)-           | n <- cdTotalDim# steps->-          copyByteArray# arrContent (offContent *# tbs) mba bOff (n *# tbs)+    writeBytes mba bOff+      | tbs <- byteSize (undefined :: t) = withArrayContent'+        (\t -> loop# bOff tbs+          (bOff +# totalDim# @ds *# tbs)+          (\i -> writeBytes mba i t))+        (\steps offContent arrContent ->+          copyByteArray# arrContent (offContent *# tbs)+                         mba bOff (cdTotalDim# steps *# tbs))     {-# INLINE writeBytes #-}      readAddr addr s0@@ -169,29 +161,28 @@       = case newByteArray# bsize s0 of          (# s1, mba1 #) -> case unsafeFreezeByteArray# mba1                                 (copyAddrToByteArray# addr mba1 0# bsize s1) of-           (# s2, ba #) -> (# s2, ArrayBase (# | (# 0# , ba, steps, Dict #) #) #)+           (# s2, ba #) -> (# s2, fromElems' steps 0# ba #)     {-# INLINE readAddr #-} -    writeAddr (ArrayBase c) addr-      | tbs <- byteSize (undefined :: t) = case c of-        (# t | #) | W# n <- totalDim' @ds ->-          loop# 0# tbs (word2Int# n *# tbs) (\i -> writeAddr t (plusAddr# addr i))-        (# | (# offContent, arrContent, steps, _ #) #)-           | n <- cdTotalDim# steps ->-          copyByteArrayToAddr# arrContent (offContent *# tbs) addr (n *# tbs)+    writeAddr a addr+      | tbs <- byteSize (undefined :: t) = withArrayContent'+        (\t -> loop# 0# tbs+          (totalDim# @ds *# tbs)+          (\i -> writeAddr t (plusAddr# addr i)))+        (\steps offContent arrContent ->+          copyByteArrayToAddr# arrContent (offContent *# tbs)+                               addr (cdTotalDim# steps *# tbs)) a     {-# INLINE writeAddr #-}  -    byteSize  _ = case totalDim' @ds of -- WARNING: slow!-      W# n -> byteSize (undefined :: t) *# word2Int# n+    byteSize _ = byteSize @t undefined *# totalDim# @ds -- WARNING: slow!     {-# INLINE byteSize #-} -    byteAlign _ = byteAlign (undefined :: t)+    byteAlign _ = byteAlign @t undefined     {-# INLINE byteAlign #-} -    byteOffset (ArrayBase a) = case a of-      (# _ | #)                  -> 0#-      (# | (# off, _, _, _ #) #) -> off *# byteSize (undefined :: t)+    byteOffset = withArrayContent'+      (\_ -> 0#) (\_ off _ -> off *# byteSize @t undefined)     {-# INLINE byteOffset #-}      byteFieldOffset _ _ = negateInt# 1#@@ -199,8 +190,7 @@      indexArray ba off       | steps <- cumulDims $ dims @ds-      , n <- cdTotalDim# steps-      = ArrayBase (# | (# off *# n, ba, steps, Dict #) #)+      = fromElems' steps (off *# cdTotalDim# steps) ba     {-# INLINE indexArray #-}  @@ -222,17 +212,17 @@   (ArrayBase (# b | #))     = comb x (f a b) accumV2Idempotent x f comb-  a@(ArrayBase (# | (# _, _, steps, Dict #) #))+  a@(ArrayBase (# | (# steps, _, _, Dict #) #))   b@(ArrayBase (# | _ #))     = foldr (comb . (\i -> f (ixOff i a) (ixOff i b))) x                           [0 .. fromIntegral (cdTotalDim steps) - 1] accumV2Idempotent x f comb     (ArrayBase (# a | #))-  b@(ArrayBase (# | (# _, _, steps, Dict #) #))+  b@(ArrayBase (# | (# steps, _, _, Dict #) #))     = foldr (comb . (\i -> f a (ixOff i b))) x                           [0 .. fromIntegral (cdTotalDim steps) - 1] accumV2Idempotent x f comb-  a@(ArrayBase (# | (# _, _, steps, Dict #) #))+  a@(ArrayBase (# | (# steps, _, _, Dict #) #))     (ArrayBase (# b | #))     = foldr (comb . (\i -> f (ixOff i a) b)) x                           [0 .. fromIntegral (cdTotalDim steps) - 1]@@ -242,7 +232,7 @@ mapV :: (t -> t) -> ArrayBase t ds -> ArrayBase t ds mapV f (ArrayBase (# t | #))     = ArrayBase (# f t | #)-mapV f x@(ArrayBase (# | (# offN, ba, steps, Dict #) #))+mapV f x@(ArrayBase (# | (# steps, offN, ba, Dict #) #))     | tbs <- byteSize (undefEl x)     , n <- cdTotalDim# steps     = case runRW#@@ -251,7 +241,7 @@            ( loop1# n                (\i -> writeArray mba i (f (indexArray ba (offN +# i)))) s1            )-     ) of (# _, r #) -> ArrayBase (# | (# 0#, r, steps, Dict #) #)+     ) of (# _, r #) -> fromElems' steps 0# r {-# INLINE mapV #-}  @@ -259,8 +249,8 @@      -> ArrayBase t ds -> ArrayBase t ds -> ArrayBase t ds zipV f (ArrayBase (# x | #)) b = mapV (f x) b zipV f a (ArrayBase (# y | #)) = mapV (`f` y) a-zipV f a@(ArrayBase (# | (# oa, ba, steps, Dict #) #))-         (ArrayBase (# | (# ob, bb, _, _ #) #))+zipV f a@(ArrayBase (# | (# steps, oa, ba, Dict #) #))+         (ArrayBase (# | (# _,    ob, bb, _ #) #))     | n <- cdTotalDim# steps     = case runRW#      ( \s0 -> case newByteArray# (byteSize (undefEl a) *# n) s0 of@@ -272,7 +262,7 @@                         )                ) s1            )-     ) of (# _, r #) -> ArrayBase (# | (# 0#, r, steps, Dict #) #)+     ) of (# _, r #) -> fromElems' steps 0# r {-# INLINE zipV #-}  @@ -397,8 +387,8 @@     {-# SPECIALIZE instance Bounded (ArrayBase Word16 ds) #-}     {-# SPECIALIZE instance Bounded (ArrayBase Word32 ds) #-}     {-# SPECIALIZE instance Bounded (ArrayBase Word64 ds) #-}-    maxBound = ArrayBase (# maxBound | #)-    minBound = ArrayBase (# minBound | #)+    maxBound = broadcast' maxBound+    minBound = broadcast' minBound  instance Num t => Num (ArrayBase t ds)  where     {-# SPECIALIZE instance Num (ArrayBase Float ds)  #-}@@ -425,7 +415,7 @@     {-# INLINE abs #-}     signum = mapV signum     {-# INLINE signum #-}-    fromInteger i = ArrayBase (# fromInteger i | #)+    fromInteger = broadcast' . fromInteger     {-# INLINE fromInteger #-}  instance Fractional t => Fractional (ArrayBase t ds)  where@@ -435,14 +425,14 @@     {-# INLINE (/) #-}     recip = mapV recip     {-# INLINE recip #-}-    fromRational r = ArrayBase (# fromRational r | #)+    fromRational = broadcast' . fromRational     {-# INLINE fromRational #-}   instance Floating t => Floating (ArrayBase t ds) where     {-# SPECIALIZE instance Floating (ArrayBase Float ds)  #-}     {-# SPECIALIZE instance Floating (ArrayBase Double ds) #-}-    pi = ArrayBase (# pi | #)+    pi = broadcast' pi     {-# INLINE pi #-}     exp = mapV exp     {-# INLINE exp #-}@@ -480,26 +470,9 @@     {-# INLINE atanh #-}  instance PrimBytes t => PrimArray t (ArrayBase t ds) where-    {-# SPECIALIZE instance PrimArray Float  (ArrayBase Float ds)  #-}-    {-# SPECIALIZE instance PrimArray Double (ArrayBase Double ds) #-}-    {-# SPECIALIZE instance PrimArray Int    (ArrayBase Int ds)    #-}-    {-# SPECIALIZE instance PrimArray Word   (ArrayBase Word ds)   #-}-    {-# SPECIALIZE instance PrimArray Int8   (ArrayBase Int8 ds)   #-}-    {-# SPECIALIZE instance PrimArray Int16  (ArrayBase Int16 ds)  #-}-    {-# SPECIALIZE instance PrimArray Int32  (ArrayBase Int32 ds)  #-}-    {-# SPECIALIZE instance PrimArray Int64  (ArrayBase Int64 ds)  #-}-    {-# SPECIALIZE instance PrimArray Word8  (ArrayBase Word8 ds)  #-}-    {-# SPECIALIZE instance PrimArray Word16 (ArrayBase Word16 ds) #-}-    {-# SPECIALIZE instance PrimArray Word32 (ArrayBase Word32 ds) #-}-    {-# SPECIALIZE instance PrimArray Word64 (ArrayBase Word64 ds) #-} -    broadcast t = ArrayBase (# t | #)-    {-# INLINE broadcast #-}--    ix# i (ArrayBase a) = case a of-      (# t | #)                    -> t-      (# | (# off, arr, _, _ #) #) -> indexArray arr (off +# i)-    {-# INLINE ix# #-}+    broadcast# t = ArrayBase (# t | #)+    {-# INLINE broadcast# #-}      gen# steps f z0 = go (byteSize @t undefined *# n)       where@@ -510,57 +483,63 @@                (# s2, z1 #) -> case unsafeFreezeByteArray# mba s2 of                  (# s3, ba #) -> (# s3, (# z1, ba #) #)          ) of (# _, (# z1, ba #) #)-                   -> (# z1, ArrayBase (# | (# 0# , ba, steps, Dict #) #) #)-        {-# NOINLINE go #-}+                   -> (# z1, fromElems' steps 0# ba #)         loop0 mba i z s           | isTrue# (i ==# n) = (# s, z #)           | otherwise = case f z of               (# z', x #) -> loop0 mba (i +# 1#) z' (writeArray mba i x s)     {-# INLINE gen# #-} -    upd# steps i x (ArrayBase (# a | #)) = go (byteSize x)-      where-        n = cdTotalDim# steps-        go tbs = case runRW#-         ( \s0 -> case newByteArray# (tbs *# n) s0 of-             (# s1, mba #) -> unsafeFreezeByteArray# mba-               (writeArray mba i x-                 (loop1# n (\j -> writeArray mba j a) s1)-               )-         ) of (# _, r #) -> ArrayBase (# |  (# 0# , r, steps, Dict #) #)-        {-# NOINLINE go #-}-    upd# _ i x (ArrayBase (# | (# offN, ba, steps, Dict #) #))-        = go (byteSize x)+    upd# steps i x = withArrayContent' f g       where         n = cdTotalDim# steps-        go tbs = case runRW#-         ( \s0 -> case newByteArray# (tbs *# n) s0 of-             (# s1, mba #) -> unsafeFreezeByteArray# mba-               (writeArray mba i x-                 (copyByteArray# ba (offN *# tbs) mba 0# (tbs *# n) s1)-               )-         ) of (# _, r #) -> ArrayBase (# | (# 0#, r, steps, Dict #) #)-        {-# NOINLINE go #-}+        f a = go (byteSize x)+          where+            go tbs = case runRW#+             ( \s0 -> case newByteArray# (tbs *# n) s0 of+                 (# s1, mba #) -> unsafeFreezeByteArray# mba+                   (writeArray mba i x+                     (loop1# n (\j -> writeArray mba j a) s1)+                   )+             ) of (# _, r #) -> fromElems' steps 0# r+        g _ offN ba = go (byteSize x)+          where+            go tbs = case runRW#+             ( \s0 -> case newByteArray# (tbs *# n) s0 of+                 (# s1, mba #) -> unsafeFreezeByteArray# mba+                   (writeArray mba i x+                     (copyByteArray# ba (offN *# tbs) mba 0# (tbs *# n) s1)+                   )+             ) of (# _, r #) -> fromElems' steps 0# r     {-# INLINE upd# #-} -    arrayContent# (ArrayBase a) = case a of-      (# x | #)                     -> (# x | #)-      (# | (# off, arr, cd, _ #) #) -> (# | (# cd, off, arr #) #)-    {-# INLINE arrayContent# #-}+    withArrayContent# = withArrayContent'+    {-# INLINE withArrayContent# #-} -    offsetElems (ArrayBase a) = case a of-      (# _ | #)                  -> 0#-      (# | (# off, _, _, _ #) #) -> off-    {-# INLINE offsetElems #-}+    fromElems# = fromElems'+    {-# INLINE fromElems# #-} -    uniqueOrCumulDims (ArrayBase a) = case a of-      (# t | #)                    -> Left t-      (# | (# _, _, steps, _ #) #) -> Right steps-    {-# INLINE uniqueOrCumulDims #-}+withArrayContent' ::+       forall (t :: Type) (ds :: [Nat]) (rep :: RuntimeRep) (r :: TYPE rep)+     . (t -> r)+    -> (CumulDims -> Int# -> ByteArray# -> r)+    -> ArrayBase t ds -> r+withArrayContent' f _ (ArrayBase (# e | #)) = f e+withArrayContent' _ g (ArrayBase (# | (# steps, off, ba, _ #) #)) = g steps off ba+{-# INLINE withArrayContent' #-} -    fromElems steps off ba = ArrayBase (# | (# off, ba, steps, Dict #) #)-    {-# INLINE fromElems #-}+fromElems' :: forall (t :: Type) (ds :: [Nat])+            . PrimBytes t => CumulDims -> Int# -> ByteArray# -> ArrayBase t ds+fromElems' steps off ba = ArrayBase (# | (# steps, off, ba, Dict #) #)+{-# INLINE fromElems' #-} +broadcast' :: t -> ArrayBase t ds+broadcast' t = ArrayBase (# t | #)+{-# INLINE broadcast' #-}++totalDim# :: forall (ds :: [Nat]) . Dimensions ds => Int#+totalDim# = case totalDim' @ds of W# n -> word2Int# n+{-# INLINE totalDim# #-}  loop# :: Int# -- ^ initial value       -> Int# -- ^ step

@@ -4,12 +4,10 @@ {-# LANGUAGE MagicHash             #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeApplications      #-}-{-# LANGUAGE UnboxedSums           #-} {-# LANGUAGE UnboxedTuples         #-} {-# LANGUAGE UndecidableInstances  #-} module Numeric.DataFrame.Internal.Backend.Family.DoubleX2 (DoubleX2 (..)) where - import           GHC.Base import           Numeric.DataFrame.Internal.PrimArray import           Numeric.PrimBytes@@ -368,8 +366,8 @@  instance PrimArray Double DoubleX2 where -    broadcast (D# x) = DoubleX2# x x-    {-# INLINE broadcast #-}+    broadcast# (D# x) = DoubleX2# x x+    {-# INLINE broadcast# #-}      ix# 0# (DoubleX2# a1 _) = D# a1     ix# 1# (DoubleX2# _ a2) = D# a2@@ -386,8 +384,8 @@     upd# _ _ _ x                     = x     {-# INLINE upd# #-} -    arrayContent# x = (# | (# CumulDims [ELEM_N, 1], 0#, getBytes x #) #)-    {-# INLINE arrayContent# #-}+    withArrayContent# _ g x = g (CumulDims [ELEM_N, 1]) 0# (getBytes x)+    {-# INLINE withArrayContent# #-}      offsetElems _ = 0#     {-# INLINE offsetElems #-}@@ -395,7 +393,7 @@     uniqueOrCumulDims _ = Right (CumulDims [ELEM_N, 1])     {-# INLINE uniqueOrCumulDims #-} -    fromElems _ off ba = DoubleX2#+    fromElems# _ off ba = DoubleX2#       (indexDoubleArray# ba off)       (indexDoubleArray# ba (off +# 1#))-    {-# INLINE fromElems #-}+    {-# INLINE fromElems# #-}

@@ -4,7 +4,6 @@ {-# LANGUAGE MagicHash             #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeApplications      #-}-{-# LANGUAGE UnboxedSums           #-} {-# LANGUAGE UnboxedTuples         #-} {-# LANGUAGE UndecidableInstances  #-} module Numeric.DataFrame.Internal.Backend.Family.DoubleX3 (DoubleX3 (..)) where@@ -399,8 +398,8 @@  instance PrimArray Double DoubleX3 where -    broadcast (D# x) = DoubleX3# x x x-    {-# INLINE broadcast #-}+    broadcast# (D# x) = DoubleX3# x x x+    {-# INLINE broadcast# #-}      ix# 0# (DoubleX3# a1 _ _) = D# a1     ix# 1# (DoubleX3# _ a2 _) = D# a2@@ -420,8 +419,8 @@     upd# _ _ _ x                       = x     {-# INLINE upd# #-} -    arrayContent# x = (# | (# CumulDims [ELEM_N, 1], 0#, getBytes x #) #)-    {-# INLINE arrayContent# #-}+    withArrayContent# _ g x = g (CumulDims [ELEM_N, 1]) 0# (getBytes x)+    {-# INLINE withArrayContent# #-}      offsetElems _ = 0#     {-# INLINE offsetElems #-}@@ -429,8 +428,8 @@     uniqueOrCumulDims _ = Right (CumulDims [ELEM_N, 1])     {-# INLINE uniqueOrCumulDims #-} -    fromElems _ off ba = DoubleX3#+    fromElems# _ off ba = DoubleX3#       (indexDoubleArray# ba off)       (indexDoubleArray# ba (off +# 1#))       (indexDoubleArray# ba (off +# 2#))-    {-# INLINE fromElems #-}+    {-# INLINE fromElems# #-}

@@ -4,7 +4,6 @@ {-# LANGUAGE MagicHash             #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeApplications      #-}-{-# LANGUAGE UnboxedSums           #-} {-# LANGUAGE UnboxedTuples         #-} {-# LANGUAGE UndecidableInstances  #-} module Numeric.DataFrame.Internal.Backend.Family.DoubleX4 (DoubleX4 (..)) where@@ -426,8 +425,8 @@  instance PrimArray Double DoubleX4 where -    broadcast (D# x) = DoubleX4# x x x x-    {-# INLINE broadcast #-}+    broadcast# (D# x) = DoubleX4# x x x x+    {-# INLINE broadcast# #-}      ix# 0# (DoubleX4# a1 _ _ _) = D# a1     ix# 1# (DoubleX4# _ a2 _ _) = D# a2@@ -450,8 +449,8 @@     upd# _ _ _ x                         = x     {-# INLINE upd# #-} -    arrayContent# x = (# | (# CumulDims [ELEM_N, 1], 0#, getBytes x #) #)-    {-# INLINE arrayContent# #-}+    withArrayContent# _ g x = g (CumulDims [ELEM_N, 1]) 0# (getBytes x)+    {-# INLINE withArrayContent# #-}      offsetElems _ = 0#     {-# INLINE offsetElems #-}@@ -459,9 +458,9 @@     uniqueOrCumulDims _ = Right (CumulDims [ELEM_N, 1])     {-# INLINE uniqueOrCumulDims #-} -    fromElems _ off ba = DoubleX4#+    fromElems# _ off ba = DoubleX4#       (indexDoubleArray# ba off)       (indexDoubleArray# ba (off +# 1#))       (indexDoubleArray# ba (off +# 2#))       (indexDoubleArray# ba (off +# 3#))-    {-# INLINE fromElems #-}+    {-# INLINE fromElems# #-}

@@ -4,7 +4,6 @@ {-# LANGUAGE MagicHash             #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeApplications      #-}-{-# LANGUAGE UnboxedSums           #-} {-# LANGUAGE UnboxedTuples         #-} {-# LANGUAGE UndecidableInstances  #-} module Numeric.DataFrame.Internal.Backend.Family.FloatX2 (FloatX2 (..)) where@@ -368,8 +367,8 @@  instance PrimArray Float FloatX2 where -    broadcast (F# x) = FloatX2# x x-    {-# INLINE broadcast #-}+    broadcast# (F# x) = FloatX2# x x+    {-# INLINE broadcast# #-}      ix# 0# (FloatX2# a1 _) = F# a1     ix# 1# (FloatX2# _ a2) = F# a2@@ -386,8 +385,8 @@     upd# _ _ _ x                    = x     {-# INLINE upd# #-} -    arrayContent# x = (# | (# CumulDims [ELEM_N, 1], 0#, getBytes x #) #)-    {-# INLINE arrayContent# #-}+    withArrayContent# _ g x = g (CumulDims [ELEM_N, 1]) 0# (getBytes x)+    {-# INLINE withArrayContent# #-}      offsetElems _ = 0#     {-# INLINE offsetElems #-}@@ -395,7 +394,7 @@     uniqueOrCumulDims _ = Right (CumulDims [ELEM_N, 1])     {-# INLINE uniqueOrCumulDims #-} -    fromElems _ off ba = FloatX2#+    fromElems# _ off ba = FloatX2#       (indexFloatArray# ba off)       (indexFloatArray# ba (off +# 1#))-    {-# INLINE fromElems #-}+    {-# INLINE fromElems# #-}

@@ -4,7 +4,6 @@ {-# LANGUAGE MagicHash             #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeApplications      #-}-{-# LANGUAGE UnboxedSums           #-} {-# LANGUAGE UnboxedTuples         #-} {-# LANGUAGE UndecidableInstances  #-} module Numeric.DataFrame.Internal.Backend.Family.FloatX3 (FloatX3 (..)) where@@ -400,8 +399,8 @@  instance PrimArray Float FloatX3 where -    broadcast (F# x) = FloatX3# x x x-    {-# INLINE broadcast #-}+    broadcast# (F# x) = FloatX3# x x x+    {-# INLINE broadcast# #-}      ix# 0# (FloatX3# a1 _ _) = F# a1     ix# 1# (FloatX3# _ a2 _) = F# a2@@ -421,8 +420,8 @@     upd# _ _ _ x                      = x     {-# INLINE upd# #-} -    arrayContent# x = (# | (# CumulDims [ELEM_N, 1], 0#, getBytes x #) #)-    {-# INLINE arrayContent# #-}+    withArrayContent# _ g x = g (CumulDims [ELEM_N, 1]) 0# (getBytes x)+    {-# INLINE withArrayContent# #-}      offsetElems _ = 0#     {-# INLINE offsetElems #-}@@ -430,8 +429,8 @@     uniqueOrCumulDims _ = Right (CumulDims [ELEM_N, 1])     {-# INLINE uniqueOrCumulDims #-} -    fromElems _ off ba = FloatX3#+    fromElems# _ off ba = FloatX3#       (indexFloatArray# ba off)       (indexFloatArray# ba (off +# 1#))       (indexFloatArray# ba (off +# 2#))-    {-# INLINE fromElems #-}+    {-# INLINE fromElems# #-}

@@ -5,7 +5,6 @@ {-# LANGUAGE MagicHash             #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeApplications      #-}-{-# LANGUAGE UnboxedSums           #-} {-# LANGUAGE UnboxedTuples         #-} {-# LANGUAGE UndecidableInstances  #-} {-# OPTIONS_GHC -fno-warn-orphans  #-}@@ -20,6 +19,7 @@ import           Numeric.ProductOrd import qualified Numeric.ProductOrd.NonTransitive     as NonTransitive import qualified Numeric.ProductOrd.Partial           as Partial+import           Unsafe.Coerce                        (unsafeCoerce)   data FloatX4 = FloatX4# Float# Float# Float# Float#@@ -432,8 +432,8 @@  instance PrimArray Float FloatX4 where -    broadcast (F# x) = FloatX4# x x x x-    {-# INLINE broadcast #-}+    broadcast# (F# x) = FloatX4# x x x x+    {-# INLINE broadcast# #-}      ix# 0# (FloatX4# a1 _ _ _) = F# a1     ix# 1# (FloatX4# _ a2 _ _) = F# a2@@ -456,8 +456,8 @@     upd# _ _ _ x                        = x     {-# INLINE upd# #-} -    arrayContent# x = (# | (# CumulDims [ELEM_N, 1], 0#, getBytes x #) #)-    {-# INLINE arrayContent# #-}+    withArrayContent# _ g x = g (CumulDims [ELEM_N, 1]) 0# (getBytes x)+    {-# INLINE withArrayContent# #-}      offsetElems _ = 0#     {-# INLINE offsetElems #-}@@ -465,13 +465,12 @@     uniqueOrCumulDims _ = Right (CumulDims [ELEM_N, 1])     {-# INLINE uniqueOrCumulDims #-} -    fromElems _ off ba = FloatX4#+    fromElems# _ off ba = FloatX4#       (indexFloatArray# ba off)       (indexFloatArray# ba (off +# 1#))       (indexFloatArray# ba (off +# 2#))       (indexFloatArray# ba (off +# 3#))-    {-# INLINE fromElems #-}-+    {-# INLINE fromElems# #-}  -------------------------------------------------------------------------------- -- Rewrite rules to improve efficiency of algorithms@@ -485,14 +484,13 @@ --------------------------------------------------------------------------------  getIdxOffset :: Idxs '[4] -> Int#-getIdxOffset is = case unsafeCoerce# is of-  [W# i] -> word2Int# i-  _      -> 0#+getIdxOffset is = case unsafeCoerce is of+  ~[w] -> case w of W# i -> word2Int# i {-# INLINE getIdxOffset #-}   {-# RULES-"index/FloatX4" forall i . index @Float @'[4] i-  = unsafeCoerce# (ix# @Float @FloatX4 (getIdxOffset i))+"index/FloatX4" forall i . index @Float @'[4] @'[] @'[4] i+  = unsafeCoerce (ix# @Float @FloatX4 (getIdxOffset i))    #-}

@@ -9,7 +9,8 @@ module Numeric.DataFrame.Internal.Backend.Family.ScalarBase (ScalarBase (..)) where  -import           GHC.Base+import           Data.Coerce+import           Numeric.Basics import           Numeric.DataFrame.Internal.PrimArray import           Numeric.PrimBytes import           Numeric.ProductOrd@@ -18,7 +19,7 @@  -- | Specialize ScalarBase type without any arrays newtype ScalarBase t = ScalarBase { _unScalarBase :: t }-  deriving ( Enum, Eq, Bounded, Integral+  deriving ( Enum, Eq, Bounded, Integral, Epsilon, RealExtras, RealFloatExtras            , Num, Fractional, Floating, Ord, Real, RealFrac, RealFloat            , PrimBytes) @@ -28,23 +29,23 @@ deriving instance Ord t => Ord (Partial.ProductOrd (ScalarBase t))  instance PrimBytes t => PrimArray t (ScalarBase t) where-  broadcast = unsafeCoerce#-  {-# INLINE broadcast #-}-  ix# _ = unsafeCoerce#+  broadcast# = coerce+  {-# INLINE broadcast# #-}+  ix# _ = coerce   {-# INLINE ix# #-}-  gen# _ = unsafeCoerce#+  gen# _ = coerce   {-# INLINE gen# #-}   upd# _ 0# = const . ScalarBase   upd# _ _  = const id   {-# INLINE upd# #-}-  arrayContent# x = (# _unScalarBase x | #)-  {-# INLINE arrayContent# #-}+  withArrayContent# f _ x = f (_unScalarBase x)+  {-# INLINE withArrayContent# #-}   offsetElems _ = 0#   {-# INLINE offsetElems #-}   uniqueOrCumulDims = Left . _unScalarBase   {-# INLINE uniqueOrCumulDims #-}-  fromElems _ off ba = indexArray ba off-  {-# INLINE fromElems #-}+  fromElems# _ off ba = indexArray ba off+  {-# INLINE fromElems# #-}  _suppressHlintUnboxedTuplesWarning :: () -> (# (), () #) _suppressHlintUnboxedTuplesWarning = undefined

@@ -0,0 +1,238 @@+{-# LANGUAGE ConstraintKinds  #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE PatternSynonyms  #-}+{-# LANGUAGE ViewPatterns     #-}+module Numeric.Basics+  ( -- * Constants+    pattern M_E, pattern M_LOG2E, pattern M_LOG10E, pattern M_LN2, pattern M_LN10+  , pattern M_SQRT2, pattern M_SQRT1_2+  , pattern M_PI, pattern M_PI_2, pattern M_PI_3, pattern M_PI_4+  , pattern M_1_PI, pattern M_2_PI, pattern M_2_SQRTPI+  , Epsilon (..), pattern M_EPS+    -- * Functions+  , RealExtras (..), RealFloatExtras (..)+  , negateUnless+    -- * Exceptions+  , IterativeMethod, TooManyIterations, tooManyIterations+  ) where++import Data.Int+import Data.Word+import GHC.Exception+import GHC.Stack+import Numeric.PrimBytes++-- | \( e \)+pattern M_E :: (Eq a, Fractional a) => Fractional a => a+pattern M_E = 2.718281828459045235360287471352662498++-- | \( \log_2 e \)+pattern M_LOG2E :: (Eq a, Fractional a) => Fractional a => a+pattern M_LOG2E = 1.442695040888963407359924681001892137++-- | \( \log_{10} e \)+pattern M_LOG10E :: (Eq a, Fractional a) => Fractional a => a+pattern M_LOG10E = 0.434294481903251827651128918916605082++-- | \( \log_e 2 \)+pattern M_LN2 :: (Eq a, Fractional a) => Fractional a => a+pattern M_LN2 = 0.693147180559945309417232121458176568++-- | \( \log_e 10 \)+pattern M_LN10 :: (Eq a, Fractional a) => Fractional a => a+pattern M_LN10 = 2.302585092994045684017991454684364208++-- | \( \sqrt{2} \)+pattern M_SQRT2 :: (Eq a, Fractional a) => Fractional a => a+pattern M_SQRT2 = 1.414213562373095048801688724209698079++-- | \( \frac{1}{\sqrt{2}} \)+pattern M_SQRT1_2 :: (Eq a, Fractional a) => Fractional a => a+pattern M_SQRT1_2 = 0.707106781186547524400844362104849039++-- | \( \pi \)+pattern M_PI :: (Eq a, Fractional a) => Fractional a => a+pattern M_PI = 3.1415926535897932384626433832795028841971+-- | \( \frac{\pi}{2} \)+pattern M_PI_2 :: (Eq a, Fractional a) => Fractional a => a+pattern M_PI_2 = 1.570796326794896619231321691639751442++-- | \( \frac{\pi}{3} \)+pattern M_PI_3 :: (Eq a, Fractional a) => Fractional a => a+pattern M_PI_3 = 1.047197551196597746154214461093167628++-- | \( \frac{\pi}{4} \)+pattern M_PI_4 :: (Eq a, Fractional a) => Fractional a => a+pattern M_PI_4 = 0.785398163397448309615660845819875721++-- | \( \frac{1}{\pi} \)+pattern M_1_PI :: (Eq a, Fractional a) => Fractional a => a+pattern M_1_PI = 0.318309886183790671537767526745028724++-- | \( \frac{2}{\pi} \)+pattern M_2_PI :: (Eq a, Fractional a) => Fractional a => a+pattern M_2_PI = 0.636619772367581343075535053490057448++-- | \( \frac{2}{\sqrt{\pi}} \)+pattern M_2_SQRTPI :: (Eq a, Fractional a) => Fractional a => a+pattern M_2_SQRTPI = 1.128379167095512573896158903121545172++-- | Define a meaningful precision for complex floating-point operations.+class (Eq a, Floating a) => Epsilon a where+    -- | A small positive number that depends on the type of @a@.+    --   Compare your values to @epsilon@ to tell if they are near zero.+    epsilon :: a++instance Epsilon Double where+    epsilon = 1e-12++instance Epsilon Float where+    epsilon = 1e-6++-- | A small positive number that depends on the type of @a@.+pattern M_EPS :: Epsilon a => a+pattern M_EPS <- ((epsilon ==) -> True)+  where+    M_EPS = epsilon++-- | Negate if @False@.+--   This is a useful alternative to `signum`,+--     when @signum 0 == 0@ causing some troubles.+negateUnless :: Num t => Bool -> t -> t+negateUnless True  = id+negateUnless False = negate+{-# INLINE negateUnless #-}++-- | Extra functions for `Real` types.+class (Real a, PrimBytes a) => RealExtras a where+    -- | @copysign x y@ returns a value with the magnitude of x and the sign of y.+    --+    --   NB: in future, this function is to reimplemented using primops+    --       and should behave the same way as its C analogue.+    copysign :: a -> a -> a+    copysign x y+      | (x >= 0) == (y >= 0) = x+      | otherwise = negate x+    {-# INLINE copysign #-}++instance RealExtras Int+instance RealExtras Int8+instance RealExtras Int16+instance RealExtras Int32+instance RealExtras Int64+instance RealExtras Word+instance RealExtras Word8+instance RealExtras Word16+instance RealExtras Word32+instance RealExtras Word64++instance RealExtras Float where+    copysign = c'copysignf+    {-# INLINE copysign #-}++instance RealExtras Double where+    copysign = c'copysignd+    {-# INLINE copysign #-}++-- | Extra functions for `RealFrac` types.+class (Epsilon a, RealExtras a, RealFloat a) => RealFloatExtras a where+    -- | \( \sqrt{ x^2 + y^2 } \).+    --+    --   NB: in future, this function is to reimplemented using primops+    --       and should behave the same way as its C analogue.+    hypot :: a -> a -> a+    hypot x y = scaleFloat ea (sqrt (an*an + bn*bn))+      where+        x' = abs x+        y' = abs y+        (a,b) = if x' >= y' then (x', y') else (y', x')+        (_, ea) = decodeFloat a+        an = scaleFloat (negate ea) a+        bn = scaleFloat (negate ea) b+    {-# INLINE hypot #-}+    -- | Maximum finite number representable by this FP type.+    maxFinite :: a++instance RealFloatExtras Float where+    hypot = c'hypotf+    {-# INLINE hypot #-}+    maxFinite = 3.40282347e+38+    {-# INLINE maxFinite #-}+++instance RealFloatExtras Double where+    hypot = c'hypotd+    {-# INLINE hypot #-}+    maxFinite = 1.7976931348623157e+308+    {-# INLINE maxFinite #-}++foreign import ccall unsafe "hypot"  c'hypotd :: Double -> Double -> Double+foreign import ccall unsafe "hypotf" c'hypotf :: Float -> Float -> Float+foreign import ccall unsafe "copysign"  c'copysignd :: Double -> Double -> Double+foreign import ccall unsafe "copysignf" c'copysignf :: Float -> Float -> Float++{- |+This is just an alias for the `HasCallStack` constraint.+It servers two goals:++  1. Document functions that use iterative methods and can fail+     (supposedly in extremely rare cases).+  2. Provide a call stack in case of failure.++Use `tooManyIterations` function where necessary if you implement an iterative+algorithm and annotate your implementation function with `IterativeMethod` constraint.++ -}+type IterativeMethod = HasCallStack++-- | Throw a `TooManyIterations` exception.+tooManyIterations ::+       IterativeMethod+    => String  -- ^ Label (e.g. function name)+    -> a+tooManyIterations s+  = throw TooManyIterations+  { tmiUserInfo  = s+  , tmiCallStack = callStack+  }++{- |+Typically, this exception can occur in an iterative algorithm;+when the number of iterations exceeds a pre-defined limit, but the stop condition+is not fulfilled.++Use the `IterativeMethod` constraint to annotate functions that throw this exception.+ -}+data TooManyIterations+  = TooManyIterations+  { tmiUserInfo  :: String+    -- ^ Short description of the error, e.g. a function name.+  , tmiCallStack :: CallStack+    -- ^ Function call stack.+    --   Note, this field is ignored in the `Eq` and `Ord` instances.+  }++-- | Note, this instance ignores `oodCallStack`+instance Eq TooManyIterations where+  (==) a b = tmiUserInfo a == tmiUserInfo b++-- | Note, this instance ignores `oodCallStack`+instance Ord TooManyIterations where+  compare a b = compare (tmiUserInfo a) (tmiUserInfo b)++instance Show TooManyIterations where+  showsPrec p e = addLoc errStr+    where+      addLoc s+        = let someE = errorCallWithCallStackException s (tmiCallStack e)+              errc :: ErrorCall+              errc = case fromException someE of+                Nothing -> ErrorCall s+                Just ec -> ec+          in  showsPrec p errc+      errStr = unlines+        [ "An iterative method has exceeded the limit for the iteration number."+        , "User info: " ++ tmiUserInfo e+        ]++instance Exception TooManyIterations

@@ -7,6 +7,8 @@     -- * Functionality   , module Numeric.DataFrame.SubSpace   , module Numeric.DataFrame.Contraction+  , module Numeric.Basics+  , module Numeric.Subroutine.Sort   ) where  import Numeric.DataFrame.Internal.Backend ()@@ -18,3 +20,7 @@ import Numeric.Matrix import Numeric.Scalar import Numeric.Vector++import Numeric.Basics++import Numeric.Subroutine.Sort (sort, sortBy)

@@ -1,16 +1,17 @@-{-# LANGUAGE DataKinds              #-}-{-# LANGUAGE FlexibleContexts       #-}-{-# LANGUAGE FlexibleInstances      #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE InstanceSigs           #-}-{-# LANGUAGE MagicHash              #-}-{-# LANGUAGE MultiParamTypeClasses  #-}-{-# LANGUAGE ScopedTypeVariables    #-}-{-# LANGUAGE TypeApplications       #-}-{-# LANGUAGE TypeFamilies           #-}-{-# LANGUAGE TypeOperators          #-}-{-# LANGUAGE UnboxedTuples          #-}-{-# LANGUAGE UndecidableInstances   #-}+{-# LANGUAGE DataKinds               #-}+{-# LANGUAGE FlexibleContexts        #-}+{-# LANGUAGE FlexibleInstances       #-}+{-# LANGUAGE FunctionalDependencies  #-}+{-# LANGUAGE InstanceSigs            #-}+{-# LANGUAGE MagicHash               #-}+{-# LANGUAGE MultiParamTypeClasses   #-}+{-# LANGUAGE ScopedTypeVariables     #-}+{-# LANGUAGE TypeApplications        #-}+{-# LANGUAGE TypeFamilies            #-}+{-# LANGUAGE TypeOperators           #-}+{-# LANGUAGE UnboxedTuples           #-}+{-# LANGUAGE UndecidableInstances    #-}+{-# LANGUAGE UndecidableSuperClasses #-} ----------------------------------------------------------------------------- -- | -- Module      :  Numeric.DataFrame.Contraction

@@ -2,14 +2,18 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts          #-} {-# LANGUAGE FlexibleInstances         #-}+{-# LANGUAGE InstanceSigs              #-} {-# LANGUAGE MagicHash                 #-} {-# LANGUAGE MultiParamTypeClasses     #-}+{-# LANGUAGE PatternSynonyms           #-} {-# LANGUAGE PolyKinds                 #-} {-# LANGUAGE ScopedTypeVariables       #-} {-# LANGUAGE TypeApplications          #-} {-# LANGUAGE TypeFamilies              #-} {-# LANGUAGE TypeInType                #-} {-# LANGUAGE TypeOperators             #-}+{-# LANGUAGE UndecidableInstances      #-}+{-# LANGUAGE ViewPatterns              #-} ----------------------------------------------------------------------------- -- | -- Module      :  Numeric.DataFrame.IO@@ -22,208 +26,348 @@  module Numeric.DataFrame.IO     ( IODataFrame (XIOFrame), SomeIODataFrame (..)-    , newDataFrame, newPinnedDataFrame+    , castDataFrame+    , newDataFrame, newPinnedDataFrame, oneMoreDataFrame+    , subDataFrameView, subDataFrameView'     , copyDataFrame, copyMutableDataFrame     , copyDataFrame', copyMutableDataFrame'+    , copyDataFrameOff, copyMutableDataFrameOff     , freezeDataFrame, unsafeFreezeDataFrame-    , thawDataFrame, thawPinDataFrame, unsafeThawDataFrame+    , thawDataFrame, thawPinDataFrame, unsafeThawDataFrame, withThawDataFrame     , writeDataFrame, writeDataFrameOff     , readDataFrame, readDataFrameOff-    , withDataFramePtr, isDataFramePinned+    , isDataFramePinned, getDataFrameSteps+    , withDataFramePtr     ) where  -import GHC.Base-import GHC.IO   (IO (..))-import GHC.Ptr  (Ptr (..))+import GHC.IO  (IO (..))+import GHC.Ptr (Ptr (..)) +import Control.Monad.ST                     (RealWorld)+import Data.Coerce+import Data.Kind import Numeric.DataFrame.Internal.Mutable import Numeric.DataFrame.Internal.PrimArray import Numeric.DataFrame.Type import Numeric.Dimensions+import Unsafe.Coerce   -- | Mutable DataFrame that lives in IO. --   Internal representation is always a MutableByteArray.-data family IODataFrame (t :: Type) (ns :: [k])---- | Pure wrapper on a mutable byte array-newtype instance IODataFrame t (ns :: [Nat]) = IODataFrame (MDataFrame RealWorld t (ns :: [Nat]))+newtype IODataFrame (t :: Type) (ns :: [k]) = IODataFrame (MDataFrame RealWorld t (ns :: [k]))  -- | Data frame with some dimensions missing at compile time. --   Pattern-match against its constructor to get a Nat-indexed mutable data frame.-data instance IODataFrame t (xs :: [XNat])-  = forall (ns :: [Nat]) . Dimensions ns-  => XIOFrame (IODataFrame t ns)+pattern XIOFrame :: forall (t :: Type) (xns :: [XNat]) . ()+                 => forall (ns :: [Nat]) . (FixedDims xns ns, Dimensions ns)+                 => IODataFrame t ns -> IODataFrame t xns+pattern XIOFrame df <- (mkXIOFramePat -> XIOFramePat df)+  where+    XIOFrame = castDataFrame+{-# COMPLETE XIOFrame #-} +data XIOFramePat (t :: Type) (xns :: [XNat])+  = forall (ns :: [Nat]) . (FixedDims xns ns, Dimensions ns)+  => XIOFramePat (IODataFrame t ns)++mkXIOFramePat :: forall (t :: Type) (xns :: [XNat])+               . IODataFrame t xns -> XIOFramePat t xns+mkXIOFramePat df+  | SomeDims ds <- fromSteps (getDataFrameSteps df)+  , XDims (Dims :: Dims ns) <- (unsafeCoerce ds) :: Dims xns+    = XIOFramePat @t @xns @ns (unsafeCoerce df)+  | otherwise+    = error "XIOFrame pattern: impossible args"+ -- | Mutable DataFrame of unknown dimensionality data SomeIODataFrame (t :: Type)   = forall (ns :: [Nat]) . Dimensions ns => SomeIODataFrame (IODataFrame t ns) +-- | Allow coercing between @XNat@-indexed and @Nat@-indexed Mutable DataFrames.+castDataFrame ::+       forall (t :: Type) (xns :: [XNat]) (ns :: [Nat])+     . FixedDims xns ns+    => IODataFrame t ns -> IODataFrame t xns+castDataFrame = coerce (castDataFrame# @t @xns @ns)+{-# INLINE castDataFrame #-}+ -- | Create a new mutable DataFrame.-newDataFrame :: forall t (ns :: [Nat])-              . ( PrimBytes t, Dimensions ns)-             => IO (IODataFrame t ns)-newDataFrame = IODataFrame <$> IO (newDataFrame# @t @ns)+newDataFrame ::+       forall (t :: Type) ns+     . (PrimBytes t, Dimensions ns) => IO (IODataFrame t ns)+newDataFrame = coerce (newDataFrame# @t @_ @ns) {-# INLINE newDataFrame #-} - -- | Create a new mutable DataFrame.-newPinnedDataFrame :: forall t (ns :: [Nat])-                    . ( PrimBytes t, Dimensions ns)-                   => IO (IODataFrame t ns)-newPinnedDataFrame = IODataFrame <$> IO (newPinnedDataFrame# @t @ns)+newPinnedDataFrame ::+       forall (t :: Type) ns+     . (PrimBytes t, Dimensions ns) => IO (IODataFrame t ns)+newPinnedDataFrame = coerce (newPinnedDataFrame# @t @_ @ns) {-# INLINE newPinnedDataFrame #-} +-- | Create a new mutable DataFrame of the same size.+oneMoreDataFrame ::+       forall (t :: Type) ns+     . IODataFrame t ns -> IO (IODataFrame t ns)+oneMoreDataFrame = coerce (oneMoreDataFrame# @t @_ @ns)+{-# INLINE oneMoreDataFrame #-} +-- | View a part of a DataFrame.+--+--   This function does not perform a copy.+--   All changes to a new DataFrame will be reflected in the original DataFrame as well.+--+--   If any of the dims in @as@ or @b@ is unknown (@a ~ XN m@),+--   then this function is unsafe and can throw an `OutOfDimBounds` exception.+--   Otherwise, its safety is guaranteed by the type system.+subDataFrameView ::+       forall (t :: Type) b bi bd as bs asbs+     . (SubFrameIndexCtx b bi bd, KnownDim bd, ConcatList as (b :+ bs) asbs)+    => Idxs (as +: bi) -> IODataFrame t asbs -> IODataFrame t (bd :+ bs)+subDataFrameView = coerce (subDataFrameView# @t @_ @b @bi @bd @as @bs @asbs)++-- | View a part of a DataFrame.+--+--   This function does not perform a copy.+--   All changes to a new DataFrame will be reflected in the original DataFrame as well.+--+--   This is a simpler version of @subDataFrameView@ that allows+--    to view over one index at a time.+--+--   If any of the dims in @as@ is unknown (@a ~ XN m@),+--   then this function is unsafe and can throw an `OutOfDimBounds` exception.+--   Otherwise, its safety is guaranteed by the type system.+subDataFrameView' ::+       forall (t :: Type) as bs asbs+     . ConcatList as bs asbs+    => Idxs as -> IODataFrame t asbs -> IODataFrame t bs+subDataFrameView' = coerce (subDataFrameView'# @t @_ @as @bs @asbs)+ -- | Copy one DataFrame into another mutable DataFrame at specified position. -----   In contrast to @copyMDataFrame'@, this function allows to copy over a range of contiguous---   indices over a single dimension.+--   In contrast to @copyDataFrame'@, this function allows to copy over a range+--    of contiguous indices over a single dimension. --   For example, you can write a 3x4 matrix into a 7x4 matrix, starting at indices 0..3.-copyDataFrame :: forall (t :: Type)-                        (b :: Nat) (bi :: Nat) (bd :: Nat)-                        (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat])-               . ( b ~ (bi + bd - 1)-                 , PrimBytes t-                 , PrimBytes (DataFrame t (bd :+ bs))-                 , ConcatList as (b :+ bs) asbs-                 )-              => Idxs (as +: bi) -> DataFrame t (bd :+ bs)-              -> IODataFrame t asbs -> IO ()-copyDataFrame ei df (IODataFrame mdf) = IO (copyDataFrame# ei df mdf)+--+--   This function is safe (no `OutOfDimBounds` exception possible).+--   If any of the dims in @as@ is unknown (@a ~ XN m@),+--   you may happen to write data beyond dataframe bounds.+--   In this case, this function does nothing.+--   If (@b ~ XN m@) and (@Idx bi + Dim bd > Dim b@), this function copies only as+--   many elements as fits into the dataframe along this dimension (possibly none).+copyDataFrame ::+       forall (t :: Type) b bi bd as bs asbs+     . ( SubFrameIndexCtx b bi bd, KnownDim bd, ExactDims bs+       , PrimArray t (DataFrame t (bd :+ bs))+       , ConcatList as (b :+ bs) asbs )+    => Idxs (as +: bi) -> DataFrame t (bd :+ bs) -> IODataFrame t asbs -> IO ()+copyDataFrame = coerce (copyDataFrame# @t @_ @b @bi @bd @as @bs @asbs) {-# INLINE copyDataFrame #-}  -- | Copy one mutable DataFrame into another mutable DataFrame at specified position. -----   In contrast to @copyMDataFrame'@, this function allows to copy over a range of contiguous---   indices over a single dimension.+--   In contrast to @copyMutableDataFrame'@, this function allows to copy over a range+--    of contiguous indices over a single dimension. --   For example, you can write a 3x4 matrix into a 7x4 matrix, starting at indices 0..3.-copyMutableDataFrame :: forall (t :: Type)-                               (b :: Nat) (bi :: Nat) (bd :: Nat)-                               (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat])-                      . ( b ~ (bi + bd - 1)-                        , PrimBytes t-                        , ConcatList as (b :+ bs) asbs-                        )-                     => Idxs (as +: bi) -> IODataFrame t (bd :+ bs)-                     -> IODataFrame t asbs -> IO ()-copyMutableDataFrame ei (IODataFrame mdfA) (IODataFrame mdfB)-    = IO (copyMDataFrame# ei mdfA mdfB)+--+--   This function is safe (no `OutOfDimBounds` exception possible).+--   If any of the dims in @as@ is unknown (@a ~ XN m@),+--   you may happen to write data beyond dataframe bounds.+--   In this case, this function does nothing.+--   If (@b ~ XN m@) and (@Idx bi + Dim bd > Dim b@), this function copies only as+--   many elements as fits into the dataframe along this dimension (possibly none).+copyMutableDataFrame ::+       forall (t :: Type) b bi bd as bs asbs+     . ( SubFrameIndexCtx b bi bd+       , ExactDims bs+       , PrimBytes t+       , ConcatList as (b :+ bs) asbs )+    => Idxs (as +: bi) -> IODataFrame t (bd :+ bs) -> IODataFrame t asbs -> IO ()+copyMutableDataFrame = coerce (copyMDataFrame# @t @_ @b @bi @bd @as @bs @asbs) {-# INLINE copyMutableDataFrame #-}  -- | Copy one DataFrame into another mutable DataFrame at specified position. -----   This is a simpler version of @copyDataFrame@ that allows to copy over one index at a time.-copyDataFrame' :: forall (t :: Type)-                         (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat])-                . ( PrimBytes t-                  , PrimBytes (DataFrame t bs)-                  , ConcatList as bs asbs-                 )-               => Idxs as -> DataFrame t bs-               -> IODataFrame t asbs -> IO ()-copyDataFrame' ei df (IODataFrame mdf) = IO (copyDataFrame'# ei df mdf)+--   This is a simpler version of @copyDataFrame@ that allows+--     to copy over one index at a time.+--+--   This function is safe (no `OutOfDimBounds` exception possible).+--   If any of the dims in @as@ is unknown (@a ~ XN m@),+--   you may happen to write data beyond dataframe bounds.+--   In this case, this function does nothing.+copyDataFrame' ::+       forall (t :: Type) as bs asbs+     . ( ExactDims bs+       , PrimArray t (DataFrame t bs)+       , ConcatList as bs asbs )+    => Idxs as -> DataFrame t bs -> IODataFrame t asbs -> IO ()+copyDataFrame' = coerce (copyDataFrame'# @t @_ @as @bs @asbs) {-# INLINE copyDataFrame' #-}  -- | Copy one mutable DataFrame into another mutable DataFrame at specified position. -----   This is a simpler version of @copyDataFrame@ that allows to copy over one index at a time.-copyMutableDataFrame' :: forall (t :: Type)-                                (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat])-                       . ( PrimBytes t-                         , ConcatList as bs asbs-                         )-                      => Idxs as -> IODataFrame t bs-                      -> IODataFrame t asbs -> IO ()-copyMutableDataFrame' ei (IODataFrame mdfA) (IODataFrame mdfB)-  = IO (copyMDataFrame'# ei mdfA mdfB)+--   This is a simpler version of @copyMutableDataFrame@ that allows+--     to copy over one index at a time.+--+--   This function is safe (no `OutOfDimBounds` exception possible).+--   If any of the dims in @as@ is unknown (@a ~ XN m@),+--   you may happen to write data beyond dataframe bounds.+--   In this case, this function does nothing.+copyMutableDataFrame' ::+       forall (t :: Type) as bs asbs+     . (ExactDims bs, PrimBytes t, ConcatList as bs asbs)+    => Idxs as -> IODataFrame t bs -> IODataFrame t asbs -> IO ()+copyMutableDataFrame' = coerce (copyMDataFrame'# @t @_ @as @bs @asbs) {-# INLINE copyMutableDataFrame' #-} +-- | Copy one DataFrame into another mutable DataFrame by offset in+--   primitive elements.+--+--   This is a low-level copy function; you have to keep in mind the row-major+--   layout of Mutable DataFrames. Offset bounds are not checked.+--   You will get an undefined behavior if you write beyond the DataFrame bounds.+copyDataFrameOff ::+       forall (t :: Type) as bs asbs+     . ( Dimensions bs+       , PrimArray t (DataFrame t bs)+       , ConcatList as bs asbs )+    => Int -> DataFrame t bs -> IODataFrame t asbs -> IO ()+copyDataFrameOff = coerce (copyDataFrameOff# @t @_ @as @bs @asbs)+{-# INLINE copyDataFrameOff #-}++-- | Copy one mutable DataFrame into another mutable DataFrame by offset in+--   primitive elements.+--+--   This is a low-level copy function; you have to keep in mind the row-major+--   layout of Mutable DataFrames. Offset bounds are not checked.+--   You will get an undefined behavior if you write beyond the DataFrame bounds+copyMutableDataFrameOff ::+       forall (t :: Type) as bs asbs+     . (ExactDims bs, PrimBytes t, ConcatList as bs asbs)+    => Int -> IODataFrame t bs -> IODataFrame t asbs -> IO ()+copyMutableDataFrameOff = coerce (copyMDataFrameOff# @t @_ @as @bs @asbs)+{-# INLINE copyMutableDataFrameOff #-}+ -- | Make a mutable DataFrame immutable, without copying.-unsafeFreezeDataFrame :: forall (t :: Type) (ns :: [Nat])-                       . PrimArray t (DataFrame t ns)-                      => IODataFrame t ns -> IO (DataFrame t ns)-unsafeFreezeDataFrame (IODataFrame mdf) = IO (unsafeFreezeDataFrame# mdf)+unsafeFreezeDataFrame ::+       forall (t :: Type) ns+     . PrimArray t (DataFrame t ns)+    => IODataFrame t ns -> IO (DataFrame t ns)+unsafeFreezeDataFrame = coerce (unsafeFreezeDataFrame# @t @_ @ns) {-# INLINE unsafeFreezeDataFrame #-} - -- | Copy content of a mutable DataFrame into a new immutable DataFrame.-freezeDataFrame :: forall (t :: Type) (ns :: [Nat])-                 . PrimArray t (DataFrame t ns)-                => IODataFrame t ns -> IO (DataFrame t ns)-freezeDataFrame (IODataFrame mdf) = IO (freezeDataFrame# mdf)+freezeDataFrame ::+       forall (t :: Type) ns+     . PrimArray t (DataFrame t ns)+    => IODataFrame t ns -> IO (DataFrame t ns)+freezeDataFrame = coerce (freezeDataFrame# @t @_ @ns) {-# INLINE freezeDataFrame #-}  -- | Create a new mutable DataFrame and copy content of immutable one in there.-thawDataFrame :: forall (t :: Type) (ns :: [Nat])-               . (Dimensions ns, PrimBytes (DataFrame t ns))-              => DataFrame t ns -> IO (IODataFrame t ns)-thawDataFrame df = IODataFrame <$> IO (thawDataFrame# df)+thawDataFrame ::+       forall (t :: Type) ns+     . (Dimensions ns, PrimArray t (DataFrame t ns))+    => DataFrame t ns -> IO (IODataFrame t ns)+thawDataFrame = coerce (thawDataFrame# @t @_ @ns) {-# INLINE thawDataFrame #-}  -- | Create a new mutable DataFrame and copy content of immutable one in there. --   The result array is pinned and aligned.-thawPinDataFrame :: forall (t :: Type) (ns :: [Nat])-                  . (Dimensions ns, PrimBytes (DataFrame t ns))-                 => DataFrame t ns -> IO (IODataFrame t ns)-thawPinDataFrame df = IODataFrame <$> IO (thawPinDataFrame# df)+thawPinDataFrame ::+       forall (t :: Type) ns+     . (Dimensions ns, PrimArray t (DataFrame t ns))+    => DataFrame t ns -> IO (IODataFrame t ns)+thawPinDataFrame = coerce (thawPinDataFrame# @t @_ @ns) {-# INLINE thawPinDataFrame #-}  -- | UnsafeCoerces an underlying byte array.-unsafeThawDataFrame :: forall (t :: Type) (ns :: [Nat])-                     . ( Dimensions ns-                       , PrimBytes (DataFrame t ns), PrimBytes t)-                    => DataFrame t ns -> IO (IODataFrame t ns)-unsafeThawDataFrame df = IODataFrame <$> IO (unsafeThawDataFrame# df)+unsafeThawDataFrame ::+       forall (t :: Type) ns+     . (Dimensions ns, PrimArray t (DataFrame t ns))+    => DataFrame t ns+    -> IO (IODataFrame t ns)+unsafeThawDataFrame = coerce (unsafeThawDataFrame# @t @_ @ns) {-# INLINE unsafeThawDataFrame #-} ---- | Write a single element at the specified index-writeDataFrame :: forall t (ns :: [Nat])-                . PrimBytes t-               => IODataFrame t ns -> Idxs ns -> DataFrame t ('[] :: [Nat]) -> IO ()-writeDataFrame (IODataFrame mdf) ei = IO . writeDataFrame# mdf ei . unsafeCoerce#-{-# INLINE writeDataFrame #-}----- | Read a single element at the specified index-readDataFrame :: forall (t :: Type) (ns :: [Nat])-               . PrimBytes t-              => IODataFrame t ns -> Idxs ns -> IO (DataFrame t ('[] :: [Nat]))-readDataFrame (IODataFrame mdf) = unsafeCoerce# . IO . readDataFrame# mdf-{-# INLINE readDataFrame #-}-+-- | Given two continuations @f@ and @g@.+--   If the input DataFrame is a single broadcast value, use it in @f@.+--   Otherwise, create a new mutable DataFrame and copy content of immutable one+--   in there; then use it in @g@.+--+--   This function is useful when @thawDataFrame@ cannot be used due to+--   @Dimensions ns@ constraint being not available.+withThawDataFrame ::+       forall (t :: Type) ns r+     . PrimArray t (DataFrame t ns)+    => (t -> IO r)+    -> (IODataFrame t ns -> IO r)+    -> DataFrame t ns -> IO r+withThawDataFrame = coerce (withThawDataFrame# @t @_ @ns @r) --- | Write a single element at the specified element offset-writeDataFrameOff :: forall (t :: Type) (ns :: [Nat])-                   . PrimBytes t-               => IODataFrame t ns -> Int -> DataFrame t ('[] :: [Nat])  -> IO ()-writeDataFrameOff (IODataFrame mdf) (I# i)-  = IO . writeDataFrameOff# mdf i . unsafeCoerce#+-- | Write a single element at the specified element offset.+--+--   This is a low-level write function; you have to keep in mind the row-major+--   layout of Mutable DataFrames. Offset bounds are not checked.+--   You will get an undefined behavior if you write beyond the DataFrame bounds.+writeDataFrameOff ::+       forall (t :: Type) ns+     . PrimBytes (DataFrame t ('[] :: KindOf ns))+    => IODataFrame t ns -> Int -> DataFrame t ('[] :: KindOf ns) -> IO ()+writeDataFrameOff = coerce (writeDataFrameOff# @t @_ @ns) {-# INLINE writeDataFrameOff #-} +-- | Write a single element at the specified index.+--+--   This function is safe (no `OutOfDimBounds` exception possible).+--   If any of the dims in @ns@ is unknown (@n ~ XN m@),+--   you may happen to write data beyond dataframe bounds.+--   In this case, this function does nothing.+writeDataFrame ::+       forall (t :: Type) ns+     . PrimBytes (DataFrame t ('[] :: KindOf ns))+    => IODataFrame t ns -> Idxs ns -> DataFrame t ('[] :: KindOf ns) -> IO ()+writeDataFrame = coerce (writeDataFrame# @t @_ @ns)+{-# INLINE writeDataFrame #-} --- | Read a single element at the specified element offset-readDataFrameOff :: forall (t :: Type) (ns :: [Nat])-                  . PrimBytes t-               => IODataFrame t ns -> Int -> IO (DataFrame t ('[] :: [Nat]))-readDataFrameOff (IODataFrame mdf) (I# i)-  = unsafeCoerce# (IO (readDataFrameOff# mdf i))+-- | Read a single element at the specified element offset.+--+--   This is a low-level read function; you have to keep in mind the row-major+--   layout of Mutable DataFrames. Offset bounds are not checked.+--   You will get an undefined behavior if you read beyond the DataFrame bounds.+readDataFrameOff ::+       forall (t :: Type) ns+     . PrimBytes (DataFrame t ('[] :: KindOf ns))+    => IODataFrame t ns -> Int -> IO (DataFrame t ('[] :: KindOf ns))+readDataFrameOff = coerce (readDataFrameOff# @t @_ @ns) {-# INLINE readDataFrameOff #-} +-- | Read a single element at the specified index.+--+--   If any of the dims in @ns@ is unknown (@n ~ XN m@),+--   then this function is unsafe and can throw an `OutOfDimBounds` exception.+--   Otherwise, its safety is guaranteed by the type system.+readDataFrame ::+       forall (t :: Type) ns+     . PrimBytes (DataFrame t ('[] :: KindOf ns))+    => IODataFrame t ns -> Idxs ns -> IO (DataFrame t ('[] :: KindOf ns))+readDataFrame = coerce (readDataFrame# @t @_ @ns)+{-# INLINE readDataFrame #-}  -- | Check if the byte array wrapped by this DataFrame is pinned, --   which means cannot be relocated by GC.-isDataFramePinned :: forall (k :: Type) (t :: Type) (ns :: [k])-                   . KnownDimKind k-                  => IODataFrame t ns -> Bool-isDataFramePinned df = case dimKind @k of-    DimNat -> case df of-      IODataFrame x -> isDataFramePinned# x-    DimXNat -> case df of-      XIOFrame (IODataFrame x) -> isDataFramePinned# x+isDataFramePinned ::+       forall (t :: Type) ns . IODataFrame t ns -> Bool+isDataFramePinned = coerce (isDataFramePinned# @t @_ @ns)+{-# INLINE isDataFramePinned #-} +-- | Get cumulative dimensions @ns@ of a @IODataFrame t ns@+getDataFrameSteps ::+       forall (t :: Type) ns . IODataFrame t ns -> CumulDims+getDataFrameSteps = coerce (getDataFrameSteps# @t @_ @ns)+{-# INLINE getDataFrameSteps #-}  -- | Allow arbitrary IO operations on a pointer to the beginning of the data --   keeping the data from garbage collecting until the arg function returns.@@ -233,15 +377,9 @@ -- --   Warning: use this function on a pinned DataFrame only; --            otherwise, the data may be relocated before the arg fun finishes.-withDataFramePtr :: forall (k :: Type) (t :: Type) (ns :: [k]) (r :: Type)-                  . (PrimBytes t, KnownDimKind k)-                 => IODataFrame t ns-                 -> ( Ptr t -> IO r )-                 -> IO r-withDataFramePtr df k = case dimKind @k of-    DimNat -> case df of-      IODataFrame x-        -> IO $ withDataFramePtr# x (\p -> case k (Ptr p) of IO f -> f)-    DimXNat -> case df of-      XIOFrame (IODataFrame x)-        -> IO $ withDataFramePtr# x (\p -> case k (Ptr p) of IO f -> f)+withDataFramePtr ::+       forall (t :: Type) ns (r :: Type)+     . PrimBytes t => IODataFrame t ns -> (Ptr t -> IO r) -> IO r+withDataFramePtr (IODataFrame x) k+  = IO (withDataFramePtr# x (\p -> case k (Ptr p) of IO f -> f))+{-# INLINE withDataFramePtr #-}

@@ -2,6 +2,7 @@ {-# LANGUAGE ConstraintKinds       #-} {-# LANGUAGE DataKinds             #-} {-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds             #-} {-# LANGUAGE RoleAnnotations       #-}@@ -9,15 +10,39 @@ {-# LANGUAGE TypeApplications      #-} {-# LANGUAGE TypeFamilies          #-} {-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UndecidableInstances  #-} {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} #if defined(__HADDOCK__) || defined(__HADDOCK_VERSION__) {-# OPTIONS_GHC -fno-warn-simplifiable-class-constraints #-} #else {-# OPTIONS_GHC -fplugin Data.Constraint.Deriving #-} #endif+{-+This module contains all generic and specific instances for all backend+(implementation) types. Its hs-boot counterpart provides only generic instances+(that do not depend on BackendFamily).+Import this module only at the root of the module hierarchy, where the specific+implementation-dependent modules do not need to depend on it.+But do not forget to import this module in the places that will be imported by+the user (such as Numeric.DataFrame). So that the user can benefit from the+compile-time knowledge of the specific backend implementation. +By design the import chain is as follows:++NDI.Backend.Family.hs-boot            NDI.Backend.Family+         \                                   |+    NDI.Backend.hs-boot               NDI.Backend (instances only)+          \                                 /+     NDI.BackendI                          /+            \                             /+    Numeric.DataFrame.Type               /+                    \                   /+                     \                 /+                     Numeric.DataFrame++ -} module Numeric.DataFrame.Internal.Backend-  ( DFBackend, Backend (..), BackendFamily, KnownBackend ()+  ( Backend (..), BackendFamily, KnownBackend ()   , inferKnownBackend, inferPrimElem     -- * Auto-deriving instances   , inferEq, inferOrd@@ -47,15 +72,15 @@                                                                     inferKnownBackend,                                                                     inferPrimArray,                                                                     inferPrimElem)-import           Numeric.DataFrame.Internal.BackendI       (I) --- | Implementation behind the DataFrame-type DFBackend (t :: Type) (ds :: [Nat]) = Backend I t ds (BackendFamily t ds)  -- | Backend resolver: --   Use this constraint to find any class instances defined for all DataFrame implementations, --   e.g. @Num@, @PrimBytes@, etc.-type KnownBackend (t :: Type) (ds :: [Nat]) = Impl.KnownBackend t ds (BackendFamily t ds)+class Impl.KnownBackend t ds (BackendFamily t ds)+   => KnownBackend (t :: Type) (ds :: [Nat])+instance Impl.KnownBackend t ds (BackendFamily t ds)+   => KnownBackend (t :: Type) (ds :: [Nat])  -- | A newtype wrapper for all DataFrame implementations. --   I need two layers of wrappers to provide default overlappable instances to@@ -65,12 +90,12 @@ newtype Backend (i :: Type) (t :: Type) (ds :: [Nat]) (backend :: Type)     = Backend { _getBackend :: backend } type role Backend phantom phantom phantom representational-type instance DeriveContext (Backend I t ds b) = b ~ BackendFamily t ds--- When typechecker knows what the third parameter @b@ is, no instances overlap,+type instance DeriveContext (Backend i t ds b) = b ~ BackendFamily t ds+-- When typechecker knows what the fourth parameter @b@ is, no instances overlap, -- because @b@ is always always a concrete type. -- The "dynamic instances" derived via ToInstance have to be incoherent, -- because @BackendFamily t ds@ as a type family (before resolving it)---  is no more conrete than just @b@.+--  is no more concrete than just @b@. {-# ANN type Backend (DeriveAll' NoOverlap ["KnownBackend"]) #-}  @@ -80,47 +105,48 @@    . (PrimBytes t, Dimensions ds)   => Dict (KnownBackend t ds) inferKnownBackend-  = Impl.inferKnownBackend @t @ds @(BackendFamily t ds)+  = case Impl.inferKnownBackend @t @ds @(BackendFamily t ds) of+      Dict -> Dict  inferPrimElem-  :: forall (t :: Type) (d :: Nat) (ds :: [Nat])+  :: forall (t :: Type) (d :: Nat) (ds :: [Nat]) (i :: Type)    . KnownBackend t (d ': ds)-  => DFBackend t (d ': ds) -> Dict (PrimBytes t)+  => Backend i t (d ': ds) (BackendFamily t (d ': ds)) -> Dict (PrimBytes t) inferPrimElem = Impl.inferPrimElem @t @d @ds . _getBackend    inferEq-  :: forall (t :: Type) (ds :: [Nat]) (b :: Type)+  :: forall (t :: Type) (ds :: [Nat]) (b :: Type) (i :: Type)    . (Eq t, Impl.KnownBackend t ds b)-  => Dict (Eq (Backend I t ds b))+  => Dict (Eq (Backend i t ds b)) inferEq     = mapDict toBackend     . mapDict (Sub (Impl.inferBackendInstance @t @ds))     $ inferDeriveContext @t @ds @b undefined  inferOrd-  :: forall (t :: Type) (ds :: [Nat]) (b :: Type)+  :: forall (t :: Type) (ds :: [Nat]) (b :: Type) (i :: Type)    . (Ord t, Impl.KnownBackend t ds b)-  => Dict (Ord (Backend I t ds b))+  => Dict (Ord (Backend i t ds b)) inferOrd     = mapDict toBackend     . mapDict (Sub (Impl.inferBackendInstance @t @ds))     $ inferDeriveContext @t @ds @b undefined  inferProductOrder-  :: forall (t :: Type) (ds :: [Nat]) (b :: Type)+  :: forall (t :: Type) (ds :: [Nat]) (b :: Type) (i :: Type)    . (Ord t, Impl.KnownBackend t ds b)-  => Dict (ProductOrder (Backend I t ds b))+  => Dict (ProductOrder (Backend i t ds b)) inferProductOrder     = mapDict toBackend     . mapDict (Sub (Impl.inferBackendInstance @t @ds))     $ inferDeriveContext @t @ds @b undefined  inferPONonTransitive-  :: forall (t :: Type) (ds :: [Nat]) (b :: Type)+  :: forall (t :: Type) (ds :: [Nat]) (b :: Type) (i :: Type)    . (Ord t, Impl.KnownBackend t ds b)-  => Dict (Ord (NonTransitive.ProductOrd (Backend I t ds b)))+  => Dict (Ord (NonTransitive.ProductOrd (Backend i t ds b))) inferPONonTransitive     = mapDict (unsafeDerive NonTransitive.ProductOrd)     . mapDict toBackend@@ -128,9 +154,9 @@     $ inferDeriveContext @t @ds @b undefined  inferPOPartial-  :: forall (t :: Type) (ds :: [Nat]) (b :: Type)+  :: forall (t :: Type) (ds :: [Nat]) (b :: Type) (i :: Type)    . (Ord t, Impl.KnownBackend t ds b)-  => Dict (Ord (Partial.ProductOrd (Backend I t ds b)))+  => Dict (Ord (Partial.ProductOrd (Backend i t ds b))) inferPOPartial     = mapDict (unsafeDerive Partial.ProductOrd)     . mapDict toBackend@@ -138,9 +164,9 @@     $ inferDeriveContext @t @ds @b undefined  inferBounded-  :: forall (t :: Type) (ds :: [Nat]) (b :: Type)+  :: forall (t :: Type) (ds :: [Nat]) (b :: Type) (i :: Type)    . (Bounded t, Impl.KnownBackend t ds b)-  => Dict (Bounded (Backend I t ds b))+  => Dict (Bounded (Backend i t ds b)) inferBounded     -- Here is an ugly trick:     --  We don't have instance of @Bounded Float@ and @Bounded Double@.@@ -160,27 +186,27 @@     $ inferDeriveContext @t @ds @b undefined  inferNum-  :: forall (t :: Type) (ds :: [Nat]) (b :: Type)+  :: forall (t :: Type) (ds :: [Nat]) (b :: Type) (i :: Type)    . (Num t, Impl.KnownBackend t ds b)-  => Dict (Num (Backend I t ds b))+  => Dict (Num (Backend i t ds b)) inferNum     = mapDict toBackend     . mapDict (Sub (Impl.inferBackendInstance @t @ds))     $ inferDeriveContext @t @ds @b undefined  inferFractional-  :: forall (t :: Type) (ds :: [Nat]) (b :: Type)+  :: forall (t :: Type) (ds :: [Nat]) (b :: Type) (i :: Type)    . (Fractional t, Impl.KnownBackend t ds b)-  => Dict (Fractional (Backend I t ds b))+  => Dict (Fractional (Backend i t ds b)) inferFractional     = mapDict toBackend     . mapDict (Sub (Impl.inferBackendInstance @t @ds))     $ inferDeriveContext @t @ds @b undefined  inferFloating-  :: forall (t :: Type) (ds :: [Nat]) (b :: Type)+  :: forall (t :: Type) (ds :: [Nat]) (b :: Type) (i :: Type)    . (Floating t, Impl.KnownBackend t ds b)-  => Dict (Floating (Backend I t ds b))+  => Dict (Floating (Backend i t ds b)) inferFloating     = mapDict toBackend     . mapDict (Sub (Impl.inferBackendInstance @t @ds))@@ -188,18 +214,18 @@   inferPrimBytes-  :: forall (t :: Type) (ds :: [Nat]) (b :: Type)+  :: forall (t :: Type) (ds :: [Nat]) (b :: Type) (i :: Type)    . (PrimBytes t, Dimensions ds, Impl.KnownBackend t ds b)-  => Dict (PrimBytes (Backend I t ds b))+  => Dict (PrimBytes (Backend i t ds b)) inferPrimBytes     = mapDict toBackend     . mapDict (Sub (Impl.inferBackendInstance @t @ds))     $ inferDeriveContext @t @ds @b undefined  inferPrimArray-  :: forall (t :: Type) (ds :: [Nat]) (b :: Type)+  :: forall (t :: Type) (ds :: [Nat]) (b :: Type) (i :: Type)    . (PrimBytes t, Impl.KnownBackend t ds b)-  => Dict (PrimArray t (Backend I t ds b))+  => Dict (PrimArray t (Backend i t ds b)) inferPrimArray     = mapDict toBackend     . mapDict (Sub (Impl.inferPrimArray @t @ds))@@ -208,14 +234,14 @@  -- This is the rule that cannot be encoded in the type system, but enforced -- as an invariant: Backend t ds b implies DeriveContext t ds b-inferDeriveContext :: forall (t :: Type) (ds :: [Nat]) (b :: Type)-                    . Backend I t ds b-                   -> Dict (DeriveContext (Backend I t ds b))+inferDeriveContext :: forall (t :: Type) (ds :: [Nat]) (b :: Type) (i :: Type)+                    . Backend i t ds b+                   -> Dict (DeriveContext (Backend i t ds b)) inferDeriveContext _ = unsafeCoerce (Dict :: Dict (b ~ b)) {-# INLINE inferDeriveContext #-}  -- Backend is the newtype wrapper over b. -- It has the same represenation and I expect it to have the same instance behavior.-toBackend :: forall c t ds b . c b :- c (Backend I t ds b)+toBackend :: forall c t ds b i . c b :- c (Backend i t ds b) toBackend = unsafeDerive Backend {-# INLINE toBackend #-}

@@ -1,17 +1,22 @@-{-# LANGUAGE CPP              #-}-{-# LANGUAGE ConstraintKinds  #-}-{-# LANGUAGE DataKinds        #-}-{-# LANGUAGE ExplicitForAll   #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE PolyKinds        #-}-{-# LANGUAGE RoleAnnotations  #-}-{-# LANGUAGE TypeOperators    #-}+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE ExplicitForAll        #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds             #-}+{-# LANGUAGE RoleAnnotations       #-}+{-# LANGUAGE TypeApplications      #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UndecidableInstances  #-} #if defined(__HADDOCK__) || defined(__HADDOCK_VERSION__) {-# OPTIONS_GHC -fno-warn-simplifiable-class-constraints #-} #endif  module Numeric.DataFrame.Internal.Backend-  ( DFBackend, Backend (..), BackendFamily, KnownBackend ()+  ( Backend (..), BackendFamily, KnownBackend ()   , inferKnownBackend, inferPrimElem     -- * Auto-deriving instances   , inferEq, inferOrd@@ -32,21 +37,12 @@ import {-# SOURCE #-} Numeric.DataFrame.Internal.Backend.Family (BackendFamily) import {-# SOURCE #-} qualified Numeric.DataFrame.Internal.Backend.Family as Impl                                                                                    (KnownBackend)-import {-# SOURCE #-} Numeric.DataFrame.Internal.BackendI       (I) --- | Implementation behind the DataFrame-type DFBackend (t :: Type) (ds :: [Nat]) = Backend I t ds (BackendFamily t ds)---- | Backend resolver:---   Use this constraint to find any class instances defined for all DataFrame implementations,---   e.g. @Num@, @PrimBytes@, etc.-type KnownBackend (t :: Type) (ds :: [Nat]) = Impl.KnownBackend t ds (BackendFamily t ds)+class Impl.KnownBackend t ds (BackendFamily t ds)+   => KnownBackend (t :: Type) (ds :: [Nat])+instance Impl.KnownBackend t ds (BackendFamily t ds)+   => KnownBackend (t :: Type) (ds :: [Nat]) --- | A newtype wrapper for all DataFrame implementations.---   I need two layers of wrappers to provide default overlappable instances to---   all type classes using KnownBackend mechanics.---   Type arguments are redundant here;---   nevertheless, they improve readability of error messages. newtype Backend (i :: Type) (t :: Type) (ds :: [Nat]) (backend :: Type)     = Backend { _getBackend :: backend } type role Backend phantom phantom phantom representational@@ -57,61 +53,61 @@   => Dict (KnownBackend t ds)  inferPrimElem-  :: forall (t :: Type) (d :: Nat) (ds :: [Nat])+  :: forall (t :: Type) (d :: Nat) (ds :: [Nat]) (i :: Type)    . KnownBackend t (d ': ds)-  => DFBackend t (d ': ds) -> Dict (PrimBytes t)+  => Backend i t (d ': ds) (BackendFamily t (d ': ds)) -> Dict (PrimBytes t)  inferEq-  :: forall (t :: Type) (ds :: [Nat]) (b :: Type)+  :: forall (t :: Type) (ds :: [Nat]) (b :: Type) (i :: Type)    . (Eq t, Impl.KnownBackend t ds b)-  => Dict (Eq (Backend I t ds b))+  => Dict (Eq (Backend i t ds b))  inferOrd-  :: forall (t :: Type) (ds :: [Nat]) (b :: Type)+  :: forall (t :: Type) (ds :: [Nat]) (b :: Type) (i :: Type)    . (Ord t, Impl.KnownBackend t ds b)-  => Dict (Ord (Backend I t ds b))+  => Dict (Ord (Backend i t ds b))  inferProductOrder-  :: forall (t :: Type) (ds :: [Nat]) (b :: Type)+  :: forall (t :: Type) (ds :: [Nat]) (b :: Type) (i :: Type)    . (Ord t, Impl.KnownBackend t ds b)-  => Dict (ProductOrder (Backend I t ds b))+  => Dict (ProductOrder (Backend i t ds b))  inferPONonTransitive-  :: forall (t :: Type) (ds :: [Nat]) (b :: Type)+  :: forall (t :: Type) (ds :: [Nat]) (b :: Type) (i :: Type)    . (Ord t, Impl.KnownBackend t ds b)-  => Dict (Ord (NonTransitive.ProductOrd (Backend I t ds b)))+  => Dict (Ord (NonTransitive.ProductOrd (Backend i t ds b)))  inferPOPartial-  :: forall (t :: Type) (ds :: [Nat]) (b :: Type)+  :: forall (t :: Type) (ds :: [Nat]) (b :: Type) (i :: Type)    . (Ord t, Impl.KnownBackend t ds b)-  => Dict (Ord (Partial.ProductOrd (Backend I t ds b)))+  => Dict (Ord (Partial.ProductOrd (Backend i t ds b)))  inferBounded-  :: forall (t :: Type) (ds :: [Nat]) (b :: Type)+  :: forall (t :: Type) (ds :: [Nat]) (b :: Type) (i :: Type)    . (Bounded t, Impl.KnownBackend t ds b)-  => Dict (Bounded (Backend I t ds b))+  => Dict (Bounded (Backend i t ds b))  inferNum-  :: forall (t :: Type) (ds :: [Nat]) (b :: Type)+  :: forall (t :: Type) (ds :: [Nat]) (b :: Type) (i :: Type)    . (Num t, Impl.KnownBackend t ds b)-  => Dict (Num (Backend I t ds b))+  => Dict (Num (Backend i t ds b))  inferFractional-  :: forall (t :: Type) (ds :: [Nat]) (b :: Type)+  :: forall (t :: Type) (ds :: [Nat]) (b :: Type) (i :: Type)    . (Fractional t, Impl.KnownBackend t ds b)-  => Dict (Fractional (Backend I t ds b))+  => Dict (Fractional (Backend i t ds b))  inferFloating-  :: forall (t :: Type) (ds :: [Nat]) (b :: Type)+  :: forall (t :: Type) (ds :: [Nat]) (b :: Type) (i :: Type)    . (Floating t, Impl.KnownBackend t ds b)-  => Dict (Floating (Backend I t ds b))+  => Dict (Floating (Backend i t ds b))  inferPrimBytes-  :: forall (t :: Type) (ds :: [Nat]) (b :: Type)+  :: forall (t :: Type) (ds :: [Nat]) (b :: Type) (i :: Type)    . (PrimBytes t, Dimensions ds, Impl.KnownBackend t ds b)-  => Dict (PrimBytes (Backend I t ds b))+  => Dict (PrimBytes (Backend i t ds b))  inferPrimArray-  :: forall (t :: Type) (ds :: [Nat]) (b :: Type)+  :: forall (t :: Type) (ds :: [Nat]) (b :: Type) (i :: Type)    . (PrimBytes t, Impl.KnownBackend t ds b)-  => Dict (PrimArray t (Backend I t ds b))+  => Dict (PrimArray t (Backend i t ds b))

@@ -7,31 +7,54 @@ {-# LANGUAGE TypeApplications      #-} #if defined(__HADDOCK__) || defined(__HADDOCK_VERSION__) {-# LANGUAGE FlexibleInstances     #-}-{-# OPTIONS_GHC -fdefer-type-errors #-}-{-# OPTIONS_GHC -fno-warn-deferred-type-errors #-} {-# OPTIONS_GHC -fno-warn-missing-methods #-} {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} {-# OPTIONS_GHC -fno-warn-simplifiable-class-constraints #-} #else {-# OPTIONS_GHC -fplugin Data.Constraint.Deriving #-} #endif+{-+The purpose of this module is to provide incoherent instances of common type classes+for the type @Backend@.+It imports @Backend.hs-boot@ module and thus does not depend on the actual+implementation of @BackendFamily@.+Import this module instead of @Backend.hs-boot@ in the places that must not depend+on @BackendFamily@, such as @Numeric.DataFrame.Type@. +By design the import chain is as follows:++NDI.Backend.Family.hs-boot            NDI.Backend.Family+         \                                   |+    NDI.Backend.hs-boot               NDI.Backend (instances only)+          \                                 /+     NDI.BackendI                          /+            \                             /+    Numeric.DataFrame.Type               /+                    \                   /+                     \                 /+                     Numeric.DataFrame++ -} module Numeric.DataFrame.Internal.BackendI-  ( I+  ( DFBackend, Backend (..), Backend.BackendFamily, Backend.KnownBackend ()+  , Backend.inferKnownBackend, Backend.inferPrimElem+#if !defined(__HADDOCK__) && !defined(__HADDOCK_VERSION__)   , inferEq, inferOrd   , inferProductOrder, inferPONonTransitive, inferPOPartial   , inferBounded, inferNum   , inferFractional, inferFloating   , inferPrimBytes, inferPrimArray+#endif   ) where  --import           Data.Constraint.Deriving             (OverlapMode (..),-                                                       ToInstance (..))+#if !defined(__HADDOCK__) && !defined(__HADDOCK_VERSION__)+import Data.Constraint          (Dict)+import Data.Constraint.Deriving (OverlapMode (..), ToInstance (..))+#endif import           Data.Kind                            (Type) import           Numeric.DataFrame.Internal.PrimArray (PrimArray)-import           Numeric.Dimensions                   (Dict, Dimensions, Nat)+import           Numeric.Dimensions                   (Dimensions, Nat) import           Numeric.PrimBytes                    (PrimBytes) import           Numeric.ProductOrd                   (ProductOrder) import qualified Numeric.ProductOrd.NonTransitive     as NonTransitive@@ -43,6 +66,9 @@   +-- | Implementation behind the DataFrame+type DFBackend (t :: Type) (ds :: [Nat]) = Backend I t ds (Impl.BackendFamily t ds)+ {- | The instance keeper for the `Backend` type.    Using this data as a tag to the `Backend` type allows to define `Backend` instances@@ -52,6 +78,10 @@ data I  ++-- The instances below are bumb stubs needed only to compile haddock+#if !defined(__HADDOCK__) && !defined(__HADDOCK_VERSION__)+ {-# ANN inferEq (ToInstance Incoherent) #-} inferEq   :: forall (t :: Type) (ds :: [Nat]) (b :: Type)@@ -129,10 +159,7 @@   => Dict (PrimArray t (Backend I t ds b)) inferPrimArray = Backend.inferPrimArray @t @ds @b ----- The instances below are bumb stubs needed only to compile haddock-#if defined(__HADDOCK__) || defined(__HADDOCK_VERSION__)+#else  instance     forall (t :: Type) (ds :: [Nat]) (b :: Type)

@@ -1,9 +0,0 @@-module Numeric.DataFrame.Internal.BackendI (I) where--{- | The instance keeper for the `Backend` type.--  Using this data as a tag to the `Backend` type allows to define `Backend` instances-  in two different modules without any orphans.-- -}-data I

@@ -8,6 +8,7 @@ {-# LANGUAGE ScopedTypeVariables       #-} {-# LANGUAGE TypeApplications          #-} {-# LANGUAGE TypeFamilies              #-}+{-# LANGUAGE TypeInType                #-} {-# LANGUAGE TypeOperators             #-} {-# LANGUAGE UnboxedTuples             #-} {-# OPTIONS_GHC -fno-warn-redundant-constraints #-}@@ -17,264 +18,511 @@ -- Copyright   :  (c) Artem Chirkin -- License     :  BSD3 ----- Maintainer  :  chirkin@arch.ethz.ch ----- Interfrace to perform primitive stateful operations on mutable frames.+-- Interface to perform primitive stateful operations on mutable frames. -- -----------------------------------------------------------------------------  module Numeric.DataFrame.Internal.Mutable     ( MDataFrame ()+    , castDataFrame#     , newDataFrame#, newPinnedDataFrame#+    , oneMoreDataFrame#+    , subDataFrameView#, subDataFrameView'#     , copyDataFrame#, copyMDataFrame#     , copyDataFrame'#, copyMDataFrame'#+    , copyDataFrameOff#, copyMDataFrameOff#     , freezeDataFrame#, unsafeFreezeDataFrame#-    , thawDataFrame#, thawPinDataFrame#, unsafeThawDataFrame#+    , thawDataFrame#, thawPinDataFrame#, unsafeThawDataFrame#, withThawDataFrame#     , writeDataFrame#, writeDataFrameOff#     , readDataFrame#, readDataFrameOff#     , withDataFramePtr#, isDataFramePinned#+    , getDataFrameSteps#     ) where - import GHC.Base import Numeric.DataFrame.Internal.PrimArray import Numeric.DataFrame.Type import Numeric.Dimensions import Numeric.PrimBytes - -- | Mutable DataFrame type. --   Keeps element offset, number of elements, and a mutable byte storage-data MDataFrame s t (ns :: [Nat])+data MDataFrame s t (ns :: [k])   = MDataFrame# Int# CumulDims (MutableByteArray# s) +-- | Allow coercing between @XNat@-indexed and @Nat@-indexed Mutable DataFrames.+castDataFrame# ::+       forall (t :: Type) (xns :: [XNat]) (ns :: [Nat]) s+     . FixedDims xns ns+    => MDataFrame s t ns -> MDataFrame s t xns+castDataFrame# (MDataFrame# o c a) = MDataFrame# o c a+{-# INLINE castDataFrame# #-}  -- | Create a new mutable DataFrame.-newDataFrame# :: forall t (ns :: [Nat]) s-               . ( PrimBytes t, Dimensions ns)-              => State# s -> (# State# s, MDataFrame s t ns #)-newDataFrame# s0+newDataFrame# ::+       forall (t :: Type) (k :: Type) (ns :: [k]) s+     . (PrimBytes t, Dimensions ns)+    => State# s -> (# State# s, MDataFrame s t ns #)+newDataFrame#     | steps <- cumulDims $ dims @ns     , n <- cdTotalDim# steps-    , (# s1, mba #) <- newByteArray# (n *# byteSize @t undefined) s0-    = (# s1,  MDataFrame# 0# steps mba #)+      = if isTrue# (n ==# 0#)+        then \s0 -> (# s0, error "Empty DataFrame (DF0)" #)+        else \s0 -> case newByteArray# (n *# byteSize @t undefined) s0 of+                          (# s1, mba #) -> (# s1,  MDataFrame# 0# steps mba #) {-# INLINE newDataFrame# #-}  -- | Create a new mutable DataFrame.-newPinnedDataFrame# :: forall t (ns :: [Nat]) s-                     . ( PrimBytes t, Dimensions ns)-                    => State# s -> (# State# s, MDataFrame s t ns #)-newPinnedDataFrame# s0+newPinnedDataFrame# ::+       forall (t :: Type) (k :: Type) (ns :: [k]) s+     . (PrimBytes t, Dimensions ns)+    => State# s -> (# State# s, MDataFrame s t ns #)+newPinnedDataFrame#     | steps <- cumulDims $ dims @ns     , n <- cdTotalDim# steps-    , (# s1, mba #)  <- newAlignedPinnedByteArray#-        (n *# byteSize @t undefined)-        (byteAlign @t undefined) s0-    = (# s1,  MDataFrame# 0# steps mba #)+      = if isTrue# (n ==# 0#)+        then \s0 -> (# s0, error "Empty DataFrame (DF0)" #)+        else \s0 -> case newAlignedPinnedByteArray#+                          (n *# byteSize @t undefined)+                          (byteAlign @t undefined) s0 of+                          (# s1, mba #) -> (# s1,  MDataFrame# 0# steps mba #) {-# INLINE newPinnedDataFrame# #-} +-- | Create a new mutable DataFrame of the same size.+oneMoreDataFrame# ::+       forall (t :: Type) (k :: Type) (ns :: [k]) s+     . MDataFrame s t ns -> State# s -> (# State# s, MDataFrame s t ns #)+oneMoreDataFrame# mdf@(MDataFrame# off steps mba) s0+    | 0# <- cdTotalDim# steps = (# s0, mdf #)+    | (# s1, bs #) <- getSizeofMutableByteArray# mba s0+    , (# s2, mba' #) <- newByteArray# (bs -# off) s1+      = (# s2,  MDataFrame# 0# steps mba' #)+{-# INLINE oneMoreDataFrame# #-}++-- | View a part of a DataFrame.+--+--   This function does not perform a copy.+--   All changes to a new DataFrame will be reflected in the original DataFrame as well.+--+--   If any of the dims in @as@ or @b@ is unknown (@a ~ XN m@),+--   then this function is unsafe and can throw an `OutOfDimBounds` exception.+--   Otherwise, its safety is guaranteed by the type system.+subDataFrameView# ::+       forall (t :: Type) (k :: Type)+              (b :: k) (bi :: k) (bd :: k)+              (as :: [k]) (bs :: [k]) (asbs :: [k]) s+     . (SubFrameIndexCtx b bi bd, KnownDim bd, ConcatList as (b :+ bs) asbs)+    => Idxs (as +: bi) -> MDataFrame s t asbs -> MDataFrame s t (bd :+ bs)+subDataFrameView# ei (MDataFrame# offM stepsM arr)+    = MDataFrame# (case offA of I# i -> i) stepsA arr+  where+    (offA, stepsA) = getOffAndStepsSub (I# offM) stepsM ei (dim @bd)++-- | View a part of a DataFrame.+--+--   This function does not perform a copy.+--   All changes to a new DataFrame will be reflected in the original DataFrame as well.+--+--   This is a simpler version of @subDataFrameView@ that allows+--    to view over one index at a time.+--+--   If any of the dims in @as@ is unknown (@a ~ XN m@),+--   then this function is unsafe and can throw an `OutOfDimBounds` exception.+--   Otherwise, its safety is guaranteed by the type system.+subDataFrameView'# ::+       forall (t :: Type) (k :: Type) (as :: [k]) (bs :: [k]) (asbs :: [k]) s+     . ConcatList as bs asbs+    => Idxs as -> MDataFrame s t asbs -> MDataFrame s t bs+subDataFrameView'# ei (MDataFrame# offM stepsM arr)+    = MDataFrame# (case offA of I# i -> i) stepsA arr+  where+    (offA, stepsA) = getOffAndSteps (I# offM) stepsM ei+ -- | Copy one DataFrame into another mutable DataFrame at specified position. -----   In contrast to @copyDataFrame'@, this function allows to copy over a range of contiguous---   indices over a single dimension.+--   In contrast to @copyDataFrame'@, this function allows to copy over a range+--    of contiguous indices over a single dimension. --   For example, you can write a 3x4 matrix into a 7x4 matrix, starting at indices 0..3.-copyDataFrame# :: forall (t :: Type)-                         (b :: Nat) (bi :: Nat) (bd :: Nat)-                         (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) s-                . ( b ~ (bi + bd - 1)-                  , PrimBytes t-                  , PrimBytes (DataFrame t (bd :+ bs))-                  , ConcatList as (b :+ bs) asbs-                  )-               => Idxs (as +: bi) -> DataFrame t (bd :+ bs) -> MDataFrame s t asbs-               -> State# s -> (# State# s, () #)-copyDataFrame# ei df (MDataFrame# off steps mba) s-    | I# i <- cdIx steps ei-    = (# writeBytes mba ((off +# i) *# byteSize @t undefined) df s, () #)+--+--   This function is safe (no `OutOfDimBounds` exception possible).+--   If any of the dims in @as@ is unknown (@a ~ XN m@),+--   you may happen to write data beyond dataframe bounds.+--   In this case, this function does nothing.+--   If (@b ~ XN m@) and (@Idx bi + Dim bd > Dim b@), this function copies only as+--   many elements as fits into the dataframe along this dimension (possibly none).+copyDataFrame# ::+       forall (t :: Type) (k :: Type)+              (b :: k) (bi :: k) (bd :: k)+              (as :: [k]) (bs :: [k]) (asbs :: [k]) s+     . ( SubFrameIndexCtx b bi bd, KnownDim bd+       , ExactDims bs+       , PrimArray t (DataFrame t (bd :+ bs))+       , ConcatList as (b :+ bs) asbs )+    => Idxs (as +: bi) -> DataFrame t (bd :+ bs) -> MDataFrame s t asbs+    -> State# s -> (# State# s, () #)+copyDataFrame# ei df (MDataFrame# offM stepsM arrDest)+    | elS <- byteSize @t undefined+    , Just (I# offDest, stepsB)+         <- getOffAndStepsSubM (I# offM) stepsM ei (dim @bd)+    , n <- cdTotalDim# stepsB+    , isTrue# (n ># 0#) -- is there enough space to write anything?+    = withArrayContent+      (\e s -> (# fillArray arrDest offDest n e s, () #))+      (\_ offSrc arrSrc s ->+        (# copyByteArray# arrSrc  (offSrc *# elS)+                          arrDest (offDest *# elS) (n *# elS) s, () #)) df+    | otherwise = \s -> (# s, () #) {-# INLINE copyDataFrame# #-} - {-# ANN copyMDataFrame# "HLint: ignore Use camelCase" #-} -- | Copy one mutable DataFrame into another mutable DataFrame at specified position. -----   In contrast to @copyMDataFrame'@, this function allows to copy over a range of contiguous---   indices over a single dimension.+--   In contrast to @copyMutableDataFrame'@, this function allows to copy over a range+--    of contiguous indices over a single dimension. --   For example, you can write a 3x4 matrix into a 7x4 matrix, starting at indices 0..3.-copyMDataFrame# :: forall (t :: Type)-                          (b :: Nat) (bi :: Nat) (bd :: Nat)-                          (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) s-                 . ( b ~ (bi + bd - 1)-                   , PrimBytes t-                   , ConcatList as (b :+ bs) asbs-                   )-                => Idxs (as +: bi) -> MDataFrame s t (bd :+ bs) -> MDataFrame s t asbs-                -> State# s -> (# State# s, () #)-                     -- all information for copying in this case is taken from the inside-                     -- of the data types at the term level;-                     -- steps zips with indices just fine independently of their types-                     -- and length.-                     -- Thus, it's fine here to just unsafeCoerce# an index.-copyMDataFrame# ei df =-  copyMDataFrame'#-     (unsafeCoerce# ei :: Idxs as)-     (unsafeCoerce# df :: MDataFrame s t (b :+ bs))+--+--   This function is safe (no `OutOfDimBounds` exception possible).+--   If any of the dims in @as@ is unknown (@a ~ XN m@),+--   you may happen to write data beyond dataframe bounds.+--   In this case, this function does nothing.+--   If (@b ~ XN m@) and (@Idx bi + Dim bd > Dim b@), this function copies only as+--   many elements as fits into the dataframe along this dimension (possibly none).+copyMDataFrame# ::+       forall (t :: Type) (k :: Type)+              (b :: k) (bi :: k) (bd :: k)+              (as :: [k]) (bs :: [k]) (asbs :: [k]) s+     . ( SubFrameIndexCtx b bi bd+       , ExactDims bs+       , PrimBytes t+       , ConcatList as (b :+ bs) asbs )+    => Idxs (as +: bi) -> MDataFrame s t (bd :+ bs) -> MDataFrame s t asbs+    -> State# s -> (# State# s, () #)+copyMDataFrame# ei (MDataFrame# offA (CumulDims ~(bb:b:_)) arrA)+                   (MDataFrame# offM stepsM arrM)+    | elS <- byteSize @t undefined+    , Just (I# offDest, stepsB)+         <- getOffAndStepsSubM (I# offM) stepsM ei (unsafeCoerce# (quot bb b))+    , n <- cdTotalDim# stepsB+    , isTrue# (n ># 0#) -- is there enough space to write anything?+    = \s -> (# copyMutableByteArray# arrA (offA *# elS)+                                     arrM (offDest *# elS) (n *# elS) s+             , () #)+    | otherwise = \s -> (# s, () #) {-# INLINE copyMDataFrame# #-}  {-# ANN copyDataFrame'# "HLint: ignore Use camelCase" #-} -- | Copy one DataFrame into another mutable DataFrame at specified position. -----   This is a simpler version of @copyDataFrame@ that allows to copy over one index at a time.-copyDataFrame'# :: forall (t :: Type) (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) s-                . ( PrimBytes t-                  , PrimBytes (DataFrame t bs)-                  , ConcatList as bs asbs-                  )-               => Idxs as -> DataFrame t bs -> MDataFrame s t asbs-               -> State# s -> (# State# s, () #)-copyDataFrame'# ei df (MDataFrame# off steps mba) s-    | I# i <- cdIx steps ei-    = (# writeBytes mba ((off +# i) *# byteSize @t undefined) df s, () #)+--   This is a simpler version of @copyDataFrame@ that allows+--     to copy over one index at a time.+--+--   This function is safe (no `OutOfDimBounds` exception possible).+--   If any of the dims in @as@ is unknown (@a ~ XN m@),+--   you may happen to write data beyond dataframe bounds.+--   In this case, this function does nothing.+copyDataFrame'# ::+       forall (t :: Type) (k :: Type) (as :: [k]) (bs :: [k]) (asbs :: [k]) s+     . ( ExactDims bs+       , PrimArray t (DataFrame t bs)+       , ConcatList as bs asbs )+    => Idxs as -> DataFrame t bs -> MDataFrame s t asbs+    -> State# s -> (# State# s, () #)+copyDataFrame'# ei df (MDataFrame# offM stepsM arrDest)+    | elS <- byteSize @t undefined+    , Just (I# offDest, stepsA) <- getOffAndStepsM (I# offM) stepsM ei+    , n <- cdTotalDim# stepsA+    = withArrayContent+      (\e s -> (# fillArray arrDest offDest n e s, () #))+      (\_ offSrc arrSrc s ->+        (# copyByteArray# arrSrc  (offSrc *# elS)+                          arrDest (offDest *# elS) (n *# elS) s, () #)) df+    | otherwise = \s -> (# s, () #) {-# INLINE copyDataFrame'# #-}  {-# ANN copyMDataFrame'# "HLint: ignore Use camelCase" #-} -- | Copy one mutable DataFrame into another mutable DataFrame at specified position. -----   This is a simpler version of @copyMDataFrame@ that allows to copy over one index at a time.-copyMDataFrame'# :: forall (t :: Type) (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) s-                 . ( PrimBytes t-                   , ConcatList as bs asbs-                   )-                => Idxs as -> MDataFrame s t bs -> MDataFrame s t asbs-                -> State# s -> (# State# s, () #)-copyMDataFrame'# ei (MDataFrame# offA stepsA arrA) (MDataFrame# offM stepsM arrM) s+--   This is a simpler version of @copyMutableDataFrame@ that allows+--     to copy over one index at a time.+--+--   This function is safe (no `OutOfDimBounds` exception possible).+--   If any of the dims in @as@ is unknown (@a ~ XN m@),+--   you may happen to write data beyond dataframe bounds.+--   In this case, this function does nothing.+copyMDataFrame'# ::+       forall (t :: Type) (k :: Type) (as :: [k]) (bs :: [k]) (asbs :: [k]) s+     . (ExactDims bs, PrimBytes t, ConcatList as bs asbs)+    => Idxs as -> MDataFrame s t bs -> MDataFrame s t asbs+    -> State# s -> (# State# s, () #)+copyMDataFrame'# ei (MDataFrame# offA stepsA arrA) (MDataFrame# offM stepsM arrM)     | elS <- byteSize @t undefined     , lenA <- cdTotalDim# stepsA-    , I# i <- cdIx stepsM ei-    = (# copyMutableByteArray# arrA (offA *# elS)-                               arrM ((offM +# i) *# elS) (lenA *# elS) s-       , () #)+    , Just (I# i) <- cdIxM stepsM ei+    = \s -> (# copyMutableByteArray#+                 arrA (offA *# elS)+                 arrM ((offM +# i) *# elS) (lenA *# elS) s, () #)+    | otherwise = \s -> (# s, () #) {-# INLINE copyMDataFrame'# #-} +-- | Copy one DataFrame into another mutable DataFrame by offset in+--   primitive elements.+--+--   This is a low-level copy function; you have to keep in mind the row-major+--   layout of Mutable DataFrames. Offset bounds are not checked.+--   You will get an undefined behavior if you write beyond the DataFrame bounds.+copyDataFrameOff# ::+       forall (t :: Type) (k :: Type) (as :: [k]) (bs :: [k]) (asbs :: [k]) s+     . ( Dimensions bs+       , PrimArray t (DataFrame t bs)+       , ConcatList as bs asbs )+    => Int -> DataFrame t bs -> MDataFrame s t asbs+    -> State# s -> (# State# s, () #)+copyDataFrameOff# (I# off) df (MDataFrame# offM _ arrDest)+    | elS <- byteSize @t undefined+    , offDest <- offM +# off+    = withArrayContent+      (\e s ->+        (# fillArray arrDest offDest+              (case totalDim (dims @bs) of W# n -> word2Int# n) e s, () #))+      (\steps offSrc arrSrc s ->+        (# copyByteArray# arrSrc  (offSrc *# elS)+                          arrDest (offDest *# elS)+                                  (cdTotalDim# steps *# elS) s, () #)) df+{-# INLINE copyDataFrameOff# #-}++-- | Copy one mutable DataFrame into another mutable DataFrame by offset in+--   primitive elements.+--+--   This is a low-level copy function; you have to keep in mind the row-major+--   layout of Mutable DataFrames. Offset bounds are not checked.+--   You will get an undefined behavior if you write beyond the DataFrame bounds.+copyMDataFrameOff# ::+       forall (t :: Type) (k :: Type) (as :: [k]) (bs :: [k]) (asbs :: [k]) s+     . (ExactDims bs, PrimBytes t, ConcatList as bs asbs)+    => Int -> MDataFrame s t bs -> MDataFrame s t asbs+    -> State# s -> (# State# s, () #)+copyMDataFrameOff# (I# off) (MDataFrame# offA stepsA arrA)+                            (MDataFrame# offM _      arrM)+    | elS <- byteSize @t undefined+    , lenA <- cdTotalDim# stepsA+    = \s -> (# copyMutableByteArray#+                 arrA (offA *# elS)+                 arrM ((offM +# off) *# elS) (lenA *# elS) s, () #)+{-# INLINE copyMDataFrameOff# #-}+ -- | Make a mutable DataFrame immutable, without copying.-unsafeFreezeDataFrame# :: forall (t :: Type) (ns :: [Nat]) s-                        . PrimArray t (DataFrame t ns)-                       => MDataFrame s t ns-                       -> State# s -> (# State# s, DataFrame t ns #)-unsafeFreezeDataFrame# (MDataFrame# offM steps arrM) s1-    | (# s2, arrA #) <- unsafeFreezeByteArray# arrM s1-    = (# s2, fromElems steps offM arrA #)+unsafeFreezeDataFrame# ::+       forall (t :: Type) (k :: Type) (ns :: [k]) s+     . PrimArray t (DataFrame t ns)+    => MDataFrame s t ns+    -> State# s -> (# State# s, DataFrame t ns #)+unsafeFreezeDataFrame# (MDataFrame# offM steps arrM) s0+    | 0# <- cdTotalDim# steps+      = (# s0, error "Empty DataFrame (DF0)" #)+    | (# s1, arrA #) <- unsafeFreezeByteArray# arrM s0+      = (# s1, fromElems steps offM arrA #) {-# INLINE unsafeFreezeDataFrame# #-}  -- | Copy content of a mutable DataFrame into a new immutable DataFrame.-freezeDataFrame# :: forall (t :: Type) (ns :: [Nat]) s-                  . PrimArray t (DataFrame t ns)-                 => MDataFrame s t ns -> State# s -> (# State# s, DataFrame t ns #)+freezeDataFrame# ::+       forall (t :: Type) (k :: Type) (ns :: [k]) s+     . PrimArray t (DataFrame t ns)+    => MDataFrame s t ns -> State# s -> (# State# s, DataFrame t ns #) freezeDataFrame# (MDataFrame# offM steps arrM) s0+    | 0# <- cdTotalDim# steps+      = (# s0, error "Empty DataFrame (DF0)" #)     | elS  <- byteSize @t undefined     , n <- cdTotalDim# steps     , (# s1, mba #) <- newByteArray# (n *# elS) s0     , s2 <- copyMutableByteArray# arrM (offM *# elS) mba 0# (n *# elS) s1     , (# s3, arrA #) <- unsafeFreezeByteArray# mba s2-    = (# s3, fromElems steps 0# arrA #)+      = (# s3, fromElems steps 0# arrA #) {-# INLINE freezeDataFrame# #-}  -- | Create a new mutable DataFrame and copy content of immutable one in there.-thawDataFrame# :: forall (t :: Type) (ns :: [Nat]) s-                . ( Dimensions ns-                  , PrimBytes (DataFrame t ns))-               => DataFrame t ns -> State# s -> (# State# s, MDataFrame s t ns #)+thawDataFrame# ::+       forall (t :: Type) (k :: Type) (ns :: [k]) s+     . (Dimensions ns, PrimArray t (DataFrame t ns))+    => DataFrame t ns -> State# s -> (# State# s, MDataFrame s t ns #) thawDataFrame# df s0-    | arrA  <- getBytes df-    , boff  <- byteOffset df-    , bsize <- byteSize df-    , steps <- cumulDims $ dims @ns-    , (# s1, arrM #) <- newByteArray# bsize s0-    , s2 <- copyByteArray# arrA boff arrM 0# bsize s1-    = (# s2, MDataFrame# 0# steps arrM #)+    | nw == 0+      = (# s0, error "Empty DataFrame (DF0)" #)+    | bSize <- case nw of W# w -> byteSize @t undefined *# word2Int# w+    , (# s1, arrM #) <- newByteArray# bSize s0+    , r <- MDataFrame# 0# steps arrM+    , (# s2, _ #) <- copyDataFrameOff# 0 df r s1+      = (# s2, r #)+  where+    nw = cdTotalDim steps+    steps = getSteps (dims @ns) df {-# INLINE thawDataFrame# #-}  -- | Create a new mutable DataFrame and copy content of immutable one in there. --   The result array is pinned and aligned.-thawPinDataFrame# :: forall (t :: Type) (ns :: [Nat]) s-                . ( Dimensions ns-                  , PrimBytes (DataFrame t ns))-               => DataFrame t ns -> State# s -> (# State# s, MDataFrame s t ns #)+thawPinDataFrame# ::+       forall (t :: Type) (k :: Type) (ns :: [k]) s+     . (Dimensions ns, PrimArray t (DataFrame t ns))+    => DataFrame t ns -> State# s -> (# State# s, MDataFrame s t ns #) thawPinDataFrame# df s0-    | arrA  <- getBytes df-    , boff  <- byteOffset df-    , bsize <- byteSize df-    , steps <- cumulDims $ dims @ns-    , (# s1, arrM #) <- newAlignedPinnedByteArray# bsize (byteAlign df) s0-    , s2 <- copyByteArray# arrA boff arrM 0# bsize s1-    = (# s2, MDataFrame# 0# steps arrM #)+    | nw == 0+      = (# s0, error "Empty DataFrame (DF0)" #)+    | bSize <- case nw of W# w -> byteSize @t undefined *# word2Int# w+    , (# s1, arrM #) <- newAlignedPinnedByteArray# bSize (byteAlign @t undefined) s0+    , r <- MDataFrame# 0# steps arrM+    , (# s2, _ #) <- copyDataFrameOff# 0 df r s1+      = (# s2, r #)+  where+    nw = cdTotalDim steps+    steps = getSteps (dims @ns) df {-# INLINE thawPinDataFrame# #-}  -- | UnsafeCoerces an underlying byte array.-unsafeThawDataFrame# :: forall (t :: Type) (ns :: [Nat]) s-                      . ( Dimensions ns-                        , PrimBytes (DataFrame t ns), PrimBytes t)-                     => DataFrame t ns-                     -> State# s -> (# State# s, MDataFrame s t ns #)-unsafeThawDataFrame# df s0-    | elS  <- byteSize @t undefined-    , arrA <- getBytes df-    , boff <- byteOffset df-    , steps <- cumulDims $ dims @ns-    = (# s0-       , MDataFrame# (quotInt# boff elS) steps (unsafeCoerce# arrA)-       #)+unsafeThawDataFrame# ::+       forall (t :: Type) (k :: Type) (ns :: [k]) s+     . (Dimensions ns, PrimArray t (DataFrame t ns))+    => DataFrame t ns+    -> State# s -> (# State# s, MDataFrame s t ns #)+unsafeThawDataFrame# = withArrayContent f g+  where+    f :: t -> State# s -> (# State# s, MDataFrame s t ns #)+    f e s0+      | steps <- cumulDims (dims @ns)+      , n <- cdTotalDim# steps+      , (# s1, arrM #) <- newByteArray# (n *# byteSize @t undefined) s0+      = (# fillArray arrM 0# n e s1, MDataFrame# 0# steps arrM #)+    g :: CumulDims -> Int# -> ByteArray# -> State# s -> (# State# s, MDataFrame s t ns #)+    g steps off ba s0+      = (# s0, MDataFrame# off steps (unsafeCoerce# ba) #) {-# INLINE unsafeThawDataFrame# #-} +-- | Given two continuations @f@ and @g@.+--   If the input DataFrame is a single broadcast value, use it in @f@.+--   Otherwise, create a new mutable DataFrame and copy content of immutable one+--   in there; then use it in @g@.+--+--   This function is useful when @thawDataFrame@ cannot be used due to+--   @Dimensions ns@ constraint being not available.+withThawDataFrame# ::+       forall (t :: Type) (k :: Type) (ns :: [k]) (r :: Type) s+     . PrimArray t (DataFrame t ns)+    => (t -> State# s -> (# State# s, r #)) -- ^ f+    -> (MDataFrame s t ns -> State# s -> (# State# s, r #)) -- ^ g+    -> DataFrame t ns+    -> State# s -> (# State# s, r #)+withThawDataFrame# f g = withArrayContent f g'+  where+    g' :: CumulDims -> Int# -> ByteArray# -> State# s -> (# State# s, r #)+    g' steps eOff arrA s0 = case cdTotalDim# steps of+      0# -> g (error "Empty DataFrame (DF0)") s0+      elems+       | elS <- byteSize @t undefined+       , bsize <- elS *# elems+       , (# s1, arrM #) <- newByteArray# bsize s0+       , s2 <- copyByteArray# arrA (eOff *# elS) arrM 0# bsize s1+         -> g (MDataFrame# 0# steps arrM) s2+{-# INLINE withThawDataFrame# #-} --- | Write a single element at the specified element offset-writeDataFrameOff# :: forall (t :: Type) (ns :: [Nat]) s-                    . PrimBytes t-                   => MDataFrame s t ns -> Int# -> t -> State# s -> (# State# s, () #)-writeDataFrameOff# (MDataFrame# off _ mba) i x s+-- | Write a single element at the specified element offset.+--+--   This is a low-level write function; you have to keep in mind the row-major+--   layout of Mutable DataFrames. Offset bounds are not checked.+--   You will get an undefined behavior if you write beyond the DataFrame bounds.+writeDataFrameOff# ::+       forall (t :: Type) (k :: Type) (ns :: [k]) s+     . PrimBytes (DataFrame t ('[] :: [k]))+    => MDataFrame s t ns -> Int -> DataFrame t ('[] :: [k])+    -> State# s -> (# State# s, () #)+writeDataFrameOff# (MDataFrame# off _ mba) (I# i) x s   = (# writeArray mba (off +# i) x s, () #) {-# INLINE writeDataFrameOff# #-} --- | Write a single element at the specified index-writeDataFrame# :: forall (t :: Type) (ns :: [Nat]) s-                 . PrimBytes t-                => MDataFrame s t ns -> Idxs ns -> t -> State# s -> (# State# s, () #)+-- | Write a single element at the specified index.+--+--   This function is safe (no `OutOfDimBounds` exception possible).+--   If any of the dims in @ns@ is unknown (@n ~ XN m@),+--   you may happen to write data beyond dataframe bounds.+--   In this case, this function does nothing.+writeDataFrame# ::+       forall (t :: Type) (k :: Type) (ns :: [k]) s+     . PrimBytes (DataFrame t ('[] :: [k]))+    => MDataFrame s t ns -> Idxs ns -> DataFrame t ('[] :: [k])+    -> State# s -> (# State# s, () #) writeDataFrame# mdf@(MDataFrame# _ st _) ei-  | I# i <- cdIx st ei = writeDataFrameOff# mdf i+  | Just off <- (cdIxM st ei)+  = writeDataFrameOff# mdf off+  | otherwise = const (\s -> (# s, () #)) {-# INLINE writeDataFrame# #-} --- | Read a single element at the specified element offset-readDataFrameOff# :: forall (t :: Type) (ns :: [Nat]) s-                   . PrimBytes t-                  => MDataFrame s t ns -> Int# -> State# s -> (# State# s, t #)-readDataFrameOff# (MDataFrame# off _ mba) i = readArray mba (off +# i)+-- | Read a single element at the specified element offset.+--+--   This is a low-level read function; you have to keep in mind the row-major+--   layout of Mutable DataFrames. Offset bounds are not checked.+--   You will get an undefined behavior if you read beyond the DataFrame bounds.+readDataFrameOff# ::+       forall (t :: Type) (k :: Type) (ns :: [k]) s+     . PrimBytes (DataFrame t ('[] :: [k]))+    => MDataFrame s t ns -> Int+    -> State# s -> (# State# s, DataFrame t ('[] :: [k]) #)+readDataFrameOff# (MDataFrame# off _ mba) (I# i)+  = readArray @(DataFrame t ('[] :: [k])) mba (off +# i) {-# INLINE readDataFrameOff# #-} --- | Read a single element at the specified index-readDataFrame# :: forall (t :: Type) (ns :: [Nat]) s-                . PrimBytes t-               => MDataFrame s t ns -> Idxs ns -> State# s -> (# State# s, t #)+-- | Read a single element at the specified index.+--+--   If any of the dims in @ns@ is unknown (@n ~ XN m@),+--   then this function is unsafe and can throw an `OutOfDimBounds` exception.+--   Otherwise, its safety is guaranteed by the type system.+readDataFrame# ::+       forall (t :: Type) (k :: Type) (ns :: [k]) s+     . PrimBytes (DataFrame t ('[] :: [k]))+    => MDataFrame s t ns -> Idxs ns+    -> State# s -> (# State# s, DataFrame t ('[] :: [k]) #) readDataFrame# mdf@(MDataFrame# _ st _) ei-  | I# i <- cdIx st ei = readDataFrameOff# mdf i+  = readDataFrameOff# mdf (cdIx st ei) {-# INLINE readDataFrame# #-}  -- | Allow arbitrary operations on a pointer to the beginning of the data. --   Only possible with @RealWord@ state (thus, in @IO@) due to semantics of --   @touch#@ operation that keeps the data from being garbage collected.-withDataFramePtr# :: forall (t :: Type) (ns :: [Nat]) (r :: Type)-                   . PrimBytes t-                  => MDataFrame RealWorld t ns-                  -> ( Addr# -> State# RealWorld -> (# State# RealWorld, r #) )-                  -> State# RealWorld -> (# State# RealWorld, r #)+withDataFramePtr# ::+       forall (t :: Type) (k :: Type) (ns :: [k]) (r :: Type)+     . PrimBytes t+    => MDataFrame RealWorld t ns+    -> (Addr# -> State# RealWorld -> (# State# RealWorld, r #))+    -> State# RealWorld -> (# State# RealWorld, r #) withDataFramePtr# (MDataFrame# off _ mba) k s0   | (# s1, a #) <- unsafeFreezeByteArray# mba s0   , (# s2, r #) <- k ( byteArrayContents# a                        `plusAddr#` (off *# byteSize @t undefined)                      ) s1-  = (# touch# mba s2, r #)+    = (# touch# mba s2, r #)+{-# INLINE withDataFramePtr# #-}  -- | Check if the byte array wrapped by this DataFrame is pinned, --   which means cannot be relocated by GC.-isDataFramePinned# :: forall (t :: Type) (ns :: [Nat]) s-                    . MDataFrame s t ns -> Bool+isDataFramePinned# ::+       forall (t :: Type) (k :: Type) (ns :: [k]) s . MDataFrame s t ns -> Bool isDataFramePinned# (MDataFrame# _ _ mba)   = isTrue# (isMutableByteArrayPinned# mba)++-- | Get cumulative dimensions @ns@ of a @MDataFrame s t ns@+getDataFrameSteps# ::+       forall (t :: Type) (k :: Type) (ns :: [k]) s+     . MDataFrame s t ns -> CumulDims+getDataFrameSteps# (MDataFrame# _ c _) = c+{-# INLINE getDataFrameSteps# #-}++-- | Fill a mutable byte array with the same single element+fillArray :: PrimBytes t+          => MutableByteArray# s+          -> Int# -- ^ Offset in elements+          -> Int# -- ^ Number of elements+          -> t+          -> State# s -> State# s+fillArray mba off n e+  = let lim = off +# n+        go i s | isTrue# (i >=# lim) = s+               | otherwise           = go (i +# 1#) (writeArray mba i e s)+    in  go off+{-# INLINE fillArray #-}

@@ -1,27 +1,40 @@ {-# LANGUAGE CPP                    #-} {-# LANGUAGE DataKinds              #-}+{-# LANGUAGE ExplicitForAll         #-}+{-# LANGUAGE FlexibleInstances      #-} {-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs                  #-} {-# LANGUAGE MagicHash              #-} {-# LANGUAGE MultiParamTypeClasses  #-} {-# LANGUAGE PolyKinds              #-}+{-# LANGUAGE TypeOperators          #-} {-# LANGUAGE UnboxedTuples          #-} module Numeric.DataFrame.Internal.PrimArray   ( PrimArray (..), CumulDims (..)-  , cumulDims, cdTotalDim, cdTotalDim#, cdIx+  , cumulDims, cdTotalDim, cdTotalDim#+  , cdIx, cdIxSub, getOffAndSteps, getOffAndStepsSub+  , cdIxM, getOffAndStepsM, getOffAndStepsSubM   , ixOff, unsafeFromFlatList, getSteps, fromSteps+  , withArrayContent, fromElems, broadcast   ) where -import Data.Monoid        as Mon (Monoid (..))-import Data.Semigroup     as Sem (Semigroup (..))-import GHC.Base           (ByteArray#, Int (..), Int#, Word (..), word2Int#)+import Control.Arrow  ((***))+import Data.Monoid    as Mon (Monoid (..))+import Data.Semigroup as Sem (Semigroup (..))+import GHC.Base       hiding (foldr)+ -- (ByteArray#, Int (..), Int#, RuntimeRep (..), Type,+ --                           Word (..), inline, runRW#, touch#, word2Int#, (+#))+import GHC.Exts           (TYPE) import Numeric.Dimensions import Numeric.PrimBytes + -- | Given @Dims ns@, @CumulativeDims@ is a list of length @Length ns + 1@; --   which cumulative @totalDim@ accumulated on the right. --   In particular, its first element is @totalDim ds@, --   its last element is always is always @1@. newtype CumulDims = CumulDims { unCumulDims :: [Word] }+  deriving Show  instance Sem.Semigroup CumulDims where     CumulDims as <> CumulDims bs = CumulDims $ map (head bs *) (init as) ++ bs@@ -49,16 +62,128 @@ -- --   Note, you can take offset of subspace with CumulDims of larger space --     - very convenient!+--+--   If any of the dims in @ns@ is unknown (@n ~ XN m@),+--   then this function is unsafe and can throw an `OutOfDimBounds` exception.+--   Otherwise, its safety is guaranteed by the type system. cdIx :: CumulDims -> Idxs ns -> Int-cdIx ~(CumulDims ~(_:steps))-  = fromIntegral . sum . zipWith (*) steps . listIdxs+cdIx steps+  = fromIntegral . fst . getOffAndSteps' 0 0 (unCumulDims steps) . listIdxs +-- | Calculate offset of an Idxs.+--+--   Also check if the last index plus dimVal of subN is not bigger than the+--   corresponding dim inside CumulDims; throw an `OutOfDimBounds` otherwise.+--+--   If any of the dims in @ns@ is unknown (@n ~ XN m@),+--   then this function is unsafe and can throw an `OutOfDimBounds` exception.+--   Otherwise, its safety is guaranteed by the type system.+cdIxSub :: CumulDims -> Idxs (ns +: idxN) -> Dim subN -> Int+cdIxSub steps idxs d+  = fromIntegral+  . fst . getOffAndSteps' (dimVal d) 0 (unCumulDims steps) $ listIdxs idxs++-- | Calculate offset of an Idxs and return remaining CumulDims.+--+--   If any of the dims in @ns@ is unknown (@n ~ XN m@),+--   then this function is unsafe and can throw an `OutOfDimBounds` exception.+--   Otherwise, its safety is guaranteed by the type system.+getOffAndSteps :: Int -- ^ Initial offset+               -> CumulDims -> Idxs ns -> (Int, CumulDims)+getOffAndSteps off0 steps+  = (fromIntegral *** CumulDims)+  . getOffAndSteps' 0 (fromIntegral off0) (unCumulDims steps) . listIdxs++-- | Calculate offset of an Idxs and return remaining CumulDims.+--+--   Also check if the last index plus dimVal of subN is not bigger than the+--   corresponding dim inside CumulDims; throw an `OutOfDimBounds` otherwise.+--+--   If any of the dims in @ns@ is unknown (@n ~ XN m@),+--   then this function is unsafe and can throw an `OutOfDimBounds` exception.+--   Otherwise, its safety is guaranteed by the type system.+getOffAndStepsSub :: Int -- ^ Initial offset+                  -> CumulDims -> Idxs (ns +: idxN)+                  -> Dim subN -> (Int, CumulDims)+getOffAndStepsSub off0 steps idxs d+  = (fromIntegral *** CumulDims)+  . getOffAndSteps' (dimVal d) (fromIntegral off0) (unCumulDims steps)+  $ listIdxs idxs+++getOffAndSteps' :: Word -> Word -> [Word] -> [Word] -> (Word, [Word])+getOffAndSteps' sub0 off0 steps0 is0 = go sub0 off0 steps0 is0+  where+#ifndef UNSAFE_INDICES+    ds0 = case fromSteps (CumulDims steps0) of SomeDims x -> listDims x+#endif+    go :: Word -> Word -> [Word] -> [Word] -> (Word, [Word])+    go 0 off steps [] = (off, steps)+    go sub off ~(steps@(s:_)) [] = (off, sub*s : steps)+#ifndef UNSAFE_INDICES+    go sub _ ~(bs:(s:_)) [i]+      | b <- quot bs s+      , sub > 0 && i + sub > b+      = outOfDimBoundsNoCallStack+          "{Calculating SubDataFrame offset}"+          i b (Just sub) (Just (ds0, is0))+    go _ _ ~(bs:(s:_)) (i:_)+      | b <- quot bs s+      , i >= b+      = outOfDimBoundsNoCallStack+          "{Calculating SubDataFrame offset}"+          i b Nothing (Just (ds0, is0))+#endif+    go sub off ~(_:steps@(s:_)) (i:ixs)+      = go sub (off + i*s) steps ixs+{-# INLINE getOffAndSteps' #-}++++-- | Same as `cdIx`, but safe; returns @Nothing@ if out of bounds.+cdIxM :: CumulDims -> Idxs ns -> Maybe Int+cdIxM steps+  = fmap (fromIntegral . fst)+  . getOffAndStepsM' 0 0 (unCumulDims steps) . listIdxs++-- | Same as `getOffAndSteps`, but safe; returns @Nothing@ if out of bounds.+--   Trims the first (slicing) dimension of the returned CumulDims to fit+--   the original dataframe if necessary.+getOffAndStepsM :: Int -- ^ Initial offset+                -> CumulDims -> Idxs ns -> Maybe (Int, CumulDims)+getOffAndStepsM off0 steps+  = fmap (fromIntegral *** CumulDims)+  . getOffAndStepsM' 0 (fromIntegral off0) (unCumulDims steps) . listIdxs++-- | Same as `getOffAndStepsSub`, but safe; returns @Nothing@ if out of bounds.+--   Trims the first (slicing) dimension of the returned CumulDims to fit+--   the original dataframe if necessary.+getOffAndStepsSubM :: Int -- ^ Initial offset+                  -> CumulDims -> Idxs (ns +: idxN)+                  -> Dim subN -> Maybe (Int, CumulDims)+getOffAndStepsSubM off0 steps idxs d+  = fmap (fromIntegral *** CumulDims)+  . getOffAndStepsM' (dimVal d) (fromIntegral off0) (unCumulDims steps)+  $ listIdxs idxs++getOffAndStepsM' :: Word -> Word -> [Word] -> [Word] -> Maybe (Word, [Word])+getOffAndStepsM' = go+  where+    go :: Word -> Word -> [Word] -> [Word] -> Maybe (Word, [Word])+    go _   off steps [] = Just (off, steps)+    go sub off ~(bs:steps@(s:_)) (i:ixs)+      | is >= bs       = Nothing+      | not (null ixs) = go sub (off + is) steps ixs+      | sub == 0       = Just (off + is, steps)+      | otherwise      = Just (off + is, min (bs - is) (sub*s) : steps)+      where+        is = i*s+{-# INLINE getOffAndStepsM' #-}+ -- | Try to get @CumulDims@ from an array, --   and create it using @Dims@ if failed. getSteps :: PrimArray t a => Dims (ns :: [k]) -> a -> CumulDims-getSteps dds df = case uniqueOrCumulDims df of-   Left  _  -> cumulDims dds-   Right ds -> ds+getSteps dds = withArrayContent (const $ cumulDims dds) (\cd _ _ -> cd) {-# INLINE getSteps #-}  -- | Get @Dims@ by "de-accumulating" @CumulDims@.@@ -75,9 +200,14 @@  class PrimBytes t => PrimArray t a | a -> t where     -- | Broadcast element into array-    broadcast :: t -> a+    --+    --   Warning: do not use this function at the call site; use `broadcast`+    --            instead. Otherwise you will miss some rewrite rules.+    broadcast# :: t -> a     -- | Index an array given an offset     ix# :: Int# -> a -> t+    ix# i = withArrayContent id (\_ off arr -> indexArray arr (off +# i))+    {-# INLINE ix# #-}     -- | Generate an array using an accumulator funtion     gen# :: CumulDims             -- ^ Dimensionality of the result array;@@ -92,17 +222,26 @@             --   types and is not checked at runtime.          -> Int# -> t -> a -> a -    -- | If the array represented as a single broadcasted value,-    --   return this value.-    --   Otherwise, return full array content:+    -- | If the array is represented as a single broadcasted value, return this+    --   this value. Otherwise, return the full array content:     --    @CumulDims@, array offset (elements), byte array with the content.-    arrayContent# :: a -> (# t | (# CumulDims, Int#, ByteArray# #) #)+    --+    --   Warning: never use this function directly. Use `withArrayContent` instead.+    --            There is a bug in GHC 8.6, such that certain optimizations+    --            (probably, instance specialization/rewrite rules) break the code,+    --            which is only observable at runtime. The effect is that the+    --            content of a `ByteArray#` becomes a garbage. The workaround is+    --            to use a non-inlinable wrapper to disable these optimizations.+    --            In addition, the wrapper function has some rewrite rules, which+    --            can potentially improve performance with other GHC versions.+    withArrayContent# :: forall (rep :: RuntimeRep) (r :: TYPE rep)+                       . (t -> r)+                      -> (CumulDims -> Int# -> ByteArray# -> r)+                      -> a -> r      -- | Offset of an array as a number of elements     offsetElems :: a -> Int#-    offsetElems a = case arrayContent# a of-      (# _ | #)             -> 0#-      (# | (# _, o, _ #) #) -> o+    offsetElems a = withArrayContent (\_ f -> f 0#) (const $ \o _ f -> f o) a (\i -> i)     {-# INLINE offsetElems #-}      -- | Normally, this returns a cumulative @totalDim@s.@@ -114,18 +253,25 @@     --   Note, this function returns the only unique element only if it is     --   a such by construction (there is no equality checks involved).     uniqueOrCumulDims :: a -> Either t CumulDims-    uniqueOrCumulDims a = case arrayContent# a of-      (# x | #)              -> Left x-      (# | (# cd, _, _ #) #) -> Right cd+    uniqueOrCumulDims = withArrayContent Left (\cd _ _ -> Right cd)     {-# INLINE uniqueOrCumulDims #-} -    -- | Get array by its offset and cumulative dims in a ByteArray.+    -- | Define an array by its offset and cumulative dims in a ByteArray.     --   Both offset and dims are given in element number (not in bytes).     ---    --   It is better to use this function instead of @fromBytes@ to avoid-    --   recalculating @CumulDims@ for implementations that require it.-    fromElems :: CumulDims -> Int# -> ByteArray# -> a+    --   Warning: never use this function directly. Use `fromElems` instead.+    --            There is a bug in GHC 8.6, such that certain optimizations+    --            (probably, instance specialization/rewrite rules) break the code,+    --            which is only observable at runtime. The effect is that the+    --            content of a `ByteArray#` becomes a garbage. The workaround is+    --            to use a non-inlinable wrapper to disable these optimizations.+    --            In addition, the wrapper function has some rewrite rules, which+    --            can potentially improve performance with other GHC versions.+    fromElems# :: CumulDims -> Int# -> ByteArray# -> a +{-# WARNING fromElems# "Please, use fromElems instead." #-}+{-# WARNING withArrayContent# "Please, use withArrayContent instead." #-}+ -- | Index array by an integer offset (starting from 0). ixOff :: PrimArray t a => Int -> a -> t ixOff (I# i) = ix# i@@ -138,3 +284,51 @@   where     f []     = (# [], x0 #)     f (x:xs) = (# xs, x #)++-- | If the array is represented as a single broadcasted value, return this+--   this value. Otherwise, return the full array content:+--    @CumulDims@, array offset (elements), byte array with the content.+withArrayContent :: forall (t :: Type) (a :: Type)+                           (rep :: RuntimeRep) (r :: TYPE rep)+                  . PrimArray t a+                 => (t -> r)+                 -> (CumulDims -> Int# -> ByteArray# -> r)+                 -> a -> r+withArrayContent = withArrayContent#+#if __GLASGOW_HASKELL__ == 806+{-# NOINLINE withArrayContent #-}+#else+{-# INLINE[1] withArrayContent #-}+#endif++-- | Define an array by its offset and cumulative dims in a ByteArray.+--   Both offset and dims are given in element number (not in bytes).+--+--   It is better to use this function instead of @fromBytes@ to avoid+--   recalculating @CumulDims@ for implementations that require it.+fromElems :: forall (t :: Type) (a :: Type)+           . PrimArray t a => CumulDims -> Int# -> ByteArray# -> a+fromElems = fromElems#+#if __GLASGOW_HASKELL__ == 806+{-# NOINLINE fromElems #-}+#else+{-# INLINE[1] fromElems #-}+#endif++-- | Broadcast element into array+broadcast :: forall (t :: Type) (a :: Type)+           . PrimArray t a => t -> a+broadcast = broadcast#+{-# INLINE[1] broadcast #-}++{-# RULES++"withArrayContent/id"+  withArrayContent broadcast fromElems = id++"withArrayContent+fromElems" forall f g cd off ba .+  withArrayContent f g (fromElems cd off ba) = g cd off ba++"withArrayContent+broadcast" forall f g e .+  withArrayContent f g (broadcast e) = f e+  #-}

@@ -2,14 +2,18 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts          #-} {-# LANGUAGE FlexibleInstances         #-}+{-# LANGUAGE InstanceSigs              #-} {-# LANGUAGE MagicHash                 #-} {-# LANGUAGE MultiParamTypeClasses     #-}+{-# LANGUAGE PatternSynonyms           #-} {-# LANGUAGE PolyKinds                 #-} {-# LANGUAGE ScopedTypeVariables       #-} {-# LANGUAGE TypeApplications          #-} {-# LANGUAGE TypeFamilies              #-} {-# LANGUAGE TypeInType                #-} {-# LANGUAGE TypeOperators             #-}+{-# LANGUAGE UndecidableInstances      #-}+{-# LANGUAGE ViewPatterns              #-} ----------------------------------------------------------------------------- -- | -- Module      :  Numeric.DataFrame.ST@@ -22,203 +26,344 @@  module Numeric.DataFrame.ST     ( STDataFrame (XSTFrame), SomeSTDataFrame (..)-    , newDataFrame, newPinnedDataFrame+    , castDataFrame+    , newDataFrame, newPinnedDataFrame, oneMoreDataFrame+    , subDataFrameView, subDataFrameView'     , copyDataFrame, copyMutableDataFrame     , copyDataFrame', copyMutableDataFrame'+    , copyDataFrameOff, copyMutableDataFrameOff     , freezeDataFrame, unsafeFreezeDataFrame-    , thawDataFrame, thawPinDataFrame, unsafeThawDataFrame+    , thawDataFrame, thawPinDataFrame, unsafeThawDataFrame, withThawDataFrame     , writeDataFrame, writeDataFrameOff     , readDataFrame, readDataFrameOff-    , isDataFramePinned+    , isDataFramePinned, getDataFrameSteps     ) where --import GHC.Base-import GHC.ST   (ST (..))+import GHC.ST (ST (..)) +import Data.Coerce+import Data.Kind import Numeric.DataFrame.Internal.Mutable import Numeric.DataFrame.Internal.PrimArray import Numeric.DataFrame.Type import Numeric.Dimensions+import Unsafe.Coerce   -- | Mutable DataFrame that lives in ST. --   Internal representation is always a MutableByteArray.-data family STDataFrame s (t :: Type) (ns :: [k])---- | Pure wrapper on a mutable byte array-newtype instance STDataFrame s t (ns :: [Nat]) = STDataFrame (MDataFrame s t (ns :: [Nat]))+newtype STDataFrame s (t :: Type) (ns :: [k]) = STDataFrame (MDataFrame s t (ns :: [k]))  -- | Data frame with some dimensions missing at compile time. --   Pattern-match against its constructor to get a Nat-indexed mutable data frame.-data instance STDataFrame s t (xs :: [XNat])-  = forall (ns :: [Nat]) . Dimensions ns-  => XSTFrame (STDataFrame s t ns)+pattern XSTFrame :: forall s  (t :: Type) (xns :: [XNat]) . ()+                 => forall (ns :: [Nat]) . (FixedDims xns ns, Dimensions ns)+                 => STDataFrame s t ns -> STDataFrame s t xns+pattern XSTFrame df <- (mkXSTFramePat -> XSTFramePat df)+  where+    XSTFrame = castDataFrame+{-# COMPLETE XSTFrame #-} +data XSTFramePat s (t :: Type) (xns :: [XNat])+  = forall (ns :: [Nat]) . (FixedDims xns ns, Dimensions ns)+  => XSTFramePat (STDataFrame s t ns)++mkXSTFramePat :: forall s  (t :: Type) (xns :: [XNat])+               . STDataFrame s t xns -> XSTFramePat s t xns+mkXSTFramePat df+  | SomeDims ds <- fromSteps (getDataFrameSteps df)+  , XDims (Dims :: Dims ns) <- (unsafeCoerce ds) :: Dims xns+    = XSTFramePat @s @t @xns @ns (unsafeCoerce df)+  | otherwise+    = error "XSTFrame pattern: impossible args"+ -- | Mutable DataFrame of unknown dimensionality data SomeSTDataFrame s (t :: Type)   = forall (ns :: [Nat]) . Dimensions ns => SomeSTDataFrame (STDataFrame s t ns) +-- | Allow coercing between @XNat@-indexed and @Nat@-indexed Mutable DataFrames.+castDataFrame ::+       forall (t :: Type) (xns :: [XNat]) (ns :: [Nat]) s+     . FixedDims xns ns+    => STDataFrame s t ns -> STDataFrame s t xns+castDataFrame = coerce (castDataFrame# @t @xns @ns)+{-# INLINE castDataFrame #-}+ -- | Create a new mutable DataFrame.-newDataFrame :: forall t (ns :: [Nat]) s-              . ( PrimBytes t, Dimensions ns)-             => ST s (STDataFrame s t ns)-newDataFrame = STDataFrame <$> ST (newDataFrame# @t @ns)+newDataFrame ::+       forall (t :: Type) ns s+     . (PrimBytes t, Dimensions ns) => ST s (STDataFrame s t ns)+newDataFrame = coerce (newDataFrame# @t @_ @ns) {-# INLINE newDataFrame #-} - -- | Create a new mutable DataFrame.-newPinnedDataFrame :: forall t (ns :: [Nat]) s-                    . ( PrimBytes t, Dimensions ns)-                   => ST s (STDataFrame s t ns)-newPinnedDataFrame = STDataFrame <$> ST (newPinnedDataFrame# @t @ns)+newPinnedDataFrame ::+       forall (t :: Type) ns s+     . (PrimBytes t, Dimensions ns) => ST s (STDataFrame s t ns)+newPinnedDataFrame = coerce (newPinnedDataFrame# @t @_ @ns) {-# INLINE newPinnedDataFrame #-} +-- | Create a new mutable DataFrame of the same size.+oneMoreDataFrame ::+       forall (t :: Type) ns s+     . STDataFrame s t ns -> ST s (STDataFrame s t ns)+oneMoreDataFrame = coerce (oneMoreDataFrame# @t @_ @ns)+{-# INLINE oneMoreDataFrame #-} +-- | View a part of a DataFrame.+--+--   This function does not perform a copy.+--   All changes to a new DataFrame will be reflected in the original DataFrame as well.+--+--   If any of the dims in @as@ or @b@ is unknown (@a ~ XN m@),+--   then this function is unsafe and can throw an `OutOfDimBounds` exception.+--   Otherwise, its safety is guaranteed by the type system.+subDataFrameView ::+       forall (t :: Type) b bi bd as bs asbs s+     . (SubFrameIndexCtx b bi bd, KnownDim bd, ConcatList as (b :+ bs) asbs)+    => Idxs (as +: bi) -> STDataFrame s t asbs -> STDataFrame s t (bd :+ bs)+subDataFrameView = coerce (subDataFrameView# @t @_ @b @bi @bd @as @bs @asbs)++-- | View a part of a DataFrame.+--+--   This function does not perform a copy.+--   All changes to a new DataFrame will be reflected in the original DataFrame as well.+--+--   This is a simpler version of @subDataFrameView@ that allows+--    to view over one index at a time.+--+--   If any of the dims in @as@ is unknown (@a ~ XN m@),+--   then this function is unsafe and can throw an `OutOfDimBounds` exception.+--   Otherwise, its safety is guaranteed by the type system.+subDataFrameView' ::+       forall (t :: Type) as bs asbs s+     . ConcatList as bs asbs+    => Idxs as -> STDataFrame s t asbs -> STDataFrame s t bs+subDataFrameView' = coerce (subDataFrameView'# @t @_ @as @bs @asbs)+ -- | Copy one DataFrame into another mutable DataFrame at specified position. -----   In contrast to @copyMDataFrame'@, this function allows to copy over a range of contiguous---   indices over a single dimension.+--   In contrast to @copyDataFrame'@, this function allows to copy over a range+--    of contiguous indices over a single dimension. --   For example, you can write a 3x4 matrix into a 7x4 matrix, starting at indices 0..3.-copyDataFrame :: forall (t :: Type)-                        (b :: Nat) (bi :: Nat) (bd :: Nat)-                        (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) s-               . ( b ~ (bi + bd - 1)-                 , PrimBytes t-                 , PrimBytes (DataFrame t (bd :+ bs))-                 , ConcatList as (b :+ bs) asbs-                 )-              => Idxs (as +: bi) -> DataFrame t (bd :+ bs)-              -> STDataFrame s t asbs -> ST s ()-copyDataFrame ei df (STDataFrame mdf) = ST (copyDataFrame# ei df mdf)+--+--   This function is safe (no `OutOfDimBounds` exception possible).+--   If any of the dims in @as@ is unknown (@a ~ XN m@),+--   you may happen to write data beyond dataframe bounds.+--   In this case, this function does nothing.+--   If (@b ~ XN m@) and (@Idx bi + Dim bd > Dim b@), this function copies only as+--   many elements as fits into the dataframe along this dimension (possibly none).+copyDataFrame ::+       forall (t :: Type) b bi bd as bs asbs s+     . ( SubFrameIndexCtx b bi bd, KnownDim bd, ExactDims bs+       , PrimArray t (DataFrame t (bd :+ bs))+       , ConcatList as (b :+ bs) asbs )+    => Idxs (as +: bi) -> DataFrame t (bd :+ bs) -> STDataFrame s t asbs -> ST s ()+copyDataFrame = coerce (copyDataFrame# @t @_ @b @bi @bd @as @bs @asbs) {-# INLINE copyDataFrame #-}  -- | Copy one mutable DataFrame into another mutable DataFrame at specified position. -----   In contrast to @copyMDataFrame'@, this function allows to copy over a range of contiguous---   indices over a single dimension.+--   In contrast to @copyMutableDataFrame'@, this function allows to copy over a range+--    of contiguous indices over a single dimension. --   For example, you can write a 3x4 matrix into a 7x4 matrix, starting at indices 0..3.-copyMutableDataFrame :: forall (t :: Type)-                               (b :: Nat) (bi :: Nat) (bd :: Nat)-                               (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) s-                      . ( b ~ (bi + bd - 1)-                        , PrimBytes t-                        , ConcatList as (b :+ bs) asbs-                        )-                     => Idxs (as +: bi) -> STDataFrame s t (bd :+ bs)-                     -> STDataFrame s t asbs -> ST s ()-copyMutableDataFrame ei (STDataFrame mdfA) (STDataFrame mdfB)-    = ST (copyMDataFrame# ei mdfA mdfB)+--+--   This function is safe (no `OutOfDimBounds` exception possible).+--   If any of the dims in @as@ is unknown (@a ~ XN m@),+--   you may happen to write data beyond dataframe bounds.+--   In this case, this function does nothing.+--   If (@b ~ XN m@) and (@Idx bi + Dim bd > Dim b@), this function copies only as+--   many elements as fits into the dataframe along this dimension (possibly none).+copyMutableDataFrame ::+       forall (t :: Type) b bi bd as bs asbs s+     . ( SubFrameIndexCtx b bi bd+       , ExactDims bs+       , PrimBytes t+       , ConcatList as (b :+ bs) asbs )+    => Idxs (as +: bi) -> STDataFrame s t (bd :+ bs) -> STDataFrame s t asbs -> ST s ()+copyMutableDataFrame = coerce (copyMDataFrame# @t @_ @b @bi @bd @as @bs @asbs) {-# INLINE copyMutableDataFrame #-}  -- | Copy one DataFrame into another mutable DataFrame at specified position. -----   This is a simpler version of @copyDataFrame@ that allows to copy over one index at a time.-copyDataFrame' :: forall (t :: Type)-                         (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) s-                . ( PrimBytes t-                  , PrimBytes (DataFrame t bs)-                  , ConcatList as bs asbs-                 )-               => Idxs as -> DataFrame t bs-               -> STDataFrame s t asbs -> ST s ()-copyDataFrame' ei df (STDataFrame mdf) = ST (copyDataFrame'# ei df mdf)+--   This is a simpler version of @copyDataFrame@ that allows+--     to copy over one index at a time.+--+--   This function is safe (no `OutOfDimBounds` exception possible).+--   If any of the dims in @as@ is unknown (@a ~ XN m@),+--   you may happen to write data beyond dataframe bounds.+--   In this case, this function does nothing.+copyDataFrame' ::+       forall (t :: Type) as bs asbs s+     . ( ExactDims bs+       , PrimArray t (DataFrame t bs)+       , ConcatList as bs asbs )+    => Idxs as -> DataFrame t bs -> STDataFrame s t asbs -> ST s ()+copyDataFrame' = coerce (copyDataFrame'# @t @_ @as @bs @asbs) {-# INLINE copyDataFrame' #-}  -- | Copy one mutable DataFrame into another mutable DataFrame at specified position. -----   This is a simpler version of @copyDataFrame@ that allows to copy over one index at a time.-copyMutableDataFrame' :: forall (t :: Type)-                                (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) s-                       . ( PrimBytes t-                         , ConcatList as bs asbs-                         )-                      => Idxs as -> STDataFrame s t bs-                      -> STDataFrame s t asbs -> ST s ()-copyMutableDataFrame' ei (STDataFrame mdfA) (STDataFrame mdfB)-  = ST (copyMDataFrame'# ei mdfA mdfB)+--   This is a simpler version of @copyMutableDataFrame@ that allows+--     to copy over one index at a time.+--+--   This function is safe (no `OutOfDimBounds` exception possible).+--   If any of the dims in @as@ is unknown (@a ~ XN m@),+--   you may happen to write data beyond dataframe bounds.+--   In this case, this function does nothing.+copyMutableDataFrame' ::+       forall (t :: Type) as bs asbs s+     . (ExactDims bs, PrimBytes t, ConcatList as bs asbs)+    => Idxs as -> STDataFrame s t bs -> STDataFrame s t asbs -> ST s ()+copyMutableDataFrame' = coerce (copyMDataFrame'# @t @_ @as @bs @asbs) {-# INLINE copyMutableDataFrame' #-} +-- | Copy one DataFrame into another mutable DataFrame by offset in+--   primitive elements.+--+--   This is a low-level copy function; you have to keep in mind the row-major+--   layout of Mutable DataFrames. Offset bounds are not checked.+--   You will get an undefined behavior if you write beyond the DataFrame bounds.+copyDataFrameOff ::+       forall (t :: Type) as bs asbs s+     . ( Dimensions bs+       , PrimArray t (DataFrame t bs)+       , ConcatList as bs asbs )+    => Int -> DataFrame t bs -> STDataFrame s t asbs -> ST s ()+copyDataFrameOff = coerce (copyDataFrameOff# @t @_ @as @bs @asbs)+{-# INLINE copyDataFrameOff #-}++-- | Copy one mutable DataFrame into another mutable DataFrame by offset in+--   primitive elements.+--+--   This is a low-level copy function; you have to keep in mind the row-major+--   layout of Mutable DataFrames. Offset bounds are not checked.+--   You will get an undefined behavior if you write beyond the DataFrame bounds+copyMutableDataFrameOff ::+       forall (t :: Type) as bs asbs s+     . (ExactDims bs, PrimBytes t, ConcatList as bs asbs)+    => Int -> STDataFrame s t bs -> STDataFrame s t asbs -> ST s ()+copyMutableDataFrameOff = coerce (copyMDataFrameOff# @t @_ @as @bs @asbs)+{-# INLINE copyMutableDataFrameOff #-}+ -- | Make a mutable DataFrame immutable, without copying.-unsafeFreezeDataFrame :: forall (t :: Type) (ns :: [Nat]) s-                       . PrimArray t (DataFrame t ns)-                      => STDataFrame s t ns -> ST s (DataFrame t ns)-unsafeFreezeDataFrame (STDataFrame mdf) = ST (unsafeFreezeDataFrame# mdf)+unsafeFreezeDataFrame ::+       forall (t :: Type) ns s+     . PrimArray t (DataFrame t ns)+    => STDataFrame s t ns -> ST s (DataFrame t ns)+unsafeFreezeDataFrame = coerce (unsafeFreezeDataFrame# @t @_ @ns) {-# INLINE unsafeFreezeDataFrame #-} - -- | Copy content of a mutable DataFrame into a new immutable DataFrame.-freezeDataFrame :: forall (t :: Type) (ns :: [Nat]) s-                 . PrimArray t (DataFrame t ns)-                => STDataFrame s t ns -> ST s (DataFrame t ns)-freezeDataFrame (STDataFrame mdf) = ST (freezeDataFrame# mdf)+freezeDataFrame ::+       forall (t :: Type) ns s+     . PrimArray t (DataFrame t ns)+    => STDataFrame s t ns -> ST s (DataFrame t ns)+freezeDataFrame = coerce (freezeDataFrame# @t @_ @ns) {-# INLINE freezeDataFrame #-}  -- | Create a new mutable DataFrame and copy content of immutable one in there.-thawDataFrame :: forall (t :: Type) (ns :: [Nat]) s-               . (Dimensions ns, PrimBytes (DataFrame t ns))-              => DataFrame t ns -> ST s (STDataFrame s t ns)-thawDataFrame df = STDataFrame <$> ST (thawDataFrame# df)+thawDataFrame ::+       forall (t :: Type) ns s+     . (Dimensions ns, PrimArray t (DataFrame t ns))+    => DataFrame t ns -> ST s (STDataFrame s t ns)+thawDataFrame = coerce (thawDataFrame# @t @_ @ns) {-# INLINE thawDataFrame #-}  -- | Create a new mutable DataFrame and copy content of immutable one in there. --   The result array is pinned and aligned.-thawPinDataFrame :: forall (t :: Type) (ns :: [Nat]) s-                  . (Dimensions ns, PrimBytes (DataFrame t ns))-                 => DataFrame t ns -> ST s (STDataFrame s t ns)-thawPinDataFrame df = STDataFrame <$> ST (thawPinDataFrame# df)+thawPinDataFrame ::+       forall (t :: Type) ns s+     . (Dimensions ns, PrimArray t (DataFrame t ns))+    => DataFrame t ns -> ST s (STDataFrame s t ns)+thawPinDataFrame = coerce (thawPinDataFrame# @t @_ @ns) {-# INLINE thawPinDataFrame #-}  -- | UnsafeCoerces an underlying byte array.-unsafeThawDataFrame :: forall (t :: Type) (ns :: [Nat]) s-                     . ( Dimensions ns-                       , PrimBytes (DataFrame t ns), PrimBytes t)-                    => DataFrame t ns -> ST s (STDataFrame s t ns)-unsafeThawDataFrame df = STDataFrame <$> ST (unsafeThawDataFrame# df)+unsafeThawDataFrame ::+       forall (t :: Type) ns s+     . (Dimensions ns, PrimArray t (DataFrame t ns))+    => DataFrame t ns+    -> ST s (STDataFrame s t ns)+unsafeThawDataFrame = coerce (unsafeThawDataFrame# @t @_ @ns) {-# INLINE unsafeThawDataFrame #-} ---- | Write a single element at the specified index-writeDataFrame :: forall t (ns :: [Nat]) s-                . PrimBytes t-               => STDataFrame s t ns -> Idxs ns -> DataFrame t ('[] :: [Nat]) -> ST s ()-writeDataFrame (STDataFrame mdf) ei = ST . writeDataFrame# mdf ei . unsafeCoerce#-{-# INLINE writeDataFrame #-}----- | Read a single element at the specified index-readDataFrame :: forall (t :: Type) (ns :: [Nat]) s-               . PrimBytes t-              => STDataFrame s t ns -> Idxs ns -> ST s (DataFrame t ('[] :: [Nat]))-readDataFrame (STDataFrame mdf) = unsafeCoerce# . ST . readDataFrame# mdf-{-# INLINE readDataFrame #-}-+-- | Given two continuations @f@ and @g@.+--   If the input DataFrame is a single broadcast value, use it in @f@.+--   Otherwise, create a new mutable DataFrame and copy content of immutable one+--   in there; then use it in @g@.+--+--   This function is useful when @thawDataFrame@ cannot be used due to+--   @Dimensions ns@ constraint being not available.+withThawDataFrame ::+       forall (t :: Type) ns r s+     . PrimArray t (DataFrame t ns)+    => (t -> ST s r)+    -> (STDataFrame s t ns -> ST s r)+    -> DataFrame t ns -> ST s r+withThawDataFrame = coerce (withThawDataFrame# @t @_ @ns @r) --- | Write a single element at the specified element offset-writeDataFrameOff :: forall (t :: Type) (ns :: [Nat]) s-                   . PrimBytes t-               => STDataFrame s t ns -> Int -> DataFrame t ('[] :: [Nat])  -> ST s ()-writeDataFrameOff (STDataFrame mdf) (I# i)-  = ST . writeDataFrameOff# mdf i . unsafeCoerce#+-- | Write a single element at the specified element offset.+--+--   This is a low-level write function; you have to keep in mind the row-major+--   layout of Mutable DataFrames. Offset bounds are not checked.+--   You will get an undefined behavior if you write beyond the DataFrame bounds.+writeDataFrameOff ::+       forall (t :: Type) ns s+     . PrimBytes (DataFrame t ('[] :: KindOf ns))+    => STDataFrame s t ns -> Int -> DataFrame t ('[] :: KindOf ns) -> ST s ()+writeDataFrameOff = coerce (writeDataFrameOff# @t @_ @ns) {-# INLINE writeDataFrameOff #-} +-- | Write a single element at the specified index.+--+--   This function is safe (no `OutOfDimBounds` exception possible).+--   If any of the dims in @ns@ is unknown (@n ~ XN m@),+--   you may happen to write data beyond dataframe bounds.+--   In this case, this function does nothing.+writeDataFrame ::+       forall (t :: Type) ns s+     . PrimBytes (DataFrame t ('[] :: KindOf ns))+    => STDataFrame s t ns -> Idxs ns -> DataFrame t ('[] :: KindOf ns) -> ST s ()+writeDataFrame = coerce (writeDataFrame# @t @_ @ns)+{-# INLINE writeDataFrame #-} --- | Read a single element at the specified element offset-readDataFrameOff :: forall (t :: Type) (ns :: [Nat]) s-                  . PrimBytes t-               => STDataFrame s t ns -> Int -> ST s (DataFrame t ('[] :: [Nat]))-readDataFrameOff (STDataFrame mdf) (I# i)-  = unsafeCoerce# (ST (readDataFrameOff# mdf i))+-- | Read a single element at the specified element offset.+--+--   This is a low-level read function; you have to keep in mind the row-major+--   layout of Mutable DataFrames. Offset bounds are not checked.+--   You will get an undefined behavior if you read beyond the DataFrame bounds.+readDataFrameOff ::+       forall (t :: Type) ns s+     . PrimBytes (DataFrame t ('[] :: KindOf ns))+    => STDataFrame s t ns -> Int -> ST s (DataFrame t ('[] :: KindOf ns))+readDataFrameOff = coerce (readDataFrameOff# @t @_ @ns) {-# INLINE readDataFrameOff #-} +-- | Read a single element at the specified index.+--+--   If any of the dims in @ns@ is unknown (@n ~ XN m@),+--   then this function is unsafe and can throw an `OutOfDimBounds` exception.+--   Otherwise, its safety is guaranteed by the type system.+readDataFrame ::+       forall (t :: Type) ns s+     . PrimBytes (DataFrame t ('[] :: KindOf ns))+    => STDataFrame s t ns -> Idxs ns -> ST s (DataFrame t ('[] :: KindOf ns))+readDataFrame = coerce (readDataFrame# @t @_ @ns)+{-# INLINE readDataFrame #-}  -- | Check if the byte array wrapped by this DataFrame is pinned, --   which means cannot be relocated by GC.-isDataFramePinned :: forall (k :: Type) (t :: Type) (ns :: [k]) s-                   . KnownDimKind k-                  => STDataFrame s t ns -> Bool-isDataFramePinned df = case dimKind @k of-    DimNat -> case df of-      STDataFrame x -> isDataFramePinned# x-    DimXNat -> case df of-      XSTFrame (STDataFrame x) -> isDataFramePinned# x+isDataFramePinned ::+       forall (t :: Type) ns s . STDataFrame s t ns -> Bool+isDataFramePinned = coerce (isDataFramePinned# @t @_ @ns)+{-# INLINE isDataFramePinned #-}++-- | Get cumulative dimensions @ns@ of a @STDataFrame s t ns@+getDataFrameSteps ::+       forall (t :: Type) ns s . STDataFrame s t ns -> CumulDims+getDataFrameSteps = coerce (getDataFrameSteps# @t @_ @ns)+{-# INLINE getDataFrameSteps #-}++_unusedTopBind :: STDataFrame s t ns+_unusedTopBind = STDataFrame undefined

@@ -1,503 +1,1265 @@-{-# LANGUAGE BangPatterns            #-}-{-# LANGUAGE DataKinds               #-}-{-# LANGUAGE FlexibleContexts        #-}-{-# LANGUAGE FlexibleInstances       #-}-{-# LANGUAGE FunctionalDependencies  #-}-{-# LANGUAGE MagicHash               #-}-{-# LANGUAGE MultiParamTypeClasses   #-}-{-# LANGUAGE ScopedTypeVariables     #-}-{-# LANGUAGE TypeApplications        #-}-{-# LANGUAGE TypeFamilies            #-}-{-# LANGUAGE TypeOperators           #-}-{-# LANGUAGE UnboxedTuples           #-}-{-# LANGUAGE UndecidableInstances    #-}-{-# LANGUAGE UndecidableSuperClasses #-}--------------------------------------------------------------------------------- |--- Module      :  Numeric.DataFrame.SubSpace--- Copyright   :  (c) Artem Chirkin--- License     :  BSD3--------------------------------------------------------------------------------------module Numeric.DataFrame.SubSpace-  ( SubSpace (..), (!), element-  , ewfoldMap, iwfoldMap-  , ewzip, iwzip-  , indexWise_, elementWise_-  ) where--import Data.Kind-import GHC.Exts--import Numeric.DataFrame.Internal.PrimArray-import Numeric.DataFrame.Type-import Numeric.Dimensions-import Numeric.PrimBytes----- | Operations on DataFrames------ @as@ is an indexing dimensionality------ @bs@ is an element dimensionality------ @t@ is an underlying data type (i.e. Float, Int, Double)----class ( ConcatList as bs asbs-      , Dimensions as-      , Dimensions bs-      , Dimensions asbs-      , PrimArray t (DataFrame t bs)-      , PrimArray t (DataFrame t asbs)-      , PrimBytes   (DataFrame t bs)-      , PrimBytes   (DataFrame t asbs)-      ) => SubSpace (t :: Type) (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat])-                    | asbs as -> bs, asbs bs -> as, as bs -> asbs where--    -- | Unsafely get a sub-dataframe by its primitive element offset.-    --   The offset is not checked to be aligned to the space structure or for bounds.-    --   Arguments are zero-based primitive element offset and subset ("bs" element)-    --   size (aka `totalDim` of sub dataframe)-    ---    --   Normal indexing can be expressed in terms of `indexOffset#`:-    ---    --   > index i = case (# dimVal (dim @bs), fromEnum i #) of (# I# n, I# j #) -> indexOffset# (n *# j)-    indexOffset# :: Int# -- ^ Prim element offset-                 -> DataFrame t asbs -> DataFrame t bs-    indexOffset# off df = case uniqueOrCumulDims df of-      Left a      -> broadcast a-      Right steps -> fromElems (dropPref (dims @as) steps) (offsetElems df +# off) (getBytes df)-    {-# INLINE [1] indexOffset# #-}--    -- | Unsafely update a sub-dataframe by its primitive element offset.-    --   The offset is not checked to be aligned to the space structure or for bounds.-    --   Arguments are zero-based primitive element offset and subset ("bs" element)-    --   size (aka `totalDim` of sub dataframe)-    ---    --   Normal updating can be expressed in terms of `indexOffset#`:-    ---    --   > update i = case (# dimVal (dim @bs), fromEnum i #) of (# I# n, I# j #) -> updateOffset# (n *# j)-    updateOffset# :: Int# -- ^ Prim element offset-                  -> DataFrame t bs -> DataFrame t asbs -> DataFrame t asbs-    updateOffset# off x df-      | steps <- getSteps (dims @asbs) df-      , elemBS <- byteSize @t undefined = case runRW#-        ( \s0 -> case newByteArray# (cdTotalDim# steps *# elemBS) s0 of-          (# s1, mba #) -> unsafeFreezeByteArray# mba-            ( writeBytes mba (off *# elemBS) x-              ( writeBytes mba 0# df s1 )-            )-        ) of (# _, r #) -> fromElems steps 0# r-    {-# INLINE [1] updateOffset# #-}--    -- | Get an element by its index in the dataframe-    index :: Idxs as -> DataFrame t asbs -> DataFrame t bs-    index i df = case uniqueOrCumulDims df of-      Left a      -> broadcast a-      Right steps -> case cdIx steps i of-        I# off -> fromElems (dropPref (dims @as) steps) (offsetElems df +# off) (getBytes df)-    {-# INLINE [1] index #-}--    -- | Get a few contiguous elements.-    ---    --   In a sense, this is just a more complicated version of `index`.-    slice :: forall (bi :: Nat) (bd :: Nat) (b' :: Nat) (bs' :: [Nat])-           . ( b' ~ (bi + bd - 1), bs ~ (b' :+ bs'), KnownDim bd)-          => Idxs (as +: bi) -> DataFrame t asbs -> DataFrame t (bd :+ bs')-    slice  i df-      | _ :* Dims <- dims @bs-      , Dict <- inferKnownBackend @t @(bd ': bs')-        = case uniqueOrCumulDims df of-        Left a      -> broadcast a-        Right steps -> case cdIx steps i of-          I# off-            | bsteps <- repHead (dimVal' @bd) (dropPref (dims @as) steps)-              -> fromElems bsteps (offsetElems df +# off) (getBytes df)-      | otherwise = error "SubSpace/slice: impossible arguments"-      where-        repHead y (CumulDims (_:x:xs)) = CumulDims (y*x:x:xs)-        repHead _ steps                = steps--    -- | Set a new value to an element-    update :: Idxs as -> DataFrame t bs -> DataFrame t asbs -> DataFrame t asbs-    update i x df-      | steps <- getSteps (dims @asbs) df-      , I# off <- cdIx steps i-      , elemBS <- byteSize @t undefined = case runRW#-        ( \s0 -> case newByteArray# (cdTotalDim# steps *# elemBS) s0 of-          (# s1, mba #) -> unsafeFreezeByteArray# mba-            ( writeBytes mba (off *# elemBS) x-              ( writeBytes mba 0# df s1 )-            )-        ) of (# _, r #) -> fromElems steps 0# r-    {-# INLINE [1] update #-}--    -- | Update a few contiguous elements-    ---    --   In a sense, this is just a more complicated version of `update`.-    updateSlice :: forall (bi :: Nat) (bd :: Nat) (b' :: Nat) (bs' :: [Nat])-           . ( b' ~ (bi + bd - 1), bs ~ (b' :+ bs'), KnownDim bd)-          => Idxs (as +: bi) -> DataFrame t (bd :+ bs') -> DataFrame t asbs -> DataFrame t asbs-    updateSlice i x df-      | _ :* Dims <- dims @bs-      , Dict <- inferKnownBackend @t @(bd ': bs')-      , steps <- getSteps (dims @asbs) df-      , I# off <- cdIx steps i-      , elemBS <- byteSize @t undefined = case runRW#-        ( \s0 -> case newByteArray# (cdTotalDim# steps *# elemBS) s0 of-          (# s1, mba #) -> unsafeFreezeByteArray# mba-            ( writeBytes mba (off *# elemBS) x-              ( writeBytes mba 0# df s1 )-            )-        ) of (# _, r #) -> fromElems steps 0# r-      | otherwise = error "SubSpace/updateSlice: impossible arguments"-    {-# INLINE [1] updateSlice #-}--    -- | Map a function over each element of DataFrame-    ewmap  :: forall s (bs' :: [Nat]) (asbs' :: [Nat])-            . SubSpace s as bs' asbs'-           => (DataFrame s bs' -> DataFrame t bs)-           -> DataFrame s asbs' -> DataFrame t asbs-    ewmap f df-      | bsizeT    <- byteSize @t undefined-      , stepsAS   <- cumulDims $ dims @as-      , stepsBS   <- cumulDims $ dims @bs-      , stepsBS'  <- cumulDims $ dims @bs'-      , stepsASBS <- stepsAS <> stepsBS-      , lenAS     <- cdTotalDim# stepsAS-      , lenBS     <- cdTotalDim# stepsBS-      , lenBS'    <- cdTotalDim# stepsBS'-      , lenBSB    <- lenBS *# bsizeT-      , lenASBSB  <- lenAS *# lenBSB-      = let go mba sourceOffE destOffB s-              | isTrue# (destOffB >=# lenASBSB)-                = s-              | otherwise-                = go mba (sourceOffE +# lenBS') (destOffB +# lenBSB)-                     (writeBytes mba destOffB (f (indexOffset# sourceOffE df)) s)-        in  case runRW#-          ( \s0 -> case newByteArray# lenASBSB s0 of-            (# s1, mba #) -> unsafeFreezeByteArray# mba ( go mba 0# 0# s1 )-          ) of (# _, r #) -> fromElems stepsASBS 0# r-    {-# INLINE [1] ewmap #-}--    -- | Map a function over each element with its index of DataFrame-    iwmap  :: forall s (bs' :: [Nat]) (asbs' :: [Nat])-            . SubSpace s as bs' asbs'-           => (Idxs as -> DataFrame s bs' -> DataFrame t bs)-           -> DataFrame s asbs' -> DataFrame t asbs-    iwmap f df-      | bsizeT    <- byteSize @t undefined-      , stepsAS   <- cumulDims $ dims @as-      , stepsBS   <- cumulDims $ dims @bs-      , stepsBS'  <- cumulDims $ dims @bs'-      , stepsASBS <- stepsAS <> stepsBS-      , lenAS     <- cdTotalDim# stepsAS-      , lenBS     <- cdTotalDim# stepsBS-      , lenBS'    <- cdTotalDim# stepsBS'-      , lenBSB    <- lenBS *# bsizeT-      , lenASBSB  <- lenAS *# lenBSB-      = let go _ [] _ _ s = s-            go mba (i:is) sourceOffE destOffB s-                = go mba is (sourceOffE +# lenBS') (destOffB +# lenBSB)-                     (writeBytes mba destOffB (f i (indexOffset# sourceOffE df)) s)-        in  case runRW#-          ( \s0 -> case newByteArray# lenASBSB s0 of-            (# s1, mba #) -> unsafeFreezeByteArray# mba ( go mba [minBound..maxBound] 0# 0# s1 )-          ) of (# _, r #) -> fromElems stepsASBS 0# r-    {-# INLINE [1] iwmap #-}--    -- | Generate a DataFrame by repeating an element-    ewgen :: DataFrame t bs -> DataFrame t asbs-    ewgen df = case uniqueOrCumulDims df of-      Left a -> broadcast a-      Right stepsBS-        | stepsAS <- cumulDims $ dims @as-        , stepsASBS <- stepsAS <> stepsBS-        , elS       <- byteSize @t undefined-        , lenBSB    <- cdTotalDim# stepsBS *# elS-        , lenASBSB  <- cdTotalDim# stepsASBS *# elS-          -> let go mba destOffB s-                   | isTrue# (destOffB >=# lenASBSB)-                     = s-                   | otherwise-                     = go mba (destOffB +# lenBSB)-                          (writeBytes mba destOffB df s)-             in  case runRW#-              ( \s0 -> case newByteArray# lenASBSB s0 of-                (# s1, mba #) -> unsafeFreezeByteArray# mba ( go mba 0# s1 )-              ) of (# _, r #) -> fromElems stepsASBS 0# r-    {-# INLINE [1] ewgen #-}--    -- | Generate a DataFrame by iterating a function (index -> element)-    iwgen :: (Idxs as -> DataFrame t bs) -> DataFrame t asbs-    iwgen f-        | stepsAS <- cumulDims $ dims @as-        , stepsBS <- cumulDims $ dims @bs-        , stepsASBS <- stepsAS <> stepsBS-        , elS       <- byteSize @t undefined-        , lenBSB    <- cdTotalDim# stepsBS *# elS-        , lenASBSB  <- cdTotalDim# stepsASBS *# elS-          = let go _ [] _ s = s-                go mba (i:is) destOffB s-                  = go mba is (destOffB +# lenBSB) (writeBytes mba destOffB (f i) s)-            in  case runRW#-              ( \s0 -> case newByteArray# lenASBSB s0 of-                (# s1, mba #) -> unsafeFreezeByteArray# mba ( go mba [minBound..maxBound] 0# s1 )-              ) of (# _, r #) -> fromElems stepsASBS 0# r-    {-# INLINE [1] iwgen #-}--    -- | Left-associative fold of a DataFrame.-    --   The fold is strict, so accumulater is evaluated to WHNF;-    --   but you'd better make sure that the function is strict enough to not-    --   produce memory leaks deeply inside the result data type.-    ewfoldl :: (b -> DataFrame t bs -> b) -> b -> DataFrame t asbs -> b-    ewfoldl f x0 df = case uniqueOrCumulDims df of-      Left a ->-        let b = broadcast a-            go 0 x = x-            go n x = go (n-1) $! f x b-        in  go (totalDim' @as) x0-      Right stepsASBS-        | stepsBS <- dropPref (dims @as) stepsASBS-        , lenBS   <- cdTotalDim# stepsBS-        , lenASBS <- cdTotalDim# stepsASBS-          -> let go sourceOffE x-                  | isTrue# (sourceOffE >=# lenASBS)-                    = x-                  | otherwise-                    = go (sourceOffE +# lenBS) $! f x (indexOffset# sourceOffE df)-             in  go 0# x0--    -- | Left-associative fold of a DataFrame with an index-    --   The fold is strict, so accumulater is evaluated to WHNF;-    --   but you'd better make sure that the function is strict enough to not-    --   produce memory leaks deeply inside the result data type.-    iwfoldl :: (Idxs as -> b -> DataFrame t bs -> b) -> b -> DataFrame t asbs -> b-    iwfoldl f x0 df = case uniqueOrCumulDims df of-      Left a ->-        let b = broadcast a-            go [] x     = x-            go (i:is) x = go is $! f i x b-        in  go [minBound..maxBound] x0-      Right stepsASBS-        | stepsBS <- dropPref (dims @as) stepsASBS-        , lenBS   <- cdTotalDim# stepsBS-          -> let go [] _ x = x-                 go (i:is) sourceOffE x-                    = go is (sourceOffE +# lenBS) $! f i x (indexOffset# sourceOffE df)-             in  go [minBound..maxBound] 0# x0--    -- | Right-associative fold of a DataFrame-    --   The fold is strict, so accumulater is evaluated to WHNF;-    --   but you'd better make sure that the function is strict enough to not-    --   produce memory leaks deeply inside the result data type.-    ewfoldr :: (DataFrame t bs -> b -> b) -> b -> DataFrame t asbs -> b-    ewfoldr f x0 df = case uniqueOrCumulDims df of-      Left a ->-        let b = broadcast a-            go 0 x = x-            go n x = go (n-1) $! f b x-        in  go (totalDim' @as) x0-      Right stepsASBS-        | stepsBS <- dropPref (dims @as) stepsASBS-        , lenBS   <- cdTotalDim# stepsBS-        , lenASBS <- cdTotalDim# stepsASBS-          -> let go sourceOffE x-                  | isTrue# (sourceOffE <# 0#)-                    = x-                  | otherwise-                    = go (sourceOffE -# lenBS) $! f (indexOffset# sourceOffE df) x-             in  go (lenASBS -# lenBS) x0--    -- | Right-associative fold of a DataFrame with an index-    --   The fold is strict, so accumulater is evaluated to WHNF;-    --   but you'd better make sure that the function is strict enough to not-    --   produce memory leaks deeply inside the result data type.-    iwfoldr :: (Idxs as -> DataFrame t bs -> b -> b) -> b -> DataFrame t asbs -> b-    iwfoldr f x0 df = case uniqueOrCumulDims df of-      Left a ->-        let b = broadcast a-            go [] x     = x-            go (i:is) x = go is $! f i b x-        in  go [maxBound, pred maxBound .. minBound] x0-      Right stepsASBS-        | stepsBS <- dropPref (dims @as) stepsASBS-        , lenBS   <- cdTotalDim# stepsBS-        , lenASBS <- cdTotalDim# stepsASBS-          -> let go [] _ x = x-                 go (i:is) sourceOffE x-                    = go is (sourceOffE -# lenBS) $! f i (indexOffset# sourceOffE df) x-             in  go [maxBound, pred maxBound .. minBound] (lenASBS -# lenBS) x0--    -- | Apply an applicative functor on each element (Lens-like traversal)-    elementWise :: forall (s :: Type) (bs' :: [Nat]) (asbs' :: [Nat]) (f :: Type -> Type)-                 . ( Applicative f-                   , SubSpace s as bs' asbs'-                   )-                => (DataFrame s bs' -> f (DataFrame t bs))-                -> DataFrame s asbs' -> f (DataFrame t asbs)-    elementWise = indexWise . const-    {-# INLINE [1] elementWise #-}--    -- | Apply an applicative functor on each element with its index-    --     (Lens-like indexed traversal)-    indexWise :: forall (s :: Type) (bs' :: [Nat]) (asbs' :: [Nat]) (f :: Type -> Type)-               . ( Applicative f-                 , SubSpace s as bs' asbs'-                 )-              => (Idxs as -> DataFrame s bs' -> f (DataFrame t bs))-              -> DataFrame s asbs' -> f (DataFrame t asbs)-    indexWise f df = runWithState <$> iwfoldl applyF (pure initialState) df-      where-        steps = cumulDims $ dims @asbs-        -- run a state-based continuation within RW-        runWithState :: ( State# RealWorld -> (# State# RealWorld, (# MutableByteArray# RealWorld, Int# #) #))-                     -> DataFrame t asbs-        runWithState g = case runRW#-                           ( \s0 -> case g s0 of-                                (# s1, (# marr, _ #) #) -> unsafeFreezeByteArray# marr s1-                           ) of (# _, arr #) -> fromElems steps 0# arr--        -- Prepare empty byte array for the result DataFrame and keep a current position counter-        -- Input: state-        -- Output: state +-        --     ( current mutable byte array + current write position )-        initialState :: State# RealWorld -> (# State# RealWorld, (# MutableByteArray# RealWorld, Int# #) #)-        initialState s0 = case newByteArray# (rezLength# *# rezElBSize#) s0 of-                            (# s1, marr #) -> (# s1, (# marr, 0# #) #)--        -- Given the result chunk, write it into a mutable array-        updateChunk :: (State# RealWorld -> (# State# RealWorld, (# MutableByteArray# RealWorld, Int# #) #))-                    -> DataFrame t bs-                    -> (State# RealWorld -> (# State# RealWorld, (# MutableByteArray# RealWorld, Int# #) #))-        updateChunk g dfChunk = case (# byteOffset dfChunk, getBytes dfChunk #) of-            (# off#, arr#  #) -> \s -> case g s of-                                        (# s1, (# marr#, pos# #) #) -> case-                                            copyByteArray# arr# (off# *# rezElBSize#)-                                                           marr# (pos# *# rezElBSize#)-                                                           (rezStepN# *# rezElBSize#) s1 of-                                          s2 -> (# s2, (# marr#, pos# +# rezStepN# #) #)--        -- Apply applicative functor on each chunk and update a state.-        applyF :: Idxs as-               -> f (State# RealWorld -> (# State# RealWorld, (# MutableByteArray# RealWorld, Int# #) #))-               -> DataFrame s bs'-               -> f (State# RealWorld -> (# State# RealWorld, (# MutableByteArray# RealWorld, Int# #) #))-        applyF idx s dfChunk = idx `seq` dfChunk `seq` updateChunk <$> s <*> f idx dfChunk--        -- Element byte size of the result DataFrame (byte size of s)-        rezElBSize# = byteSize @t undefined-        -- Number of primitive elements in the result DataFrame chunk-        !(I# rezStepN#) = fromIntegral $ totalDim' @bs-        -- Number of primitive elements in the result DataFrame-        rezLength# = cdTotalDim# steps------ | Apply an applicative functor on each element with its index---     (Lens-like indexed traversal)-indexWise_ :: forall t as bs asbs f b-            . (SubSpace t as bs asbs, Applicative f)-           => (Idxs as -> DataFrame t bs -> f b)-           -> DataFrame t asbs -> f ()-indexWise_ f = iwfoldr (\i -> (*>) . f i) (pure ())---- | Apply an applicative functor on each element (Lens-like traversal)-elementWise_ :: forall t as bs asbs f b-              . (SubSpace t as bs asbs, Applicative f)-             => (DataFrame t bs -> f b)-             -> DataFrame t asbs -> f ()-elementWise_ f = ewfoldr ((*>) . f) (pure ())----- | Apply a functor over a single element (simple lens)-element :: forall t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) f-         . (SubSpace t as bs asbs, Applicative f)-        => Idxs as-        -> (DataFrame t bs -> f (DataFrame t bs))-        -> DataFrame t asbs -> f (DataFrame t asbs)-element i f df = flip (update i) df <$> f (index i df)-{-# INLINE element #-}---- | Index an element (reverse arguments of `index`)-(!) :: SubSpace t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat])-    => DataFrame t asbs -> Idxs as -> DataFrame t bs-(!) = flip index-{-# INLINE (!) #-}-infixl 4 !----ewfoldMap :: forall t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) m-           . (Monoid m, SubSpace t as bs asbs)-          => (DataFrame t bs -> m) -> DataFrame t asbs -> m-ewfoldMap f = ewfoldl (\m b -> m `seq` (mappend m $! f b)) mempty-{-# INLINE ewfoldMap #-}--iwfoldMap :: forall t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) m-           . ( Monoid m, SubSpace t as bs asbs)-          => (Idxs as -> DataFrame t bs -> m) -> DataFrame t asbs -> m-iwfoldMap f = iwfoldl (\i m b -> m `seq` (mappend m $! f i b)) mempty-{-# INLINE iwfoldMap #-}------ | Zip two spaces on a specified subspace index-wise (with index)-iwzip :: forall t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat])-                s (bs' :: [Nat]) (asbs' :: [Nat])-                r (bs'' :: [Nat]) (asbs'' :: [Nat])-       . ( SubSpace t as bs asbs-         , SubSpace s as bs' asbs'-         , SubSpace r as bs'' asbs''-         )-      => (Idxs as -> DataFrame t bs -> DataFrame s bs' -> DataFrame r bs'')-      -> DataFrame t asbs-      -> DataFrame s asbs'-      -> DataFrame r asbs''-iwzip f dft dfs = iwmap g dft-  where-    g i dft' = f i dft' (index i dfs)-{-# INLINE iwzip #-}---- | Zip two spaces on a specified subspace element-wise (without index)-ewzip :: forall t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat])-                s (bs' :: [Nat]) (asbs' :: [Nat])-                r (bs'' :: [Nat]) (asbs'' :: [Nat])-       . ( SubSpace t as bs asbs-         , SubSpace s as bs' asbs'-         , SubSpace r as bs'' asbs''-         )-      => (DataFrame t bs -> DataFrame s bs' -> DataFrame r bs'')-      -> DataFrame t asbs-      -> DataFrame s asbs'-      -> DataFrame r asbs''-ewzip = iwzip . const-{-# INLINE ewzip #-}---instance ( ConcatList as bs asbs-         , Dimensions as-         , Dimensions bs-         , Dimensions asbs-         , PrimArray t (DataFrame t bs)-         , PrimArray t (DataFrame t asbs)-         , PrimBytes   (DataFrame t bs)-         , PrimBytes   (DataFrame t asbs)-         ) => SubSpace t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) where----dropPref :: Dims (ns :: [Nat]) -> CumulDims -> CumulDims-dropPref ds = CumulDims . drop (length $ listDims ds) . unCumulDims---unSc :: DataFrame (t :: Type) ('[] :: [Nat]) -> t-unSc = unsafeCoerce#--{-# RULES-"ewgen/broadcast" ewgen = broadcast . unSc--  #-}+{-# LANGUAGE AllowAmbiguousTypes     #-}+{-# LANGUAGE DataKinds               #-}+{-# LANGUAGE FlexibleContexts        #-}+{-# LANGUAGE FlexibleInstances       #-}+{-# LANGUAGE FunctionalDependencies  #-}+{-# LANGUAGE InstanceSigs            #-}+{-# LANGUAGE MagicHash               #-}+{-# LANGUAGE MultiParamTypeClasses   #-}+{-# LANGUAGE PolyKinds               #-}+{-# LANGUAGE RankNTypes              #-}+{-# LANGUAGE ScopedTypeVariables     #-}+{-# LANGUAGE TypeApplications        #-}+{-# LANGUAGE TypeFamilies            #-}+{-# LANGUAGE TypeOperators           #-}+{-# LANGUAGE UndecidableInstances    #-}+{-# LANGUAGE UndecidableSuperClasses #-}+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}+{- |+Module      :  Numeric.DataFrame.SubSpace+Copyright   :  (c) Artem Chirkin+License     :  BSD3++This module provides a flexible interface to manipulate parts of a DataFrame.++==== A note on indexing and slicing++When you index or slice dataframes, the left part of the dimension list+(@as@ for indexing, plus @b@ for slicing) determines the mechanics of accessing+sub-dataframes.+If compiler knows all dimensions at compile time, it can guarantee that the+operation is safe (provided with valid indices).+Otherwise, you can get an `OutOfDimBounds` exception at runtime.++When all dimensions in the indexing subspace satisfy @d :: Nat@ or @d ~ N n@,+slicing functions are safe to use, but you need some type-level proof for GHC+that the indices align.++When any of the dimensions are unknown (@d ~ XN m@), these functions are unsafe+-- they can yield an `OutOfDimBounds` exception if you give a bad index.+But they are easy to use (no type-level proof needed).++ -}++module Numeric.DataFrame.SubSpace+  ( -- $indexingSafety+    -- * Class definition+    SubSpace (SubSpaceCtx), CanSlice+    -- * Simple interface+    --+    --   All functions in this section are named @sxxx@, where @s@ stands for+    --   "simple". These allow using all functions of `SubSpace` with indexing+    --   dimensionality @as@ fixed to a single dim @(as ~ '[a])@.+    --   Use these functions if you are tired of @TypeApplications@ or find the+    --   error messages too cryptic.+  , sindexOffset, supdateOffset+  , (.!), slookup, supdate, sslice, ssliceMaybe, supdateSlice+  , sewgen, siwgen, sewmap, siwmap, sewzip, siwzip+  , selement, selementWise, selementWise_, sindexWise, sindexWise_+  , sewfoldl, sewfoldl', sewfoldr, sewfoldr', sewfoldMap+  , siwfoldl, siwfoldl', siwfoldr, siwfoldr', siwfoldMap+    -- * Flexible interface+    --+    --   Functions in this section allow you pick, fold, iterate, or do whatever+    --   you want with arbitrary sub-dataframe dimensionalities:+    --   e.g. a DataFrame of rank 3 can be processed as an 1D array of matrices+    --   or a matrix of vectors, or a 3D array of scalars.+    --   Often, you would need @TypeApplications@ to specify explicitly at least+    --   the indexing subspace (parameter @as@).+  , joinDataFrame, indexOffset, updateOffset+  , index, Numeric.DataFrame.SubSpace.lookup+  , update, slice, sliceMaybe, updateSlice+  , ewgen, iwgen, ewmap, iwmap, ewzip, iwzip+  , element, elementWise, elementWise_, indexWise, indexWise_+  , ewfoldl, ewfoldl', ewfoldr, ewfoldr', ewfoldMap+  , iwfoldl, iwfoldl', iwfoldr, iwfoldr', iwfoldMap+  ) where++import           Control.Arrow                        (first)+import           Control.Monad+import           Control.Monad.ST+import           Data.Kind+import           GHC.Base                             (Int (..), (+#))+import           Numeric.DataFrame.Internal.PrimArray+import           Numeric.DataFrame.ST+import           Numeric.DataFrame.Type+import           Numeric.Dimensions+import qualified Numeric.TypedList                    as TL+import           Unsafe.Coerce++-- | Unsafely get a sub-dataframe by its primitive element offset.+--   The offset is not checked to be aligned to the space structure or for bounds.+--+--   Warning: this function is utterly unsafe -- it does not even throw an exception if+--            the offset is too big; you just get an undefined behavior.+sindexOffset ::+       forall t a bs+     . SubSpace t '[a] bs (a :+ bs)+    => Int -- ^ Prim element offset+    -> DataFrame t (a :+ bs) -> DataFrame t bs+sindexOffset = indexOffset @t @'[a] @bs @(a :+ bs)+{-# INLINE sindexOffset #-}++-- | Unsafely update a sub-dataframe by its primitive element offset.+--   The offset is not checked to be aligned to the space structure or for bounds.+--+--   Warning: this function is utterly unsafe -- it does not even throw an exception if+--            the offset is too big; you just get an undefined behavior.+supdateOffset ::+       forall t a bs+     . SubSpace t '[a] bs (a :+ bs)+    => Int -- ^ Prim element offset+    -> DataFrame t bs -> DataFrame t (a :+ bs) -> DataFrame t (a :+ bs)+supdateOffset = updateOffset @t @'[a] @bs @(a :+ bs)+{-# INLINE supdateOffset #-}++-- | Get an element by its index in the dataframe.+--+--   If (@a ~ XN m@) then this function is unsafe and can throw+--   an `OutOfDimBounds` exception.+--   Otherwise, its safety is guaranteed by the type system.+(.!) ::+       forall t a bs+     . SubSpace t '[a] bs (a :+ bs)+    => DataFrame t (a :+ bs) -> Idx a -> DataFrame t bs+(.!) x i = index @t @'[a] @bs @(a :+ bs) (i :* U) x+{-# INLINE (.!) #-}+infixl 4 .!++-- | Set a new value to an element.+--+--   If (@a ~ XN m@) and the index falls outside of the DataFrame dim,+--   then this function returns the original DataFrame.+supdate ::+       forall t a bs+     . SubSpace t '[a] bs (a :+ bs)+    => Idx a -> DataFrame t bs -> DataFrame t (a :+ bs) -> DataFrame t (a :+ bs)+supdate = update @t @'[a] @bs @(a :+ bs) . (:*U)+{-# INLINE[1] supdate #-}++-- | Map a function over each element of DataFrame.+sewmap ::+       forall t a bs s bs'+     . (SubSpace t '[a] bs (a :+ bs), SubSpace s '[a] bs' (a :+ bs'))+    => (DataFrame s bs' -> DataFrame t bs)+    -> DataFrame s (a :+ bs') -> DataFrame t (a :+ bs)+sewmap = ewmap @t @'[a] @bs @(a :+ bs) @s @bs' @(a :+ bs')+{-# INLINE sewmap #-}++-- | Map a function over each element with its index of DataFrame.+siwmap ::+       forall t a bs s bs'+     . (SubSpace t '[a] bs (a :+ bs), SubSpace s '[a] bs' (a :+ bs'))+    => (Idx a -> DataFrame s bs' -> DataFrame t bs)+    -> DataFrame s (a :+ bs') -> DataFrame t (a :+ bs)+siwmap f = iwmap @t @'[a] @bs @(a :+ bs) @s @bs' @(a :+ bs') (\(i :* U) -> f i)+{-# INLINE[1] siwmap #-}++-- | Generate a DataFrame by repeating an element.+sewgen ::+       forall t a bs+     . (SubSpace t '[a] bs (a :+ bs), Dimensions '[a])+    => DataFrame t bs -> DataFrame t (a :+ bs)+sewgen = ewgen @t @'[a] @bs @(a :+ bs)+{-# INLINE sewgen #-}++-- | Generate a DataFrame by iterating a function (index -> element).+siwgen ::+       forall t a bs+     . (SubSpace t '[a] bs (a :+ bs), Dimensions '[a])+    => (Idx a -> DataFrame t bs) -> DataFrame t (a :+ bs)+siwgen f = iwgen @t @'[a] @bs @(a :+ bs) (\(i :* U) -> f i)+{-# INLINE[1] siwgen #-}++-- | Left-associative lazy fold of a DataFrame.+--   Same rules apply as for `foldl`.+sewfoldl ::+       forall t a bs b+     . SubSpace t '[a] bs (a :+ bs)+    => (b -> DataFrame t bs -> b) -> b -> DataFrame t (a :+ bs) -> b+sewfoldl = ewfoldl @t @'[a] @bs @(a :+ bs) @b+{-# INLINE sewfoldl #-}++-- | Left-associative strict fold of a DataFrame.+--   Same rules apply as for `foldl'`.+sewfoldl' ::+       forall t a bs b+     . SubSpace t '[a] bs (a :+ bs)+    => (b -> DataFrame t bs -> b) -> b -> DataFrame t (a :+ bs) -> b+sewfoldl' = ewfoldl' @t @'[a] @bs @(a :+ bs) @b+{-# INLINE sewfoldl' #-}++-- | Left-associative lazy fold of a DataFrame with an index.+--   Same rules apply as for `foldl`.+siwfoldl ::+       forall t a bs b+     . SubSpace t '[a] bs (a :+ bs)+    => (Idx a -> b -> DataFrame t bs -> b) -> b -> DataFrame t (a :+ bs) -> b+siwfoldl f = iwfoldl @t @'[a] @bs @(a :+ bs) @b (\(i :* U) -> f i)+{-# INLINE[1] siwfoldl #-}++-- | Left-associative strict fold of a DataFrame with an index.+--   Same rules apply as for `foldl'`.+siwfoldl' ::+       forall t a bs b+     . SubSpace t '[a] bs (a :+ bs)+    => (Idx a -> b -> DataFrame t bs -> b) -> b -> DataFrame t (a :+ bs) -> b+siwfoldl' f = iwfoldl' @t @'[a] @bs @(a :+ bs) @b (\(i :* U) -> f i)+{-# INLINE[1] siwfoldl' #-}++-- | Right-associative lazy fold of a DataFrame.+--   Same rules apply as for `foldr`.+sewfoldr ::+       forall t a bs b+     . SubSpace t '[a] bs (a :+ bs)+    => (DataFrame t bs -> b -> b) -> b -> DataFrame t (a :+ bs) -> b+sewfoldr = ewfoldr @t @'[a] @bs @(a :+ bs) @b+{-# INLINE sewfoldr #-}++-- | Right-associative strict fold of a DataFrame.+--   Same rules apply as for `foldr'`.+sewfoldr' ::+       forall t a bs b+     . SubSpace t '[a] bs (a :+ bs)+    => (DataFrame t bs -> b -> b) -> b -> DataFrame t (a :+ bs) -> b+sewfoldr' = ewfoldr' @t @'[a] @bs @(a :+ bs) @b+{-# INLINE sewfoldr' #-}++-- | Right-associative lazy fold of a DataFrame with an index.+--   Same rules apply as for `foldr`.+siwfoldr ::+       forall t a bs b+     . SubSpace t '[a] bs (a :+ bs)+    => (Idx a -> DataFrame t bs -> b -> b) -> b -> DataFrame t (a :+ bs) -> b+siwfoldr f = iwfoldr @t @'[a] @bs @(a :+ bs) @b (\(i :* U) -> f i)+{-# INLINE[1] siwfoldr #-}++-- | Right-associative strict fold of a DataFrame with an index.+--   Same rules apply as for `foldr'`.+siwfoldr' ::+       forall t a bs b+     . SubSpace t '[a] bs (a :+ bs)+    => (Idx a -> DataFrame t bs -> b -> b) -> b -> DataFrame t (a :+ bs) -> b+siwfoldr' f = iwfoldr' @t @'[a] @bs @(a :+ bs) @b (\(i :* U) -> f i)+{-# INLINE[1] siwfoldr' #-}++-- | Apply an applicative functor on each element (Lens-like traversal).+selementWise ::+       forall t a bs s bs' f+     . (SubSpace t '[a] bs (a :+ bs), SubSpace s '[a] bs' (a :+ bs'), Applicative f)+    => (DataFrame s bs' -> f (DataFrame t bs))+    -> DataFrame s (a :+ bs') -> f (DataFrame t (a :+ bs))+selementWise = elementWise @t @'[a] @bs @(a :+ bs) @s @bs' @(a :+ bs') @f+{-# INLINE selementWise #-}++-- | Apply an applicative functor on each element with its index+--     (Lens-like indexed traversal).+sindexWise ::+       forall t a bs s bs' f+     . (SubSpace t '[a] bs (a :+ bs), SubSpace s '[a] bs' (a :+ bs'), Applicative f)+    => (Idx a -> DataFrame s bs' -> f (DataFrame t bs))+    -> DataFrame s (a :+ bs') -> f (DataFrame t (a :+ bs))+sindexWise f = indexWise @t @'[a] @bs @(a :+ bs) @s @bs' @(a :+ bs') @f (\(i :* U) -> f i)+{-# INLINE[1] sindexWise #-}++-- | Apply an applicative functor on each element (Lens-like traversal)+selementWise_ ::+       forall t a bs f b+     . (SubSpace t '[a] bs (a :+ bs), Applicative f)+    => (DataFrame t bs -> f b) -> DataFrame t (a :+ bs) -> f ()+selementWise_ = elementWise_ @t @'[a] @bs @(a :+ bs) @f @b+{-# INLINE selementWise_ #-}++-- | Apply an applicative functor on each element with its index+--     (Lens-like indexed traversal)+sindexWise_ ::+       forall t a bs f b+    . (SubSpace t '[a] bs (a :+ bs), Applicative f)+   => (Idx a -> DataFrame t bs -> f b) -> DataFrame t (a :+ bs) -> f ()+sindexWise_ f = indexWise_ @t @'[a] @bs @(a :+ bs) @f @b (\(i :* U) -> f i)+{-# INLINE sindexWise_ #-}++-- | Apply a functor over a single element (simple lens)+--+--   If (@a ~ XN m@) and the index falls outside of the DataFrame Dim, the+--   argument Functor is not called and the result is @pure@ original DataFrame.+selement ::+       forall t a bs f+     . (SubSpace t '[a] bs (a :+ bs), Applicative f)+    => Idx a+    -> (DataFrame t bs -> f (DataFrame t bs))+    -> DataFrame t (a :+ bs) -> f (DataFrame t (a :+ bs))+selement = element @t @'[a] @bs @(a :+ bs) @f . (:* U)+{-# INLINE selement #-}++-- | Map each element of the DataFrame to a monoid,+--    and combine the results.+sewfoldMap ::+       forall t a bs m+     . (SubSpace t '[a] bs (a :+ bs), Monoid m)+    => (DataFrame t bs -> m) -> DataFrame t (a :+ bs) -> m+sewfoldMap = ewfoldMap @t @'[a] @bs @(a :+ bs) @m+{-# INLINE sewfoldMap #-}++-- | Map each element of the DataFrame and its index to a monoid,+--    and combine the results.+siwfoldMap ::+       forall t a bs m+     . (SubSpace t '[a] bs (a :+ bs), Monoid m)+    => (Idx a -> DataFrame t bs -> m) -> DataFrame t (a :+ bs) -> m+siwfoldMap f = iwfoldMap @t @'[a] @bs @(a :+ bs) @m (\(i :* U) -> f i)+{-# INLINE[1] siwfoldMap #-}++-- | Zip two spaces on a specified subspace element-wise (without index)+sewzip ::+       forall t a bs l bsL r bsR+     . (SubSpace t '[a] bs (a :+ bs), SubSpace l '[a] bsL (a :+ bsL), SubSpace r '[a] bsR (a :+ bsR))+    => (DataFrame l bsL -> DataFrame r bsR -> DataFrame t bs)+    -> DataFrame l (a :+ bsL) -> DataFrame r (a :+ bsR) -> DataFrame t (a :+ bs)+sewzip = ewzip @t @'[a] @bs @(a :+ bs) @l @bsL @(a :+ bsL) @r @bsR @(a :+ bsR)+{-# INLINE sewzip #-}++-- | Zip two spaces on a specified subspace index-wise (with index)+siwzip ::+       forall t a bs l bsL r bsR+     . (SubSpace t '[a] bs (a :+ bs), SubSpace l '[a] bsL (a :+ bsL), SubSpace r '[a] bsR (a :+ bsR))+    => (Idx a -> DataFrame l bsL -> DataFrame r bsR -> DataFrame t bs)+    -> DataFrame l (a :+ bsL) -> DataFrame r (a :+ bsR) -> DataFrame t (a :+ bs)+siwzip f = iwzip @t @'[a] @bs @(a :+ bs) @l @bsL @(a :+ bsL) @r @bsR @(a :+ bsR) (\(i :* U) -> f i)+{-# INLINE siwzip #-}++-- | Flatten a nested DataFrame, analogous to `Control.Monad.join`.+joinDataFrame ::+       forall t as bs asbs+     . (SubSpace t as bs asbs, PrimBytes (DataFrame t bs))+    => DataFrame (DataFrame t bs) as -> DataFrame t asbs+joinDataFrame = joinDataFrameI @_ @t @as @bs @asbs+{-# INLINE[1] joinDataFrame #-}++-- | Unsafely get a sub-dataframe by its primitive element offset.+--   The offset is not checked to be aligned to the space structure or for bounds.+--+--   Warning: this function is utterly unsafe -- it does not even throw an exception if+--            the offset is too big; you just get an undefined behavior.+indexOffset ::+       forall t as bs asbs+     . SubSpace t as bs asbs+    => Int -- ^ Prim element offset+    -> DataFrame t asbs -> DataFrame t bs+indexOffset = indexOffsetI @_ @t @as @bs @asbs+{-# INLINE[1] indexOffset #-}++-- | Unsafely update a sub-dataframe by its primitive element offset.+--   The offset is not checked to be aligned to the space structure or for bounds.+--+--   Warning: this function is utterly unsafe -- it does not even throw an exception if+--            the offset is too big; you just get an undefined behavior.+updateOffset ::+       forall t as bs asbs+     . SubSpace t as bs asbs+    => Int -- ^ Prim element offset+    -> DataFrame t bs -> DataFrame t asbs -> DataFrame t asbs+updateOffset = updateOffsetI @_ @t @as @bs @asbs+{-# INLINE[1] updateOffset #-}++-- | Get an element by its index in the dataframe.+--+--   If any of the dims in @as@ is unknown (@a ~ XN m@),+--   then this function is unsafe and can throw an `OutOfDimBounds` exception.+--   Otherwise, its safety is guaranteed by the type system.+index ::+       forall t as bs asbs+     . SubSpace t as bs asbs+    => Idxs as -> DataFrame t asbs -> DataFrame t bs+index = indexI @_ @t @as @bs @asbs+{-# INLINE[1] index #-}++-- | Set a new value to an element.+--+--   If any of the dims in @as@ is unknown (@a ~ XN m@),+--   you may happen to update data beyond dataframe bounds.+--   In this case, the original DataFrame is returned.+update ::+       forall t as bs asbs+     . SubSpace t as bs asbs+    => Idxs as -> DataFrame t bs -> DataFrame t asbs -> DataFrame t asbs+update = updateI @_ @t @as @bs @asbs+{-# INLINE[1] update #-}++-- | Map a function over each element of DataFrame.+ewmap ::+       forall t as bs asbs s bs' asbs'+     . (SubSpace t as bs asbs, SubSpace s as bs' asbs')+    => (DataFrame s bs' -> DataFrame t bs)+    -> DataFrame s asbs' -> DataFrame t asbs+ewmap = ewmapI @_ @t @as @bs @asbs @s @bs' @asbs'+{-# INLINE[1] ewmap #-}++-- | Map a function over each element with its index of DataFrame.+iwmap ::+       forall t as bs asbs s bs' asbs'+     . (SubSpace t as bs asbs, SubSpace s as bs' asbs')+    => (Idxs as -> DataFrame s bs' -> DataFrame t bs)+    -> DataFrame s asbs' -> DataFrame t asbs+iwmap = iwmapI @_ @t @as @bs @asbs @s @bs' @asbs'+{-# INLINE[1] iwmap #-}++-- | Generate a DataFrame by repeating an element.+ewgen ::+       forall t as bs asbs+     . (SubSpace t as bs asbs, Dimensions as)+    => DataFrame t bs -> DataFrame t asbs+ewgen = ewgenI @_ @t @as @bs @asbs+{-# INLINE[1] ewgen #-}++-- | Generate a DataFrame by iterating a function (index -> element).+iwgen ::+       forall t as bs asbs+     . (SubSpace t as bs asbs, Dimensions as)+    => (Idxs as -> DataFrame t bs) -> DataFrame t asbs+iwgen = iwgenI @_ @t @as @bs @asbs+{-# INLINE[1] iwgen #-}++-- | Left-associative lazy fold of a DataFrame.+--   Same rules apply as for `foldl`.+ewfoldl ::+       forall t as bs asbs b+     . SubSpace t as bs asbs+    => (b -> DataFrame t bs -> b) -> b -> DataFrame t asbs -> b+ewfoldl = ewfoldlI @_ @t @as @bs @asbs @b+{-# INLINE[1] ewfoldl #-}++-- | Left-associative strict fold of a DataFrame.+--   Same rules apply as for `foldl'`.+ewfoldl' ::+       forall t as bs asbs b+     . SubSpace t as bs asbs+    => (b -> DataFrame t bs -> b) -> b -> DataFrame t asbs -> b+ewfoldl' f z0 xs = ewfoldr f' id xs z0+  where+    f' x k z = k $! f z x+{-# INLINE ewfoldl' #-}++-- | Left-associative lazy fold of a DataFrame with an index.+--   Same rules apply as for `foldl`.+iwfoldl ::+       forall t as bs asbs b+     . SubSpace t as bs asbs+    => (Idxs as -> b -> DataFrame t bs -> b) -> b -> DataFrame t asbs -> b+iwfoldl = iwfoldlI @_ @t @as @bs @asbs @b+{-# INLINE[1] iwfoldl #-}++-- | Left-associative strict fold of a DataFrame with an index.+--   Same rules apply as for `foldl'`.+iwfoldl' ::+       forall t as bs asbs b+     . SubSpace t as bs asbs+    => (Idxs as -> b -> DataFrame t bs -> b) -> b -> DataFrame t asbs -> b+iwfoldl' f z0 xs = iwfoldr f' id xs z0+  where+    f' i x k z = k $! f i z x+{-# INLINE[1] iwfoldl' #-}++-- | Right-associative lazy fold of a DataFrame.+--   Same rules apply as for `foldr`.+ewfoldr ::+       forall t as bs asbs b+     . SubSpace t as bs asbs+    => (DataFrame t bs -> b -> b) -> b -> DataFrame t asbs -> b+ewfoldr = ewfoldrI @_ @t @as @bs @asbs @b+{-# INLINE[1] ewfoldr #-}++-- | Right-associative strict fold of a DataFrame.+--   Same rules apply as for `foldr'`.+ewfoldr' ::+       forall t as bs asbs b+     . SubSpace t as bs asbs+    => (DataFrame t bs -> b -> b) -> b -> DataFrame t asbs -> b+ewfoldr' f z0 xs = ewfoldl f' id xs z0+  where+    f' k x z = k $! f x z+{-# INLINE ewfoldr' #-}++-- | Right-associative lazy fold of a DataFrame with an index.+--   Same rules apply as for `foldr`.+iwfoldr ::+       forall t as bs asbs b+     . SubSpace t as bs asbs+    => (Idxs as -> DataFrame t bs -> b -> b) -> b -> DataFrame t asbs -> b+iwfoldr = iwfoldrI @_ @t @as @bs @asbs @b+{-# INLINE[1] iwfoldr #-}++-- | Right-associative strict fold of a DataFrame with an index.+--   Same rules apply as for `foldr'`.+iwfoldr' ::+       forall t as bs asbs b+     . SubSpace t as bs asbs+    => (Idxs as -> DataFrame t bs -> b -> b) -> b -> DataFrame t asbs -> b+iwfoldr' f z0 xs = iwfoldl f' id xs z0+  where+    f' i k x z = k $! f i x z+{-# INLINE[1] iwfoldr' #-}++-- | Apply an applicative functor on each element (Lens-like traversal).+elementWise ::+       forall t as bs asbs s bs' asbs' f+     . (SubSpace t as bs asbs, SubSpace s as bs' asbs', Applicative f)+    => (DataFrame s bs' -> f (DataFrame t bs))+    -> DataFrame s asbs' -> f (DataFrame t asbs)+elementWise = elementWiseI @_ @t @as @bs @asbs @s @bs' @asbs' @f+{-# INLINE[1] elementWise #-}++-- | Apply an applicative functor on each element with its index+--     (Lens-like indexed traversal).+indexWise ::+       forall t as bs asbs s bs' asbs' f+     . (SubSpace t as bs asbs, SubSpace s as bs' asbs', Applicative f)+    => (Idxs as -> DataFrame s bs' -> f (DataFrame t bs))+    -> DataFrame s asbs' -> f (DataFrame t asbs)+indexWise = indexWiseI @_ @t @as @bs @asbs @s @bs' @asbs' @f+{-# INLINE[1] indexWise #-}++-- | Apply an applicative functor on each element (Lens-like traversal)+elementWise_ ::+       forall t as bs asbs f b+     . (SubSpace t as bs asbs, Applicative f)+    => (DataFrame t bs -> f b) -> DataFrame t asbs -> f ()+elementWise_ f = ewfoldr ((*>) . f) (pure ())+{-# INLINE elementWise_ #-}++-- | Apply an applicative functor on each element with its index+--     (Lens-like indexed traversal)+indexWise_ ::+       forall t as bs asbs f b+    . (SubSpace t as bs asbs, Applicative f)+   => (Idxs as -> DataFrame t bs -> f b) -> DataFrame t asbs -> f ()+indexWise_ f = iwfoldr (\i -> (*>) . f i) (pure ())+{-# INLINE indexWise_ #-}++-- | Apply a functor over a single element (simple lens)+--+--   If any of the dims in @as@ is unknown (@a ~ XN m@) and any of the+--   corresponding indices fall outside of the DataFrame Dims, then the+--   argument Functor is not called and the result is @pure@ original DataFrame.+element ::+       forall t as bs asbs f+     . (SubSpace t as bs asbs, Applicative f)+    => Idxs as+    -> (DataFrame t bs -> f (DataFrame t bs))+    -> DataFrame t asbs -> f (DataFrame t asbs)+element i f df = case dimKind @(KindOfEl asbs) of+  DimKNat -> flip (update i) df <$> f (index i df)+  DimKXNat+    | XFrame (dfN :: DataFrame t asbsN) <- df+    , Just off <- cdIxM (getSteps (dims @asbsN) dfN) i+      -> flip (updateOffset off) df <$> f (indexOffset off df)+    | otherwise+      -> pure df+{-# INLINE element #-}+++-- | Map each element of the DataFrame to a monoid,+--    and combine the results.+ewfoldMap ::+       forall t as bs asbs m+     . (SubSpace t as bs asbs, Monoid m)+    => (DataFrame t bs -> m) -> DataFrame t asbs -> m+ewfoldMap f = ewfoldr (mappend . f) mempty+{-# INLINE ewfoldMap #-}++-- | Map each element of the DataFrame and its index to a monoid,+--    and combine the results.+iwfoldMap ::+       forall t as bs asbs m+     . (SubSpace t as bs asbs, Monoid m)+    => (Idxs as -> DataFrame t bs -> m) -> DataFrame t asbs -> m+iwfoldMap f = iwfoldr (\i -> mappend . f i) mempty+{-# INLINE iwfoldMap #-}++-- | Zip two spaces on a specified subspace element-wise (without index)+ewzip :: forall t as bs asbs l bsL asbsL r bsR asbsR+     . (SubSpace t as bs asbs, SubSpace l as bsL asbsL, SubSpace r as bsR asbsR)+    => (DataFrame l bsL -> DataFrame r bsR -> DataFrame t bs)+    -> DataFrame l asbsL -> DataFrame r asbsR -> DataFrame t asbs+ewzip = iwzip . const+{-# INLINE ewzip #-}++-- | Zip two spaces on a specified subspace index-wise (with index).+iwzip :: forall t as bs asbs l bsL asbsL r bsR asbsR+     . (SubSpace t as bs asbs, SubSpace l as bsL asbsL, SubSpace r as bsR asbsR)+    => (Idxs as -> DataFrame l bsL -> DataFrame r bsR -> DataFrame t bs)+    -> DataFrame l asbsL -> DataFrame r asbsR -> DataFrame t asbs+iwzip f dfl dfr = case dimKind @(KindOfEl asbs) of+  DimKNat -> iwmap (\i x -> f i x (index i dfr)) dfl+  DimKXNat+    | XFrame (_ :: DataFrame l asbsLN) <- dfl+    , XFrame (_ :: DataFrame r asbsRN) <- dfr+    , asbs <- unsafeCoerce -- minimum spans+        $ zipWith min (listDims $ dims @asbsLN) (listDims $ dims @asbsRN) :: Dims asbs+    , bs <- (dims :: Dims bs)+    , as <- (dropSufDims bs asbs :: Dims as)+      -> withLiftedConcatList @'Nothing @('Just (DimsBound bs)) @'Nothing as bs asbs $+          \(Dims :: Dims asn) (Dims :: Dims bsn) (Dims :: Dims asbsn) -> case () of+            _ | Dict <- inferKnownBackend @t @asbsn+              , Dict <- inferKnownBackend @t @bsn+             -> XFrame (iwgen @t @asn @bsn @asbsn+                         (\iN -> let i = liftIdxs iN+                                 in  unliftXFrame (f i (index i dfl) (index i dfr))+                         )+                       )+{-# INLINE iwzip #-}++-- | DataFrames indexed by Nats and XNats require slightly different sets of+--   constraints to be sliced.+--   This family hides the difference, so that I could write one function for+--   both kinds.+type family CanSlice (t :: Type) (asbs :: [k])  :: Constraint where+  CanSlice t (asbs :: [Nat])+    = ( PrimArray t (DataFrame t asbs), Dimensions asbs )+  CanSlice t (asbs :: [XNat])+    = ( )++-- | Get a few contiguous elements.+--+--   In a sense, this is just a more complicated version of `sindex`.+--+--   If (@b ~ XN m@) then this function is unsafe and can throw+--   an `OutOfDimBounds` exception.+--   Otherwise, its safety is guaranteed by the type system.+sslice ::+       forall t b bi bd bs+     . ( KnownDimKind (KindOfEl bs)+       , CanSlice t (b :+ bs)+       , SubFrameIndexCtx b bi bd, KnownDim bd+       , PrimArray t (DataFrame t (bd :+ bs)))+    => Idx bi -> DataFrame t (b :+ bs) -> DataFrame t (bd :+ bs)+sslice = slice @t @b @bi @bd @'[] @bs @(b :+ bs) . (:* U)+{-# INLINE[1] sslice #-}++-- | Update a few contiguous elements.+--+--   In a sense, this is just a more complicated version of `supdate`.+--+--   If (@b ~ XN m@) and (@Idx bi + Dim bd > Dim b@), this function updates only as+--   many elements as fits into the dataframe along this dimension (possibly none).+supdateSlice ::+       forall t b bi bd bs+     . ( KnownDimKind (KindOfEl bs)+       , CanSlice t (b :+ bs)+       , SubFrameIndexCtx b bi bd+       , KnownDim bd, ExactDims bs+       , PrimArray t (DataFrame t (bd :+ bs)))+    => Idx bi -> DataFrame t (bd :+ bs)+    -> DataFrame t (b :+ bs) -> DataFrame t (b :+ bs)+supdateSlice = updateSlice @t @b @bi @bd @'[] @bs @(b :+ bs) . (:* U)+{-# INLINE[1] supdateSlice #-}++-- | Get a few contiguous elements.+--+--   In a sense, this is just a more complicated version of `index`.+--+--   If any of the dims in @as@ or @b@ is unknown (@a ~ XN m@),+--   then this function is unsafe and can throw an `OutOfDimBounds` exception.+--   Otherwise, its safety is guaranteed by the type system.+slice ::+       forall (t :: Type) b bi bd as bs asbs+     . ( KnownDimKind (KindOfEl asbs)+       , CanSlice t asbs+       , SubFrameIndexCtx b bi bd, KnownDim bd+       , ConcatList as (b :+ bs) asbs+       , PrimArray t (DataFrame t (bd :+ bs)))+    => Idxs (as +: bi) -> DataFrame t asbs -> DataFrame t (bd :+ bs)+slice i = case dimKind @(KindOfEl asbs) of+  DimKNat+    -> withArrayContent broadcast+    (\steps off0 ba ->+      let (off, bsteps) = getOffAndStepsSub (I# off0) steps i (dim @bd)+      in fromElems bsteps (case off of I# o -> o) ba+    )+  DimKXNat+    -> \(XFrame (df :: DataFrame t asbsN)) -> withArrayContent broadcast+    (\steps off0 ba ->+      let (off, bsteps) = getOffAndStepsSub (I# off0) steps i (dim @bd)+      in fromElems bsteps (case off of I# o -> o) ba+    ) df+{-# INLINE[1] slice #-}++-- | Update a few contiguous elements.+--+--   In a sense, this is just a more complicated version of `update`.+--+--   If any of the dims in @as@ is unknown (@a ~ XN m@),+--   you may happen to update data beyond dataframe bounds.+--   In this case, the original DataFrame is returned.+--   If (@b ~ XN m@) and (@Idx bi + Dim bd > Dim b@), this function updates only as+--   many elements as fits into the dataframe along this dimension (possibly none).+updateSlice ::+       forall (t :: Type) b bi bd as bs asbs+     . ( KnownDimKind (KindOfEl asbs)+       , CanSlice t asbs+       , SubFrameIndexCtx b bi bd+       , KnownDim bd, ExactDims bs+       , ConcatList as (b :+ bs) asbs+       , PrimArray t (DataFrame t (bd :+ bs)))+    => Idxs (as +: bi) -> DataFrame t (bd :+ bs)+    -> DataFrame t asbs -> DataFrame t asbs+updateSlice i bdbsDf asbsDf = case dimKind @(KindOfEl asbs) of+  DimKNat -> runST $ do+      asbsM <- thawDataFrame asbsDf+      copyDataFrame i bdbsDf asbsM+      unsafeFreezeDataFrame asbsM+  DimKXNat+    | (XFrame (asbsDfN :: DataFrame t asbsN)) <- asbsDf -> runST $ do+      asbsM <- thawDataFrame @t @asbsN asbsDfN+      copyDataFrame i bdbsDf (castDataFrame @t @asbs asbsM)+      XFrame <$> unsafeFreezeDataFrame asbsM+{-# INLINE[1] updateSlice #-}+++-- | Get an element by its index in the dataframe.+--   This is a safe alternative to `(.!)` function when the index dimension+--   is not known at compile time (@a ~ XN m@).+slookup ::+       forall t (a :: XNat) (bs :: [XNat])+     . (All KnownDimType bs, PrimBytes t)+    => Idx a -> DataFrame t (a :+ bs) -> Maybe (DataFrame t bs)+slookup = Numeric.DataFrame.SubSpace.lookup @t @'[a] @bs @(a :+ bs) . (:*U)+{-# INLINE slookup #-}++-- | Get an element by its index in the dataframe.+--   This is a safe alternative to `index` function when some of the dimensions+--   are not known at compile time (@d ~ XN m@).+lookup ::+       forall t (as :: [XNat]) (bs :: [XNat]) (asbs :: [XNat])+     . (ConcatList as bs asbs, All KnownDimType bs, PrimBytes t)+    => Idxs as -> DataFrame t asbs -> Maybe (DataFrame t bs)+lookup i (XFrame (df :: DataFrame t asbsN))+  | asbsN <- dims @asbsN+  , Just off <- cdIxM (getSteps asbsN df) i+  , asbs <- XDims asbsN :: Dims asbs+  , (as, bs) <- prefSufDims i asbs+    = withLiftedConcatList @'Nothing @'Nothing @('Just asbsN) as bs asbs $+        \(Dims :: Dims asn) (Dims :: Dims bsn) (_ :: Dims asbsn)+          -> case inferKnownBackend @t @bsn of+            Dict -> Just (XFrame (indexOffset @t @asn @bsn @asbsn off df))+  | otherwise = Nothing+{-# INLINE lookup #-}++-- | Get a few contiguous elements.+--+--   In a sense, this is just a more complicated version of `slookup`.+--+--   This is a safe alternative to `sslice` function when the slice dimension+--   is not known at compile time (@b ~ XN m@).+ssliceMaybe ::+       forall (t :: Type) (b :: XNat) (bi :: XNat) (bd :: XNat) (bs :: [XNat])+     . ( SubFrameIndexCtx b bi bd, KnownDim bd+       , All KnownDimType bs, PrimBytes t)+    => Idx bi -> DataFrame t (b :+ bs) -> Maybe (DataFrame t (bd :+ bs))+ssliceMaybe = sliceMaybe @t @b @bi @bd @'[] @bs @(b :+ bs) . (:* U)+{-# INLINE ssliceMaybe #-}+++-- | Get a few contiguous elements.+--+--   In a sense, this is just a more complicated version of `lookup`.+--+--   This is a safe alternative to `slice` function when some of the dimensions+--   are not known at compile time (@d ~ XN m@).+sliceMaybe ::+       forall (t :: Type) (b :: XNat) bi bd as bs asbs+     . ( SubFrameIndexCtx b bi bd, KnownDim bd+       , ConcatList as (b :+ bs) asbs+       , All KnownDimType bs, PrimBytes t)+    => Idxs (as +: bi) -> DataFrame t asbs -> Maybe (DataFrame t (bd :+ bs))+sliceMaybe i (XFrame (df :: DataFrame t asbsN))+  | asbsN <- dims @asbsN+  , bd <- dim @bd+  , Dict <- ( withKnownXDim @bd Dict+      :: Dict (KnownDim (DimBound bd), KnownDimType bd, FixedDim bd (DimBound bd)))+  , Just (I# off0, bsteps@(CumulDims (bbN:bN:_)))+      <- getOffAndStepsSubM 0 (getSteps asbsN df) i bd+  , bbN == bN * dimVal bd -- is there enough elements?+  , asbs <- XDims asbsN :: Dims asbs+  , XDims (Dims :: Dims bsN) <-+      unsafeCoerce (dropSome (listIdxs i) (listDims asbs)) :: Dims bs+  , Dict <- inferKnownBackend @t @(DimBound bd ': bsN)+    = Just $ XFrame @_ @t @(bd :+ bs) @(DimBound bd ': bsN)+              (withArrayContent broadcast+                (\_ off -> fromElems bsteps (off0 +# off)) df)+  | otherwise = Nothing+{-# INLINE sliceMaybe #-}+++-- | Operations on DataFrames+--+-- @as@ is an indexing dimensionality+--+-- @bs@ is an element dimensionality+--+-- @t@ is an underlying data type (i.e. Float, Int, Double)+--+class ( ConcatList as bs asbs+      , SubSpaceCtx t as bs asbs+      , PrimBytes t+      , KnownDimKind k+      ) => SubSpace (t :: Type) (as :: [k]) (bs :: [k]) (asbs :: [k])+                    | asbs as -> bs, asbs bs -> as, as bs -> asbs where+    type SubSpaceCtx t as bs asbs :: Constraint++    joinDataFrameI :: PrimBytes (DataFrame t bs)+                   => DataFrame (DataFrame t bs) as -> DataFrame t asbs+    indexOffsetI :: Int -> DataFrame t asbs -> DataFrame t bs+    updateOffsetI :: Int -> DataFrame t bs -> DataFrame t asbs -> DataFrame t asbs+    indexI :: Idxs as -> DataFrame t asbs -> DataFrame t bs+    updateI :: Idxs as -> DataFrame t bs -> DataFrame t asbs -> DataFrame t asbs+    ewmapI  :: forall s (bs' :: [k]) (asbs' :: [k])+             . SubSpace s as bs' asbs'+            => (DataFrame s bs' -> DataFrame t bs)+            -> DataFrame s asbs' -> DataFrame t asbs+    iwmapI  :: forall s (bs' :: [k]) (asbs' :: [k])+             . SubSpace s as bs' asbs'+            => (Idxs as -> DataFrame s bs' -> DataFrame t bs)+            -> DataFrame s asbs' -> DataFrame t asbs+    ewgenI :: Dimensions as => DataFrame t bs -> DataFrame t asbs+    iwgenI :: Dimensions as => (Idxs as -> DataFrame t bs) -> DataFrame t asbs+    ewfoldlI :: (b -> DataFrame t bs -> b) -> b -> DataFrame t asbs -> b+    iwfoldlI :: (Idxs as -> b -> DataFrame t bs -> b) -> b -> DataFrame t asbs -> b+    ewfoldrI :: (DataFrame t bs -> b -> b) -> b -> DataFrame t asbs -> b+    iwfoldrI :: (Idxs as -> DataFrame t bs -> b -> b) -> b -> DataFrame t asbs -> b+    elementWiseI :: forall (s :: Type) (bs' :: [k]) (asbs' :: [k]) (f :: Type -> Type)+                  . (Applicative f, SubSpace s as bs' asbs')+                 => (DataFrame s bs' -> f (DataFrame t bs))+                 -> DataFrame s asbs' -> f (DataFrame t asbs)+    elementWiseI = indexWiseI . const+    {-# INLINE elementWiseI #-}+    indexWiseI :: forall (s :: Type) (bs' :: [k]) (asbs' :: [k]) (f :: Type -> Type)+                . (Applicative f, SubSpace s as bs' asbs')+               => (Idxs as -> DataFrame s bs' -> f (DataFrame t bs))+               -> DataFrame s asbs' -> f (DataFrame t asbs)++instance ( ConcatList as bs asbs+         , SubSpaceCtx t as bs asbs+         ) => SubSpace t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) where+    type SubSpaceCtx t as bs asbs+      = ( Dimensions as, Dimensions bs, Dimensions asbs+        , PrimArray t (DataFrame t asbs), PrimArray t (DataFrame t bs))++    joinDataFrameI+      | Dict <- inferKnownBackend @(DataFrame t bs) @as+        = withArrayContent ewgenI+            (\steps -> fromElems (steps `mappend` cumulDims (dims @bs)))++    indexOffsetI (I# off) = withArrayContent broadcast+      (\steps off0 -> fromElems (dropPref (dims @as) steps) (off0 +# off))+    {-# INLINE indexOffsetI #-}++    updateOffsetI off bs asbs = runST $ do+        asbsM <- thawDataFrame asbs+        copyDataFrameOff off bs asbsM+        unsafeFreezeDataFrame asbsM+    {-# INLINE updateOffsetI #-}++    indexI i = withArrayContent broadcast+      (\steps off0 -> fromElems (dropPref (dims @as) steps)+         (case cdIx steps i of I# off -> off0 +# off))+    {-# INLINE indexI #-}++    updateI i bs asbs = runST $ do+        asbsM <- thawDataFrame asbs+        copyDataFrame' i bs asbsM+        unsafeFreezeDataFrame asbsM+    {-# INLINE updateI #-}++    ewmapI (f :: DataFrame s bs' -> DataFrame t bs) (asbs' :: DataFrame s asbs')+      = case uniqueOrCumulDims asbs' of+      Left e  -> ewgen (f (broadcast e))+      Right _ -> runST $ do+        let asTD  = fromIntegral (totalDim' @as ) :: Int+            bsTD  = fromIntegral (totalDim' @bs ) :: Int+            bs'TD = fromIntegral (totalDim' @bs') :: Int+        asbsM <- newDataFrame+        forM_ [0..asTD-1] $ \i ->+          copyDataFrameOff (i*bsTD) (f (indexOffset (i*bs'TD) asbs')) asbsM+        unsafeFreezeDataFrame asbsM+    {-# INLINE ewmapI #-}++    iwmapI f (asbs' :: DataFrame s asbs')+      = case uniqueOrCumulDims asbs' of+      Left e  -> iwgen (flip f (broadcast e))+      Right _ -> runST $ do+        asbsM <- newDataFrame+        forM_ [minBound..maxBound] $ \i ->+          copyDataFrame' i (f i (index i asbs')) asbsM+        unsafeFreezeDataFrame asbsM+    {-# INLINE iwmapI #-}++    ewgenI bs = case uniqueOrCumulDims bs of+      Left a -> broadcast a+      Right bsSteps -> runST $ do+        let asTD = fromIntegral (totalDim' @as) :: Int+            bsTD = fromIntegral (cdTotalDim bsSteps)+        asbsM <- newDataFrame+        forM_ [0, bsTD .. asTD * bsTD  - 1] $ \o -> copyDataFrameOff o bs asbsM+        unsafeFreezeDataFrame asbsM+    {-# INLINE ewgenI #-}++    iwgenI f = runST $ do+        asbsM <- newDataFrame+        forM_ [minBound..maxBound] $ \i -> copyDataFrame' i (f i) asbsM+        unsafeFreezeDataFrame asbsM+    {-# INLINE iwgenI #-}++    ewfoldlI f x0 asbs = case uniqueOrCumulDims asbs of+      Left a ->+        let b = broadcast a+            go i | i < 0     = x0+                 | otherwise = f (go (i-1)) b+        in  go (fromIntegral (totalDim' @as) - 1 :: Int)+      Right asbsSteps ->+        let bsSteps = dropPref (dims @as) asbsSteps+            bsLen   = max 1 (fromIntegral (cdTotalDim bsSteps)) :: Int+            asbsLen = fromIntegral (cdTotalDim asbsSteps) :: Int+            go i | i < 0     = x0+                 | otherwise = f (go (i - bsLen)) (indexOffset i asbs)+        in  go (asbsLen - bsLen)+    {-# INLINE ewfoldlI #-}++    iwfoldlI f x0 asbs+      | not (nonVoidDims (dims @as)) = x0+      | otherwise = case uniqueOrCumulDims asbs of+        Left a ->+          let b = broadcast a+              go i | i == minBound = f i x0 b+                   | otherwise     = f i (go (pred i)) b+          in  go maxBound+        Right _ ->+          let go i | i == minBound = f i x0 (index i asbs)+                   | otherwise     = f i (go (pred i)) (index i asbs)+          in  go maxBound+    {-# INLINE iwfoldlI #-}++    ewfoldrI f x0 asbs = case uniqueOrCumulDims asbs of+        Left a ->+          let b = broadcast a+              go i | i >= totalDim' @as = x0+                   | otherwise          = f b (go (i+1))+          in  go 0+        Right asbsSteps ->+          let bsSteps = dropPref (dims @as) asbsSteps+              bsLen   = max 1 (fromIntegral (cdTotalDim bsSteps)) :: Int+              asbsLen = fromIntegral (cdTotalDim asbsSteps) :: Int+              go i | i >= asbsLen = x0+                   | otherwise    = f (indexOffset i asbs) (go (i + bsLen))+          in  go 0+    {-# INLINE ewfoldrI #-}++    iwfoldrI f x0 asbs+      | not (nonVoidDims (dims @as)) = x0+      | otherwise = case uniqueOrCumulDims asbs of+        Left a ->+          let b = broadcast a+              go i | i == maxBound = f i b x0+                   | otherwise     = f i b (go (succ i))+          in  go minBound+        Right _ ->+          let go i | i == maxBound = f i (index i asbs) x0+                   | otherwise     = f i (index i asbs) (go (succ i))+          in  go minBound+    {-# INLINE iwfoldrI #-}++    indexWiseI (f :: Idxs as -> DataFrame s bs' -> f (DataFrame t bs))+        = fmap mkSTDF . iwfoldr fST (pure $ MakingDF (const (pure ())))+      where+        mkSTDF :: MakingDF t asbs -> DataFrame t asbs+        mkSTDF st = runST $ do+          df <- newDataFrame+          getMDF st df+          unsafeFreezeDataFrame df+        fST :: Idxs as -> DataFrame s bs'+            -> f (MakingDF t asbs) -> f (MakingDF t asbs)+        fST i bs' asbsSTF+          = (\r st -> MakingDF (\x -> copyDataFrame' i r x *> getMDF st x))+             <$> f i bs' <*> asbsSTF+    {-# INLINE indexWiseI #-}++-- | Hide ST monad state with a DataFrame in works inside a plain type.+newtype MakingDF t asbs+  = MakingDF { getMDF :: forall s . STDataFrame s t asbs -> ST s () }++-- | Checks if all of the dimensions are non-zero.+nonVoidDims :: Dims ns -> Bool+nonVoidDims = all (0 <) . listDims++dropPref :: Dims (ns :: [Nat]) -> CumulDims -> CumulDims+dropPref ds = CumulDims . dropSome (listDims ds) . unCumulDims++dropSome :: [Word] -> [Word] -> [Word]+dropSome []     xs = xs+dropSome (_:as) xs = dropSome as (tail xs)++instance ( ConcatList as bs asbs+         , SubSpaceCtx t as bs asbs+         ) => SubSpace t (as :: [XNat]) (bs :: [XNat]) (asbs :: [XNat]) where+    type SubSpaceCtx t as bs asbs+      = ( Dimensions bs, PrimBytes t, ExactDims bs+        , All KnownDimType as, All KnownDimType bs, All KnownDimType asbs)++    joinDataFrameI (XFrame (df :: DataFrame (DataFrame t bs) asN)) =+      let as   = XDims (dims @asN) :: Dims as+          bs   = dims :: Dims bs+          asbs = concatDims as bs :: Dims asbs+      in withLiftedConcatList @('Just asN) @('Just (DimsBound bs)) @'Nothing+                              as bs asbs $+          \(Dims :: Dims asn) (Dims :: Dims bsn) (Dims :: Dims asbsn) -> case () of+            _ | Dict <- inferKnownBackend @t @bsn+              , Dict <- inferKnownBackend @t @asbsn+                -> XFrame @_ @t @asbs @asbsn $ withArrayContent+                                                -- know for sure its DataFrame t bsn+                    (ewgen @t @asn @bsn @asbsn . unliftXFrame)+                    (\steps -> fromElems (steps `mappend` cumulDims (dims @bs)))+                    df+    {-# INLINE joinDataFrameI #-}++    indexOffsetI off (XFrame (df :: DataFrame t asbsN)) =+      let bs = dims :: Dims bs+          as = dropSufDims bs asbs :: Dims as+          asbs = XDims (dims @asbsN) :: Dims asbs+      in withLiftedConcatList @'Nothing @('Just (DimsBound bs)) @('Just asbsN)+                              as bs asbs $+           \(Dims :: Dims asn) (Dims :: Dims bsn) (Dims :: Dims asbsn)+             -> case inferKnownBackend @t @bsn of+               Dict -> XFrame (indexOffset @t @asn @bsn @asbsn off df)+    {-# INLINE indexOffsetI #-}++    updateOffsetI off (XFrame (bsDf :: DataFrame t bsN))+                      (XFrame (asbsDf :: DataFrame t asbsN)) =+      let bs = dims :: Dims bs+          as = dropSufDims bs asbs :: Dims as+          asbs = XDims (dims @asbsN) :: Dims asbs+      in withLiftedConcatList @'Nothing @('Just bsN) @('Just asbsN)+                              as bs asbs $+           \(Dims :: Dims asn) (Dims :: Dims bsn) (Dims :: Dims asbsn)+             -> XFrame (updateOffset @t @asn @bsn @asbsn off bsDf asbsDf)+    {-# INLINE updateOffsetI #-}++    indexI i (XFrame (df :: DataFrame t asbsN)) =+      let bs = dims :: Dims bs+          as = dropSufDims bs asbs :: Dims as+          asbs = XDims (dims @asbsN) :: Dims asbs+      in withLiftedConcatList @'Nothing @'Nothing @('Just asbsN)+                              as bs asbs $+           \(Dims :: Dims asn) (Dims :: Dims bsn) (Dims :: Dims asbsn)+             -> case inferKnownBackend @t @bsn of+               Dict -> XFrame (index @t @asn @bsn @asbsn (unsafeUnliftIdxs i) df)+    {-# INLINE indexI #-}++    updateI i (XFrame (bsDf :: DataFrame t bsN))+              (XFrame (asbsDf :: DataFrame t asbsN)) =+      let bs = dims :: Dims bs+          as = dropSufDims bs asbs :: Dims as+          asbs = XDims (dims @asbsN) :: Dims asbs+      in withLiftedConcatList @'Nothing @('Just bsN) @('Just asbsN)+                              as bs asbs $+           \(Dims :: Dims asn) (Dims :: Dims bsn) (Dims :: Dims asbsn)+             -> XFrame (update @t @asn @bsn @asbsn (unsafeUnliftIdxs i) bsDf asbsDf)+    {-# INLINE updateI #-}++    ewmapI  :: forall s (bs' :: [XNat]) (asbs' :: [XNat])+             . SubSpace s as bs' asbs'+            => (DataFrame s bs' -> DataFrame t bs)+            -> DataFrame s asbs' -> DataFrame t asbs+    ewmapI f (XFrame (df :: DataFrame s asbsN')) =+      let bs    = dims :: Dims bs+          bs'   = dims :: Dims bs'+          as    = dropSufDims bs' asbs' :: Dims as+          asbs' = XDims (dims @asbsN') :: Dims asbs'+          asbs  = concatDims as bs :: Dims asbs+      in withLiftedConcatList @'Nothing @'Nothing @('Just asbsN')+                              as bs' asbs' $+         \(Dims :: Dims asn) (Dims :: Dims bsn') (Dims :: Dims asbsn') ->+         withLiftedConcatList @('Just asn) @'Nothing @'Nothing+                                as bs asbs $+         \(Dims :: Dims asn) (Dims :: Dims bsn) (Dims :: Dims asbsn) ->+           case inferKnownBackend @t @asbsn of+            Dict+             | Dict <- inferKnownBackend @t @bsn+             , Dict <- inferKnownBackend @s @bsn'+             -> XFrame (ewmap @t @asn @bsn @asbsn @s @bsn' @asbsn'+                        (unliftXFrame . f . XFrame) df)+    {-# INLINE ewmapI #-}++    iwmapI  :: forall s (bs' :: [XNat]) (asbs' :: [XNat])+             . SubSpace s as bs' asbs'+            => (Idxs as -> DataFrame s bs' -> DataFrame t bs)+            -> DataFrame s asbs' -> DataFrame t asbs+    iwmapI f (XFrame (df :: DataFrame s asbsN')) =+      let bs    = dims :: Dims bs+          bs'   = dims :: Dims bs'+          as    = dropSufDims bs' asbs' :: Dims as+          asbs' = XDims (dims @asbsN') :: Dims asbs'+          asbs  = concatDims as bs :: Dims asbs+      in withLiftedConcatList @'Nothing @'Nothing @('Just asbsN')+                              as bs' asbs' $+         \(Dims :: Dims asn) (Dims :: Dims bsn') (Dims :: Dims asbsn') ->+         withLiftedConcatList @('Just asn) @'Nothing @'Nothing+                                as bs asbs $+         \(Dims :: Dims asn) (Dims :: Dims bsn) (Dims :: Dims asbsn) -> case () of+           _ | Dict <- inferKnownBackend @t @asbsn+             , Dict <- inferKnownBackend @t @bsn+             , Dict <- inferKnownBackend @s @bsn'+               -> XFrame (iwmap @t @asn @bsn @asbsn @s @bsn' @asbsn'+                           (\i x -> unliftXFrame (f (liftIdxs i) (XFrame x))) df)+    {-# INLINE iwmapI #-}+++    ewgenI (XFrame (df :: DataFrame t bsN)) =+      let as   = dims :: Dims as+          bs   = dims :: Dims bs+          asbs = concatDims as bs :: Dims asbs+      in withLiftedConcatList @'Nothing @('Just bsN) @'Nothing as bs asbs $+          \(Dims :: Dims asn) (Dims :: Dims bsn) (Dims :: Dims asbsn) ->+            case inferKnownBackend @t @asbsn of+              Dict -> XFrame (ewgen @t @asn @bsn @asbsn df)+    {-# INLINE ewgenI #-}++    iwgenI f =+      let as   = dims :: Dims as+          bs   = dims :: Dims bs+          asbs = concatDims as bs :: Dims asbs+      in withLiftedConcatList @'Nothing @'Nothing @'Nothing as bs asbs $+          \(Dims :: Dims asn) (Dims :: Dims bsn) (Dims :: Dims asbsn) -> case () of+            _ | Dict <- inferKnownBackend @t @asbsn+              , Dict <- inferKnownBackend @t @bsn+                 -> XFrame (iwgen @t @asn @bsn @asbsn (unliftXFrame . f . liftIdxs))+    {-# INLINE iwgenI #-}++    ewfoldlI f x0 (XFrame (df :: DataFrame s asbsN)) =+      let as   = dropSufDims bs asbs :: Dims as+          bs   = dims :: Dims bs+          asbs = XDims (dims @asbsN) :: Dims asbs+      in withLiftedConcatList @'Nothing @'Nothing @('Just asbsN) as bs asbs $+          \(Dims :: Dims asn) (Dims :: Dims bsn) (Dims :: Dims asbsn) ->+           case inferKnownBackend @t @bsn of+             Dict -> ewfoldl @t @asn @bsn @asbsn (\b x -> f b (XFrame x)) x0 df+    {-# INLINE ewfoldlI #-}++    iwfoldlI f x0 (XFrame (df :: DataFrame s asbsN)) =+      let as   = dropSufDims bs asbs :: Dims as+          bs   = dims :: Dims bs+          asbs = XDims (dims @asbsN) :: Dims asbs+      in withLiftedConcatList @'Nothing @'Nothing @('Just asbsN) as bs asbs $+          \(Dims :: Dims asn) (Dims :: Dims bsn) (Dims :: Dims asbsn) ->+           case inferKnownBackend @t @bsn of+             Dict -> iwfoldl @t @asn @bsn @asbsn+                       (\i b x -> f (liftIdxs i) b (XFrame x)) x0 df+    {-# INLINE iwfoldlI #-}++    ewfoldrI f x0 (XFrame (df :: DataFrame s asbsN)) =+      let as   = dropSufDims bs asbs :: Dims as+          bs   = dims :: Dims bs+          asbs = XDims (dims @asbsN) :: Dims asbs+      in withLiftedConcatList @'Nothing @'Nothing @('Just asbsN) as bs asbs $+          \(Dims :: Dims asn) (Dims :: Dims bsn) (Dims :: Dims asbsn) ->+           case inferKnownBackend @t @bsn of+             Dict -> ewfoldr @t @asn @bsn @asbsn (\x -> f (XFrame x)) x0 df+    {-# INLINE ewfoldrI #-}++    iwfoldrI f x0 (XFrame (df :: DataFrame s asbsN)) =+      let as   = dropSufDims bs asbs :: Dims as+          bs   = dims :: Dims bs+          asbs = XDims (dims @asbsN) :: Dims asbs+      in withLiftedConcatList @'Nothing @'Nothing @('Just asbsN) as bs asbs $+          \(Dims :: Dims asn) (Dims :: Dims bsn) (Dims :: Dims asbsn) ->+           case inferKnownBackend @t @bsn of+             Dict -> iwfoldr @t @asn @bsn @asbsn+                       (\i x -> f (liftIdxs i) (XFrame x)) x0 df+    {-# INLINE iwfoldrI #-}++    indexWiseI :: forall s (bs' :: [XNat]) (asbs' :: [XNat]) f+                . (Applicative f, SubSpace s as bs' asbs')+               => (Idxs as -> DataFrame s bs' -> f (DataFrame t bs))+               -> DataFrame s asbs' -> f (DataFrame t asbs)+    indexWiseI f (XFrame (df :: DataFrame s asbsN')) =+      let bs    = dims :: Dims bs+          bs'   = dims :: Dims bs'+          as    = dropSufDims bs' asbs' :: Dims as+          asbs' = XDims (dims @asbsN') :: Dims asbs'+          asbs  = concatDims as bs :: Dims asbs+      in withLiftedConcatList @'Nothing @'Nothing @('Just asbsN')+                              as bs' asbs' $+         \(Dims :: Dims asn) (Dims :: Dims bsn') (Dims :: Dims asbsn') ->+         withLiftedConcatList @('Just asn) @'Nothing @'Nothing+                                as bs asbs $+         \(Dims :: Dims asn) (Dims :: Dims bsn) (Dims :: Dims asbsn) -> case () of+           _ | Dict <- inferKnownBackend @t @asbsn+             , Dict <- inferKnownBackend @t @bsn+             , Dict <- inferKnownBackend @s @bsn'+               -> XFrame <$>+                         (indexWise @t @asn @bsn @asbsn @s @bsn' @asbsn'+                           (\i x -> unliftXFrame <$> f (liftIdxs i) (XFrame x)) df+                         )+    {-# INLINE indexWiseI #-}++dropSufDims :: ConcatList as bs asbs+            => Dims bs -> Dims asbs -> Dims as+dropSufDims = unsafeCoerce dropSuf+  where+    dropSuf :: [Word] -> [Word] -> [Word]+    dropSuf bs asbs = fst $ foldr f ([], bs) asbs+    f :: Word -> ([Word], [Word]) -> ([Word], [Word])+    f x (as, [])  = (x:as,[])+    f _ (_, _:rs) = ([], rs)++prefSufDims :: ConcatList as bs asbs+             => TypedList f as -> Dims asbs -> (Dims as, Dims bs)+prefSufDims = unsafeCoerce f+  where+    f :: [Word] -> [Word] -> ([Word], [Word])+    f  []      asbs   = ([], asbs)+    f (_:is) ~(a:sbs) = first (a:) (f is sbs)++concatDims :: ConcatList as bs asbs+           => Dims as -> Dims bs -> Dims asbs+concatDims = TL.concat++{-+A trick here is that both alternatives of 'MayEq' have the same representation+of a single equality constraint.+Thus, I can unsafeCoerce an equality later into MayEq to significantly+reduce amount of boilerplate.+ -}+type family MayEq (mns :: (Maybe [Nat])) (ns :: [Nat]) :: Constraint where+    MayEq 'Nothing   bs = bs ~ bs+    MayEq ('Just as) bs = as ~ bs++-- Very unsafe function, because it does not check the content of XDims at all.+withLiftedConcatList ::+       forall (asm :: Maybe [Nat]) (bsm :: Maybe [Nat]) (asbsm :: Maybe [Nat])+              (asx :: [XNat]) (bsx :: [XNat]) (asbsx :: [XNat]) r+     . -- (ConcatList asx bsx asbsx) =>+       Dims asx -> Dims bsx -> Dims asbsx+    -> ( forall (asn :: [Nat]) (bsn :: [Nat]) (asbsn :: [Nat])+          . ( ConcatList asn bsn asbsn+            , FixedDims asx asn, FixedDims bsx bsn, FixedDims asbsx asbsn+            , MayEq asm asn, MayEq bsm bsn, MayEq asbsm asbsn)+         => Dims asn -> Dims bsn -> Dims asbsn -> r+       ) -> r+withLiftedConcatList (XDims (asn :: Dims asn))+                     (XDims (bsn :: Dims bsn))+                     (XDims (asbsn :: Dims asbsn)) k+  | Dict <- unsafeEqTypes @_ @asbsn @(Concat asn bsn)+  , Dict <- unsafeCoerce (Dict @(asn ~ asn)) :: Dict (MayEq asm asn)+  , Dict <- unsafeCoerce (Dict @(bsn ~ bsn)) :: Dict (MayEq bsm bsn)+  , Dict <- unsafeCoerce (Dict @(asbsn ~ asbsn)) :: Dict (MayEq asbsm asbsn)+  , Dict <- inferConcat @asn @bsn @asbsn = k asn bsn asbsn++unliftXFrame :: forall (t :: Type) (xns :: [XNat]) (ns :: [Nat])+              . (ExactDims xns, FixedDims xns ns)+             => DataFrame t xns -> DataFrame t ns+unliftXFrame (XFrame x) = unsafeCoerce x+{-# INLINE unliftXFrame #-}++unsafeEqTypes :: forall k (a :: k) (b :: k)+               . Dict (a ~ b)+unsafeEqTypes = unsafeCoerce (Dict :: Dict (a ~ a))

@@ -12,6 +12,7 @@ {-# LANGUAGE MagicHash                  #-} {-# LANGUAGE MultiParamTypeClasses      #-} {-# LANGUAGE PatternSynonyms            #-}+{-# LANGUAGE PolyKinds                  #-} {-# LANGUAGE RankNTypes                 #-} {-# LANGUAGE ScopedTypeVariables        #-} {-# LANGUAGE StandaloneDeriving         #-}@@ -22,7 +23,9 @@ {-# LANGUAGE UnboxedTuples              #-} {-# LANGUAGE UndecidableInstances       #-} {-# LANGUAGE ViewPatterns               #-}-+#ifdef UNSAFE_INDICES+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}+#endif {- |   The core @easytensor@ types.  -}@@ -38,24 +41,29 @@   , DataFrame ( SingleFrame, MultiFrame, XFrame, (:*:), Z               , S, DF2, DF3, DF4, DF5, DF6, DF7, DF8, DF9) #endif+  , scalar, unScalar+  , IndexFrame (..), SubFrameIndexCtx     -- * Flexible assembling and disassembling   , PackDF, packDF, unpackDF   , appendDF, consDF, snocDF   , fromFlatList, fromListWithDefault, fromList-  , constrainDF+  , constrainDF, asDiag     -- * Infer type class instances   , KnownBackend (), DFBackend, KnownBackends   , InferKnownBackend (..), inferPrimElem     -- * Re-exports-  , Dim (..), Idx (), XNat (..), N, XN, Dims, Idxs, TypedList (..)+  , Dim (..), Idx (), Nat, XNat (..), N, XN, Dims, Idxs, TypedList (..)   , PrimBytes (), bSizeOf, bAlignOf, bFieldOffsetOf   , PrimArray (), ixOff   ) where  +#if !(MIN_VERSION_base(4,13,0))+import Data.Proxy (Proxy)+#endif+import           Control.Arrow                   (second, (***)) import           Data.Data-import           Data.Proxy                      (Proxy)-import           Data.Semigroup                  hiding (All)+import           Data.Semigroup                  hiding (All, Min) import           Data.Type.Lits import           Data.Void import           Foreign.Storable                (Storable (..))@@ -66,7 +74,9 @@ import qualified Text.ParserCombinators.ReadPrec as Read import qualified Text.Read                       as Read import qualified Text.Read.Lex                   as Read+import           Unsafe.Coerce +import           Numeric.Basics import           Numeric.DataFrame.Internal.PrimArray import           Numeric.Dimensions import           Numeric.PrimBytes@@ -75,12 +85,11 @@ import qualified Numeric.ProductOrd.Partial           as Partial import           Numeric.TypedList                    (typeables) -import {-# SOURCE #-} Numeric.DataFrame.Internal.Backend  (DFBackend,-                                                           KnownBackend)-import {-# SOURCE #-} qualified Numeric.DataFrame.Internal.Backend  as Backend-import           Numeric.DataFrame.Internal.BackendI ()+import           Numeric.DataFrame.Internal.BackendI (DFBackend, KnownBackend)+import qualified Numeric.DataFrame.Internal.BackendI as Backend  + -- | Keep data in a primitive data frame --    and maintain information about Dimensions in the type system data family DataFrame (t :: l) (xs :: [k])@@ -97,7 +106,7 @@ --   Pattern-match against its constructor to get a Nat-indexed data frame. data instance DataFrame (ts :: l) (xns :: [XNat])   = forall (ns :: [Nat])-  . (KnownXNatTypes xns, FixedDims xns ns, Dimensions ns, KnownBackends ts ns)+  . (All KnownDimType xns, FixedDims xns ns, Dimensions ns, KnownBackends ts ns)   => XFrame (DataFrame ts ns)  -- | Data frame that has an unknown dimensionality at compile time.@@ -113,21 +122,36 @@  {-# COMPLETE Z, (:*:) #-} +#define PLEASE_STYLISH_HASKELL \+  forall (xs :: [Type]) (ns :: [Nat])  . () => \+  forall (y :: Type)    (ys :: [Type]) . (xs ~ (y ': ys)) => \+  DataFrame y ns -> DataFrame ys ns -> DataFrame xs ns  -- | Constructing a @MultiFrame@ using DataFrame columns-pattern (:*:) :: forall (xs :: [Type]) (ns :: [Nat])  . ()-              => forall (y :: Type)    (ys :: [Type]) . (xs ~ (y ': ys))-              => DataFrame y ns -> DataFrame ys ns -> DataFrame xs ns+pattern (:*:) :: PLEASE_STYLISH_HASKELL pattern (:*:) x xs <- (MultiFrame (DataFrame' x :* (MultiFrame -> xs)))   where     (:*:) x (MultiFrame xs) = MultiFrame (DataFrame' x :* xs) infixr 6 :*:+#undef PLEASE_STYLISH_HASKELL  -- | Empty MultiFrame pattern Z :: forall (xs :: [Type]) (ns :: [Nat])            . () => (xs ~ '[]) => DataFrame xs ns pattern Z = MultiFrame U +-- | Convert a scalar back to an ordinary type+unScalar :: DataFrame t ('[] :: [Nat]) -> t+-- rely on that Scalar is just two times newtype alias to t+unScalar = unsafeCoerce+{-# INLINE unScalar #-}++-- | Convert any type to a scalar wrapper+scalar :: t -> DataFrame t ('[] :: [Nat])+-- rely on that Scalar is just two times newtype alias to t+scalar = unsafeCoerce+{-# INLINE scalar #-}+ -- | I use this kind-polymorphic constraint to generalize @XFrame@ and @SomeDataFrame@ --   over @SingleFrame@ and @MultiFrame@. type family KnownBackends (ts :: l) (ns :: [Nat]) :: Constraint where@@ -137,8 +161,8 @@       (KnownBackend t ns, KnownBackends ts ns)  -- | Allow inferring @KnownBackends@ if you know the dimensions and the element types.-class InferKnownBackend (t :: k) ds where-    -- Infer @KnownBackends@ if you know the dimensions and the element types.+class InferKnownBackend t (ds :: [Nat]) where+    -- | Infer @KnownBackends@ if you know the dimensions and the element types.     inferKnownBackend :: Dict (KnownBackends t ds)  instance (PrimBytes t, Dimensions ds) => InferKnownBackend (t :: Type) ds where@@ -146,15 +170,17 @@  instance (RepresentableList ts, All PrimBytes ts, Dimensions ds)       => InferKnownBackend (ts :: [Type]) ds where-    inferKnownBackend = go (tList @_ @ts)+    inferKnownBackend = go (tList @ts)       where-        go :: forall ss . All PrimBytes ss => TypeList ss -> Dict (KnownBackends ss ds)+        go :: forall ss . All PrimBytes ss+           => TypeList ss -> Dict (KnownBackends ss ds)         go U = Dict         go ((_ :: Proxy t) :* ts)              = case Backend.inferKnownBackend @t @ds of                  Dict -> case go ts of                    Dict -> Dict + -- | All component data frames must satisfy a given constraint. type family AllFrames (f :: Type -> Constraint) (ts :: [Type]) (ds :: [Nat])                                                              :: Constraint where@@ -162,6 +188,107 @@     AllFrames f (t ': ts) ds = (f (DataFrame t ds), AllFrames f ts ds)  +-- | Index one dimension deep into a @DataFrame@.+class IndexFrame t d ds where+    -- | Index one dimension deep into a @DataFrame@.+    --+    --   Note, this function does not provide indexing safety at the type level;+    --   it throws an `OutOfDimBounds` exception if an index is out of bounds+    --   (unless @unsafeindices@ package flag is enabled, which is even more dangerous).+    (!) :: DataFrame t (d ': ds) -> Word -> DataFrame t ds++instance (PrimArray t (DataFrame t '[d]), KnownDim d)+      => IndexFrame (t :: Type) (d :: Nat) '[] where+    {-# INLINE (!) #-}+    (!) df i+#ifndef UNSAFE_INDICES+      | i >= dimVal' @d = outOfDimBoundsNoCallStack "IndexFrame.(!)"+                            i (dimVal' @d) Nothing Nothing+      | otherwise+#endif+        = S (ixOff (fromIntegral i) df)++instance {-# INCOHERENT #-}+         ( PrimArray t (DataFrame t (d ': ds))+         , KnownDim d, KnownBackend t ds)+      => IndexFrame (t :: Type) (d :: Nat) ds where+    {-# INLINE (!) #-}+    (!) df i+#ifndef UNSAFE_INDICES+      | i >= dimVal' @d = outOfDimBoundsNoCallStack "IndexFrame.(!)"+                            i (dimVal' @d) Nothing Nothing+      | otherwise+#endif+        = withArrayContent broadcast+           (\(CumulDims ~(_:ss@(s:_))) off0 ->+               fromElems (CumulDims ss) (case s*i of W# off -> off0 +# word2Int# off)+           ) df+++instance IndexFrame ('[] :: [Type]) (d :: Nat) ds where+    {-# INLINE (!) #-}+    (!) Z _ = Z++instance (IndexFrame t d ds, IndexFrame ts d ds)+      => IndexFrame ((t ': ts) :: [Type]) (d :: Nat) ds where+    {-# INLINE (!) #-}+    (!) (df :*: dfs) i = df ! i :*: dfs ! i++instance PrimBytes t+      => IndexFrame (t :: Type) (xd :: XNat) xds where+    {-# INLINE (!) #-}+    (!) (XFrame df) i+      | D :* (Dims :: Dims ns) <- dims `inSpaceOf` df+      , Dict <- inferKnownBackend @t @ns+        = XFrame (df ! i)+    (!) _ _ = error "IndexFrame: impossible pattern"++instance (RepresentableList ts, All PrimBytes ts)+      => IndexFrame (ts :: [Type]) (xd :: XNat) xds where+    {-# INLINE (!) #-}+    (!) (XFrame df) i+      | (D :: Dim n) :* (Dims :: Dims ns) <- dims `inSpaceOf` df+      , Dict <- getTsEvs @ts @n @ns tList+        = XFrame (df ! i)+      where+        getTsEvs :: forall (as :: [Type]) (d :: Nat) (ds :: [Nat])+                  . ( All PrimBytes as, KnownBackends as (d ': ds)+                    , Dimensions ds, KnownDim d)+                 => TypeList as -> Dict (IndexFrame as d ds, KnownBackends as ds)+        getTsEvs U = Dict+        getTsEvs ((_ :: Proxy a) :* as')+          | Dict <- getTsEvs @_ @d @ds as'+          , Dict <- inferKnownBackend @a @ds = Dict+    (!) _ _ = error "IndexFrame: impossible pattern"++{- |+This type family describes two strategies for dealing with dimensions when+slicing a @DataFrame@.++If the original space dimension (@d@) is fixed at compile time+(@d :: Nat@ or @d ~ N n@), then we enforce the safety of a slicing operation+with types:+    the index space is bounded by the size of the original space+    minus the subframe size.++If the original space dimension (@d@) is not fixed (@d ~ XN m@), then we give up.+Just let the user do the slicing as easy as possible, and throw an `OutOfDimBounds`+exception at runtime if the index plus the sliced size is greater than the+original size of the DataFrame.+ -}+type family SubFrameIndexCtx (d :: k) (idxN :: k) (subN :: k) :: Constraint where+    SubFrameIndexCtx (n :: Nat) idxN subN+      = (n + 1) ~ (idxN + subN)+    SubFrameIndexCtx (N n) idxN subN+      = ( (n + 1) ~ (DimBound idxN + DimBound subN)+        , idxN ~ N (DimBound idxN)+        , subN ~ N (DimBound subN)+        )+    SubFrameIndexCtx (XN m) idxN subN+      = ( idxN ~ XN m+        , subN ~ N (DimBound subN)+        )+ deriving instance Typeable (DataFrame (t :: l) (xs :: [k])) deriving instance ( Data (DataFrame t xs)                   , Typeable t, Typeable xs, Typeable k, Typeable l)@@ -184,17 +311,24 @@                => Fractional (DataFrame t ds) deriving instance Floating (DFBackend t ds)                => Floating (DataFrame t ds)+deriving instance Epsilon (DFBackend t ds)+               => Epsilon (DataFrame t ds) deriving instance Real (DFBackend t ds)                => Real (DataFrame t ds)+deriving instance RealExtras (DFBackend t ds)+               => RealExtras (DataFrame t ds) deriving instance RealFrac (DFBackend t ds)                => RealFrac (DataFrame t ds) deriving instance RealFloat (DFBackend t ds)                => RealFloat (DataFrame t ds)+deriving instance RealFloatExtras (DFBackend t ds)+               => RealFloatExtras (DataFrame t ds) deriving instance PrimBytes (DFBackend t ds)                => PrimBytes (DataFrame t ds) deriving instance (PrimArray t (DFBackend t ds), PrimBytes t)                => PrimArray t (DataFrame t ds) + instance Ord (NonTransitive.ProductOrd (DFBackend t ds))       => Ord (NonTransitive.ProductOrd (DataFrame t ds)) where     (>) = coerce ((>) @(NonTransitive.ProductOrd (DFBackend t ds)))@@ -263,7 +397,7 @@          ) => Show (DataFrame (t :: Type) (ds :: [Nat])) where     showsPrec p x = case dims @ds of       U       -> showParen (p >= 10)-        $ showString "S " . showsPrec 10 (unsafeCoerce# x :: t)+        $ showString "S " . showsPrec 10 (unScalar x)       D0 :* _ -> showString "DF0"       d  :* _ -> showParen (p >= 10)         $ unpackDF' ( \Dict f ->@@ -310,24 +444,24 @@  instance (All Read ts, All PrimBytes ts, RepresentableList ts, Dimensions ds)       => Read (DataFrame (ts :: [Type]) (ds :: [Nat])) where-    readPrec = readFixedMultiDF (tList @Type @ts) (dims @ds)+    readPrec = readFixedMultiDF (tList @ts) (dims @ds)     readList = Read.readListDefault     readListPrec = Read.readListPrecDefault -instance (Read t, PrimBytes t, BoundedDims ds, All KnownXNatType ds)+instance (Read t, PrimBytes t, BoundedDims ds, All KnownDimType ds)       => Read (DataFrame (t :: Type) (ds :: [XNat])) where     readPrec = Read.parens . Read.prec 10 $ do       Read.lift . Read.expect $ Read.Ident "XFrame"-      Read.step $ readPrecBoundedDF (minDims @XNat @ds)+      Read.step $ readPrecBoundedDF (minimalDims @ds)     readList = Read.readListDefault     readListPrec = Read.readListPrecDefault  instance ( All Read ts, All PrimBytes ts, RepresentableList ts-         , BoundedDims ds, All KnownXNatType ds)+         , BoundedDims ds, All KnownDimType ds)       => Read (DataFrame (ts :: [Type]) (ds :: [XNat])) where     readPrec = Read.parens . Read.prec 10 $ do       Read.lift . Read.expect $ Read.Ident "XFrame"-      Read.step $ readBoundedMultiDF (tList @Type @ts) (minDims @XNat @ds)+      Read.step $ readBoundedMultiDF (tList @ts) (minimalDims @ds)     readList = Read.readListDefault     readListPrec = Read.readListPrecDefault @@ -343,7 +477,7 @@       => Read (SomeDataFrame (ts :: [Type])) where     readPrec = Read.parens . Read.prec 10 $ do       Read.lift . Read.expect $ Read.Ident "SomeDataFrame"-      Read.step $ readSomeMultiDF (tList @Type @ts)+      Read.step $ readSomeMultiDF (tList @ts)     readList = Read.readListDefault     readListPrec = Read.readListPrecDefault @@ -381,7 +515,7 @@   -} readPrecBoundedDF :: forall (t :: Type) (ds :: [XNat])-                   . (Read t, PrimBytes t, KnownXNatTypes ds)+                   . (Read t, PrimBytes t, All KnownDimType ds)                   => Dims ds -> Read.ReadPrec (DataFrame t ds) -- reading scalar readPrecBoundedDF U@@ -414,7 +548,7 @@   = Read.parens $ lookLex >>= \case     Read.Ident ('D':'F':s)       | Just (Dx (n :: Dim n)) <- (Read.readMaybe ('D':s) :: Maybe SomeDim)-      , Just Dict <- indeedLE m n -- check if the DF dim is not less than m+      , Just Dict <- lessOrEqDim m n         -> case n of           D0 -> do -- need to repack it under different constraint dims             XFrame x <- readPrecBoundedDF @t (Dn D0 :* xns)@@ -428,12 +562,6 @@                 (followedBy x)      _ -> Read.pfail-  where-    indeedLE :: forall (a ::Nat) (b :: Nat) . Dim a -> Dim b -> Maybe (Dict (a <= b))-    indeedLE a b = case compareDim a b of-      SLT -> Just Dict-      SEQ -> Just Dict-      SGT -> Nothing  {- In this case we know Nothing about the dimensionality of a DataFrame.@@ -451,7 +579,7 @@     Read.+++     (lookLex >>= \case        Read.Ident ('D':'F':s)-         | Just (Dx (d :: Dim d)) <- (Read.readMaybe ('D':s) :: Maybe SomeDim)+         | Just (Dx (d@D :: Dim d)) <- (Read.readMaybe ('D':s) :: Maybe SomeDim)            -> case d of              D0 | Dict <- inferKnownBackend @t @'[0]                  -> SomeDataFrame <$> readPrecFixedDF @t (D0 :* U)@@ -479,7 +607,7 @@     return (x :*: xs)  readBoundedMultiDF :: forall (ts :: [Type]) (ds :: [XNat])-                    . (All Read ts, All PrimBytes ts, KnownXNatTypes ds)+                    . (All Read ts, All PrimBytes ts, All KnownDimType ds)                    => TypeList ts                    -> Dims ds                    -> Read.ReadPrec (DataFrame ts ds)@@ -562,9 +690,9 @@ -- | A scalar DataFrame is just a newtype wrapper on a value. pattern S :: forall (t :: Type) . t -> DataFrame t ('[] :: [Nat]) -- rely on that Scalar is just two times newtype alias to t-pattern S x <- (unsafeCoerce# -> x)+pattern S x <- (unScalar -> x)   where-    S = unsafeCoerce#+    S = scalar {-# COMPLETE S #-}  @@ -800,25 +928,27 @@                -> Int -> r)           -> DataFrame t (d ': ds)           -> r-unpackDF' k df+unpackDF' k   | d :* Dims <- dims @(d ': ds)   , Dict <- inferKnownBackend @t @(d ': ds)   , Dict <- inferKnownBackend @t @ds-    = case arrayContent# df of-        (# x | #)-          | e <- broadcast x-            -> let f :: forall (zr :: RuntimeRep) (z :: TYPE zr)-                      . (Int -> DataFrame t ds -> z) -> Int -> z-                   f consume = (`consume` e)-               in k Dict f 0-        (# | (# cdims, off, arr #) #)-          | cd <- CumulDims . tail $ unCumulDims cdims-          , td <- cdTotalDim# cd-          , n <- case dimVal d of W# w -> word2Int# w-            -> let f :: forall (zr :: RuntimeRep) (z :: TYPE zr)-                      . (Int -> DataFrame t ds -> z) -> Int -> z-                   f consume (I# o) = consume (I# (o -# td)) (fromElems cd o arr)-               in k Dict f (I# (off +# td *# (n -# 1#)))+    = withArrayContent+    ( \x ->+      let e = broadcast x+          f :: forall (zr :: RuntimeRep) (z :: TYPE zr)+             . (Int -> DataFrame t ds -> z) -> Int -> z+          f consume = (`consume` e)+      in k Dict f 0+    )+    ( \cdims off arr ->+      let cd = CumulDims . tail $ unCumulDims cdims+          td = cdTotalDim# cd+          n = case dimVal d of W# w -> word2Int# w+          f :: forall (zr :: RuntimeRep) (z :: TYPE zr)+             . (Int -> DataFrame t ds -> z) -> Int -> z+          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"  @@ -878,17 +1008,20 @@   -- | Unsafely copy two PrimBytes values into a third one.-unsafeAppendPB :: (PrimBytes x, PrimBytes y, PrimBytes z)+unsafeAppendPB :: forall x y z+                . (PrimBytes x, PrimBytes y, PrimBytes z)                => x -> y -> z-unsafeAppendPB x y-  | sx <- byteSize x-  = case runRW#-    ( \s0 -> case newByteArray# (sx +# byteSize y) s0 of-        (# s1, mba #) -> unsafeFreezeByteArray# mba-            ( writeBytes mba sx y-            ( writeBytes mba 0# x s1))-    ) of (# _, r #) -> fromBytes 0# r-+unsafeAppendPB x y = go (byteSize x) (byteSize y)+  where+    go :: Int# -> Int# -> z+    go 0# _  = fromBytes (byteOffset y) (getBytes y)+    go _  0# = fromBytes (byteOffset x) (getBytes x)+    go sx sy = case runRW#+      ( \s0 -> case newByteArray# (sx +# sy) s0 of+          (# s1, mba #) -> unsafeFreezeByteArray# mba+              ( writeBytes mba sx y+              ( writeBytes mba 0# x s1))+      ) of (# _, r #) -> fromBytes 0# r  -- | Construct a DataFrame from a list of smaller DataFrames. --@@ -911,35 +1044,76 @@ --   Pattern-match against the resulting @XFrame@ to find out its dimensionality. -- --   You must not provide an infinite list as an argument.-fromList :: forall (t :: Type) (ds :: [Nat])-          . (PrimBytes t, Dimensions ds)-         => [DataFrame t ds] -> DataFrame t (XN 0 ': AsXDims ds)+fromList :: forall (t :: Type) (ds :: [Nat]) (xds :: [XNat])+          . (PrimBytes t, Dimensions ds, xds ~ Map N ds, ds ~ UnMap N xds)+         => [DataFrame t ds] -> DataFrame t (XN 0 ': xds) fromList xs     | Dx (D :: Dim n) <- someDimVal . fromIntegral $ length xs     , Dict <- inferKnownBackend @t @(n ': ds)-    , ds@(AsXDims (XDims ds')) <- dims @ds-    , Just Dict <- sameDims ds ds'+    , Dict <- unsafeEqTypes @_ @ds @(DimsBound xds)+    , Dict <- inferExactFixedDims (dims @ds)       = XFrame (fromListWithDefault @t @n @ds undefined xs)     | otherwise-      = error "Numeri.DataFrame.Type/fromList: impossible arguments"-+      = case Dict @(ds ~ UnMap N xds) of+          Dict -> -- just make GHC not complain about unused constraints.+            error "Numeri.DataFrame.Type/fromList: impossible arguments"  -- | Try to convert between @XNat@-indexed DataFrames. -- --   This is useful for imposing restrictions on unknown DataFrames, --   e.g. increasing the minimum number of elements.-constrainDF :: forall (ds :: [XNat]) (ys :: [XNat]) (l :: Type) (ts :: l)-             . (BoundedDims ds, All KnownXNatType ds)-            => DataFrame ts ys -> Maybe (DataFrame ts ds)-constrainDF (XFrame (df :: DataFrame ts ns))+constrainDF :: forall (ds :: [XNat]) (ys :: [XNat]) t+             . (BoundedDims ds, All KnownDimType ds)+            => DataFrame t ys -> Maybe (DataFrame t ds)+constrainDF (XFrame (df :: DataFrame t ns))   | ns <- dims @ns-  = case constrainDims @XNat @ds ns of+  = case constrainDims @ds ns of       Just (XDims (Dims :: Dims ms))         | Dict <- unsafeEqTypes @[Nat] @ns @ms           -> Just $ XFrame df       _   -> Nothing +-- | Place elements of a vector on the main diagonal of a matrix;+--   fill the rest of the matrix with zeroes.+--+--   Note, this function is naturally generalized onto higher dimensions+--    (which can be seen from the type signature).+--+--   Note, the argument of this function does not fully determine its result type.+--   This may cause some obscure type errors.+--   Specify type parameters @n@ and @m@ explicitly or make sure the result type is fixed.+asDiag :: forall (n :: Nat) (m :: Nat) (ds :: [Nat]) (t :: Type)+        . ( Dimensions ds, KnownDim n, KnownDim m+          , KnownBackend t (Min n m :+ ds)+          , KnownBackend t (n :+ m :+ ds)+          , PrimBytes t)+       => DataFrame t (Min n m :+ ds)+       -> DataFrame t (n :+ m :+ ds)+asDiag x+  | elemSize <- byteSize @t undefined+  , dMinNM@D <- minDim (D @n) (D @m)+  , xba <- getBytes x+  , ds <- dims @ds+  , steps@(CumulDims (elemsNR:_:elemsNE:_)) <- cumulDims (D @n :* D @m :* ds)+  , m <- dimVal' @m+  , bsE <- case elemsNE of W# w -> word2Int# w *# elemSize+  , bsR <- case elemsNR of W# w -> word2Int# w *# elemSize+  , bsShift <- case m + 1 of W# w -> word2Int# w *# bsE+  , bsLim <- case m * dimVal dMinNM of W# w -> word2Int# w *# bsE+    = case runRW#+      ( \s0 -> case newByteArray# bsR s0 of+          (# s1, mba #) ->+            let go offSrc offDst s+                  | isTrue# (offDst >=# bsLim) = s+                  | otherwise = go (offSrc +# bsE) (offDst +# bsShift)+                      (copyByteArray# xba offSrc mba offDst bsE s)+            in  unsafeFreezeByteArray# mba+                  (go (byteOffset x) 0# (setByteArray# mba 0# bsR 0# s1)) +      ) of (# _, r #) -> fromElems steps 0# r+  | otherwise+    = error "Numeri.DataFrame.Type/asDiag: impossible arguments"+{-# INLINE asDiag #-}  -- Need this for @packDF'@ to make @Int -> c z@ a proper second-order type -- parameterized by the result type.@@ -955,7 +1129,7 @@       U | S x <- v         -> z S `k` x       D :* (Dims :: Dims ns)-        -> case inferTypeableCons @_ @ds of+        -> case inferTypeableCons @ds of           Dict ->             -- PLZ don't ask me how does this work             unpackDF' (\_ f -> runOff $ packDF'@@ -965,7 +1139,7 @@     gunfold k z _ = case typeableDims @ds of       U      -> k (z S)       D :* (Dims :: Dims ns)-        -> case inferTypeableCons @_ @ds of Dict -> packDF' k z+        -> case inferTypeableCons @ds of Dict -> packDF' k z     toConstr _ = case typeableDims @ds of       U      -> scalarFrameConstr       d :* _ -> singleFrameConstr $ dimVal d@@ -980,11 +1154,11 @@ instance (AllFrames Data ts ds, Typeable ts, Typeable ds)       => Data (DataFrame (ts :: [Type]) (ds :: [Nat])) where     gfoldl _ z Z = z Z-    gfoldl k z (x :*: xs) = case inferTypeableCons @Type @ts of+    gfoldl k z (x :*: xs) = case inferTypeableCons @ts of       Dict -> z (:*:) `k` x `k` xs-    gunfold k z _ = case typeables @Type @ts of+    gunfold k z _ = case typeables @ts of       U      -> z Z-      _ :* _ -> case inferTypeableCons @_ @ts of Dict -> k (k (z (:*:)))+      _ :* _ -> case inferTypeableCons @ts of Dict -> k (k (z (:*:)))     toConstr Z         = multiFrameZConstr     toConstr (_ :*: _) = multiFrameConsConstr     dataTypeOf _ = dataFrameDataType [multiFrameZConstr, multiFrameConsConstr]@@ -1043,13 +1217,14 @@ fromSingleFrame (dd@D :* (Dims :: Dims ds')) x   | Dict <- inferKnownBackend @t @ds   , Dict <- inferKnownBackend @t @ds'-    = G.M1 $ case arrayContent# x of-      (# e | #) -> fillRep @_ @ds' (const $ broadcast e) 0 dd-      (# | (# cdims, off, arr #) #)-       | cd <- CumulDims . tail $ unCumulDims cdims-       , td <- cdTotalDim# cd-                -> fillRep @_ @ds'-                   (\(W# i) -> fromElems cd (off +# td *# word2Int# i) arr) 0 dd+    = G.M1 $ withArrayContent+        (\e -> fillRep @_ @ds' (const $ broadcast e) 0 dd)+        (\cdims off arr ->+           let cd = CumulDims . tail $ unCumulDims cdims+               td = cdTotalDim# cd+           in  fillRep @_ @ds'+                 (\(W# i) -> fromElems cd (off +# td *# word2Int# i) arr) 0 dd+        ) x   where     fillRep :: forall (n :: Nat) (ns :: [Nat])              . (Word -> DataFrame t ns)@@ -1105,7 +1280,7 @@       where         d2  = divDim d D2         d2' = d2 `plusDim` modDim d D2-+{-# INLINE toSingleFrame #-}  type family MultiFrameRepNil (ts :: [Type]) :: (Type -> Type) where     MultiFrameRepNil '[]      = G.C1 ('G.MetaCons "Z" 'G.PrefixI 'False) G.U1@@ -1136,5 +1311,245 @@   +instance (AllFrames Eq ts ds, AllFrames Ord ts ds)+      => Ord (DataFrame (ts :: [Type]) ds) where+    compare Z Z                   = EQ+    compare (a :*: as) (b :*: bs) = compare a b <> compare as bs+++withFixedDF1 :: forall (l :: Type) (ts :: l) (xns :: [XNat])+                       (rep :: RuntimeRep) (r :: TYPE rep)+              . xns ~ Map 'N (DimsBound xns)+             => ( forall (ns :: [Nat])+               . ( All KnownDimType xns, FixedDims xns ns+                 , Dimensions ns+                 , KnownBackends ts ns+                 , ns ~ DimsBound xns+                 , xns ~ Map 'N ns+                 ) => DataFrame ts ns -> r+              ) -> DataFrame ts xns -> r+withFixedDF1 f (XFrame (df :: DataFrame ts ds))+  | Dict <- unsafeEqTypes @_ @ds @(DimsBound xns)+    = f df+{-# INLINE withFixedDF1 #-}++withFixedDF2 :: forall (l :: Type) (ts :: l) (xns :: [XNat])+                       (rep :: RuntimeRep) (r :: TYPE rep)+              . xns ~ Map 'N (DimsBound xns)+             => ( forall (ns :: [Nat])+               . ( All KnownDimType xns, FixedDims xns ns+                 , Dimensions ns+                 , KnownBackends ts ns+                 , ns ~ DimsBound xns+                 , xns ~ Map 'N ns+                 ) => DataFrame ts ns -> DataFrame ts ns -> r+              ) -> DataFrame ts xns -> DataFrame ts xns -> r+withFixedDF2 f (XFrame (a :: DataFrame ts as)) (XFrame (b :: DataFrame ts bs))+  | Dict <- unsafeEqTypes @_ @as @(DimsBound xns)+  , Dict <- unsafeEqTypes @_ @bs @(DimsBound xns)+    = f a b+{-# INLINE withFixedDF2 #-}++instance ( xns ~ Map 'N (DimsBound xns)+         , Eq (DataFrame ts xns)+         , Ord (DataFrame ts (DimsBound xns))+         ) => Ord (DataFrame (ts :: l) (xns :: [XNat])) where+    compare = withFixedDF2 compare+    (>=) = withFixedDF2 (>=)+    (<=) = withFixedDF2 (<=)+    (>)  = withFixedDF2 (>)+    (<)  = withFixedDF2 (<)+    min  = withFixedDF2 ((.) XFrame . min)+    max  = withFixedDF2 ((.) XFrame . max)++instance ( Dimensions xns+         , KnownBackends ts (DimsBound xns)+         , Num (DataFrame ts (DimsBound xns))+         ) => Num (DataFrame (ts :: l) (xns :: [XNat])) where+    (+) = withKnownXDims @xns $ withFixedDF2 ((.) XFrame . (+))+    (-) = withKnownXDims @xns $ withFixedDF2 ((.) XFrame . (-))+    (*) = withKnownXDims @xns $ withFixedDF2 ((.) XFrame . (*))+    negate = withKnownXDims @xns $ withFixedDF1 (XFrame . negate)+    abs    = withKnownXDims @xns $ withFixedDF1 (XFrame . abs)+    signum = withKnownXDims @xns $ withFixedDF1 (XFrame . signum)+    fromInteger = withKnownXDims @xns+      (XFrame . fromInteger @(DataFrame ts (DimsBound xns)))++instance ( Dimensions xns+         , KnownBackends ts (DimsBound xns)+         , Fractional (DataFrame ts (DimsBound xns))+         ) => Fractional (DataFrame (ts :: l) (xns :: [XNat])) where+    (/) = withKnownXDims @xns $ withFixedDF2 ((.) XFrame . (/))+    recip = withKnownXDims @xns $ withFixedDF1 (XFrame . recip)+    fromRational = withKnownXDims @xns+      (XFrame . fromRational @(DataFrame ts (DimsBound xns)))++instance ( Dimensions xns+         , KnownBackends ts (DimsBound xns)+         , Floating (DataFrame ts (DimsBound xns))+         ) => Floating (DataFrame (ts :: l) (xns :: [XNat])) where+    pi    = withKnownXDims @xns $ XFrame (pi :: DataFrame ts (DimsBound xns))+    exp   = withKnownXDims @xns $ withFixedDF1 (XFrame . exp)+    log   = withKnownXDims @xns $ withFixedDF1 (XFrame . log)+    sqrt  = withKnownXDims @xns $ withFixedDF1 (XFrame . sqrt)+    sin   = withKnownXDims @xns $ withFixedDF1 (XFrame . sin)+    cos   = withKnownXDims @xns $ withFixedDF1 (XFrame . cos)+    tan   = withKnownXDims @xns $ withFixedDF1 (XFrame . tan)+    asin  = withKnownXDims @xns $ withFixedDF1 (XFrame . asin)+    acos  = withKnownXDims @xns $ withFixedDF1 (XFrame . acos)+    atan  = withKnownXDims @xns $ withFixedDF1 (XFrame . atan)+    sinh  = withKnownXDims @xns $ withFixedDF1 (XFrame . sinh)+    cosh  = withKnownXDims @xns $ withFixedDF1 (XFrame . cosh)+    tanh  = withKnownXDims @xns $ withFixedDF1 (XFrame . tanh)+    asinh = withKnownXDims @xns $ withFixedDF1 (XFrame . asinh)+    acosh = withKnownXDims @xns $ withFixedDF1 (XFrame . acosh)+    atanh = withKnownXDims @xns $ withFixedDF1 (XFrame . atanh)+    (**)    = withKnownXDims @xns $ withFixedDF2 ((.) XFrame . (**))+    logBase = withKnownXDims @xns $ withFixedDF2 ((.) XFrame . logBase)++instance ( xns ~ Map 'N (DimsBound xns)+         , ProductOrder (DataFrame ts (DimsBound xns))+         ) => ProductOrder (DataFrame (ts :: l) (xns :: [XNat])) where+    cmp = withFixedDF2 cmp++instance ( Dimensions xns+         , KnownBackends ts (DimsBound xns)+         , Bounded (DataFrame ts (DimsBound xns))+         ) => Bounded (DataFrame (ts :: l) (xns :: [XNat])) where+    minBound = withKnownXDims @xns (XFrame (minBound :: DataFrame ts (DimsBound xns)))+    maxBound = withKnownXDims @xns (XFrame (maxBound :: DataFrame ts (DimsBound xns)))++instance ( Dimensions xns+         , KnownBackends ts (DimsBound xns)+         , PrimBytes (DataFrame ts (DimsBound xns))+         ) => PrimBytes (DataFrame (ts :: l) (xns :: [XNat])) where+    type PrimFields (DataFrame ts xns)+      = PrimFields (DataFrame ts (DimsBound xns))+    getBytes = withKnownXDims @xns $ withFixedDF1 getBytes+    getBytesPinned = withKnownXDims @xns $ withFixedDF1 getBytesPinned+    fromBytes i ba+      = withKnownXDims @xns (XFrame (fromBytes i ba :: DataFrame ts (DimsBound xns)))+    readBytes mba i s0+      | (# s1, (a  :: DataFrame ts (DimsBound xns)) #) <- readBytes mba i s0+        = (# s1, withKnownXDims @xns (XFrame a) #)+    writeBytes mba i = withKnownXDims @xns $ withFixedDF1 (writeBytes mba i)+    readAddr addr s0+      | (# s1, (a  :: DataFrame ts (DimsBound xns)) #) <- readAddr addr s0+        = (# s1, withKnownXDims @xns (XFrame a) #)+    writeAddr = withKnownXDims @xns $ withFixedDF1 writeAddr+    byteSize  _ = withKnownXDims @xns (byteSize @(DataFrame ts (DimsBound xns)) undefined)+    byteAlign _ = withKnownXDims @xns (byteAlign @(DataFrame ts (DimsBound xns)) undefined)+    byteOffset  = withKnownXDims @xns (withFixedDF1 byteOffset)+    byteFieldOffset n _+        = withKnownXDims @xns (byteFieldOffset @(DataFrame ts (DimsBound xns)) n undefined)+    indexArray ba i+      = withKnownXDims @xns (XFrame (indexArray ba i :: DataFrame ts (DimsBound xns)))+    readArray mba i s0+      | (# s1, (a  :: DataFrame ts (DimsBound xns)) #) <- readArray mba i s0+        = (# s1, withKnownXDims @xns (XFrame a) #)+    writeArray mba i = withKnownXDims @xns (withFixedDF1 (writeArray mba i))++instance ( Dimensions xns+         , KnownBackend t (DimsBound xns)+         , PrimArray t (DataFrame t (DimsBound xns))+         , PrimBytes t+         ) => PrimArray t (DataFrame t (xns :: [XNat])) where+    broadcast#+      = withKnownXDims @xns (XFrame . broadcast# @t @(DataFrame t (DimsBound xns)))+    ix# i = withKnownXDims @xns (withFixedDF1 (ix# i))+    gen# cd f s0+      | (# s1, (a  :: DataFrame t (DimsBound xns)) #) <- gen# cd f s0+        = (# s1, withKnownXDims @xns (XFrame a) #)+    upd# cd i t = withKnownXDims @xns (withFixedDF1 (XFrame . upd# cd i t))+    withArrayContent# f g = withKnownXDims @xns (withFixedDF1 (withArrayContent f g))+    offsetElems = withKnownXDims @xns (withFixedDF1 offsetElems)+    uniqueOrCumulDims = withKnownXDims @xns (withFixedDF1 uniqueOrCumulDims)+    fromElems# cd i ba+      = withKnownXDims @xns (XFrame (fromElems cd i ba :: DataFrame t (DimsBound xns)))+++-- The following instance only make sense on scalars.++instance ( Enum (DataFrame ts ('[] :: [Nat]))+         , KnownBackends ts ('[] :: [Nat])+         ) => Enum (DataFrame (ts :: l) ('[] :: [XNat])) where+    succ (XFrame x) = XFrame (succ x)+    pred (XFrame x) = XFrame (pred x)+    toEnum  = XFrame . toEnum+    fromEnum (XFrame x) = fromEnum x+    enumFrom (XFrame x) = map XFrame $ enumFrom x+    enumFromThen   (XFrame x) (XFrame y) = map XFrame $ enumFromThen x y+    enumFromTo     (XFrame x) (XFrame y) = map XFrame $ enumFromTo x y+    enumFromThenTo (XFrame x) (XFrame y) (XFrame z)+      = map XFrame $ enumFromThenTo x y z++instance ( Epsilon (DataFrame ts ('[] :: [Nat]))+         , KnownBackends ts ('[] :: [Nat])+         , Eq (DataFrame ts ('[] :: [XNat]))+         ) => Epsilon (DataFrame (ts :: l) ('[] :: [XNat])) where+    epsilon = XFrame epsilon++instance ( Real (DataFrame ts ('[] :: [Nat]))+         , KnownBackends ts ('[] :: [Nat])+         , Eq (DataFrame ts ('[] :: [XNat]))+         ) => Real (DataFrame (ts :: l) ('[] :: [XNat])) where+    toRational (XFrame x) = toRational x++instance ( Integral (DataFrame ts ('[] :: [Nat]))+         , KnownBackends ts ('[] :: [Nat])+         , Eq (DataFrame ts ('[] :: [XNat]))+         ) => Integral (DataFrame (ts :: l) ('[] :: [XNat])) where+    quot (XFrame x) (XFrame y) = XFrame (quot x y)+    rem (XFrame x) (XFrame y) = XFrame (rem x y)+    div (XFrame x) (XFrame y) = XFrame (div x y)+    mod (XFrame x) (XFrame y) = XFrame (mod x y)+    quotRem (XFrame x) (XFrame y) = (XFrame *** XFrame) (quotRem x y)+    divMod (XFrame x) (XFrame y) = (XFrame *** XFrame) (divMod x y)+    toInteger (XFrame x) = toInteger x++instance ( RealExtras (DataFrame t ('[] :: [Nat]))+         , KnownBackend t ('[] :: [Nat])+         , Eq t+         ) => RealExtras (DataFrame (t :: Type) ('[] :: [XNat])) where+    copysign (XFrame x) (XFrame y) = XFrame (copysign x y)++instance ( RealFrac (DataFrame t ('[] :: [Nat]))+         , KnownBackend t ('[] :: [Nat])+         , Eq t+         ) => RealFrac (DataFrame (t :: Type) ('[] :: [XNat])) where+    properFraction (XFrame x) = second XFrame (properFraction x)+    truncate (XFrame x) = truncate x+    round (XFrame x) = round x+    ceiling (XFrame x) = ceiling x+    floor (XFrame x) = floor x++instance ( RealFloat (DataFrame t ('[] :: [Nat]))+         , KnownBackend t ('[] :: [Nat])+         , Eq t+         ) => RealFloat (DataFrame (t :: Type) ('[] :: [XNat])) where+    floatRadix  = const (floatRadix  @(DataFrame t ('[] :: [Nat])) undefined)+    floatDigits = const (floatDigits @(DataFrame t ('[] :: [Nat])) undefined)+    floatRange  = const (floatRange  @(DataFrame t ('[] :: [Nat])) undefined)+    decodeFloat (XFrame x) = decodeFloat x+    encodeFloat i = XFrame . encodeFloat i+    exponent (XFrame x) = exponent x+    significand (XFrame x) = XFrame (significand x)+    scaleFloat i (XFrame x) = XFrame (scaleFloat i x)+    isNaN (XFrame x) = isNaN x+    isInfinite (XFrame x) = isInfinite x+    isDenormalized (XFrame x) = isDenormalized x+    isNegativeZero (XFrame x) = isNegativeZero x+    isIEEE (XFrame x) = isIEEE x+    atan2 (XFrame y) (XFrame x) = XFrame (atan2 y x)++instance ( RealFloatExtras (DataFrame t ('[] :: [Nat]))+         , KnownBackend t ('[] :: [Nat])+         , Eq t+         ) => RealFloatExtras (DataFrame (t :: Type) ('[] :: [XNat])) where+    hypot (XFrame x) (XFrame y) = XFrame (hypot x y)+    maxFinite = XFrame maxFinite+++ unsafeEqTypes :: forall k (a :: k) (b :: k) . Dict (a ~ b)-unsafeEqTypes = unsafeCoerce# (Dict :: Dict (a ~ a))+unsafeEqTypes = unsafeCoerce (Dict :: Dict (a ~ a))

@@ -3,7 +3,6 @@   , SquareMatrix (..)   , MatrixDeterminant (..)   , MatrixInverse (..)-  , MatrixLU (..), LUFact (..)   , Matrix   , HomTransform4 (..)   , Mat22f, Mat23f, Mat24f@@ -14,10 +13,9 @@   , Mat42d, Mat43d, Mat44d   , mat22, mat33, mat44   , (%*)-  , pivotMat, luSolve   ) where  import Numeric.DataFrame.Internal.Backend () import Numeric.Matrix.Internal-import Numeric.Matrix.Internal.Mat44d     ()-import Numeric.Matrix.Internal.Mat44f     ()+import Numeric.Matrix.Internal.Double     ()+import Numeric.Matrix.Internal.Float      ()

@@ -0,0 +1,123 @@+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MagicHash             #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds             #-}+{-# LANGUAGE RecordWildCards       #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE StandaloneDeriving    #-}+{-# LANGUAGE TypeApplications      #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UnboxedTuples         #-}+{-# LANGUAGE UndecidableInstances  #-}++module Numeric.Matrix.Bidiagonal+  ( BiDiag (..), biDiag, bidiagonalHouseholder+  ) where++import Control.Monad+import Control.Monad.ST+import Data.Kind+import Numeric.Basics+import Numeric.DataFrame.ST+import Numeric.DataFrame.SubSpace+import Numeric.DataFrame.Type+import Numeric.Dimensions+import Numeric.Matrix.Internal+import Numeric.Scalar.Internal+import Numeric.Subroutine.Householder+import Numeric.Vector.Internal+++-- | Put two vectors on the main and first upper diagonal.+biDiag :: forall (t :: Type) (n :: Nat) (m :: Nat)+        . (PrimBytes t, Num t)+       => Dims '[n,m]+       -> Vector t (Min n m)+       -> Vector t (Min n m)+       -> Matrix t n m+biDiag (dn@D :* dm@D :* U) a b = runST $ do+    dnm@D <- pure $ minDim dn dm+    rPtr <- thawDataFrame 0+    forM_ [0 .. dimVal dnm - 1] $ \i -> do+      writeDataFrame rPtr (Idx i :* Idx i :* U) $ a ! i+      when (i+1 < dimVal dm) $+        writeDataFrame rPtr (Idx i :* Idx (i+1) :* U) $ b ! i+    unsafeFreezeDataFrame rPtr++-- | Decomposition of a matrix \( A = U B V^\intercal \) such that+--   \( U \) and \( V \) are orthogonal and \( B \) is bidiagonal.+data BiDiag (t :: Type) (n :: Nat)  (m :: Nat)+  = BiDiag+  { bdU     :: Matrix t n n+    -- ^ \( U \) left orthogonal matrix+  , bdUDet  :: Scalar t+    -- ^ A shortcut for evaluating a determinant of \( |U| = \pm 1 \)+  , bdAlpha :: Vector t (Min n m)+    -- ^ Main diagonal of \( B \)+  , bdBeta  :: Vector t (Min n m)+    -- ^ First upper diagonal of \( B \);+    --   its last element equals zero if \( n \geq m \)+  , bdV     :: Matrix t m m+    -- ^ \( B \) left orthogonal matrix+  , bdVDet  :: Scalar t+    -- ^ A shortcut for evaluating a determinant of \( |V| = \pm 1 \)+  }++deriving instance ( Show t, PrimBytes t+                  , KnownDim n, KnownDim m, KnownDim (Min n m))+                  => Show (BiDiag t n m)+deriving instance ( Eq t, PrimBytes t+                  , KnownDim n, KnownDim m, KnownDim (Min n m)+                  , KnownBackend t '[Min n m])+                  => Eq (BiDiag t n m)++{- |+Decompose a matrix \( A = U B V^\intercal \) such that+\( U \) and \( V \) are orthogonal and \( B \) is bidiagonal.++The first returned number+ -}+bidiagonalHouseholder ::+       forall (t :: Type) (n :: Nat) (m :: Nat)+     . (PrimBytes t, Ord t, Epsilon t, KnownDim n, KnownDim m)+    => Matrix t n m+    -> BiDiag t n m+bidiagonalHouseholder a = runST $ do+      D <- pure $ minDim (dim @n) (dim @m)+      tmpNPtr <- newDataFrame+      tmpMPtr <- newDataFrame+      uPtr <- thawDataFrame eye+      bPtr <- thawDataFrame a+      vPtr <- thawDataFrame eye+      (ud, vd) <-+        let f (ud, vd) i = do+              ud' <- householderReflectionInplaceL tmpNPtr uPtr bPtr+                     (Idx (i - 1) :* Idx (i - 1) :* U)+              vd' <- householderReflectionInplaceR tmpMPtr vPtr bPtr+                     (Idx (i - 1) :* Idx i :* U)+              return (ud /= ud', vd /= vd')+        in foldM f (False, False) [1 .. lim - 1]++      udn <- householderReflectionInplaceL tmpNPtr uPtr bPtr+                     (Idx (lim - 1) :* Idx (lim - 1) :* U)+      vdn <- if (m > lim)+             then householderReflectionInplaceR tmpMPtr vPtr bPtr+                     (Idx (lim - 1) :* Idx lim :* U)+             else pure False+      bdU <- unsafeFreezeDataFrame uPtr+      bdV <- unsafeFreezeDataFrame vPtr+      b <- unsafeFreezeDataFrame bPtr+      let bdAlpha = iwgen @t @'[Min n m]+            (\(Idx i :* U) -> index (Idx i :* Idx i :* U) b)+          bdBeta  = iwgen @t @'[Min n m]+            (\(Idx i :* U) -> if i+1 < m then index (Idx i :* Idx (i+1) :* U) b else 0)+          bdUDet = if ud /= udn then -1 else 1+          bdVDet = if vd /= vdn then -1 else 1+      return BiDiag {..}+  where+    n = dimVal' @n+    m = dimVal' @m+    lim = max 1 (min n m)

@@ -17,7 +17,6 @@   , SquareMatrix (..)   , MatrixDeterminant (..)   , MatrixInverse (..)-  , MatrixLU (..), LUFact (..)   , Matrix   , HomTransform4 (..)   , Mat22f, Mat23f, Mat24f@@ -28,21 +27,13 @@   , Mat42d, Mat43d, Mat44d   , mat22, mat33, mat44   , (%*)-  , pivotMat, luSolve   ) where -import Control.Monad                        (foldM)-import Control.Monad.ST-import Data.Foldable                        (foldl', forM_)-import Data.List                            (delete) import GHC.Base import Numeric.DataFrame.Contraction        ((%*)) import Numeric.DataFrame.Internal.PrimArray-import Numeric.DataFrame.ST-import Numeric.DataFrame.SubSpace import Numeric.DataFrame.Type import Numeric.Dimensions-import Numeric.PrimBytes import Numeric.Scalar.Internal import Numeric.Vector.Internal @@ -70,29 +61,6 @@     inverse :: Matrix t n n -> Matrix t n n  --- | Result of LU factorization with Partial Pivoting---   @ PA = LU @.-data LUFact t n-  = LUFact-  { luLower    :: Matrix t n n-    -- ^ Lower triangular matrix @L@.-    --   All elements on the diagonal of @L@ equal @1@.-  , luUpper    :: Matrix t n n-    -- ^ Upper triangular matrix @U@-  , luPerm     :: Matrix t n n-    -- ^ Row permutation matrix @P@-  , luPermSign :: Scalar t-    -- ^ Sign of permutation @luPermSign == det . luPerm@-  }--deriving instance (Show t, PrimBytes t, KnownDim n) => Show (LUFact t n)-deriving instance (Eq (Matrix t n n), Eq t) => Eq (LUFact t n)--class MatrixLU t (n :: Nat) where-    -- | Compute LU factorization with Partial Pivoting-    lu :: Matrix t n n -> LUFact t n-- -- | Operations on 4x4 transformation matrices and vectors in homogeneous coordinates. --   All angles are specified in radians. --@@ -260,214 +228,3 @@       = let f 0# = ix# 0# df             f k  = ix# k  df + f (k -# n1)         in scalar $ f (n *# n -# 1#)---instance ( KnownDim n, Ord t, Fractional t-         , PrimBytes t-         , PrimArray t (Matrix t n n)-         , PrimArray t (Vector t n)-         , PrimBytes (Vector t n)-         , PrimBytes (Matrix t n n)-         )-         => MatrixInverse t n where-  inverse m = runST $ do-      m' <- newDataFrame-      indexWise_ @t @'[n] @'[n] @'[n, n] @_ @()-        (\is ->-          indexWise_ @t @'[n] @'[] @'[n] @_ @()-            (\(j:*U) -> writeDataFrame m' (j:*is)) . luSolve luM-        ) eye-      unsafeFreezeDataFrame m'-    where-      luM = lu m--    -- much nicer, but probably slower version:-    --   (it is not particularly fast to do an extra transpose-    --       before calculating the inverse)-    -- ewmap (luSolve . lu $ transpose m) eye----instance ( KnownDim n, Ord t, Fractional t-         , PrimBytes t, PrimArray t (Matrix t n n))-         => MatrixDeterminant t n where-  det m = prodF (luUpper f) * prodF (luLower f) * luPermSign f-    where-      f = lu m-      n = case dimVal' @n of W# w -> word2Int# w-      n1 = n +# 1#-      nn1 = n *# n -# 1#-      prodF a = scalar $ prodF' nn1 a-      prodF' 0# a = ix# 0# a-      prodF' k  a = ix# k a * prodF' (k -# n1) a---instance ( KnownDim n, Ord t, Fractional t-         , PrimBytes t, PrimArray t (Matrix t n n))-         => MatrixLU t n where-    lu m' = case runRW# go of-        (# _, (# bu, bl #) #) -> LUFact-            { luLower    = fromElems steps 0# bl-            , luUpper    = fromElems steps 0# bu-            , luPerm     = p-            , luPermSign = si-            }-      where-        dn = dimVal' @n-        dnn = dn * dn-        steps = CumulDims [dnn, dn, 1]-        (m, p, si) = pivotMat m'-        n  = case dn of W# w -> word2Int# w-        nn = case dnn of W# w -> word2Int# w-        tbs = byteSize @t undefined-        bsize = nn *# tbs-        ixm i j = ix# (i *# n +# j) m-        loop :: (Int# -> a -> State# s -> (# State# s, a #))-             -> Int# -> Int# -> a -> State# s -> (# State# s, a #)-        loop f i k x s-          | isTrue# (i ==# k) = (# s, x #)-          | otherwise = case f i x s of-              (# s', y #) -> loop f ( i +# 1# ) k y s'-        go s0-          | (# s1, mbl #) <- newByteArray# bsize s0-          , (# s2, mbu #) <- newByteArray# bsize s1-          , s3 <- setByteArray# mbl 0# bsize 0# s2-          , s4 <- setByteArray# mbu 0# bsize 0# s3-          , readL <- \i j -> readArray @t mbl (i *# n +# j)-          , readU <- \i j -> readArray @t mbu (i *# n +# j)-          , writeL <- \i j -> writeArray @t mbl (i *# n +# j)-          , writeU <- \i j -> writeArray @t mbu (i *# n +# j)-          , computeU <- \i j ->-              let f k x s-                    | (# s' , ukj #) <- readU k j s-                    , (# s'', lik #) <- readL i k s'-                    = (# s'', x - ukj * lik #)-              in loop f 0# i (ixm i j)-          , computeL' <- \i j ->-              let f k x s-                    | (# s' , ukj #) <- readU k j s-                    , (# s'', lik #) <- readL i k s'-                    = (# s'', x - ukj * lik #)-              in loop f 0# j (ixm i j)-          , (# sr, () #) <--              loop-                ( \j _ sj -> case sj of-                    sj0-                      | sj1 <- writeL j j 1 sj0-                      , (# sj2, () #) <- loop-                          ( \i _ sij0 -> case computeU i j sij0 of-                               (# sij1, uij #) -> (# writeU i j uij sij1, () #)-                          ) 0# j () sj1-                      , (# sj3, ujj #) <- computeU j j sj2-                      , sj4 <- writeU j j ujj sj3-                        -> case ujj of-                          0 -> loop-                            ( \i _ sij -> (# writeL i j 0 sij, () #)-                            ) (j +# 1#) n () sj4-                          x -> loop-                            ( \i _ sij0 -> case computeL' i j sij0 of-                                (# sij1, lij #) -> (# writeL i j (lij / x) sij1, () #)-                            ) (j +# 1#) n () sj4-                ) 0# n () s4-          , (# sf0, bl #) <- unsafeFreezeByteArray# mbl sr-          , (# sf1, bu #) <- unsafeFreezeByteArray# mbu sf0-          = (# sf1, (# bu, bl #) #)----- | Solve @Ax = b@ problem given LU decomposition of A.-luSolve :: forall (t :: Type) (n :: Nat)-         . ( KnownDim n, Fractional t-           , PrimArray t (Matrix t n n), PrimArray t (Vector t n))-        => LUFact t n -> Vector t n -> Vector t n-luSolve LUFact {..} b = x-  where-    -- Pb = LUx-    pb = luPerm %* b-    n# = case dimVal' @n of W# w -> word2Int# w-    n = I# n#-    -- Ly = Pb-    y :: Vector t n-    y = runST $ do-      my <- newDataFrame-      let ixA (I# i) (I# j) = scalar $ ix# (i *# n# +# j) luLower-          ixB (I# i) = scalar $ ix# i pb-      forM_ [0..n-1] $ \i -> do-        v <- foldM ( \v j -> do-                      dj <- readDataFrameOff my j-                      return $ v - dj * ixA i j-                   ) (ixB i) [0..i-1]-        writeDataFrameOff my i v-      unsafeFreezeDataFrame my-    -- Ux = y-    x = runST $ do-      mx <- newDataFrame-      let ixA (I# i) (I# j) = scalar $ ix# (i *# n# +# j) luUpper-          ixB (I# i) = scalar $ ix# i y-      forM_ [n-1, n-2 .. 0] $ \i -> do-        v <- foldM ( \v j -> do-                      dj <- readDataFrameOff mx j-                      return $ v - dj * ixA i j-                   ) (ixB i) [i+1..n-1]-        writeDataFrameOff mx i (v / ixA i i)-      unsafeFreezeDataFrame mx----- | Permute rows that the largest magnitude elements in columns are on diagonals.------   Invariants of result matrix:---     * forall j >= i: |M[i,i]| >= M[j,i]---     * if M[i,i] == 0 then forall j >= i: |M[i+1,i+1]| >= M[j,i+1]-pivotMat :: forall (t :: Type) (n :: Nat)-          . (KnownDim n, PrimArray t (Matrix t n n), Ord t, Num t)-         => Matrix t n n -> ( Matrix t n n -- permutated matrix-                            , Matrix t n n -- permutation matrix-                            , Scalar t -- sign of permutation matrix-                            )-pivotMat mat-    = ( let f ( _, [] )   = undefined-            f ( j, i:is )-              | j == n    = f (0, is)-              | otherwise = (# (j+1, i:is), ix i j #)-        in case gen# steps f (0,rowOrder) of-            (# _, r #) -> r-      , let f ( _, [] ) = undefined-            f ( j, x:xs )-               | j == n    = f (0, xs)-               | otherwise = (# ( j + 1, x:xs), if j == x then 1 else 0 #)-        in case gen# steps f (0,rowOrder) of-            (# _, r #) -> r-      , if countMisordered rowOrder `rem` 2 == 1-        then -1 else 1-      )-  where-    dn = dimVal' @n-    steps = CumulDims [dn * dn, dn, 1]-    -- permuted row ordering-    rowOrder = uncurry fillPass $ searchPass 0 [0..n-1]-    -- matrix size-    n = fromIntegral dn-    n# = case n of I# x -> x-    -- sign of permutations-    countMisordered :: [Int] -> Int-    countMisordered [] = 0-    countMisordered (i:is) = foldl' (\c j -> if i > j then succ c else c) 0 is-                           + countMisordered is-    ix (I# i) (I# j) = ix# (i *# n# +# j) mat-    findMax :: Int -> [Int] -> (t, Int)-    findMax j = foldl' (\(ox, oi) i -> let x = abs (ix i j)-                                       in if x > ox then (x, i)-                                                    else (ox, oi)-                      ) (0, 0)-    -- search maximums, leaving Nothing where all rows are 0-    searchPass :: Int -> [Int] -> ([Int], [Maybe Int])-    searchPass j is-      | j == n    = (is, [])-      | otherwise = case findMax j is of-          (0, _) -> (Nothing:) <$> searchPass (j+1) is-          (_, i) -> (Just i:) <$> searchPass (j+1) (delete i is)-    -- replace Nothings with remaining row numbers-    fillPass :: [Int] -> [Maybe Int] -> [Int]-    fillPass _ []                  = []-    fillPass js (Just i : is)      = i : fillPass js is-    fillPass (j:js) (Nothing : is) = j : fillPass js is-    fillPass [] (Nothing : is)     = 0 : fillPass [] is

@@ -0,0 +1,199 @@+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MagicHash             #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications      #-}+{-# LANGUAGE UnboxedTuples         #-}+{-# LANGUAGE ViewPatterns          #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Numeric.Matrix.Internal.Double () where++import qualified Control.Monad.ST        as ST+import qualified Numeric.DataFrame.ST    as ST+import           Numeric.Dimensions      (KnownDim)+import           Numeric.Matrix.Internal+import           Numeric.Matrix.LU+import           Numeric.Scalar.Internal+import           Numeric.Vector.Internal++{-# INLINE mkMat #-}+mkMat ::+  Double -> Double -> Double -> Double ->+  Double -> Double -> Double -> Double ->+  Double -> Double -> Double -> Double ->+  Double -> Double -> Double -> Double ->+  Mat44d+mkMat+  _11 _12 _13 _14+  _21 _22 _23 _24+  _31 _32 _33 _34+  _41 _42 _43 _44+  = ST.runST $ do+    df <- ST.newDataFrame+    ST.writeDataFrameOff df 0  $ scalar _11+    ST.writeDataFrameOff df 1  $ scalar _12+    ST.writeDataFrameOff df 2  $ scalar _13+    ST.writeDataFrameOff df 3  $ scalar _14+    ST.writeDataFrameOff df 4  $ scalar _21+    ST.writeDataFrameOff df 5  $ scalar _22+    ST.writeDataFrameOff df 6  $ scalar _23+    ST.writeDataFrameOff df 7  $ scalar _24+    ST.writeDataFrameOff df 8  $ scalar _31+    ST.writeDataFrameOff df 9  $ scalar _32+    ST.writeDataFrameOff df 10 $ scalar _33+    ST.writeDataFrameOff df 11 $ scalar _34+    ST.writeDataFrameOff df 12 $ scalar _41+    ST.writeDataFrameOff df 13 $ scalar _42+    ST.writeDataFrameOff df 14 $ scalar _43+    ST.writeDataFrameOff df 15 $ scalar _44+    ST.unsafeFreezeDataFrame df++instance HomTransform4 Double where+  {-# INLINE translate4 #-}+  translate4 (unpackV4# -> (# x, y, z, _ #)) = mkMat+    1 0 0 0+    0 1 0 0+    0 0 1 0+    x y z 1++  {-# INLINE translate3 #-}+  translate3 (unpackV3# -> (# x, y, z #)) = mkMat+    1 0 0 0+    0 1 0 0+    0 0 1 0+    x y z 1++  {-# INLINE rotateX #-}+  rotateX a = mkMat+    1 0 0 0+    0 c s 0+    0 n c 0+    0 0 0 1+    where+      c = cos a+      s = sin a+      n = -s++  {-# INLINE rotateY #-}+  rotateY a = mkMat+    c 0 n 0+    0 1 0 0+    s 0 c 0+    0 0 0 1+    where+      c = cos a+      s = sin a+      n = -s++  {-# INLINE rotateZ #-}+  rotateZ a = mkMat+    c s 0 0+    n c 0 0+    0 0 1 0+    0 0 0 1+    where+      c = cos a+      s = sin a+      n = -s++  {-# INLINE rotate #-}+  rotate (unpackV3# -> (# x, y, z #)) a = mkMat+    (c+xxv)  (yxv+zs) (zxv-ys) 0+    (xyv-zs) (c+yyv)  (zyv+xs) 0+    (xzv+ys) (yzv-xs) (c+zzv)  0+     0        0        0       1+    where+      c = cos a+      v = 1 - c -- v for versine+      s = sin a+      xxv = x * x * v+      xyv = x * y * v+      xzv = x * z * v+      yxv = xyv+      yyv = y * y * v+      yzv = y * z * v+      zxv = xzv+      zyv = yzv+      zzv = z * z * v+      xs = x * s+      ys = y * s+      zs = z * s++  {-# INLINE rotateEuler #-}+  rotateEuler x y z = mkMat+    (cy*cz)  (cx*sz+sx*sy*cz) (sx*sz-cx*sy*cz) 0+    (-cy*sz) (cx*cz-sx*sy*sz) (sx*cz+cx*sy*sz) 0+     sy      (-sx*cy)         (cx*cy)          0+     0        0                0               1+    where+      cx = cos x+      sx = sin x+      cy = cos y+      sy = sin y+      cz = cos z+      sz = sin z++  {-# INLINE lookAt #-}+  lookAt up cam foc = mkMat+    xb1 yb1 zb1 0+    xb2 yb2 zb2 0+    xb3 yb3 zb3 0+    tx  ty  tz  1+    where+      (# xb1, xb2, xb3 #) = unpackV3# xb+      (# yb1, yb2, yb3 #) = unpackV3# yb+      (# zb1, zb2, zb3 #) = unpackV3# zb+      zb = normalized $ cam - foc -- Basis vector for "backward", since +Z is behind the camera+      xb = normalized $ up `cross` zb -- Basis vector for "right"+      yb = zb `cross` xb -- Basis vector for "up"+      ncam = -cam+      tx = unScalar $ xb `dot` ncam+      ty = unScalar $ yb `dot` ncam+      tz = unScalar $ zb `dot` ncam++  {-# INLINE perspective #-}+  perspective n f fovy aspect = mkMat+    dpw 0   0   0+    0   dph 0   0+    0   0   a (-1)+    0   0   b   0+    where+      hpd = tan (fovy * 0.5) -- height/distance+      wpd = aspect * hpd; -- width/distance+      dph = recip hpd -- distance/height+      dpw = recip wpd -- distance/width+      nmf = n - f+      a = (n + f) / nmf+      b = 2 * n * f / nmf++  {-# INLINE orthogonal #-}+  orthogonal n f w h = mkMat+    iw 0  0 0+    0  ih 0 0+    0  0  a 0+    0  0  b 1+    where+      ih = 2 / h+      iw = 2 / w+      nmf = n - f+      a = 2 / nmf+      b = (n + f) / nmf++  {-# INLINE toHomPoint #-}+  toHomPoint (unpackV3# -> (# x, y, z #)) = vec4 x y z 1++  {-# INLINE toHomVector #-}+  toHomVector (unpackV3# -> (# x, y, z #)) = vec4 x y z 0++  {-# INLINE fromHom #-}+  fromHom (unpackV4# -> (# x, y, z, w #))+    | w == 0    = vec3 x y z+    | otherwise = vec3 (x/w) (y/w) (z/w)++instance KnownDim n => MatrixInverse Double n where+    inverse = inverseViaLU++instance KnownDim n => MatrixDeterminant Double n where+    det = detViaLU