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
{ activeBuf :: Arr a
, freeBuf :: Arr a
}
newStore :: (Syntax a, MonadComp m) => Data Length -> m (Store a)
newStore l = Store <$> newNamedArr "store" l <*> newNamedArr "store" l
unsafeInplaceStore :: (Syntax a, MonadComp m) => Data Length -> m (Store a)
unsafeInplaceStore l = do
arr <- newNamedArr "store" l
return $ Store arr arr
unsafeFreezeStore :: (Syntax a, MonadComp m) =>
Data Length -> Store a -> m (Manifest a)
unsafeFreezeStore l = unsafeFreezeSlice l . activeBuf
unsafeFreezeStore2 :: (Syntax a, MonadComp m)
=> Data Length
-> Data Length
-> Store a
-> m (Manifest2 a)
unsafeFreezeStore2 r c Store {..} =
nest r c <$> unsafeFreezeSlice (r*c) activeBuf
swapStore :: Syntax a => Store a -> Run ()
swapStore Store {..} = unsafeSwapArr activeBuf freeBuf
setStore :: (Manifestable Run vec a, Finite vec, Syntax a) =>
Store a -> vec -> Run ()
setStore st@Store {..} vec = case viewManifest vec of
Just iarr
| unsafeEqArrIArr activeBuf iarr ->
iff (iarrOffset iarr == arrOffset activeBuf)
(return ())
saveAndSwap
_ -> saveAndSwap
where
saveAndSwap = manifestStore freeBuf vec >> swapStore st
setStore2 :: (Manifestable2 Run vec a, Finite2 vec, Syntax a) =>
Store a -> vec -> Run ()
setStore2 st@Store {..} vec = case viewManifest2 vec of
Just arr
| let iarr = unnest arr
, unsafeEqArrIArr activeBuf iarr ->
iff (iarrOffset iarr == arrOffset activeBuf)
(return ())
saveAndSwap
_ -> saveAndSwap
where
saveAndSwap = manifestStore2 freeBuf vec >> swapStore st
store :: (Manifestable Run vec a, Finite vec, Syntax a) =>
Store a -> vec -> Run (Manifest a)
store st vec = setStore st vec >> unsafeFreezeStore (length vec) st
store2 :: (Manifestable2 Run vec a, Finite2 vec, Syntax a) =>
Store a -> vec -> Run (Manifest2 a)
store2 st vec = setStore2 st vec >> unsafeFreezeStore2 r c st
where
(r,c) = extent2 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 st rng body init = do
setStore st init
lr <- initRef $ length init
for rng $ \i -> do
l <- unsafeFreezeRef lr
next <- body i =<< unsafeFreezeStore l st
setStore st next
setRef lr $ length next
l <- unsafeFreezeRef lr
unsafeFreezeStore l 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 st rng body init = do
setStore2 st init
rr <- initRef $ numRows init
cr <- initRef $ numCols init
for rng $ \i -> do
r <- unsafeFreezeRef rr
c <- unsafeFreezeRef cr
next <- body i =<< unsafeFreezeStore2 r c st
setStore2 st next
setRef rr $ numRows next
setRef cr $ numCols next
r <- unsafeFreezeRef rr
c <- unsafeFreezeRef cr
unsafeFreezeStore2 r c st