{-# LANGUAGE CPP                 #-}
{-# LANGUAGE ConstraintKinds     #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE RebindableSyntax    #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators       #-}
{-# LANGUAGE ViewPatterns        #-}
-- |
-- Module      : Data.Array.Accelerate.Math.FFT.Adhoc
-- Copyright   : [2017..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--
-- Implementation of ad-hoc FFT stolen from the accelerate-fourier by Henning
-- Thielemann (BSD3 licensed), and updated to work with current Accelerate. That
-- package contains other more sophisticated algorithms as well.
--

module Data.Array.Accelerate.Math.FFT.Adhoc ( fft )
  where

import Data.Array.Accelerate                                        hiding ( transpose, fromInteger )
import Data.Array.Accelerate.Data.Bits
import Data.Array.Accelerate.Data.Complex
import Data.Array.Accelerate.Control.Lens.Shape

import Data.Array.Accelerate.Math.FFT.Mode
import Data.Array.Accelerate.Math.FFT.Type

import qualified Prelude                                            as P


fft :: (Shape sh, Slice sh, Numeric e)
    => Mode
    -> Acc (Array (sh:.Int) (Complex e))
    -> Acc (Array (sh:.Int) (Complex e))
fft :: Mode
-> Acc (Array (sh :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
fft Mode
mode Acc (Array (sh :. Int) (Complex e))
arr =
  let len :: Exp Int
len             = Exp (sh :. Int) -> Exp Int
forall sh a. (Elt sh, Elt a) => Exp (sh :. a) -> Exp a
indexHead (Acc (Array (sh :. Int) (Complex e)) -> Exp (sh :. Int)
forall sh e. (Shape sh, Elt e) => Acc (Array sh e) -> Exp sh
shape Acc (Array (sh :. Int) (Complex e))
arr)
      (Exp Bool
pow2, Exp Bool
smooth5) = Exp Int -> (Exp Bool, Exp Bool)
is2or5smooth Exp Int
len
  in
  if Exp Int
len Exp Int -> Exp Int -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
<= Exp Int
1 then Acc (Array (sh :. Int) (Complex e))
arr                        else
  if Exp Bool
pow2     then Mode
-> Acc (Array (sh :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
forall sh e.
(Shape sh, Slice sh, Numeric e) =>
Mode
-> Acc (Array (sh :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
ditSplitRadixLoop Mode
mode Acc (Array (sh :. Int) (Complex e))
arr else
  if Exp Bool
smooth5  then Mode
-> Acc (Array (sh :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
forall sh e.
(Shape sh, Slice sh, Numeric e) =>
Mode
-> Acc (Array (sh :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
dit235            Mode
mode Acc (Array (sh :. Int) (Complex e))
arr
              else Mode
-> Acc (Array (sh :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
forall sh e.
(Shape sh, Slice sh, Numeric e) =>
Mode
-> Acc (Array (sh :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
transformChirp235 Mode
mode Acc (Array (sh :. Int) (Complex e))
arr


-- Implementations
-- ---------------

is2or5smooth :: Exp Int -> (Exp Bool, Exp Bool)
is2or5smooth :: Exp Int -> (Exp Bool, Exp Bool)
is2or5smooth Exp Int
len =
  let maxPowerOfTwo :: Exp Int
maxPowerOfTwo = Exp Int
len Exp Int -> Exp Int -> Exp Int
forall a. Bits a => Exp a -> Exp a -> Exp a
.&. Exp Int -> Exp Int
forall a. Num a => a -> a
negate Exp Int
len
      lenOdd :: Exp Int
lenOdd        = Exp Int
len Exp Int -> Exp Int -> Exp Int
forall a. Integral a => a -> a -> a
`quot` Exp Int
maxPowerOfTwo
  in
  ( Exp Int
1 Exp Int -> Exp Int -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Int
lenOdd
  , Exp Int
1 Exp Int -> Exp Int -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Int -> Exp Int -> Exp Int
divideMaxPower Exp Int
5 (Exp Int -> Exp Int -> Exp Int
divideMaxPower Exp Int
3 Exp Int
lenOdd)
  )

divideMaxPower :: Exp Int -> Exp Int -> Exp Int
divideMaxPower :: Exp Int -> Exp Int -> Exp Int
divideMaxPower Exp Int
fac =
  (Exp Int -> Exp Bool) -> (Exp Int -> Exp Int) -> Exp Int -> Exp Int
forall e.
Elt e =>
(Exp e -> Exp Bool) -> (Exp e -> Exp e) -> Exp e -> Exp e
while (\Exp Int
n -> Exp Int
n Exp Int -> Exp Int -> Exp Int
forall a. Integral a => a -> a -> a
`rem`  Exp Int
fac Exp Int -> Exp Int -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Int
0)
        (\Exp Int
n -> Exp Int
n Exp Int -> Exp Int -> Exp Int
forall a. Integral a => a -> a -> a
`quot` Exp Int
fac)


-- -- | Split-radix for power-of-two sizes
-- --
-- ditSplitRadix
--     :: (Shape sh, Numeric e)
--     => Mode
--     -> Acc (Array (sh:.Int) (Complex e))
--     -> Acc (Array (sh:.Int) (Complex e))
-- ditSplitRadix mode arr =
--   if indexHead (shape arr) <= 1
--     then arr
--     else ditSplitRadixLoop mode arr

ditSplitRadixLoop
    :: forall sh e. (Shape sh, Slice sh, Numeric e)
    => Mode
    -> Acc (Array (sh:.Int) (Complex e))
    -> Acc (Array (sh:.Int) (Complex e))
ditSplitRadixLoop :: Mode
-> Acc (Array (sh :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
ditSplitRadixLoop Mode
mode Acc (Array (sh :. Int) (Complex e))
arr =
  let
      twiddleSR :: Exp a -> Exp b -> Exp a -> c (Plain (Complex (Exp b)))
twiddleSR (Exp a -> Exp b
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral -> Exp b
n4) Exp b
k (Exp a -> Exp b
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral -> Exp b
j) =
        let w :: Exp b
w = Exp b
forall a. Floating a => a
pi Exp b -> Exp b -> Exp b
forall a. Num a => a -> a -> a
* Exp b
k Exp b -> Exp b -> Exp b
forall a. Num a => a -> a -> a
* Exp b
j Exp b -> Exp b -> Exp b
forall a. Fractional a => a -> a -> a
/ (Exp b
2Exp b -> Exp b -> Exp b
forall a. Num a => a -> a -> a
*Exp b
n4)
        in  Complex (Exp b) -> c (Plain (Complex (Exp b)))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp b -> Exp b
forall a. Floating a => a -> a
cos Exp b
w Exp b -> Exp b -> Complex (Exp b)
forall a. a -> a -> Complex a
:+ Mode -> Exp b
forall a. Num a => Mode -> a
signOfMode Mode
mode Exp b -> Exp b -> Exp b
forall a. Num a => a -> a -> a
* Exp b -> Exp b
forall a. Floating a => a -> a
sin Exp b
w)

      twiddle :: Exp a -> Exp b -> Acc (Array (Z :. a) (Complex b))
twiddle Exp a
len4 Exp b
k =
        Exp (Z :. a)
-> (Exp (Z :. a) -> Exp (Complex b))
-> Acc (Array (Z :. a) (Complex b))
forall sh a.
(Shape sh, Elt a) =>
Exp sh -> (Exp sh -> Exp a) -> Acc (Array sh a)
generate (Exp a -> Exp (Z :. a)
forall i. Elt i => Exp i -> Exp (Z :. i)
index1 Exp a
len4) (Exp a -> Exp b -> Exp a -> Exp (Complex b)
forall a b a (c :: * -> *).
(FromIntegral a b, FromIntegral a b, Ord a, Ord a,
 Integral (Exp a), Integral (Exp a), Lift c (Complex (Exp b)),
 Floating (Exp b), Elt b) =>
Exp a -> Exp b -> Exp a -> c (Complex b)
twiddleSR Exp a
len4 Exp b
k (Exp a -> Exp (Complex b))
-> (Exp (Z :. a) -> Exp a) -> Exp (Z :. a) -> Exp (Complex b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp (Z :. a) -> Exp a
forall sh a. (Elt sh, Elt a) => Exp (sh :. a) -> Exp a
indexHead)

      step :: c (Plain
     (Acc (Array ((sh :. Int) :. Int) (Complex a)),
      Acc (Array ((sh :. Int) :. Int) (Complex a))))
-> c (Plain
        (Acc (Array ((sh :. Int) :. Int) (Complex a)),
         Acc (Array ((sh :. Int) :. Int) (Complex a))))
step (c (Plain
     (Acc (Array ((sh :. Int) :. Int) (Complex a)),
      Acc (Array ((sh :. Int) :. Int) (Complex a))))
-> (Acc (Array ((sh :. Int) :. Int) (Complex a)),
    Acc (Array ((sh :. Int) :. Int) (Complex a)))
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift -> (Acc (Array ((sh :. Int) :. Int) (Complex a))
us,Acc (Array ((sh :. Int) :. Int) (Complex a))
zs)) =
        let
            k :: Exp Int
k           = Exp ((sh :. Int) :. Int) -> Exp Int
forall sh a. (Elt sh, Elt a) => Exp (sh :. a) -> Exp a
indexHead (Acc (Array ((sh :. Int) :. Int) (Complex a))
-> Exp ((sh :. Int) :. Int)
forall sh e. (Shape sh, Elt e) => Acc (Array sh e) -> Exp sh
shape Acc (Array ((sh :. Int) :. Int) (Complex a))
zs)
            tw1 :: Acc (Array (Z :. Int) (Complex a))
tw1         = Exp Int -> Exp a -> Acc (Array (Z :. Int) (Complex a))
forall a b.
(Shape (Z :. a), FromIntegral a b, Ord a, Integral (Exp a),
 Floating (Exp b), Elt b) =>
Exp a -> Exp b -> Acc (Array (Z :. a) (Complex b))
twiddle Exp Int
k Exp a
1
            tw3 :: Acc (Array (Z :. Int) (Complex a))
tw3         = Exp Int -> Exp a -> Acc (Array (Z :. Int) (Complex a))
forall a b.
(Shape (Z :. a), FromIntegral a b, Ord a, Integral (Exp a),
 Floating (Exp b), Elt b) =>
Exp a -> Exp b -> Acc (Array (Z :. a) (Complex b))
twiddle Exp Int
k Exp a
3
            --
            im :: Exp (Plain (Complex (Exp a)))
im          = Complex (Exp a) -> Exp (Plain (Complex (Exp a)))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp a
0 Exp a -> Exp a -> Complex (Exp a)
forall a. a -> a -> Complex a
:+ Mode -> Exp a
forall a. Num a => Mode -> a
signOfMode Mode
mode)
            twidZeven :: Acc (Array ((sh :. Int) :. Int) (Complex a))
twidZeven   = (Exp (Complex a) -> Exp (Complex a) -> Exp (Complex a))
-> Acc (Array (Z :. Int) (Complex a))
-> Acc (Array ((sh :. Int) :. Int) (Complex a))
-> Acc (Array ((sh :. Int) :. Int) (Complex a))
forall sh a b c.
(Shape sh, Slice sh, Elt a, Elt b, Elt c) =>
(Exp a -> Exp b -> Exp c)
-> Acc (Array (Z :. Int) a)
-> Acc (Array (sh :. Int) b)
-> Acc (Array (sh :. Int) c)
zipWithExtrude1 Exp (Complex a) -> Exp (Complex a) -> Exp (Complex a)
forall a. Num a => a -> a -> a
(*) Acc (Array (Z :. Int) (Complex a))
tw1 (Exp Int
-> Exp Int
-> Acc (Array ((sh :. Int) :. Int) (Complex a))
-> Acc (Array ((sh :. Int) :. Int) (Complex a))
forall sh e.
(Shape sh, Elt e) =>
Exp Int
-> Exp Int
-> Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
sieveV Exp Int
2 Exp Int
0 Acc (Array ((sh :. Int) :. Int) (Complex a))
zs)
            twidZodd :: Acc (Array ((sh :. Int) :. Int) (Complex a))
twidZodd    = (Exp (Complex a) -> Exp (Complex a) -> Exp (Complex a))
-> Acc (Array (Z :. Int) (Complex a))
-> Acc (Array ((sh :. Int) :. Int) (Complex a))
-> Acc (Array ((sh :. Int) :. Int) (Complex a))
forall sh a b c.
(Shape sh, Slice sh, Elt a, Elt b, Elt c) =>
(Exp a -> Exp b -> Exp c)
-> Acc (Array (Z :. Int) a)
-> Acc (Array (sh :. Int) b)
-> Acc (Array (sh :. Int) c)
zipWithExtrude1 Exp (Complex a) -> Exp (Complex a) -> Exp (Complex a)
forall a. Num a => a -> a -> a
(*) Acc (Array (Z :. Int) (Complex a))
tw3 (Exp Int
-> Exp Int
-> Acc (Array ((sh :. Int) :. Int) (Complex a))
-> Acc (Array ((sh :. Int) :. Int) (Complex a))
forall sh e.
(Shape sh, Elt e) =>
Exp Int
-> Exp Int
-> Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
sieveV Exp Int
2 Exp Int
1 Acc (Array ((sh :. Int) :. Int) (Complex a))
zs)
            zsum :: Acc (Array ((sh :. Int) :. Int) (Complex a))
zsum        = (Exp (Complex a) -> Exp (Complex a) -> Exp (Complex a))
-> Acc (Array ((sh :. Int) :. Int) (Complex a))
-> Acc (Array ((sh :. Int) :. Int) (Complex a))
-> Acc (Array ((sh :. Int) :. Int) (Complex a))
forall sh a b c.
(Shape sh, Elt a, Elt b, Elt c) =>
(Exp a -> Exp b -> Exp c)
-> Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c)
zipWith Exp (Complex a) -> Exp (Complex a) -> Exp (Complex a)
forall a. Num a => a -> a -> a
(+) Acc (Array ((sh :. Int) :. Int) (Complex a))
twidZeven Acc (Array ((sh :. Int) :. Int) (Complex a))
twidZodd
            zdiff :: Acc (Array ((sh :. Int) :. Int) (Complex a))
zdiff       = (Exp (Complex a) -> Exp (Complex a))
-> Acc (Array ((sh :. Int) :. Int) (Complex a))
-> Acc (Array ((sh :. Int) :. Int) (Complex a))
forall sh a b.
(Shape sh, Elt a, Elt b) =>
(Exp a -> Exp b) -> Acc (Array sh a) -> Acc (Array sh b)
map (Exp (Complex a)
im Exp (Complex a) -> Exp (Complex a) -> Exp (Complex a)
forall a. Num a => a -> a -> a
*) ((Exp (Complex a) -> Exp (Complex a) -> Exp (Complex a))
-> Acc (Array ((sh :. Int) :. Int) (Complex a))
-> Acc (Array ((sh :. Int) :. Int) (Complex a))
-> Acc (Array ((sh :. Int) :. Int) (Complex a))
forall sh a b c.
(Shape sh, Elt a, Elt b, Elt c) =>
(Exp a -> Exp b -> Exp c)
-> Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c)
zipWith (-) Acc (Array ((sh :. Int) :. Int) (Complex a))
twidZeven Acc (Array ((sh :. Int) :. Int) (Complex a))
twidZodd)
            zcomplete :: Acc (Array ((sh :. Int) :. Int) (Complex a))
zcomplete   = Acc (Array ((sh :. Int) :. Int) (Complex a))
zsum Acc (Array ((sh :. Int) :. Int) (Complex a))
-> Acc (Array ((sh :. Int) :. Int) (Complex a))
-> Acc (Array ((sh :. Int) :. Int) (Complex a))
forall sh e.
(Shape sh, Elt e) =>
Acc (Array (sh :. Int) e)
-> Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int) e)
++ Acc (Array ((sh :. Int) :. Int) (Complex a))
zdiff
            Exp sh
_ :. Exp Int
n :. Exp Int
_ = Exp (Plain ((Exp sh :. Exp Int) :. Exp Int))
-> (Exp sh :. Exp Int) :. Exp Int
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift (Acc (Array ((sh :. Int) :. Int) (Complex a))
-> Exp ((sh :. Int) :. Int)
forall sh e. (Shape sh, Elt e) => Acc (Array sh e) -> Exp sh
shape Acc (Array ((sh :. Int) :. Int) (Complex a))
zcomplete) :: Exp sh :. Exp Int :. Exp Int
        in
        (Acc (Array ((sh :. Int) :. Int) (Complex a)),
 Acc (Array ((sh :. Int) :. Int) (Complex a)))
-> c (Plain
        (Acc (Array ((sh :. Int) :. Int) (Complex a)),
         Acc (Array ((sh :. Int) :. Int) (Complex a))))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift ( (Exp (Complex a) -> Exp (Complex a) -> Exp (Complex a))
-> Acc (Array ((sh :. Int) :. Int) (Complex a))
-> Acc (Array ((sh :. Int) :. Int) (Complex a))
-> Acc (Array ((sh :. Int) :. Int) (Complex a))
forall sh a b c.
(Shape sh, Elt a, Elt b, Elt c) =>
(Exp a -> Exp b -> Exp c)
-> Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c)
zipWith Exp (Complex a) -> Exp (Complex a) -> Exp (Complex a)
forall a. Num a => a -> a -> a
(+) Acc (Array ((sh :. Int) :. Int) (Complex a))
us Acc (Array ((sh :. Int) :. Int) (Complex a))
zcomplete Acc (Array ((sh :. Int) :. Int) (Complex a))
-> Acc (Array ((sh :. Int) :. Int) (Complex a))
-> Acc (Array ((sh :. Int) :. Int) (Complex a))
forall sh e.
(Shape sh, Elt e) =>
Acc (Array (sh :. Int) e)
-> Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int) e)
++ (Exp (Complex a) -> Exp (Complex a) -> Exp (Complex a))
-> Acc (Array ((sh :. Int) :. Int) (Complex a))
-> Acc (Array ((sh :. Int) :. Int) (Complex a))
-> Acc (Array ((sh :. Int) :. Int) (Complex a))
forall sh a b c.
(Shape sh, Elt a, Elt b, Elt c) =>
(Exp a -> Exp b -> Exp c)
-> Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c)
zipWith (-) Acc (Array ((sh :. Int) :. Int) (Complex a))
us Acc (Array ((sh :. Int) :. Int) (Complex a))
zcomplete
             , Exp Int
-> Acc (Array ((sh :. Int) :. Int) (Complex a))
-> Acc (Array ((sh :. Int) :. Int) (Complex a))
forall sh e.
(Shape sh, Elt e) =>
Exp Int
-> Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
dropV Exp Int
n Acc (Array ((sh :. Int) :. Int) (Complex a))
us
             )

      rebase :: Acc (Array (sh :. Int) e, b)
-> c (Plain (Acc (Array (sh :. Int) e), Acc b))
rebase Acc (Array (sh :. Int) e, b)
s = (Acc (Array (sh :. Int) e), Acc b)
-> c (Plain (Acc (Array (sh :. Int) e), Acc b))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp e -> Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int) e)
forall sh e.
(Shape sh, Num e) =>
Exp e -> Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int) e)
transform2 (-Exp e
1) (Acc (Array (sh :. Int) e, b) -> Acc (Array (sh :. Int) e)
forall a b. (Arrays a, Arrays b) => Acc (a, b) -> Acc a
afst Acc (Array (sh :. Int) e, b)
s), Acc (Array (sh :. Int) e, b) -> Acc b
forall a b. (Arrays a, Arrays b) => Acc (a, b) -> Acc b
asnd Acc (Array (sh :. Int) e, b)
s)

      reorder :: c (Plain
     (Acc (Array ((sh :. Int) :. Int) e),
      Acc (Array ((sh :. Int) :. Int) e)))
-> c (Plain
        (Acc (Array ((sh :. Int) :. Int) e),
         Acc (Array ((sh :. Int) :. Int) e)))
reorder (c (Plain
     (Acc (Array ((sh :. Int) :. Int) e),
      Acc (Array ((sh :. Int) :. Int) e)))
-> (Acc (Array ((sh :. Int) :. Int) e),
    Acc (Array ((sh :. Int) :. Int) e))
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift -> (Acc (Array ((sh :. Int) :. Int) e)
xs,Acc (Array ((sh :. Int) :. Int) e)
ys)) =
        let evens :: Acc (Array ((sh :. Int) :. Int) e)
evens = Exp Int
-> Exp Int
-> Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
forall sh e.
(Shape sh, Elt e) =>
Exp Int
-> Exp Int
-> Acc (Array (sh :. Int) e)
-> Acc (Array (sh :. Int) e)
sieve Exp Int
2 Exp Int
0 Acc (Array ((sh :. Int) :. Int) e)
xs
            odds :: Acc (Array ((sh :. Int) :. Int) e)
odds  = Exp Int
-> Exp Int
-> Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
forall sh e.
(Shape sh, Elt e) =>
Exp Int
-> Exp Int
-> Acc (Array (sh :. Int) e)
-> Acc (Array (sh :. Int) e)
sieve Exp Int
2 Exp Int
1 Acc (Array ((sh :. Int) :. Int) e)
xs
        in
        (Acc (Array ((sh :. Int) :. Int) e),
 Acc (Array ((sh :. Int) :. Int) e))
-> c (Plain
        (Acc (Array ((sh :. Int) :. Int) e),
         Acc (Array ((sh :. Int) :. Int) e)))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Acc (Array ((sh :. Int) :. Int) e)
evens Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
forall sh e.
(Shape sh, Elt e) =>
Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
++^ Acc (Array ((sh :. Int) :. Int) e)
ys, Exp Int
-> Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
forall sh e.
(Shape sh, Elt e) =>
Exp Int
-> Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
twist Exp Int
2 Acc (Array ((sh :. Int) :. Int) e)
odds)

      initial :: Acc
  (Plain
     (Acc (Array ((sh :. Int) :. Int) (Complex e)),
      Acc (Array ((sh :. Int) :. Int) (Complex e))))
initial =
        let Exp sh
sh :. Exp Int
n = Exp (Plain (Exp sh :. Exp Int)) -> Exp sh :. Exp Int
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift (Acc (Array (sh :. Int) (Complex e)) -> Exp (sh :. Int)
forall sh e. (Shape sh, Elt e) => Acc (Array sh e) -> Exp sh
shape Acc (Array (sh :. Int) (Complex e))
arr) :: Exp sh :. Exp Int
        in  (Acc (Array ((sh :. Int) :. Int) (Complex e)),
 Acc (Array ((sh :. Int) :. Int) (Complex e)))
-> Acc
     (Plain
        (Acc (Array ((sh :. Int) :. Int) (Complex e)),
         Acc (Array ((sh :. Int) :. Int) (Complex e))))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift ( Exp ((sh :. Int) :. Int)
-> Acc (Array (sh :. Int) (Complex e))
-> Acc (Array ((sh :. Int) :. Int) (Complex e))
forall sh sh' e.
(Shape sh, Shape sh', Elt e) =>
Exp sh -> Acc (Array sh' e) -> Acc (Array sh e)
reshape (((Exp sh :. Exp Int) :. Exp Int)
-> Exp (Plain ((Exp sh :. Exp Int) :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh
sh Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
1 (Exp sh :. Exp Int) -> Exp Int -> (Exp sh :. Exp Int) :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
n)) Acc (Array (sh :. Int) (Complex e))
arr
                 , Exp ((sh :. Int) :. Int)
-> Exp (Complex e) -> Acc (Array ((sh :. Int) :. Int) (Complex e))
forall sh e.
(Shape sh, Elt e) =>
Exp sh -> Exp e -> Acc (Array sh e)
fill    (((Exp sh :. Exp Int) :. Exp Int)
-> Exp (Plain ((Exp sh :. Exp Int) :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh
sh Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
0 (Exp sh :. Exp Int) -> Exp Int -> (Exp sh :. Exp Int) :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
n Exp Int -> Exp Int -> Exp Int
forall a. Integral a => a -> a -> a
`quot` Exp Int
2)) Exp (Complex e)
0
                 )
  in
  Acc (Array ((sh :. Int) :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
forall sh e.
(Shape sh, Elt e) =>
Acc (Array ((sh :. Int) :. Int) e) -> Acc (Array (sh :. Int) e)
headV
    (Acc (Array ((sh :. Int) :. Int) (Complex e))
 -> Acc (Array (sh :. Int) (Complex e)))
-> Acc (Array ((sh :. Int) :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
forall a b. (a -> b) -> a -> b
$ Acc
  (Array ((sh :. Int) :. Int) (Complex e),
   Array ((sh :. Int) :. Int) (Complex e))
-> Acc (Array ((sh :. Int) :. Int) (Complex e))
forall a b. (Arrays a, Arrays b) => Acc (a, b) -> Acc a
afst
    (Acc
   (Array ((sh :. Int) :. Int) (Complex e),
    Array ((sh :. Int) :. Int) (Complex e))
 -> Acc (Array ((sh :. Int) :. Int) (Complex e)))
-> Acc
     (Array ((sh :. Int) :. Int) (Complex e),
      Array ((sh :. Int) :. Int) (Complex e))
-> Acc (Array ((sh :. Int) :. Int) (Complex e))
forall a b. (a -> b) -> a -> b
$ (Acc
   (Array ((sh :. Int) :. Int) (Complex e),
    Array ((sh :. Int) :. Int) (Complex e))
 -> Acc (Scalar Bool))
-> (Acc
      (Array ((sh :. Int) :. Int) (Complex e),
       Array ((sh :. Int) :. Int) (Complex e))
    -> Acc
         (Array ((sh :. Int) :. Int) (Complex e),
          Array ((sh :. Int) :. Int) (Complex e)))
-> Acc
     (Array ((sh :. Int) :. Int) (Complex e),
      Array ((sh :. Int) :. Int) (Complex e))
-> Acc
     (Array ((sh :. Int) :. Int) (Complex e),
      Array ((sh :. Int) :. Int) (Complex e))
forall a.
Arrays a =>
(Acc a -> Acc (Scalar Bool)) -> (Acc a -> Acc a) -> Acc a -> Acc a
awhile (\Acc
  (Array ((sh :. Int) :. Int) (Complex e),
   Array ((sh :. Int) :. Int) (Complex e))
s -> Exp Bool -> Acc (Scalar Bool)
forall e. Elt e => Exp e -> Acc (Scalar e)
unit (Exp (sh :. Int) -> Exp Int
forall sh a. (Elt sh, Elt a) => Exp (sh :. a) -> Exp a
indexHead (Exp ((sh :. Int) :. Int) -> Exp (sh :. Int)
forall sh a. (Elt sh, Elt a) => Exp (sh :. a) -> Exp sh
indexTail (Acc (Array ((sh :. Int) :. Int) (Complex e))
-> Exp ((sh :. Int) :. Int)
forall sh e. (Shape sh, Elt e) => Acc (Array sh e) -> Exp sh
shape (Acc
  (Array ((sh :. Int) :. Int) (Complex e),
   Array ((sh :. Int) :. Int) (Complex e))
-> Acc (Array ((sh :. Int) :. Int) (Complex e))
forall a b. (Arrays a, Arrays b) => Acc (a, b) -> Acc b
asnd Acc
  (Array ((sh :. Int) :. Int) (Complex e),
   Array ((sh :. Int) :. Int) (Complex e))
s))) Exp Int -> Exp Int -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
> Exp Int
0)) Acc
  (Array ((sh :. Int) :. Int) (Complex e),
   Array ((sh :. Int) :. Int) (Complex e))
-> Acc
     (Array ((sh :. Int) :. Int) (Complex e),
      Array ((sh :. Int) :. Int) (Complex e))
forall (c :: * -> *) a (c :: * -> *).
(Unlift
   c
   (Acc (Array ((sh :. Int) :. Int) (Complex a)),
    Acc (Array ((sh :. Int) :. Int) (Complex a))),
 Lift
   c
   (Acc (Array ((sh :. Int) :. Int) (Complex a)),
    Acc (Array ((sh :. Int) :. Int) (Complex a))),
 FromIntegral Int a, RealFloat a) =>
c (Array ((sh :. Int) :. Int) (Complex a),
   Array ((sh :. Int) :. Int) (Complex a))
-> c (Array ((sh :. Int) :. Int) (Complex a),
      Array ((sh :. Int) :. Int) (Complex a))
step
    (Acc
   (Array ((sh :. Int) :. Int) (Complex e),
    Array ((sh :. Int) :. Int) (Complex e))
 -> Acc
      (Array ((sh :. Int) :. Int) (Complex e),
       Array ((sh :. Int) :. Int) (Complex e)))
-> Acc
     (Array ((sh :. Int) :. Int) (Complex e),
      Array ((sh :. Int) :. Int) (Complex e))
-> Acc
     (Array ((sh :. Int) :. Int) (Complex e),
      Array ((sh :. Int) :. Int) (Complex e))
forall a b. (a -> b) -> a -> b
$ Acc
  (Array ((sh :. Int) :. Int) (Complex e),
   Array ((sh :. Int) :. Int) (Complex e))
-> Acc
     (Array ((sh :. Int) :. Int) (Complex e),
      Array ((sh :. Int) :. Int) (Complex e))
forall (c :: * -> *) sh e b.
(Lift c (Acc (Array (sh :. Int) e), Acc b), Shape sh, Num (Exp e),
 Arrays b, Elt e) =>
Acc (Array (sh :. Int) e, b) -> c (Array (sh :. Int) e, b)
rebase
    (Acc
   (Array ((sh :. Int) :. Int) (Complex e),
    Array ((sh :. Int) :. Int) (Complex e))
 -> Acc
      (Array ((sh :. Int) :. Int) (Complex e),
       Array ((sh :. Int) :. Int) (Complex e)))
-> Acc
     (Array ((sh :. Int) :. Int) (Complex e),
      Array ((sh :. Int) :. Int) (Complex e))
-> Acc
     (Array ((sh :. Int) :. Int) (Complex e),
      Array ((sh :. Int) :. Int) (Complex e))
forall a b. (a -> b) -> a -> b
$ (Acc
   (Array ((sh :. Int) :. Int) (Complex e),
    Array ((sh :. Int) :. Int) (Complex e))
 -> Acc (Scalar Bool))
-> (Acc
      (Array ((sh :. Int) :. Int) (Complex e),
       Array ((sh :. Int) :. Int) (Complex e))
    -> Acc
         (Array ((sh :. Int) :. Int) (Complex e),
          Array ((sh :. Int) :. Int) (Complex e)))
-> Acc
     (Array ((sh :. Int) :. Int) (Complex e),
      Array ((sh :. Int) :. Int) (Complex e))
-> Acc
     (Array ((sh :. Int) :. Int) (Complex e),
      Array ((sh :. Int) :. Int) (Complex e))
forall a.
Arrays a =>
(Acc a -> Acc (Scalar Bool)) -> (Acc a -> Acc a) -> Acc a -> Acc a
awhile (\Acc
  (Array ((sh :. Int) :. Int) (Complex e),
   Array ((sh :. Int) :. Int) (Complex e))
s -> Exp Bool -> Acc (Scalar Bool)
forall e. Elt e => Exp e -> Acc (Scalar e)
unit (Exp ((sh :. Int) :. Int) -> Exp Int
forall sh a. (Elt sh, Elt a) => Exp (sh :. a) -> Exp a
indexHead (Acc (Array ((sh :. Int) :. Int) (Complex e))
-> Exp ((sh :. Int) :. Int)
forall sh e. (Shape sh, Elt e) => Acc (Array sh e) -> Exp sh
shape (Acc
  (Array ((sh :. Int) :. Int) (Complex e),
   Array ((sh :. Int) :. Int) (Complex e))
-> Acc (Array ((sh :. Int) :. Int) (Complex e))
forall a b. (Arrays a, Arrays b) => Acc (a, b) -> Acc b
asnd Acc
  (Array ((sh :. Int) :. Int) (Complex e),
   Array ((sh :. Int) :. Int) (Complex e))
s)) Exp Int -> Exp Int -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
> Exp Int
1)) Acc
  (Array ((sh :. Int) :. Int) (Complex e),
   Array ((sh :. Int) :. Int) (Complex e))
-> Acc
     (Array ((sh :. Int) :. Int) (Complex e),
      Array ((sh :. Int) :. Int) (Complex e))
forall (c :: * -> *) sh e (c :: * -> *).
(Unlift
   c
   (Acc (Array ((sh :. Int) :. Int) e),
    Acc (Array ((sh :. Int) :. Int) e)),
 Lift
   c
   (Acc (Array ((sh :. Int) :. Int) e),
    Acc (Array ((sh :. Int) :. Int) e)),
 Shape sh, Elt e) =>
c (Array ((sh :. Int) :. Int) e, Array ((sh :. Int) :. Int) e)
-> c (Array ((sh :. Int) :. Int) e, Array ((sh :. Int) :. Int) e)
reorder
    (Acc
   (Array ((sh :. Int) :. Int) (Complex e),
    Array ((sh :. Int) :. Int) (Complex e))
 -> Acc
      (Array ((sh :. Int) :. Int) (Complex e),
       Array ((sh :. Int) :. Int) (Complex e)))
-> Acc
     (Array ((sh :. Int) :. Int) (Complex e),
      Array ((sh :. Int) :. Int) (Complex e))
-> Acc
     (Array ((sh :. Int) :. Int) (Complex e),
      Array ((sh :. Int) :. Int) (Complex e))
forall a b. (a -> b) -> a -> b
$ Acc
  (Array ((sh :. Int) :. Int) (Complex e),
   Array ((sh :. Int) :. Int) (Complex e))
initial


-- | Decimation in time for sizes that are composites of the factors 2,3 and 5.
-- These sizes are known as 5-smooth numbers or the Hamming sequence.
--
-- <http://oeis.org/A051037>
--
dit235
    :: forall sh e. (Shape sh, Slice sh, Numeric e)
    => Mode
    -> Acc (Array (sh:.Int) (Complex e))
    -> Acc (Array (sh:.Int) (Complex e))
dit235 :: Mode
-> Acc (Array (sh :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
dit235 Mode
mode Acc (Array (sh :. Int) (Complex e))
arr =
  let
      merge :: forall sh' a. (Shape sh', Elt a)
            => Acc (Array (sh':.Int:.Int) a)
            -> Acc (Array (sh':.Int) a)
      merge :: Acc (Array ((sh' :. Int) :. Int) a) -> Acc (Array (sh' :. Int) a)
merge Acc (Array ((sh' :. Int) :. Int) a)
xs =
        let Exp sh'
sh :. Exp Int
m :. Exp Int
n = Exp (Plain ((Exp sh' :. Exp Int) :. Exp Int))
-> (Exp sh' :. Exp Int) :. Exp Int
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift (Acc (Array ((sh' :. Int) :. Int) a) -> Exp ((sh' :. Int) :. Int)
forall sh e. (Shape sh, Elt e) => Acc (Array sh e) -> Exp sh
shape Acc (Array ((sh' :. Int) :. Int) a)
xs) :: Exp sh' :. Exp Int :. Exp Int
        in  Exp (sh' :. Int)
-> (Exp (sh' :. Int) -> Exp ((sh' :. Int) :. Int))
-> Acc (Array ((sh' :. Int) :. Int) a)
-> Acc (Array (sh' :. Int) a)
forall sh sh' a.
(Shape sh, Shape sh', Elt a) =>
Exp sh'
-> (Exp sh' -> Exp sh) -> Acc (Array sh a) -> Acc (Array sh' a)
backpermute
              ((Exp sh' :. Exp Int) -> Exp (Plain (Exp sh' :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh'
sh Exp sh' -> Exp Int -> Exp sh' :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
mExp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
*Exp Int
n))
              (\(Exp (sh' :. Int) -> Exp sh' :. Exp Int
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift -> Exp sh'
ix :. Exp Int
k :: Exp sh' :. Exp Int) ->
                  let (Exp Int
q,Exp Int
r) = Exp Int
k Exp Int -> Exp Int -> (Exp Int, Exp Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Exp Int
m
                  in  ((Exp sh' :. Exp Int) :. Exp Int)
-> Exp (Plain ((Exp sh' :. Exp Int) :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh'
ix Exp sh' -> Exp Int -> Exp sh' :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
r (Exp sh' :. Exp Int) -> Exp Int -> (Exp sh' :. Exp Int) :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
q))
              Acc (Array ((sh' :. Int) :. Int) a)
xs

      step :: Exp Int
-> Acc (Array ((sh :. Int) :. Int) (Complex e))
-> Acc (Array ((sh :. Int) :. Int) (Complex e))
step Exp Int
fac Acc (Array ((sh :. Int) :. Int) (Complex e))
xs =
        let Exp sh
sh :. Exp Int
count :. Exp Int
len = Exp (Plain ((Exp sh :. Exp Int) :. Exp Int))
-> (Exp sh :. Exp Int) :. Exp Int
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift (Acc (Array ((sh :. Int) :. Int) (Complex e))
-> Exp ((sh :. Int) :. Int)
forall sh e. (Shape sh, Elt e) => Acc (Array sh e) -> Exp sh
shape Acc (Array ((sh :. Int) :. Int) (Complex e))
xs) :: Exp sh :. Exp Int :. Exp Int
            --
            twiddled :: Acc (Array (sh:.Int:.Int:.Int) (Complex e))
            twiddled :: Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e))
twiddled = Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e))
-> Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e))
forall sh e.
(Shape sh, Elt e) =>
Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
transpose
                     (Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e))
 -> Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e)))
-> Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e))
-> Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e))
forall a b. (a -> b) -> a -> b
$ (Exp (Complex e) -> Exp (Complex e) -> Exp (Complex e))
-> Acc (Array DIM2 (Complex e))
-> Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e))
-> Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e))
forall sh a b c.
(Shape sh, Slice sh, Elt a, Elt b, Elt c) =>
(Exp a -> Exp b -> Exp c)
-> Acc (Array DIM2 a)
-> Acc (Array ((sh :. Int) :. Int) b)
-> Acc (Array ((sh :. Int) :. Int) c)
zipWithExtrude2 Exp (Complex e) -> Exp (Complex e) -> Exp (Complex e)
forall a. Num a => a -> a -> a
(*) (Exp Int -> Exp Int -> Acc (Array DIM2 (Complex e))
twiddleFactors Exp Int
fac Exp Int
len)
                     (Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e))
 -> Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e)))
-> Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e))
-> Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e))
forall a b. (a -> b) -> a -> b
$ Exp (((sh :. Int) :. Int) :. Int)
-> Acc (Array ((sh :. Int) :. Int) (Complex e))
-> Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e))
forall sh sh' e.
(Shape sh, Shape sh', Elt e) =>
Exp sh -> Acc (Array sh' e) -> Acc (Array sh e)
reshape ((((Exp sh :. Exp Int) :. Exp Int) :. Exp Int)
-> Exp (Plain (((Exp sh :. Exp Int) :. Exp Int) :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh
sh Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
count Exp Int -> Exp Int -> Exp Int
forall a. Integral a => a -> a -> a
`quot` Exp Int
fac (Exp sh :. Exp Int) -> Exp Int -> (Exp sh :. Exp Int) :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
fac ((Exp sh :. Exp Int) :. Exp Int)
-> Exp Int -> ((Exp sh :. Exp Int) :. Exp Int) :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
len)) Acc (Array ((sh :. Int) :. Int) (Complex e))
xs
        in
        Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e))
-> Acc (Array ((sh :. Int) :. Int) (Complex e))
forall sh e.
(Shape sh, Elt e) =>
Acc (Array ((sh :. Int) :. Int) e) -> Acc (Array (sh :. Int) e)
merge (Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e))
 -> Acc (Array ((sh :. Int) :. Int) (Complex e)))
-> Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e))
-> Acc (Array ((sh :. Int) :. Int) (Complex e))
forall a b. (a -> b) -> a -> b
$ if Exp Int
fac Exp Int -> Exp Int -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Int
5 then Exp (Complex e, Complex e, Complex e, Complex e)
-> Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e))
-> Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e))
forall sh e.
(Shape sh, Num e) =>
Exp (e, e, e, e)
-> Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int) e)
transform5 Exp (Complex e, Complex e, Complex e, Complex e)
cache5 Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e))
twiddled else
                if Exp Int
fac Exp Int -> Exp Int -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Int
4 then Exp (Complex e, Complex e, Complex e)
-> Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e))
-> Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e))
forall sh e.
(Shape sh, Num e) =>
Exp (e, e, e)
-> Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int) e)
transform4 Exp (Complex e, Complex e, Complex e)
cache4 Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e))
twiddled else
                if Exp Int
