{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}

-- | This module gives a library of different vector types.
--
-- = Basic use
--
-- A typical 1-dimensional vector computation goes as follows:
--
-- 1. Start with a 'Manifest' vector (one that is refers directly to an array in
--   memory).
--
-- 2. Apply operations overloaded by 'Pully' (e.g. 'take', 'drop', 'map',
--    'reverse'). The result is one or more 'Pull' vectors.
--
-- 3. If the previous step resulted in several parts, assemble them using
--    operations overloaded by 'Pushy' (e.g. '++'). The result is a 'Push'
--    vector.
--
-- 4. Write the vector to memory using 'manifest' or 'manifestFresh'.
--
-- (Of course, there are many variations on this general scheme.)
--
-- Note that it's possible to skip step \#2 or \#3 above. For example, it's
-- possible to directly concatenate two 'Manifest' vectors using '++', and
-- 'manifest' can be applied directly to a 'Pull' vector (or even to a
-- 'Manifest', in which case it becomes a no-op).
--
--
--
-- = Efficiency and fusion
--
-- The library has been designed so that all operations fuse together without
-- creating any intermediate structures in memory. The only exception is the
-- operations that produce 'Manifest' or 'Manifest2' vectors ('manifest',
-- 'manifest2', etc.).
--
-- For example, the following function only creates a single structure in memory
-- even though it seemingly generates several intermediate vectors:
--
-- @
-- f :: (`Num` a, `Syntax` a, `MonadComp` m) => `Pull` a -> m (`Manifest` a)
-- f = `manifestFresh` . `reverse` . `map` (*2) . `take` 10
-- @
--
-- Furthermore, the operations associated with each type of vector are
-- restricted to operations that can be carried out efficiently for that type.
-- For example, although it would be possible to implement append for 'Pull'
-- vectors, doing so results in unnecessary conditionals in the generated code.
-- Therefore, the '++' operator returns a 'Push' vector, which ensures efficient
-- generated code.
--
-- In many cases, the cycle 'Manifest' -> 'Pull' -> 'Push' -> 'Manifest' is
-- guided by the types of the operations involved. However, there are cases when
-- it's preferable to shortcut the cycle even when it's not demanded by the
-- types. The reason is that fusion can lead to duplicated computations.
--
-- Here is an example where fusion leads to redundant computations:
--
-- @
-- bad = do
--     v :: `DManifest` `Int32` <- `readStd`  -- Read from stdin
--     let v'  = `map` heavy v
--         v'' = v' `++` `reverse` v'
--     `writeStd` v''                     -- Write to stdout
-- @
--
-- Since @v'@ is used twice in defining @v''@, the mapping of the @heavy@
-- computation will be done twice when writing @v''@ to the output. One way to
-- prevent this is to perform the heavy mapping once, store the result in
-- memory, and define @v''@ from the stored vector:
--
-- @
-- good = do
--     v :: `DManifest` `Int32` <- `readStd`  -- Read from stdin
--     v' <- `manifestFresh` $ `map` heavy v
--     let v'' = v' `++` `reverse` v'
--     `writeStd` v''                     -- Write to stdout
-- @
--
-- Even though the examples are called @bad@ and @good@, there's not a clear-cut
-- answer to which version is best. It could depend on whether time or
-- memory is the most scarce resource. This library leaves the decision in the
-- hands of the programmer.
--
--
--
-- = Working with matrices
--
-- 2-dimensional matrix computations can follow a scheme similar to the above by
-- using the types 'Manifest2', 'Pull2' and 'Push2' and the corresponding
-- operations.
--
-- A quite common situation is the need to apply an operation on each row or
-- column of a matrix. Operating on the rows can be done by a combination of
-- 'exposeRows' and 'hideRows'. For example, this function reverses each row in
-- a matrix:
--
-- @
-- revEachRow :: `MonadComp` m => `Pull2` a -> `Push2` m a
-- revEachRow mat = `hideRows` (`numCols` mat) $ `map` `reverse` $ `exposeRows` mat
-- @
--
-- 'exposeRows' takes a 'Pully2' matrix and turns it into @`Pull` (`Pull` a)@
-- i.e. a vector of row vectors. 'map' is used to apply 'reverse' to each row.
-- Finally, 'hideRows' turns the nested vector it back into a matrix, of type
-- 'Push2'.
--
-- Note that 'hideRows' generally cannot know the length of the rows, so this
-- number has to be provided as its first argument. When compiling with
-- assertions, it will be checked at runtime that the length of each row is
-- equal to the given length.
--
-- In order to operate on the columns instead of the rows, just apply
-- 'transpose' on the original matrix. This operation will fuse with the rest of
-- the computation.
--
-- It gets a bit more complicated when the operation applied to each row is
-- effectful. For example, the operation may have to use 'manifest' internally
-- giving it a monadic result type. In such situations, the function 'sequens'
-- is helpful. It is a bit similar to the standard function @sequence@ for
-- lists, execept that it converts @`Push` m (m a)@ into @`Push` m a@; i.e. it
-- embeds the effect into the resulting 'Push' vector.
--
-- Here is a version of the previous example where the row operation is
-- effectful (due to 'manifestFresh') and 'sequens' is inserted to embed the
-- effects:
--
-- @
-- revEachRowM :: (`Syntax` a, `MonadComp` m) => `Pull2` a -> `Push2` m a
-- revEachRowM mat = `hideRows` (`numCols` mat) $ `sequens`
--                 $ `map` (`manifestFresh` . `reverse`) $ `exposeRows` mat
--
-- @
--
-- Note that 'sequens' is generally a dangerous function due to the hiding of
-- effects inside the resulting vector. These effects may be (seemingly)
-- randomly interleaved with other effects when the vector is used. However, the
-- above example is fine, since 'manifestFresh' allocates a fresh array for the
-- storage, so its effects cannot be observed from the outside.
--
-- The comments to 'Push' elaborate more on the semantics of push vectors with
-- interleaved effects.

module Feldspar.Data.Vector
  ( module Feldspar.Data.Array
  , module Feldspar.Data.Vector
  ) where



import qualified Prelude

import Data.List (genericLength)
import Data.Proxy

import Feldspar
import Feldspar.Data.Array
import Feldspar.Run
import Feldspar.Run.Concurrent
import qualified Language.Embedded.Concurrent as Imp



-- This library has been inspired by the vector library in feldspar-language:
-- <https://github.com/Feldspar/feldspar-language/blob/master/src/Feldspar/Vector.hs>
--
-- The general idea of pull and push vectors is described in
-- "Combining deep and shallow embedding of domain-specific languages"
-- <http://dx.doi.org/10.1016/j.cl.2015.07.003>.
--
-- Push arrays were originally introduced in
-- "Expressive array constructs in an embedded GPU kernel programming language"
-- <http://dx.doi.org/10.1145/2103736.2103740>.



--------------------------------------------------------------------------------
-- * 1-dimensional manifest vectors
--------------------------------------------------------------------------------

-- | A 1-dimensional vector with a concrete representation in memory
--
-- There are two main reasons to use 'Manifest' when possible instead of `Pull`:
--
-- * The operations of the 'Manifestable' class are more efficient for
--   'Manifest'. They either result in a no-op or an efficient memory-copy
--   (instead of a copying loop).
--
-- * 'Manifest' can be freely converted to/from a 2-dimensional structure using
--   'nest' and 'unnest'. Note that the representation of 'Manifest2' is
--   @`Nest` (`Manifest` a)@.
type Manifest = IArr

-- | 'Manifest' vector specialized to 'Data' elements
type DManifest a = DIArr a

-- | Treated as a row vector
instance Finite2 (Manifest a) where extent2 :: Manifest a -> (Data Length, Data Length)
extent2 Manifest a
v = (Data Length
1, Manifest a -> Data Length
forall a. Finite a => a -> Data Length
length Manifest a
v)

