module Data.Repa.Eval.Generic.Seq.Cursored
        (fillCursoredBlock2)
where
import Data.Repa.Eval.Elt
import GHC.Exts


-- | Fill a block in a rank-2 array, sequentially.
--
--   * Blockwise filling can be more cache-efficient than linear filling for
--     rank-2 arrays.
--
--   * Using cursor functions can help to expose inter-element indexing
--     computations to the GHC and LLVM optimisers.
--
--   * Coordinates given are of the filled edges of the block.
--
--   * The block is filled in row major order from top to bottom.
-- 
--   * We need the `Elt` constraint so that we can use its `touch` function
--     to provide an order of evaluation ammenable to the LLVM optimiser.
--     You should compile your Haskell program with @-fllvm -optlo-O3@ to
--     enable LLVM's Global Value Numbering optimisation.
--
fillCursoredBlock2
        :: Elt a
        => (Int# -> a -> IO ())
                -- ^ Update function to write into result buffer.
        -> (Int# -> Int# -> cursor)
                -- ^ Make a cursor to a particular element from an (x, y) index.
        -> (Int# -> Int# -> cursor -> cursor) 
                -- ^ Shift the cursor by an (x, y) offset.
        -> (cursor -> a) -- ^ Function to evaluate an element at the given 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 ()

fillCursoredBlock2 :: forall a cursor.
Elt a =>
(Int# -> a -> IO ())
-> (Int# -> Int# -> cursor)
-> (Int# -> Int# -> cursor -> cursor)
-> (cursor -> a)
-> Int#
-> Int#
-> Int#
-> Int#
-> Int#
-> IO ()
fillCursoredBlock2
        Int# -> a -> IO ()
write
        Int# -> Int# -> cursor
makeCursor Int# -> Int# -> cursor -> cursor
shiftCursor cursor -> a
getElem
        !Int#
imageWidth !Int#
x0 !Int#
y0 !Int#
w0 Int#
h0

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

        fillBlock :: Int# -> IO ()
fillBlock !Int#
y
         | 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# -> IO ()
fillLine4 Int#
x0
                Int# -> IO ()
fillBlock (Int#
y Int# -> Int# -> Int#
+# Int#
1#)

         where  fillLine4 :: Int# -> IO ()
fillLine4 !Int#
x
                 | Int#
1# <- Int#
x Int# -> Int# -> Int#
+# Int#
4# Int# -> Int# -> Int#
>=# Int#
x1 = Int# -> IO ()
fillLine1 Int#
x
                 | Bool
otherwise
                 = do   -- Compute each source cursor based on the previous one
                        -- so that the variable live ranges in the generated
                        -- code are shorter.
                        let srcCur0 :: cursor
srcCur0     = Int# -> Int# -> cursor
makeCursor  Int#
x  Int#
y 
                        let srcCur1 :: cursor
srcCur1     = Int# -> Int# -> cursor -> cursor
shiftCursor Int#
1# Int#
0# cursor
srcCur0
                        let srcCur2 :: cursor
srcCur2     = Int# -> Int# -> cursor -> cursor
shiftCursor Int#
1# Int#
0# cursor
srcCur1
                        let srcCur3 :: cursor
srcCur3     = Int# -> Int# -> cursor -> cursor
shiftCursor Int#
1# Int#
0# cursor
srcCur2

                        -- Get the result value for each cursor.
                        let val0 :: a
val0        = cursor -> a
getElem cursor
srcCur0
                        let val1 :: a
val1        = cursor -> a
getElem cursor
srcCur1
                        let val2 :: a
val2        = cursor -> a
getElem cursor
srcCur2
                        let val3 :: a
val3        = cursor -> a
getElem cursor
srcCur3

                        -- Ensure that we've computed each of the result values
                        -- before we write into the array. If the backend code
                        -- generator can't tell our destination array doesn't
                        -- alias with the source then writing to it can prevent
                        -- the sharing of intermediate computations.
                        a -> IO ()
forall a. Elt a => a -> IO ()
touch a
val0
                        a -> IO ()
forall a. Elt a => a -> IO ()
touch a
val1
                        a -> IO ()
forall a. Elt a => a -> IO ()
touch a
val2
                        a -> IO ()
forall a. Elt a => a -> IO ()
touch a
val3

                        -- Compute row-major index into destination array.
                        let !dstCur0 :: Int#
dstCur0    = Int#
x Int# -> Int# -> Int#
+# (Int#
y Int# -> Int# -> Int#
*# Int#
imageWidth)
                        Int# -> a -> IO ()
write  Int#
dstCur0        a
val0
                        Int# -> a -> IO ()
write (Int#
dstCur0 Int# -> Int# -> Int#
+# Int#
1#) a
val1
                        Int# -> a -> IO ()
write (Int#
dstCur0 Int# -> Int# -> Int#
+# Int#
2#) a
val2
                        Int# -> a -> IO ()
write (Int#
dstCur0 Int# -> Int# -> Int#
+# Int#
3#) a
val3
                        Int# -> IO ()
fillLine4 (Int#
x Int# -> Int# -> Int#
+# Int#
4#)
                {-# INLINE fillLine4 #-}
                
                fillLine1 :: Int# -> IO ()
fillLine1 !Int#
x
                 | 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   let val0 :: a
val0  = cursor -> a
getElem (cursor -> a) -> cursor -> a
forall a b. (a -> b) -> a -> b
$ Int# -> Int# -> cursor
makeCursor Int#
x Int#
y
                        Int# -> a -> IO ()
write (Int#
x Int# -> Int# -> Int#
+# (Int#
y Int# -> Int# -> Int#
*# Int#
imageWidth)) a
val0
                        Int# -> IO ()
fillLine1 (Int#
x Int# -> Int# -> Int#
+# Int#
1#)
                {-# INLINE fillLine1 #-}
        {-# INLINE fillBlock #-}
{-# INLINE [0] fillCursoredBlock2 #-}