{-# LANGUAGE GADTs           #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_HADDOCK hide #-}
-- |
-- Module      : Data.Array.Accelerate.Representation.Stencil
-- Copyright   : [2008..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--

module Data.Array.Accelerate.Representation.Stencil (

  -- ** Stencil patterns
  StencilR(..),
  stencilArrayR,
  stencilR, stencilEltR, stencilShapeR, stencilHalo,
  rnfStencilR,
  liftStencilR,

) where

import Data.Array.Accelerate.Representation.Array
import Data.Array.Accelerate.Representation.Shape
import Data.Array.Accelerate.Representation.Type

import Language.Haskell.TH


-- | GADT reifying the 'Stencil' class
--
data StencilR sh e pat where
  StencilRunit3 :: TypeR e -> StencilR DIM1 e (Tup3 e e e)
  StencilRunit5 :: TypeR e -> StencilR DIM1 e (Tup5 e e e e e)
  StencilRunit7 :: TypeR e -> StencilR DIM1 e (Tup7 e e e e e e e)
  StencilRunit9 :: TypeR e -> StencilR DIM1 e (Tup9 e e e e e e e e e)

  StencilRtup3  :: StencilR sh e pat1
                -> StencilR sh e pat2
                -> StencilR sh e pat3
                -> StencilR (sh, Int) e (Tup3 pat1 pat2 pat3)

  StencilRtup5  :: StencilR sh e pat1
                -> StencilR sh e pat2
                -> StencilR sh e pat3
                -> StencilR sh e pat4
                -> StencilR sh e pat5
                -> StencilR (sh, Int) e (Tup5 pat1 pat2 pat3 pat4 pat5)

  StencilRtup7  :: StencilR sh e pat1
                -> StencilR sh e pat2
                -> StencilR sh e pat3
                -> StencilR sh e pat4
                -> StencilR sh e pat5
                -> StencilR sh e pat6
                -> StencilR sh e pat7
                -> StencilR (sh, Int) e (Tup7 pat1 pat2 pat3 pat4 pat5 pat6 pat7)

  StencilRtup9  :: StencilR sh e pat1
                -> StencilR sh e pat2
                -> StencilR sh e pat3
                -> StencilR sh e pat4
                -> StencilR sh e pat5
                -> StencilR sh e pat6
                -> StencilR sh e pat7
                -> StencilR sh e pat8
                -> StencilR sh e pat9
                -> StencilR (sh, Int) e (Tup9 pat1 pat2 pat3 pat4 pat5 pat6 pat7 pat8 pat9)

stencilEltR :: StencilR sh e pat -> TypeR e
stencilEltR :: StencilR sh e pat -> TypeR e
stencilEltR (StencilRunit3 TypeR e
t) = TypeR e
t
stencilEltR (StencilRunit5 TypeR e
t) = TypeR e
t
stencilEltR (StencilRunit7 TypeR e
t) = TypeR e
t
stencilEltR (StencilRunit9 TypeR e
t) = TypeR e
t
stencilEltR (StencilRtup3 StencilR sh e pat1
sR StencilR sh e pat2
_ StencilR sh e pat3
_) = StencilR sh e pat1 -> TypeR e
forall sh e pat. StencilR sh e pat -> TypeR e
stencilEltR StencilR sh e pat1
sR
stencilEltR (StencilRtup5 StencilR sh e pat1
sR StencilR sh e pat2
_ StencilR sh e pat3
_ StencilR sh e pat4
_ StencilR sh e pat5
_) = StencilR sh e pat1 -> TypeR e
forall sh e pat. StencilR sh e pat -> TypeR e
stencilEltR StencilR sh e pat1
sR
stencilEltR (StencilRtup7 StencilR sh e pat1
sR StencilR sh e pat2
_ StencilR sh e pat3
_ StencilR sh e pat4
_ StencilR sh e pat5
_ StencilR sh e pat6
_ StencilR sh e pat7
_) = StencilR sh e pat1 -> TypeR e
forall sh e pat. StencilR sh e pat -> TypeR e
stencilEltR StencilR sh e pat1
sR
stencilEltR (StencilRtup9 StencilR sh e pat1
sR StencilR sh e pat2
_ StencilR sh e pat3
_ StencilR sh e pat4
_ StencilR sh e pat5
_ StencilR sh e pat6
_ StencilR sh e pat7
_ StencilR sh e pat8
_ StencilR sh e pat9
_) = StencilR sh e pat1 -> TypeR e
forall sh e pat. StencilR sh e pat -> TypeR e
stencilEltR StencilR sh e pat1
sR

stencilShapeR :: StencilR sh e pat -> ShapeR sh
stencilShapeR :: StencilR sh e pat -> ShapeR sh
stencilShapeR (StencilRunit3 TypeR e
_) = ShapeR () -> ShapeR ((), Int)
forall sh. ShapeR sh -> ShapeR (sh, Int)
ShapeRsnoc ShapeR ()
ShapeRz
stencilShapeR (StencilRunit5 TypeR e
_) = ShapeR () -> ShapeR ((), Int)
forall sh. ShapeR sh -> ShapeR (sh, Int)
ShapeRsnoc ShapeR ()
ShapeRz
stencilShapeR (StencilRunit7 TypeR e
_) = ShapeR () -> ShapeR ((), Int)
forall sh. ShapeR sh -> ShapeR (sh, Int)
ShapeRsnoc ShapeR ()
ShapeRz
stencilShapeR (StencilRunit9 TypeR e
_) = ShapeR () -> ShapeR ((), Int)
forall sh. ShapeR sh -> ShapeR (sh, Int)
ShapeRsnoc ShapeR ()
ShapeRz
stencilShapeR (StencilRtup3 StencilR sh e pat1
sR StencilR sh e pat2
_ StencilR sh e pat3
_) = ShapeR sh -> ShapeR (sh, Int)
forall sh. ShapeR sh -> ShapeR (sh, Int)
ShapeRsnoc (ShapeR sh -> ShapeR (sh, Int)) -> ShapeR sh -> ShapeR (sh, Int)
forall a b. (a -> b) -> a -> b
$ StencilR sh e pat1 -> ShapeR sh
forall sh e pat. StencilR sh e pat -> ShapeR sh
stencilShapeR StencilR sh e pat1
sR
stencilShapeR (StencilRtup5 StencilR sh e pat1
sR StencilR sh e pat2
_ StencilR sh e pat3
_ StencilR sh e pat4
_ StencilR sh e pat5
_) = ShapeR sh -> ShapeR (sh, Int)
forall sh. ShapeR sh -> ShapeR (sh, Int)
ShapeRsnoc (ShapeR sh -> ShapeR (sh, Int)) -> ShapeR sh -> ShapeR (sh, Int)
forall a b. (a -> b) -> a -> b
$ StencilR sh e pat1 -> ShapeR sh
forall sh e pat. StencilR sh e pat -> ShapeR sh
stencilShapeR StencilR sh e pat1
sR
stencilShapeR (StencilRtup7 StencilR sh e pat1
sR StencilR sh e pat2
_ StencilR sh e pat3
_ StencilR sh e pat4
_ StencilR sh e pat5
_ StencilR sh e pat6
_ StencilR sh e pat7
_) = ShapeR sh -> ShapeR (sh, Int)
forall sh. ShapeR sh -> ShapeR (sh, Int)
ShapeRsnoc (ShapeR sh -> ShapeR (sh, Int)) -> ShapeR sh -> ShapeR (sh, Int)
forall a b. (a -> b) -> a -> b
$ StencilR sh e pat1 -> ShapeR sh
forall sh e pat. StencilR sh e pat -> ShapeR sh
stencilShapeR StencilR sh e pat1
sR
stencilShapeR (StencilRtup9 StencilR sh e pat1
sR StencilR sh e pat2
_ StencilR sh e pat3
_ StencilR sh e pat4
_ StencilR sh e pat5
_ StencilR sh e pat6
_ StencilR sh e pat7
_ StencilR sh e pat8
_ StencilR sh e pat9
_) = ShapeR sh -> ShapeR (sh, Int)
forall sh. ShapeR sh -> ShapeR (sh, Int)
ShapeRsnoc (ShapeR sh -> ShapeR (sh, Int)) -> ShapeR sh -> ShapeR (sh, Int)
forall a b. (a -> b) -> a -> b
$ StencilR sh e pat1 -> ShapeR sh
forall sh e pat. StencilR sh e pat -> ShapeR sh
stencilShapeR StencilR sh e pat1
sR

stencilR :: StencilR sh e pat -> TypeR pat
stencilR :: StencilR sh e pat -> TypeR pat
stencilR (StencilRunit3 TypeR e
t) = TypeR e -> TypeR e -> TypeR e -> TupR ScalarType (Tup3 e e e)
forall (s :: * -> *) t1 t2 t3.
TupR s t1 -> TupR s t2 -> TupR s t3 -> TupR s (Tup3 t1 t2 t3)
tupR3 TypeR e
t TypeR e
t TypeR e
t
stencilR (StencilRunit5 TypeR e
t) = TypeR e
-> TypeR e
-> TypeR e
-> TypeR e
-> TypeR e
-> TupR ScalarType (Tup5 e e e e e)
forall (s :: * -> *) t1 t2 t3 t4 t5.
TupR s t1
-> TupR s t2
-> TupR s t3
-> TupR s t4
-> TupR s t5
-> TupR s (Tup5 t1 t2 t3 t4 t5)
tupR5 TypeR e
t TypeR e
t TypeR e
t TypeR e
t TypeR e
t
stencilR (StencilRunit7 TypeR e
t) = TypeR e
-> TypeR e
-> TypeR e
-> TypeR e
-> TypeR e
-> TypeR e
-> TypeR e
-> TupR ScalarType (Tup7 e e e e e e e)
forall (s :: * -> *) t1 t2 t3 t4 t5 t6 t7.
TupR s t1
-> TupR s t2
-> TupR s t3
-> TupR s t4
-> TupR s t5
-> TupR s t6
-> TupR s t7
-> TupR s (Tup7 t1 t2 t3 t4 t5 t6 t7)
tupR7 TypeR e
t TypeR e
t TypeR e
t TypeR e
t TypeR e
t TypeR e
t TypeR e
t
stencilR (StencilRunit9 TypeR e
t) = TypeR e
-> TypeR e
-> TypeR e
-> TypeR e
-> TypeR e
-> TypeR e
-> TypeR e
-> TypeR e
-> TypeR e
-> TupR ScalarType (Tup9 e e e e e e e e e)
forall (s :: * -> *) t1 t2 t3 t4 t5 t6 t7 t8 t9.
TupR s t1
-> TupR s t2
-> TupR s t3
-> TupR s t4
-> TupR s t5
-> TupR s t6
-> TupR s t7
-> TupR s t8
-> TupR s t9
-> TupR s (Tup9 t1 t2 t3 t4 t5 t6 t7 t8 t9)
tupR9 TypeR e
t TypeR e
t TypeR e
t TypeR e
t TypeR e
t TypeR e
t TypeR e
t TypeR e
t TypeR e
t
stencilR (StencilRtup3 StencilR sh e pat1
s1 StencilR sh e pat2
s2 StencilR sh e pat3
s3) = TupR ScalarType pat1
-> TupR ScalarType pat2
-> TupR ScalarType pat3
-> TupR ScalarType (Tup3 pat1 pat2 pat3)
forall (s :: * -> *) t1 t2 t3.
TupR s t1 -> TupR s t2 -> TupR s t3 -> TupR s (Tup3 t1 t2 t3)
tupR3 (StencilR sh e pat1 -> TupR ScalarType pat1
forall sh e pat. StencilR sh e pat -> TypeR pat
stencilR StencilR sh e pat1
s1) (StencilR sh e pat2 -> TupR ScalarType pat2
forall sh e pat. StencilR sh e pat -> TypeR pat
stencilR StencilR sh e pat2
s2) (StencilR sh e pat3 -> TupR ScalarType pat3
forall sh e pat. StencilR sh e pat -> TypeR pat
stencilR StencilR sh e pat3
s3)
stencilR (StencilRtup5 StencilR sh e pat1
s1 StencilR sh e pat2
s2 StencilR sh e pat3
s3 StencilR sh e pat4
s4 StencilR sh e pat5
s5) = TupR ScalarType pat1
-> TupR ScalarType pat2
-> TupR ScalarType pat3
-> TupR ScalarType pat4
-> TupR ScalarType pat5
-> TupR ScalarType (Tup5 pat1 pat2 pat3 pat4 pat5)
forall (s :: * -> *) t1 t2 t3 t4 t5.
TupR s t1
-> TupR s t2
-> TupR s t3
-> TupR s t4
-> TupR s t5
-> TupR s (Tup5 t1 t2 t3 t4 t5)
tupR5 (StencilR sh e pat1 -> TupR ScalarType pat1
forall sh e pat. StencilR sh e pat -> TypeR pat
stencilR StencilR sh e pat1
s1) (StencilR sh e pat2 -> TupR ScalarType pat2
forall sh e pat. StencilR sh e pat -> TypeR pat
stencilR StencilR sh e pat2
s2) (StencilR sh e pat3 -> TupR ScalarType pat3
forall sh e pat. StencilR sh e pat -> TypeR pat
stencilR StencilR sh e pat3
s3) (StencilR sh e pat4 -> TupR ScalarType pat4
forall sh e pat. StencilR sh e pat -> TypeR pat
stencilR StencilR sh e pat4
s4) (StencilR sh e pat5 -> TupR ScalarType pat5
forall sh e pat. StencilR sh e pat -> TypeR pat
stencilR StencilR sh e pat5
s5)
stencilR (StencilRtup7 StencilR sh e pat1
s1 StencilR sh e pat2
s2 StencilR sh e pat3
s3 StencilR sh e pat4
s4 StencilR sh e pat5
s5 StencilR sh e pat6
s6 StencilR sh e pat7
s7) = TupR ScalarType pat1
-> TupR ScalarType pat2
-> TupR ScalarType pat3
-> TupR ScalarType pat4
-> TupR ScalarType pat5
-> TupR ScalarType pat6
-> TupR ScalarType pat7
-> TupR ScalarType (Tup7 pat1 pat2 pat3 pat4 pat5 pat6 pat7)
forall (s :: * -> *) t1 t2 t3 t4 t5 t6 t7.
TupR s t1
-> TupR s t2
-> TupR s t3
-> TupR s t4
-> TupR s t5
-> TupR s t6
-> TupR s t7
-> TupR s (Tup7 t1 t2 t3 t4 t5 t6 t7)
tupR7 (StencilR sh e pat1 -> TupR ScalarType pat1
forall sh e pat. StencilR sh e pat -> TypeR pat
stencilR StencilR sh e pat1
s1) (StencilR sh e pat2 -> TupR ScalarType pat2
forall sh e pat. StencilR sh e pat -> TypeR pat
stencilR StencilR sh e pat2
s2) (StencilR sh e pat3 -> TupR ScalarType pat3
forall sh e pat. StencilR sh e pat -> TypeR pat
stencilR StencilR sh e pat3
s3) (StencilR sh e pat4 -> TupR ScalarType pat4
forall sh e pat. StencilR sh e pat -> TypeR pat
stencilR StencilR sh e pat4
s4) (StencilR sh e pat5 -> TupR ScalarType pat5
forall sh e pat. StencilR sh e pat -> TypeR pat
stencilR StencilR sh e pat5
s5) (StencilR sh e pat6 -> TupR ScalarType pat6
forall sh e pat. StencilR sh e pat -> TypeR pat
stencilR StencilR sh e pat6
s6) (StencilR sh e pat7 -> TupR ScalarType pat7
forall sh e pat. StencilR sh e pat -> TypeR pat
stencilR StencilR sh e pat7
s7)
stencilR (StencilRtup9 StencilR sh e pat1
s1 StencilR sh e pat2
s2 StencilR sh e pat3
s3 StencilR sh e pat4
s4 StencilR sh e pat5
s5 StencilR sh e pat6
s6 StencilR sh e pat7
s7 StencilR sh e pat8
s8 StencilR sh e pat9
s9) = TupR ScalarType pat1
-> TupR ScalarType pat2
-> TupR ScalarType pat3
-> TupR ScalarType pat4
-> TupR ScalarType pat5
-> TupR ScalarType pat6
-> TupR ScalarType pat7
-> TupR ScalarType pat8
-> TupR ScalarType pat9
-> TupR
     ScalarType (Tup9 pat1 pat2 pat3 pat4 pat5 pat6 pat7 pat8 pat9)
forall (s :: * -> *) t1 t2 t3 t4 t5 t6 t7 t8 t9.
TupR s t1
-> TupR s t2
-> TupR s t3
-> TupR s t4
-> TupR s t5
-> TupR s t6
-> TupR s t7
-> TupR s t8
-> TupR s t9
-> TupR s (Tup9 t1 t2 t3 t4 t5 t6 t7 t8 t9)
tupR9 (StencilR sh e pat1 -> TupR ScalarType pat1
forall sh e pat. StencilR sh e pat -> TypeR pat
stencilR StencilR sh e pat1
s1) (StencilR sh e pat2 -> TupR ScalarType pat2
forall sh e pat. StencilR sh e pat -> TypeR pat
stencilR StencilR sh e pat2
s2) (StencilR sh e pat3 -> TupR ScalarType pat3
forall sh e pat. StencilR sh e pat -> TypeR pat
stencilR StencilR sh e pat3
s3) (StencilR sh e pat4 -> TupR ScalarType pat4
forall sh e pat. StencilR sh e pat -> TypeR pat
stencilR StencilR sh e pat4
s4) (StencilR sh e pat5 -> TupR ScalarType pat5
forall sh e pat. StencilR sh e pat -> TypeR pat
stencilR StencilR sh e pat5
s5) (StencilR sh e pat6 -> TupR ScalarType pat6
forall sh e pat. StencilR sh e pat -> TypeR pat
stencilR StencilR sh e pat6
s6) (StencilR sh e pat7 -> TupR ScalarType pat7
forall sh e pat. StencilR sh e pat -> TypeR pat
stencilR StencilR sh e pat7
s7) (StencilR sh e pat8 -> TupR ScalarType pat8
forall sh e pat. StencilR sh e pat -> TypeR pat
stencilR StencilR sh e pat8
s8) (StencilR sh e pat9 -> TupR ScalarType pat9
forall sh e pat. StencilR sh e pat -> TypeR pat
stencilR StencilR sh e pat9
s9)

stencilArrayR :: StencilR sh e pat -> ArrayR (Array sh e)
stencilArrayR :: StencilR sh e pat -> ArrayR (Array sh e)
stencilArrayR StencilR sh e pat
sR = ShapeR sh -> TypeR e -> ArrayR (Array sh e)
forall sh e. ShapeR sh -> TypeR e -> ArrayR (Array sh e)
ArrayR (StencilR sh e pat -> ShapeR sh
forall sh e pat. StencilR sh e pat -> ShapeR sh
stencilShapeR StencilR sh e pat
sR) (StencilR sh e pat -> TypeR e
forall sh e pat. StencilR sh e pat -> TypeR e
stencilEltR StencilR sh e pat
sR)

stencilHalo :: StencilR sh e stencil -> (ShapeR sh, sh)
stencilHalo :: StencilR sh e stencil -> (ShapeR sh, sh)
stencilHalo = StencilR sh e stencil -> (ShapeR sh, sh)
forall sh e stencil. StencilR sh e stencil -> (ShapeR sh, sh)
go'
  where
    go' :: StencilR sh e stencil -> (ShapeR sh, sh)
    go' :: StencilR sh e stencil -> (ShapeR sh, sh)
go' StencilRunit3{} = (ShapeR sh
ShapeR ((), Int)
dim1, ((), Int
1))
    go' StencilRunit5{} = (ShapeR sh
ShapeR ((), Int)
dim1, ((), Int
2))
    go' StencilRunit7{} = (ShapeR sh
