module Data.Yarr.Repr.Delayed (
D,
Regular,
UArray(LinearDelayed, ShapeDelayed, ShapeDelayedTarget),
L, SH, delay, delayShaped,
DT,
) where
import Prelude as P
import Control.Monad
import Data.Yarr.Base as B
import Data.Yarr.Eval
import Data.Yarr.Shape
import Data.Yarr.Utils.FixedVector as V
data D
instance Shape sh => Regular D L sh a where
data UArray D L sh a =
LinearDelayed
!sh
(IO ())
(IO ())
(Int -> IO a)
extent (LinearDelayed sh _ _ _) = sh
touchArray (LinearDelayed _ tch _ _) = tch
force (LinearDelayed sh _ iforce _) =
(sh `deepseq` return ()) >> iforce
instance Shape sh => NFData (UArray D L sh a) where
rnf (LinearDelayed sh tch iforce lget) =
sh `deepseq` tch `seq` iforce `seq` lget `seq` ()
instance Shape sh => USource D L sh a where
linearIndex (LinearDelayed _ _ _ lget) = lget
instance (Shape sh, Vector v e) => VecRegular D D L sh v e where
slices (LinearDelayed sh tch iforce lget) =
V.generate
(\i -> LinearDelayed sh tch iforce ((return . (V.! i)) <=< lget))
instance (Shape sh, Vector v e) => UVecSource D D L sh v e
instance Fusion r D L where
fmapM f arr =
LinearDelayed
(extent arr) (touchArray arr) (force arr) (f <=< linearIndex arr)
fzip2M f arr1 arr2 =
let sh = intersect (vl_2 (extent arr1) (extent arr2))
tch = touchArray arr1 >> touchArray arr2
iforce = force arr1 >> force arr2
lget i = do
v1 <- linearIndex arr1 i
v2 <- linearIndex arr2 i
f v1 v2
in LinearDelayed sh tch iforce lget
fzip3M f arr1 arr2 arr3 =
let sh = intersect (vl_3 (extent arr1) (extent arr2) (extent arr3))
tch = touchArray arr1 >> touchArray arr2 >> touchArray arr3
iforce = force arr1 >> force arr2 >> force arr3
lget i = do
v1 <- linearIndex arr1 i
v2 <- linearIndex arr2 i
v3 <- linearIndex arr3 i
f v1 v2 v3
in LinearDelayed sh tch iforce lget
fzipM fun arrs =
let shapes = V.map extent arrs
sh = V.head shapes
tch = V.mapM_ touchArray arrs
iforce = V.mapM_ force arrs
lgets = V.map linearIndex arrs
lget i = do
v <- V.mapM ($ i) lgets
inspect v fun
in if V.all (== sh) shapes
then LinearDelayed sh tch iforce lget
else error ("Yarr! All arrays in linear zip " ++
"must be of the same extent")
instance DefaultFusion D D L
instance Shape sh => Regular D SH sh a where
data UArray D SH sh a =
ShapeDelayed
!sh
(IO ())
(IO ())
(sh -> IO a)
extent (ShapeDelayed sh _ _ _) = sh
touchArray (ShapeDelayed _ tch _ _) = tch
force (ShapeDelayed sh _ iforce _) = (sh `deepseq` return ()) >> iforce
instance Shape sh => NFData (UArray D SH sh a) where
rnf (ShapeDelayed sh tch iforce get) =
sh `deepseq` tch `seq` iforce `seq` get `seq` ()
instance Shape sh => USource D SH sh a where
index (ShapeDelayed _ _ _ get) = get
instance (Shape sh, Vector v e) => VecRegular D D SH sh v e where
slices (ShapeDelayed sh tch iforce get) =
V.generate
(\i -> ShapeDelayed sh tch iforce ((return . (V.! i)) <=< get))
instance (Shape sh, Vector v e) => UVecSource D D SH sh v e
instance Fusion r D SH where
fmapM f arr =
ShapeDelayed
(extent arr) (touchArray arr) (force arr) (f <=< index arr)
fzip2M f arr1 arr2 =
let sh = intersect (vl_2 (extent arr1) (extent arr2))
tch = touchArray arr1 >> touchArray arr2
iforce = force arr1 >> force arr2
get sh = do
v1 <- index arr1 sh
v2 <- index arr2 sh
f v1 v2
in ShapeDelayed sh tch iforce get
fzip3M f arr1 arr2 arr3 =
let sh = intersect (vl_3 (extent arr1) (extent arr2) (extent arr3))
tch = touchArray arr1 >> touchArray arr2 >> touchArray arr3
iforce = force arr1 >> force arr2 >> force arr3
get sh = do
v1 <- index arr1 sh
v2 <- index arr2 sh
v3 <- index arr3 sh
f v1 v2 v3
in ShapeDelayed sh tch iforce get
fzipM fun arrs =
let shapes = V.map extent arrs
sh = intersect shapes
tch = V.mapM_ touchArray arrs
iforce = V.mapM_ force arrs
gets = V.map index arrs
get sh = do
v <- V.mapM ($ sh) gets
inspect v fun
in ShapeDelayed sh tch iforce get
instance DefaultFusion D D SH
delay :: (USource r l sh a, USource D l sh a, Fusion r D l)
=> UArray r l sh a -> UArray D l sh a
delay = B.fmap id
delayShaped :: USource r l sh a => UArray r l sh a -> UArray D SH sh a
delayShaped arr =
ShapeDelayed (extent arr) (touchArray arr) (force arr) (index arr)
data DT
instance Shape sh => Regular DT SH sh a where
data UArray DT SH sh a =
ShapeDelayedTarget
!sh
(IO ())
(IO ())
(sh -> a -> IO ())
extent (ShapeDelayedTarget sh _ _ _) = sh
touchArray (ShapeDelayedTarget _ tch _ _) = tch
force (ShapeDelayedTarget sh _ iforce _) =
(sh `deepseq` return ()) >> iforce
instance Shape sh => NFData (UArray DT SH sh a) where
rnf (ShapeDelayedTarget sh tch iforce wr) =
sh `deepseq` tch `seq` iforce `seq` wr `seq` ()
instance Shape sh => UTarget DT SH sh a where
write (ShapeDelayedTarget _ _ _ wr) = wr