{-# LANGUAGE CPP, MagicHash #-}
--   This is specialised for stencils up to 7x7.
--   Due to limitations in the GHC optimiser, using larger stencils doesn't
--   work, and will yield `error` at runtime. We can probably increase the
--   limit if required -- just ask.
--
--   The focus of the stencil is in the center of the 7x7 tile, which has
--   coordinates (0, 0). All coefficients in the stencil must fit in the tile,
--   so they can be given X,Y coordinates up to +/- 3 positions.
--   The stencil can be any shape, and need not be symmetric -- provided it
--   fits in the 7x7 tile.
--
module Data.Array.Repa.Stencil.Dim2
        ( -- * Stencil creation
          makeStencil2,
#ifndef REPA_NO_TH
          stencil2,
#endif
          -- * Stencil operators
          PC5, mapStencil2, forStencil2)
where
import Data.Array.Repa.Base
import Data.Array.Repa.Index
import Data.Array.Repa.Shape
import Data.Array.Repa.Repr.Delayed
import Data.Array.Repa.Repr.Cursored
import Data.Array.Repa.Repr.Partitioned
import Data.Array.Repa.Repr.HintSmall
import Data.Array.Repa.Repr.Undefined
import Data.Array.Repa.Stencil.Base
#ifndef REPA_NO_TH
import Data.Array.Repa.Stencil.Template
#endif
import Data.Array.Repa.Stencil.Partition
import GHC.Exts

-- | A index into the flat array.
--   Should be abstract outside the stencil modules.
data Cursor
        = Cursor Int

type PC5 = P C (P (S D) (P (S D) (P (S D) (P (S D) X))))


-- Wrappers -------------------------------------------------------------------
-- | Like `mapStencil2` but with the parameters flipped.
forStencil2
        :: Source r a
        => Boundary a
        -> Array  r DIM2 a
        -> Stencil  DIM2 a
        -> Array PC5 DIM2 a

{-# INLINE forStencil2 #-}
forStencil2 :: Boundary a -> Array r DIM2 a -> Stencil DIM2 a -> Array PC5 DIM2 a
forStencil2 Boundary a
boundary Array r DIM2 a
arr Stencil DIM2 a
stencil
        = Boundary a -> Stencil DIM2 a -> Array r DIM2 a -> Array PC5 DIM2 a
forall r a.
Source r a =>
Boundary a -> Stencil DIM2 a -> Array r DIM2 a -> Array PC5 DIM2 a
mapStencil2 Boundary a
boundary Stencil DIM2 a
stencil Array r DIM2 a
arr


-------------------------------------------------------------------------------
-- | Apply a stencil to every element of a 2D array.
mapStencil2
        :: Source r a
        => Boundary a           -- ^ How to handle the boundary of the array.
        -> Stencil DIM2 a       -- ^ Stencil to apply.
        -> Array r DIM2 a               -- ^ Array to apply stencil to.
        -> Array PC5 DIM2 a

{-# INLINE mapStencil2 #-}
mapStencil2 :: Boundary a -> Stencil DIM2 a -> Array r DIM2 a -> Array PC5 DIM2 a
mapStencil2 Boundary a
boundary stencil :: Stencil DIM2 a
stencil@(StencilStatic DIM2
sExtent a
_zero DIM2 -> a -> a -> a
_load) Array r DIM2 a
arr
 = let  sh :: DIM2
sh                       = Array r DIM2 a -> DIM2
forall r e sh. (Source r e, Shape sh) => Array r sh e -> sh
extent Array r DIM2 a
arr
        (DIM0
_ :. Int
aHeight :. Int
aWidth) = DIM2
sh
        (DIM0
_ :. Int
sHeight :. Int
sWidth) = DIM2
sExtent

        sHeight2 :: Int
sHeight2        = Int
sHeight Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
        sWidth2 :: Int
sWidth2         = Int
sWidth  Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2

        -- Partition the array into the internal and border regions.
        ![ Region    Int
inX    Int
inY    Int
inW    Int
inH
         , Region  Int
westX  Int
westY  Int
westW  Int
westH
         , Region  Int
eastX  Int
eastY  Int
eastW  Int
eastH
         , Region Int
northX Int
northY Int
northW Int
northH 
         , Region Int
southX Int
southY Int
southW Int
southH ] 
           = Size -> Size -> Offset -> [Region]
partitionForStencil 
                (Int -> Int -> Size
Size   Int
aWidth   Int
aHeight) 
                (Int -> Int -> Size
Size   Int
sWidth   Int
sHeight)
                (Int -> Int -> Offset
Offset Int
sWidth2  Int
sHeight2)

        {-# INLINE inInternal #-}
        inInternal :: DIM2 -> Bool
inInternal (DIM0
Z :. Int
y :. Int
x)
                =  Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
inX Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Int
inX Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
inW)
                Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
inY Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Int
inY Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
inH)

        {-# INLINE inBorder #-}
        inBorder :: DIM2 -> Bool
inBorder       = Bool -> Bool
not (Bool -> Bool) -> (DIM2 -> Bool) -> DIM2 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DIM2 -> Bool
inInternal

        -- Cursor functions ----------------
        {-# INLINE makec #-}
        makec :: DIM2 -> Cursor
makec (DIM0
Z :. Int
y :. Int
x)
         = Int -> Cursor
Cursor (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
aWidth)

        {-# INLINE shiftc #-}
        shiftc :: DIM2 -> Cursor -> Cursor
shiftc DIM2
ix (Cursor Int
off)
         = Int -> Cursor
Cursor
         (Int -> Cursor) -> Int -> Cursor
forall a b. (a -> b) -> a -> b
$ case DIM2
ix of
                DIM0
Z :. Int
y :. Int
x     -> Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
aWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x

        {-# INLINE arrInternal #-}
        arrInternal :: Array C DIM2 a
arrInternal     = DIM2
-> (DIM2 -> Cursor)
-> (DIM2 -> Cursor -> Cursor)
-> (Cursor -> a)
-> Array C DIM2 a
forall sh cursor e.
sh
-> (sh -> cursor)
-> (sh -> cursor -> cursor)
-> (cursor -> e)
-> Array C sh e
makeCursored (Array r DIM2 a -> DIM2
forall r e sh. (Source r e, Shape sh) => Array r sh e -> sh
extent Array r DIM2 a
arr) DIM2 -> Cursor
makec DIM2 -> Cursor -> Cursor
shiftc Cursor -> a
getInner' 

        {-# INLINE getInner' #-}
        getInner' :: Cursor -> a
getInner' Cursor
cur   = (DIM2 -> Cursor -> Cursor)
-> Stencil DIM2 a -> Array r DIM2 a -> Cursor -> a
forall r a.
Source r a =>
(DIM2 -> Cursor -> Cursor)
-> Stencil DIM2 a -> Array r DIM2 a -> Cursor -> a
unsafeAppStencilCursor2 DIM2 -> Cursor -> Cursor
shiftc Stencil DIM2 a
stencil Array r DIM2 a
arr Cursor
cur

        {-# INLINE arrBorder #-}
        arrBorder :: Array (S D) DIM2 a
arrBorder       = Array D DIM2 a -> Array (S D) DIM2 a
forall r1 sh a. Array r1 sh a -> Array (S r1) sh a
ASmall (DIM2 -> (DIM2 -> a) -> Array D DIM2 a
forall sh a. sh -> (sh -> a) -> Array D sh a
fromFunction (Array r DIM2 a -> DIM2
forall r e sh. (Source r e, Shape sh) => Array r sh e -> sh
extent Array r DIM2 a
arr) DIM2 -> a
getBorder')

        {-# INLINE getBorder' #-}
        getBorder' :: DIM2 -> a
getBorder' DIM2
ix
         = case Boundary a
boundary of
                BoundFixed a
c    -> a
c
                BoundConst a
c    -> (DIM2 -> DIM2 -> DIM2)
-> Stencil DIM2 a -> a -> Array r DIM2 a -> DIM2 -> a
forall r a.
Source r a =>
(DIM2 -> DIM2 -> DIM2)
-> Stencil DIM2 a -> a -> Array r DIM2 a -> DIM2 -> a
unsafeAppStencilCursor2_const DIM2 -> DIM2 -> DIM2
forall sh. Shape sh => sh -> sh -> sh
addDim Stencil DIM2 a
stencil a
c Array r DIM2 a
arr DIM2
ix
                Boundary a
BoundClamp      -> (DIM2 -> DIM2 -> DIM2)
-> Stencil DIM2 a -> Array r DIM2 a -> DIM2 -> a
forall r a.
Source r a =>
(DIM2 -> DIM2 -> DIM2)
-> Stencil DIM2 a -> Array r DIM2 a -> DIM2 -> a
unsafeAppStencilCursor2_clamp DIM2 -> DIM2 -> DIM2
forall sh. Shape sh => sh -> sh -> sh
addDim Stencil DIM2 a
stencil Array r DIM2 a
arr DIM2
ix
   in
    --  internal region
        DIM2
-> Range DIM2
-> Array C DIM2 a
-> Array (P (S D) (P (S D) (P (S D) (P (S D) X)))) DIM2 a
-> Array PC5 DIM2 a
forall r1 r2 sh e.
sh
-> Range sh
-> Array r1 sh e
-> Array r2 sh e
-> Array (P r1 r2) sh e
APart DIM2
sh (DIM2 -> DIM2 -> (DIM2 -> Bool) -> Range DIM2
forall sh. sh -> sh -> (sh -> Bool) -> Range sh
Range (DIM0
Z DIM0 -> Int -> DIM0 :. Int
forall tail head. tail -> head -> tail :. head
:.    Int
inY (DIM0 :. Int) -> Int -> DIM2
forall tail head. tail -> head -> tail :. head
:.    Int
inX) (DIM0
Z DIM0 -> Int -> DIM0 :. Int
forall tail head. tail -> head -> tail :. head
:.    Int
inH (DIM0 :. Int) -> Int -> DIM2
forall tail head. tail -> head -> tail :. head
:.    Int
inW) DIM2 -> Bool
inInternal) Array C DIM2 a
arrInternal

    --  border regions
    (Array (P (S D) (P (S D) (P (S D) (P (S D) X)))) DIM2 a
 -> Array PC5 DIM2 a)
-> Array (P (S D) (P (S D) (P (S D) (P (S D) X)))) DIM2 a
-> Array PC5 DIM2 a
forall a b. (a -> b) -> a -> b
$   DIM2
-> Range DIM2
-> Array (S D) DIM2 a
-> Array (P (S D) (P (S D) (P (S D) X))) DIM2 a
-> Array (P (S D) (P (S D) (P (S D) (P (S D) X)))) DIM2 a
forall r1 r2 sh e.
sh
-> Range sh
-> Array r1 sh e
-> Array r2 sh e
-> Array (P r1 r2) sh e
APart DIM2
sh (DIM2 -> DIM2 -> (DIM2 -> Bool) -> Range DIM2
forall sh. sh -> sh -> (sh -> Bool) -> Range sh
Range (DIM0
Z DIM0 -> Int -> DIM0 :. Int
forall tail head. tail -> head -> tail :. head
:.  Int
westY (DIM0 :. Int) -> Int -> DIM2
forall tail head. tail -> head -> tail :. head
:.  Int
westX) (DIM0
Z DIM0 -> Int -> DIM0 :. Int
forall tail head. tail -> head -> tail :. head
:.  Int
westH (DIM0 :. Int) -> Int -> DIM2
forall tail head. tail -> head -> tail :. head
:.  Int
westW) DIM2 -> Bool
inBorder)   Array (S D) DIM2 a
arrBorder
    (Array (P (S D) (P (S D) (P (S D) X))) DIM2 a
 -> Array (P (S D) (P (S D) (P (S D) (P (S D) X)))) DIM2 a)
-> Array (P (S D) (P (S D) (P (S D) X))) DIM2 a
-> Array (P (S D) (P (S D) (P (S D) (P (S D) X)))) DIM2 a
forall a b. (a -> b) -> a -> b
$   DIM2
-> Range DIM2
-> Array (S D) DIM2 a
-> Array (P (S D) (P (S D) X)) DIM2 a
-> Array (P (S D) (P (S D) (P (S D) X))) DIM2 a
forall r1 r2 sh e.
sh
-> Range sh
-> Array r1 sh e
-> Array r2 sh e
-> Array (P r1 r2) sh e
APart DIM2
sh (DIM2 -> DIM2 -> (DIM2 -> Bool) -> Range DIM2
forall sh. sh -> sh -> (sh -> Bool) -> Range sh
Range (DIM0
Z DIM0 -> Int -> DIM0 :. Int
forall tail head. tail -> head -> tail :. head
:.  Int
eastY (DIM0 :. Int) -> Int -> DIM2
forall tail head. tail -> head -> tail :. head
:.  Int
eastX) (DIM0
Z DIM0 -> Int -> DIM0 :. Int
forall tail head. tail -> head -> tail :. head
:.  Int
eastH (DIM0 :. Int) -> Int -> DIM2
forall tail head. tail -> head -> tail :. head
:.  Int
eastW) DIM2 -> Bool
inBorder)   Array (S D) DIM2 a
arrBorder
    (Array (P (S D) (P (S D) X)) DIM2 a
 -> Array (P (S D) (P (S D) (P (S D) X))) DIM2 a)
-> Array (P (S D) (P (S D) X)) DIM2 a
-> Array (P (S D) (P (S D) (P (S D) X))) DIM2 a
forall a b. (a -> b) -> a -> b
$   DIM2
-> Range DIM2
-> Array (S D) DIM2 a
-> Array (P (S D) X) DIM2 a
-> Array (P (S D) (P (S D) X)) DIM2 a
forall r1 r2 sh e.
sh
-> Range sh
-> Array r1 sh e
-> Array r2 sh e
-> Array (P r1 r2) sh e
APart DIM2
sh (DIM2 -> DIM2 -> (DIM2 -> Bool) -> Range DIM2
forall sh. sh -> sh -> (sh -> Bool) -> Range sh
Range (DIM0
Z DIM0 -> Int -> DIM0 :. Int
forall tail head. tail -> head -> tail :. head
:. Int
northY (DIM0 :. Int) -> Int -> DIM2
forall tail head. tail -> head -> tail :. head
:. Int
northX) (DIM0
Z DIM0 -> Int -> DIM0 :. Int
forall tail head. tail -> head -> tail :. head
:. Int
northH (DIM0 :. Int) -> Int -> DIM2
forall tail head. tail -> head -> tail :. head
:. Int
northW) DIM2 -> Bool
inBorder)   Array (S D) DIM2 a
arrBorder
    (Array (P (S D) X) DIM2 a -> Array (P (S D) (P (S D) X)) DIM2 a)
-> Array (P (S D) X) DIM2 a -> Array (P (S D) (P (S D) X)) DIM2 a
forall a b. (a -> b) -> a -> b
$   DIM2
-> Range DIM2
-> Array (S D) DIM2 a
-> Array X DIM2 a
-> Array (P (S D) X) DIM2 a
forall r1 r2 sh e.
sh
-> Range sh
-> Array r1 sh e
-> Array r2 sh e
-> Array (P r1 r2) sh e
APart DIM2
sh (DIM2 -> DIM2 -> (DIM2 -> Bool) -> Range DIM2
forall sh. sh -> sh -> (sh -> Bool) -> Range sh
Range (DIM0
Z DIM0 -> Int -> DIM0 :. Int
forall tail head. tail -> head -> tail :. head
:. Int
southY (DIM0 :. Int) -> Int -> DIM2
forall tail head. tail -> head -> tail :. head
:. Int
southX) (DIM0
Z DIM0 -> Int -> DIM0 :. Int
forall tail head. tail -> head -> tail :. head
:. Int
southH (DIM0 :. Int) -> Int -> DIM2
forall tail head. tail -> head -> tail :. head
:. Int
southW) DIM2 -> Bool
inBorder)   Array (S D) DIM2 a
arrBorder
    (Array X DIM2 a -> Array (P (S D) X) DIM2 a)
-> Array X DIM2 a -> Array (P (S D) X) DIM2 a
forall a b. (a -> b) -> a -> b
$   DIM2 -> Array X DIM2 a
forall sh e. sh -> Array X sh e
AUndefined DIM2
sh


unsafeAppStencilCursor2
        :: Source r a
        => (DIM2 -> Cursor -> Cursor)
        -> Stencil DIM2 a
        -> Array r DIM2 a
        -> Cursor
        -> a

{-# INLINE unsafeAppStencilCursor2 #-}
unsafeAppStencilCursor2 :: (DIM2 -> Cursor -> Cursor)
-> Stencil DIM2 a -> Array r DIM2 a -> Cursor -> a
unsafeAppStencilCursor2 DIM2 -> Cursor -> Cursor
shift
        (StencilStatic DIM2
sExtent a
zero DIM2 -> a -> a -> a
loads)
        Array r DIM2 a
arr Cursor
cur0

        | DIM0
_ :. Int
sHeight :. Int
sWidth        <- DIM2
sExtent
        , Int
sHeight Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
7, Int
sWidth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
7
        = let
                -- Get data from the manifest array.
                {-# INLINE getData #-}
                getData :: Cursor -> a
getData (Cursor Int
cur) = Array r DIM2 a
arr Array r DIM2 a -> Int -> a
forall r e sh. (Source r e, Shape sh) => Array r sh e -> Int -> e
`unsafeLinearIndex` Int
cur

                -- Build a function to pass data from the array to our stencil.
                {-# INLINE oload #-}
                oload :: Int -> Int -> a -> a
oload Int
oy Int
ox
                 = let  !cur' :: Cursor
cur' = DIM2 -> Cursor -> Cursor
shift (DIM0
Z DIM0 -> Int -> DIM0 :. Int
forall tail head. tail -> head -> tail :. head
:. Int
oy (DIM0 :. Int) -> Int -> DIM2
forall tail head. tail -> head -> tail :. head
:. Int
ox) Cursor
cur0
                   in   DIM2 -> a -> a -> a
loads (DIM0
Z DIM0 -> Int -> DIM0 :. Int
forall tail head. tail -> head -> tail :. head
:. Int
oy (DIM0 :. Int) -> Int -> DIM2
forall tail head. tail -> head -> tail :. head
:. Int
ox) (Cursor -> a
getData Cursor
cur')

           in   (Int -> Int -> a -> a) -> a -> a
forall a. (Int -> Int -> a -> a) -> a -> a
template7x7 Int -> Int -> a -> a
oload a
zero

        | Bool
otherwise
        = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines 
                [ [Char]
"mapStencil2: Your stencil is too big for this method."
                , [Char]
" It must fit within a 7x7 tile to be compiled statically." ]


-- | Like above, but treat elements outside the array has having a constant value.
unsafeAppStencilCursor2_const
        :: forall r a
        .  Source r a
        => (DIM2 -> DIM2 -> DIM2)
        -> Stencil DIM2 a
        -> a
        -> Array r DIM2 a
        -> DIM2
        -> a

{-# INLINE unsafeAppStencilCursor2_const #-}
unsafeAppStencilCursor2_const :: (DIM2 -> DIM2 -> DIM2)
-> Stencil DIM2 a -> a -> Array r DIM2 a -> DIM2 -> a
unsafeAppStencilCursor2_const DIM2 -> DIM2 -> DIM2
shift
           (StencilStatic DIM2
sExtent a
zero DIM2 -> a -> a -> a
loads)
           a
fixed Array r DIM2 a
arr DIM2
cur

        | DIM0
_ :. Int
sHeight      :. Int
sWidth       <- DIM2
sExtent
        , DIM0
_ :. (I# Int#
aHeight) :. (I# Int#
aWidth)  <- Array r DIM2 a -> DIM2
forall r e sh. (Source r e, Shape sh) => Array r sh e -> sh
extent Array r DIM2 a
arr
        , Int
sHeight Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
7, Int
sWidth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
7
        = let
                -- Get data from the manifest array.
                {-# INLINE getData #-}
                getData :: DIM2 -> a
                getData :: DIM2 -> a
getData (DIM0
Z :. (I# Int#
y) :. (I# Int#
x))
                 = Int# -> Int# -> a
getData' Int#
x Int#
y

                {-# NOINLINE getData' #-}
                getData' :: Int# -> Int# -> a
                getData' :: Int# -> Int# -> a
getData' !Int#
x !Int#
y
                 | Int#
1# <-   (Int#
x Int# -> Int# -> Int#
<# Int#
0#) Int# -> Int# -> Int#
`orI#` (Int#
x Int# -> Int# -> Int#
>=# Int#
aWidth)
                    Int# -> Int# -> Int#
`orI#` (Int#
y Int# -> Int# -> Int#
<# Int#
0#) Int# -> Int# -> Int#
`orI#` (Int#
y Int# -> Int# -> Int#
>=# Int#
aHeight)
                 = a
fixed

                 | Bool
otherwise
                 = Array r DIM2 a
arr Array r DIM2 a -> DIM2 -> a
forall r e sh. (Source r e, Shape sh) => Array r sh e -> sh -> e
`unsafeIndex` (DIM0
Z DIM0 -> Int -> DIM0 :. Int
forall tail head. tail -> head -> tail :. head
:. (Int# -> Int
I# Int#
y) (DIM0 :. Int) -> Int -> DIM2
forall tail head. tail -> head -> tail :. head
:.  (Int# -> Int
I# Int#
x))

                -- Build a function to pass data from the array to our stencil.
                {-# INLINE oload #-}
                oload :: Int -> Int -> a -> a
oload Int
oy Int
ox
                 = let  !cur' :: DIM2
cur' = DIM2 -> DIM2 -> DIM2
shift (DIM0
Z DIM0 -> Int -> DIM0 :. Int
forall tail head. tail -> head -> tail :. head
:. Int
oy (DIM0 :. Int) -> Int -> DIM2
forall tail head. tail -> head -> tail :. head
:. Int
ox) DIM2
cur
                   in   DIM2 -> a -> a -> a
loads (DIM0
Z DIM0 -> Int -> DIM0 :. Int
forall tail head. tail -> head -> tail :. head
:. Int
oy (DIM0 :. Int) -> Int -> DIM2
forall tail head. tail -> head -> tail :. head
:. Int
ox) (DIM2 -> a
getData DIM2
cur')

           in   (Int -> Int -> a -> a) -> a -> a
forall a. (Int -> Int -> a -> a) -> a -> a
template7x7 Int -> Int -> a -> a
oload a
zero

        | Bool
otherwise
        = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines 
                [ [Char]
"mapStencil2: Your stencil is too big for this method."
                , [Char]
" It must fit within a 7x7 tile to be compiled statically." ]


-- | Like above, but clamp out of bounds array values to the closest real value.
unsafeAppStencilCursor2_clamp
        :: forall r a
        .  Source r a
        => (DIM2 -> DIM2 -> DIM2)
        -> Stencil DIM2 a
        -> Array r DIM2 a
        -> DIM2
        -> a

{-# INLINE unsafeAppStencilCursor2_clamp #-}
unsafeAppStencilCursor2_clamp :: (DIM2 -> DIM2 -> DIM2)
-> Stencil DIM2 a -> Array r DIM2 a -> DIM2 -> a
unsafeAppStencilCursor2_clamp DIM2 -> DIM2 -> DIM2
shift
           (StencilStatic DIM2
sExtent a
zero DIM2 -> a -> a -> a
loads)
           Array r DIM2 a
arr DIM2
cur

        | DIM0
_ :. Int
sHeight      :. Int
sWidth       <- DIM2
sExtent
        , DIM0
_ :. (I# Int#
aHeight) :. (I# Int#
aWidth)  <- Array r DIM2 a -> DIM2
forall r e sh. (Source r e, Shape sh) => Array r sh e -> sh
extent Array r DIM2 a
arr
        , Int
sHeight Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
7, Int
sWidth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
7
        = let
                -- Get data from the manifest array.
                {-# INLINE getData #-}
                getData :: DIM2 -> a
                getData :: DIM2 -> a
getData (DIM0
Z :. (I# Int#
y) :. (I# Int#
x))
                 = Int# -> Int# -> a
wrapLoadX Int#
x Int#
y

                {-# NOINLINE wrapLoadX #-}
                wrapLoadX :: Int# -> Int# -> a
                wrapLoadX :: Int# -> Int# -> a
wrapLoadX !Int#
x !Int#
y
                 | Int#
1# <- Int#
x Int# -> Int# -> Int#
<# Int#
0#        = Int# -> Int# -> a
wrapLoadY Int#
0#             Int#
y
                 | Int#
1# <- Int#
x Int# -> Int# -> Int#
>=# Int#
aWidth   = Int# -> Int# -> a
wrapLoadY (Int#
aWidth Int# -> Int# -> Int#
-# Int#
1#) Int#
y
                 | Bool
otherwise    = Int# -> Int# -> a
wrapLoadY Int#
x Int#
y

                {-# NOINLINE wrapLoadY #-}
                wrapLoadY :: Int# -> Int# -> a
                wrapLoadY :: Int# -> Int# -> a
wrapLoadY !Int#
x !Int#
y
                 | Int#
1# <- Int#
y Int# -> Int# -> Int#
<#  Int#
0#       = Int# -> Int# -> a
loadXY Int#
x Int#
0#
                 | Int#
1# <- Int#
y Int# -> Int# -> Int#
>=# Int#
aHeight  = Int# -> Int# -> a
loadXY Int#
x (Int#
aHeight Int# -> Int# -> Int#
-# Int#
1#)
                 | Bool
otherwise     = Int# -> Int# -> a
loadXY Int#
x Int#
y

                {-# INLINE loadXY #-}
                loadXY :: Int# -> Int# -> a
                loadXY :: Int# -> Int# -> a
loadXY !Int#
x !Int#
y
                 = Array r DIM2 a
arr Array r DIM2 a -> DIM2 -> a
forall r e sh. (Source r e, Shape sh) => Array r sh e -> sh -> e
`unsafeIndex` (DIM0
Z DIM0 -> Int -> DIM0 :. Int
forall tail head. tail -> head -> tail :. head
:. (Int# -> Int
I# Int#
y) (DIM0 :. Int) -> Int -> DIM2
forall tail head. tail -> head -> tail :. head
:.  (Int# -> Int
I# Int#
x))

                -- Build a function to pass data from the array to our stencil.
                {-# INLINE oload #-}
                oload :: Int -> Int -> a -> a
oload Int
oy Int
ox
                 = let  !cur' :: DIM2
cur' = DIM2 -> DIM2 -> DIM2
shift (DIM0
Z DIM0 -> Int -> DIM0 :. Int
forall tail head. tail -> head -> tail :. head
:. Int
oy (DIM0 :. Int) -> Int -> DIM2
forall tail head. tail -> head -> tail :. head
:. Int
ox) DIM2
cur
                   in   DIM2 -> a -> a -> a
loads (DIM0
Z DIM0 -> Int -> DIM0 :. Int
forall tail head. tail -> head -> tail :. head
:. Int
oy (DIM0 :. Int) -> Int -> DIM2
forall tail head. tail -> head -> tail :. head
:. Int
ox) (DIM2 -> a
getData DIM2
cur')

           in   (Int -> Int -> a -> a) -> a -> a
forall a. (Int -> Int -> a -> a) -> a -> a
template7x7 Int -> Int -> a -> a
oload a
zero

        | Bool
otherwise
        = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines 
                [ [Char]
"mapStencil2: Your stencil is too big for this method."
                , [Char]
" It must fit within a 7x7 tile to be compiled statically." ]


-- | Data template for stencils up to 7x7.
template7x7
        :: (Int -> Int -> a -> a)
        -> a -> a

{-# INLINE template7x7 #-}
template7x7 :: (Int -> Int -> a -> a) -> a -> a
template7x7 Int -> Int -> a -> a
f a
zero
        = Int -> Int -> a -> a
f (-Int
3) (-Int
3)  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f (-Int
3) (-Int
2)  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f (-Int
3) (-Int
1)  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f (-Int
3)   Int
0  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f (-Int
3)   Int
1  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f (-Int
3)   Int
2  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> a -> a
f (-Int
3) Int
3
        (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> a -> a
f (-Int
2) (-Int
3)  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f (-Int
2) (-Int
2)  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f (-Int
2) (-Int
1)  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f (-Int
2)   Int
0  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f (-Int
2)   Int
1  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f (-Int
2)   Int
2  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> a -> a
f (-Int
2) Int
3
        (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> a -> a
f (-Int
1) (-Int
3)  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f (-Int
1) (-Int
2)  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f (-Int
1) (-Int
1)  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f (-Int
1)   Int
0  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f (-Int
1)   Int
1  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f (-Int
1)   Int
2  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> a -> a
f (-Int
1) Int
3
        (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> a -> a
f   Int
0  (-Int
3)  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f   Int
0  (-Int
2)  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f   Int
0  (-Int
1)  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f   Int
0    Int
0  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f   Int
0    Int
1  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f   Int
0    Int
2  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> a -> a
f   Int
0  Int
3
        (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> a -> a
f   Int
1  (-Int
3)  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f   Int
1  (-Int
2)  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f   Int
1  (-Int
1)  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f   Int
1    Int
0  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f   Int
1    Int
1  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f   Int
1    Int
2  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> a -> a
f   Int
1  Int
3
        (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> a -> a
f   Int
2  (-Int
3)  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f   Int
2  (-Int
2)  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f   Int
2  (-Int
1)  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f   Int
2    Int
0  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f   Int
2    Int
1  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f   Int
2    Int
2  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> a -> a
f   Int
2  Int
3
        (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> a -> a
f   Int
3  (-Int
3)  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f   Int
3  (-Int
2)  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f   Int
3  (-Int
1)  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f   Int
3    Int
0  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f   Int
3    Int
1  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$  Int -> Int -> a -> a
f   Int
3    Int
2  (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> a -> a
f   Int
3  Int
3
        (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
zero