packages feed

accelerate-cufft (empty) → 0.0

raw patch · 11 files changed

+749/−0 lines, 11 filesdep +acceleratedep +accelerate-cudadep +accelerate-cufftsetup-changed

Dependencies added: accelerate, accelerate-cuda, accelerate-cufft, accelerate-fourier, accelerate-utility, base, cuda, cufft

Files

+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) Henning Thielemann 2014++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#! /usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ accelerate-cufft.cabal view
@@ -0,0 +1,106 @@+Name:             accelerate-cufft+Version:          0.0+License:          BSD3+License-File:     LICENSE+Author:           Henning Thielemann <haskell@henning-thielemann.de>+Maintainer:       Henning Thielemann <haskell@henning-thielemann.de>+Homepage:         http://code.haskell.org/~thielema/accelerate-cufft/+Category:         Math+Synopsis:         Accelerate frontend to the CUFFT library (Fourier transform)+Description:+  An interface for the @accelerate@ framework+  to the Fourier Transform library @cufft@+  provided by Nvidia for their CUDA enabled graphic cards.+Tested-With:      GHC==7.8.3+Cabal-Version:    >=1.14+Build-Type:       Simple++Flag buildExamples+  description: Build example executables+  default:     False++Source-Repository this+  Tag:         0.0+  Type:        darcs+  Location:    http://code.haskell.org/~thielema/accelerate-cufft/++Source-Repository head+  Type:        darcs+  Location:    http://code.haskell.org/~thielema/accelerate-cufft/++Library+  Build-Depends:+    cufft >=0.1.1 && <0.2,+    cuda >= 0.5 && <0.7,+    accelerate-fourier >=0.0 && <0.1,+    accelerate-utility >=0.1 && <0.2,+    accelerate-cuda >=0.15 && <0.16,+    accelerate >=0.15 && <0.16,+    base >=4.5 && <4.8++  GHC-Options:      -Wall -fwarn-missing-import-lists+  Hs-Source-Dirs:   src+  Default-Language: Haskell98+  Exposed-Modules:+    Data.Array.Accelerate.CUFFT.Single+    Data.Array.Accelerate.CUFFT.Batched+  Other-Modules:+    Data.Array.Accelerate.CUFFT.Private+    Data.Array.Accelerate.CUFFT.RealClass++Executable accelerate-cufft-demo+  GHC-Options:      -Wall -fwarn-missing-import-lists -threaded+  Hs-Source-Dirs:   example+  Main-Is:          Main.hs+  Default-Language: Haskell98+  If flag(buildExamples)+    Build-Depends:+      accelerate-cufft,+      accelerate-cuda,+      accelerate,+      base+  Else+    Buildable: False++Executable accelerate-cufft-demo-merged+  GHC-Options:      -Wall -fwarn-missing-import-lists -threaded+  Hs-Source-Dirs:   example+  Main-Is:          Merged.hs+  Default-Language: Haskell98+  If flag(buildExamples)+    Build-Depends:+      accelerate-cuda,+      accelerate,+      cufft,+      cuda,+      base+  Else+    Buildable: False++Executable accelerate-cufft-demo-separate+  GHC-Options:      -Wall -fwarn-missing-import-lists -threaded+  Hs-Source-Dirs:   example+  Main-Is:          Separate.hs+  Default-Language: Haskell98+  If flag(buildExamples)+    Build-Depends:+      accelerate-cuda,+      accelerate,+      cufft,+      cuda,+      base+  Else+    Buildable: False++Executable cufft-demo+  GHC-Options:      -Wall -fwarn-missing-import-lists -threaded+  Hs-Source-Dirs:   example+  Main-Is:          CUFFT.hs+  Default-Language: Haskell98+  If flag(buildExamples)+    Build-Depends:+      cufft,+      cuda,+      base+  Else+    Buildable: False
+ example/CUFFT.hs view
@@ -0,0 +1,14 @@+module Main where++import qualified Foreign.CUDA.Runtime as CUDA+import qualified Foreign.CUDA.FFT as CUFFT+++main :: IO ()+main =+   CUDA.withListArrayLen [0,1,0,0,0] $ \width inp -> do+      let outlen = (div width 2 + 1) * 2+      out <- CUDA.mallocArray outlen+      h <- CUFFT.plan1D width CUFFT.R2C 1+      CUFFT.execR2C h inp out+      print =<< CUDA.peekListArray outlen out
+ example/Main.hs view
@@ -0,0 +1,44 @@+module Main where++import qualified Data.Array.Accelerate.CUFFT.Batched as Batched+import qualified Data.Array.Accelerate.CUFFT.Single as Single+import qualified Data.Array.Accelerate.CUDA.Foreign as AF+import qualified Data.Array.Accelerate.CUDA as CUDA+import qualified Data.Array.Accelerate as A+import Data.Array.Accelerate (Z(Z), (:.)((:.)))+++mainSingle :: IO ()+mainSingle = do+   let dim = Z:.7+   hf <- AF.inDefaultContext $ Single.plan1D Single.forwardReal dim+   let spec =+          CUDA.run1 (Single.transform hf) $+          A.fromList dim $ 0 : 1 : repeat (0 :: Float)+   print spec++   hb <- AF.inDefaultContext $ Single.plan1D Single.inverseReal dim+   print $ CUDA.run1 (Single.transform hb) spec+++mainBatched :: IO ()+mainBatched = do+   let count, width :: Int+       count = 3; width = 7+       dim :: A.DIM2+       dim = Z:.count:.width++   hf <- AF.inDefaultContext $ Batched.plan1D Batched.forwardReal dim+   let spec =+          CUDA.run1 (Batched.transform hf) $+          A.fromList dim $ concat $+          take count $ map (take width) $+          iterate (0:) $ 1 : repeat (0 :: Float)+   print spec++   hb <- AF.inDefaultContext $ Batched.plan1D Batched.inverseReal dim+   print $ CUDA.run1 (Batched.transform hb) spec+++main :: IO ()+main = mainSingle >> mainBatched
+ example/Merged.hs view
@@ -0,0 +1,39 @@+{- |+Simple manual implementation+of embedding cufft functionality in the @accelerate@ framework.+In this example, a plan is created for every transform+and is run within 'CUDA.run1'.+-}+module Main where++import qualified Data.Array.Accelerate.CUDA.Foreign as AF+import qualified Data.Array.Accelerate.CUDA as CUDA++import qualified Foreign.CUDA.FFT as CUFFT++import qualified Data.Array.Accelerate as A+import Data.Array.Accelerate (Acc, Vector, Z(Z), (:.)((:.)), )+++transformForeign :: Vector Float -> AF.CIO (Vector Float)+transformForeign input =+   let (Z:.inlen) = A.arrayShape input+       outlen = (div inlen 2 + 1) * 2+   in  do+       output <- AF.allocateArray (Z:.outlen)+       ((), iptr) <- AF.devicePtrsOfArray input+       ((), optr) <- AF.devicePtrsOfArray output+       AF.liftIO $ do+          h <- CUFFT.plan1D inlen CUFFT.R2C 1+          CUFFT.execR2C h iptr optr+       return output++transform :: Acc (Vector Float) -> Acc (Vector Float)+transform =+   A.foreignAcc+      (AF.CUDAForeignAcc "transformForeign" transformForeign)+      (error "no fft fallback implemented")++main :: IO ()+main =+   print $ CUDA.run1 transform $ A.fromList (Z:.5) [1,0,0,0,0]
+ example/Separate.hs view
@@ -0,0 +1,39 @@+{- |+Simple manual implementation+of embedding cufft functionality in the @accelerate@ framework.+In this example, a plan is created once globally+and must be run 'inDefaultContext'.+-}+module Main where++import qualified Data.Array.Accelerate.CUDA.Foreign as AF+import qualified Data.Array.Accelerate.CUDA as CUDA++import qualified Foreign.CUDA.FFT as CUFFT++import qualified Data.Array.Accelerate as A+import Data.Array.Accelerate (Acc, Vector, Z(Z), (:.)((:.)), )+++transformForeign :: CUFFT.Handle -> Vector Float -> AF.CIO (Vector Float)+transformForeign h input =+   let (Z:.inlen) = A.arrayShape input+       outlen = (div inlen 2 + 1) * 2+   in  do+       output <- AF.allocateArray (Z:.outlen)+       ((), iptr) <- AF.devicePtrsOfArray input+       ((), optr) <- AF.devicePtrsOfArray output+       AF.liftIO $ CUFFT.execR2C h iptr optr+       return output++transform :: CUFFT.Handle -> Acc (Vector Float) -> Acc (Vector Float)+transform h =+   A.foreignAcc+      (AF.CUDAForeignAcc "transformForeign" $ transformForeign h)+      (error "no fft fallback implemented")++main :: IO ()+main = do+   let inlen = 5+   h <- AF.inDefaultContext $ CUFFT.plan1D inlen CUFFT.R2C 1+   print $ CUDA.run1 (transform h) $ A.fromList (Z:.inlen) [1,0,0,0,0]
+ src/Data/Array/Accelerate/CUFFT/Batched.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{- |+Transformations of collections of datasets.+-}+module Data.Array.Accelerate.CUFFT.Batched (+   Priv.Transform,+   Priv.transform,++   Handle,+   plan1D,+   plan2D,+   plan3D,++   RC.Real,+   Mode,+   Priv.forwardComplex, Priv.inverseComplex,+   Priv.forwardReal, Priv.inverseReal,+   Batch0, Batch1, Batch2, Batch3,+   ) where++import qualified Data.Array.Accelerate.CUFFT.Private as Priv+import Data.Array.Accelerate.CUFFT.Private+          (Batch0, Batch1, Batch2, Batch3,+           Mode, wrapFallback, Handle, makeHandle, )++import qualified Data.Array.Accelerate.CUFFT.RealClass as RC++import qualified Data.Array.Accelerate.Fourier.Planned as Fourier++import qualified Data.Array.Accelerate as A+import Data.Array.Accelerate (Elt, Shape, Slice, (:.)((:.)), )++import qualified Foreign.CUDA.FFT as CUFFT+++{- |+The plan must be created in the 'Data.Array.Accelerate.CUDA.Context'+where 'Priv.transform' is executed.+E.g. if you run 'Priv.transform' in 'Data.Array.Accelerate.CUDA.run1',+then you must call 'plan1D'+within 'Data.Array.Accelerate.CUDA.Foreign.inDefaultContext'.+-}+plan1D ::+   (Shape sh, Slice sh, Elt e, RC.Real e) =>+   Mode (Batch1 sh) e a b -> Batch1 sh -> IO (Handle (Batch1 sh) e a b)+plan1D mode (batch:.width) =+   makeHandle mode width+      (\sign -> wrapFallback mode $ Fourier.transform sign width)+      (\typ -> CUFFT.planMany [width] Nothing Nothing typ (A.arraySize batch))++plan2D ::+   (Shape sh, Slice sh, Elt e, RC.Real e) =>+   Mode (Batch2 sh) e a b -> Batch2 sh -> IO (Handle (Batch2 sh) e a b)+plan2D mode sh@(batch:.height:.width) =+   makeHandle mode width+      (wrapFallback mode . Priv.transform2D sh)+      (\typ ->+         CUFFT.planMany [height,width] Nothing Nothing typ (A.arraySize batch))++plan3D ::+   (Shape sh, Slice sh, Elt e, RC.Real e) =>+   Mode (Batch3 sh) e a b ->+   Batch3 sh -> IO (Handle (Batch3 sh) e a b)+plan3D mode sh@(batch:.depth:.height:.width) =+   makeHandle mode width+      (wrapFallback mode . Priv.transform3D sh)+      (\typ ->+         CUFFT.planMany [depth,height,width]+            Nothing Nothing typ (A.arraySize batch))
+ src/Data/Array/Accelerate/CUFFT/Private.hs view
@@ -0,0 +1,335 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{- |+Accelerate interface to the native CUDA implementation+of the Fourier Transform provided by the CUFFT library.+-}+module Data.Array.Accelerate.CUFFT.Private where++import qualified Data.Array.Accelerate.CUFFT.RealClass as RC++import qualified Data.Array.Accelerate.Fourier.Preprocessed as Prep+import qualified Data.Array.Accelerate.Fourier.Planned as Fourier++import qualified Data.Array.Accelerate.Utility.Lift.Exp as Exp+import qualified Data.Array.Accelerate.Utility.Sliced as Sliced+import Data.Array.Accelerate.Utility.Lift.Exp (expr)++import qualified Data.Array.Accelerate.CUDA.Foreign as AF+import qualified Data.Array.Accelerate as A+import Data.Array.Accelerate.Data.Complex (Complex((:+)), real, imag, conjugate)+import Data.Array.Accelerate+          (Acc, Array, Elt, Shape, Slice, (:.)((:.)),+           Exp, (!), (?), (==*), (<*),)++import qualified Foreign.CUDA.FFT as CUFFT+import qualified Foreign.CUDA.Driver as CUDA+import Foreign.CUDA.Ptr (DevicePtr, )++import qualified System.Mem.Weak as Weak+++type Transform sh a b = Acc (Array sh a) -> Acc (Array sh b)+++type Sign a = (Int, Fourier.Sign a)++forwardSign, inverseSign :: Num a => Sign a+forwardSign = (-1, Fourier.forward)+inverseSign = ( 1, Fourier.inverse)+++data+   Handle sh e a b =+      Handle (Transform sh a b) (Mode sh e a b) Int CUFFT.Handle++makeHandle ::+   (Shape sh, Slice sh, RC.Real e) =>+   Mode sh e a b -> Int ->+   (Fourier.Sign e -> Transform sh a b) ->+   (CUFFT.Type -> IO CUFFT.Handle) ->+   IO (Handle sh e a b)+makeHandle mode width fallback planner = do+   plan <- planner $ types mode+   Weak.addFinalizer plan (CUFFT.destroy plan)+   return $ Handle (fallback $ fsign mode) mode width plan+++type Batch0 sh = sh+type Batch1 sh = Batch0 sh :. Int+type Batch2 sh = Batch1 sh :. Int+type Batch3 sh = Batch2 sh :. Int++transform2D ::+   (Shape sh, Slice sh, Elt a, RC.Real a) =>+   Batch2 sh -> Fourier.Sign a ->+   Fourier.Transform (Batch2 sh) (Complex a)+transform2D (_shape:.height:.width) sign =+   Prep.transform2d $+      Prep.SubTransformPair+         (Fourier.transform sign width)+         (Fourier.transform sign height)+++transform3D ::+   (Shape sh, Slice sh, Elt a, RC.Real a) =>+   Batch3 sh -> Fourier.Sign a ->+   Fourier.Transform (Batch3 sh) (Complex a)+transform3D (_shape:.depth:.height:.width) sign =+   Prep.transform3d $+   Prep.SubTransformTriple+      (Fourier.transform sign width)+      (Fourier.transform sign height)+      (Fourier.transform sign depth)+++{- |+The implementation works on all arrays of rank less than or equal to 3.+The result is un-normalised.+-}+transform ::+   (Shape sh, Slice sh, Elt e, RC.Real e) =>+   Handle (sh:.Int) e a b ->+   Transform (sh:.Int) a b+transform hndl@(Handle fallback mode width _) =+   {-+   Unfortunately the fallback version of the function+   needs to be wrapped in 'interleave' and 'deinterleave'+   to match the data layout as expected by the foreign version.+   Fusion might remove redundant transformations.+   The optimal solution is to make the backend explicit in the type,+   which allows us to declare back-end specific functions+   without a fall-back implementation.+   -}+   wrap mode (A.constant width) $+   A.foreignAcc+      (AF.CUDAForeignAcc "transformForeign" $ transformForeign hndl)+      (unwrap mode (A.constant width) fallback)+++forwardComplex, inverseComplex ::+   (Shape sh, Slice sh, RC.Real e) =>+   Mode sh e (Complex e) (Complex e)+forwardComplex =+   getModeC2C $ RC.switch (modeC2CFloat forwardSign) (modeC2CDouble forwardSign)+inverseComplex =+   getModeC2C $ RC.switch (modeC2CFloat inverseSign) (modeC2CDouble inverseSign)++{- |+In contrast to plain CUFFT functions the data is redundant.+That is, an array of shape @sh@ is transformed to an array of shape @sh@.+This way, all dimensions of an array are handled the same way.+Chances are good,+that the internal post processing is fused with following array operations+and thus the redundant data will not be stored in a manifest array.+-}+forwardReal ::+   (Shape sh, Slice sh, RC.Real e) =>+   Mode (sh:.Int) e e (Complex e)+forwardReal =+   getModeR2C $+   RC.switch+      (modeR2C CUFFT.R2C CUFFT.execR2C)+      (modeR2C CUFFT.D2Z CUFFT.execD2Z)++inverseReal ::+   (Shape sh, Slice sh, RC.Real e) =>+   Mode (sh:.Int) e (Complex e) e+inverseReal =+   getModeC2R $+   RC.switch+      (modeC2R CUFFT.C2R CUFFT.execC2R)+      (modeC2R CUFFT.Z2D CUFFT.execZ2D)+++data Types = R2C | C2R | C2C+   deriving (Eq, Ord, Enum, Show)+++data Mode sh e a b =+   Mode {+      types :: CUFFT.Type,+      plainTypes :: Types,+      execute :: CUFFT.Handle -> CUDA.DevicePtr e -> CUDA.DevicePtr e -> IO (),+      wrap :: Exp Int -> Fourier.Transform (sh:.Int) e -> Transform sh a b,+      unwrap :: Exp Int -> Transform sh a b -> Fourier.Transform (sh:.Int) e,+      wrapFallback :: Fourier.Transform sh (Complex e) -> Transform sh a b,+      fsign :: Fourier.Sign e+   }++newtype+   ModeC2C sh e =+      ModeC2C {getModeC2C :: Mode sh e (Complex e) (Complex e)}++newtype+   ModeR2C sh e =+      ModeR2C {getModeR2C :: Mode sh e e (Complex e)}++newtype+   ModeC2R sh e =+      ModeC2R {getModeC2R :: Mode sh e (Complex e) e}+++type Execute e = CUFFT.Handle -> DevicePtr e -> DevicePtr e -> IO ()+type ExecuteSign e = CUFFT.Handle -> DevicePtr e -> DevicePtr e -> Int -> IO ()+++modeC2C ::+   (Shape sh, Slice sh, RC.Real e, Elt e) =>+   CUFFT.Type -> ExecuteSign e -> Sign e -> ModeC2C sh e+modeC2C typ exec (isign,fsign0) =+   ModeC2C $+   Mode {+      types = typ,+      execute = \hndl iptr optr -> exec hndl iptr optr isign,+      plainTypes = C2C,+      wrap = \ _width f -> deinterleave . f . interleave,+      unwrap = \ _width f -> interleave . f . deinterleave,+      wrapFallback = id,+      fsign = fsign0+   }++modeC2CFloat :: (Shape sh, Slice sh) => Sign Float -> ModeC2C sh Float+modeC2CFloat = modeC2C CUFFT.C2C CUFFT.execC2C++modeC2CDouble :: (Shape sh, Slice sh) => Sign Double -> ModeC2C sh Double+modeC2CDouble = modeC2C CUFFT.Z2Z CUFFT.execZ2Z+++{-+The fallback implementation is inefficient+because it does not benefit from occurring symmetries.+However, it works generally for all dimensions+and also for odd data set sizes.+-}+modeR2C ::+   (Shape sh, Slice sh, RC.Real e, Elt e) =>+   CUFFT.Type -> Execute e -> ModeR2C (sh:.Int) e+modeR2C typ exec =+   ModeR2C $+   Mode {+      types = typ,+      execute = exec,+      plainTypes = R2C,+      wrap = \width f -> mirror width . deinterleave . f . addDim,+      unwrap = \width f -> interleave . takeHalf width . f . removeDim,+      wrapFallback = (. A.map (Exp.modify expr (:+0))),+      fsign = Fourier.forward+   }++modeC2R ::+   (Shape sh, Slice sh, RC.Real e, Elt e) =>+   CUFFT.Type -> Execute e -> ModeC2R (sh:.Int) e+modeC2R typ exec =+   ModeC2R $+   Mode {+      types = typ,+      execute = exec,+      plainTypes = C2R,+      wrap = \width f -> removeDim . f . interleave . takeHalf width,+      unwrap = \width f -> addDim . f . mirror width . deinterleave,+      wrapFallback = (A.map real .),+      fsign = Fourier.inverse+   }+++transformForeign ::+   (Shape sh, Elt e, RC.Real e) =>+   Handle (sh:.Int) e a b ->+   Array (sh:.Int:.Int) e -> AF.CIO (Array (sh:.Int:.Int) e)+transformForeign (Handle _ mode width hndl) input = do+   let (shape :. _width :. _tupleSize) = A.arrayShape input+       outputSh =+          case plainTypes mode of+             R2C -> shape :. div width 2 + 1 :. 2+             C2R -> shape :. width :. 1+             C2C -> shape :. width :. 2+   output <- AF.allocateArray outputSh+   iptr   <- getDevicePtr input+   optr   <- getDevicePtr output+   AF.liftIO $ execute mode hndl iptr optr+   return output+++newtype+   GetDevicePtr sh e =+      GetDevicePtr {+         runGetDevicePtr :: Array sh e -> AF.CIO ((), CUDA.DevicePtr e)+      }++getDevicePtr ::+   (RC.Real e) =>+   Array sh e -> AF.CIO (CUDA.DevicePtr e)+getDevicePtr =+   fmap snd .+   runGetDevicePtr+      (RC.switch+         (GetDevicePtr AF.devicePtrsOfArray)+         (GetDevicePtr AF.devicePtrsOfArray))+++{-+The rule "interleave/deinterleave" may turn a bottom into the identity,+if the input array has not extent 2 at the least-significant dimension.+The rule is only safe for the usage in this module.+-}+{-# RULES+  "interleave/deinterleave" forall x. deinterleave (interleave x) = x;+  "deinterleave/interleave" forall x. interleave (deinterleave x) = x;+  "addDim/removeDim" forall x. removeDim (addDim x) = x;+  "removeDim/addDim" forall x. addDim (removeDim x) = x;+ #-}++{- |+Imitate cuComplex types by interleaving real and imaginary components.+Adds a least-significant dimension of extent 2.+-}+{-# NOINLINE[1] interleave #-}+interleave ::+   (Shape sh, Slice sh, Elt a) =>+   Acc (Array sh (Complex a)) -> Acc (Array (sh:.Int) a)+interleave arr =+   A.generate+      (A.lift $ A.shape arr :. (2::Int))+      (\ix ->+         let x = arr ! A.indexTail ix+         in  A.indexHead ix ==* 0 ? (real x, imag x))++{-# NOINLINE[1] deinterleave #-}+deinterleave ::+   (Shape sh, Slice sh, Elt a) =>+   Acc (Array (sh:.Int) a) -> Acc (Array sh (Complex a))+deinterleave arr =+   A.generate (A.indexTail $ A.shape arr)+      (\ix ->+         let get n = arr ! A.lift (ix :. (n::Int))+         in  A.lift $ get 0 :+ get 1)++{-# NOINLINE[1] addDim #-}+addDim ::+   (Shape sh, Slice sh, Elt a) =>+   Acc (Array sh a) -> Acc (Array (sh:.Int) a)+addDim arr = A.reshape (A.lift $ A.shape arr :. (1::Int)) arr++{-# NOINLINE[1] removeDim #-}+removeDim ::+   (Shape sh, Slice sh, Elt a) =>+   Acc (Array (sh:.Int) a) -> Acc (Array sh a)+removeDim arr = A.reshape (A.indexTail $ A.shape arr) arr+++takeHalf ::+   (Shape sh, Slice sh, Elt a) =>+   Exp Int -> Fourier.Transform (sh:.Int) a+takeHalf width = Sliced.take (div width 2 + 1)++mirror ::+   (Shape sh, Slice sh, Elt a, A.IsNum a) =>+   Exp Int -> Fourier.Transform (sh:.Int) (Complex a)+mirror newWidth arr =+   let (sh:.width) = Exp.unlift (expr:.expr) $ A.shape arr+   in  A.generate (A.lift $ sh :. newWidth) $+       Exp.modify (expr:.expr) $ \(ix:.k) ->+          k <* width ?+             (arr ! Exp.indexCons ix k,+              conjugate (arr ! Exp.indexCons ix (newWidth - k)))
+ src/Data/Array/Accelerate/CUFFT/RealClass.hs view
@@ -0,0 +1,13 @@+module Data.Array.Accelerate.CUFFT.RealClass where++import qualified Data.Array.Accelerate as A++import qualified Prelude as P+import Prelude (Float, Double)+++class (P.RealFloat e, A.IsFloating e) => Real e where+   switch :: f Float -> f Double -> f e++instance Real Float  where switch f _ = f+instance Real Double where switch _ f = f
+ src/Data/Array/Accelerate/CUFFT/Single.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{- |+Transformations of single datasets.+-}+module Data.Array.Accelerate.CUFFT.Single (+   Priv.Transform,+   Priv.transform,++   Handle,+   plan1D,+   plan2D,+   plan3D,++   RC.Real,+   Mode,+   Priv.forwardComplex, Priv.inverseComplex,+   Priv.forwardReal, Priv.inverseReal,+   ) where++import qualified Data.Array.Accelerate.CUFFT.RealClass as RC+import qualified Data.Array.Accelerate.CUFFT.Private as Priv+import Data.Array.Accelerate.CUFFT.Private+          (Mode, wrapFallback, Handle, makeHandle, )++import qualified Data.Array.Accelerate.Fourier.Planned as Fourier++import Data.Array.Accelerate (Elt, DIM1, DIM2, DIM3, Z(Z), (:.)((:.)), )++import qualified Foreign.CUDA.FFT as CUFFT+++{- |+The plan must be created in the context where the transform is executed.+See 'Data.Array.Accelerate.CUFFT.Batched.plan1D' for details.+-}+plan1D ::+   (Elt e, RC.Real e) =>+   Mode DIM1 e a b -> DIM1 -> IO (Handle DIM1 e a b)+plan1D mode (Z:.width) =+   makeHandle mode width+      (\sign -> wrapFallback mode $ Fourier.transform sign width)+      (\typ -> CUFFT.plan1D width typ 1)++plan2D ::+   (Elt e, RC.Real e) =>+   Mode DIM2 e a b -> DIM2 -> IO (Handle DIM2 e a b)+plan2D mode sh@(Z:.height:.width) =+   makeHandle mode width+      (wrapFallback mode . Priv.transform2D sh)+      (CUFFT.plan2D height width)++plan3D ::+   (Elt e, RC.Real e) =>+   Mode DIM3 e a b -> DIM3 -> IO (Handle DIM3 e a b)+plan3D mode sh@(Z:.depth:.height:.width) =+   makeHandle mode width+      (wrapFallback mode . Priv.transform3D sh)+      (CUFFT.plan3D depth height width)