fac Exp Int -> Exp Int -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Int
3 then Exp (Complex e, Complex e)
-> Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e))
-> Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e))
forall sh e.
(Shape sh, Num e) =>
Exp (e, e)
-> Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int) e)
transform3 Exp (Complex e, Complex e)
cache3 Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e))
twiddled
                            else Exp (Complex e)
-> Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e))
-> Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e))
forall sh e.
(Shape sh, Num e) =>
Exp e -> Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int) e)
transform2 Exp (Complex e)
cache2 Acc (Array (((sh :. Int) :. Int) :. Int) (Complex e))
twiddled

      initial :: Acc (Array (sh:.Int:.Int) (Complex e), Vector Int)
      initial :: Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
initial =
        let Exp sh
sh :. Exp Int
n = Exp (Plain (Exp sh :. Exp Int)) -> Exp sh :. Exp Int
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift (Acc (Array (sh :. Int) (Complex e)) -> Exp (sh :. Int)
forall sh e. (Shape sh, Elt e) => Acc (Array sh e) -> Exp sh
shape Acc (Array (sh :. Int) (Complex e))
arr) :: Exp sh :. Exp Int
        in  (Acc (Array ((sh :. Int) :. Int) (Complex e)), Acc (Vector Int))
-> Acc
     (Plain
        (Acc (Array ((sh :. Int) :. Int) (Complex e)), Acc (Vector Int)))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift ( Exp ((sh :. Int) :. Int)
-> Acc (Array (sh :. Int) (Complex e))
-> Acc (Array ((sh :. Int) :. Int) (Complex e))
forall sh sh' e.
(Shape sh, Shape sh', Elt e) =>
Exp sh -> Acc (Array sh' e) -> Acc (Array sh e)
reshape (((Exp sh :. Exp Int) :. Exp Int)
-> Exp (Plain ((Exp sh :. Exp Int) :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh
sh Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
1 (Exp sh :. Exp Int) -> Exp Int -> (Exp sh :. Exp Int) :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
n)) Acc (Array (sh :. Int) (Complex e))
arr
                 , Exp (Z :. Int) -> Exp Int -> Acc (Vector Int)
forall sh e.
(Shape sh, Elt e) =>
Exp sh -> Exp e -> Acc (Array sh e)
fill (Exp Int -> Exp (Z :. Int)
forall i. Elt i => Exp i -> Exp (Z :. i)
index1 Exp Int
0) Exp Int
0
                 )

      twiddleFactors :: Exp Int -> Exp Int -> Acc (Matrix (Complex e))
      twiddleFactors :: Exp Int -> Exp Int -> Acc (Array DIM2 (Complex e))
twiddleFactors Exp Int
m Exp Int
n =
        Exp DIM2
-> (Exp DIM2 -> Exp (Complex e)) -> Acc (Array DIM2 (Complex e))
forall sh a.
(Shape sh, Elt a) =>
Exp sh -> (Exp sh -> Exp a) -> Acc (Array sh a)
generate (Exp Int -> Exp Int -> Exp DIM2
forall i. Elt i => Exp i -> Exp i -> Exp ((Z :. i) :. i)
index2 Exp Int
m Exp Int
n)
                 (\(Exp DIM2 -> (Z :. Exp Int) :. Exp Int
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift -> Z
Z :. Exp Int
j :. Exp Int
i) -> Exp Int -> Exp Int -> Exp Int -> Exp (Complex e)
twiddle (Exp Int
mExp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
*Exp Int
n) Exp Int
j Exp Int
i)

      cisrat :: Exp Int -> Exp Int -> Exp (Complex e)
      cisrat :: Exp Int -> Exp Int -> Exp (Complex e)
cisrat Exp Int
d Exp Int
n =
        let w :: Exp e
w = Exp e
2Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
*Exp e
forall a. Floating a => a
pi Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
* Exp Int -> Exp e
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Int
n Exp e -> Exp e -> Exp e
forall a. Fractional a => a -> a -> a
/ Exp Int -> Exp e
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Int
d
        in  Complex (Exp e) -> Exp (Plain (Complex (Exp e)))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp e -> Exp e
forall a. Floating a => a -> a
cos Exp e
w Exp e -> Exp e -> Complex (Exp e)
forall a. a -> a -> Complex a
:+ Mode -> Exp e
forall a. Num a => Mode -> a
signOfMode Mode
mode Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
* Exp e -> Exp e
forall a. Floating a => a -> a
sin Exp e
w)

      twiddle :: Exp Int -> Exp Int -> Exp Int -> Exp (Complex e)
      twiddle :: Exp Int -> Exp Int -> Exp Int -> Exp (Complex e)
twiddle Exp Int
n Exp Int
k Exp Int
j = Exp Int -> Exp Int -> Exp (Complex e)
cisrat Exp Int
n ((Exp Int
kExp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
*Exp Int
j) Exp Int -> Exp Int -> Exp Int
forall a. Integral a => a -> a -> a
`rem` Exp Int
n)

      cache2 :: Exp (Complex e)
      cache2 :: Exp (Complex e)
cache2 = -Exp (Complex e)
1

      cache3 :: Exp (Complex e, Complex e)
      cache3 :: Exp (Complex e, Complex e)
cache3 =
        let sqrt3d2 :: Exp e
sqrt3d2 = Exp e -> Exp e
forall a. Floating a => a -> a
sqrt Exp e
3 Exp e -> Exp e -> Exp e
forall a. Fractional a => a -> a -> a
/ Exp e
2
            mhalf :: Exp e
mhalf   = -Exp e
1Exp e -> Exp e -> Exp e
forall a. Fractional a => a -> a -> a
/Exp e
2
            s :: Exp e
s       = Mode -> Exp e
forall a. Num a => Mode -> a
signOfMode Mode
mode
            u :: Exp e
u       = Exp e
s Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
* Exp e
sqrt3d2
        in
        (Complex (Exp e), Complex (Exp e))
-> Exp (Plain (Complex (Exp e), Complex (Exp e)))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp e
mhalf Exp e -> Exp e -> Complex (Exp e)
forall a. a -> a -> Complex a
:+ Exp e
u, Exp e
mhalf Exp e -> Exp e -> Complex (Exp e)
forall a. a -> a -> Complex a
:+ (-Exp e
u))

      cache4 :: Exp (Complex e, Complex e, Complex e)
      cache4 :: Exp (Complex e, Complex e, Complex e)
cache4 =
        let s :: Exp e
s = Mode -> Exp e
forall a. Num a => Mode -> a
signOfMode Mode
mode
        in  (Complex (Exp e), Complex (Exp e), Complex (Exp e))
-> Exp (Plain (Complex (Exp e), Complex (Exp e), Complex (Exp e)))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp e
0 Exp e -> Exp e -> Complex (Exp e)
forall a. a -> a -> Complex a
:+ Exp e
s, (-Exp e
1) Exp e -> Exp e -> Complex (Exp e)
forall a. a -> a -> Complex a
:+ (-Exp e
0), Exp e
0 Exp e -> Exp e -> Complex (Exp e)
forall a. a -> a -> Complex a
:+ (-Exp e
s))

      cache5 :: Exp (Complex e, Complex e, Complex e, Complex e)
      cache5 :: Exp (Complex e, Complex e, Complex e, Complex e)
