module Feldspar.Data.Buffered
( Store
, newStore
, unsafeInplaceStore
, unsafeFreezeStore
, unsafeFreezeStore2
, setStore
, setStore2
, store
, store2
, loopStore
, loopStore2
) where
import Prelude ()
import Control.Monad.State
import Feldspar.Representation
import Feldspar.Run
import Feldspar.Data.Vector
data Store a = Store
{ Store a -> Arr a
activeBuf :: Arr a
, Store a -> Arr a
freeBuf :: Arr a
}
newStore :: (Syntax a, MonadComp m) => Data Length -> m (Store a)
newStore :: Data Length -> m (Store a)
newStore Data Length
l = Arr a -> Arr a -> Store a
forall a. Arr a -> Arr a -> Store a
Store (Arr a -> Arr a -> Store a) -> m (Arr a) -> m (Arr a -> Store a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Data Length -> m (Arr a)
forall a (m :: * -> *).
(Type (Internal a), MonadComp m) =>
String -> Data Length -> m (Arr a)
newNamedArr String
"store" Data Length
l m (Arr a -> Store a) -> m (Arr a) -> m (Store a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Data Length -> m (Arr a)
forall a (m :: * -> *).
(Type (Internal a), MonadComp m) =>
String -> Data Length -> m (Arr a)
newNamedArr String
"store" Data Length
l
unsafeInplaceStore :: (Syntax a, MonadComp m) => Data Length -> m (Store a)
unsafeInplaceStore :: Data Length -> m (Store a)
unsafeInplaceStore Data Length
l = do
Arr a
arr <- String -> Data Length -> m (Arr a)
forall a (m :: * -> *).
(Type (Internal a), MonadComp m) =>
String -> Data Length -> m (Arr a)
newNamedArr String
"store" Data Length
l
Store a -> m (Store a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Store a -> m (Store a)) -> Store a -> m (Store a)
forall a b. (a -> b) -> a -> b
$ Arr a -> Arr a -> Store a
forall a. Arr a -> Arr a -> Store a
Store Arr a
arr Arr a
arr
unsafeFreezeStore :: (Syntax a, MonadComp m) =>
Data Length -> Store a -> m (Manifest a)
unsafeFreezeStore :: Data Length -> Store a -> m (Manifest a)
unsafeFreezeStore Data Length
l = Data Length -> Arr a -> m (Manifest a)
forall (m :: * -> *) a.
MonadComp m =>
Data Length -> Arr a -> m (IArr a)
unsafeFreezeSlice Data Length
l (Arr a -> m (Manifest a))
-> (Store a -> Arr a) -> Store a -> m (Manifest a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Store a -> Arr a
forall a. Store a -> Arr a
activeBuf
unsafeFreezeStore2 :: (Syntax a, MonadComp m)
=> Data Length
-> Data Length
-> Store a
-> m (Manifest2 a)
unsafeFreezeStore2 :: Data Length -> Data Length -> Store a -> m (Manifest2 a)
unsafeFreezeStore2 Data Length
r Data Length
c Store {Arr a
freeBuf :: Arr a
activeBuf :: Arr a
freeBuf :: forall a. Store a -> Arr a
activeBuf :: forall a. Store a -> Arr 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
activeBuf
swapStore :: Syntax a => Store a -> Run ()
swapStore :: Store a -> Run ()
swapStore Store {Arr a
freeBuf :: Arr a
activeBuf :: Arr a
freeBuf :: forall a. Store a -> Arr a
activeBuf :: forall a. Store a -> Arr a
..} = Arr a -> Arr a -> Run ()
forall a. Arr a -> Arr a -> Run ()
unsafeSwapArr Arr a
activeBuf Arr a
freeBuf
setStore :: (Manifestable Run vec a, Finite vec, Syntax a) =>
Store a -> vec -> Run ()
setStore :: Store a -> vec -> Run ()
setStore st :: Store a
st@Store {Arr a
freeBuf :: Arr a
activeBuf :: Arr a
freeBuf :: forall a. Store a -> Arr a
activeBuf :: forall a. Store a -> Arr a
..} vec
vec = case vec -> Maybe (Manifest a)
forall vec a. ViewManifest vec a => vec -> Maybe (Manifest a)
viewManifest vec
vec of
Just Manifest a
iarr
| Arr a -> Manifest a -> Bool
forall a. Arr a -> IArr a -> Bool
unsafeEqArrIArr Arr a
activeBuf Manifest a
iarr ->
Data Bool -> Run () -> Run () -> Run ()
forall (m :: * -> *).
MonadComp m =>
Data Bool -> m () -> m () -> m ()
iff (Manifest a -> Data Length
forall a. IArr a -> Data Length
iarrOffset Manifest a
iarr Data Length -> Data Length -> Data Bool
forall a. PrimType a => Data a -> Data a -> Data Bool
== Arr a -> Data Length
forall a. Arr a -> Data Length
arrOffset Arr a
activeBuf)
(() -> Run ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
Run ()
saveAndSwap
Maybe (Manifest a)
_ -> Run ()
saveAndSwap
where
saveAndSwap :: Run ()
saveAndSwap = Arr a -> vec -> Run ()
forall (m :: * -> *) vec a.
(Manifestable m vec a, Syntax a) =>
Arr a -> vec -> m ()
manifestStore Arr a
freeBuf vec
vec Run () -> Run () -> Run ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Store a -> Run ()
forall a. Syntax a => Store a -> Run ()
swapStore Store a
st
setStore2 :: (Manifestable2 Run vec a, Finite2 vec, Syntax a) =>
Store a -> vec -> Run ()
setStore2 :: Store a -> vec -> Run ()
setStore2 st :: Store a
st@Store {Arr a
freeBuf :: Arr a
activeBuf :: Arr a
freeBuf :: forall a. Store a -> Arr a
activeBuf :: forall a. Store a -> Arr a
..} vec
vec = case vec -> Maybe (Manifest2 a)
forall vec a. ViewManifest2 vec a => vec -> Maybe (Manifest2 a)
viewManifest2 vec
vec of
Just Manifest2 a
arr
| let iarr :: Manifest a
iarr = Manifest2 a -> Manifest a
forall a. Slicable a => Nest a -> a
unnest Manifest2 a
arr
, Arr a -> Manifest a -> Bool
forall a. Arr a -> IArr a -> Bool
unsafeEqArrIArr Arr a
activeBuf Manifest a
iarr ->
Data Bool -> Run () -> Run () -> Run ()
forall (m :: * -> *).
MonadComp m =>
Data Bool -> m () -> m () -> m ()
iff (Manifest a -> Data Length
forall a. IArr a -> Data Length
iarrOffset Manifest a
iarr Data Length -> Data Length -> Data Bool
forall a. PrimType a => Data a -> Data a -> Data Bool
== Arr a -> Data Length
forall a. Arr a -> Data Length
arrOffset Arr a
activeBuf)
(() -> Run ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
Run ()
saveAndSwap
Maybe (Manifest2 a)
_ -> Run ()
saveAndSwap
where
saveAndSwap :: Run ()
saveAndSwap = Arr a -> vec -> Run ()
forall (m :: * -> *) vec a.
(Manifestable2 m vec a, Syntax a) =>
Arr a -> vec -> m ()
manifestStore2 Arr a
freeBuf vec
vec Run () -> Run () -> Run ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Store a -> Run ()
forall a. Syntax a => Store a -> Run ()
swapStore Store a
st
store :: (Manifestable Run vec a, Finite vec, Syntax a) =>
Store a -> vec -> Run (Manifest a)
store :: Store a -> vec -> Run (Manifest a)
store Store a
st vec
vec = Store a -> vec -> Run ()
forall vec a.
(Manifestable Run vec a, Finite vec, Syntax a) =>
Store a -> vec -> Run ()
setStore Store a
st vec
vec Run () -> Run (Manifest a) -> Run (Manifest a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Data Length -> Store a -> Run (Manifest a)
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Data Length -> Store a -> m (Manifest a)
unsafeFreezeStore (vec -> Data Length
forall a. Finite a => a -> Data Length
length vec
vec) Store a
st
store2 :: (Manifestable2 Run vec a, Finite2 vec, Syntax a) =>
Store a -> vec -> Run (Manifest2 a)
store2 :: Store a -> vec -> Run (Manifest2 a)
store2 Store a
st vec
vec = Store a -> vec -> Run ()
forall vec a.
(Manifestable2 Run vec a, Finite2 vec, Syntax a) =>
Store a -> vec -> Run ()
setStore2 Store a
st vec
vec Run () -> Run (Manifest2 a) -> Run (Manifest2 a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Data Length -> Data Length -> Store a -> Run (Manifest2 a)
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Data Length -> Data Length -> Store a -> m (Manifest2 a)
unsafeFreezeStore2 Data Length
r Data Length
c Store a
st
where
(Data Length
r,Data Length
c) = vec -> (Data Length, Data Length)
forall a. Finite2 a => a -> (Data Length, Data Length)
extent2 vec
vec
loopStore
:: ( Integral i
, PrimType i
, Syntax a
, Manifestable Run vec1 a
, Finite vec1
, Manifestable Run vec2 a
, Finite vec2
)
=> Store a
-> IxRange (Data i)
-> (Data i -> Manifest a -> Run vec1)
-> vec2
-> Run (Manifest a)
loopStore :: Store a
-> IxRange (Data i)
-> (Data i -> Manifest a -> Run vec1)
-> vec2
-> Run (Manifest a)
loopStore Store a
st IxRange (Data i)
rng Data i -> Manifest a -> Run vec1
body vec2
init = do
Store a -> vec2 -> Run ()
forall vec a.
(Manifestable Run vec a, Finite vec, Syntax a) =>
Store a -> vec -> Run ()
setStore Store a
st vec2
init
Ref (Data Length)
lr <- Data Length -> Run (Ref (Data Length))
forall a (m :: * -> *). (Syntax a, MonadComp m) => a -> m (Ref a)
initRef (Data Length -> Run (Ref (Data Length)))
-> Data Length -> Run (Ref (Data Length))
forall a b. (a -> b) -> a -> b
$ vec2 -> Data Length
forall a. Finite a => a -> Data Length
length vec2
init
IxRange (Data i) -> (Data i -> Run ()) -> Run ()
forall (m :: * -> *) n.
(MonadComp m, Integral n, PrimType n) =>
IxRange (Data n) -> (Data n -> m ()) -> m ()
for IxRange (Data i)
rng ((Data i -> Run ()) -> Run ()) -> (Data i -> Run ()) -> Run ()
forall a b. (a -> b) -> a -> b
$ \Data i
i -> do
Data Length
l <- Ref (Data Length) -> Run (Data Length)
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
unsafeFreezeRef Ref (Data Length)
lr
vec1
next <- Data i -> Manifest a -> Run vec1
body Data i
i (Manifest a -> Run vec1) -> Run (Manifest a) -> Run vec1
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Data Length -> Store a -> Run (Manifest a)
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Data Length -> Store a -> m (Manifest a)
unsafeFreezeStore Data Length
l Store a
st
Store a -> vec1 -> Run ()
forall vec a.
(Manifestable Run vec a, Finite vec, Syntax a) =>
Store a -> vec -> Run ()
setStore Store a
st vec1
next
Ref (Data Length) -> Data Length -> Run ()
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Ref a -> a -> m ()
setRef Ref (Data Length)
lr (Data Length -> Run ()) -> Data Length -> Run ()
forall a b. (a -> b) -> a -> b
$ vec1 -> Data Length
forall a. Finite a => a -> Data Length
length vec1
next
Data Length
l <- Ref (Data Length) -> Run (Data Length)
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
unsafeFreezeRef Ref (Data Length)
lr
Data Length -> Store a -> Run (Manifest a)
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Data Length -> Store a -> m (Manifest a)
unsafeFreezeStore Data Length
l Store a
st
loopStore2
:: ( Integral i
, PrimType i
, Syntax a
, Manifestable2 Run vec1 a
, Finite2 vec1
, Manifestable2 Run vec2 a
, Finite2 vec2
)
=> Store a
-> IxRange (Data i)
-> (Data i -> Manifest2 a -> Run vec1)
-> vec2
-> Run (Manifest2 a)
loopStore2 :: Store a
-> IxRange (Data i)
-> (Data i -> Manifest2 a -> Run vec1)
-> vec2
-> Run (Manifest2 a)
loopStore2 Store a
st IxRange (Data i)
rng Data i -> Manifest2 a -> Run vec1
body vec2
init = do
Store a -> vec2 -> Run ()
forall vec a.
(Manifestable2 Run vec a, Finite2 vec, Syntax a) =>
Store a -> vec -> Run ()
setStore2 Store a
st vec2
init
Ref (Data Length)
rr <- Data Length -> Run (Ref (Data Length))
forall a (m :: * -> *). (Syntax a, MonadComp m) => a -> m (Ref a)
initRef (Data Length -> Run (Ref (Data Length)))
-> Data Length -> Run (Ref (Data Length))
forall a b. (a -> b) -> a -> b
$ vec2 -> Data Length
forall a. Finite2 a => a -> Data Length
numRows vec2
init
Ref (Data Length)
cr <- Data Length -> Run (Ref (Data Length))
forall a (m :: * -> *). (Syntax a, MonadComp m) => a -> m (Ref a)
initRef (Data Length -> Run (Ref (Data Length)))
-> Data Length -> Run (Ref (Data Length))
forall a b. (a -> b) -> a -> b
$ vec2 -> Data Length
forall a. Finite2 a => a -> Data Length
numCols vec2
init
IxRange (Data i) -> (Data i -> Run ()) -> Run ()
forall (m :: * -> *) n.
(MonadComp m, Integral n, PrimType n) =>
IxRange (Data n) -> (Data n -> m ()) -> m ()
for IxRange (Data i)
rng ((Data i -> Run ()) -> Run ()) -> (Data i -> Run ()) -> Run ()
forall a b. (a -> b) -> a -> b
$ \Data i
i -> do
Data Length
r <- Ref (Data Length) -> Run (Data Length)
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
unsafeFreezeRef Ref (Data Length)
rr
Data Length
c <- Ref (Data Length) -> Run (Data Length)
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
unsafeFreezeRef Ref (Data Length)
cr
vec1
next <- Data i -> Manifest2 a -> Run vec1
body Data i
i (Manifest2 a -> Run vec1) -> Run (Manifest2 a) -> Run vec1
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Data Length -> Data Length -> Store a -> Run (Manifest2 a)
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Data Length -> Data Length -> Store a -> m (Manifest2 a)
unsafeFreezeStore2 Data Length
r Data Length
c Store a
st
Store a -> vec1 -> Run ()
forall vec a.
(Manifestable2 Run vec a, Finite2 vec, Syntax a) =>
Store a -> vec -> Run ()
setStore2 Store a
st vec1
next
Ref (Data Length) -> Data Length -> Run ()
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Ref a -> a -> m ()
setRef Ref (Data Length)
rr (Data Length -> Run ()) -> Data Length -> Run ()
forall a b. (a -> b) -> a -> b
$ vec1 -> Data Length
forall a. Finite2 a => a -> Data Length
numRows vec1
next
Ref (Data Length) -> Data Length -> Run ()
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Ref a -> a -> m ()
setRef Ref (Data Length)
cr (Data Length -> Run ()) -> Data Length -> Run ()
forall a b. (a -> b) -> a -> b
$ vec1 -> Data Length
forall a. Finite2 a => a -> Data Length
numCols vec1
next
Data Length
r <- Ref (Data Length) -> Run (Data Length)
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
unsafeFreezeRef Ref (Data Length)
rr
Data Length
c <- Ref (Data Length) -> Run (Data Length)
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
unsafeFreezeRef Ref (Data Length)
cr
Data Length -> Data Length -> Store a -> Run (Manifest2 a)
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Data Length -> Data Length -> Store a -> m (Manifest2 a)
unsafeFreezeStore2 Data Length
r Data Length
c Store a
st