-- | Make a 'Manifest' vector from a list of values
listManifest :: (Syntax a, MonadComp m) => [a] -> m (Manifest a)
listManifest :: [a] -> m (Manifest a)
listManifest = Push m a -> m (Manifest a)
forall (m :: * -> *) vec a.
(Manifestable m vec a, Syntax a) =>
vec -> m (Manifest a)
manifestFresh (Push m a -> m (Manifest a))
-> ([a] -> Push m a) -> [a] -> m (Manifest a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Push m a
forall (m :: * -> *) a. Monad m => [a] -> Push m a
listPush



--------------------------------------------------------------------------------
-- * 2-dimensional manifest vectors
--------------------------------------------------------------------------------

-- | A 2-dimensional vector with a concrete representation in memory
type Manifest2 a = Nest (Manifest a)

-- | 'Manifest2' vector specialized to 'Data' elements
type DManifest2 a = Manifest2 (Data a)



--------------------------------------------------------------------------------
-- * 1-dimensional pull vectors
--------------------------------------------------------------------------------

-- | 1-dimensional pull vector: a vector representation that supports random
-- access and fusion of operations
data Pull a where
    Pull
        :: Data Length        -- Length of vector
        -> (Data Index -> a)  -- Index function
        -> Pull a

-- | 'Pull' vector specialized to 'Data' elements
type DPull a = Pull (Data a)

instance Functor Pull
  where
    fmap :: (a -> b) -> Pull a -> Pull b
fmap a -> b
f (Pull Data Length
len Data Length -> a
ixf) = Data Length -> (Data Length -> b) -> Pull b
forall a. Data Length -> (Data Length -> a) -> Pull a
Pull Data Length
len (a -> b
f (a -> b) -> (Data Length -> a) -> Data Length -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data Length -> a
ixf)

-- It would be possible to have the instance:
--
--     instance Applicative Pull
--       where
--         pure a  = Pull 1 (const a)
--         Pull len1 ixf1 <*> Pull len2 ixf2 = Pull (len1*len2) $ \i ->
--             let k = i `div` len2
--                 l = i `mod` len2
--             in  ixf1 k $ ixf2 l
--
-- However, it has been omitted due to the use of `div` and `mod`.

instance Indexed (Pull a)
  where
    type IndexedElem (Pull a) = a
    Pull Data Length
len Data Length -> a
ixf ! :: Pull a -> Data Length -> IndexedElem (Pull a)
! Data Length
i = Data Length -> a
ixf (Data Length -> a) -> Data Length -> a
forall a b. (a -> b) -> a -> b
$ AssertionLabel -> Data Bool -> String -> Data Length -> Data Length
forall a.
Syntax a =>
AssertionLabel -> Data Bool -> String -> a -> a
guardValLabel
      AssertionLabel
InternalAssertion
      (Data Length
i Data Length -> Data Length -> Data Bool
forall a. (Ord a, PrimType a) => Data a -> Data a -> Data Bool
< Data Length
len)
      String
"indexing outside of Pull vector"
      Data Length
i

instance Finite (Pull a)
  where
    length :: Pull a -> Data Length
length (Pull Data Length
len Data Length -> a
_) = Data Length
len

-- | Treated as a row vector
instance Finite2 (Pull a) where extent2 :: Pull a -> (Data Length, Data Length)
extent2 Pull a
v = (Data Length
1, Pull a -> Data Length
forall a. Finite a => a -> Data Length
length Pull a
v)

instance Slicable (Pull a)
  where
    slice :: Data Length -> Data Length -> Pull a -> Pull a
slice Data Length
from Data Length
n = Data Length -> Pull a -> Pull a
forall vec a. Pully vec a => Data Length -> vec -> Pull a
take Data Length
n (Pull a -> Pull a) -> (Pull a -> Pull a) -> Pull a -> Pull a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data Length -> Pull a -> Pull a
forall vec a. Pully vec a => Data Length -> vec -> Pull a
drop Data Length
from

instance
    ( Syntax a
    , MarshalHaskell (Internal a)
    , MarshalFeld a
    ) =>
      MarshalFeld (Pull a)
  where
    type HaskellRep (Pull a) = HaskellRep (Manifest a)
    fwrite :: Handle -> Pull a -> Run ()
fwrite Handle
hdl = Handle -> Seq Run a -> Run ()
forall a. MarshalFeld a => Handle -> a -> Run ()
fwrite Handle
hdl (Seq Run a -> Run ()) -> (Pull a -> Seq Run a) -> Pull a -> Run ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pull a -> Seq Run a
forall (m :: * -> *) vec a. Seqy m vec a => vec -> Seq m a
toSeq
    fread :: Handle -> Run (Pull a)
fread Handle
hdl  = (Manifest a -> Pull a
forall vec a. Pully vec a => vec -> Pull a
toPull :: Manifest a -> _) (Manifest a -> Pull a) -> Run (Manifest a) -> Run (Pull a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> Run (Manifest a)
forall a. MarshalFeld a => Handle -> Run a
fread Handle
hdl

data VecChanSizeSpec lenSpec = VecChanSizeSpec (Data Length) lenSpec

ofLength :: Data Length -> lenSpec -> VecChanSizeSpec lenSpec
ofLength :: Data Length -> lenSpec -> VecChanSizeSpec lenSpec
ofLength = Data Length -> lenSpec -> VecChanSizeSpec lenSpec
forall lenSpec. Data Length -> lenSpec -> VecChanSizeSpec lenSpec
VecChanSizeSpec

instance ( Syntax a, BulkTransferable a
         , ContainerType a ~ Arr a
         ) => Transferable (Pull a)
  where
    type SizeSpec (Pull a) = VecChanSizeSpec (SizeSpec a)
    calcChanSize :: proxy (Pull a)
-> SizeSpec (Pull a) -> ChanSize Data PrimType' Length
calcChanSize proxy (Pull a)
_ (VecChanSizeSpec n m) =
        let hsz :: ChanSize Data PrimType' Length
hsz = Data Length
n Data Length -> Proxy Length -> ChanSize Data PrimType' Length
forall k (pred :: k -> Constraint) (a :: k) i (exp :: * -> *)
       (proxy :: k -> *).
(pred a, Integral i) =>
exp i -> proxy a -> ChanSize exp pred i
`Imp.timesSizeOf` (Proxy Length
forall k (t :: k). Proxy t
Proxy :: Proxy Length)
            bsz :: ChanSize Data PrimType' Length
bsz = Proxy a -> SizeSpec a -> ChanSize Data PrimType' Length
forall a (proxy :: * -> *).
Transferable a =>
proxy a -> SizeSpec a -> ChanSize Data PrimType' Length
calcChanSize (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) SizeSpec a
m
        in  ChanSize Data PrimType' Length
hsz ChanSize Data PrimType' Length
-> ChanSize Data PrimType' Length -> ChanSize Data PrimType' Length
forall k i (exp :: * -> *) (pred :: k -> Constraint).
Integral i =>
ChanSize exp pred i -> ChanSize exp pred i -> ChanSize exp pred i
`Imp.plusSize` (Data Length
n Data Length
-> ChanSize Data PrimType' Length -> ChanSize Data PrimType' Length
forall k i (exp :: * -> *) (pred :: k -> Constraint).
Integral i =>
exp i -> ChanSize exp pred i -> ChanSize exp pred i
`Imp.timesSize` ChanSize Data PrimType' Length
bsz)
    untypedReadChan :: Chan t c -> Run (Pull a)
untypedReadChan Chan t c
c = do
        Data Length
len :: Data Length <- Chan t c -> Run (Data Length)
forall a t c. Transferable a => Chan t c -> Run a
untypedReadChan Chan t c
c
        Arr a
arr <- Data Length -> Run (Arr a)
forall a (m :: * -> *).
(Type (Internal a), MonadComp m) =>
Data Length -> m (Arr a)
newArr Data Length
len
        Proxy a
-> Chan t c
-> Data Length
-> Data Length
-> ContainerType a
-> Run (Data Bool)
forall a (proxy :: * -> *) t c.
BulkTransferable a =>
proxy a
-> Chan t c
-> Data Length
-> Data Length
-> ContainerType a
-> Run (Data Bool)
untypedReadChanBuf (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) Chan t c
c Data Length
0 Data Length
len Arr a
ContainerType a
arr
        IArr a -> Pull a
forall vec a. Pully vec a => vec -> Pull a
toPull (IArr a -> Pull a) -> Run (IArr a) -> Run (Pull a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arr a -> Run (IArr a)
forall (m :: * -> *) a. MonadComp m => Arr a -> m (IArr a)
unsafeFreezeArr Arr a
arr
    untypedWriteChan :: Chan t c -> Pull a -> Run (Data Bool)
untypedWriteChan Chan t c
c Pull a
v = do
        -- TODO: can we avoid an array copy here if v is already manifest?
        Arr a
arr <- IArr a -> Run (Arr a)
forall (m :: * -> *) a. MonadComp m => IArr a -> m (Arr a)
unsafeThawArr (IArr a -> Run (Arr a)) -> Run (IArr a) -> Run (Arr a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Pull a -> Run (IArr a)
forall (m :: * -> *) vec a.
(Manifestable m vec a, Syntax a) =>
vec -> m (Manifest a)
manifestFresh Pull a
v
        Chan t c -> Data Length -> Run (Data Bool)
forall a t c. Transferable a => Chan t c -> a -> Run (Data Bool)
untypedWriteChan Chan t c
c Data Length
len
        Proxy a
-> Chan t c
-> Data Length
-> Data Length
-> ContainerType a
-> Run (Data Bool)
forall a (proxy :: * -> *) t c.
BulkTransferable a =>
proxy a
-> Chan t c
-> Data Length
-> Data Length
-> ContainerType a
-> Run (Data Bool)
untypedWriteChanBuf (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) Chan t c
c Data Length
0 Data Length
len Arr a
ContainerType a
arr
      where
        len :: Data Length
len = Pull a -> Data Length
forall a. Finite a => a -> Data Length
length Pull a
v
 -- TODO Make instances for other vector types

instance ( Syntax a, BulkTransferable a
         , ContainerType a ~ Arr a
         ) => Transferable (IArr a)
  where
    type SizeSpec (IArr a) = VecChanSizeSpec (SizeSpec a)
    calcChanSize :: proxy (IArr a)
-> SizeSpec (IArr a) -> ChanSize Data PrimType' Length
calcChanSize proxy (IArr a)
_ (VecChanSizeSpec n m) =
        let hsz :: ChanSize Data PrimType' Length
hsz = Data Length
n Data Length -> Proxy Length -> ChanSize Data PrimType' Length
forall k (pred :: k -> Constraint) (a :: k) i (exp :: * -> *)
       (proxy :: k -> *).
(pred a, Integral i) =>
exp i -> proxy a -> ChanSize exp pred i
`Imp.timesSizeOf` (Proxy Length
forall k (t :: k). Proxy t
Proxy :: Proxy Length)
            bsz :: ChanSize Data PrimType' Length
bsz = Proxy a -> SizeSpec a -> ChanSize Data PrimType' Length
forall a (proxy :: * -> *).
Transferable a =>
proxy a -> SizeSpec a -> ChanSize Data PrimType' Length
calcChanSize (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) SizeSpec a
m
        in  ChanSize Data PrimType' Length
hsz ChanSize Data PrimType' Length
-> ChanSize Data PrimType' Length -> ChanSize Data PrimType' Length
forall k i (exp :: * -> *) (pred :: k -> Constraint).
Integral i =>
ChanSize exp pred i -> ChanSize exp pred i -> ChanSize exp pred i
`Imp.plusSize` (Data Length
n Data Length
-> ChanSize Data PrimType' Length -> ChanSize Data PrimType' Length
forall k i (exp :: * -> *) (pred :: k -> Constraint).
Integral i =>
exp i -> ChanSize exp pred i -> ChanSize exp pred i
`Imp.timesSize` ChanSize Data PrimType' Length
bsz)
    untypedReadChan :: Chan t c -> Run (IArr a)
untypedReadChan Chan t c
c = do
        Data Length
len :: Data Length <- Chan t c -> Run (Data Length)
forall a t c. Transferable a => Chan t c -> Run a
untypedReadChan Chan t c
c
        Arr a
arr <- Data Length -> Run (Arr a)
forall a (m :: * -> *).
(Type (Internal a), MonadComp m) =>
Data Length -> m (Arr a)
newArr Data Length
len
        Proxy a
-> Chan t c
-> Data Length
-> Data Length
-> ContainerType a
-> Run (Data Bool)
forall a (proxy :: * -> *) t c.
BulkTransferable a =>
proxy a
-> Chan t c
-> Data Length
-> Data Length
-> ContainerType a
-> Run (Data Bool)
untypedReadChanBuf (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) Chan t c
c Data Length
0 Data Length
len Arr a
ContainerType a
arr
        Arr a -> Run (IArr a)
forall (m :: * -> *) a. MonadComp m => Arr a -> m (IArr a)
unsafeFreezeArr Arr a
arr
    untypedWriteChan :: Chan t c -> IArr a -> Run (Data Bool)
untypedWriteChan Chan t c
c IArr a
v = do
        Arr a
arr <- IArr a -> Run (Arr a)
forall (m :: * -> *) a. MonadComp m => IArr a -> m (Arr a)
unsafeThawArr IArr a
v
        Chan t c -> Data Length -> Run (Data Bool)
forall a t c. Transferable a => Chan t c -> a -> Run (Data Bool)
untypedWriteChan Chan t c
c Data Length
len
        Proxy a
-> Chan t c
-> Data Length
-> Data Length
-> ContainerType a
-> Run (Data Bool)
forall a (proxy :: * -> *) t c.
BulkTransferable a =>
proxy a
-> Chan t c
-> Data Length
-> Data Length
-> ContainerType a
-> Run (Data Bool)
untypedWriteChanBuf (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) Chan t c
c Data Length
0 Data Length
len Arr a
ContainerType a
arr
      where
        len :: Data Length
len = IArr a -> Data Length
forall a. Finite a => a -> Data Length
length IArr a
v

instance ( Syntax a, BulkTransferable a
         , ContainerType a ~ Arr a
         ) => Transferable (Arr a)
  where
    type SizeSpec (Arr a) = VecChanSizeSpec (SizeSpec a)
    calcChanSize :: proxy (Arr a) -> SizeSpec (Arr a) -> ChanSize Data PrimType' Length
calcChanSize proxy (Arr a)
_ (VecChanSizeSpec n m) =
        let hsz :: ChanSize Data PrimType' Length
hsz = Data Length
n Data Length -> Proxy Length -> ChanSize Data PrimType' Length
forall k (pred :: k -> Constraint) (a :: k) i (exp :: * -> *)
       (proxy :: k -> *).
(pred a, Integral i) =>
exp i -> proxy a -> ChanSize exp pred i
`Imp.timesSizeOf` (Proxy Length
forall k (t :: k). Proxy t
Proxy :: Proxy Length)
            bsz :: ChanSize Data PrimType' Length
bsz = Proxy a -> SizeSpec a -> ChanSize Data PrimType' Length
forall a (proxy :: * -> *).
Transferable a =>
proxy a -> SizeSpec a -> ChanSize Data PrimType' Length
calcChanSize (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) SizeSpec a
m
        in  ChanSize Data PrimType' Length
hsz ChanSize Data PrimType' Length
-> ChanSize Data PrimType' Length -> ChanSize Data PrimType' Length
forall k i (exp :: * -> *) (pred :: k -> Constraint).
Integral i =>
ChanSize exp pred i -> ChanSize exp pred i -> ChanSize exp pred i
`Imp.plusSize` (Data Length
n Data Length
-> ChanSize Data PrimType' Length -> ChanSize Data PrimType' Length
forall k i (exp :: * -> *) (pred :: k -> Constraint).
Integral i =>
exp i -> ChanSize exp pred i -> ChanSize exp pred i
`Imp.timesSize` ChanSize Data PrimType' Length
bsz)
    untypedReadChan :: Chan t c -> Run (Arr a)
untypedReadChan Chan t c
c = do
        Data Length
len :: Data Length <- Chan t c -> Run (Data Length)
forall a t c. Transferable a => Chan t c -> Run a
untypedReadChan Chan t c
c
        Arr a
arr <- Data Length -> Run (Arr a)
forall a (m :: * -> *).
(Type (Internal a), MonadComp m) =>
Data Length -> m (Arr a)
newArr Data Length
len
        Proxy a
-> Chan t c
-> Data Length
-> Data Length
-> ContainerType a
-> Run (Data Bool)
forall a (proxy :: * -> *) t c.
BulkTransferable a =>
proxy a
-> Chan t c
-> Data Length
-> Data Length
-> ContainerType a
-> Run (Data Bool)
untypedReadChanBuf (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) Chan t c
c Data Length
0 Data Length
len Arr a
ContainerType a
arr
        Arr a -> Run (Arr a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Arr a
arr
    untypedWriteChan :: Chan t c -> Arr a -> Run (Data Bool)
untypedWriteChan Chan t c
c Arr a
v = do
        Chan t c -> Data Length -> Run (Data Bool)
forall a t c. Transferable a => Chan t c -> a -> Run (Data Bool)
untypedWriteChan Chan t c
c Data Length
len
        Proxy a
-> Chan t c
-> Data Length
-> Data Length
-> ContainerType a
-> Run (Data Bool)
forall a (proxy :: * -> *) t c.
BulkTransferable a =>
proxy a
-> Chan t c
-> Data Length
-> Data Length
-> ContainerType a
-> Run (Data Bool)
untypedWriteChanBuf (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) Chan t c
c Data Length
0 Data Length
len Arr a
ContainerType a
v
      where
        len :: Data Length
len = Arr a -> Data Length
forall a. Finite a => a -> Data Length
length Arr a
v

-- | Data structures that are 'Pull'-like (i.e. support '!' and 'length')
class    (Indexed vec, Finite vec, IndexedElem vec ~ a) => Pully vec a
instance (Indexed vec, Finite vec, IndexedElem vec ~ a) => Pully vec a

-- | Convert a vector to 'Pull'
toPull :: Pully vec a => vec -> Pull a
toPull :: vec -> Pull a
toPull vec
vec = Data Length -> (Data Length -> a) -> Pull a
forall a. Data Length -> (Data Length -> a) -> Pull a
Pull (vec -> Data Length
forall a. Finite a => a -> Data Length
length vec
vec) (vec
vecvec -> Data Length -> IndexedElem vec
forall a. Indexed a => a -> Data Length -> IndexedElem a
!)



----------------------------------------
-- ** Operations
----------------------------------------

-- | Take the head of a non-empty vector
head :: Pully vec a => vec -> a
head :: vec -> a
head = (vec -> Data Length -> IndexedElem vec
forall a. Indexed a => a -> Data Length -> IndexedElem a
! Data Length
0)

tail :: Pully vec a => vec -> Pull a
tail :: vec -> Pull a
tail = Data Length -> vec -> Pull a
forall vec a. Pully vec a => Data Length -> vec -> Pull a
drop Data Length
1

take :: Pully vec a => Data Length -> vec -> Pull a
take :: Data Length -> vec -> Pull a
take Data Length
l vec
vec = Data Length -> (Data Length -> a) -> Pull a
forall a. Data Length -> (Data Length -> a) -> Pull a
Pull (Data Length -> Data Length -> Data Length
forall a. (Ord a, PrimType a) => Data a -> Data a -> Data a
min (vec -> Data Length
forall a. Finite a => a -> Data Length
length vec
vec) Data Length
l) (vec
vecvec -> Data Length -> IndexedElem vec
forall a. Indexed a => a -> Data Length -> IndexedElem a
!)

drop :: Pully vec a => Data Length -> vec -> Pull a
drop :: Data Length -> vec -> Pull a
drop Data Length
l vec
vec = Data Length -> (Data Length -> a) -> Pull a
forall a. Data Length -> (Data Length -> a) -> Pull a
Pull (Data Bool -> Data Length
forall a. (Integral a, PrimType a) => Data Bool -> Data a
b2i (Data Length
lData Length -> Data Length -> Data Bool
forall a. (Ord a, PrimType a) => Data a -> Data a -> Data Bool
<=Data Length
m) Data Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
* (Data Length
mData Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
-Data Length
l)) ((vec
vecvec -> Data Length -> IndexedElem vec
forall a. Indexed a => a -> Data Length -> IndexedElem a
!) (Data Length -> a)
-> (Data Length -> Data Length) -> Data Length -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Data Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
+Data Length
l))
  where
    m :: Data Length
m = vec -> Data Length
forall a. Finite a => a -> Data Length
length vec
vec

tails :: Pully vec a => vec -> Pull (Pull a)
tails :: vec -> Pull (Pull a)
tails vec
vec = Data Length -> (Data Length -> Pull a) -> Pull (Pull a)
forall a. Data Length -> (Data Length -> a) -> Pull a
Pull (vec -> Data Length
forall a. Finite a => a -> Data Length
length vec
vec Data Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
+ Data Length
1) (Data Length -> vec -> Pull a
forall vec a. Pully vec a => Data Length -> vec -> Pull a
`drop` vec
vec)

inits :: Pully vec a => vec -> Pull (Pull a)
inits :: vec -> Pull (Pull a)
inits vec
vec = Data Length -> (Data Length -> Pull a) -> Pull (Pull a)
forall a. Data Length -> (Data Length -> a) -> Pull a
Pull (vec -> Data Length
forall a. Finite a => a -> Data Length
length vec
vec Data Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
+ Data Length
1) (Data Length -> vec -> Pull a
forall vec a. Pully vec a => Data Length -> vec -> Pull a
`take` vec
vec)

inits1 :: Pully vec a => vec -> Pull (Pull a)
inits1 :: vec -> Pull (Pull a)
inits1 = Pull (Pull a) -> Pull (Pull a)
forall vec a. Pully vec a => vec -> Pull a
tail (Pull (Pull a) -> Pull (Pull a))
-> (vec -> Pull (Pull a)) -> vec -> Pull (Pull a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. vec -> Pull (Pull a)
forall vec a. Pully vec a => vec -> Pull (Pull a)
inits

replicate :: Data Length -> a -> Pull a
replicate :: Data Length -> a -> Pull a
replicate Data Length
l = Data Length -> (Data Length -> a) -> Pull a
forall a. Data Length -> (Data Length -> a) -> Pull a
Pull Data Length
l ((Data Length -> a) -> Pull a)
-> (a -> Data Length -> a) -> a -> Pull a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Data Length -> a
forall a b. a -> b -> a
const

map :: Pully vec a => (a -> b) -> vec -> Pull b
map :: (a -> b) -> vec -> Pull b
map a -> b
f vec
vec = Data Length -> (Data Length -> b) -> Pull b
forall a. Data Length -> (Data Length -> a) -> Pull a
Pull (vec -> Data Length
forall a. Finite a => a -> Data Length
length vec
vec) (a -> b
f (a -> b) -> (Data Length -> a) -> Data Length -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (vec
vecvec -> Data Length -> IndexedElem vec
forall a. Indexed a => a -> Data Length -> IndexedElem a
!))

zip :: (Pully vec1 a, Pully vec2 b) => vec1 -> vec2 -> Pull (a,b)
zip :: vec1 -> vec2 -> Pull (a, b)
zip vec1
a vec2
b = Data Length -> (Data Length -> (a, b)) -> Pull (a, b)
forall a. Data Length -> (Data Length -> a) -> Pull a
Pull (vec1 -> Data Length
forall a. Finite a => a -> Data Length
length vec1
a Data Length -> Data Length -> Data Length
forall a. (Ord a, PrimType a) => Data a -> Data a -> Data a
`min` vec2 -> Data Length
forall a. Finite a => a -> Data Length
length vec2
b) (\Data Length
i -> (vec1
avec1 -> Data Length -> IndexedElem vec1
forall a. Indexed a => a -> Data Length -> IndexedElem a
!Data Length
i, vec2
bvec2 -> Data Length -> IndexedElem vec2
forall a. Indexed a => a -> Data Length -> IndexedElem a
!Data Length
i))

-- | Back-permute a 'Pull' vector using an index mapping. The supplied mapping
-- must be a bijection when restricted to the domain of the vector. This
-- property is not checked, so use with care.
backPermute :: Pully vec a =>
    (Data Length -> Data Index -> Data Index) -> (vec -> Pull a)
backPermute :: (Data Length -> Data Length -> Data Length) -> vec -> Pull a
backPermute Data Length -> Data Length -> Data Length
perm vec
vec = Data Length -> (Data Length -> a) -> Pull a
forall a. Data Length -> (Data Length -> a) -> Pull a
Pull Data Length
len ((vec
vecvec -> Data Length -> IndexedElem vec
forall a. Indexed a => a -> Data Length -> IndexedElem a
!) (Data Length -> a)
-> (Data Length -> Data Length) -> Data Length -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data Length -> Data Length -> Data Length
perm Data Length
len)
  where
    len :: Data Length
len = vec -> Data Length
forall a. Finite a => a -> Data Length
length vec
vec

reverse :: Pully vec a => vec -> Pull a
reverse :: vec -> Pull a
reverse = (Data Length -> Data Length -> Data Length) -> vec -> Pull a
forall vec a.
Pully vec a =>
(Data Length -> Data Length -> Data Length) -> vec -> Pull a
backPermute ((Data Length -> Data Length -> Data Length) -> vec -> Pull a)
-> (Data Length -> Data Length -> Data Length) -> vec -> Pull a
forall a b. (a -> b) -> a -> b
$ \Data Length
len Data Length
i -> Data Length
lenData Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
-Data Length
iData Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
-Data Length
1

(...) :: Data Index -> Data Index -> Pull (Data Index)
Data Length
l ... :: Data Length -> Data Length -> Pull (Data Length)
... Data Length
h = Data Length -> (Data Length -> Data Length) -> Pull (Data Length)
forall a. Data Length -> (Data Length -> a) -> Pull a
Pull (Data Bool -> Data Length
forall a. (Integral a, PrimType a) => Data Bool -> Data a
b2i (Data Length
lData Length -> Data Length -> Data Bool
forall a. (Ord a, PrimType a) => Data a -> Data a -> Data Bool
<Data Length
hData Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
+Data Length
1) Data Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
* (Data Length
hData Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
-Data Length
lData Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
+Data Length
1)) (Data Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
+Data Length
l)

infix 3 ...

zipWith :: (Pully vec1 a, Pully vec2 b) =>
    (a -> b -> c) -> vec1 -> vec2 -> Pull c
zipWith :: (a -> b -> c) -> vec1 -> vec2 -> Pull c
zipWith a -> b -> c
f vec1
a vec2
b = ((a, b) -> c) -> Pull (a, b) -> Pull c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b -> c) -> (a, b) -> c
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> c
f) (Pull (a, b) -> Pull c) -> Pull (a, b) -> Pull c
forall a b. (a -> b) -> a -> b
$ vec1 -> vec2 -> Pull (a, b)
forall vec1 a vec2 b.
(Pully vec1 a, Pully vec2 b) =>
vec1 -> vec2 -> Pull (a, b)
zip vec1
a vec2
b

-- | Left fold of a vector
fold :: (Syntax a, Pully vec a) => (a -> a -> a) -> a -> vec -> a
fold :: (a -> a -> a) -> a -> vec -> a
fold a -> a -> a
f a
init vec
vec = Data Length -> a -> (Data Length -> a -> a) -> a
forall st.
Syntax st =>
Data Length -> st -> (Data Length -> st -> st) -> st
forLoop (vec -> Data Length
forall a. Finite a => a -> Data Length
length vec
vec) a
init ((Data Length -> a -> a) -> a) -> (Data Length -> a -> a) -> a
forall a b. (a -> b) -> a -> b
$ \Data Length
i a
st -> a -> a -> a
f (vec
vecvec -> Data Length -> IndexedElem vec
forall a. Indexed a => a -> Data Length -> IndexedElem a
!Data Length
i) a
st

-- | Left fold of a non-empty vector
fold1 :: (Syntax a, Pully vec a) => (a -> a -> a) -> vec -> a
fold1 :: (a -> a -> a) -> vec -> a
fold1 a -> a -> a
f vec
vec = Data Length -> a -> (Data Length -> a -> a) -> a
forall st.
Syntax st =>
Data Length -> st -> (Data Length -> st -> st) -> st
forLoop (vec -> Data Length
forall a. Finite a => a -> Data Length
length vec
vec) (vec
vecvec -> Data Length -> IndexedElem vec
forall a. Indexed a => a -> Data Length -> IndexedElem a
!Data Length
0) ((Data Length -> a -> a) -> a) -> (Data Length -> a -> a) -> a
forall a b. (a -> b) -> a -> b
$ \Data Length
i a
st -> a -> a -> a
f (vec
vecvec -> Data Length -> IndexedElem vec
forall a. Indexed a => a -> Data Length -> IndexedElem a
!(Data Length
iData Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
+Data Length
1)) a
st

sum :: (Pully vec a, Syntax a, Num a) => vec -> a
sum :: vec -> a
sum = (a -> a -> a) -> a -> vec -> a
forall a vec.
(Syntax a, Pully vec a) =>
(a -> a -> a) -> a -> vec -> a
fold a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0

-- | Scalar product
scProd :: (Num a, Syntax a, Pully vec1 a, Pully vec2 a) => vec1 -> vec2 -> a
scProd :: vec1 -> vec2 -> a
scProd vec1
a vec2
b = Pull a -> a
forall vec a. (Pully vec a, Syntax a, Num a) => vec -> a
sum ((a -> a -> a) -> vec1 -> vec2 -> Pull a
forall vec1 a vec2 b c.
(Pully vec1 a, Pully vec2 b) =>
(a -> b -> c) -> vec1 -> vec2 -> Pull c
zipWith a -> a -> a
forall a. Num a => a -> a -> a
(*) vec1
a vec2
b)



--------------------------------------------------------------------------------
-- * 2-dimensional pull vectors
--------------------------------------------------------------------------------

-- | 2-dimensional pull vector: a vector representation that supports random
-- access and fusion of operations
data Pull2 a where
    Pull2
        :: Data Length                      -- Number of rows
        -> Data Length                      -- Number of columns
        -> (Data Index -> Data Index -> a)  -- (row,col) -> element
        -> Pull2 a

-- | 'Pull2' vector specialized to 'Data' elements
type DPull2 a = Pull2 (Data a)

instance Functor Pull2
  where
    fmap :: (a -> b) -> Pull2 a -> Pull2 b
fmap a -> b
f (Pull2 Data Length
r Data Length
c Data Length -> Data Length -> a
ixf) = Data Length
-> Data Length -> (Data Length -> Data Length -> b) -> Pull2 b
forall a.
Data Length
-> Data Length -> (Data Length -> Data Length -> a) -> Pull2 a
Pull2 Data Length
r Data Length
c (\Data Length
i Data Length
j -> a -> b
f (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ Data Length -> Data Length -> a
ixf Data Length
i Data Length
j)

-- | Indexing the rows
instance Indexed (Pull2 a)
  where
    type IndexedElem (Pull2 a) = Pull a
    Pull2 Data Length
r Data Length
c Data Length -> Data Length -> a
ixf ! :: Pull2 a -> Data Length -> IndexedElem (Pull2 a)
! Data Length
i = Data Length -> (Data Length -> a) -> Pull a
forall a. Data Length -> (Data Length -> a) -> Pull a
Pull Data Length
c (Data Length -> Data Length -> a
ixf Data Length
i')
      where
        i' :: Data Length
i' = AssertionLabel -> Data Bool -> String -> Data Length -> Data Length
forall a.
Syntax a =>
AssertionLabel -> Data Bool -> String -> a -> a
guardValLabel
          AssertionLabel
InternalAssertion
          (Data Length
i Data Length -> Data Length -> Data Bool
forall a. (Ord a, PrimType a) => Data a -> Data a -> Data Bool
< Data Length
r)
          String
"indexing outside of Pull2 vector"
          Data Length
i

-- | 'length' gives number of rows
instance Finite (Pull2 a) where length :: Pull2 a -> Data Length
length = Pull2 a -> Data Length
forall a. Finite2 a => a -> Data Length
numRows

instance Finite2 (Pull2 a)
  where
    extent2 :: Pull2 a -> (Data Length, Data Length)
extent2 (Pull2 Data Length
r Data Length
c Data Length -> Data Length -> a
_) = (Data Length
r,Data Length
c)

-- | Take a slice of the rows
instance Slicable (Pull2 a)
  where
    slice :: Data Length -> Data Length -> Pull2 a -> Pull2 a
slice Data Length
from Data Length
n Pull2 a
vec
        = Data Length -> Pull (Pull a) -> Pull2 a
forall vec1 vec2 a.
(Pully vec1 vec2, Pully vec2 a) =>
Data Length -> vec1 -> Pull2 a
hideRowsPull (Pull2 a -> Data Length
forall a. Finite2 a => a -> Data Length
numCols Pull2 a
vec)
        (Pull (Pull a) -> Pull2 a) -> Pull (Pull a) -> Pull2 a
forall a b. (a -> b) -> a -> b
$ Data Length -> Pull (Pull a) -> Pull (Pull a)
forall vec a. Pully vec a => Data Length -> vec -> Pull a
take Data Length
n
        (Pull (Pull a) -> Pull (Pull a)) -> Pull (Pull a) -> Pull (Pull a)
forall a b. (a -> b) -> a -> b
$ Data Length -> Pull (Pull a) -> Pull (Pull a)
forall vec a. Pully vec a => Data Length -> vec -> Pull a
drop Data Length
from
        (Pull (Pull a) -> Pull (Pull a)) -> Pull (Pull a) -> Pull (Pull a)
forall a b. (a -> b) -> a -> b
$ Pull2 a -> Pull (Pull a)
forall vec a. Pully2 vec a => vec -> Pull (Pull a)
exposeRows
        (Pull2 a -> Pull (Pull a)) -> Pull2 a -> Pull (Pull a)
forall a b. (a -> b) -> a -> b
$ Pull2 a
vec

instance
    ( Syntax a
    , MarshalHaskell (Internal a)
    , MarshalFeld a
    ) =>
      MarshalFeld (Pull2 a)
  where
    type HaskellRep (Pull2 a) = HaskellRep (Manifest2 a)
    fwrite :: Handle -> Pull2 a -> Run ()
fwrite Handle
hdl = Handle -> Push2 Run a -> Run ()
forall a. MarshalFeld a => Handle -> a -> Run ()
fwrite Handle
hdl (Push2 Run a -> Run ())
-> (Pull2 a -> Push2 Run a) -> Pull2 a -> Run ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pull2 a -> Push2 Run a
forall (m :: * -> *) vec a. Pushy2 m vec a => vec -> Push2 m a
toPush2
    fread :: Handle -> Run (Pull2 a)
fread Handle
hdl  = (Manifest2 a -> Pull2 a
forall vec a. Pully2 vec a => vec -> Pull2 a
toPull2 :: Manifest2 a -> _) (Manifest2 a -> Pull2 a) -> Run (Manifest2 a) -> Run (Pull2 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> Run (Manifest2 a)
forall a. MarshalFeld a => Handle -> Run a
fread Handle
hdl

-- | Vectors that can be converted to 'Pull2'
class Pully2 vec a | vec -> a
  where
    -- | Convert a vector to 'Pull2'
    toPull2 :: vec -> Pull2 a

-- | Convert to a 'Pull2' with a single row
instance Syntax a => Pully2 (Manifest a) a
  where
    toPull2 :: Manifest a -> Pull2 a
toPull2 = Pull a -> Pull2 a
forall vec a. Pully2 vec a => vec -> Pull2 a
toPull2 (Pull a -> Pull2 a)
-> (Manifest a -> Pull a) -> Manifest a -> Pull2 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Manifest a -> Pull a
forall vec a. Pully vec a => vec -> Pull a
toPull

instance (Indexed vec, Slicable vec, IndexedElem vec ~ a, Syntax a) =>
    Pully2 (Nest vec) a
  where
    toPull2 :: Nest vec -> Pull2 a
toPull2 Nest vec
arr = Data Length
-> Data Length -> (Data Length -> Data Length -> a) -> Pull2 a
forall a.
Data Length
-> Data Length -> (Data Length -> Data Length -> a) -> Pull2 a
Pull2 Data Length
r Data Length
c ((Data Length -> Data Length -> a) -> Pull2 a)
-> (Data Length -> Data Length -> a) -> Pull2 a
forall a b. (a -> b) -> a -> b
$ \Data Length
i Data Length
j -> Nest vec
arrNest vec -> Data Length -> IndexedElem (Nest vec)
forall a. Indexed a => a -> Data Length -> IndexedElem a
!Data Length
ivec -> Data Length -> IndexedElem vec
forall a. Indexed a => a -> Data Length -> IndexedElem a
!Data Length
j
      where
        (Data Length
r,Data Length
c) = Nest vec -> (Data Length, Data Length)
forall a. Finite2 a => a -> (Data Length, Data Length)
extent2 Nest vec
arr

-- | Convert to a 'Pull2' with a single row
instance Pully2 (Pull a) a
  where
    toPull2 :: Pull a -> Pull2 a
toPull2 (Pull Data Length
l Data Length -> a
ixf) = Data Length
-> Data Length -> (Data Length -> Data Length -> a) -> Pull2 a
forall a.
Data Length
-> Data Length -> (Data Length -> Data Length -> a) -> Pull2 a
Pull2 Data Length
1 Data Length
l ((Data Length -> Data Length -> a) -> Pull2 a)
-> (Data Length -> Data Length -> a) -> Pull2 a
forall a b. (a -> b) -> a -> b
$ \Data Length
_ Data Length
j -> Data Length -> a
ixf Data Length
j

instance Pully2 (Pull2 a) a where toPull2 :: Pull2 a -> Pull2 a
toPull2 = Pull2 a -> Pull2 a
forall a. a -> a
id



----------------------------------------
-- ** Operations
----------------------------------------

-- | Transposed version of 'toPull'. Can be used to e.g. turn a 'Pull' into a
-- column of a matrix
toPull2' :: Pully2 vec a => vec -> Pull2 a
toPull2' :: vec -> Pull2 a
toPull2' = Pull2 a -> Pull2 a
forall vec a. Pully2 vec a => vec -> Pull2 a
transpose (Pull2 a -> Pull2 a) -> (vec -> Pull2 a) -> vec -> Pull2 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. vec -> Pull2 a
forall vec a. Pully2 vec a => vec -> Pull2 a
toPull2

-- | Turn a vector of rows into a 2-dimensional vector. All inner vectors are
-- assumed to have the given length, and this assumption is not checked by
-- assertions. If types permit, it is preferable to use 'hideRows', which does
-- check the lengths.
hideRowsPull :: (Pully vec1 vec2, Pully vec2 a)
    => Data Length  -- ^ Length of inner vectors
    -> vec1
    -> Pull2 a
hideRowsPull :: Data Length -> vec1 -> Pull2 a
hideRowsPull Data Length
c vec1
vec = Data Length
-> Data Length -> (Data Length -> Data Length -> a) -> Pull2 a
forall a.
Data Length
-> Data Length -> (Data Length -> Data Length -> a) -> Pull2 a
Pull2 (vec1 -> Data Length
forall a. Finite a => a -> Data Length
length vec1
vec) Data Length
c ((Data Length -> Data Length -> a) -> Pull2 a)
-> (Data Length -> Data Length -> a) -> Pull2 a
forall a b. (a -> b) -> a -> b
$ \Data Length
i Data Length
j -> vec1
vecvec1 -> Data Length -> IndexedElem vec1
forall a. Indexed a => a -> Data Length -> IndexedElem a
!Data Length
ivec2 -> Data Length -> IndexedElem vec2
forall a. Indexed a => a -> Data Length -> IndexedElem a
!Data Length
j

-- | Expose the rows in a 'Pull2' by turning it into a vector of rows
exposeRows :: Pully2 vec a => vec -> Pull (Pull a)
exposeRows :: vec -> Pull (Pull a)
exposeRows vec
vec = Data Length -> (Data Length -> Pull a) -> Pull (Pull a)
forall a. Data Length -> (Data Length -> a) -> Pull a
Pull (Pull2 a -> Data Length
forall a. Finite2 a => a -> Data Length
numRows Pull2 a
v) ((Data Length -> Pull a) -> Pull (Pull a))
-> (Data Length -> Pull a) -> Pull (Pull a)
forall a b. (a -> b) -> a -> b
$ \Data Length
i -> Data Length -> (Data Length -> a) -> Pull a
forall a. Data Length -> (Data Length -> a) -> Pull a
Pull (Pull2 a -> Data Length
forall a. Finite2 a => a -> Data Length
numCols Pull2 a
v) ((Data Length -> a) -> Pull a) -> (Data Length -> a) -> Pull a
forall a b. (a -> b) -> a -> b
$ \Data Length
j -> Pull2 a
vPull2 a -> Data Length -> IndexedElem (Pull2 a)
forall a. Indexed a => a -> Data Length -> IndexedElem a
!Data Length
iPull a -> Data Length -> IndexedElem (Pull a)
forall a. Indexed a => a -> Data Length -> IndexedElem a
!Data Length
j
  where
    v :: Pull2 a
v = vec -> Pull2 a
forall vec a. Pully2 vec a => vec -> Pull2 a
toPull2 vec
vec

-- | Transpose of a matrix
transpose :: Pully2 vec a => vec -> Pull2 a
transpose :: vec -> Pull2 a
transpose vec
vec = Data Length
-> Data Length -> (Data Length -> Data Length -> a) -> Pull2 a
forall a.
Data Length
-> Data Length -> (Data Length -> Data Length -> a) -> Pull2 a
Pull2 (Pull2 a -> Data Length
forall a. Finite2 a => a -> Data Length
numCols Pull2 a
v) (Pull2 a -> Data Length
forall a. Finite2 a => a -> Data Length
numRows Pull2 a
v) ((Data Length -> Data Length -> a) -> Pull2 a)
-> (Data Length -> Data Length -> a) -> Pull2 a
forall a b. (a -> b) -> a -> b
$ \Data Length
i Data Length
j -> Pull2 a
vPull2 a -> Data Length -> IndexedElem (Pull2 a)
forall a. Indexed a => a -> Data Length -> IndexedElem a
!Data Length
jPull a -> Data Length -> IndexedElem (Pull a)
forall a. Indexed a => a -> Data Length -> IndexedElem a
!Data Length
i
  where
    v :: Pull2 a
v = vec -> Pull2 a
forall vec a. Pully2 vec a => vec -> Pull2 a
toPull2 vec
vec

toRowVec :: Pully vec a => vec -> Pull2 a
toRowVec :: vec -> Pull2 a
toRowVec vec
vec = Data Length -> Pull vec -> Pull2 a
forall vec1 vec2 a.
(Pully vec1 vec2, Pully vec2 a) =>
Data Length -> vec1 -> Pull2 a
hideRowsPull (vec -> Data Length
forall a. Finite a => a -> Data Length
length vec
vec) (Pull vec -> Pull2 a) -> Pull vec -> Pull2 a
forall a b. (a -> b) -> a -> b
$ Data Length -> vec -> Pull vec
forall a. Data Length -> a -> Pull a
replicate Data Length
1 vec
vec

fromRowVec :: Pully2 vec a => vec -> Pull a
fromRowVec :: vec -> Pull a
fromRowVec = Pull (Pull a) -> Pull a
forall vec a. Pully vec a => vec -> a
head (Pull (Pull a) -> Pull a)
-> (vec -> Pull (Pull a)) -> vec -> Pull a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. vec -> Pull (Pull a)
forall vec a. Pully2 vec a => vec -> Pull (Pull a)
exposeRows

toColVec :: Pully vec a => vec -> Pull2 a
toColVec :: vec -> Pull2 a
toColVec = Pull2 a -> Pull2 a
forall vec a. Pully2 vec a => vec -> Pull2 a
transpose (Pull2 a -> Pull2 a) -> (vec -> Pull2 a) -> vec -> Pull2 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. vec -> Pull2 a
forall vec a. Pully vec a => vec -> Pull2 a
toRowVec

fromColVec :: Pully2 vec a => vec -> Pull a
fromColVec :: vec -> Pull a
fromColVec = Pull2 a -> Pull a
forall vec a. Pully2 vec a => vec -> Pull a
fromRowVec (Pull2 a -> Pull a) -> (vec -> Pull2 a) -> vec -> Pull a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. vec -> Pull2 a
forall vec a. Pully2 vec a => vec -> Pull2 a
transpose

-- | Matrix multiplication
matMul :: (Pully2 vec1 a, Pully2 vec2 a, Num a, Syntax a) =>
    vec1 -> vec2 -> Pull2 a
matMul :: vec1 -> vec2 -> Pull2 a
matMul vec1
veca vec2
vecb = Data Length
-> Data Length -> (Data Length -> Data Length -> a) -> Pull2 a
forall a.
Data Length
-> Data Length -> (Data Length -> Data Length -> a) -> Pull2 a
Pull2 (Pull2 a -> Data Length
forall a. Finite2 a => a -> Data Length
numRows Pull2 a
va) (Pull2 a -> Data Length
forall a. Finite2 a => a -> Data Length
numCols Pull2 a
vb) ((Data Length -> Data Length -> a) -> Pull2 a)
-> (Data Length -> Data Length -> a) -> Pull2 a
forall a b. (a -> b) -> a -> b
$ \Data Length
i Data Length
j ->
    Pull a -> Pull a -> a
forall a vec1 vec2.
(Num a, Syntax a, Pully vec1 a, Pully vec2 a) =>
vec1 -> vec2 -> a
scProd (Pull2 a
vaPull2 a -> Data Length -> IndexedElem (Pull2 a)
forall a. Indexed a => a -> Data Length -> IndexedElem a
!Data Length
i) (Pull2 a -> Pull2 a
forall vec a. Pully2 vec a => vec -> Pull2 a
transpose Pull2 a
vb Pull2 a -> Data Length -> IndexedElem (Pull2 a)
forall a. Indexed a => a -> Data Length -> IndexedElem a
! Data Length
j)
  where
    va :: Pull2 a
va = vec1 -> Pull2 a
forall vec a. Pully2 vec a => vec -> Pull2 a
toPull2 vec1
veca
    vb :: Pull2 a
vb = vec2 -> Pull2 a
forall vec a. Pully2 vec a => vec -> Pull2 a
toPull2 vec2
vecb



--------------------------------------------------------------------------------
-- * 1-dimensional push vectors
--------------------------------------------------------------------------------

-- | 1-dimensional push vector: a vector representation that supports nested
-- write patterns (e.g. resulting from concatenation) and fusion of operations
--
-- If it is the case that @`dumpPush` v (\\_ _ -> `return` ())@ has the same
-- behavior as @`return` ()@, i.e., the vector does not have any embedded side
-- effects, we can regard 'Push' as a pure data structure with the denotation of
-- a finite list.
--
-- However, 'Push' is commonly used to assemble data after splitting it up and
-- performing some operations on the parts. We want to be able to use 'Push'
-- even if the operation involved has side effects. The function 'sequens' can
-- be used to embed effects into a 'Push' vector.
--
-- 'Push' vectors with embedded effects can often be considered to be denoted by
-- @M [a]@, where @M@ is some suitable monad. That is, the vector performs some
-- effects and produces a finite list of values as a result. This denotation is
-- enough to explain e.g. why
--
-- @
-- `return` (v `++` v)
-- @
--
-- is different from
--
-- @
-- do v' <- `manifestFresh` v
--    `return` (v' `++` v')
-- @
--
-- (The former duplicates the embedded effects while the latter only performs
-- the effects once.)
--
-- However, this denotation is not enough to model 'dumpPush', which allows a
-- write method to be interleaved with the embedded effects. Even a function
-- such as 'manifest' can to some extent be used observe the order of effects
-- (if the array argument to 'manifest' is also updated by the internal
-- effects).
--
-- Conclusion:
--
-- * You can normally think of @`Push` a@ as denoting @M [a]@ (finite list)
--
-- * Make sure to pass a free array as argument to 'manifest'
--
-- * Avoid using 'dumpPush' unless you know that it's safe
data Push m a
  where
    Push
        :: Data Length
        -> ((Data Index -> a -> m ()) -> m ())
        -> Push m a

-- | 'Push' vector specialized to 'Data' elements
type DPush m a = Push m (Data a)

instance Functor (Push m)
  where
    fmap :: (a -> b) -> Push m a -> Push m b
fmap a -> b
f (Push Data Length
len (Data Length -> a -> m ()) -> m ()
dump) = Data Length -> ((Data Length -> b -> m ()) -> m ()) -> Push m b
forall a (m :: * -> *).
Data Length -> ((Data Length -> a -> m ()) -> m ()) -> Push m a
Push Data Length
len (((Data Length -> b -> m ()) -> m ()) -> Push m b)
-> ((Data Length -> b -> m ()) -> m ()) -> Push m b
forall a b. (a -> b) -> a -> b
$ \Data Length -> b -> m ()
write ->
        (Data Length -> a -> m ()) -> m ()
dump ((Data Length -> a -> m ()) -> m ())
-> (Data Length -> a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Data Length
i -> Data Length -> b -> m ()
write Data Length
i (b -> m ()) -> (a -> b) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f

-- | This instance behaves like the list instance:
--
-- > pure x    = [x]
-- > fs <*> xs = [f x | f <- fs, x <- xs]
instance Applicative (Push m)
  where
    pure :: a -> Push m a
pure a
a = Data Length -> ((Data Length -> a -> m ()) -> m ()) -> Push m a
forall a (m :: * -> *).
Data Length -> ((Data Length -> a -> m ()) -> m ()) -> Push m a
Push Data Length
1 (((Data Length -> a -> m ()) -> m ()) -> Push m a)
-> ((Data Length -> a -> m ()) -> m ()) -> Push m a
forall a b. (a -> b) -> a -> b
$ \Data Length -> a -> m ()
write -> Data Length -> a -> m ()
write Data Length
0 a
a
    Push m (a -> b)
vec1 <*> :: Push m (a -> b) -> Push m a -> Push m b
<*> Push m a
vec2 = Data Length -> ((Data Length -> b -> m ()) -> m ()) -> Push m b
forall a (m :: * -> *).
Data Length -> ((Data Length -> a -> m ()) -> m ()) -> Push m a
Push (Data Length
len1Data Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
*Data Length
len2) (((Data Length -> b -> m ()) -> m ()) -> Push m b)
-> ((Data Length -> b -> m ()) -> m ()) -> Push m b
forall a b. (a -> b) -> a -> b
$ \Data Length -> b -> m ()
write -> do
        Push m a -> (Data Length -> a -> m ()) -> m ()
forall (m :: * -> *) a.
Push m a -> (Data Length -> a -> m ()) -> m ()
dumpPush Push m a
vec2 ((Data Length -> a -> m ()) -> m ())
-> (Data Length -> a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Data Length
i2 a
a ->
          Push m (a -> b) -> (Data Length -> (a -> b) -> m ()) -> m ()
forall (m :: * -> *) a.
Push m a -> (Data Length -> a -> m ()) -> m ()
dumpPush Push m (a -> b)
vec1 ((Data Length -> (a -> b) -> m ()) -> m ())
-> (Data Length -> (a -> b) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Data Length
i1 a -> b
f ->
            Data Length -> b -> m ()
write (Data Length
i1Data Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
*Data Length
len2 Data Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
+ Data Length
i2) (a -> b
f a
a)
      where
        (Data Length
len1,Data Length
len2) = (Push m (a -> b) -> Data Length
forall a. Finite a => a -> Data Length
length Push m (a -> b)
vec1, Push m a -> Data Length
forall a. Finite a => a -> Data Length
length Push m a
vec2)

-- No instance `Monad Push`, because it's not possible to determine the length
-- of the result of `>>=`.

instance Finite (Push m a)
  where
    length :: Push m a -> Data Length
length (Push Data Length
len (Data Length -> a -> m ()) -> m ()
_) = Data Length
len

-- | Treated as a row vector
instance Finite2 (Push m a) where extent2 :: Push m a -> (Data Length, Data Length)
extent2 Push m a
v = (Data Length
1, Push m a -> Data Length
forall a. Finite a => a -> Data Length
length Push m a
v)

instance
    ( Syntax a
    , MarshalHaskell (Internal a)
    , MarshalFeld a
    , m ~ Run
    ) =>
      MarshalFeld (Push m a)
  where
    type HaskellRep (Push m a) = HaskellRep (Manifest a)
    fwrite :: Handle -> Push m a -> Run ()
fwrite Handle
hdl = Handle -> Manifest a -> Run ()
forall a. MarshalFeld a => Handle -> a -> Run ()
fwrite Handle
hdl (Manifest a -> Run ())
-> (Push m a -> Run (Manifest a)) -> Push m a -> Run ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Push m a -> Run (Manifest a)
forall (m :: * -> *) vec a.
(Manifestable m vec a, Syntax a) =>
vec -> m (Manifest a)
manifestFresh
    fread :: Handle -> Run (Push m a)
fread Handle
hdl  = Manifest a -> Push m a
forall (m :: * -> *) vec a. Pushy m vec a => vec -> Push m a
toPush (Manifest a -> Push m a)
-> (Manifest a -> Manifest a) -> Manifest a -> Push m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> a
forall _. Manifest _ -> Manifest _
id :: Manifest _ -> _) (Manifest a -> Push m a) -> Run (Manifest a) -> Run (Push m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> Run (Manifest a)
forall a. MarshalFeld a => Handle -> Run a
fread Handle
hdl

-- | Vectors that can be converted to 'Push'
class Pushy m vec a | vec -> a
  where
    -- | Convert a vector to 'Push'
    toPush :: vec -> Push m a

-- | A version of 'toPush' that constrains the @m@ argument of 'Push' to that of
-- the monad in which the result is returned. This can be a convenient way to
-- avoid unresolved overloading.
toPushM :: (Pushy m vec a, Monad m) => vec -> m (Push m a)
toPushM :: vec -> m (Push m a)
toPushM = Push m a -> m (Push m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Push m a -> m (Push m a))
-> (vec -> Push m a) -> vec -> m (Push m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. vec -> Push m a
forall (m :: * -> *) vec a. Pushy m vec a => vec -> Push m a
toPush

instance (Syntax a, MonadComp m) => Pushy m (Manifest a) a where toPush :: Manifest a -> Push m a
toPush = Pull a -> Push m a
forall (m :: * -> *) vec a. Pushy m vec a => vec -> Push m a
toPush (Pull a -> Push m a)
-> (Manifest a -> Pull a) -> Manifest a -> Push m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Manifest a -> Pull a
forall vec a. Pully vec a => vec -> Pull a
toPull
instance (m1 ~ m2)               => Pushy m1 (Push m2 a) a where toPush :: Push m2 a -> Push m1 a
toPush = Push m2 a -> Push m1 a
forall a. a -> a
id

instance MonadComp m => Pushy m (Pull a) a
  where
    toPush :: Pull a -> Push m a
toPush Pull a
vec = Data Length -> ((Data Length -> a -> m ()) -> m ()) -> Push m a
forall a (m :: * -> *).
Data Length -> ((Data Length -> a -> m ()) -> m ()) -> Push m a
Push Data Length
len (((Data Length -> a -> m ()) -> m ()) -> Push m a)
-> ((Data Length -> a -> m ()) -> m ()) -> Push m a
forall a b. (a -> b) -> a -> b
$ \Data Length -> a -> m ()
write ->
        IxRange (Data Length) -> (Data Length -> m ()) -> m ()
forall (m :: * -> *) n.
(MonadComp m, Integral n, PrimType n) =>
IxRange (Data n) -> (Data n -> m ()) -> m ()
for (Data Length
0,Int
1,Data Length -> Border (Data Length)
forall i. i -> Border i
Excl Data Length
len) ((Data Length -> m ()) -> m ()) -> (Data Length -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Data Length
i ->
          Data Length -> a -> m ()
write Data Length
i (Pull a
vecPull a -> Data Length -> IndexedElem (Pull a)
forall a. Indexed a => a -> Data Length -> IndexedElem a
!Data Length
i)
      where
        len :: Data Length
len = Pull a -> Data Length
forall a. Finite a => a -> Data Length
length Pull a
vec

instance (MonadComp m1, m1 ~ m2) => Pushy m1 (Seq m2 a) a
  where
    toPush :: Seq m2 a -> Push m1 a
toPush (Seq Data Length
len m2 (Data Length -> m2 a)
init) = Data Length -> ((Data Length -> a -> m2 ()) -> m2 ()) -> Push m2 a
forall a (m :: * -> *).
Data Length -> ((Data Length -> a -> m ()) -> m ()) -> Push m a
Push Data Length
len (((Data Length -> a -> m2 ()) -> m2 ()) -> Push m2 a)
-> ((Data Length -> a -> m2 ()) -> m2 ()) -> Push m2 a
forall a b. (a -> b) -> a -> b
$ \Data Length -> a -> m2 ()
write -> do
      Data Length -> m2 a
next <- m2 (Data Length -> m2 a)
init
      IxRange (Data Length) -> (Data Length -> m2 ()) -> m2 ()
forall (m :: * -> *) n.
(MonadComp m, Integral n, PrimType n) =>
IxRange (Data n) -> (Data n -> m ()) -> m ()
for (Data Length
0,Int
1,Data Length -> Border (Data Length)
forall i. i -> Border i
Excl Data Length
len) ((Data Length -> m2 ()) -> m2 ())
-> (Data Length -> m2 ()) -> m2 ()
forall a b. (a -> b) -> a -> b
$ \Data Length
i -> do
        a
a <- Data Length -> m2 a
next Data Length
i
        Data Length -> a -> m2 ()
write Data Length
i a
a

-- | Dump the contents of a 'Push' vector
dumpPush
    :: Push m a                   -- ^ Vector to dump
    -> (Data Index -> a -> m ())  -- ^ Function that writes one element
    -> m ()
dumpPush :: Push m a -> (Data Length -> a -> m ()) -> m ()
dumpPush (Push Data Length
_ (Data Length -> a -> m ()) -> m ()
dump) = (Data Length -> a -> m ()) -> m ()
dump



----------------------------------------
-- ** Operations
----------------------------------------

-- | Create a 'Push' vector from a list of elements
listPush :: Monad m => [a] -> Push m a
listPush :: [a] -> Push m a
listPush [a]
as = Data Length -> ((Data Length -> a -> m ()) -> m ()) -> Push m a
forall a (m :: * -> *).
Data Length -> ((Data Length -> a -> m ()) -> m ()) -> Push m a
Push (Internal (Data Length) -> Data Length
forall a. Syntax a => Internal a -> a
value (Internal (Data Length) -> Data Length)
-> Internal (Data Length) -> Data Length
forall a b. (a -> b) -> a -> b
$ [a] -> Length
forall i a. Num i => [a] -> i
genericLength [a]
as) (((Data Length -> a -> m ()) -> m ()) -> Push m a)
-> ((Data Length -> a -> m ()) -> m ()) -> Push m a
forall a b. (a -> b) -> a -> b
$ \Data Length -> a -> m ()
write ->
    [m ()] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [Data Length -> a -> m ()
write (Internal (Data Length) -> Data Length
forall a. Syntax a => Internal a -> a
value Length
Internal (Data Length)
i) a
a | (Length
i,a
a) <- [Length] -> [a] -> [(Length, a)]
forall a b. [a] -> [b] -> [(a, b)]
Prelude.zip [Length
0..] [a]
as]

-- | Append two vectors to make a 'Push' vector
(++) :: (Pushy m vec1 a, Pushy m vec2 a, Monad m) => vec1 -> vec2 -> Push m a
vec1
vec1 ++ :: vec1 -> vec2 -> Push m a
++ vec2
vec2 = Data Length -> ((Data Length -> a -> m ()) -> m ()) -> Push m a
forall a (m :: * -> *).
Data Length -> ((Data Length -> a -> m ()) -> m ()) -> Push m a
Push (Data Length
len1 Data Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
+ Push m a -> Data Length
forall a. Finite a => a -> Data Length
length Push m a
v2) (((Data Length -> a -> m ()) -> m ()) -> Push m a)
-> ((Data Length -> a -> m ()) -> m ()) -> Push m a
forall a b. (a -> b) -> a -> b
$ \Data Length -> a -> m ()
write ->
    Push m a -> (Data Length -> a -> m ()) -> m ()
forall (m :: * -> *) a.
Push m a -> (Data Length -> a -> m ()) -> m ()
dumpPush Push m a
v1 Data Length -> a -> m ()
write m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Push m a -> (Data Length -> a -> m ()) -> m ()
forall (m :: * -> *) a.
Push m a -> (Data Length -> a -> m ()) -> m ()
dumpPush Push m a
v2 (Data Length -> a -> m ()
write (Data Length -> a -> m ())
-> (Data Length -> Data Length) -> Data Length -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Data Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
+Data Length
len1))
  where
    v1 :: Push m a
v1   = vec1 -> Push m a
forall (m :: * -> *) vec a. Pushy m vec a => vec -> Push m a
toPush vec1
vec1
    v2 :: Push m a
v2   = vec2 -> Push m a
forall (m :: * -> *) vec a. Pushy m vec a => vec -> Push m a
toPush vec2
vec2
    len1 :: Data Length
len1 = Push m a -> Data Length
forall a. Finite a => a -> Data Length
length Push m a
v1

-- Concatenate nested vectors to a 'Push' vector
concat :: (Pushy m vec1 vec2, Pushy m vec2 a, MonadComp m)
    => Data Length  -- ^ Length of inner vectors
    -> vec1
    -> Push m a
concat :: Data Length -> vec1 -> Push m a
concat Data Length
c vec1
vec = Data Length -> ((Data Length -> a -> m ()) -> m ()) -> Push m a
forall a (m :: * -> *).
Data Length -> ((Data Length -> a -> m ()) -> m ()) -> Push m a
Push (Data Length
lenData Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
*Data Length
c) (((Data Length -> a -> m ()) -> m ()) -> Push m a)
-> ((Data Length -> a -> m ()) -> m ()) -> Push m a
forall a b. (a -> b) -> a -> b
$ \Data Length -> a -> m ()
write ->
    Push m (Push m a) -> (Data Length -> Push m a -> m ()) -> m ()
forall (m :: * -> *) a.
Push m a -> (Data Length -> a -> m ()) -> m ()
dumpPush Push m (Push m a)
v ((Data Length -> Push m a -> m ()) -> m ())
-> (Data Length -> Push m a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Data Length
i Push m a
row ->
      Push m a -> (Data Length -> a -> m ()) -> m ()
forall (m :: * -> *) a.
Push m a -> (Data Length -> a -> m ()) -> m ()
dumpPush Push m a
row ((Data Length -> a -> m ()) -> m ())
-> (Data Length -> a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Data Length
j a
a -> do
        AssertionLabel -> Data Bool -> String -> m ()
forall (m :: * -> *).
MonadComp m =>
AssertionLabel -> Data Bool -> String -> m ()
assertLabel
          AssertionLabel
InternalAssertion
          (Push m a -> Data Length
forall a. Finite a => a -> Data Length
length Push m a
row Data Length -> Data Length -> Data Bool
forall a. PrimType a => Data a -> Data a -> Data Bool
== Data Length
c)
          String
"concat: inner length differs"
        Data Length -> a -> m ()
write (Data Length
i Data Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
* Push m a -> Data Length
forall a. Finite a => a -> Data Length
length Push m a
row Data Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
+ Data Length
j) a
a
  where
    v :: Push m (Push m a)
v   = (vec2 -> Push m a) -> Push m vec2 -> Push m (Push m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap vec2 -> Push m a
forall (m :: * -> *) vec a. Pushy m vec a => vec -> Push m a
toPush (Push m vec2 -> Push m (Push m a))
-> Push m vec2 -> Push m (Push m a)
forall a b. (a -> b) -> a -> b
$ vec1 -> Push m vec2
forall (m :: * -> *) vec a. Pushy m vec a => vec -> Push m a
toPush vec1
vec
    len :: Data Length
len = Push m (Push m a) -> Data Length
forall a. Finite a => a -> Data Length
length Push m (Push m a)
v

-- Flatten a 2-dimensional vector to a 'Push' vector
flatten :: Pushy2 m vec a => vec -> Push m a
flatten :: vec -> Push m a
flatten vec
vec = Data Length -> ((Data Length -> a -> m ()) -> m ()) -> Push m a
forall a (m :: * -> *).
Data Length -> ((Data Length -> a -> m ()) -> m ()) -> Push m a
Push (Data Length
rData Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
*Data Length
c) (((Data Length -> a -> m ()) -> m ()) -> Push m a)
-> ((Data Length -> a -> m ()) -> m ()) -> Push m a
forall a b. (a -> b) -> a -> b
$ \Data Length -> a -> m ()
write ->
    Push2 m a -> (Data Length -> Data Length -> a -> m ()) -> m ()
forall (m :: * -> *) a.
Push2 m a -> (Data Length -> Data Length -> a -> m ()) -> m ()
dumpPush2 Push2 m a
v ((Data Length -> Data Length -> a -> m ()) -> m ())
-> (Data Length -> Data Length -> a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Data Length
i Data Length
j -> Data Length -> a -> m ()
write (Data Length
iData Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
*Data Length
c Data Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
+ Data Length
j)
  where
    v :: Push2 m a
v     = vec -> Push2 m a
forall (m :: * -> *) vec a. Pushy2 m vec a => vec -> Push2 m a
toPush2 vec
vec
    (Data Length
r,Data Length
c) = Push2 m a -> (Data Length, Data Length)
forall a. Finite2 a => a -> (Data Length, Data Length)
extent2 Push2 m a
v

-- | Embed the effects in the elements into the internal effects of a 'Push'
-- vector
--
-- __WARNING:__ This function should be used with care, since it allows hiding
-- effects inside a vector. These effects may be (seemingly) randomly
-- interleaved with other effects when the vector is used.
--
-- The name 'sequens' has to do with the similarity to the standard function
-- 'sequence'.
sequens :: (Pushy m vec (m a), Monad m) => vec -> Push m a
sequens :: vec -> Push m a
sequens vec
vec = Data Length -> ((Data Length -> a -> m ()) -> m ()) -> Push m a
forall a (m :: * -> *).
Data Length -> ((Data Length -> a -> m ()) -> m ()) -> Push m a
Push (Push m (m a) -> Data Length
forall a. Finite a => a -> Data Length
length Push m (m a)
v) (((Data Length -> a -> m ()) -> m ()) -> Push m a)
-> ((Data Length -> a -> m ()) -> m ()) -> Push m a
forall a b. (a -> b) -> a -> b
$ \Data Length -> a -> m ()
write ->
    Push m (m a) -> (Data Length -> m a -> m ()) -> m ()
forall (m :: * -> *) a.
Push m a -> (Data Length -> a -> m ()) -> m ()
dumpPush Push m (m a)
v ((Data Length -> m a -> m ()) -> m ())
-> (Data Length -> m a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Data Length
i m a
m ->
      m a
m m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Data Length -> a -> m ()
write Data Length
i
  where
    v :: Push m (m a)
v = vec -> Push m (m a)
forall (m :: * -> *) vec a. Pushy m vec a => vec -> Push m a
toPush vec
vec

-- | Forward-permute a 'Push' vector using an index mapping. The supplied
-- mapping must be a bijection when restricted to the domain of the vector. This
-- property is not checked, so use with care.
forwardPermute :: Pushy m vec a =>
    (Data Length -> Data Index -> Data Index) -> vec ->  Push m a
forwardPermute :: (Data Length -> Data Length -> Data Length) -> vec -> Push m a
forwardPermute Data Length -> Data Length -> Data Length
p vec
vec = Data Length -> ((Data Length -> a -> m ()) -> m ()) -> Push m a
forall a (m :: * -> *).
Data Length -> ((Data Length -> a -> m ()) -> m ()) -> Push m a
Push Data Length
len (((Data Length -> a -> m ()) -> m ()) -> Push m a)
-> ((Data Length -> a -> m ()) -> m ()) -> Push m a
forall a b. (a -> b) -> a -> b
$ \Data Length -> a -> m ()
write ->
    Push m a -> (Data Length -> a -> m ()) -> m ()
forall (m :: * -> *) a.
Push m a -> (Data Length -> a -> m ()) -> m ()
dumpPush Push m a
v ((Data Length -> a -> m ()) -> m ())
-> (Data Length -> a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Data Length
i a
a ->
      Data Length -> a -> m ()
write (Data Length -> Data Length -> Data Length
p Data Length
len Data Length
i) a
a
  where
    v :: Push m a
v   = vec -> Push m a
forall (m :: * -> *) vec a. Pushy m vec a => vec -> Push m a
toPush vec
vec
    len :: Data Length
len = Push m a -> Data Length
forall a. Finite a => a -> Data Length
length Push m a
v

-- | Convert a vector to a push vector that computes @n@ elements in each step.
-- This can be used to achieve loop unrolling.
--
-- The length of the vector must be divisible by the number of unrolling steps.
unroll :: (Pully vec a, MonadComp m)
    => Length  -- ^ Number of steps to unroll
    -> vec
    -> Push m a
unroll :: Length -> vec -> Push m a
unroll Length
0 vec
_   = String -> Push m a
forall a. HasCallStack => String -> a
Prelude.error String
"unroll: cannot unroll 0 steps"
unroll Length
n vec
vec = Data Length -> ((Data Length -> a -> m ()) -> m ()) -> Push m a
forall a (m :: * -> *).
Data Length -> ((Data Length -> a -> m ()) -> m ()) -> Push m a
Push Data Length
len (((Data Length -> a -> m ()) -> m ()) -> Push m a)
-> ((Data Length -> a -> m ()) -> m ()) -> Push m a
forall a b. (a -> b) -> a -> b
$ \Data Length -> a -> m ()
write -> do
    Data Bool -> String -> m ()
forall (m :: * -> *). MonadComp m => Data Bool -> String -> m ()
assert
      ((Data Length
len Data Length -> Data Length -> Data Length
forall a. (Integral a, PrimType a) => Data a -> Data a -> Data a
`mod` Internal (Data Length) -> Data Length
forall a. Syntax a => Internal a -> a
value Length
Internal (Data Length)
n) Data Length -> Data Length -> Data Bool
forall a. PrimType a => Data a -> Data a -> Data Bool
== Data Length
0)
      (String
"unroll: length not divisible by " String -> String -> String
forall a. [a] -> [a] -> [a]
Prelude.++ Length -> String
forall a. Show a => a -> String
show Length
n)
    IxRange (Data Length) -> (Data Length -> m ()) -> m ()
forall (m :: * -> *) n.
(MonadComp m, Integral n, PrimType n) =>
IxRange (Data n) -> (Data n -> m ()) -> m ()
for (Data Length
0,Int
n',Data Length -> Border (Data Length)
forall i. i -> Border i
Excl Data Length
len) ((Data Length -> m ()) -> m ()) -> (Data Length -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Data Length
i ->
      if Length
n Length -> Length -> Bool
forall a. Eq a => a -> a -> Bool
Prelude.== Length
1
        then Data Length -> a -> m ()
write Data Length
i (vec
vecvec -> Data Length -> IndexedElem vec
forall a. Indexed a => a -> Data Length -> IndexedElem a
!Data Length
i)
        else [m ()] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
Prelude.sequence_
          [ do Data Length
k <- Data Length -> m (Data Length)
forall a (m :: * -> *). (Syntax a, MonadComp m) => a -> m a
shareM (Data Length
i Data Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
+ Internal (Data Length) -> Data Length
forall a. Syntax a => Internal a -> a
value Length
Internal (Data Length)
j)
               Data Length -> a -> m ()
write Data Length
k (vec
vecvec -> Data Length -> IndexedElem vec
forall a. Indexed a => a -> Data Length -> IndexedElem a
!Data Length
k)
            | Length
j <- [Length
0..Length
nLength -> Length -> Length
forall a. Num a => a -> a -> a
-Length
1]
          ]
  where
    n' :: Int
n'  = Length -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Length
n
    len :: Data Length
len = vec -> Data Length
forall a. Finite a => a -> Data Length
length vec
vec



--------------------------------------------------------------------------------
-- * 2-dimensional push vectors
--------------------------------------------------------------------------------

-- | 2-dimensional push vector: a vector representation that supports nested
-- write patterns (e.g. resulting from concatenation) and fusion of operations
--
-- See the comments to 'Push' regarding the semantics of push vectors with
-- interleaved effects.
data Push2 m a
  where
    Push2
        :: Data Length  -- Number of rows
        -> Data Length  -- Number of columns
        -> ((Data Index -> Data Index -> a -> m ()) -> m ())
        -> Push2 m a

-- | 'Push2' vector specialized to 'Data' elements
type DPush2 m a = Push2 m (Data a)

instance Functor (Push2 m)
  where
    fmap :: (a -> b) -> Push2 m a -> Push2 m b
fmap a -> b
f (Push2 Data Length
r Data Length
c (Data Length -> Data Length -> a -> m ()) -> m ()
dump) = Data Length
-> Data Length
-> ((Data Length -> Data Length -> b -> m ()) -> m ())
-> Push2 m b
forall a (m :: * -> *).
Data Length
-> Data Length
-> ((Data Length -> Data Length -> a -> m ()) -> m ())
-> Push2 m a
Push2 Data Length
r Data Length
c (((Data Length -> Data Length -> b -> m ()) -> m ()) -> Push2 m b)
-> ((Data Length -> Data Length -> b -> m ()) -> m ()) -> Push2 m b
forall a b. (a -> b) -> a -> b
$ \Data Length -> Data Length -> b -> m ()
write ->
        (Data Length -> Data Length -> a -> m ()) -> m ()
dump ((Data Length -> Data Length -> a -> m ()) -> m ())
-> (Data Length -> Data Length -> a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Data Length
i Data Length
j -> Data Length -> Data Length -> b -> m ()
write Data Length
i Data Length
j (b -> m ()) -> (a -> b) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f

-- | 'length' gives number of rows
instance Finite (Push2 m a)
  where
    length :: Push2 m a -> Data Length
length (Push2 Data Length
r Data Length
_ (Data Length -> Data Length -> a -> m ()) -> m ()
_) = Data Length
r

instance Finite2 (Push2 m a)
  where
    extent2 :: Push2 m a -> (Data Length, Data Length)
extent2 (Push2 Data Length
r Data Length
c (Data Length -> Data Length -> a -> m ()) -> m ()
_) = (Data Length
r,Data Length
c)

instance
    ( Syntax a
    , MarshalHaskell (Internal a)
    , MarshalFeld a
    , m ~ Run
    ) =>
      MarshalFeld (Push2 m a)
  where
    type HaskellRep (Push2 m a) = HaskellRep (Manifest2 a)
    fwrite :: Handle -> Push2 m a -> Run ()
fwrite Handle
hdl = Handle -> Manifest2 a -> Run ()
forall a. MarshalFeld a => Handle -> a -> Run ()
fwrite Handle
hdl (Manifest2 a -> Run ())
-> (Push2 m a -> Run (Manifest2 a)) -> Push2 m a -> Run ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Push2 m a -> Run (Manifest2 a)
forall (m :: * -> *) vec a.
(Manifestable2 m vec a, Syntax a) =>
vec -> m (Manifest2 a)
manifestFresh2
    fread :: Handle -> Run (Push2 m a)
fread Handle
hdl  = Manifest2 a -> Push2 m a
forall (m :: * -> *) vec a. Pushy2 m vec a => vec -> Push2 m a
toPush2 (Manifest2 a -> Push2 m a)
-> (Manifest2 a -> Manifest2 a) -> Manifest2 a -> Push2 m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> a
forall _. Manifest2 _ -> Manifest2 _
id :: Manifest2 _ -> _) (Manifest2 a -> Push2 m a) -> Run (Manifest2 a) -> Run (Push2 m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> Run (Manifest2 a)
forall a. MarshalFeld a => Handle -> Run a
fread Handle
hdl

-- | Vectors that can be converted to 'Push2'
class Pushy2 m vec a | vec -> a
  where
    -- | Convert a vector to 'Push2'
    toPush2 :: vec -> Push2 m a

-- | A version of 'toPush2' that constrains the @m@ argument of 'Push2' to that
-- of the monad in which the result is returned. This can be a convenient way to
-- avoid unresolved overloading.
toPushM2 :: (Pushy2 m vec a, Monad m) => vec -> m (Push2 m a)
toPushM2 :: vec -> m (Push2 m a)
toPushM2 = Push2 m a -> m (Push2 m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Push2 m a -> m (Push2 m a))
-> (vec -> Push2 m a) -> vec -> m (Push2 m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. vec -> Push2 m a
forall (m :: * -> *) vec a. Pushy2 m vec a => vec -> Push2 m a
toPush2

-- | Convert to a 'Push2' with a single row
instance (Syntax a, MonadComp m) => Pushy2 m (Manifest a)  a where toPush2 :: Manifest a -> Push2 m a
toPush2 = Pull a -> Push2 m a
forall (m :: * -> *) vec a. Pushy2 m vec a => vec -> Push2 m a
toPush2 (Pull a -> Push2 m a)
-> (Manifest a -> Pull a) -> Manifest a -> Push2 m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Manifest a -> Pull a
forall vec a. Pully vec a => vec -> Pull a
toPull
instance (Syntax a, MonadComp m) => Pushy2 m (Manifest2 a) a where toPush2 :: Manifest2 a -> Push2 m a
toPush2 = Pull2 a -> Push2 m a
forall (m :: * -> *) vec a. Pushy2 m vec a => vec -> Push2 m a
toPush2 (Pull2 a -> Push2 m a)
-> (Manifest2 a -> Pull2 a) -> Manifest2 a -> Push2 m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Manifest2 a -> Pull2 a
forall vec a. Pully2 vec a => vec -> Pull2 a
toPull2
instance MonadComp m             => Pushy2 m (Pull a)      a where toPush2 :: Pull a -> Push2 m a
toPush2 = Pull2 a -> Push2 m a
forall (m :: * -> *) vec a. Pushy2 m vec a => vec -> Push2 m a
toPush2 (Pull2 a -> Push2 m a)
-> (Pull a -> Pull2 a) -> Pull a -> Push2 m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pull a -> Pull2 a
forall vec a. Pully2 vec a => vec -> Pull2 a
toPull2
instance (m1 ~ m2)               => Pushy2 m1 (Push2 m2 a) a where toPush2 :: Push2 m2 a -> Push2 m1 a
toPush2 = Push2 m2 a -> Push2 m1 a
forall a. a -> a
id

instance MonadComp m => Pushy2 m (Pull2 a) a
  where
    toPush2 :: Pull2 a -> Push2 m a
toPush2 Pull2 a
vec = Data Length
-> Data Length
-> ((Data Length -> Data Length -> a -> m ()) -> m ())
-> Push2 m a
forall a (m :: * -> *).
Data Length
-> Data Length
-> ((Data Length -> Data Length -> a -> m ()) -> m ())
-> Push2 m a
Push2 Data Length
r Data Length
c (((Data Length -> Data Length -> a -> m ()) -> m ()) -> Push2 m a)
-> ((Data Length -> Data Length -> a -> m ()) -> m ()) -> Push2 m a
forall a b. (a -> b) -> a -> b
$ \Data Length -> Data Length -> a -> m ()
write ->
        IxRange (Data Length) -> (Data Length -> m ()) -> m ()
forall (m :: * -> *) n.
(MonadComp m, Integral n, PrimType n) =>
IxRange (Data n) -> (Data n -> m ()) -> m ()
for (Data Length
0,Int
1,Data Length -> Border (Data Length)
forall i. i -> Border i
Excl Data Length
r) ((Data Length -> m ()) -> m ()) -> (Data Length -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Data Length
i ->
          IxRange (Data Length) -> (Data Length -> m ()) -> m ()
forall (m :: * -> *) n.
(MonadComp m, Integral n, PrimType n) =>
IxRange (Data n) -> (Data n -> m ()) -> m ()
for (Data Length
0,Int
1,Data Length -> Border (Data Length)
forall i. i -> Border i
Excl Data Length
c) ((Data Length -> m ()) -> m ()) -> (Data Length -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Data Length
j ->
          Data Length -> Data Length -> a -> m ()
write Data Length
i Data Length
j (Pull2 a
vecPull2 a -> Data Length -> IndexedElem (Pull2 a)
forall a. Indexed a => a -> Data Length -> IndexedElem a
!Data Length
iPull a -> Data Length -> IndexedElem (Pull a)
forall a. Indexed a => a -> Data Length -> IndexedElem a
!Data Length
j)
      where
        (Data Length
r,Data Length
c) = Pull2 a -> (Data Length, Data Length)
forall a. Finite2 a => a -> (Data Length, Data Length)
extent2 Pull2 a
vec

-- | Dump the contents of a 'Push2' vector
dumpPush2
    :: Push2 m a                                -- ^ Vector to dump
    -> (Data Index -> Data Index -> a -> m ())  -- ^ Function that writes one element
    -> m ()
dumpPush2 :: Push2 m a -> (Data Length -> Data Length -> a -> m ()) -> m ()
dumpPush2 (Push2 Data Length
_ Data Length
_ (Data Length -> Data Length -> a -> m ()) -> m ()
dump) = (Data Length -> Data Length -> a -> m ()) -> m ()
dump



----------------------------------------
-- ** Operations
----------------------------------------

-- | Turn a vector of rows into a 2-dimensional vector. All inner vectors are
-- assumed to have the given length.
hideRows :: (Pushy m vec1 vec2, Pushy m vec2 a, MonadComp m)
    => Data Length  -- ^ Length of inner vectors
    -> vec1
    -> Push2 m a
hideRows :: Data Length -> vec1 -> Push2 m a
hideRows Data Length
c vec1
vec = Data Length
-> Data Length
-> ((Data Length -> Data Length -> a -> m ()) -> m ())
-> Push2 m a
forall a (m :: * -> *).
Data Length
-> Data Length
-> ((Data Length -> Data Length -> a -> m ()) -> m ())
-> Push2 m a
Push2 (Push m (Push m a) -> Data Length
forall a. Finite a => a -> Data Length
length Push m (Push m a)
v) Data Length
c (((Data Length -> Data Length -> a -> m ()) -> m ()) -> Push2 m a)
-> ((Data Length -> Data Length -> a -> m ()) -> m ()) -> Push2 m a
forall a b. (a -> b) -> a -> b
$ \Data Length -> Data Length -> a -> m ()
write ->
    Push m (Push m a) -> (Data Length -> Push m a -> m ()) -> m ()
forall (m :: * -> *) a.
Push m a -> (Data Length -> a -> m ()) -> m ()
dumpPush Push m (Push m a)
v ((Data Length -> Push m a -> m ()) -> m ())
-> (Data Length -> Push m a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Data Length
i Push m a
row ->
      Push m a -> (Data Length -> a -> m ()) -> m ()
forall (m :: * -> *) a.
Push m a -> (Data Length -> a -> m ()) -> m ()
dumpPush Push m a
row ((Data Length -> a -> m ()) -> m ())
-> (Data Length -> a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Data Length
j a
a -> do
        AssertionLabel -> Data Bool -> String -> m ()
forall (m :: * -> *).
MonadComp m =>
AssertionLabel -> Data Bool -> String -> m ()
assertLabel
          AssertionLabel
InternalAssertion
          (Push m a -> Data Length
forall a. Finite a => a -> Data Length
length Push m a
row Data Length -> Data Length -> Data Bool
forall a. PrimType a => Data a -> Data a -> Data Bool
== Data Length
c)
          String
"hideRows: inner length differs"
        Data Length -> Data Length -> a -> m ()
write Data Length
i Data Length
j a
a
  where
    v :: Push m (Push m a)
v = (vec2 -> Push m a) -> Push m vec2 -> Push m (Push m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap vec2 -> Push m a
forall (m :: * -> *) vec a. Pushy m vec a => vec -> Push m a
toPush (Push m vec2 -> Push m (Push m a))
-> Push m vec2 -> Push m (Push m a)
forall a b. (a -> b) -> a -> b
$ vec1 -> Push m vec2
forall (m :: * -> *) vec a. Pushy m vec a => vec -> Push m a
toPush vec1
vec

-- | Convert a 2-dimensional vector with effectful elements to 'Push2'
--
-- __WARNING:__ This function should be used with care, since is allows hiding
-- effects inside a vector. These effects may be (seemingly) randomly
-- interleaved with other effects when the vector is used.
--
-- The name 'sequens2' has to do with the similarity to the standard function
-- 'sequence'.
sequens2 :: (Pushy2 m vec (m a), Monad m) => vec -> Push2 m a
sequens2 :: vec -> Push2 m a
sequens2 vec
vec = Data Length
-> Data Length
-> ((Data Length -> Data Length -> a -> m ()) -> m ())
-> Push2 m a
forall a (m :: * -> *).
Data Length
-> Data Length
-> ((Data Length -> Data Length -> a -> m ()) -> m ())
-> Push2 m a
Push2 (Push2 m (m a) -> Data Length
forall a. Finite2 a => a -> Data Length
numRows Push2 m (m a)
v) (Push2 m (m a) -> Data Length
forall a. Finite2 a => a -> Data Length
numCols Push2 m (m a)
v) (((Data Length -> Data Length -> a -> m ()) -> m ()) -> Push2 m a)
-> ((Data Length -> Data Length -> a -> m ()) -> m ()) -> Push2 m a
forall a b. (a -> b) -> a -> b
$ \Data Length -> Data Length -> a -> m ()
write ->
    Push2 m (m a)
-> (Data Length -> Data Length -> m a -> m ()) -> m ()
forall (m :: * -> *) a.
Push2 m a -> (Data Length -> Data Length -> a -> m ()) -> m ()
dumpPush2 Push2 m (m a)
v ((Data Length -> Data Length -> m a -> m ()) -> m ())
-> (Data Length -> Data Length -> m a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Data Length
i Data Length
j m a
m ->
      m a
m m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Data Length -> Data Length -> a -> m ()
write Data Length
i Data Length
j
  where
    v :: Push2 m (m a)
v = vec -> Push2 m (m a)
forall (m :: * -> *) vec a. Pushy2 m vec a => vec -> Push2 m a
toPush2 vec
vec

-- | Forward-permute a 'Push' vector using an index mapping. The supplied
-- mapping must be a bijection when restricted to the domain of the vector. This
-- property is not checked, so use with care.
forwardPermute2 :: Pushy2 m vec a
    => (Data Length -> Data Length -> (Data Index, Data Index) -> (Data Index, Data Index))
    -> vec ->  Push2 m a
forwardPermute2 :: (Data Length
 -> Data Length
 -> (Data Length, Data Length)
 -> (Data Length, Data Length))
-> vec -> Push2 m a
forwardPermute2 Data Length
-> Data Length
-> (Data Length, Data Length)
-> (Data Length, Data Length)
p vec
vec = Data Length
-> Data Length
-> ((Data Length -> Data Length -> a -> m ()) -> m ())
-> Push2 m a
forall a (m :: * -> *).
Data Length
-> Data Length
-> ((Data Length -> Data Length -> a -> m ()) -> m ())
-> Push2 m a
Push2 Data Length
r Data Length
c (((Data Length -> Data Length -> a -> m ()) -> m ()) -> Push2 m a)
-> ((Data Length -> Data Length -> a -> m ()) -> m ()) -> Push2 m a
forall a b. (a -> b) -> a -> b
$ \Data Length -> Data Length -> a -> m ()
write ->
    Push2 m a -> (Data Length -> Data Length -> a -> m ()) -> m ()
forall (m :: * -> *) a.
Push2 m a -> (Data Length -> Data Length -> a -> m ()) -> m ()
dumpPush2 Push2 m a
v ((Data Length -> Data Length -> a -> m ()) -> m ())
-> (Data Length -> Data Length -> a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Data Length
i Data Length
j a
a -> do
      let (Data Length
i',Data Length
j') = Data Length
-> Data Length
-> (Data Length, Data Length)
-> (Data Length, Data Length)
p Data Length
r Data Length
c (Data Length
i,Data Length
j)
      Data Length -> Data Length -> a -> m ()
write Data Length
i' Data Length
j' a
a
  where
    v :: Push2 m a
v     = vec -> Push2 m a
forall (m :: * -> *) vec a. Pushy2 m vec a => vec -> Push2 m a
toPush2 vec
vec
    (Data Length
r,Data Length
c) = Push2 m a -> (Data Length, Data Length)
forall a. Finite2 a => a -> (Data Length, Data Length)
extent2 Push2 m a
v

transposePush :: Pushy2 m vec a => vec -> Push2 m a
transposePush :: vec -> Push2 m a
transposePush vec
vec = Data Length
-> Data Length
-> ((Data Length -> Data Length -> a -> m ()) -> m ())
-> Push2 m a
forall a (m :: * -> *).
Data Length
-> Data Length
-> ((Data Length -> Data Length -> a -> m ()) -> m ())
-> Push2 m a
Push2 Data Length
c Data Length
r (((Data Length -> Data Length -> a -> m ()) -> m ()) -> Push2 m a)
-> ((Data Length -> Data Length -> a -> m ()) -> m ()) -> Push2 m a
forall a b. (a -> b) -> a -> b
$ \Data Length -> Data Length -> a -> m ()
write ->
    Push2 m a -> (Data Length -> Data Length -> a -> m ()) -> m ()
forall (m :: * -> *) a.
Push2 m a -> (Data Length -> Data Length -> a -> m ()) -> m ()
dumpPush2 Push2 m a
v ((Data Length -> Data Length -> a -> m ()) -> m ())
-> (Data Length -> Data Length -> a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Data Length
i Data Length
j a
a ->
      Data Length -> Data Length -> a -> m ()
write Data Length
j Data Length
i a
a
  where
    v :: Push2 m a
v     = vec -> Push2 m a
forall (m :: * -> *) vec a. Pushy2 m vec a => vec -> Push2 m a
toPush2 vec
vec
    (Data Length
r,Data Length
c) = Push2 m a -> (Data Length, Data Length)
forall a. Finite2 a => a -> (Data Length, Data Length)
extent2 Push2 m a
v



--------------------------------------------------------------------------------
-- * Sequential vectors
--------------------------------------------------------------------------------

-- | Finite sequential vector
--
-- Users interested in infinite streams are referred to the library:
-- <https://github.com/emilaxelsson/feldspar-synch>
data Seq m a
  where
    Seq :: Data Length -> m (Data Index -> m a) -> Seq m a

-- | 'Seq' vector specialized to 'Data' elements
type DSeq m a = Seq m (Data a)

instance Monad m => Functor (Seq m)
  where
    fmap :: (a -> b) -> Seq m a -> Seq m b
fmap a -> b
f (Seq Data Length
len m (Data Length -> m a)
init) = Data Length -> m (Data Length -> m b) -> Seq m b
forall (m :: * -> *) a.
Data Length -> m (Data Length -> m a) -> Seq m a
Seq Data Length
len (m (Data Length -> m b) -> Seq m b)
-> m (Data Length -> m b) -> Seq m b
forall a b. (a -> b) -> a -> b
$ do
      Data Length -> m a
next <- m (Data Length -> m a)
init
      (Data Length -> m b) -> m (Data Length -> m b)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Data Length -> m b) -> m (Data Length -> m b))
-> (Data Length -> m b) -> m (Data Length -> m b)
forall a b. (a -> b) -> a -> b
$ (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (m a -> m b) -> (Data Length -> m a) -> Data Length -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data Length -> m a
next

instance Finite (Seq m a)
  where
    length :: Seq m a -> Data Length
length (Seq Data Length
len m (Data Length -> m a)
_) = Data Length
len

instance
    ( Syntax a
    , MarshalHaskell (Internal a)
    , MarshalFeld a
    , m ~ Run
    ) =>
      MarshalFeld (Seq m a)
  where
    type HaskellRep (Seq m a) = HaskellRep (Manifest a)

    fwrite :: Handle -> Seq m a -> Run ()
fwrite Handle
hdl (Seq Data Length
len m (Data Length -> m a)
init) = do
      Data Length -> m a
next <- m (Data Length -> m a)
Run (Data Length -> m a)
init
      Handle -> Data Length -> Run ()
forall a. MarshalFeld a => Handle -> a -> Run ()
fwrite Handle
hdl Data Length
len Run () -> Run () -> Run ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Run ()
forall r. PrintfType r => String -> r
printf String
" "
      IxRange (Data Length) -> (Data Length -> m ()) -> m ()
forall (m :: * -> *) n.
(MonadComp m, Integral n, PrimType n) =>
IxRange (Data n) -> (Data n -> m ()) -> m ()
for (Data Length
0,Int
1,Data Length -> Border (Data Length)
forall i. i -> Border i
Excl Data Length
len) ((Data Length -> m ()) -> m ()) -> (Data Length -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Data Length
i -> Data Length -> m a
next Data Length
i m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> a -> Run ()
forall a. MarshalFeld a => Handle -> a -> Run ()
fwrite Handle
hdl m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> m ()
forall r. PrintfType r => String -> r
printf String
" "

    fread :: Handle -> Run (Seq m a)
fread Handle
hdl = Manifest a -> Seq m a
forall (m :: * -> *) vec a. Seqy m vec a => vec -> Seq m a
toSeq (Manifest a -> Seq m a)
-> (Manifest a -> Manifest a) -> Manifest a -> Seq m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> a
forall _. Manifest _ -> Manifest _
id :: Manifest _ -> _) (Manifest a -> Seq m a) -> Run (Manifest a) -> Run (Seq m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> Run (Manifest a)
forall a. MarshalFeld a => Handle -> Run a
fread Handle
hdl
      -- Need to go through a temporary array to avoid embedding side-effects in
      -- the resulting vector. E.g. we don't want to duplicate the reads if the
      -- vector is duplicated.

-- | Vectors that can be converted to 'Seq'
class Seqy m vec a | vec -> a
  where
    -- | Convert a vector to 'Seq'
    toSeq :: vec -> Seq m a

-- | A version of 'toSeq' that constrains the @m@ argument of 'Seq' to that of
-- the monad in which the result is returned. This can be a convenient way to
-- avoid unresolved overloading.
toSeqM :: (Seqy m vec a, Monad m) => vec -> m (Seq m a)
toSeqM :: vec -> m (Seq m a)
toSeqM = Seq m a -> m (Seq m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Seq m a -> m (Seq m a)) -> (vec -> Seq m a) -> vec -> m (Seq m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. vec -> Seq m a
forall (m :: * -> *) vec a. Seqy m vec a => vec -> Seq m a
toSeq

instance (Syntax a, MonadComp m) => Seqy m (Manifest a) a where toSeq :: Manifest a -> Seq m a
toSeq = Pull a -> Seq m a
forall (m :: * -> *) vec a. Seqy m vec a => vec -> Seq m a
toSeq (Pull a -> Seq m a)
-> (Manifest a -> Pull a) -> Manifest a -> Seq m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Manifest a -> Pull a
forall vec a. Pully vec a => vec -> Pull a
toPull
instance (m1 ~ m2)               => Seqy m1 (Seq m2 a) a  where toSeq :: Seq m2 a -> Seq m1 a
toSeq = Seq m2 a -> Seq m1 a
forall a. a -> a
id

instance MonadComp m => Seqy m (Pull a) a
  where
    toSeq :: Pull a -> Seq m a
toSeq Pull a
vec = Data Length -> m (Data Length -> m a) -> Seq m a
forall (m :: * -> *) a.
Data Length -> m (Data Length -> m a) -> Seq m a
Seq (Pull a -> Data Length
forall a. Finite a => a -> Data Length
length Pull a
vec) (m (Data Length -> m a) -> Seq m a)
-> m (Data Length -> m a) -> Seq m a
forall a b. (a -> b) -> a -> b
$ (Data Length -> m a) -> m (Data Length -> m a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Data Length -> m a) -> m (Data Length -> m a))
-> (Data Length -> m a) -> m (Data Length -> m a)
forall a b. (a -> b) -> a -> b
$ \Data Length
i -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ Pull a
vecPull a -> Data Length -> IndexedElem (Pull a)
forall a. Indexed a => a -> Data Length -> IndexedElem a
!Data Length
i

zipWithSeq :: (Seqy m vec1 a, Seqy m vec2 b, Monad m) =>
    (a -> b -> c) -> vec1 -> vec2 -> Seq m c
zipWithSeq :: (a -> b -> c) -> vec1 -> vec2 -> Seq m c
zipWithSeq a -> b -> c
f vec1
vec1 vec2
vec2 = Data Length -> m (Data Length -> m c) -> Seq m c
forall (m :: * -> *) a.
Data Length -> m (Data Length -> m a) -> Seq m a
Seq (Data Length -> Data Length -> Data Length
forall a. (Ord a, PrimType a) => Data a -> Data a -> Data a
min Data Length
l1 Data Length
l2) (m (Data Length -> m c) -> Seq m c)
-> m (Data Length -> m c) -> Seq m c
forall a b. (a -> b) -> a -> b
$ do
    Data Length -> m a
next1 <- m (Data Length -> m a)
init1
    Data Length -> m b
next2 <- m (Data Length -> m b)
init2
    (Data Length -> m c) -> m (Data Length -> m c)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Data Length -> m c) -> m (Data Length -> m c))
-> (Data Length -> m c) -> m (Data Length -> m c)
forall a b. (a -> b) -> a -> b
$ \Data Length
i -> a -> b -> c
f (a -> b -> c) -> m a -> m (b -> c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Data Length -> m a
next1 Data Length
i m (b -> c) -> m b -> m c
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Data Length -> m b
next2 Data Length
i
  where
    Seq Data Length
l1 m (Data Length -> m a)
init1 = vec1 -> Seq m a
forall (m :: * -> *) vec a. Seqy m vec a => vec -> Seq m a
toSeq vec1
vec1
    Seq Data Length
l2 m (Data Length -> m b)
init2 = vec2 -> Seq m b
forall (m :: * -> *) vec a. Seqy m vec a => vec -> Seq m a
toSeq vec2
vec2

unfold :: (Syntax b, MonadComp m) => Data Length -> (b -> (b,a)) -> b -> Seq m a
unfold :: Data Length -> (b -> (b, a)) -> b -> Seq m a
unfold Data Length
len b -> (b, a)
step b
init = Data Length -> m (Data Length -> m a) -> Seq m a
forall (m :: * -> *) a.
Data Length -> m (Data Length -> m a) -> Seq m a
Seq Data Length
len (m (Data Length -> m a) -> Seq m a)
-> m (Data Length -> m a) -> Seq m a
forall a b. (a -> b) -> a -> b
$ do
    Ref b
r <- b -> m (Ref b)
forall a (m :: * -> *). (Syntax a, MonadComp m) => a -> m (Ref a)
initRef b
init
    (Data Length -> m a) -> m (Data Length -> m a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Data Length -> m a) -> m (Data Length -> m a))
-> (Data Length -> m a) -> m (Data Length -> m a)
forall a b. (a -> b) -> a -> b
$ \Data Length
_ -> do
      b
acc <- Ref b -> m b
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
getRef Ref b
r
      let (b
acc',a
a) = b -> (b, a)
step b
acc
      Ref b -> b -> m ()
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Ref a -> a -> m ()
setRef Ref b
r b
acc'
      a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

mapAccum' :: (Seqy m vec a, Syntax acc, MonadComp m) =>
    (acc -> a -> (acc,b)) -> acc -> vec -> Seq m (acc,b)
mapAccum' :: (acc -> a -> (acc, b)) -> acc -> vec -> Seq m (acc, b)
mapAccum' acc -> a -> (acc, b)
step acc
acc0 vec
vec = Data Length -> m (Data Length -> m (acc, b)) -> Seq m (acc, b)
forall (m :: * -> *) a.
Data Length -> m (Data Length -> m a) -> Seq m a
Seq Data Length
len (m (Data Length -> m (acc, b)) -> Seq m (acc, b))
-> m (Data Length -> m (acc, b)) -> Seq m (acc, b)
forall a b. (a -> b) -> a -> b
$ do
    Data Length -> m a
next <- m (Data Length -> m a)
init
    Ref acc
r    <- acc -> m (Ref acc)
forall a (m :: * -> *). (Syntax a, MonadComp m) => a -> m (Ref a)
initRef acc
acc0
    (Data Length -> m (acc, b)) -> m (Data Length -> m (acc, b))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Data Length -> m (acc, b)) -> m (Data Length -> m (acc, b)))
-> (Data Length -> m (acc, b)) -> m (Data Length -> m (acc, b))
forall a b. (a -> b) -> a -> b
$ \Data Length
i -> do
      a
a   <- Data Length -> m a
next Data Length
i
      acc
acc <- Ref acc -> m acc
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
getRef Ref acc
r
      let (acc
acc',b
b) = acc -> a -> (acc, b)
step acc
acc a
a
      Ref acc -> acc -> m ()
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Ref a -> a -> m ()
setRef Ref acc
r acc
acc'
      acc
acc'' <- Ref acc -> m acc
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
getRef Ref acc
r
        -- Read from the reference to avoid duplicating `acc'`
      (acc, b) -> m (acc, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (acc
acc'',b
b)
  where
    Seq Data Length
len m (Data Length -> m a)
init = vec -> Seq m a
forall (m :: * -> *) vec a. Seqy m vec a => vec -> Seq m a
toSeq vec
vec

mapAccum :: (Seqy m vec a, Syntax acc, MonadComp m) =>
    (acc -> a -> (acc,b)) -> acc -> vec -> Seq m b
mapAccum :: (acc -> a -> (acc, b)) -> acc -> vec -> Seq m b
mapAccum acc -> a -> (acc, b)
step acc
acc0 vec
vec = Data Length -> m (Data Length -> m b) -> Seq m b
forall (m :: * -> *) a.
Data Length -> m (Data Length -> m a) -> Seq m a
Seq Data Length
len (m (Data Length -> m b) -> Seq m b)
-> m (Data Length -> m b) -> Seq m b
forall a b. (a -> b) -> a -> b
$ do
    Data Length -> m a
next <- m (Data Length -> m a)
init
    Ref acc
r    <- acc -> m (Ref acc)
forall a (m :: * -> *). (Syntax a, MonadComp m) => a -> m (Ref a)
initRef acc
acc0
    (Data Length -> m b) -> m (Data Length -> m b)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Data Length -> m b) -> m (Data Length -> m b))
-> (Data Length -> m b) -> m (Data Length -> m b)
forall a b. (a -> b) -> a -> b
$ \Data Length
i -> do
      a
a   <- Data Length -> m a
next Data Length
i
      acc
acc <- Ref acc -> m acc
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
getRef Ref acc
r
      let (acc
acc',b
b) = acc -> a -> (acc, b)
step acc
acc a
a
      Ref acc -> acc -> m ()
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Ref a -> a -> m ()
setRef Ref acc
r acc
acc'
      b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
  where
    Seq Data Length
len m (Data Length -> m a)
init = vec -> Seq m a
forall (m :: * -> *) vec a. Seqy m vec a => vec -> Seq m a
toSeq vec
vec

-- | This function behaves slightly differently from the standard @scanl@ for
-- lists:
--
-- * The initial element is not included in the output
-- * Thus, the output has the same length as the input
scan :: (Seqy m vec b, Syntax a, MonadComp m) =>
    (a -> b -> a) -> a -> vec -> Seq m a
scan :: (a -> b -> a) -> a -> vec -> Seq m a
scan a -> b -> a
step a
acc0 = ((a, ()) -> a) -> Seq m (a, ()) -> Seq m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, ()) -> a
forall a b. (a, b) -> a
fst (Seq m (a, ()) -> Seq m a)
-> (vec -> Seq m (a, ())) -> vec -> Seq m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> (a, ())) -> a -> vec -> Seq m (a, ())
forall (m :: * -> *) vec a acc b.
(Seqy m vec a, Syntax acc, MonadComp m) =>
(acc -> a -> (acc, b)) -> acc -> vec -> Seq m (acc, b)
mapAccum' (\a
acc b
a -> (a -> b -> a
step a
acc b
a, ())) a
acc0
  -- The reason for the discrepancy towards `Data.List.scanl` is that it's
  -- generally not possible for a `Seq` of length `l+1` to read elements from a
  -- `Seq` of length `l` without a conditional in the body.



--------------------------------------------------------------------------------
-- * Writing to memory
--------------------------------------------------------------------------------

-- It would be possible to make the `vec` parameter to `ViewManifest` and
-- `Manifestable` have kind `* -> *` and avoid the `a` parameter. But the
-- current design was chosen for consistency with `ViewManifest2` and
-- `Manifestable2`.

class ViewManifest vec a | vec -> a
  where
    -- | Try to cast a vector to 'Manifest' directly
    viewManifest :: vec -> Maybe (Manifest a)
    viewManifest vec
_ = Maybe (Manifest a)
forall a. Maybe a
Nothing

instance ViewManifest (Manifest a) a where viewManifest :: Manifest a -> Maybe (Manifest a)
viewManifest = Manifest a -> Maybe (Manifest a)
forall a. a -> Maybe a
Just
instance ViewManifest (Pull a) a
instance ViewManifest (Push m a) a
instance ViewManifest (Seq m a) a

class ViewManifest vec a => Manifestable m vec a | vec -> a
  where
    -- | Write the contents of a vector to memory and get it back as a
    -- 'Manifest' vector. The supplied array may or may not be used for storage.
    manifest :: Syntax a
        => Arr a  -- ^ Where to store the vector
        -> vec    -- ^ Vector to store
        -> m (Manifest a)

    default manifest :: (Pushy m vec a, Finite vec, Syntax a, MonadComp m) =>
        Arr a -> vec -> m (Manifest a)
    manifest Arr a
loc vec
vec = do
        Push m a -> (Data Length -> a -> m ()) -> m ()
forall (m :: * -> *) a.
Push m a -> (Data Length -> a -> m ()) -> m ()
dumpPush Push m a
v ((Data Length -> a -> m ()) -> m ())
-> (Data Length -> a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Data Length
i a
a -> Arr a -> Data Length -> a -> m ()
forall (m :: * -> *) a.
(Syntax a, MonadComp m) =>
Arr a -> Data Length -> a -> m ()
setArr Arr a
loc Data Length
i a
a
        Data Length -> Arr a -> m (Manifest a)
forall (m :: * -> *) a.
MonadComp m =>
Data Length -> Arr a -> m (IArr a)
unsafeFreezeSlice (vec -> Data Length
forall a. Finite a => a -> Data Length
length vec
vec) Arr a
loc
      where
        v :: Push m a
v = vec -> Push m a
forall (m :: * -> *) vec a. Pushy m vec a => vec -> Push m a
toPush vec
vec

    -- | A version of 'manifest' that allocates a fresh array for the result
    manifestFresh :: Syntax a => vec -> m (Manifest a)

    default manifestFresh :: (Finite vec, Syntax a, MonadComp m) =>
        vec -> m (Manifest a)
    manifestFresh vec
vec = do
        Arr a
loc <- Data Length -> m (Arr a)
forall a (m :: * -> *).
(Type (Internal a), MonadComp m) =>
Data Length -> m (Arr a)
newArr (Data Length -> m (Arr a)) -> Data Length -> m (Arr a)
forall a b. (a -> b) -> a -> b
$ vec -> Data Length
forall a. Finite a => a -> Data Length
length vec
vec
        Arr a -> vec -> m (Manifest a)
forall (m :: * -> *) vec a.
(Manifestable m vec a, Syntax a) =>
Arr a -> vec -> m (Manifest a)
manifest Arr a
loc vec
vec

    -- | A version of 'manifest' that only stores the vector to the given array
    -- ('manifest' is not guaranteed to use the array)
    manifestStore :: Syntax a => Arr a -> vec -> m ()

    default manifestStore :: (Pushy m vec a, Syntax a, MonadComp m) =>
        Arr a -> vec -> m ()
    manifestStore Arr a
loc = m (Manifest a) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Manifest a) -> m ()) -> (vec -> m (Manifest a)) -> vec -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arr a -> Push m a -> m (Manifest a)
forall (m :: * -> *) vec a.
(Manifestable m vec a, Syntax a) =>
Arr a -> vec -> m (Manifest a)
manifest Arr a
loc (Push m a -> m (Manifest a))
-> (vec -> Push m a) -> vec -> m (Manifest a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. vec -> Push m a
forall (m :: * -> *) vec a. Pushy m vec a => vec -> Push m a
toPush

-- | 'manifest' and 'manifestFresh' are no-ops. 'manifestStore' does a proper
-- 'arrCopy'.
instance MonadComp m => Manifestable m (Manifest a) a
  where
    manifest :: Arr a -> Manifest a -> m (Manifest a)
manifest Arr a
_        = Manifest a -> m (Manifest a)
forall (m :: * -> *) a. Monad m => a -> m a
return
    manifestFresh :: Manifest a -> m (Manifest a)
manifestFresh     = Manifest a -> m (Manifest a)
forall (m :: * -> *) a. Monad m => a -> m a
return
    manifestStore :: Arr a -> Manifest a -> m ()
manifestStore Arr a
loc = Arr a -> Arr a -> m ()
forall (m :: * -> *) a. MonadComp m => Arr a -> Arr a -> m ()
copyArr Arr a
loc (Arr a -> m ()) -> (Manifest a -> m (Arr a)) -> Manifest a -> m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Manifest a -> m (Arr a)
forall (m :: * -> *) a. MonadComp m => IArr a -> m (Arr a)
unsafeThawArr

instance MonadComp m             => Manifestable m (Pull a) a
instance (MonadComp m1, m1 ~ m2) => Manifestable m1 (Push m2 a) a
instance (MonadComp m1, m1 ~ m2) => Manifestable m1 (Seq m2 a) a


class ViewManifest2 vec a | vec -> a
  where
    -- | Try to cast a vector to 'Manifest2' directly
    viewManifest2 :: vec -> Maybe (Manifest2 a)
    viewManifest2 vec
_ = Maybe (Manifest2 a)
forall a. Maybe a
Nothing

instance ViewManifest2 (Manifest2 a) a where viewManifest2 :: Manifest2 a -> Maybe (Manifest2 a)
viewManifest2 = Manifest2 a -> Maybe (Manifest2 a)
forall a. a -> Maybe a
Just
instance ViewManifest2 (Pull2 a) a
instance ViewManifest2 (Push2 m a) a

class ViewManifest2 vec a => Manifestable2 m vec a | vec -> a
  where
    -- | Write the contents of a vector to memory and get it back as a
    -- 'Manifest2' vector
    manifest2 :: Syntax a
        => Arr a  -- ^ Where to store the result
        -> vec    -- ^ Vector to store
        -> m (Manifest2 a)

    default manifest2 :: (Pushy2 m vec a, Syntax a, MonadComp m) =>
        Arr a -> vec -> m (Manifest2 a)
    manifest2 Arr a
loc vec
vec = do
        Push2 m a -> (Data Length -> Data Length -> a -> m ()) -> m ()
forall (m :: * -> *) a.
Push2 m a -> (Data Length -> Data Length -> a -> m ()) -> m ()
dumpPush2 Push2 m a
v ((Data Length -> Data Length -> a -> m ()) -> m ())
-> (Data Length -> Data Length -> a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Data Length
i Data Length
j a
a -> Arr a -> Data Length -> a -> m ()
forall (m :: * -> *) a.
(Syntax a, MonadComp m) =>
Arr a -> Data Length -> a -> m ()
setArr Arr a
loc (Data Length
iData Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
*Data Length
c Data Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
+ Data Length
j) a
a
        Data Length -> Data Length -> IArr a -> Manifest2 a
forall a. Finite a => Data Length -> Data Length -> a -> Nest a
nest Data Length
r Data Length
c (IArr a -> Manifest2 a) -> m (IArr a) -> m (Manifest2 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Data Length -> Arr a -> m (IArr a)
forall (m :: * -> *) a.
MonadComp m =>
Data Length -> Arr a -> m (IArr a)
unsafeFreezeSlice (Data Length
rData Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
*Data Length
c) Arr a
loc
      where
        v :: Push2 m a
v     = vec -> Push2 m a
forall (m :: * -> *) vec a. Pushy2 m vec a => vec -> Push2 m a
toPush2 vec
vec
        (Data Length
r,Data Length
c) = Push2 m a -> (Data Length, Data Length)
forall a. Finite2 a => a -> (Data Length, Data Length)
extent2 Push2 m a
v

    -- | A version of 'manifest2' that allocates a fresh array for the result
    manifestFresh2 :: Syntax a => vec -> m (Manifest2 a)

    default manifestFresh2 :: (Finite2 vec, Syntax a, MonadComp m) =>
        vec -> m (Manifest2 a)
    manifestFresh2 vec
vec = do
        Arr a
loc <- Data Length -> m (Arr a)
forall a (m :: * -> *).
(Type (Internal a), MonadComp m) =>
Data Length -> m (Arr a)
newArr (vec -> Data Length
forall a. Finite2 a => a -> Data Length
numRows vec
vec Data Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
* vec -> Data Length
forall a. Finite2 a => a -> Data Length
numCols vec
vec)
        Arr a -> vec -> m (Manifest2 a)
forall (m :: * -> *) vec a.
(Manifestable2 m vec a, Syntax a) =>
Arr a -> vec -> m (Manifest2 a)
manifest2 Arr a
loc vec
vec

    -- | A version of 'manifest2' that only stores the vector to the given array
    -- ('manifest2' is not guaranteed to use the array)
    manifestStore2 :: Syntax a => Arr a -> vec -> m ()

    default manifestStore2 :: (Pushy2 m vec a, Syntax a, MonadComp m) =>
        Arr a -> vec -> m ()
    manifestStore2 Arr a
loc = m (Manifest2 a) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Manifest2 a) -> m ())
-> (vec -> m (Manifest2 a)) -> vec -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arr a -> Push2 m a -> m (Manifest2 a)
forall (m :: * -> *) vec a.
(Manifestable2 m vec a, Syntax a) =>
Arr a -> vec -> m (Manifest2 a)
manifest2 Arr a
loc (Push2 m a -> m (Manifest2 a))
-> (vec -> Push2 m a) -> vec -> m (Manifest2 a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. vec -> Push2 m a
forall (m :: * -> *) vec a. Pushy2 m vec a => vec -> Push2 m a
toPush2

-- | 'manifest2' and 'manifestFresh2' are no-ops. 'manifestStore2' does a proper
-- 'arrCopy'.
instance MonadComp m => Manifestable2 m (Manifest2 a) a
  where
    manifest2 :: Arr a -> Manifest2 a -> m (Manifest2 a)
manifest2 Arr a
_        = Manifest2 a -> m (Manifest2 a)
forall (m :: * -> *) a. Monad m => a -> m a
return
    manifestFresh2 :: Manifest2 a -> m (Manifest2 a)
manifestFresh2     = Manifest2 a -> m (Manifest2 a)
forall (m :: * -> *) a. Monad m => a -> m a
return
    manifestStore2 :: Arr a -> Manifest2 a -> m ()
manifestStore2 Arr a
loc = Arr a -> Arr a -> m ()
forall (m :: * -> *) a. MonadComp m => Arr a -> Arr a -> m ()
copyArr Arr a
loc (Arr a -> m ())
-> (Manifest2 a -> m (Arr a)) -> Manifest2 a -> m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< IArr a -> m (Arr a)
forall (m :: * -> *) a. MonadComp m => IArr a -> m (Arr a)
unsafeThawArr (IArr a -> m (Arr a))
-> (Manifest2 a -> IArr a) -> Manifest2 a -> m (Arr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Manifest2 a -> IArr a
forall a. Slicable a => Nest a -> a
unnest

instance MonadComp m             => Manifestable2 m (Pull2 a) a
instance (MonadComp m1, m1 ~ m2) => Manifestable2 m1 (Push2 m2 a) a