cache5 =
        let z :: Exp Int -> Exp (Complex e)
z = Exp Int -> Exp Int -> Exp (Complex e)
cisrat Exp Int
5
        in  (Exp (Complex e), Exp (Complex e), Exp (Complex e),
 Exp (Complex e))
-> Exp
     (Plain
        (Exp (Complex e), Exp (Complex e), Exp (Complex e),
         Exp (Complex e)))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp Int -> Exp (Complex e)
z Exp Int
1, Exp Int -> Exp (Complex e)
z Exp Int
2, Exp Int -> Exp (Complex e)
z Exp Int
3, Exp Int -> Exp (Complex e)
z Exp Int
4)
  in
  Acc (Array ((sh :. Int) :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
forall sh e.
(Shape sh, Elt e) =>
Acc (Array ((sh :. Int) :. Int) e) -> Acc (Array (sh :. Int) e)
headV
    (Acc (Array ((sh :. Int) :. Int) (Complex e))
 -> Acc (Array (sh :. Int) (Complex e)))
-> Acc (Array ((sh :. Int) :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
forall a b. (a -> b) -> a -> b
$ Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
-> Acc (Array ((sh :. Int) :. Int) (Complex e))
forall a b. (Arrays a, Arrays b) => Acc (a, b) -> Acc a
afst
    (Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
 -> Acc (Array ((sh :. Int) :. Int) (Complex e)))
-> Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
-> Acc (Array ((sh :. Int) :. Int) (Complex e))
forall a b. (a -> b) -> a -> b
$ (Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
 -> Acc (Scalar Bool))
-> (Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
    -> Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int))
-> Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
-> Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
forall a.
Arrays a =>
(Acc a -> Acc (Scalar Bool)) -> (Acc a -> Acc a) -> Acc a -> Acc a
awhile
        (\Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
s -> Exp Bool -> Acc (Scalar Bool)
forall e. Elt e => Exp e -> Acc (Scalar e)
unit (Acc (Vector Int) -> Exp Int
forall e. Elt e => Acc (Vector e) -> Exp Int
length (Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
-> Acc (Vector Int)
forall a b. (Arrays a, Arrays b) => Acc (a, b) -> Acc b
asnd Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
s) Exp Int -> Exp Int -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
> Exp Int
0))
        (\Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
s -> let (Acc (Array ((sh :. Int) :. Int) (Complex e))
xs,Acc (Vector Int)
fs) = Acc
  (Plain
     (Acc (Array ((sh :. Int) :. Int) (Complex e)), Acc (Vector Int)))
-> (Acc (Array ((sh :. Int) :. Int) (Complex e)), Acc (Vector Int))
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
Acc
  (Plain
     (Acc (Array ((sh :. Int) :. Int) (Complex e)), Acc (Vector Int)))
s
                   f :: Exp Int
f       = Acc (Vector Int)
fs Acc (Vector Int) -> Exp Int -> Exp Int
forall sh e.
(Shape sh, Elt e) =>
Acc (Array sh e) -> Exp Int -> Exp e
!! Exp Int
0
               in
               (Acc (Array ((sh :. Int) :. Int) (Complex e)), Acc (Vector Int))
-> Acc
     (Plain
        (Acc (Array ((sh :. Int) :. Int) (Complex e)), Acc (Vector Int)))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp Int
-> Acc (Array ((sh :. Int) :. Int) (Complex e))
-> Acc (Array ((sh :. Int) :. Int) (Complex e))
step Exp Int
f Acc (Array ((sh :. Int) :. Int) (Complex e))
xs, Acc (Vector Int) -> Acc (Vector Int)
forall sh e.
(Shape sh, Elt e) =>
Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int) e)
tail Acc (Vector Int)
fs))
    (Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
 -> Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int))
-> Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
-> Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
forall a b. (a -> b) -> a -> b
$ (Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
 -> Acc (Scalar Bool))
-> (Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
    -> Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int))
-> Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
-> Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
forall a.
Arrays a =>
(Acc a -> Acc (Scalar Bool)) -> (Acc a -> Acc a) -> Acc a -> Acc a
awhile
        (\Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
s -> Exp Bool -> Acc (Scalar Bool)
forall e. Elt e => Exp e -> Acc (Scalar e)
unit (Exp ((sh :. Int) :. Int) -> Exp Int
forall sh a. (Elt sh, Elt a) => Exp (sh :. a) -> Exp a
indexHead (Acc (Array ((sh :. Int) :. Int) (Complex e))
-> Exp ((sh :. Int) :. Int)
forall sh e. (Shape sh, Elt e) => Acc (Array sh e) -> Exp sh
shape (Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
-> Acc (Array ((sh :. Int) :. Int) (Complex e))
forall a b. (Arrays a, Arrays b) => Acc (a, b) -> Acc a
afst Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
s)) Exp Int -> Exp Int -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
> Exp Int
1))
        (\Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
s -> let (Acc (Array ((sh :. Int) :. Int) (Complex e))
xs,Acc (Vector Int)
fs)      = Acc
  (Plain
     (Acc (Array ((sh :. Int) :. Int) (Complex e)), Acc (Vector Int)))
-> (Acc (Array ((sh :. Int) :. Int) (Complex e)), Acc (Vector Int))
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
Acc
  (Plain
     (Acc (Array ((sh :. Int) :. Int) (Complex e)), Acc (Vector Int)))
s
                   len :: Exp Int
len          = Exp ((sh :. Int) :. Int) -> Exp Int
forall sh a. (Elt sh, Elt a) => Exp (sh :. a) -> Exp a
indexHead (Acc (Array ((sh :. Int) :. Int) (Complex e))
-> Exp ((sh :. Int) :. Int)
forall sh e. (Shape sh, Elt e) => Acc (Array sh e) -> Exp sh
shape Acc (Array ((sh :. Int) :. Int) (Complex e))
xs)
                   divides :: Exp a -> Exp a -> Exp Bool
divides Exp a
k Exp a
n  = Exp a
n Exp a -> Exp a -> Exp a
forall a. Integral a => a -> a -> a
`rem` Exp a
k Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp a
0
                   f :: Exp Int
f            = if Exp Int -> Exp Int -> Exp Bool
forall a. (Eq a, Integral (Exp a)) => Exp a -> Exp a -> Exp Bool
divides Exp Int
3 Exp Int
len then Exp Int
3 else
                                  if Exp Int -> Exp Int -> Exp Bool
forall a. (Eq a, Integral (Exp a)) => Exp a -> Exp a -> Exp Bool
divides Exp Int
4 Exp Int
len then Exp Int
4 else
                                  if Exp Int -> Exp Int -> Exp Bool
forall a. (Eq a, Integral (Exp a)) => Exp a -> Exp a -> Exp Bool
divides Exp Int
5 Exp Int
len then Exp Int
5
                                                   else Exp Int
2
               in
               (Acc (Array ((sh :. Int) :. Int) (Complex e)), Acc (Vector Int))
-> Acc
     (Plain
        (Acc (Array ((sh :. Int) :. Int) (Complex e)), Acc (Vector Int)))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp Int
-> Acc (Array ((sh :. Int) :. Int) (Complex e))
-> Acc (Array ((sh :. Int) :. Int) (Complex e))
forall sh e.
(Shape sh, Elt e) =>
Exp Int
-> Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
twist Exp Int
f Acc (Array ((sh :. Int) :. Int) (Complex e))
xs, Exp Int -> Acc (Scalar Int)
forall e. Elt e => Exp e -> Acc (Scalar e)
unit Exp Int
f Acc (Scalar Int) -> Acc (Vector Int) -> Acc (Vector Int)
forall sh e.
(Shape sh, Elt e) =>
Acc (Array sh e)
-> Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int) e)
`cons` Acc (Vector Int)
fs))
    (Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
 -> Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int))
-> Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
-> Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
forall a b. (a -> b) -> a -> b
$ Acc (Array ((sh :. Int) :. Int) (Complex e), Vector Int)
initial


-- | Transformation of arbitrary length base on Bluestein on a 5-smooth size.
--
transformChirp235
    :: (Shape sh, Slice sh, Numeric e)
    => Mode
    -> Acc (Array (sh:.Int) (Complex e))
    -> Acc (Array (sh:.Int) (Complex e))
