{-# LANGUAGE AllowAmbiguousTypes       #-}
{-# LANGUAGE ConstraintKinds           #-}
{-# LANGUAGE DataKinds                 #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE FlexibleInstances         #-}
{-# LANGUAGE MagicHash                 #-}
{-# LANGUAGE MultiParamTypeClasses     #-}
{-# LANGUAGE PolyKinds                 #-}
{-# LANGUAGE RankNTypes                #-}
{-# LANGUAGE ScopedTypeVariables       #-}
{-# LANGUAGE TypeApplications          #-}
{-# LANGUAGE TypeFamilyDependencies    #-}
{-# LANGUAGE TypeInType                #-}
{-# LANGUAGE TypeOperators             #-}
{-# LANGUAGE UnboxedSums               #-}
{-# LANGUAGE UnboxedTuples             #-}

module Numeric.DataFrame.Internal.Backend.Family.ArrayBase
  ( ArrayBase (..)
  ) where

import           Data.Coerce
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
import           Numeric.ProductOrd
import qualified Numeric.ProductOrd.NonTransitive     as NonTransitive
import qualified Numeric.ProductOrd.Partial           as Partial

-- | Generic Array implementation.
--   This array can reside in plain `ByteArray#` and can share the @ByteArray#@
--   with other arrays.
--   However, byte offset in the @ByteArray#@ must be multiple of the element size.
data ArrayBase (t :: Type) (ds :: [Nat])
  = ArrayBase
    (# 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.
     | (# 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).
        , 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) #-}
    {-# SPECIALIZE instance Dimensions ds => PrimBytes (ArrayBase Int ds)    #-}
    {-# SPECIALIZE instance Dimensions ds => PrimBytes (ArrayBase Word ds)   #-}
    {-# SPECIALIZE instance Dimensions ds => PrimBytes (ArrayBase Int8 ds)   #-}
    {-# SPECIALIZE instance Dimensions ds => PrimBytes (ArrayBase Int16 ds)  #-}
    {-# SPECIALIZE instance Dimensions ds => PrimBytes (ArrayBase Int32 ds)  #-}
    {-# SPECIALIZE instance Dimensions ds => PrimBytes (ArrayBase Int64 ds)  #-}
    {-# SPECIALIZE instance Dimensions ds => PrimBytes (ArrayBase Word8 ds)  #-}
    {-# SPECIALIZE instance Dimensions ds => PrimBytes (ArrayBase Word16 ds) #-}
    {-# SPECIALIZE instance Dimensions ds => PrimBytes (ArrayBase Word32 ds) #-}
    {-# SPECIALIZE instance Dimensions ds => PrimBytes (ArrayBase Word64 ds) #-}

    getBytes :: ArrayBase t ds -> ByteArray#
getBytes = (t -> ByteArray#)
-> (CumulDims -> Int# -> ByteArray# -> ByteArray#)
-> ArrayBase t ds
-> ByteArray#
forall t (ds :: [Nat]) r.
(t -> r)
-> (CumulDims -> Int# -> ByteArray# -> r) -> ArrayBase t ds -> r
withArrayContent'
      (\t
t -> let tbs :: Int#
tbs = t -> Int#
forall a. PrimBytes a => a -> Int#
byteSize t
t
             in Int# -> Int# -> t -> ByteArray#
go Int#
tbs (Int#
tbs Int# -> Int# -> Int#
*# Dimensions ds => Int#
forall (ds :: [Nat]). Dimensions ds => Int#
totalDim# @ds) t
t)
      (\CumulDims
_ Int#
_ ByteArray#
arr -> ByteArray#
arr)
      where
        go :: Int# -> Int# -> t -> ByteArray#
        go :: Int# -> Int# -> t -> ByteArray#
go Int#
tbs Int#
bsize t
t = case (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> (# State# RealWorld, ByteArray# #)
forall o. (State# RealWorld -> o) -> o
runRW#
         ( \State# RealWorld
s0 -> case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
bsize State# RealWorld
s0 of
             (# State# RealWorld
s1, MutableByteArray# RealWorld
mba #) -> MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
mba
               ( Int#
-> Int#
-> Int#
-> (Int# -> State# RealWorld -> State# RealWorld)
-> State# RealWorld
-> State# RealWorld
forall s.
Int#
-> Int#
-> Int#
-> (Int# -> State# s -> State# s)
-> State# s
-> State# s
loop# Int#
0# Int#
tbs Int#
bsize (\Int#
i -> MutableByteArray# RealWorld
-> Int# -> t -> State# RealWorld -> State# RealWorld
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeBytes MutableByteArray# RealWorld
mba Int#
i t
t) State# RealWorld
s1 )
         ) of (# State# RealWorld
_, ByteArray#
ba #) -> ByteArray#
ba
    {-# INLINE getBytes #-}

    getBytesPinned :: ArrayBase t ds -> ByteArray#
getBytesPinned = (t -> ByteArray#)
-> (CumulDims -> Int# -> ByteArray# -> ByteArray#)
-> ArrayBase t ds
-> ByteArray#
forall t (ds :: [Nat]) r.
(t -> r)
-> (CumulDims -> Int# -> ByteArray# -> r) -> ArrayBase t ds -> r
withArrayContent' t -> ByteArray#
f
      ((Int# -> ByteArray# -> ByteArray#)
-> CumulDims -> Int# -> ByteArray# -> ByteArray#
forall a b. a -> b -> a
const ((Int# -> ByteArray# -> ByteArray#)
 -> CumulDims -> Int# -> ByteArray# -> ByteArray#)
-> (Int# -> ByteArray# -> ByteArray#)
-> CumulDims
-> Int#
-> ByteArray#
-> ByteArray#
forall a b. (a -> b) -> a -> b
$ \Int#
off ByteArray#
arr -> case (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> (# State# RealWorld, ByteArray# #)
forall o. (State# RealWorld -> o) -> o
runRW# (Int#
-> ByteArray#
-> State# RealWorld
-> (# State# RealWorld, ByteArray# #)
g Int#
off ByteArray#
arr) of (# State# RealWorld
_, ByteArray#
ba #) -> ByteArray#
ba)
      where
        g :: Int# -> ByteArray# -> State# RealWorld -> (# State# RealWorld, ByteArray# #)
        g :: Int#
-> ByteArray#
-> State# RealWorld
-> (# State# RealWorld, ByteArray# #)
g Int#
off ByteArray#
arr State# RealWorld
s0
          | Int# -> Bool
isTrue# (ByteArray# -> Int#
isByteArrayPinned# ByteArray#
arr)
            = (# State# RealWorld
s0, ByteArray#
arr #)
          | Int#
tba <- t -> Int#
forall a. PrimBytes a => a -> Int#
byteAlign @t t
forall a. HasCallStack => a
undefined
          , Int#
bsize <- ByteArray# -> Int#
sizeofByteArray# ByteArray#
arr
          , (# State# RealWorld
s1, MutableByteArray# RealWorld
mba #) <- Int#
-> Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d.
Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newAlignedPinnedByteArray# Int#
bsize Int#
tba State# RealWorld
s0
          , State# RealWorld
s2 <- ByteArray#
-> Int#
-> MutableByteArray# RealWorld
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall d.
ByteArray#
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyByteArray# ByteArray#
arr Int#
off MutableByteArray# RealWorld
mba Int#
off Int#
bsize State# RealWorld
s1
            = MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
mba State# RealWorld
s2
        f :: t -> ByteArray#
        f :: t -> ByteArray#
f t
t
          | Int#
tbs <- t -> Int#
forall a. PrimBytes a => a -> Int#
byteSize t
t
          , Int#
bsize <- Dimensions ds => Int#
forall (ds :: [Nat]). Dimensions ds => Int#
totalDim# @ds Int# -> Int# -> Int#
*# Int#
tbs
            = case (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> (# State# RealWorld, ByteArray# #)
forall o. (State# RealWorld -> o) -> o
runRW#
             ( \State# RealWorld
s0 -> case Int#
-> Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d.
Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newAlignedPinnedByteArray# Int#
bsize (t -> Int#
forall a. PrimBytes a => a -> Int#
byteAlign t
t) State# RealWorld
s0 of
                 (# State# RealWorld
s1, MutableByteArray# RealWorld
mba #) -> MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
mba
                   ( Int#
-> Int#
-> Int#
-> (Int# -> State# RealWorld -> State# RealWorld)
-> State# RealWorld
-> State# RealWorld
forall s.
Int#
-> Int#
-> Int#
-> (Int# -> State# s -> State# s)
-> State# s
-> State# s
loop# Int#
0# Int#
tbs Int#
bsize (\Int#
i -> MutableByteArray# RealWorld
-> Int# -> t -> State# RealWorld -> State# RealWorld
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeBytes MutableByteArray# RealWorld
mba Int#
i t
t) State# RealWorld
s1 )
             ) of (# State# RealWorld
_, ByteArray#
ba #) -> ByteArray#
ba
    {-# INLINE getBytesPinned #-}


    fromBytes :: Int# -> ByteArray# -> ArrayBase t ds
fromBytes Int#
bOff ByteArray#
ba
      | Int#
tbs <- t -> Int#
forall a. PrimBytes a => a -> Int#
byteSize (t
forall a. HasCallStack => a
undefined :: t)
      , (# Int#
offN, Int#
offRem #) <- Int# -> Int# -> (# Int#, Int# #)
quotRemInt# Int#
bOff Int#
tbs
      = case Int#
offRem of
          Int#
0# -> CumulDims -> Int# -> ByteArray# -> ArrayBase t ds
forall t (ds :: [Nat]).
PrimBytes t =>
CumulDims -> Int# -> ByteArray# -> ArrayBase t ds
fromElems' CumulDims
steps Int#
offN ByteArray#
ba
          Int#
_  -> case CumulDims -> Int#
cdTotalDim# CumulDims
steps of Int#
n -> Int# -> ArrayBase t ds
go (Int#
tbs Int# -> Int# -> Int#
*# Int#
n)
      where
        steps :: CumulDims
steps = Dims ds -> CumulDims
forall k (ns :: [k]). Dims ns -> CumulDims
cumulDims (Dims ds -> CumulDims) -> Dims ds -> CumulDims
forall a b. (a -> b) -> a -> b
$ Dimensions ds => Dims ds
forall k (ds :: [k]). Dimensions ds => Dims ds
dims @ds
        go :: Int# -> ArrayBase t ds
go Int#
bsize = case (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> (# State# RealWorld, ByteArray# #)
forall o. (State# RealWorld -> o) -> o
runRW#
         ( \State# RealWorld
s0 -> case ( if Int# -> Bool
isTrue# (ByteArray# -> Int#
isByteArrayPinned# ByteArray#
ba)
                         then Int#
-> Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d.
Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newAlignedPinnedByteArray# Int#
bsize
                                (t -> Int#
forall a. PrimBytes a => a -> Int#
byteAlign @t t
forall a. HasCallStack => a
undefined)
                         else Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
bsize
                       ) State# RealWorld
s0
                  of
            (# State# RealWorld
s1, MutableByteArray# RealWorld
mba #) -> MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
mba
                              (ByteArray#
-> Int#
-> MutableByteArray# RealWorld
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall d.
ByteArray#
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyByteArray# ByteArray#
ba Int#
bOff MutableByteArray# RealWorld
mba Int#
0# Int#
bsize State# RealWorld
s1)
         ) of (# State# RealWorld
_, ByteArray#
r #) -> CumulDims -> Int# -> ByteArray# -> ArrayBase t ds
forall t (ds :: [Nat]).
PrimBytes t =>
CumulDims -> Int# -> ByteArray# -> ArrayBase t ds
fromElems' CumulDims
steps Int#
0# ByteArray#
r
    {-# INLINE fromBytes #-}

    readBytes :: MutableByteArray# s
-> Int# -> State# s -> (# State# s, ArrayBase t ds #)
readBytes MutableByteArray# s
mba Int#
bOff State# s
s0
      | CumulDims
steps <- Dims ds -> CumulDims
forall k (ns :: [k]). Dims ns -> CumulDims
cumulDims (Dims ds -> CumulDims) -> Dims ds -> CumulDims
forall a b. (a -> b) -> a -> b
$ Dimensions ds => Dims ds
forall k (ds :: [k]). Dimensions ds => Dims ds
dims @ds
      , Int#
n <- CumulDims -> Int#
cdTotalDim# CumulDims
steps
      , Int#
tbs <- t -> Int#
forall a. PrimBytes a => a -> Int#
byteSize (t
forall a. HasCallStack => a
undefined :: t)
      , Int#
bsize <- Int#
tbs Int# -> Int# -> Int#
*# Int#
n
      = case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
bsize State# s
s0 of
         (# State# s
s1, MutableByteArray# s
mba1 #) -> case MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
mba1
                                (MutableByteArray# s
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall d.
MutableByteArray# d
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyMutableByteArray# MutableByteArray# s
mba Int#
bOff MutableByteArray# s
mba1 Int#
0# Int#
bsize State# s
s1) of
           (# State# s
s2, ByteArray#
ba #) -> (# State# s
s2, CumulDims -> Int# -> ByteArray# -> ArrayBase t ds
forall t (ds :: [Nat]).
PrimBytes t =>
CumulDims -> Int# -> ByteArray# -> ArrayBase t ds
fromElems' CumulDims
steps Int#
0# ByteArray#
ba #)
    {-# INLINE readBytes #-}

    writeBytes :: MutableByteArray# s
-> Int# -> ArrayBase t ds -> State# s -> State# s
writeBytes MutableByteArray# s
mba Int#
bOff
      | Int#
tbs <- t -> Int#
forall a. PrimBytes a => a -> Int#
byteSize (t
forall a. HasCallStack => a
undefined :: t) = (t -> State# s -> State# s)
-> (CumulDims -> Int# -> ByteArray# -> State# s -> State# s)
-> ArrayBase t ds
-> State# s
-> State# s
forall t (ds :: [Nat]) r.
(t -> r)
-> (CumulDims -> Int# -> ByteArray# -> r) -> ArrayBase t ds -> r
withArrayContent'
        (\t
t -> Int#
-> Int#
-> Int#
-> (Int# -> State# s -> State# s)
-> State# s
-> State# s
forall s.
Int#
-> Int#
-> Int#
-> (Int# -> State# s -> State# s)
-> State# s
-> State# s
loop# Int#
bOff Int#
tbs
          (Int#
bOff Int# -> Int# -> Int#
+# Dimensions ds => Int#
forall (ds :: [Nat]). Dimensions ds => Int#
totalDim# @ds Int# -> Int# -> Int#
*# Int#
tbs)
          (\Int#
i -> MutableByteArray# s -> Int# -> t -> State# s -> State# s
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeBytes MutableByteArray# s
mba Int#
i t
t))
        (\CumulDims
steps Int#
offContent ByteArray#
arrContent ->
          ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall d.
ByteArray#
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyByteArray# ByteArray#
arrContent (Int#
offContent Int# -> Int# -> Int#
*# Int#
tbs)
                         MutableByteArray# s
mba Int#
bOff (CumulDims -> Int#
cdTotalDim# CumulDims
steps Int# -> Int# -> Int#
*# Int#
tbs))
    {-# INLINE writeBytes #-}

    readAddr :: Addr# -> State# s -> (# State# s, ArrayBase t ds #)
readAddr Addr#
addr State# s
s0
      | CumulDims
steps <- Dims ds -> CumulDims
forall k (ns :: [k]). Dims ns -> CumulDims
cumulDims (Dims ds -> CumulDims) -> Dims ds -> CumulDims
forall a b. (a -> b) -> a -> b
$ Dimensions ds => Dims ds
forall k (ds :: [k]). Dimensions ds => Dims ds
dims @ds
      , Int#
n <- CumulDims -> Int#
cdTotalDim# CumulDims
steps
      , Int#
tbs <- t -> Int#
forall a. PrimBytes a => a -> Int#
byteSize (t
forall a. HasCallStack => a
undefined :: t)
      , Int#
bsize <- Int#
tbs Int# -> Int# -> Int#
*# Int#
n
      = case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
bsize State# s
s0 of
         (# State# s
s1, MutableByteArray# s
mba1 #) -> case MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
mba1
                                (Addr#
-> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
forall d.
Addr#
-> MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
copyAddrToByteArray# Addr#
addr MutableByteArray# s
mba1 Int#
0# Int#
bsize State# s
s1) of
           (# State# s
s2, ByteArray#
ba #) -> (# State# s
s2, CumulDims -> Int# -> ByteArray# -> ArrayBase t ds
forall t (ds :: [Nat]).
PrimBytes t =>
CumulDims -> Int# -> ByteArray# -> ArrayBase t ds
fromElems' CumulDims
steps Int#
0# ByteArray#
ba #)
    {-# INLINE readAddr #-}

    writeAddr :: ArrayBase t ds -> Addr# -> State# s -> State# s
writeAddr ArrayBase t ds
a Addr#
addr
      | Int#
tbs <- t -> Int#
forall a. PrimBytes a => a -> Int#
byteSize (t
forall a. HasCallStack => a
undefined :: t) = (t -> State# s -> State# s)
-> (CumulDims -> Int# -> ByteArray# -> State# s -> State# s)
-> ArrayBase t ds
-> State# s
-> State# s
forall t (ds :: [Nat]) r.
(t -> r)
-> (CumulDims -> Int# -> ByteArray# -> r) -> ArrayBase t ds -> r
withArrayContent'
        (\t
t -> Int#
-> Int#
-> Int#
-> (Int# -> State# s -> State# s)
-> State# s
-> State# s
forall s.
Int#
-> Int#
-> Int#
-> (Int# -> State# s -> State# s)
-> State# s
-> State# s
loop# Int#
0# Int#
tbs
          (Dimensions ds => Int#
forall (ds :: [Nat]). Dimensions ds => Int#
totalDim# @ds Int# -> Int# -> Int#
*# Int#
tbs)
          (\Int#
i -> t -> Addr# -> State# s -> State# s
forall a s. PrimBytes a => a -> Addr# -> State# s -> State# s
writeAddr t
t (Addr# -> Int# -> Addr#
plusAddr# Addr#
addr Int#
i)))
        (\CumulDims
steps Int#
offContent ByteArray#
arrContent ->
          ByteArray# -> Int# -> Addr# -> Int# -> State# s -> State# s
forall d.
ByteArray# -> Int# -> Addr# -> Int# -> State# d -> State# d
copyByteArrayToAddr# ByteArray#
arrContent (Int#
offContent Int# -> Int# -> Int#
*# Int#
tbs)
                               Addr#
addr (CumulDims -> Int#
cdTotalDim# CumulDims
steps Int# -> Int# -> Int#
*# Int#
tbs)) ArrayBase t ds
a
    {-# INLINE writeAddr #-}


    byteSize :: ArrayBase t ds -> Int#
byteSize ArrayBase t ds
_ = t -> Int#
forall a. PrimBytes a => a -> Int#
byteSize @t t
forall a. HasCallStack => a
undefined Int# -> Int# -> Int#
*# Dimensions ds => Int#
forall (ds :: [Nat]). Dimensions ds => Int#
totalDim# @ds -- WARNING: slow!
    {-# INLINE byteSize #-}

    byteAlign :: ArrayBase t ds -> Int#
byteAlign ArrayBase t ds
_ = t -> Int#
forall a. PrimBytes a => a -> Int#
byteAlign @t t
forall a. HasCallStack => a
undefined
    {-# INLINE byteAlign #-}

    byteOffset :: ArrayBase t ds -> Int#
byteOffset = (t -> Int#)
-> (CumulDims -> Int# -> ByteArray# -> Int#)
-> ArrayBase t ds
-> Int#
forall t (ds :: [Nat]) r.
(t -> r)
-> (CumulDims -> Int# -> ByteArray# -> r) -> ArrayBase t ds -> r
withArrayContent'
      (\t
_ -> Int#
0#) (\CumulDims
_ Int#
off ByteArray#
_ -> Int#
off Int# -> Int# -> Int#
*# t -> Int#
forall a. PrimBytes a => a -> Int#
byteSize @t t
forall a. HasCallStack => a
undefined)
    {-# INLINE byteOffset #-}

    byteFieldOffset :: Proxy# name -> ArrayBase t ds -> Int#
byteFieldOffset Proxy# name
_ ArrayBase t ds
_ = Int# -> Int#
negateInt# Int#
1#
    {-# INLINE byteFieldOffset #-}

    indexArray :: ByteArray# -> Int# -> ArrayBase t ds
indexArray ByteArray#
ba Int#
off
      | CumulDims
steps <- Dims ds -> CumulDims
forall k (ns :: [k]). Dims ns -> CumulDims
cumulDims (Dims ds -> CumulDims) -> Dims ds -> CumulDims
forall a b. (a -> b) -> a -> b
$ Dimensions ds => Dims ds
forall k (ds :: [k]). Dimensions ds => Dims ds
dims @ds
      = CumulDims -> Int# -> ByteArray# -> ArrayBase t ds
forall t (ds :: [Nat]).
PrimBytes t =>
CumulDims -> Int# -> ByteArray# -> ArrayBase t ds
fromElems' CumulDims
steps (Int#
off Int# -> Int# -> Int#
*# CumulDims -> Int#
cdTotalDim# CumulDims
steps) ByteArray#
ba
    {-# INLINE indexArray #-}



-- | Accumulates only idempotent operations!
--   Being applied to FromScalars, executes only once!
--   Here, idempotance means: assuming @f a b = g x@, @g (g x) = g x@
--
--   Also, I assume the sizes of arrays are the same.
--
--   Inside, this function uses foldr; thus, if the combining function is
--   lazy in the second argument, it may avoid some unnecessary work.
accumV2Idempotent :: a
                  -> (t -> t -> a)
                  -> (a -> a -> a)
                  -> ArrayBase t ds -> ArrayBase t ds -> a
accumV2Idempotent :: a
-> (t -> t -> a)
-> (a -> a -> a)
-> ArrayBase t ds
-> ArrayBase t ds
-> a
accumV2Idempotent a
x t -> t -> a
f a -> a -> a
comb
  (ArrayBase (# t
a | #))
  (ArrayBase (# t
b | #))
    = a -> a -> a
comb a
x (t -> t -> a
f t
a t
b)
accumV2Idempotent a
x t -> t -> a
f a -> a -> a
comb
  a :: ArrayBase t ds
a@(ArrayBase (# | (# CumulDims
steps, Int#
_, ByteArray#
_, Dict (PrimBytes t)
Dict #) #))
  b :: ArrayBase t ds
b@(ArrayBase (# | (# CumulDims, Int#, ByteArray#, Dict (PrimBytes t) #)
_ #))
    = (Int -> a -> a) -> a -> [Int] -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a -> a -> a
comb (a -> a -> a) -> (Int -> a) -> Int -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Int
i -> t -> t -> a
f (Int -> ArrayBase t ds -> t
forall t a. PrimArray t a => Int -> a -> t
ixOff Int
i ArrayBase t ds
a) (Int -> ArrayBase t ds -> t
forall t a. PrimArray t a => Int -> a -> t
ixOff Int
i ArrayBase t ds
b))) a
x
                          [Int
0 .. Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CumulDims -> Word
cdTotalDim CumulDims
steps) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
accumV2Idempotent a
x t -> t -> a
f a -> a -> a
comb
    (ArrayBase (# t
a | #))
  b :: ArrayBase t ds
b@(ArrayBase (# | (# CumulDims
steps, Int#
_, ByteArray#
_, Dict (PrimBytes t)
Dict #) #))
    = (Int -> a -> a) -> a -> [Int] -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a -> a -> a
comb (a -> a -> a) -> (Int -> a) -> Int -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Int
i -> t -> t -> a
f t
a (Int -> ArrayBase t ds -> t
forall t a. PrimArray t a => Int -> a -> t
ixOff Int
i ArrayBase t ds
b))) a
x
                          [Int
0 .. Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CumulDims -> Word
cdTotalDim CumulDims
steps) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
accumV2Idempotent a
x t -> t -> a
f a -> a -> a
comb
  a :: ArrayBase t ds
a@(ArrayBase (# | (# CumulDims
steps, Int#
_, ByteArray#
_, Dict (PrimBytes t)
Dict #) #))
    (ArrayBase (# t
b | #))
    = (Int -> a -> a) -> a -> [Int] -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a -> a -> a
comb (a -> a -> a) -> (Int -> a) -> Int -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Int
i -> t -> t -> a
f (Int -> ArrayBase t ds -> t
forall t a. PrimArray t a => Int -> a -> t
ixOff Int
i ArrayBase t ds
a) t
b)) a
x
                          [Int
0 .. Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CumulDims -> Word
cdTotalDim CumulDims
steps) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
{-# INLINE accumV2Idempotent #-}


mapV :: (t -> t) -> ArrayBase t ds -> ArrayBase t ds
mapV :: (t -> t) -> ArrayBase t ds -> ArrayBase t ds
mapV t -> t
f (ArrayBase (# t
t | #))
    = (# t | (# CumulDims, Int#, ByteArray#, Dict (PrimBytes t) #) #)
-> ArrayBase t ds
forall t (ds :: [Nat]).
(# t | (# CumulDims, Int#, ByteArray#, Dict (PrimBytes t) #) #)
-> ArrayBase t ds
ArrayBase (# t -> t
f t
t | #)
mapV t -> t
f x :: ArrayBase t ds
x@(ArrayBase (# | (# CumulDims
steps, Int#
offN, ByteArray#
ba, Dict (PrimBytes t)
Dict #) #))
    | Int#
tbs <- t -> Int#
forall a. PrimBytes a => a -> Int#
byteSize (ArrayBase t ds -> t
forall t (ds :: [Nat]). ArrayBase t ds -> t
undefEl ArrayBase t ds
x)
    , Int#
n <- CumulDims -> Int#
cdTotalDim# CumulDims
steps
    = case (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> (# State# RealWorld, ByteArray# #)
forall o. (State# RealWorld -> o) -> o
runRW#
     ( \State# RealWorld
s0 -> case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (Int#
tbs Int# -> Int# -> Int#
*# Int#
n) State# RealWorld
s0 of
         (# State# RealWorld
s1, MutableByteArray# RealWorld
mba #) -> MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
mba
           ( Int#
-> (Int# -> State# RealWorld -> State# RealWorld)
-> State# RealWorld
-> State# RealWorld
forall s.
Int# -> (Int# -> State# s -> State# s) -> State# s -> State# s
loop1# Int#
n
               (\Int#
i -> MutableByteArray# RealWorld
-> Int# -> t -> State# RealWorld -> State# RealWorld
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeArray MutableByteArray# RealWorld
mba Int#
i (t -> t
f (ByteArray# -> Int# -> t
forall a. PrimBytes a => ByteArray# -> Int# -> a
indexArray ByteArray#
ba (Int#
offN Int# -> Int# -> Int#
+# Int#
i)))) State# RealWorld
s1
           )
     ) of (# State# RealWorld
_, ByteArray#
r #) -> CumulDims -> Int# -> ByteArray# -> ArrayBase t ds
forall t (ds :: [Nat]).
PrimBytes t =>
CumulDims -> Int# -> ByteArray# -> ArrayBase t ds
fromElems' CumulDims
steps Int#
0# ByteArray#
r
{-# INLINE mapV #-}


zipV :: (t -> t -> t)
     -> ArrayBase t ds -> ArrayBase t ds -> ArrayBase t ds
zipV :: (t -> t -> t) -> ArrayBase t ds -> ArrayBase t ds -> ArrayBase t ds
zipV t -> t -> t
f (ArrayBase (# t
x | #)) ArrayBase t ds
b = (t -> t) -> ArrayBase t ds -> ArrayBase t ds
forall t (ds :: [Nat]).
(t -> t) -> ArrayBase t ds -> ArrayBase t ds
mapV (t -> t -> t
f t
x) ArrayBase t ds
b
zipV t -> t -> t
f ArrayBase t ds
a (ArrayBase (# t
y | #)) = (t -> t) -> ArrayBase t ds -> ArrayBase t ds
forall t (ds :: [Nat]).
(t -> t) -> ArrayBase t ds -> ArrayBase t ds
mapV (t -> t -> t
`f` t
y) ArrayBase t ds
a
zipV t -> t -> t
f a :: ArrayBase t ds
a@(ArrayBase (# | (# CumulDims
steps, Int#
oa, ByteArray#
ba, Dict (PrimBytes t)
Dict #) #))
         (ArrayBase (# | (# CumulDims
_,    Int#
ob, ByteArray#
bb, Dict (PrimBytes t)
_ #) #))
    | Int#
n <- CumulDims -> Int#
cdTotalDim# CumulDims
steps
    = case (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> (# State# RealWorld, ByteArray# #)
forall o. (State# RealWorld -> o) -> o
runRW#
     ( \State# RealWorld
s0 -> case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (t -> Int#
forall a. PrimBytes a => a -> Int#
byteSize (ArrayBase t ds -> t
forall t (ds :: [Nat]). ArrayBase t ds -> t
undefEl ArrayBase t ds
a) Int# -> Int# -> Int#
*# Int#
n) State# RealWorld
s0 of
         (# State# RealWorld
s1, MutableByteArray# RealWorld
mba #) -> MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
mba
           ( Int#
-> (Int# -> State# RealWorld -> State# RealWorld)
-> State# RealWorld
-> State# RealWorld
forall s.
Int# -> (Int# -> State# s -> State# s) -> State# s -> State# s
loop1# Int#
n
               (\Int#
i -> MutableByteArray# RealWorld
-> Int# -> t -> State# RealWorld -> State# RealWorld
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeArray MutableByteArray# RealWorld
mba Int#
i
                        (t -> t -> t
f (ByteArray# -> Int# -> t
forall a. PrimBytes a => ByteArray# -> Int# -> a
indexArray ByteArray#
ba (Int#
oa Int# -> Int# -> Int#
+# Int#
i))
                           (ByteArray# -> Int# -> t
forall a. PrimBytes a => ByteArray# -> Int# -> a
indexArray ByteArray#
bb (Int#
ob Int# -> Int# -> Int#
+# Int#
i))
                        )
               ) State# RealWorld
s1
           )
     ) of (# State# RealWorld
_, ByteArray#
r #) -> CumulDims -> Int# -> ByteArray# -> ArrayBase t ds
forall t (ds :: [Nat]).
PrimBytes t =>
CumulDims -> Int# -> ByteArray# -> ArrayBase t ds
fromElems' CumulDims
steps Int#
0# ByteArray#
r
{-# INLINE zipV #-}


-- TODO: to improve performance, I can either compare bytearrays using memcmp
--       or implement early termination if the first elements do not match.
--       On the other hand, hopefully @(&&)@ and @(||)@ ops take care of that.
instance Eq t => Eq (ArrayBase t ds) where
    {-# SPECIALIZE instance Eq (ArrayBase Float ds)  #-}
    {-# SPECIALIZE instance Eq (ArrayBase Double ds) #-}
    {-# SPECIALIZE instance Eq (ArrayBase Int ds)    #-}
    {-# SPECIALIZE instance Eq (ArrayBase Word ds)   #-}
    {-# SPECIALIZE instance Eq (ArrayBase Int8 ds)   #-}
    {-# SPECIALIZE instance Eq (ArrayBase Int16 ds)  #-}
    {-# SPECIALIZE instance Eq (ArrayBase Int32 ds)  #-}
    {-# SPECIALIZE instance Eq (ArrayBase Int64 ds)  #-}
    {-# SPECIALIZE instance Eq (ArrayBase Word8 ds)  #-}
    {-# SPECIALIZE instance Eq (ArrayBase Word16 ds) #-}
    {-# SPECIALIZE instance Eq (ArrayBase Word32 ds) #-}
    {-# SPECIALIZE instance Eq (ArrayBase Word64 ds) #-}
    == :: ArrayBase t ds -> ArrayBase t ds -> Bool
(==) = Bool
-> (t -> t -> Bool)
-> (Bool -> Bool -> Bool)
-> ArrayBase t ds
-> ArrayBase t ds
-> Bool
forall a t (ds :: [Nat]).
a
-> (t -> t -> a)
-> (a -> a -> a)
-> ArrayBase t ds
-> ArrayBase t ds
-> a
accumV2Idempotent Bool
True t -> t -> Bool
forall a. Eq a => a -> a -> Bool
(==) Bool -> Bool -> Bool
(&&)
    /= :: ArrayBase t ds -> ArrayBase t ds -> Bool
(/=) = Bool
-> (t -> t -> Bool)
-> (Bool -> Bool -> Bool)
-> ArrayBase t ds
-> ArrayBase t ds
-> Bool
forall a t (ds :: [Nat]).
a
-> (t -> t -> a)
-> (a -> a -> a)
-> ArrayBase t ds
-> ArrayBase t ds
-> a
accumV2Idempotent Bool
False t -> t -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Bool -> Bool -> Bool
(||)

instance Ord t => ProductOrder (ArrayBase t ds) where
    {-# SPECIALIZE instance ProductOrder (ArrayBase Float ds)  #-}
    {-# SPECIALIZE instance ProductOrder (ArrayBase Double ds) #-}
    {-# SPECIALIZE instance ProductOrder (ArrayBase Int ds)    #-}
    {-# SPECIALIZE instance ProductOrder (ArrayBase Word ds)   #-}
    {-# SPECIALIZE instance ProductOrder (ArrayBase Int8 ds)   #-}
    {-# SPECIALIZE instance ProductOrder (ArrayBase Int16 ds)  #-}
    {-# SPECIALIZE instance ProductOrder (ArrayBase Int32 ds)  #-}
    {-# SPECIALIZE instance ProductOrder (ArrayBase Int64 ds)  #-}
    {-# SPECIALIZE instance ProductOrder (ArrayBase Word8 ds)  #-}
    {-# SPECIALIZE instance ProductOrder (ArrayBase Word16 ds) #-}
    {-# SPECIALIZE instance ProductOrder (ArrayBase Word32 ds) #-}
    {-# SPECIALIZE instance ProductOrder (ArrayBase Word64 ds) #-}
    cmp :: ArrayBase t ds -> ArrayBase t ds -> PartialOrdering
cmp = PartialOrdering
-> (t -> t -> PartialOrdering)
-> (PartialOrdering -> PartialOrdering -> PartialOrdering)
-> ArrayBase t ds
-> ArrayBase t ds
-> PartialOrdering
forall a t (ds :: [Nat]).
a
-> (t -> t -> a)
-> (a -> a -> a)
-> ArrayBase t ds
-> ArrayBase t ds
-> a
accumV2Idempotent PartialOrdering
PEQ (\t
x t
y -> Ordering -> PartialOrdering
fromOrdering (t -> t -> Ordering
forall a. Ord a => a -> a -> Ordering
compare t
x t
y)) PartialOrdering -> PartialOrdering -> PartialOrdering
forall a. Semigroup a => a -> a -> a
(<>)
    {-# INLINE cmp #-}

instance Ord t => Ord (NonTransitive.ProductOrd (ArrayBase t ds)) where
    {-# SPECIALIZE instance Ord (NonTransitive.ProductOrd (ArrayBase Float ds))  #-}
    {-# SPECIALIZE instance Ord (NonTransitive.ProductOrd (ArrayBase Double ds)) #-}
    {-# SPECIALIZE instance Ord (NonTransitive.ProductOrd (ArrayBase Int ds))    #-}
    {-# SPECIALIZE instance Ord (NonTransitive.ProductOrd (ArrayBase Word ds))   #-}
    {-# SPECIALIZE instance Ord (NonTransitive.ProductOrd (ArrayBase Int8 ds))   #-}
    {-# SPECIALIZE instance Ord (NonTransitive.ProductOrd (ArrayBase Int16 ds))  #-}
    {-# SPECIALIZE instance Ord (NonTransitive.ProductOrd (ArrayBase Int32 ds))  #-}
    {-# SPECIALIZE instance Ord (NonTransitive.ProductOrd (ArrayBase Int64 ds))  #-}
    {-# SPECIALIZE instance Ord (NonTransitive.ProductOrd (ArrayBase Word8 ds))  #-}
    {-# SPECIALIZE instance Ord (NonTransitive.ProductOrd (ArrayBase Word16 ds)) #-}
    {-# SPECIALIZE instance Ord (NonTransitive.ProductOrd (ArrayBase Word32 ds)) #-}
    {-# SPECIALIZE instance Ord (NonTransitive.ProductOrd (ArrayBase Word64 ds)) #-}
    NonTransitive.ProductOrd ArrayBase t ds
x > :: ProductOrd (ArrayBase t ds) -> ProductOrd (ArrayBase t ds) -> Bool
> NonTransitive.ProductOrd ArrayBase t ds
y = ArrayBase t ds -> ArrayBase t ds -> PartialOrdering
forall a. ProductOrder a => a -> a -> PartialOrdering
cmp ArrayBase t ds
x ArrayBase t ds
y PartialOrdering -> PartialOrdering -> Bool
forall a. Eq a => a -> a -> Bool
== PartialOrdering
PGT
    {-# INLINE (>) #-}
    NonTransitive.ProductOrd ArrayBase t ds
x < :: ProductOrd (ArrayBase t ds) -> ProductOrd (ArrayBase t ds) -> Bool
< NonTransitive.ProductOrd ArrayBase t ds
y = ArrayBase t ds -> ArrayBase t ds -> PartialOrdering
forall a. ProductOrder a => a -> a -> PartialOrdering
cmp ArrayBase t ds
x ArrayBase t ds
y PartialOrdering -> PartialOrdering -> Bool
forall a. Eq a => a -> a -> Bool
== PartialOrdering
PLT
    {-# INLINE (<) #-}
    >= :: ProductOrd (ArrayBase t ds) -> ProductOrd (ArrayBase t ds) -> Bool
(>=) = (ArrayBase t Any -> ArrayBase t Any -> Bool)
-> ProductOrd (ArrayBase t ds)
-> ProductOrd (ArrayBase t ds)
-> Bool
coerce (Bool
-> (t -> t -> Bool)
-> (Bool -> Bool -> Bool)
-> ArrayBase t Any
-> ArrayBase t Any
-> Bool
forall a t (ds :: [Nat]).
a
-> (t -> t -> a)
-> (a -> a -> a)
-> ArrayBase t ds
-> ArrayBase t ds
-> a
accumV2Idempotent Bool
True t -> t -> Bool
forall a. Ord a => a -> a -> Bool
(>=) Bool -> Bool -> Bool
(&&))
    {-# INLINE (>=) #-}
    <= :: ProductOrd (ArrayBase t ds) -> ProductOrd (ArrayBase t ds) -> Bool
(<=) = (ArrayBase t Any -> ArrayBase t Any -> Bool)
-> ProductOrd (ArrayBase t ds)
-> ProductOrd (ArrayBase t ds)
-> Bool
coerce (Bool
-> (t -> t -> Bool)
-> (Bool -> Bool -> Bool)
-> ArrayBase t Any
-> ArrayBase t Any
-> Bool
forall a t (ds :: [Nat]).
a
-> (t -> t -> a)
-> (a -> a -> a)
-> ArrayBase t ds
-> ArrayBase t ds
-> a
accumV2Idempotent Bool
True t -> t -> Bool
forall a. Ord a => a -> a -> Bool
(<=) Bool -> Bool -> Bool
(&&))
    {-# INLINE (<=) #-}
    compare :: ProductOrd (ArrayBase t ds)
-> ProductOrd (ArrayBase t ds) -> Ordering
compare (NonTransitive.ProductOrd ArrayBase t ds
a) (NonTransitive.ProductOrd ArrayBase t ds
b)
      = PartialOrdering -> Ordering
NonTransitive.toOrdering (PartialOrdering -> Ordering) -> PartialOrdering -> Ordering
forall a b. (a -> b) -> a -> b
$ ArrayBase t ds -> ArrayBase t ds -> PartialOrdering
forall a. ProductOrder a => a -> a -> PartialOrdering
cmp ArrayBase t ds
a ArrayBase t ds
b
    {-# INLINE compare #-}
    min :: ProductOrd (ArrayBase t ds)
-> ProductOrd (ArrayBase t ds) -> ProductOrd (ArrayBase t ds)
min = (ArrayBase t Any -> ArrayBase t Any -> ArrayBase t Any)
-> ProductOrd (ArrayBase t ds)
-> ProductOrd (ArrayBase t ds)
-> ProductOrd (ArrayBase t ds)
coerce ((t -> t -> t)
-> ArrayBase t Any -> ArrayBase t Any -> ArrayBase t Any
forall t (ds :: [Nat]).
(t -> t -> t) -> ArrayBase t ds -> ArrayBase t ds -> ArrayBase t ds
zipV t -> t -> t
forall a. Ord a => a -> a -> a
min)
    {-# INLINE min #-}
    max :: ProductOrd (ArrayBase t ds)
-> ProductOrd (ArrayBase t ds) -> ProductOrd (ArrayBase t ds)
max = (ArrayBase t Any -> ArrayBase t Any -> ArrayBase t Any)
-> ProductOrd (ArrayBase t ds)
-> ProductOrd (ArrayBase t ds)
-> ProductOrd (ArrayBase t ds)
coerce ((t -> t -> t)
-> ArrayBase t Any -> ArrayBase t Any -> ArrayBase t Any
forall t (ds :: [Nat]).
(t -> t -> t) -> ArrayBase t ds -> ArrayBase t ds -> ArrayBase t ds
zipV t -> t -> t
forall a. Ord a => a -> a -> a
max)
    {-# INLINE max #-}

instance Ord t => Ord (Partial.ProductOrd (ArrayBase t ds)) where
    {-# SPECIALIZE instance Ord (Partial.ProductOrd (ArrayBase Float ds))  #-}
    {-# SPECIALIZE instance Ord (Partial.ProductOrd (ArrayBase Double ds)) #-}
    {-# SPECIALIZE instance Ord (Partial.ProductOrd (ArrayBase Int ds))    #-}
    {-# SPECIALIZE instance Ord (Partial.ProductOrd (ArrayBase Word ds))   #-}
    {-# SPECIALIZE instance Ord (Partial.ProductOrd (ArrayBase Int8 ds))   #-}
    {-# SPECIALIZE instance Ord (Partial.ProductOrd (ArrayBase Int16 ds))  #-}
    {-# SPECIALIZE instance Ord (Partial.ProductOrd (ArrayBase Int32 ds))  #-}
    {-# SPECIALIZE instance Ord (Partial.ProductOrd (ArrayBase Int64 ds))  #-}
    {-# SPECIALIZE instance Ord (Partial.ProductOrd (ArrayBase Word8 ds))  #-}
    {-# SPECIALIZE instance Ord (Partial.ProductOrd (ArrayBase Word16 ds)) #-}
    {-# SPECIALIZE instance Ord (Partial.ProductOrd (ArrayBase Word32 ds)) #-}
    {-# SPECIALIZE instance Ord (Partial.ProductOrd (ArrayBase Word64 ds)) #-}
    Partial.ProductOrd ArrayBase t ds
x > :: ProductOrd (ArrayBase t ds) -> ProductOrd (ArrayBase t ds) -> Bool
> Partial.ProductOrd ArrayBase t ds
y = ArrayBase t ds -> ArrayBase t ds -> PartialOrdering
forall a. ProductOrder a => a -> a -> PartialOrdering
cmp ArrayBase t ds
x ArrayBase t ds
y PartialOrdering -> PartialOrdering -> Bool
forall a. Eq a => a -> a -> Bool
== PartialOrdering
PGT
    {-# INLINE (>) #-}
    Partial.ProductOrd ArrayBase t ds
x < :: ProductOrd (ArrayBase t ds) -> ProductOrd (ArrayBase t ds) -> Bool
< Partial.ProductOrd ArrayBase t ds
y = ArrayBase t ds -> ArrayBase t ds -> PartialOrdering
forall a. ProductOrder a => a -> a -> PartialOrdering
cmp ArrayBase t ds
x ArrayBase t ds
y PartialOrdering -> PartialOrdering -> Bool
forall a. Eq a => a -> a -> Bool
== PartialOrdering
PLT
    {-# INLINE (<) #-}
    >= :: ProductOrd (ArrayBase t ds) -> ProductOrd (ArrayBase t ds) -> Bool
(>=) = (ArrayBase t Any -> ArrayBase t Any -> Bool)
-> ProductOrd (ArrayBase t ds)
-> ProductOrd (ArrayBase t ds)
-> Bool
coerce (Bool
-> (t -> t -> Bool)
-> (Bool -> Bool -> Bool)
-> ArrayBase t Any
-> ArrayBase t Any
-> Bool
forall a t (ds :: [Nat]).
a
-> (t -> t -> a)
-> (a -> a -> a)
-> ArrayBase t ds
-> ArrayBase t ds
-> a
accumV2Idempotent Bool
True t -> t -> Bool
forall a. Ord a => a -> a -> Bool
(>=) Bool -> Bool -> Bool
(&&))
    {-# INLINE (>=) #-}
    <= :: ProductOrd (ArrayBase t ds) -> ProductOrd (ArrayBase t ds) -> Bool
(<=) = (ArrayBase t Any -> ArrayBase t Any -> Bool)
-> ProductOrd (ArrayBase t ds)
-> ProductOrd (ArrayBase t ds)
-> Bool
coerce (Bool
-> (t -> t -> Bool)
-> (Bool -> Bool -> Bool)
-> ArrayBase t Any
-> ArrayBase t Any
-> Bool
forall a t (ds :: [Nat]).
a
-> (t -> t -> a)
-> (a -> a -> a)
-> ArrayBase t ds
-> ArrayBase t ds
-> a
accumV2Idempotent Bool
True t -> t -> Bool
forall a. Ord a => a -> a -> Bool
(<=) Bool -> Bool -> Bool
(&&))
    {-# INLINE (<=) #-}
    compare :: ProductOrd (ArrayBase t ds)
-> ProductOrd (ArrayBase t ds) -> Ordering
compare (Partial.ProductOrd ArrayBase t ds
a) (Partial.ProductOrd ArrayBase t ds
b)
      = PartialOrdering -> Ordering
Partial.toOrdering (PartialOrdering -> Ordering) -> PartialOrdering -> Ordering
forall a b. (a -> b) -> a -> b
$ ArrayBase t ds -> ArrayBase t ds -> PartialOrdering
forall a. ProductOrder a => a -> a -> PartialOrdering
cmp ArrayBase t ds
a ArrayBase t ds
b
    {-# INLINE compare #-}
    min :: ProductOrd (ArrayBase t ds)
-> ProductOrd (ArrayBase t ds) -> ProductOrd (ArrayBase t ds)
min = (ArrayBase t Any -> ArrayBase t Any -> ArrayBase t Any)
-> ProductOrd (ArrayBase t ds)
-> ProductOrd (ArrayBase t ds)
-> ProductOrd (ArrayBase t ds)
coerce ((t -> t -> t)
-> ArrayBase t Any -> ArrayBase t Any -> ArrayBase t Any
forall t (ds :: [Nat]).
(t -> t -> t) -> ArrayBase t ds -> ArrayBase t ds -> ArrayBase t ds
zipV t -> t -> t
forall a. Ord a => a -> a -> a
min)
    {-# INLINE min #-}
    max :: ProductOrd (ArrayBase t ds)
-> ProductOrd (ArrayBase t ds) -> ProductOrd (ArrayBase t ds)
max = (ArrayBase t Any -> ArrayBase t Any -> ArrayBase t Any)
-> ProductOrd (ArrayBase t ds)
-> ProductOrd (ArrayBase t ds)
-> ProductOrd (ArrayBase t ds)
coerce ((t -> t -> t)
-> ArrayBase t Any -> ArrayBase t Any -> ArrayBase t Any
forall t (ds :: [Nat]).
(t -> t -> t) -> ArrayBase t ds -> ArrayBase t ds -> ArrayBase t ds
zipV t -> t -> t
forall a. Ord a => a -> a -> a
max)
    {-# INLINE max #-}

-- | Lexicographical ordering
instance Ord t => Ord (ArrayBase t ds) where
    {-# SPECIALIZE instance Ord (ArrayBase Float ds)  #-}
    {-# SPECIALIZE instance Ord (ArrayBase Double ds) #-}
    {-# SPECIALIZE instance Ord (ArrayBase Int ds)    #-}
    {-# SPECIALIZE instance Ord (ArrayBase Word ds)   #-}
    {-# SPECIALIZE instance Ord (ArrayBase Int8 ds)   #-}
    {-# SPECIALIZE instance Ord (ArrayBase Int16 ds)  #-}
    {-# SPECIALIZE instance Ord (ArrayBase Int32 ds)  #-}
    {-# SPECIALIZE instance Ord (ArrayBase Int64 ds)  #-}
    {-# SPECIALIZE instance Ord (ArrayBase Word8 ds)  #-}
    {-# SPECIALIZE instance Ord (ArrayBase Word16 ds) #-}
    {-# SPECIALIZE instance Ord (ArrayBase Word32 ds) #-}
    {-# SPECIALIZE instance Ord (ArrayBase Word64 ds) #-}
    compare :: ArrayBase t ds -> ArrayBase t ds -> Ordering
compare = Ordering
-> (t -> t -> Ordering)
-> (Ordering -> Ordering -> Ordering)
-> ArrayBase t ds
-> ArrayBase t ds
-> Ordering
forall a t (ds :: [Nat]).
a
-> (t -> t -> a)
-> (a -> a -> a)
-> ArrayBase t ds
-> ArrayBase t ds
-> a
accumV2Idempotent Ordering
EQ t -> t -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
(<>)
    {-# INLINE compare #-}

instance Bounded t => Bounded (ArrayBase t ds) where
    {-# SPECIALIZE instance Bounded (ArrayBase Int ds)    #-}
    {-# SPECIALIZE instance Bounded (ArrayBase Word ds)   #-}
    {-# SPECIALIZE instance Bounded (ArrayBase Int8 ds)   #-}
    {-# SPECIALIZE instance Bounded (ArrayBase Int16 ds)  #-}
    {-# SPECIALIZE instance Bounded (ArrayBase Int32 ds)  #-}
    {-# SPECIALIZE instance Bounded (ArrayBase Int64 ds)  #-}
    {-# SPECIALIZE instance Bounded (ArrayBase Word8 ds)  #-}
    {-# SPECIALIZE instance Bounded (ArrayBase Word16 ds) #-}
    {-# SPECIALIZE instance Bounded (ArrayBase Word32 ds) #-}
    {-# SPECIALIZE instance Bounded (ArrayBase Word64 ds) #-}
    maxBound :: ArrayBase t ds
maxBound = t -> ArrayBase t ds
forall t (ds :: [Nat]). t -> ArrayBase t ds
broadcast' t
forall a. Bounded a => a
maxBound
    minBound :: ArrayBase t ds
minBound = t -> ArrayBase t ds
forall t (ds :: [Nat]). t -> ArrayBase t ds
broadcast' t
forall a. Bounded a => a
minBound

instance Num t => Num (ArrayBase t ds)  where
    {-# SPECIALIZE instance Num (ArrayBase Float ds)  #-}
    {-# SPECIALIZE instance Num (ArrayBase Double ds) #-}
    {-# SPECIALIZE instance Num (ArrayBase Int ds)    #-}
    {-# SPECIALIZE instance Num (ArrayBase Word ds)   #-}
    {-# SPECIALIZE instance Num (ArrayBase Int8 ds)   #-}
    {-# SPECIALIZE instance Num (ArrayBase Int16 ds)  #-}
    {-# SPECIALIZE instance Num (ArrayBase Int32 ds)  #-}
    {-# SPECIALIZE instance Num (ArrayBase Int64 ds)  #-}
    {-# SPECIALIZE instance Num (ArrayBase Word8 ds)  #-}
    {-# SPECIALIZE instance Num (ArrayBase Word16 ds) #-}
    {-# SPECIALIZE instance Num (ArrayBase Word32 ds) #-}
    {-# SPECIALIZE instance Num (ArrayBase Word64 ds) #-}
    + :: ArrayBase t ds -> ArrayBase t ds -> ArrayBase t ds
(+) = (t -> t -> t) -> ArrayBase t ds -> ArrayBase t ds -> ArrayBase t ds
forall t (ds :: [Nat]).
(t -> t -> t) -> ArrayBase t ds -> ArrayBase t ds -> ArrayBase t ds
zipV t -> t -> t
forall a. Num a => a -> a -> a
(+)
    {-# INLINE (+) #-}
    (-) = (t -> t -> t) -> ArrayBase t ds -> ArrayBase t ds -> ArrayBase t ds
forall t (ds :: [Nat]).
(t -> t -> t) -> ArrayBase t ds -> ArrayBase t ds -> ArrayBase t ds
zipV (-)
    {-# INLINE (-) #-}
    * :: ArrayBase t ds -> ArrayBase t ds -> ArrayBase t ds
(*) = (t -> t -> t) -> ArrayBase t ds -> ArrayBase t ds -> ArrayBase t ds
forall t (ds :: [Nat]).
(t -> t -> t) -> ArrayBase t ds -> ArrayBase t ds -> ArrayBase t ds
zipV t -> t -> t
forall a. Num a => a -> a -> a
(*)
    {-# INLINE (*) #-}
    negate :: ArrayBase t ds -> ArrayBase t ds
negate = (t -> t) -> ArrayBase t ds -> ArrayBase t ds
forall t (ds :: [Nat]).
(t -> t) -> ArrayBase t ds -> ArrayBase t ds
mapV t -> t
forall a. Num a => a -> a
negate
    {-# INLINE negate #-}
    abs :: ArrayBase t ds -> ArrayBase t ds
abs = (t -> t) -> ArrayBase t ds -> ArrayBase t ds
forall t (ds :: [Nat]).
(t -> t) -> ArrayBase t ds -> ArrayBase t ds
mapV t -> t
forall a. Num a => a -> a
abs
    {-# INLINE abs #-}
    signum :: ArrayBase t ds -> ArrayBase t ds
signum = (t -> t) -> ArrayBase t ds -> ArrayBase t ds
forall t (ds :: [Nat]).
(t -> t) -> ArrayBase t ds -> ArrayBase t ds
mapV t -> t
forall a. Num a => a -> a
signum
    {-# INLINE signum #-}
    fromInteger :: Integer -> ArrayBase t ds
fromInteger = t -> ArrayBase t ds
forall t (ds :: [Nat]). t -> ArrayBase t ds
broadcast' (t -> ArrayBase t ds)
-> (Integer -> t) -> Integer -> ArrayBase t ds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> t
forall a. Num a => Integer -> a
fromInteger
    {-# INLINE fromInteger #-}

instance Fractional t => Fractional (ArrayBase t ds)  where
    {-# SPECIALIZE instance Fractional (ArrayBase Float ds)  #-}
    {-# SPECIALIZE instance Fractional (ArrayBase Double ds) #-}
    / :: ArrayBase t ds -> ArrayBase t ds -> ArrayBase t ds
(/) = (t -> t -> t) -> ArrayBase t ds -> ArrayBase t ds -> ArrayBase t ds
forall t (ds :: [Nat]).
(t -> t -> t) -> ArrayBase t ds -> ArrayBase t ds -> ArrayBase t ds
zipV t -> t -> t
forall a. Fractional a => a -> a -> a
(/)
    {-# INLINE (/) #-}
    recip :: ArrayBase t ds -> ArrayBase t ds
recip = (t -> t) -> ArrayBase t ds -> ArrayBase t ds
forall t (ds :: [Nat]).
(t -> t) -> ArrayBase t ds -> ArrayBase t ds
mapV t -> t
forall a. Fractional a => a -> a
recip
    {-# INLINE recip #-}
    fromRational :: Rational -> ArrayBase t ds
fromRational = t -> ArrayBase t ds
forall t (ds :: [Nat]). t -> ArrayBase t ds
broadcast' (t -> ArrayBase t ds)
-> (Rational -> t) -> Rational -> ArrayBase t ds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> t
forall a. Fractional a => Rational -> a
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 t ds
pi = t -> ArrayBase t ds
forall t (ds :: [Nat]). t -> ArrayBase t ds
broadcast' t
forall a. Floating a => a
pi
    {-# INLINE pi #-}
    exp :: ArrayBase t ds -> ArrayBase t ds
exp = (t -> t) -> ArrayBase t ds -> ArrayBase t ds
forall t (ds :: [Nat]).
(t -> t) -> ArrayBase t ds -> ArrayBase t ds
mapV t -> t
forall a. Floating a => a -> a
exp
    {-# INLINE exp #-}
    log :: ArrayBase t ds -> ArrayBase t ds
log = (t -> t) -> ArrayBase t ds -> ArrayBase t ds
forall t (ds :: [Nat]).
(t -> t) -> ArrayBase t ds -> ArrayBase t ds
mapV t -> t
forall a. Floating a => a -> a
log
    {-# INLINE log #-}
    sqrt :: ArrayBase t ds -> ArrayBase t ds
sqrt = (t -> t) -> ArrayBase t ds -> ArrayBase t ds
forall t (ds :: [Nat]).
(t -> t) -> ArrayBase t ds -> ArrayBase t ds
mapV t -> t
forall a. Floating a => a -> a
sqrt
    {-# INLINE sqrt #-}
    sin :: ArrayBase t ds -> ArrayBase t ds
sin = (t -> t) -> ArrayBase t ds -> ArrayBase t ds
forall t (ds :: [Nat]).
(t -> t) -> ArrayBase t ds -> ArrayBase t ds
mapV t -> t
forall a. Floating a => a -> a
sin
    {-# INLINE sin #-}
    cos :: ArrayBase t ds -> ArrayBase t ds
cos = (t -> t) -> ArrayBase t ds -> ArrayBase t ds
forall t (ds :: [Nat]).
(t -> t) -> ArrayBase t ds -> ArrayBase t ds
mapV t -> t
forall a. Floating a => a -> a
cos
    {-# INLINE cos #-}
    tan :: ArrayBase t ds -> ArrayBase t ds
tan = (t -> t) -> ArrayBase t ds -> ArrayBase t ds
forall t (ds :: [Nat]).
(t -> t) -> ArrayBase t ds -> ArrayBase t ds
mapV t -> t
forall a. Floating a => a -> a
tan
    {-# INLINE tan #-}
    asin :: ArrayBase t ds -> ArrayBase t ds
asin = (t -> t) -> ArrayBase t ds -> ArrayBase t ds
forall t (ds :: [Nat]).
(t -> t) -> ArrayBase t ds -> ArrayBase t ds
mapV t -> t
forall a. Floating a => a -> a
asin
    {-# INLINE asin #-}
    acos :: ArrayBase t ds -> ArrayBase t ds
acos = (t -> t) -> ArrayBase t ds -> ArrayBase t ds
forall t (ds :: [Nat]).
(t -> t) -> ArrayBase t ds -> ArrayBase t ds
mapV t -> t
forall a. Floating a => a -> a
acos
    {-# INLINE acos #-}
    atan :: ArrayBase t ds -> ArrayBase t ds
atan = (t -> t) -> ArrayBase t ds -> ArrayBase t ds
forall t (ds :: [Nat]).
(t -> t) -> ArrayBase t ds -> ArrayBase t ds
mapV t -> t
forall a. Floating a => a -> a
atan
    {-# INLINE atan #-}
    sinh :: ArrayBase t ds -> ArrayBase t ds
sinh = (t -> t) -> ArrayBase t ds -> ArrayBase t ds
forall t (ds :: [Nat]).
(t -> t) -> ArrayBase t ds -> ArrayBase t ds
mapV t -> t
forall a. Floating a => a -> a
sinh
    {-# INLINE sinh #-}
    cosh :: ArrayBase t ds -> ArrayBase t ds
cosh = (t -> t) -> ArrayBase t ds -> ArrayBase t ds
forall t (ds :: [Nat]).
(t -> t) -> ArrayBase t ds -> ArrayBase t ds
mapV t -> t
forall a. Floating a => a -> a
cosh
    {-# INLINE cosh #-}
    tanh :: ArrayBase t ds -> ArrayBase t ds
tanh = (t -> t) -> ArrayBase t ds -> ArrayBase t ds
forall t (ds :: [Nat]).
(t -> t) -> ArrayBase t ds -> ArrayBase t ds
mapV t -> t
forall a. Floating a => a -> a
tanh
    {-# INLINE tanh #-}
    ** :: ArrayBase t ds -> ArrayBase t ds -> ArrayBase t ds
(**) = (t -> t -> t) -> ArrayBase t ds -> ArrayBase t ds -> ArrayBase t ds
forall t (ds :: [Nat]).
(t -> t -> t) -> ArrayBase t ds -> ArrayBase t ds -> ArrayBase t ds
zipV t -> t -> t
forall a. Floating a => a -> a -> a
(**)
    {-# INLINE (**) #-}
    logBase :: ArrayBase t ds -> ArrayBase t ds -> ArrayBase t ds
logBase = (t -> t -> t) -> ArrayBase t ds -> ArrayBase t ds -> ArrayBase t ds
forall t (ds :: [Nat]).
(t -> t -> t) -> ArrayBase t ds -> ArrayBase t ds -> ArrayBase t ds
zipV t -> t -> t
forall a. Floating a => a -> a -> a
logBase
    {-# INLINE logBase #-}
    asinh :: ArrayBase t ds -> ArrayBase t ds
asinh = (t -> t) -> ArrayBase t ds -> ArrayBase t ds
forall t (ds :: [Nat]).
(t -> t) -> ArrayBase t ds -> ArrayBase t ds
mapV t -> t
forall a. Floating a => a -> a
asinh
    {-# INLINE asinh #-}
    acosh :: ArrayBase t ds -> ArrayBase t ds
acosh = (t -> t) -> ArrayBase t ds -> ArrayBase t ds
forall t (ds :: [Nat]).
(t -> t) -> ArrayBase t ds -> ArrayBase t ds
mapV t -> t
forall a. Floating a => a -> a
acosh
    {-# INLINE acosh #-}
    atanh :: ArrayBase t ds -> ArrayBase t ds
atanh = (t -> t) -> ArrayBase t ds -> ArrayBase t ds
forall t (ds :: [Nat]).
(t -> t) -> ArrayBase t ds -> ArrayBase t ds
mapV t -> t
forall a. Floating a => a -> a
atanh
    {-# INLINE atanh #-}

instance PrimBytes t => PrimArray t (ArrayBase t ds) where

    broadcast# :: t -> ArrayBase t ds
broadcast# t
t = (# t | (# CumulDims, Int#, ByteArray#, Dict (PrimBytes t) #) #)
-> ArrayBase t ds
forall t (ds :: [Nat]).
(# t | (# CumulDims, Int#, ByteArray#, Dict (PrimBytes t) #) #)
-> ArrayBase t ds
ArrayBase (# t
t | #)
    {-# INLINE broadcast# #-}

    gen# :: CumulDims -> (s -> (# s, t #)) -> s -> (# s, ArrayBase t ds #)
gen# CumulDims
steps s -> (# s, t #)
f s
z0 = Int# -> (# s, ArrayBase t ds #)
go (t -> Int#
forall a. PrimBytes a => a -> Int#
byteSize @t t
forall a. HasCallStack => a
undefined Int# -> Int# -> Int#
*# Int#
n)
      where
        n :: Int#
n = CumulDims -> Int#
cdTotalDim# CumulDims
steps
        go :: Int# -> (# s, ArrayBase t ds #)
go Int#
bsize = case (State# RealWorld -> (# State# RealWorld, (# s, ByteArray# #) #))
-> (# State# RealWorld, (# s, ByteArray# #) #)
forall o. (State# RealWorld -> o) -> o
runRW#
         ( \State# RealWorld
s0 -> case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
bsize State# RealWorld
s0 of
             (# State# RealWorld
s1, MutableByteArray# RealWorld
mba #) -> case MutableByteArray# RealWorld
-> Int# -> s -> State# RealWorld -> (# State# RealWorld, s #)
loop0 MutableByteArray# RealWorld
mba Int#
0# s
z0 State# RealWorld
s1 of
               (# State# RealWorld
s2, s
z1 #) -> case MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
mba State# RealWorld
s2 of
                 (# State# RealWorld
s3, ByteArray#
ba #) -> (# State# RealWorld
s3, (# s
z1, ByteArray#
ba #) #)
         ) of (# State# RealWorld
_, (# s
z1, ByteArray#
ba #) #)
                   -> (# s
z1, CumulDims -> Int# -> ByteArray# -> ArrayBase t ds
forall t (ds :: [Nat]).
PrimBytes t =>
CumulDims -> Int# -> ByteArray# -> ArrayBase t ds
fromElems' CumulDims
steps Int#
0# ByteArray#
ba #)
        loop0 :: MutableByteArray# RealWorld
-> Int# -> s -> State# RealWorld -> (# State# RealWorld, s #)
loop0 MutableByteArray# RealWorld
mba Int#
i s
z State# RealWorld
s
          | Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
==# Int#
n) = (# State# RealWorld
s, s
z #)
          | Bool
otherwise = case s -> (# s, t #)
f s
z of
              (# s
z', t
x #) -> MutableByteArray# RealWorld
-> Int# -> s -> State# RealWorld -> (# State# RealWorld, s #)
loop0 MutableByteArray# RealWorld
mba (Int#
i Int# -> Int# -> Int#
+# Int#
1#) s
z' (MutableByteArray# RealWorld
-> Int# -> t -> State# RealWorld -> State# RealWorld
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeArray MutableByteArray# RealWorld
mba Int#
i t
x State# RealWorld
s)
    {-# INLINE gen# #-}

    upd# :: CumulDims -> Int# -> t -> ArrayBase t ds -> ArrayBase t ds
upd# CumulDims
steps Int#
i t
x = (t -> ArrayBase t ds)
-> (CumulDims -> Int# -> ByteArray# -> ArrayBase t ds)
-> ArrayBase t ds
-> ArrayBase t ds
forall t (ds :: [Nat]) r.
(t -> r)
-> (CumulDims -> Int# -> ByteArray# -> r) -> ArrayBase t ds -> r
withArrayContent' t -> ArrayBase t ds
f CumulDims -> Int# -> ByteArray# -> ArrayBase t ds
g
      where
        n :: Int#
n = CumulDims -> Int#
cdTotalDim# CumulDims
steps
        f :: t -> ArrayBase t ds
f t
a = Int# -> ArrayBase t ds
go (t -> Int#
forall a. PrimBytes a => a -> Int#
byteSize t
x)
          where
            go :: Int# -> ArrayBase t ds
go Int#
tbs = case (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> (# State# RealWorld, ByteArray# #)
forall o. (State# RealWorld -> o) -> o
runRW#
             ( \State# RealWorld
s0 -> case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (Int#
tbs Int# -> Int# -> Int#
*# Int#
n) State# RealWorld
s0 of
                 (# State# RealWorld
s1, MutableByteArray# RealWorld
mba #) -> MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
mba
                   (MutableByteArray# RealWorld
-> Int# -> t -> State# RealWorld -> State# RealWorld
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeArray MutableByteArray# RealWorld
mba Int#
i t
x
                     (Int#
-> (Int# -> State# RealWorld -> State# RealWorld)
-> State# RealWorld
-> State# RealWorld
forall s.
Int# -> (Int# -> State# s -> State# s) -> State# s -> State# s
loop1# Int#
n (\Int#
j -> MutableByteArray# RealWorld
-> Int# -> t -> State# RealWorld -> State# RealWorld
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeArray MutableByteArray# RealWorld
mba Int#
j t
a) State# RealWorld
s1)
                   )
             ) of (# State# RealWorld
_, ByteArray#
r #) -> CumulDims -> Int# -> ByteArray# -> ArrayBase t ds
forall t (ds :: [Nat]).
PrimBytes t =>
CumulDims -> Int# -> ByteArray# -> ArrayBase t ds
fromElems' CumulDims
steps Int#
0# ByteArray#
r
        g :: CumulDims -> Int# -> ByteArray# -> ArrayBase t ds
g CumulDims
_ Int#
offN ByteArray#
ba = Int# -> ArrayBase t ds
go (t -> Int#
forall a. PrimBytes a => a -> Int#
byteSize t
x)
          where
            go :: Int# -> ArrayBase t ds
go Int#
tbs = case (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> (# State# RealWorld, ByteArray# #)
forall o. (State# RealWorld -> o) -> o
runRW#
             ( \State# RealWorld
s0 -> case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (Int#
tbs Int# -> Int# -> Int#
*# Int#
n) State# RealWorld
s0 of
                 (# State# RealWorld
s1, MutableByteArray# RealWorld
mba #) -> MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
mba
                   (MutableByteArray# RealWorld
-> Int# -> t -> State# RealWorld -> State# RealWorld
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeArray MutableByteArray# RealWorld
mba Int#
i t
x
                     (ByteArray#
-> Int#
-> MutableByteArray# RealWorld
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall d.
ByteArray#
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyByteArray# ByteArray#
ba (Int#
offN Int# -> Int# -> Int#
*# Int#
tbs) MutableByteArray# RealWorld
mba Int#
0# (Int#
tbs Int# -> Int# -> Int#
*# Int#
n) State# RealWorld
s1)
                   )
             ) of (# State# RealWorld
_, ByteArray#
r #) -> CumulDims -> Int# -> ByteArray# -> ArrayBase t ds
forall t (ds :: [Nat]).
PrimBytes t =>
CumulDims -> Int# -> ByteArray# -> ArrayBase t ds
fromElems' CumulDims
steps Int#
0# ByteArray#
r
    {-# INLINE upd# #-}

    withArrayContent# :: (t -> r)
-> (CumulDims -> Int# -> ByteArray# -> r) -> ArrayBase t ds -> r
withArrayContent# = (t -> r)
-> (CumulDims -> Int# -> ByteArray# -> r) -> ArrayBase t ds -> r
forall t (ds :: [Nat]) r.
(t -> r)
-> (CumulDims -> Int# -> ByteArray# -> r) -> ArrayBase t ds -> r
withArrayContent'
    {-# INLINE withArrayContent# #-}

    fromElems# :: CumulDims -> Int# -> ByteArray# -> ArrayBase t ds
fromElems# = CumulDims -> Int# -> ByteArray# -> ArrayBase t ds
forall t (ds :: [Nat]).
PrimBytes t =>
CumulDims -> Int# -> ByteArray# -> ArrayBase t ds
fromElems'
    {-# INLINE fromElems# #-}

withArrayContent' ::
       forall (t :: Type) (ds :: [Nat]) (rep :: RuntimeRep) (r :: TYPE rep)
     . (t -> r)
    -> (CumulDims -> Int# -> ByteArray# -> r)
    -> ArrayBase t ds -> r
withArrayContent' :: (t -> r)
-> (CumulDims -> Int# -> ByteArray# -> r) -> ArrayBase t ds -> r
withArrayContent' t -> r
f CumulDims -> Int# -> ByteArray# -> r
_ (ArrayBase (# t
e | #)) = t -> r
f t
e
withArrayContent' t -> r
_ CumulDims -> Int# -> ByteArray# -> r
g (ArrayBase (# | (# CumulDims
steps, Int#
off, ByteArray#
ba, Dict (PrimBytes t)
_ #) #)) = CumulDims -> Int# -> ByteArray# -> r
g CumulDims
steps Int#
off (ByteArray# -> ByteArray#
workaroundUSum ByteArray#
ba)
{-# INLINE withArrayContent' #-}

{- A workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/19645 -}
workaroundUSum :: ByteArray# -> ByteArray#
workaroundUSum :: ByteArray# -> ByteArray#
workaroundUSum ByteArray#
x = ByteArray#
x
{-# NOINLINE workaroundUSum #-}

fromElems' :: forall (t :: Type) (ds :: [Nat])
            . PrimBytes t => CumulDims -> Int# -> ByteArray# -> ArrayBase t ds
fromElems' :: CumulDims -> Int# -> ByteArray# -> ArrayBase t ds
fromElems' CumulDims
steps Int#
off ByteArray#
ba = (# t | (# CumulDims, Int#, ByteArray#, Dict (PrimBytes t) #) #)
-> ArrayBase t ds
forall t (ds :: [Nat]).
(# t | (# CumulDims, Int#, ByteArray#, Dict (PrimBytes t) #) #)
-> ArrayBase t ds
ArrayBase (# | (# CumulDims
steps, Int#
off, ByteArray#
ba, Dict (PrimBytes t)
forall (a :: Constraint). a => Dict a
Dict #) #)
{-# INLINE fromElems' #-}

broadcast' :: t -> ArrayBase t ds
broadcast' :: t -> ArrayBase t ds
broadcast' t
t = (# t | (# CumulDims, Int#, ByteArray#, Dict (PrimBytes t) #) #)
-> ArrayBase t ds
forall t (ds :: [Nat]).
(# t | (# CumulDims, Int#, ByteArray#, Dict (PrimBytes t) #) #)
-> ArrayBase t ds
ArrayBase (# t
t | #)
{-# INLINE broadcast' #-}

totalDim# :: forall (ds :: [Nat]) . Dimensions ds => Int#
totalDim# :: Int#
totalDim# = case Dimensions ds => Word
forall k (xs :: [k]). Dimensions xs => Word
totalDim' @ds of W# Word#
n -> Word# -> Int#
word2Int# Word#
n
{-# INLINE totalDim# #-}

loop# :: Int# -- ^ initial value
      -> Int# -- ^ step
      -> Int# -- ^ final value (LESS THAN condition)
      -> (Int# -> State# s -> State# s) -> State# s -> State# s
loop# :: Int#
-> Int#
-> Int#
-> (Int# -> State# s -> State# s)
-> State# s
-> State# s
loop# Int#
n0 Int#
di Int#
n1 Int# -> State# s -> State# s
f = Int# -> State# s -> State# s
loop0 Int#
n0
  where
    loop0 :: Int# -> State# s -> State# s
loop0 Int#
i State# s
s | Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
>=# Int#
n1) = State# s
s
              | Bool
otherwise = Int# -> State# s -> State# s
loop0 (Int#
i Int# -> Int# -> Int#
+# Int#
di) (Int# -> State# s -> State# s
f Int#
i State# s
s)
{-# INLINE loop# #-}


-- | Do something in a loop for int i from 0 to (n-1)
loop1# :: Int# -> (Int# -> State# s -> State# s) -> State# s -> State# s
loop1# :: Int# -> (Int# -> State# s -> State# s) -> State# s -> State# s
loop1# Int#
n Int# -> State# s -> State# s
f = Int# -> State# s -> State# s
loop0 Int#
0#
  where
    loop0 :: Int# -> State# s -> State# s
loop0 Int#
i State# s
s | Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
==# Int#
n) = State# s
s
              | Bool
otherwise = Int# -> State# s -> State# s
loop0 (Int#
i Int# -> Int# -> Int#
+# Int#
1#) (Int# -> State# s -> State# s
f Int#
i State# s
s)
{-# INLINE loop1# #-}

undefEl :: ArrayBase t ds -> t
undefEl :: ArrayBase t ds -> t
undefEl = t -> ArrayBase t ds -> t
forall a b. a -> b -> a
const t
forall a. HasCallStack => a
undefined