module Data.Repa.Eval.Generic.Seq.Chunked
        ( fillLinear
        , fillBlock2)
where
import GHC.Exts


-------------------------------------------------------------------------------
-- | Fill something sequentially.
-- 
--   * The array is filled linearly from start to finish.  
-- 
fillLinear
        :: (Int# -> a -> IO ())  -- ^ Update function to write into result buffer.
        -> (Int# -> a)           -- ^ Function to get the value at a given index.
        -> Int#                  -- ^ Number of elements to fill.
        -> IO ()

fillLinear :: forall a. (Int# -> a -> IO ()) -> (Int# -> a) -> Int# -> IO ()
fillLinear Int# -> a -> IO ()
write Int# -> a
getElem Int#
len
 = Int# -> IO ()
fill Int#
0#
 where  fill :: Int# -> IO ()
fill !Int#
ix
         | Int#
1# <- Int#
ix Int# -> Int# -> Int#
>=# Int#
len   = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         | Bool
otherwise
         = do   Int# -> a -> IO ()
write Int#
ix (Int# -> a
getElem Int#
ix)
                Int# -> IO ()
fill (Int#
ix Int# -> Int# -> Int#
+# Int#
1#)
{-# INLINE [0] fillLinear #-}


-------------------------------------------------------------------------------
-- | Fill a block in a rank-2 array, sequentially.
--
--   * Blockwise filling can be more cache-efficient than linear filling for
--     rank-2 arrays.
--
--   * The block is filled in row major order from top to bottom.
--
fillBlock2
        :: (Int# -> a -> IO ()) -- ^ Update function to write into result buffer.
        -> (Int# -> Int# -> a)  -- ^ Function to get the value at an (x, y) index.
        -> Int#                 -- ^ Width of the whole array.
        -> Int#                 -- ^ x0 lower left corner of block to fill.
        -> Int#                 -- ^ y0
        -> Int#                 -- ^ w0 width of block to fill
        -> Int#                 -- ^ h0 height of block to fill
        -> IO ()

fillBlock2 :: forall a.
(Int# -> a -> IO ())
-> (Int# -> Int# -> a)
-> Int#
-> Int#
-> Int#
-> Int#
-> Int#
-> IO ()
fillBlock2
        Int# -> a -> IO ()
write Int# -> Int# -> a
getElem
        !Int#
imageWidth !Int#
x0 !Int#
y0 !Int#
w0 Int#
h0

 = do   Int# -> Int# -> IO ()
fillBlock Int#
y0 Int#
ix0
 where  !x1 :: Int#
x1     = Int#
x0 Int# -> Int# -> Int#
+# Int#
w0
        !y1 :: Int#
y1     = Int#
y0 Int# -> Int# -> Int#
+# Int#
h0
        !ix0 :: Int#
ix0    = Int#
x0 Int# -> Int# -> Int#
+# (Int#
y0 Int# -> Int# -> Int#
*# Int#
imageWidth)

        {-# INLINE fillBlock #-}
        fillBlock :: Int# -> Int# -> IO ()
fillBlock !Int#
y !Int#
ix
         | Int#
1# <- Int#
y Int# -> Int# -> Int#
>=# Int#
y1     = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         | Bool
otherwise
         = do   Int# -> Int# -> IO ()
fillLine1 Int#
x0 Int#
ix
                Int# -> Int# -> IO ()
fillBlock (Int#
y Int# -> Int# -> Int#
+# Int#
1#) (Int#
ix Int# -> Int# -> Int#
+# Int#
imageWidth)

         where  {-# INLINE fillLine1 #-}
                fillLine1 :: Int# -> Int# -> IO ()
fillLine1 !Int#
x !Int#
ix'
                 | Int#
1# <- Int#
x Int# -> Int# -> Int#
>=# Int#
x1             = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                 | Bool
otherwise
                 = do   Int# -> a -> IO ()
write Int#
ix' (Int# -> Int# -> a
getElem Int#
x Int#
y)
                        Int# -> Int# -> IO ()
fillLine1 (Int#
x Int# -> Int# -> Int#
+# Int#
1#) (Int#
ix' Int# -> Int# -> Int#
+# Int#
1#)

{-# INLINE [0] fillBlock2 #-}