transformChirp235 :: Mode
-> Acc (Array (sh :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
transformChirp235 Mode
mode Acc (Array (sh :. Int) (Complex e))
arr =
  let n :: Exp Int
n = Exp (sh :. Int) -> Exp Int
forall sh a. (Elt sh, Elt a) => Exp (sh :. a) -> Exp a
indexHead (Acc (Array (sh :. Int) (Complex e)) -> Exp (sh :. Int)
forall sh e. (Shape sh, Elt e) => Acc (Array sh e) -> Exp sh
shape Acc (Array (sh :. Int) (Complex e))
arr)
      f :: Exp Int
f = Exp Int -> Exp Int
ceiling5Smooth (Exp Int
2Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
*Exp Int
n)
  in
  Mode
-> Exp Int
-> (forall sh'.
    (Shape sh', Slice sh') =>
    Acc (Array (sh' :. Int) (Complex e))
    -> Acc (Array (sh' :. Int) (Complex e)))
-> (forall sh'.
    (Shape sh', Slice sh') =>
    Acc (Array (sh' :. Int) (Complex e))
    -> Acc (Array (sh' :. Int) (Complex e)))
-> Acc (Array (sh :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
forall sh e.
(Shape sh, Slice sh, Numeric e) =>
Mode
-> Exp Int
-> (forall sh'.
    (Shape sh', Slice sh') =>
    Acc (Array (sh' :. Int) (Complex e))
    -> Acc (Array (sh' :. Int) (Complex e)))
-> (forall sh'.
    (Shape sh', Slice sh') =>
    Acc (Array (sh' :. Int) (Complex e))
    -> Acc (Array (sh' :. Int) (Complex e)))
-> Acc (Array (sh :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
transformChirp Mode
mode Exp Int
f (Mode
-> Acc (Array (sh' :. Int) (Complex e))
-> Acc (Array (sh' :. Int) (Complex e))
forall sh e.
(Shape sh, Slice sh, Numeric e) =>
Mode
-> Acc (Array (sh :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
dit235 Mode
Forward) (Mode
-> Acc (Array (sh' :. Int) (Complex e))
-> Acc (Array (sh' :. Int) (Complex e))
forall sh e.
(Shape sh, Slice sh, Numeric e) =>
Mode
-> Acc (Array (sh :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
dit235 Mode
Inverse) Acc (Array (sh :. Int) (Complex e))
arr


transformChirp
    :: (Shape sh, Slice sh, Numeric e)
    => Mode
    -> Exp Int
    -> (forall sh'. (Shape sh', Slice sh') => Acc (Array (sh':.Int) (Complex e)) -> Acc (Array (sh':.Int) (Complex e)))
    -> (forall sh'. (Shape sh', Slice sh') => Acc (Array (sh':.Int) (Complex e)) -> Acc (Array (sh':.Int) (Complex e)))
    -> Acc (Array (sh:.Int) (Complex e))
    -> Acc (Array (sh:.Int) (Complex e))
transformChirp :: Mode
-> Exp Int
-> (forall sh'.
    (Shape sh', Slice sh') =>
    Acc (Array (sh' :. Int) (Complex e))
    -> Acc (Array (sh' :. Int) (Complex e)))
-> (forall sh'.
    (Shape sh', Slice sh') =>
    Acc (Array (sh' :. Int) (Complex e))
    -> Acc (Array (sh' :. Int) (Complex e)))
-> Acc (Array (sh :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
transformChirp Mode
mode Exp Int
p forall sh'.
(Shape sh', Slice sh') =>
Acc (Array (sh' :. Int) (Complex e))
-> Acc (Array (sh' :. Int) (Complex e))
analysis forall sh'.
(Shape sh', Slice sh') =>
Acc (Array (sh' :. Int) (Complex e))
-> Acc (Array (sh' :. Int) (Complex e))
synthesis Acc (Array (sh :. Int) (Complex e))
arr =
  let Exp sh
sz :. Exp Int
n   = Exp (Plain (Exp sh :. Exp Int)) -> Exp sh :. Exp Int
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift (Acc (Array (sh :. Int) (Complex e)) -> Exp (sh :. Int)
forall sh e. (Shape sh, Elt e) => Acc (Array sh e) -> Exp sh
shape Acc (Array (sh :. Int) (Complex e))
arr)
      --
      chirp :: Acc (Array (Z :. Int) (Complex e))
chirp     =
        Exp (Z :. Int)
-> (Exp (Z :. Int) -> Exp (Complex e))
-> Acc (Array (Z :. Int) (Complex e))
forall sh a.
(Shape sh, Elt a) =>
Exp sh -> (Exp sh -> Exp a) -> Acc (Array sh a)
generate (Exp Int -> Exp (Z :. Int)
forall i. Elt i => Exp i -> Exp (Z :. i)
index1 Exp Int
p) ((Exp (Z :. Int) -> Exp (Complex e))
 -> Acc (Array (Z :. Int) (Complex e)))
-> (Exp (Z :. Int) -> Exp (Complex e))
-> Acc (Array (Z :. Int) (Complex e))
forall a b. (a -> b) -> a -> b
$ \Exp (Z :. Int)
ix ->
          let k :: Exp Int
k  = Exp (Z :. Int) -> Exp Int
forall i. Elt i => Exp (Z :. i) -> Exp i
unindex1 Exp (Z :. Int)
ix
              sk :: Exp e
sk = Exp Int -> Exp e
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral (if Exp Int
p Exp Int -> Exp Int -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
> Exp Int
2Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
*Exp Int
k then Exp Int
k else Exp Int
kExp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
-Exp Int
p)
              w :: Exp e
w  = Exp e
forall a. Floating a => a
pi Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
* Exp e
sk Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
* Exp e
sk Exp e -> Exp e -> Exp e
forall a. Fractional a => a -> a -> a
/ Exp Int -> Exp e
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Int
n
          in
          Complex (Exp e) -> Exp (Plain (Complex (Exp e)))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Complex (Exp e) -> Exp (Plain (Complex (Exp e))))
-> Complex (Exp e) -> Exp (Plain (Complex (Exp e)))
forall a b. (a -> b) -> a -> b
$ Exp e -> Exp e
forall a. Floating a => a -> a
cos Exp e
w Exp e -> Exp e -> Complex (Exp e)
forall a. a -> a -> Complex a
:+ Mode -> Exp e
forall a. Num a => Mode -> a
signOfMode Mode
mode Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
* Exp e -> Exp e
forall a. Floating a => a -> a
sin Exp e
w
      --
      spectrum :: Acc (Array DIM2 (Complex e))
spectrum  = Acc (Array DIM2 (Complex e)) -> Acc (Array DIM2 (Complex e))
forall sh'.
(Shape sh', Slice sh') =>
Acc (Array (sh' :. Int) (Complex e))
-> Acc (Array (sh' :. Int) (Complex e))
analysis
                (Acc (Array DIM2 (Complex e)) -> Acc (Array DIM2 (Complex e)))
-> Acc (Array DIM2 (Complex e)) -> Acc (Array DIM2 (Complex e))
forall a b. (a -> b) -> a -> b
$ (Exp (Complex e) -> Exp (Complex e))
-> Acc (Array (Z :. Int) (Complex e))
-> Acc (Array (Z :. Int) (Complex e))
forall sh a b.
(Shape sh, Elt a, Elt b) =>
(Exp a -> Exp b) -> Acc (Array sh a) -> Acc (Array sh b)
map Exp (Complex e) -> Exp (Complex e)
forall a. Num a => Exp (Complex a) -> Exp (Complex a)
conjugate Acc (Array (Z :. Int) (Complex e))
chirp
                  Acc (Array (Z :. Int) (Complex e))
-> Acc (Array DIM2 (Complex e)) -> Acc (Array DIM2 (Complex e))
forall sh e.
(Shape sh, Elt e) =>
Acc (Array (sh :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
`consV`
                  Exp DIM2
-> Acc (Array (sh :. Int) (Complex e))
-> Acc (Array DIM2 (Complex e))
forall sh sh' e.
(Shape sh, Shape sh', Elt e) =>
Exp sh -> Acc (Array sh' e) -> Acc (Array sh e)
reshape (((Z :. Exp Int) :. Exp Int)
-> Exp (Plain ((Z :. Exp Int) :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Z
Z Z -> Exp Int -> Z :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp sh -> Exp Int
forall sh. Shape sh => Exp sh -> Exp Int
shapeSize Exp sh
sz (Z :. Exp Int) -> Exp Int -> (Z :. Exp Int) :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
p))
                          (Exp Int
-> Exp (Complex e)
-> Acc (Array (sh :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
forall sh e.
(Shape sh, Elt e) =>
Exp Int
-> Exp e -> Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int) e)
pad Exp Int
p Exp (Complex e)
0 ((Exp (Complex e) -> Exp (Complex e) -> Exp (Complex e))
-> Acc (Array (Z :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
forall sh a b c.
(Shape sh, Slice sh, Elt a, Elt b, Elt c) =>
(Exp a -> Exp b -> Exp c)
-> Acc (Array (Z :. Int) a)
-> Acc (Array (sh :. Int) b)
-> Acc (Array (sh :. Int) c)
zipWithExtrude1 Exp (Complex e) -> Exp (Complex e) -> Exp (Complex e)
forall a. Num a => a -> a -> a
(*) Acc (Array (Z :. Int) (Complex e))
chirp Acc (Array (sh :. Int) (Complex e))
arr))
      scaleDown :: Acc (Array (sh :. a) (Complex b))
-> Acc (Array (sh :. a) (Complex b))
scaleDown Acc (Array (sh :. a) (Complex b))
xs =
        let scale :: a -> c (Plain (Complex a)) -> c (Plain (Complex a))
scale a
x (c (Plain (Complex a)) -> Complex a
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift -> a
r :+ a
i) = Complex a -> c (Plain (Complex a))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (a
xa -> a -> a
forall a. Num a => a -> a -> a
*a
r a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
xa -> a -> a
forall a. Num a => a -> a -> a
*a
i)
            len :: Exp a
len                        = Exp (sh :. a) -> Exp a
forall sh a. (Elt sh, Elt a) => Exp (sh :. a) -> Exp a
indexHead (Acc (Array (sh :. a) (Complex b)) -> Exp (sh :. a)
forall sh e. (Shape sh, Elt e) => Acc (Array sh e) -> Exp sh
shape Acc (Array (sh :. a) (Complex b))
xs)
        in  (Exp (Complex b) -> Exp (Complex b))
-> Acc (Array (sh :. a) (Complex b))
-> Acc (Array (sh :. a) (Complex b))
forall sh a b.
(Shape sh, Elt a, Elt b) =>
(Exp a -> Exp b) -> Acc (Array sh a) -> Acc (Array sh b)
map (Exp b
-> Exp (Complex (Plain (Exp b))) -> Exp (Complex (Plain (Exp b)))
forall (c :: * -> *) a (c :: * -> *).
(Unlift c (Complex a), Num a, Lift c (Complex a)) =>
a -> c (Complex (Plain a)) -> c (Complex (Plain a))
scale (Exp b -> Exp b
forall a. Fractional a => a -> a
recip (Exp a -> Exp b
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp a
len))) Acc (Array (sh :. a) (Complex b))
xs
  in
  if Exp Int
n Exp Int -> Exp Int -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
<= Exp Int
1
    then Acc (Array (sh :. Int) (Complex e))
arr
    else Exp Int
-> Acc (Array (sh :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
forall sh e.
(Shape sh, Elt e) =>
Exp Int -> Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int) e)
take Exp Int
n
       (Acc (Array (sh :. Int) (Complex e))
 -> Acc (Array (sh :. Int) (Complex e)))
-> Acc (Array (sh :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
forall a b. (a -> b) -> a -> b
$ Acc (Array (sh :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
forall sh a b.
(Fractional (Exp b), FromIntegral a b, Ord a, Integral (Exp a),
 Elt b, Shape (sh :. a), Elt sh) =>
Acc (Array (sh :. a) (Complex b))
-> Acc (Array (sh :. a) (Complex b))
scaleDown
       (Acc (Array (sh :. Int) (Complex e))
 -> Acc (Array (sh :. Int) (Complex e)))
-> Acc (Array (sh :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
forall a b. (a -> b) -> a -> b
$ (Exp (Complex e) -> Exp (Complex e) -> Exp (Complex e))
-> Acc (Array (Z :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
forall sh a b c.
(Shape sh, Slice sh, Elt a, Elt b, Elt c) =>
(Exp a -> Exp b -> Exp c)
-> Acc (Array (Z :. Int) a)
-> Acc (Array (sh :. Int) b)
-> Acc (Array (sh :. Int) c)
zipWithExtrude1 Exp (Complex e) -> Exp (Complex e) -> Exp (Complex e)
forall a. Num a => a -> a -> a
(*) Acc (Array (Z :. Int) (Complex e))
chirp
       (Acc (Array (sh :. Int) (Complex e))
 -> Acc (Array (sh :. Int) (Complex e)))
-> Acc (Array (sh :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
forall a b. (a -> b) -> a -> b
$ Acc (Array (sh :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
forall sh'.
(Shape sh', Slice sh') =>
Acc (Array (sh' :. Int) (Complex e))
-> Acc (Array (sh' :. Int) (Complex e))
synthesis
       (Acc (Array (sh :. Int) (Complex e))
 -> Acc (Array (sh :. Int) (Complex e)))
-> Acc (Array (sh :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
forall a b. (a -> b) -> a -> b
$ (Exp (Complex e) -> Exp (Complex e) -> Exp (Complex e))
-> Acc (Array (Z :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
forall sh a b c.
(Shape sh, Slice sh, Elt a, Elt b, Elt c) =>
(Exp a -> Exp b -> Exp c)
-> Acc (Array (Z :. Int) a)
-> Acc (Array (sh :. Int) b)
-> Acc (Array (sh :. Int) c)
zipWithExtrude1 Exp (Complex e) -> Exp (Complex e) -> Exp (Complex e)
forall a. Num a => a -> a -> a
(*) (Acc (Array DIM2 (Complex e)) -> Acc (Array (Z :. Int) (Complex e))
forall sh e.
(Shape sh, Elt e) =>
Acc (Array ((sh :. Int) :. Int) e) -> Acc (Array (sh :. Int) e)
headV Acc (Array DIM2 (Complex e))
spectrum)
       (Acc (Array (sh :. Int) (Complex e))
 -> Acc (Array (sh :. Int) (Complex e)))
-> Acc (Array (sh :. Int) (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
forall a b. (a -> b) -> a -> b
$ Exp (sh :. Int)
-> Acc (Array DIM2 (Complex e))
-> Acc (Array (sh :. Int) (Complex e))
forall sh sh' e.
(Shape sh, Shape sh', Elt e) =>
Exp sh -> Acc (Array sh' e) -> Acc (Array sh e)
reshape ((Exp sh :. Exp Int) -> Exp (Plain (Exp sh :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh
szExp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:.Exp Int
p)) (Acc (Array DIM2 (Complex e)) -> Acc (Array DIM2 (Complex e))
forall sh e.
(Shape sh, Elt e) =>
Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
tailV Acc (Array DIM2 (Complex e))
spectrum)


ceiling5Smooth :: Exp Int -> Exp Int
ceiling5Smooth :: Exp Int -> Exp Int
ceiling5Smooth Exp Int
n =
  let (Exp Int
i2,Exp Int
i3,Exp Int
i5) = Exp (Plain (Exp Int, Exp Int, Exp Int))
-> (Exp Int, Exp Int, Exp Int)
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift (Exp (Double, (Int, Int, Int)) -> Exp (Int, Int, Int)
forall a b. (Elt a, Elt b) => Exp (a, b) -> Exp b
snd (Exp Double -> Exp (Double, (Int, Int, Int))
forall a.
(RealFloat a, Ord a, FromIntegral Int a) =>
Exp a -> Exp (a, (Int, Int, Int))
ceiling5Smooth' (Exp Int -> Exp Double
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Int
n :: Exp Double)))
  in  Exp Int -> Exp Int -> Exp Int
pow Exp Int
i2 Exp Int
2 Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
* Exp Int -> Exp Int -> Exp Int
pow Exp Int
i3 Exp Int
3 Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
* Exp Int -> Exp Int -> Exp Int
pow Exp Int
i5 Exp Int
5

ceiling5Smooth'
    :: (RealFloat a, Ord a, FromIntegral Int a)
    => Exp a
    -> Exp (a, (Int,Int,Int))
ceiling5Smooth' :: Exp a -> Exp (a, (Int, Int, Int))
ceiling5Smooth' Exp a
n =
  let d3 :: Exp Int
d3 = Exp a -> Exp Int
forall a b.
(RealFrac a, Integral b, FromIntegral Int64 b) =>
Exp a -> Exp b
ceiling (Exp a -> Exp a -> Exp a
forall a. Floating a => a -> a -> a
logBase Exp a
3 Exp a
n)
      d5 :: Exp Int
d5 = Exp a -> Exp Int
forall a b.
(RealFrac a, Integral b, FromIntegral Int64 b) =>
Exp a -> Exp b
ceiling (Exp a -> Exp a -> Exp a
forall a. Floating a => a -> a -> a
logBase Exp a
5 Exp a
n)
      --
      argmin :: Exp (a, b) -> Exp (a, b) -> Exp (a, b)
argmin Exp (a, b)
x Exp (a, b)
y = if Exp (a, b) -> Exp a
forall a b. (Elt a, Elt b) => Exp (a, b) -> Exp a
fst Exp (a, b)
x Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< Exp (a, b) -> Exp a
forall a b. (Elt a, Elt b) => Exp (a, b) -> Exp a
fst Exp (a, b)
y then Exp (a, b)
x else Exp (a, b)
y
  in
  Acc (Scalar (a, (Int, Int, Int))) -> Exp (a, (Int, Int, Int))
forall e. Elt e => Acc (Scalar e) -> Exp e
the (Acc (Scalar (a, (Int, Int, Int))) -> Exp (a, (Int, Int, Int)))
-> Acc (Scalar (a, (Int, Int, Int))) -> Exp (a, (Int, Int, Int))
forall a b. (a -> b) -> a -> b
$ (Exp (a, (Int, Int, Int))
 -> Exp (a, (Int, Int, Int)) -> Exp (a, (Int, Int, Int)))
-> Acc (Array DIM2 (a, (Int, Int, Int)))
-> Acc (Scalar (a, (Int, Int, Int)))
forall sh a.
(Shape sh, Elt a) =>
(Exp a -> Exp a -> Exp a) -> Acc (Array sh a) -> Acc (Scalar a)
fold1All Exp (a, (Int, Int, Int))
-> Exp (a, (Int, Int, Int)) -> Exp (a, (Int, Int, Int))
forall a b.
(Elt b, Ord a) =>
Exp (a, b) -> Exp (a, b) -> Exp (a, b)
argmin
      (Acc (Array DIM2 (a, (Int, Int, Int)))
 -> Acc (Scalar (a, (Int, Int, Int))))
-> Acc (Array DIM2 (a, (Int, Int, Int)))
-> Acc (Scalar (a, (Int, Int, Int)))
forall a b. (a -> b) -> a -> b
$ Exp DIM2
-> (Exp DIM2 -> Exp (a, (Int, Int, Int)))
-> Acc (Array DIM2 (a, (Int, Int, Int)))
forall sh a.
(Shape sh, Elt a) =>
Exp sh -> (Exp sh -> Exp a) -> Acc (Array sh a)
generate (Exp Int -> Exp Int -> Exp DIM2
forall i. Elt i => Exp i -> Exp i -> Exp ((Z :. i) :. i)
index2 Exp Int
d5 Exp Int
d3) -- this is probably quite small!
                 (\(Exp DIM2 -> (Z :. Exp Int) :. Exp Int
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift -> Z
Z :. Exp Int
i5 :. Exp Int
i3) ->
                    let
                        p53 :: Exp a
p53 = Exp a
5 Exp a -> Exp a -> Exp a
forall a. Floating a => a -> a -> a
** Exp Int -> Exp a
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Int
i5 Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
* Exp a
3 Exp a -> Exp a -> Exp a
forall a. Floating a => a -> a -> a
** Exp Int -> Exp a
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Int
i3
                        i2 :: Exp Int
i2  = Exp Int
0 Exp Int -> Exp Int -> Exp Int
forall a. Ord a => Exp a -> Exp a -> Exp a
`max` Exp a -> Exp Int
forall a b.
(RealFrac a, Integral b, FromIntegral Int64 b) =>
Exp a -> Exp b
ceiling (Exp a -> Exp a -> Exp a
forall a. Floating a => a -> a -> a
logBase Exp a
2 (Exp a
nExp a -> Exp a -> Exp a
forall a. Fractional a => a -> a -> a
/Exp a
p53))
                    in
                    (Exp a, (Exp Int, Exp Int, Exp Int))
-> Exp (Plain (Exp a, (Exp Int, Exp Int, Exp Int)))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift ( Exp a
p53 Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
* Exp a
2 Exp a -> Exp a -> Exp a
forall a. Floating a => a -> a -> a
** Exp Int -> Exp a
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Int
i2
                         , (Exp Int
i2,Exp Int
i3,Exp Int
i5)
                         ))

-- Utilities
-- ---------

pow :: Exp Int -> Exp Int -> Exp Int
pow :: Exp Int -> Exp Int -> Exp Int
pow Exp Int
x Exp Int
k
  = Exp (Int, Int) -> Exp Int
forall a b. (Elt a, Elt b) => Exp (a, b) -> Exp b
snd
  (Exp (Int, Int) -> Exp Int) -> Exp (Int, Int) -> Exp Int
forall a b. (a -> b) -> a -> b
$ (Exp (Int, Int) -> Exp Bool)
-> (Exp (Int, Int) -> Exp (Int, Int))
-> Exp (Int, Int)
-> Exp (Int, Int)
forall e.
Elt e =>
(Exp e -> Exp Bool) -> (Exp e -> Exp e) -> Exp e -> Exp e
while (\Exp (Int, Int)
ip -> Exp (Int, Int) -> Exp Int
forall a b. (Elt a, Elt b) => Exp (a, b) -> Exp a
fst Exp (Int, Int)
ip Exp Int -> Exp Int -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< Exp Int
k)
          (\Exp (Int, Int)
ip -> (Exp Int, Exp Int) -> Exp (Plain (Exp Int, Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp (Int, Int) -> Exp Int
forall a b. (Elt a, Elt b) => Exp (a, b) -> Exp a
fst Exp (Int, Int)
ip Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
+ Exp Int
1, Exp (Int, Int) -> Exp Int
forall a b. (Elt a, Elt b) => Exp (a, b) -> Exp b
snd Exp (Int, Int)
ip Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
* Exp Int
x))
          ((Exp Int, Exp Int) -> Exp (Plain (Exp Int, Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp Int
0,Exp Int
1))

pad :: (Shape sh, Elt e)
    => Exp Int
    -> Exp e
    -> Acc (Array (sh:.Int) e)
    -> Acc (Array (sh:.Int) e)
pad :: Exp Int
-> Exp e -> Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int) e)
pad Exp Int
n Exp e
x Acc (Array (sh :. Int) e)
xs =
  let sz :: Exp sh
sz = Exp (sh :. Int) -> Exp sh
forall sh a. (Elt sh, Elt a) => Exp (sh :. a) -> Exp sh
indexTail (Acc (Array (sh :. Int) e) -> Exp (sh :. Int)
forall sh e. (Shape sh, Elt e) => Acc (Array sh e) -> Exp sh
shape Acc (Array (sh :. Int) e)
xs)
      sh :: Exp (Plain (Exp sh :. Exp Int))
sh = (Exp sh :. Exp Int) -> Exp (Plain (Exp sh :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh
sz Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
n)
  in
  Acc (Array (sh :. Int) e)
xs Acc (Array (sh :. Int) e)
-> Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int) e)
forall sh e.
(Shape sh, Elt e) =>
Acc (Array (sh :. Int) e)
-> Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int) e)
++ Exp (sh :. Int) -> Exp e -> Acc (Array (sh :. Int) e)
forall sh e.
(Shape sh, Elt e) =>
Exp sh -> Exp e -> Acc (Array sh e)
fill Exp (sh :. Int)
sh Exp e
x

cons :: forall sh e. (Shape sh, Elt e)
     => Acc (Array sh e)
     -> Acc (Array (sh:.Int) e)
     -> Acc (Array (sh:.Int) e)
cons :: Acc (Array sh e)
-> Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int) e)
cons Acc (Array sh e)
x Acc (Array (sh :. Int) e)
xs =
  let x' :: Acc (Array (sh :. Int) e)
x' = Exp (sh :. Int) -> Acc (Array sh e) -> Acc (Array (sh :. Int) e)
forall sh sh' e.
(Shape sh, Shape sh', Elt e) =>
Exp sh -> Acc (Array sh' e) -> Acc (Array sh e)
reshape ((Exp sh :. Exp Int) -> Exp (Plain (Exp sh :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Acc (Array sh e) -> Exp sh
forall sh e. (Shape sh, Elt e) => Acc (Array sh e) -> Exp sh
shape Acc (Array sh e)
x Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
1)) Acc (Array sh e)
x
  in  Acc (Array (sh :. Int) e)
x' Acc (Array (sh :. Int) e)
-> Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int) e)
forall sh e.
(Shape sh, Elt e) =>
Acc (Array (sh :. Int) e)
-> Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int) e)
++ Acc (Array (sh :. Int) e)
xs

consV :: forall sh e. (Shape sh, Elt e)
      => Acc (Array (sh:.Int) e)
      -> Acc (Array (sh:.Int:.Int) e)
      -> Acc (Array (sh:.Int:.Int) e)
consV :: Acc (Array (sh :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
consV Acc (Array (sh :. Int) e)
x Acc (Array ((sh :. Int) :. Int) e)
xs =
  let Exp sh
sh :. Exp Int
n = Exp (Plain (Exp sh :. Exp Int)) -> Exp sh :. Exp Int
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift (Acc (Array (sh :. Int) e) -> Exp (sh :. Int)
forall sh e. (Shape sh, Elt e) => Acc (Array sh e) -> Exp sh
shape Acc (Array (sh :. Int) e)
x) :: Exp sh :. Exp Int
  in  Exp ((sh :. Int) :. Int)
-> Acc (Array (sh :. Int) e) -> Acc (Array ((sh :. Int) :. Int) e)
forall sh sh' e.
(Shape sh, Shape sh', Elt e) =>
Exp sh -> Acc (Array sh' e) -> Acc (Array sh e)
reshape (((Exp sh :. Exp Int) :. Exp Int)
-> Exp (Plain ((Exp sh :. Exp Int) :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh
sh Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
1 (Exp sh :. Exp Int) -> Exp Int -> (Exp sh :. Exp Int) :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
n)) Acc (Array (sh :. Int) e)
x Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
forall sh e.
(Shape sh, Elt e) =>
Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
++^ Acc (Array ((sh :. Int) :. Int) e)
xs

headV :: (Shape sh, Elt e)
      => Acc (Array (sh:.Int:.Int) e)
      -> Acc (Array (sh:.Int) e)
headV :: Acc (Array ((sh :. Int) :. Int) e) -> Acc (Array (sh :. Int) e)
headV Acc (Array ((sh :. Int) :. Int) e)
xs = Acc (Array (FullShape ((Any sh :. Int) :. All)) e)
-> Exp ((Any sh :. Int) :. All)
-> Acc (Array (SliceShape ((Any sh :. Int) :. All)) e)
forall slix e.
(Slice slix, Elt e) =>
Acc (Array (FullShape slix) e)
-> Exp slix -> Acc (Array (SliceShape slix) e)
slice Acc (Array ((sh :. Int) :. Int) e)
Acc (Array (FullShape ((Any sh :. Int) :. All)) e)
xs (((Any sh :. Exp Int) :. All)
-> Exp (Plain ((Any sh :. Exp Int) :. All))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Any sh
forall sh. Any sh
Any Any sh -> Exp Int -> Any sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. (Exp Int
0 :: Exp Int) (Any sh :. Exp Int) -> All -> (Any sh :. Exp Int) :. All
forall tail head. tail -> head -> tail :. head
:. All
All))

tailV :: forall sh e. (Shape sh, Elt e)
      => Acc (Array (sh:.Int:.Int) e)
      -> Acc (Array (sh:.Int:.Int) e)
tailV :: Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
tailV = Lens' (Exp ((sh :. Int) :. Int)) (Exp Int)
-> Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
forall sh e.
(Shape sh, Elt e) =>
Lens' (Exp sh) (Exp Int) -> Acc (Array sh e) -> Acc (Array sh e)
tailOn forall s t a b. Field2 s t a b => Lens s t a b
Lens' (Exp ((sh :. Int) :. Int)) (Exp Int)
_2

dropV :: forall sh e. (Shape sh, Elt e)
      => Exp Int
      -> Acc (Array (sh:.Int:.Int) e)
      -> Acc (Array (sh:.Int:.Int) e)
dropV :: Exp Int
-> Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
dropV = Lens' (Exp ((sh :. Int) :. Int)) (Exp Int)
-> Exp Int
-> Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
forall sh e.
(Shape sh, Elt e) =>
Lens' (Exp sh) (Exp Int)
-> Exp Int -> Acc (Array sh e) -> Acc (Array sh e)
dropOn forall s t a b. Field2 s t a b => Lens s t a b
Lens' (Exp ((sh :. Int) :. Int)) (Exp Int)
_2

sieve
    :: forall sh e. (Shape sh, Elt e)
    => Exp Int
    -> Exp Int
    -> Acc (Array (sh:.Int) e)
    -> Acc (Array (sh:.Int) e)
sieve :: Exp Int
-> Exp Int
-> Acc (Array (sh :. Int) e)
-> Acc (Array (sh :. Int) e)
sieve Exp Int
fac Exp Int
start Acc (Array (sh :. Int) e)
xs =
  let Exp sh
sh :. Exp Int
n = Exp (Plain (Exp sh :. Exp Int)) -> Exp sh :. Exp Int
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift (Acc (Array (sh :. Int) e) -> Exp (sh :. Int)
forall sh e. (Shape sh, Elt e) => Acc (Array sh e) -> Exp sh
shape Acc (Array (sh :. Int) e)
xs) :: Exp sh :. Exp Int
  in
  Exp (sh :. Int)
-> (Exp (sh :. Int) -> Exp (sh :. Int))
-> Acc (Array (sh :. Int) e)
-> Acc (Array (sh :. Int) e)
forall sh sh' a.
(Shape sh, Shape sh', Elt a) =>
Exp sh'
-> (Exp sh' -> Exp sh) -> Acc (Array sh a) -> Acc (Array sh' a)
backpermute
    ((Exp sh :. Exp Int) -> Exp (Plain (Exp sh :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh
sh Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
n Exp Int -> Exp Int -> Exp Int
forall a. Integral a => a -> a -> a
`quot` Exp Int
fac))
    (\(Exp (sh :. Int) -> Exp sh :. Exp Int
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift -> Exp sh
ix :. Exp Int
j :: Exp sh :. Exp Int) -> (Exp sh :. Exp Int) -> Exp (Plain (Exp sh :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh
ix Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
facExp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
*Exp Int
j Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
+ Exp Int
start))
    Acc (Array (sh :. Int) e)
xs

sieveV
    :: forall sh e. (Shape sh, Elt e)
    => Exp Int
    -> Exp Int
    -> Acc (Array (sh:.Int:.Int) e)
    -> Acc (Array (sh:.Int:.Int) e)
sieveV :: Exp Int
-> Exp Int
-> Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
sieveV Exp Int
fac Exp Int
start Acc (Array ((sh :. Int) :. Int) e)
xs =
  let Exp sh
sh :. Exp Int
m :. Exp Int
n = Exp (Plain ((Exp sh :. Exp Int) :. Exp Int))
-> (Exp sh :. Exp Int) :. Exp Int
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift (Acc (Array ((sh :. Int) :. Int) e) -> Exp ((sh :. Int) :. Int)
forall sh e. (Shape sh, Elt e) => Acc (Array sh e) -> Exp sh
shape Acc (Array ((sh :. Int) :. Int) e)
xs) :: Exp sh :. Exp Int :. Exp Int
  in
  Exp ((sh :. Int) :. Int)
-> (Exp ((sh :. Int) :. Int) -> Exp ((sh :. Int) :. Int))
-> Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
forall sh sh' a.
(Shape sh, Shape sh', Elt a) =>
Exp sh'
-> (Exp sh' -> Exp sh) -> Acc (Array sh a) -> Acc (Array sh' a)
backpermute
    (((Exp sh :. Exp Int) :. Exp Int)
-> Exp (Plain ((Exp sh :. Exp Int) :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh
sh Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
m Exp Int -> Exp Int -> Exp Int
forall a. Integral a => a -> a -> a
`quot` Exp Int
fac (Exp sh :. Exp Int) -> Exp Int -> (Exp sh :. Exp Int) :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
n))
    (\(Exp ((sh :. Int) :. Int) -> (Exp sh :. Exp Int) :. Exp Int
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift -> Exp sh
ix :. Exp Int
j :. Exp Int
i :: Exp sh :. Exp Int :. Exp Int) -> ((Exp sh :. Exp Int) :. Exp Int)
-> Exp (Plain ((Exp sh :. Exp Int) :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh
ix Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
facExp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
*Exp Int
jExp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
+Exp Int
start (Exp sh :. Exp Int) -> Exp Int -> (Exp sh :. Exp Int) :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
i))
    Acc (Array ((sh :. Int) :. Int) e)
xs

twist :: forall sh e. (Shape sh, Elt e)
      => Exp Int
      -> Acc (Array (sh:.Int:.Int) e)
      -> Acc (Array (sh:.Int:.Int) e)
twist :: Exp Int
-> Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
twist Exp Int
fac Acc (Array ((sh :. Int) :. Int) e)
xs =
  let Exp sh
sh :. Exp Int
m :. Exp Int
n = Exp (Plain ((Exp sh :. Exp Int) :. Exp Int))
-> (Exp sh :. Exp Int) :. Exp Int
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift (Acc (Array ((sh :. Int) :. Int) e) -> Exp ((sh :. Int) :. Int)
forall sh e. (Shape sh, Elt e) => Acc (Array sh e) -> Exp sh
shape Acc (Array ((sh :. Int) :. Int) e)
xs) :: Exp sh :. Exp Int :. Exp Int
  in
  Exp ((sh :. Int) :. Int)
-> (Exp ((sh :. Int) :. Int) -> Exp ((sh :. Int) :. Int))
-> Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
forall sh sh' a.
(Shape sh, Shape sh', Elt a) =>
Exp sh'
-> (Exp sh' -> Exp sh) -> Acc (Array sh a) -> Acc (Array sh' a)
backpermute
    (((Exp sh :. Exp Int) :. Exp Int)
-> Exp (Plain ((Exp sh :. Exp Int) :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh
sh Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
facExp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
*Exp Int
m (Exp sh :. Exp Int) -> Exp Int -> (Exp sh :. Exp Int) :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
n Exp Int -> Exp Int -> Exp Int
forall a. Integral a => a -> a -> a
`quot` Exp Int
fac))
    (\(Exp ((sh :. Int) :. Int) -> (Exp sh :. Exp Int) :. Exp Int
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift -> Exp sh
ix :. Exp Int
j :. Exp Int
i :: Exp sh :. Exp Int :. Exp Int) -> ((Exp sh :. Exp Int) :. Exp Int)
-> Exp (Plain ((Exp sh :. Exp Int) :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh
ix Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
j Exp Int -> Exp Int -> Exp Int
forall a. Integral a => a -> a -> a
`quot` Exp Int
fac (Exp sh :. Exp Int) -> Exp Int -> (Exp sh :. Exp Int) :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
facExp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
*Exp Int
i Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
+ Exp Int
j Exp Int -> Exp Int -> Exp Int
forall a. Integral a => a -> a -> a
`rem` Exp Int
fac))
    Acc (Array ((sh :. Int) :. Int) e)
xs


infixr 5 ++^
(++^) :: forall sh e. (Shape sh, Elt e)
      => Acc (Array (sh:.Int:.Int) e)
      -> Acc (Array (sh:.Int:.Int) e)
      -> Acc (Array (sh:.Int:.Int) e)
++^ :: Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
(++^) = Lens' (Exp ((sh :. Int) :. Int)) (Exp Int)
-> Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
forall sh e.
(Shape sh, Elt e) =>
Lens' (Exp sh) (Exp Int)
-> Acc (Array sh e) -> Acc (Array sh e) -> Acc (Array sh e)
concatOn forall s t a b. Field2 s t a b => Lens s t a b
Lens' (Exp ((sh :. Int) :. Int)) (Exp Int)
_2

zipWithExtrude1
    :: (Shape sh, Slice sh, Elt a, Elt b, Elt c)
    => (Exp a -> Exp b -> Exp c)
    -> Acc (Array DIM1      a)
    -> Acc (Array (sh:.Int) b)
    -> Acc (Array (sh:.Int) c)
zipWithExtrude1 :: (Exp a -> Exp b -> Exp c)
-> Acc (Array (Z :. Int) a)
-> Acc (Array (sh :. Int) b)
-> Acc (Array (sh :. Int) c)
zipWithExtrude1 Exp a -> Exp b -> Exp c
f Acc (Array (Z :. Int) a)
xs Acc (Array (sh :. Int) b)
ys =
  (Exp a -> Exp b -> Exp c)
-> Acc (Array (sh :. Int) a)
-> Acc (Array (sh :. Int) b)
-> Acc (Array (sh :. Int) c)
forall sh a b c.
(Shape sh, Elt a, Elt b, Elt c) =>
(Exp a -> Exp b -> Exp c)
-> Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c)
zipWith Exp a -> Exp b -> Exp c
f (Exp (sh :. All)
-> Acc (Array (SliceShape (sh :. All)) a)
-> Acc (Array (FullShape (sh :. All)) a)
forall slix e.
(Slice slix, Elt e) =>
Exp slix
-> Acc (Array (SliceShape slix) e)
-> Acc (Array (FullShape slix) e)
replicate ((Exp sh :. All) -> Exp (Plain (Exp sh :. All))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp (sh :. Int) -> Exp sh
forall sh a. (Elt sh, Elt a) => Exp (sh :. a) -> Exp sh
indexTail (Acc (Array (sh :. Int) b) -> Exp (sh :. Int)
forall sh e. (Shape sh, Elt e) => Acc (Array sh e) -> Exp sh
shape Acc (Array (sh :. Int) b)
ys) Exp sh -> All -> Exp sh :. All
forall tail head. tail -> head -> tail :. head
:. All
All)) Acc (Array (Z :. Int) a)
Acc (Array (SliceShape (sh :. All)) a)
xs) Acc (Array (sh :. Int) b)
ys

zipWithExtrude2
    :: (Shape sh, Slice sh, Elt a, Elt b, Elt c)
    => (Exp a -> Exp b -> Exp c)
    -> Acc (Array DIM2           a)
    -> Acc (Array (sh:.Int:.Int) b)
    -> Acc (Array (sh:.Int:.Int) c)
zipWithExtrude2 :: (Exp a -> Exp b -> Exp c)
-> Acc (Array DIM2 a)
-> Acc (Array ((sh :. Int) :. Int) b)
-> Acc (Array ((sh :. Int) :. Int) c)
zipWithExtrude2 Exp a -> Exp b -> Exp c
f Acc (Array DIM2 a)
xs Acc (Array ((sh :. Int) :. Int) b)
ys =
  (Exp a -> Exp b -> Exp c)
-> Acc (Array ((sh :. Int) :. Int) a)
-> Acc (Array ((sh :. Int) :. Int) b)
-> Acc (Array ((sh :. Int) :. Int) c)
forall sh a b c.
(Shape sh, Elt a, Elt b, Elt c) =>
(Exp a -> Exp b -> Exp c)
-> Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c)
zipWith Exp a -> Exp b -> Exp c
f (Exp ((sh :. All) :. All)
-> Acc (Array (SliceShape ((sh :. All) :. All)) a)
-> Acc (Array (FullShape ((sh :. All) :. All)) a)
forall slix e.
(Slice slix, Elt e) =>
Exp slix
-> Acc (Array (SliceShape slix) e)
-> Acc (Array (FullShape slix) e)
replicate (((Exp sh :. All) :. All) -> Exp (Plain ((Exp sh :. All) :. All))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp (sh :. Int) -> Exp sh
forall sh a. (Elt sh, Elt a) => Exp (sh :. a) -> Exp sh
indexTail (Exp ((sh :. Int) :. Int) -> Exp (sh :. Int)
forall sh a. (Elt sh, Elt a) => Exp (sh :. a) -> Exp sh
indexTail (Acc (Array ((sh :. Int) :. Int) b) -> Exp ((sh :. Int) :. Int)
forall sh e. (Shape sh, Elt e) => Acc (Array sh e) -> Exp sh
shape Acc (Array ((sh :. Int) :. Int) b)
ys)) Exp sh -> All -> Exp sh :. All
forall tail head. tail -> head -> tail :. head
:. All
All (Exp sh :. All) -> All -> (Exp sh :. All) :. All
forall tail head. tail -> head -> tail :. head
:. All
All)) Acc (Array DIM2 a)
Acc (Array (SliceShape ((sh :. All) :. All)) a)
xs) Acc (Array ((sh :. Int) :. Int) b)
ys

transpose
    :: forall sh e. (Shape sh, Elt e)
    => Acc (Array (sh:.Int:.Int) e)
    -> Acc (Array (sh:.Int:.Int) e)
transpose :: Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
transpose = Lens' (Exp ((sh :. Int) :. Int)) (Exp Int)
-> Lens' (Exp ((sh :. Int) :. Int)) (Exp Int)
-> Acc (Array ((sh :. Int) :. Int) e)
-> Acc (Array ((sh :. Int) :. Int) e)
forall sh e.
(Shape sh, Elt e) =>
Lens' (Exp sh) (Exp Int)
-> Lens' (Exp sh) (Exp Int) -> Acc (Array sh e) -> Acc (Array sh e)
transposeOn forall s t a b. Field1 s t a b => Lens s t a b
Lens' (Exp ((sh :. Int) :. Int)) (Exp Int)
_1 forall s t a b. Field2 s t a b => Lens s t a b
Lens' (Exp ((sh :. Int) :. Int)) (Exp Int)
_2

transform2
    :: (Shape sh, Num e)
    => Exp e
    -> Acc (Array (sh:.Int) e)
    -> Acc (Array (sh:.Int) e)
transform2 :: Exp e -> Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int) e)
transform2 Exp e
v Acc (Array (sh :. Int) e)
xs =
  Exp (sh :. Int)
-> (Exp (sh :. Int) -> Exp e) -> Acc (Array (sh :. Int) e)
forall sh a.
(Shape sh, Elt a) =>
Exp sh -> (Exp sh -> Exp a) -> Acc (Array sh a)
generate
    ((Exp sh :. Exp Int) -> Exp (Plain (Exp sh :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp (sh :. Int) -> Exp sh
forall sh a. (Elt sh, Elt a) => Exp (sh :. a) -> Exp sh
indexTail (Acc (Array (sh :. Int) e) -> Exp (sh :. Int)
forall sh e. (Shape sh, Elt e) => Acc (Array sh e) -> Exp sh
shape Acc (Array (sh :. Int) e)
xs) Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
2))
    (\(Exp (sh :. Int) -> Exp sh :. Exp Int
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift -> Exp sh
ix :. Exp Int
k :: Exp sh :. Exp Int) ->
        let x0 :: Exp e
x0 = Acc (Array (sh :. Int) e)
xs Acc (Array (sh :. Int) e) -> Exp (sh :. Int) -> Exp e
forall sh e.
(Shape sh, Elt e) =>
Acc (Array sh e) -> Exp sh -> Exp e
! (Exp sh :. Exp Int) -> Exp (Plain (Exp sh :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh
ix Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
0)
            x1 :: Exp e
x1 = Acc (Array (sh :. Int) e)
xs Acc (Array (sh :. Int) e) -> Exp (sh :. Int) -> Exp e
forall sh e.
(Shape sh, Elt e) =>
Acc (Array sh e) -> Exp sh -> Exp e
! (Exp sh :. Exp Int) -> Exp (Plain (Exp sh :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh
ix Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
1)
        in
        if Exp Int
k Exp Int -> Exp Int -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Int
0 then Exp e
x0Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+Exp e
x1
                  else Exp e
x0Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+Exp e
vExp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
*Exp e
x1)

transform3
    :: forall sh e. (Shape sh, Num e)
    => Exp (e,e)
    -> Acc (Array (sh:.Int) e)
    -> Acc (Array (sh:.Int) e)
transform3 :: Exp (e, e)
-> Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int) e)
transform3 (Exp (e, e) -> (Exp e, Exp e)
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift -> (Exp e
z1,Exp e
z2)) Acc (Array (sh :. Int) e)
xs =
  Exp (sh :. Int)
-> (Exp (sh :. Int) -> Exp e) -> Acc (Array (sh :. Int) e)
forall sh a.
(Shape sh, Elt a) =>
Exp sh -> (Exp sh -> Exp a) -> Acc (Array sh a)
generate
    ((Exp sh :. Exp Int) -> Exp (Plain (Exp sh :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp (sh :. Int) -> Exp sh
forall sh a. (Elt sh, Elt a) => Exp (sh :. a) -> Exp sh
indexTail (Acc (Array (sh :. Int) e) -> Exp (sh :. Int)
forall sh e. (Shape sh, Elt e) => Acc (Array sh e) -> Exp sh
shape Acc (Array (sh :. Int) e)
xs) Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
3))
    (\(Exp (sh :. Int) -> Exp sh :. Exp Int
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift -> Exp sh
ix :. Exp Int
k :: Exp sh :. Exp Int) ->
        let
            x0 :: Exp e
x0 = Acc (Array (sh :. Int) e)
xs Acc (Array (sh :. Int) e) -> Exp (sh :. Int) -> Exp e
forall sh e.
(Shape sh, Elt e) =>
Acc (Array sh e) -> Exp sh -> Exp e
! (Exp sh :. Exp Int) -> Exp (Plain (Exp sh :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh
ix Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
0)
            x1 :: Exp e
x1 = Acc (Array (sh :. Int) e)
xs Acc (Array (sh :. Int) e) -> Exp (sh :. Int) -> Exp e
forall sh e.
(Shape sh, Elt e) =>
Acc (Array sh e) -> Exp sh -> Exp e
! (Exp sh :. Exp Int) -> Exp (Plain (Exp sh :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh
ix Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
1)
            x2 :: Exp e
x2 = Acc (Array (sh :. Int) e)
xs Acc (Array (sh :. Int) e) -> Exp (sh :. Int) -> Exp e
forall sh e.
(Shape sh, Elt e) =>
Acc (Array sh e) -> Exp sh -> Exp e
! (Exp sh :. Exp Int) -> Exp (Plain (Exp sh :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh
ix Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
2)
            --
            ((Exp e
s,Exp e
_), (Exp e
zx1,Exp e
zx2)) = (Exp e, Exp e)
-> (Exp e, Exp e) -> ((Exp e, Exp e), (Exp e, Exp e))
forall e.
Num e =>
(Exp e, Exp e)
-> (Exp e, Exp e) -> ((Exp e, Exp e), (Exp e, Exp e))
sumAndConvolve2 (Exp e
x1,Exp e
x2) (Exp e
z1,Exp e
z2)
        in
        if Exp Int
k Exp Int -> Exp Int -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Int
0    then Exp e
x0 Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+ Exp e
s   else
        if Exp Int
k Exp Int -> Exp Int -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Int
1    then Exp e
x0 Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+ Exp e
zx1
        {- k == 2 -} else Exp e
x0 Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+ Exp e
zx2)

transform4
    :: forall sh e. (Shape sh, Num e)
    => Exp (e,e,e)
    -> Acc (Array (sh:.Int) e)
    -> Acc (Array (sh:.Int) e)
transform4 :: Exp (e, e, e)
-> Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int) e)
transform4 (Exp (e, e, e) -> (Exp e, Exp e, Exp e)
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift -> (Exp e
z1,Exp e
z2,Exp e
z3)) Acc (Array (sh :. Int) e)
xs =
  Exp (sh :. Int)
-> (Exp (sh :. Int) -> Exp e) -> Acc (Array (sh :. Int) e)
forall sh a.
(Shape sh, Elt a) =>
Exp sh -> (Exp sh -> Exp a) -> Acc (Array sh a)
generate
    ((Exp sh :. Exp Int) -> Exp (Plain (Exp sh :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp (sh :. Int) -> Exp sh
forall sh a. (Elt sh, Elt a) => Exp (sh :. a) -> Exp sh
indexTail (Acc (Array (sh :. Int) e) -> Exp (sh :. Int)
forall sh e. (Shape sh, Elt e) => Acc (Array sh e) -> Exp sh
shape Acc (Array (sh :. Int) e)
xs) Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
4))
    (\(Exp (sh :. Int) -> Exp sh :. Exp Int
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift -> Exp sh
ix :. Exp Int
k :: Exp sh :. Exp Int) ->
        let
            x0 :: Exp e
x0 = Acc (Array (sh :. Int) e)
xs Acc (Array (sh :. Int) e) -> Exp (sh :. Int) -> Exp e
forall sh e.
(Shape sh, Elt e) =>
Acc (Array sh e) -> Exp sh -> Exp e
! (Exp sh :. Exp Int) -> Exp (Plain (Exp sh :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh
ix Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
0)
            x1 :: Exp e
x1 = Acc (Array (sh :. Int) e)
xs Acc (Array (sh :. Int) e) -> Exp (sh :. Int) -> Exp e
forall sh e.
(Shape sh, Elt e) =>
Acc (Array sh e) -> Exp sh -> Exp e
! (Exp sh :. Exp Int) -> Exp (Plain (Exp sh :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh
ix Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
1)
            x2 :: Exp e
x2 = Acc (Array (sh :. Int) e)
xs Acc (Array (sh :. Int) e) -> Exp (sh :. Int) -> Exp e
forall sh e.
(Shape sh, Elt e) =>
Acc (Array sh e) -> Exp sh -> Exp e
! (Exp sh :. Exp Int) -> Exp (Plain (Exp sh :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh
ix Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
2)
            x3 :: Exp e
x3 = Acc (Array (sh :. Int) e)
xs Acc (Array (sh :. Int) e) -> Exp (sh :. Int) -> Exp e
forall sh e.
(Shape sh, Elt e) =>
Acc (Array sh e) -> Exp sh -> Exp e
! (Exp sh :. Exp Int) -> Exp (Plain (Exp sh :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh
ix Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
3)
            --
            x02a :: Exp e
x02a = Exp e
x0Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+Exp e
x2
            x02b :: Exp e
x02b = Exp e
x0Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+Exp e
z2Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
*Exp e
x2
            x13a :: Exp e
x13a = Exp e
x1Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+Exp e
x3
            x13b :: Exp e
x13b = Exp e
x1Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+Exp e
z2Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
*Exp e
x3
        in
        if Exp Int
k Exp Int -> Exp Int -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Int
0    then Exp e
x02a Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+      Exp e
x13a else
        if Exp Int
k Exp Int -> Exp Int -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Int
1    then Exp e
x02b Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+ Exp e
z1 Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
* Exp e
x13b else
        if Exp Int
k Exp Int -> Exp Int -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Int
2    then Exp e
x02a Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+ Exp e
z2 Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
* Exp e
x13a
        {- k == 3 -} else Exp e
x02b Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+ Exp e
z3 Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
* Exp e
x13b)

-- Use Rader's trick for mapping the transform to a convolution and apply
-- Karatsuba's trick at two levels (i.e. total three times) to that convolution.
--
-- 0 0 0 0 0
-- 0 1 2 3 4
-- 0 2 4 1 3
-- 0 3 1 4 2
-- 0 4 3 2 1
--
-- Permutation.T: 0 1 2 4 3
--
-- 0 0 0 0 0
-- 0 1 2 4 3
-- 0 2 4 3 1
-- 0 4 3 1 2
-- 0 3 1 2 4
--
transform5
    :: forall sh e. (Shape sh, Num e)
    => Exp (e,e,e,e)
    -> Acc (Array (sh:.Int) e)
    -> Acc (Array (sh:.Int) e)
transform5 :: Exp (e, e, e, e)
-> Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int) e)
transform5 (Exp (e, e, e, e) -> (Exp e, Exp e, Exp e, Exp e)
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift -> (Exp e
z1,Exp e
z2,Exp e
z3,Exp e
z4)) Acc (Array (sh :. Int) e)
xs =
  Exp (sh :. Int)
-> (Exp (sh :. Int) -> Exp e) -> Acc (Array (sh :. Int) e)
forall sh a.
(Shape sh, Elt a) =>
Exp sh -> (Exp sh -> Exp a) -> Acc (Array sh a)
generate
    ((Exp sh :. Exp Int) -> Exp (Plain (Exp sh :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp (sh :. Int) -> Exp sh
forall sh a. (Elt sh, Elt a) => Exp (sh :. a) -> Exp sh
indexTail (Acc (Array (sh :. Int) e) -> Exp (sh :. Int)
forall sh e. (Shape sh, Elt e) => Acc (Array sh e) -> Exp sh
shape Acc (Array (sh :. Int) e)
xs) Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
5))
    (\(Exp (sh :. Int) -> Exp sh :. Exp Int
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift -> Exp sh
ix :. Exp Int
k :: Exp sh :. Exp Int) ->
        let
            x0 :: Exp e
x0 = Acc (Array (sh :. Int) e)
xs Acc (Array (sh :. Int) e) -> Exp (sh :. Int) -> Exp e
forall sh e.
(Shape sh, Elt e) =>
Acc (Array sh e) -> Exp sh -> Exp e
! (Exp sh :. Exp Int) -> Exp (Plain (Exp sh :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh
ix Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
0)
            x1 :: Exp e
x1 = Acc (Array (sh :. Int) e)
xs Acc (Array (sh :. Int) e) -> Exp (sh :. Int) -> Exp e
forall sh e.
(Shape sh, Elt e) =>
Acc (Array sh e) -> Exp sh -> Exp e
! (Exp sh :. Exp Int) -> Exp (Plain (Exp sh :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh
ix Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
1)
            x2 :: Exp e
x2 = Acc (Array (sh :. Int) e)
xs Acc (Array (sh :. Int) e) -> Exp (sh :. Int) -> Exp e
forall sh e.
(Shape sh, Elt e) =>
Acc (Array sh e) -> Exp sh -> Exp e
! (Exp sh :. Exp Int) -> Exp (Plain (Exp sh :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh
ix Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
2)
            x3 :: Exp e
x3 = Acc (Array (sh :. Int) e)
xs Acc (Array (sh :. Int) e) -> Exp (sh :. Int) -> Exp e
forall sh e.
(Shape sh, Elt e) =>
Acc (Array sh e) -> Exp sh -> Exp e
! (Exp sh :. Exp Int) -> Exp (Plain (Exp sh :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh
ix Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
3)
            x4 :: Exp e
x4 = Acc (Array (sh :. Int) e)
xs Acc (Array (sh :. Int) e) -> Exp (sh :. Int) -> Exp e
forall sh e.
(Shape sh, Elt e) =>
Acc (Array sh e) -> Exp sh -> Exp e
! (Exp sh :. Exp Int) -> Exp (Plain (Exp sh :. Exp Int))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp sh
ix Exp sh -> Exp Int -> Exp sh :. Exp Int
forall tail head. tail -> head -> tail :. head
:. Exp Int
4)
            --
            ((Exp e
s,Exp e
_), (Exp e
d1,Exp e
d2,Exp e
d4,Exp e
d3)) = (Exp e, Exp e, Exp e, Exp e)
-> (Exp e, Exp e, Exp e, Exp e)
-> ((Exp e, Exp e), (Exp e, Exp e, Exp e, Exp e))
forall e.
Num e =>
(Exp e, Exp e, Exp e, Exp e)
-> (Exp e, Exp e, Exp e, Exp e)
-> ((Exp e, Exp e), (Exp e, Exp e, Exp e, Exp e))
sumAndConvolve4 (Exp e
x1,Exp e
x3,Exp e
x4,Exp e
x2) (Exp e
z1,Exp e
z2,Exp e
z4,Exp e
z3)
        in
        if Exp Int
k Exp Int -> Exp Int -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Int
0    then Exp e
x0 Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+ Exp e
s  else
        if Exp Int
k Exp Int -> Exp Int -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Int
1    then Exp e
x0 Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+ Exp e
d1 else
        if Exp Int
k Exp Int -> Exp Int -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Int
2    then Exp e
x0 Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+ Exp e
d2 else
        if Exp Int
k Exp Int -> Exp Int -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Int
3    then Exp e
x0 Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+ Exp e
d3
        {- k == 4 -} else Exp e
x0 Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+ Exp e
d4)


-- Some small size convolutions using the Karatsuba trick.
--
-- This does not use Toom-3 multiplication, because this requires division by
-- 2 and 6, and thus 'Fractional' constraints.
--
sumAndConvolve2
    :: Num e
    => (Exp e, Exp e)
    -> (Exp e, Exp e)
    -> ((Exp e, Exp e), (Exp e, Exp e))
sumAndConvolve2 :: (Exp e, Exp e)
-> (Exp e, Exp e) -> ((Exp e, Exp e), (Exp e, Exp e))
sumAndConvolve2 (Exp e
a0,Exp e
a1) (Exp e
b0,Exp e
b1) =
  let sa01 :: Exp e
sa01   = Exp e
a0Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+Exp e
a1
      sb01 :: Exp e
sb01   = Exp e
b0Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+Exp e
b1
      ab0ab1 :: Exp e
ab0ab1 = Exp e
a0Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
*Exp e
b0Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+Exp e
a1Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
*Exp e
b1
  in
  ((Exp e
sa01, Exp e
sb01), (Exp e
ab0ab1, Exp e
sa01Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
*Exp e
sb01Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
-Exp e
ab0ab1))

-- sumAndConvolve3
--     :: Num e
--     => (Exp e, Exp e, Exp e)
--     -> (Exp e, Exp e, Exp e)
--     -> ((Exp e, Exp e), (Exp e, Exp e, Exp e))
-- sumAndConvolve3 (a0,a1,a2) (b0,b1,b2) =
--   let ab0   = a0*b0
--       dab12 = a1*b1 - a2*b2
--       sa01  = a0+a1; sb01 = b0+b1; tab01 = sa01*sb01 - ab0
--       sa02  = a0+a2; sb02 = b0+b2; tab02 = sa02*sb02 - ab0
--       sa012 = sa01+a2
--       sb012 = sb01+b2
--       --
--       d0    = sa012*sb012 - tab01 - tab02
--       d1    = tab01 - dab12
--       d2    = tab02 + dab12
--   in
--   ((sa012, sb012), (d0, d1, d2))

sumAndConvolve4
  :: Num e
  => (Exp e, Exp e, Exp e, Exp e)
  -> (Exp e, Exp e, Exp e, Exp e)
  -> ((Exp e, Exp e), (Exp e, Exp e, Exp e, Exp e))
sumAndConvolve4 :: (Exp e, Exp e, Exp e, Exp e)
-> (Exp e, Exp e, Exp e, Exp e)
-> ((Exp e, Exp e), (Exp e, Exp e, Exp e, Exp e))
sumAndConvolve4 (Exp e
a0,Exp e
a1,Exp e
a2,Exp e
a3) (Exp e
b0,Exp e
b1,Exp e
b2,Exp e
b3) =
  let ab0 :: Exp e
ab0    = Exp e
a0Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
*Exp e
b0
      ab1 :: Exp e
ab1    = Exp e
a1Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
*Exp e
b1
      sa01 :: Exp e
sa01   = Exp e
a0Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+Exp e
a1; sb01 :: Exp e
sb01 = Exp e
b0Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+Exp e
b1
      ab01 :: Exp e
ab01   = Exp e
sa01Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
*Exp e
sb01 Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
- (Exp e
ab0Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+Exp e
ab1)
      ab2 :: Exp e
ab2    = Exp e
a2Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
*Exp e
b2
      ab3 :: Exp e
ab3    = Exp e
a3Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
*Exp e
b3
      sa23 :: Exp e
sa23   = Exp e
a2Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+Exp e
a3; sb23 :: Exp e
sb23 = Exp e
b2Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+Exp e
b3
      ab23 :: Exp e
ab23   = Exp e
sa23Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
*Exp e
sb23 Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
- (Exp e
ab2Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+Exp e
ab3)
      c0 :: Exp e
c0     = Exp e
ab0  Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+ Exp e
ab2 Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
- (Exp e
ab1 Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+ Exp e
ab3)
      c1 :: Exp e
c1     = Exp e
ab01 Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+ Exp e
ab23
      ab02 :: Exp e
ab02   = (Exp e
a0Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+Exp e
a2)Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
*(Exp e
b0Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+Exp e
b2)
      ab13 :: Exp e
ab13   = (Exp e
a1Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+Exp e
a3)Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
*(Exp e
b1Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+Exp e
b3)
      sa0123 :: Exp e
sa0123 = Exp e
sa01Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+Exp e
sa23
      sb0123 :: Exp e
sb0123 = Exp e
sb01Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+Exp e
sb23
      ab0123 :: Exp e
ab0123 = Exp e
sa0123Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
*Exp e
sb0123 Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
- (Exp e
ab02Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+Exp e
ab13)
      --
      d0 :: Exp e
d0     = Exp e
ab13   Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
+ Exp e
c0
      d1 :: Exp e
d1     = Exp e
c1
      d2 :: Exp e
d2     = Exp e
ab02   Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
- Exp e
c0
      d3 :: Exp e
d3     = Exp e
ab0123 Exp e -> Exp e -> Exp e
forall a. Num a => a -> a -> a
- Exp e
c1
  in
  ((Exp e
sa0123, Exp e
sb0123), (Exp e
d0, Exp e
d1, Exp e
d2, Exp e
d3))

fromInteger :: Num a => P.Integer -> Exp a
fromInteger :: Integer -> Exp a
fromInteger = Integer -> Exp a
forall a. Num a => Integer -> a
P.fromInteger