ShapeR ((), Int)
dim1, ((), Int
3))
    go' StencilRunit9{} = (ShapeR sh
ShapeR ((), Int)
dim1, ((), Int
4))
    --
    go' (StencilRtup3 StencilR sh e pat1
a StencilR sh e pat2
b StencilR sh e pat3
c            ) = (ShapeR sh -> ShapeR (sh, Int)
forall sh. ShapeR sh -> ShapeR (sh, Int)
ShapeRsnoc ShapeR sh
shR, ShapeR sh -> Int -> sh -> (sh, Int)
forall sh. ShapeR sh -> Int -> sh -> (sh, Int)
cons ShapeR sh
shR Int
1 (sh -> (sh, Int)) -> sh -> (sh, Int)
forall a b. (a -> b) -> a -> b
$ (sh -> sh -> sh) -> [sh] -> sh
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (ShapeR sh -> sh -> sh -> sh
forall sh. ShapeR sh -> sh -> sh -> sh
union ShapeR sh
shR) [sh
a', StencilR sh e pat2 -> sh
forall sh e stencil. StencilR sh e stencil -> sh
go StencilR sh e pat2
b, StencilR sh e pat3 -> sh
forall sh e stencil. StencilR sh e stencil -> sh
go StencilR sh e pat3
c])
      where (ShapeR sh
shR, sh
a') = StencilR sh e pat1 -> (ShapeR sh, sh)
forall sh e stencil. StencilR sh e stencil -> (ShapeR sh, sh)
go' StencilR sh e pat1
a
    go' (StencilRtup5 StencilR sh e pat1
a StencilR sh e pat2
b StencilR sh e pat3
c StencilR sh e pat4
d StencilR sh e pat5
e        ) = (ShapeR sh -> ShapeR (sh, Int)
forall sh. ShapeR sh -> ShapeR (sh, Int)
ShapeRsnoc ShapeR sh
shR, ShapeR sh -> Int -> sh -> (sh, Int)
forall sh. ShapeR sh -> Int -> sh -> (sh, Int)
cons ShapeR sh
shR Int
2 (sh -> (sh, Int)) -> sh -> (sh, Int)
forall a b. (a -> b) -> a -> b
$ (sh -> sh -> sh) -> [sh] -> sh
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (ShapeR sh -> sh -> sh -> sh
forall sh. ShapeR sh -> sh -> sh -> sh
union ShapeR sh
shR) [sh
a', StencilR sh e pat2 -> sh
forall sh e stencil. StencilR sh e stencil -> sh
go StencilR sh e pat2
b, StencilR sh e pat3 -> sh
forall sh e stencil. StencilR sh e stencil -> sh
go StencilR sh e pat3
c, StencilR sh e pat4 -> sh
forall sh e stencil. StencilR sh e stencil -> sh
go StencilR sh e pat4
d, StencilR sh e pat5 -> sh
forall sh e stencil. StencilR sh e stencil -> sh
go StencilR sh e pat5
e])
      where (ShapeR sh
shR, sh
a') = StencilR sh e pat1 -> (ShapeR sh, sh)
forall sh e stencil. StencilR sh e stencil -> (ShapeR sh, sh)
go' StencilR sh e pat1
a
    go' (StencilRtup7 StencilR sh e pat1
a StencilR sh e pat2
b StencilR sh e pat3
c StencilR sh e pat4
d StencilR sh e pat5
e StencilR sh e pat6
f StencilR sh e pat7
g    ) = (ShapeR sh -> ShapeR (sh, Int)
forall sh. ShapeR sh -> ShapeR (sh, Int)
ShapeRsnoc ShapeR sh
shR, ShapeR sh -> Int -> sh -> (sh, Int)
forall sh. ShapeR sh -> Int -> sh -> (sh, Int)
cons ShapeR sh
shR Int
3 (sh -> (sh, Int)) -> sh -> (sh, Int)
forall a b. (a -> b) -> a -> b
$ (sh -> sh -> sh) -> [sh] -> sh
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (ShapeR sh -> sh -> sh -> sh
forall sh. ShapeR sh -> sh -> sh -> sh
union ShapeR sh
shR) [sh
a', StencilR sh e pat2 -> sh
forall sh e stencil. StencilR sh e stencil -> sh
go StencilR sh e pat2
b, StencilR sh e pat3 -> sh
forall sh e stencil. StencilR sh e stencil -> sh
go StencilR sh e pat3
c, StencilR sh e pat4 -> sh
forall sh e stencil. StencilR sh e stencil -> sh
go StencilR sh e pat4
d, StencilR sh e pat5 -> sh
forall sh e stencil. StencilR sh e stencil -> sh
go StencilR sh e pat5
e, StencilR sh e pat6 -> sh
forall sh e stencil. StencilR sh e stencil -> sh
go StencilR sh e pat6
f, StencilR sh e pat7 -> sh
forall sh e stencil. StencilR sh e stencil -> sh
go StencilR sh e pat7
g])
      where (ShapeR sh
shR, sh
a') = StencilR sh e pat1 -> (ShapeR sh, sh)
forall sh e stencil. StencilR sh e stencil -> (ShapeR sh, sh)
go' StencilR sh e pat1
a
    go' (StencilRtup9 StencilR sh e pat1
a StencilR sh e pat2
b StencilR sh e pat3
c StencilR sh e pat4
d StencilR sh e pat5
e StencilR sh e pat6
f StencilR sh e pat7
g StencilR sh e pat8
h StencilR sh e pat9
i) = (ShapeR sh -> ShapeR (sh, Int)
forall sh. ShapeR sh -> ShapeR (sh, Int)
ShapeRsnoc ShapeR sh
shR, ShapeR sh -> Int -> sh -> (sh, Int)
forall sh. ShapeR sh -> Int -> sh -> (sh, Int)
cons ShapeR sh
shR Int
4 (sh -> (sh, Int)) -> sh -> (sh, Int)
forall a b. (a -> b) -> a -> b
$ (sh -> sh -> sh) -> [sh] -> sh
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (ShapeR sh -> sh -> sh -> sh
forall sh. ShapeR sh -> sh -> sh -> sh
union ShapeR sh
shR) [sh
a', StencilR sh e pat2 -> sh
forall sh e stencil. StencilR sh e stencil -> sh
go StencilR sh e pat2
b, StencilR sh e pat3 -> sh
forall sh e stencil. StencilR sh e stencil -> sh
go StencilR sh e pat3
c, StencilR sh e pat4 -> sh
forall sh e stencil. StencilR sh e stencil -> sh
go StencilR sh e pat4
d, StencilR sh e pat5 -> sh
forall sh e stencil. StencilR sh e stencil -> sh
go StencilR sh e pat5
e, StencilR sh e pat6 -> sh
forall sh e stencil. StencilR sh e stencil -> sh
go StencilR sh e pat6
f, StencilR sh e pat7 -> sh
forall sh e stencil. StencilR sh e stencil -> sh
go StencilR sh e pat7
g, StencilR sh e pat8 -> sh
forall sh e stencil. StencilR sh e stencil -> sh
go StencilR sh e pat8
h, StencilR sh e pat9 -> sh
forall sh e stencil. StencilR sh e stencil -> sh
go StencilR sh e pat9
i])
      where (ShapeR sh
shR, sh
a') = StencilR sh e pat1 -> (ShapeR sh, sh)
forall sh e stencil. StencilR sh e stencil -> (ShapeR sh, sh)
go' StencilR sh e pat1
a

    go :: StencilR sh e stencil -> sh
    go :: StencilR sh e stencil -> sh
go = (ShapeR sh, sh) -> sh
forall a b. (a, b) -> b
snd ((ShapeR sh, sh) -> sh)
-> (StencilR sh e stencil -> (ShapeR sh, sh))
-> StencilR sh e stencil
-> sh
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StencilR sh e stencil -> (ShapeR sh, sh)
forall sh e stencil. StencilR sh e stencil -> (ShapeR sh, sh)
go'

    cons :: ShapeR sh -> Int -> sh -> (sh, Int)
    cons :: ShapeR sh -> Int -> sh -> (sh, Int)
cons ShapeR sh
ShapeRz          Int
ix ()       = ((), Int
ix)
    cons (ShapeRsnoc ShapeR sh
shr) Int
ix (sh, sz) = (ShapeR sh -> Int -> sh -> (sh, Int)
forall sh. ShapeR sh -> Int -> sh -> (sh, Int)
cons ShapeR sh
shr Int
ix sh
sh, Int
sz)

tupR3 :: TupR s t1 -> TupR s t2 -> TupR s t3 -> TupR s (Tup3 t1 t2 t3)
tupR3 :: TupR s t1 -> TupR s t2 -> TupR s t3 -> TupR s (Tup3 t1 t2 t3)
tupR3 TupR s t1
t1 TupR s t2
t2 TupR s t3
t3 = TupR s ()
forall (s :: * -> *). TupR s ()
TupRunit TupR s () -> TupR s t1 -> TupR s ((), t1)
forall (s :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` TupR s t1
t1 TupR s ((), t1) -> TupR s t2 -> TupR s (((), t1), t2)
forall (s :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` TupR s t2
t2 TupR s (((), t1), t2) -> TupR s t3 -> TupR s (Tup3 t1 t2 t3)
forall (s :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` TupR s t3
t3

tupR5 :: TupR s t1 -> TupR s t2 -> TupR s t3 -> TupR s t4 -> TupR s t5 -> TupR s (Tup5 t1 t2 t3 t4 t5)
tupR5 :: TupR s t1
-> TupR s t2
-> TupR s t3
-> TupR s t4
-> TupR s t5
-> TupR s (Tup5 t1 t2 t3 t4 t5)
tupR5 TupR s t1
t1 TupR s t2
t2 TupR s t3
t3 TupR s t4
t4 TupR s t5
t5 = TupR s ()
forall (s :: * -> *). TupR s ()
TupRunit TupR s () -> TupR s t1 -> TupR s ((), t1)
forall (s :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` TupR s t1
t1 TupR s ((), t1) -> TupR s t2 -> TupR s (((), t1), t2)
forall (s :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` TupR s t2
t2 TupR s (((), t1), t2) -> TupR s t3 -> TupR s ((((), t1), t2), t3)
forall (s :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` TupR s t3
t3 TupR s ((((), t1), t2), t3)
-> TupR s t4 -> TupR s (((((), t1), t2), t3), t4)
forall (s :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` TupR s t4
t4 TupR s (((((), t1), t2), t3), t4)
-> TupR s t5 -> TupR s (Tup5 t1 t2 t3 t4 t5)
forall (s :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` TupR s t5
t5

tupR7 :: TupR s t1 -> TupR s t2 -> TupR s t3 -> TupR s t4 -> TupR s t5 -> TupR s t6 -> TupR s t7 -> TupR s (Tup7 t1 t2 t3 t4 t5 t6 t7)
tupR7 :: TupR s t1
-> TupR s t2
-> TupR s t3
-> TupR s t4
-> TupR s t5
-> TupR s t6
-> TupR s t7
-> TupR s (Tup7 t1 t2 t3 t4 t5 t6 t7)
tupR7 TupR s t1
t1 TupR s t2
t2 TupR s t3
t3 TupR s t4
t4 TupR s t5
t5 TupR s t6
t6 TupR s t7
t7 = TupR s ()
forall (s :: * -> *). TupR s ()
TupRunit TupR s () -> TupR s t1 -> TupR s ((), t1)
forall (s :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` TupR s t1
t1 TupR s ((), t1) -> TupR s t2 -> TupR s (((), t1), t2)
forall (s :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` TupR s t2
t2 TupR s (((), t1), t2) -> TupR s t3 -> TupR s ((((), t1), t2), t3)
forall (s :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` TupR s t3
t3 TupR s ((((), t1), t2), t3)
-> TupR s t4 -> TupR s (((((), t1), t2), t3), t4)
forall (s :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` TupR s t4
t4 TupR s (((((), t1), t2), t3), t4)
-> TupR s t5 -> TupR s ((((((), t1), t2), t3), t4), t5)
forall (s :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` TupR s t5
t5 TupR s ((((((), t1), t2), t3), t4), t5)
-> TupR s t6 -> TupR s (((((((), t1), t2), t3), t4), t5), t6)
forall (s :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` TupR s t6
t6 TupR s (((((((), t1), t2), t3), t4), t5), t6)
-> TupR s t7 -> TupR s (Tup7 t1 t2 t3 t4 t5 t6 t7)
forall (s :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` TupR s t7
t7

tupR9 :: TupR s t1 -> TupR s t2 -> TupR s t3 -> TupR s t4 -> TupR s t5 -> TupR s t6 -> TupR s t7 -> TupR s t8 -> TupR s t9 -> TupR s (Tup9 t1 t2 t3 t4 t5 t6 t7 t8 t9)
tupR9 :: TupR s t1
-> TupR s t2
-> TupR s t3
-> TupR s t4
-> TupR s t5
-> TupR s t6
-> TupR s t7
-> TupR s t8
-> TupR s t9
-> TupR s (Tup9 t1 t2 t3 t4 t5 t6 t7 t8 t9)
tupR9 TupR s t1
t1 TupR s t2
t2 TupR s t3
t3 TupR s t4
t4 TupR s t5
t5 TupR s t6
t6 TupR s t7
t7 TupR s t8
t8 TupR s t9
t9 = TupR s ()
forall (s :: * -> *). TupR s ()
TupRunit TupR s () -> TupR s t1 -> TupR s ((), t1)
forall (s :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` TupR s t1
t1 TupR s ((), t1) -> TupR s t2 -> TupR s (((), t1), t2)
forall (s :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` TupR s t2
t2 TupR s (((), t1), t2) -> TupR s t3 -> TupR s ((((), t1), t2), t3)
forall (s :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` TupR s t3
t3 TupR s ((((), t1), t2), t3)
-> TupR s t4 -> TupR s (((((), t1), t2), t3), t4)
forall (s :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` TupR s t4
t4 TupR s (((((), t1), t2), t3), t4)
-> TupR s t5 -> TupR s ((((((), t1), t2), t3), t4), t5)
forall (s :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` TupR s t5
t5 TupR s ((((((), t1), t2), t3), t4), t5)
-> TupR s t6 -> TupR s (((((((), t1), t2), t3), t4), t5), t6)
forall (s :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` TupR s t6
t6 TupR s (((((((), t1), t2), t3), t4), t5), t6)
-> TupR s t7 -> TupR s ((((((((), t1), t2), t3), t4), t5), t6), t7)
forall (s :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` TupR s t7
t7 TupR s ((((((((), t1), t2), t3), t4), t5), t6), t7)
-> TupR s t8
-> TupR s (((((((((), t1), t2), t3), t4), t5), t6), t7), t8)
forall (s :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` TupR s t8
t8 TupR s (((((((((), t1), t2), t3), t4), t5), t6), t7), t8)
-> TupR s t9 -> TupR s (Tup9 t1 t2 t3 t4 t5 t6 t7 t8 t9)
forall (s :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` TupR s t9
t9

rnfStencilR :: StencilR sh e pat -> ()
rnfStencilR :: StencilR sh e pat -> ()
rnfStencilR (StencilRunit3 TypeR e
t) = TypeR e -> ()
forall t. TypeR t -> ()
rnfTypeR TypeR e
t
rnfStencilR (StencilRunit5 TypeR e
t) = TypeR e -> ()
forall t. TypeR t -> ()
rnfTypeR TypeR e
t
rnfStencilR (StencilRunit7 TypeR e
t) = TypeR e -> ()
forall t. TypeR t -> ()
rnfTypeR TypeR e
t
rnfStencilR (StencilRunit9 TypeR e
t) = TypeR e -> ()
forall t. TypeR t -> ()
rnfTypeR TypeR e
t
rnfStencilR (StencilRtup3 StencilR sh e pat1
s1 StencilR sh e pat2
s2 StencilR sh e pat3
s3) = StencilR sh e pat1 -> ()
forall sh e pat. StencilR sh e pat -> ()
rnfStencilR StencilR sh e pat1
s1 () -> () -> ()
`seq` StencilR sh e pat2 -> ()
forall sh e pat. StencilR sh e pat -> ()
rnfStencilR StencilR sh e pat2
s2 () -> () -> ()
`seq` StencilR sh e pat3 -> ()
forall sh e pat. StencilR sh e pat -> ()
rnfStencilR StencilR sh e pat3
s3
rnfStencilR (StencilRtup5 StencilR sh e pat1
s1 StencilR sh e pat2
s2 StencilR sh e pat3
s3 StencilR sh e pat4
s4 StencilR sh e pat5
s5) = StencilR sh e pat1 -> ()
forall sh e pat. StencilR sh e pat -> ()
rnfStencilR StencilR sh e pat1
s1 () -> () -> ()
`seq` StencilR sh e pat2 -> ()
forall sh e pat. StencilR sh e pat -> ()
rnfStencilR StencilR sh e pat2
s2 () -> () -> ()
`seq` StencilR sh e pat3 -> ()
forall sh e pat. StencilR sh e pat -> ()
rnfStencilR StencilR sh e pat3
s3 () -> () -> ()
`seq` StencilR sh e pat4 -> ()
forall sh e pat. StencilR sh e pat -> ()
rnfStencilR StencilR sh e pat4
s4 () -> () -> ()
`seq` StencilR sh e pat5 -> ()
forall sh e pat. StencilR sh e pat -> ()
rnfStencilR StencilR sh e pat5
s5
rnfStencilR (StencilRtup7 StencilR sh e pat1
s1 StencilR sh e pat2
s2 StencilR sh e pat3
s3 StencilR sh e pat4
s4 StencilR sh e pat5
s5 StencilR sh e pat6
s6 StencilR sh e pat7
s7) = StencilR sh e pat1 -> ()
forall sh e pat. StencilR sh e pat -> ()
rnfStencilR StencilR sh e pat1
s1 () -> () -> ()
`seq` StencilR sh e pat2 -> ()
forall sh e pat. StencilR sh e pat -> ()
rnfStencilR StencilR sh e pat2
s2 () -> () -> ()
`seq` StencilR sh e pat3 -> ()
forall sh e pat. StencilR sh e pat -> ()
rnfStencilR StencilR sh e pat3
s3 () -> () -> ()
`seq` StencilR sh e pat4 -> ()
forall sh e pat. StencilR sh e pat -> ()
rnfStencilR StencilR sh e pat4
s4 () -> () -> ()
`seq` StencilR sh e pat5 -> ()
forall sh e pat. StencilR sh e pat -> ()
rnfStencilR StencilR sh e pat5
s5 () -> () -> ()
`seq` StencilR sh e pat6 -> ()
forall sh e pat. StencilR sh e pat -> ()
rnfStencilR StencilR sh e pat6
s6 () -> () -> ()
`seq` StencilR sh e pat7 -> ()
forall sh e pat. StencilR sh e pat -> ()
rnfStencilR StencilR sh e pat7
s7
rnfStencilR (StencilRtup9 StencilR sh e pat1
s1 StencilR sh e pat2
s2 StencilR sh e pat3
s3 StencilR sh e pat4
s4 StencilR sh e pat5
s5 StencilR sh e pat6
s6 StencilR sh e pat7
s7 StencilR sh e pat8
s8 StencilR sh e pat9
s9) = StencilR sh e pat1 -> ()
forall sh e pat. StencilR sh e pat -> ()
rnfStencilR StencilR sh e pat1
s1 () -> () -> ()
`seq` StencilR sh e pat2 -> ()
forall sh e pat. StencilR sh e pat -> ()
rnfStencilR StencilR sh e pat2
s2 () -> () -> ()
`seq` StencilR sh e pat3 -> ()
forall sh e pat. StencilR sh e pat -> ()
rnfStencilR StencilR sh e pat3
s3 () -> () -> ()
`seq` StencilR sh e pat4 -> ()
forall sh e pat. StencilR sh e pat -> ()
rnfStencilR StencilR sh e pat4
s4 () -> () -> ()
`seq` StencilR sh e pat5 -> ()
forall sh e pat. StencilR sh e pat -> ()
rnfStencilR StencilR sh e pat5
s5 () -> () -> ()
`seq` StencilR sh e pat6 -> ()
forall sh e pat. StencilR sh e pat -> ()
rnfStencilR StencilR sh e pat6
s6 () -> () -> ()
`seq` StencilR sh e pat7 -> ()
forall sh e pat. StencilR sh e pat -> ()
rnfStencilR StencilR sh e pat7
s7 () -> () -> ()
`seq` StencilR sh e pat8 -> ()
forall sh e pat. StencilR sh e pat -> ()
rnfStencilR StencilR sh e pat8
s8 () -> () -> ()
`seq` StencilR sh e pat9 -> ()
forall sh e pat. StencilR sh e pat -> ()
rnfStencilR StencilR sh e pat9
s9

liftStencilR :: StencilR sh e pat -> Q (TExp (StencilR sh e pat))
liftStencilR :: StencilR sh e pat -> Q (TExp (StencilR sh e pat))
liftStencilR (StencilRunit3 TypeR e
tp) = [|| StencilRunit3 $$(liftTypeR tp) ||]
liftStencilR (StencilRunit5 TypeR e
tp) = [|| StencilRunit5 $$(liftTypeR tp) ||]
liftStencilR (StencilRunit7 TypeR e
tp) = [|| StencilRunit7 $$(liftTypeR tp) ||]
liftStencilR (StencilRunit9 TypeR e
tp) = [|| StencilRunit9 $$(liftTypeR tp) ||]
liftStencilR (StencilRtup3 StencilR sh e pat1
s1 StencilR sh e pat2
s2 StencilR sh e pat3
s3) = [|| StencilRtup3 $$(liftStencilR s1) $$(liftStencilR s2) $$(liftStencilR s3) ||]
liftStencilR (StencilRtup5 StencilR sh e pat1
s1 StencilR sh e pat2
s2 StencilR sh e pat3
s3 StencilR sh e pat4
s4 StencilR sh e pat5
s5) = [|| StencilRtup5 $$(liftStencilR s1) $$(liftStencilR s2) $$(liftStencilR s3) $$(liftStencilR s4) $$(liftStencilR s5) ||]
liftStencilR (StencilRtup7 StencilR sh e pat1
s1 StencilR sh e pat2
s2 StencilR sh e pat3
s3 StencilR sh e pat4
s4 StencilR sh e pat5
s5 StencilR sh e pat6
s6 StencilR sh e pat7
s7) = [|| StencilRtup7 $$(liftStencilR s1) $$(liftStencilR s2) $$(liftStencilR s3) $$(liftStencilR s4) $$(liftStencilR s5) $$(liftStencilR s6) $$(liftStencilR s7) ||]
liftStencilR (StencilRtup9 StencilR sh e pat1
s1 StencilR sh e pat2
s2 StencilR sh e pat3
s3 StencilR sh e pat4
s4 StencilR sh e pat5
s5 StencilR sh e pat6
s6 StencilR sh e pat7
s7 StencilR sh e pat8
s8 StencilR sh e pat9
s9) = [|| StencilRtup9 $$(liftStencilR s1) $$(liftStencilR s2) $$(liftStencilR s3) $$(liftStencilR s4) $$(liftStencilR s5) $$(liftStencilR s6) $$(liftStencilR s7) $$(liftStencilR s8) $$(liftStencilR s9) ||]