diff --git a/accelerate-fourier.cabal b/accelerate-fourier.cabal --- a/accelerate-fourier.cabal +++ b/accelerate-fourier.cabal @@ -1,10 +1,10 @@ Name: accelerate-fourier -Version: 1.0.0.5 +Version: 1.0.0.6 License: BSD3 License-File: LICENSE Author: Henning Thielemann Maintainer: Henning Thielemann -Homepage: http://hub.darcs.net/thielema/accelerate-fourier/ +Homepage: https://hub.darcs.net/thielema/accelerate-fourier/ Category: Math Synopsis: Fast Fourier transform and convolution using the Accelerate framework Description: @@ -22,21 +22,22 @@ Build-Type: Simple Source-Repository this - Tag: 1.0.0.5 + Tag: 1.0.0.6 Type: darcs - Location: http://hub.darcs.net/thielema/accelerate-fourier/ + Location: https://hub.darcs.net/thielema/accelerate-fourier/ Source-Repository head Type: darcs - Location: http://hub.darcs.net/thielema/accelerate-fourier/ + Location: https://hub.darcs.net/thielema/accelerate-fourier/ Library Build-Depends: accelerate-arithmetic >=1.0 && <1.1, - accelerate-utility >=1.0 && <1.1, - accelerate >=1.0 && <1.2, - containers >=0.5 && <0.6, - transformers >=0.3 && <0.6, + accelerate-utility >=1.1 && <1.2, + accelerate >=1.3 && <1.5, + containers >=0.5 && <0.9, + transformers >=0.3 && <0.7, + non-empty >=0.3.3 && <0.4, utility-ht >=0.0.8 && <0.1, QuickCheck >=2.4 && <3, base >=4.5 && <5 @@ -86,7 +87,7 @@ Hs-Source-Dirs: benchmark Default-Language: Haskell98 Build-Depends: - criterion >=1.0 && <1.5, + criterion >=1.0 && <1.7, accelerate-fourier, accelerate-arithmetic, accelerate-utility, diff --git a/src/Data/Array/Accelerate/Fourier/Adhoc.hs b/src/Data/Array/Accelerate/Fourier/Adhoc.hs --- a/src/Data/Array/Accelerate/Fourier/Adhoc.hs +++ b/src/Data/Array/Accelerate/Fourier/Adhoc.hs @@ -187,15 +187,8 @@ (\x -> A.unit $ (Sliced.length $ A.afst x) A.> 1) (Acc.modify (acc,acc) $ \(arr,factors) -> - let divides k n = mod n k A.== 0 - caseFactor k = (divides k, k) - len = Sliced.length arr - factor = - flip (A.caseof len) 2 $ - caseFactor 3 : - caseFactor 4 : - caseFactor 5 : - [] + let len = Sliced.length arr + factor = foldr (\k -> A.ifThenElse (mod len k A.== 0) k) 2 [3,4,5] in (twist factor arr, Sliced.consExp factor factors)) . A.lift . flip (,) (A.fill (A.index1 0) 0) @@ -239,7 +232,7 @@ let d3 = ceilingLogBase 3 n d5 = ceilingLogBase 5 n in A.the $ argminimum $ - A.generate (A.lift $ Z:.d5:.d3) $ + A.generate (A.lift $ Z:.(d5+1):.(d3+1)) $ Exp.modify (expr:.expr:.expr) $ \(_z:.e5:.e3) -> let p53 = 5 ** A.fromIntegral e5 * 3 ** A.fromIntegral e3 diff --git a/src/Data/Array/Accelerate/Fourier/Private.hs b/src/Data/Array/Accelerate/Fourier/Private.hs --- a/src/Data/Array/Accelerate/Fourier/Private.hs +++ b/src/Data/Array/Accelerate/Fourier/Private.hs @@ -10,12 +10,13 @@ import qualified Data.Array.Accelerate.Utility.Sliced as Sliced import qualified Data.Array.Accelerate.Utility.Sliced1 as Sliced1 +import qualified Data.Array.Accelerate.Utility.Lift.Exp as AExp import qualified Data.Array.Accelerate.LinearAlgebra as LinAlg import Data.Array.Accelerate.LinearAlgebra (zipExtrudedVectorWith, ) import qualified Data.Array.Accelerate.Utility.Lift.Exp as Exp -import Data.Array.Accelerate.Utility.Lift.Exp (expr) +import Data.Array.Accelerate.Utility.Lift.Exp (expr, accessElement) import qualified Data.Array.Accelerate as A import Data.Array.Accelerate @@ -23,7 +24,9 @@ Z(Z), (:.)((:.)), Slice, Shape, (!), (?), ) import Data.Complex (Complex((:+)), ) +import Data.NonEmpty ((!:)) + type Transform sh a = Acc (Array sh a) -> Acc (Array sh a) data SubTransform a = @@ -109,11 +112,8 @@ (Exp.indexCons (A.shape x) (A.constant (3::Int))) (Exp.modify (expr :. expr) $ \(ix :. k) -> - let (x0,x1,x2) = A.unlift $ x ! ix - in flip (A.caseof k) x0 $ - ((A.==1), x1) : - ((A.==2), x2) : - []) + let (x0,x1,x2) = AExp.unliftTriple $ x ! ix + in accessElement (x0 !: x1 : x2 : []) k) transform3 :: (Shape sh, Slice sh, a ~ Complex b, A.RealFloat b) => @@ -138,12 +138,8 @@ (Exp.indexCons (A.shape x) (A.constant (4::Int))) (Exp.modify (expr :. expr) $ \(ix :. k) -> - let (x0,x1,x2,x3) = A.unlift $ x ! ix - in flip (A.caseof k) x0 $ - ((A.==1), x1) : - ((A.==2), x2) : - ((A.==3), x3) : - []) + let (x0,x1,x2,x3) = AExp.unliftQuadruple $ x ! ix + in accessElement (x0 !: x1 : x2 : x3 : []) k) transform4 :: (Shape sh, Slice sh, a ~ Complex b, A.RealFloat b) => @@ -171,13 +167,8 @@ (Exp.indexCons (A.shape x) (A.constant (5::Int))) (Exp.modify (expr :. expr) $ \(ix :. k) -> - let (x0,x1,x2,x3,x4) = A.unlift $ x ! ix - in flip (A.caseof k) x0 $ - ((A.==1), x1) : - ((A.==2), x2) : - ((A.==3), x3) : - ((A.==4), x4) : - []) + let (x0,x1,x2,x3,x4) = AExp.unliftQuintuple $ x ! ix + in accessElement (x0 !: x1 : x2 : x3 : x4 : []) k) {- diff --git a/src/Data/Array/Accelerate/Fourier/Sign.hs b/src/Data/Array/Accelerate/Fourier/Sign.hs --- a/src/Data/Array/Accelerate/Fourier/Sign.hs +++ b/src/Data/Array/Accelerate/Fourier/Sign.hs @@ -2,50 +2,40 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} module Data.Array.Accelerate.Fourier.Sign where import Data.Array.Accelerate.Data.Complex (Complex((:+)), ) import qualified Data.Array.Accelerate as A -import Data.Array.Accelerate (Lift(lift), Unlift(unlift), Plain, ) -import Data.Array.Accelerate.Product - (IsProduct(ProdRepr, fromProd, toProd, prod), - ProdR(ProdRsnoc, ProdRunit), - TupleIdx(ZeroTupIdx), ) -import Data.Array.Accelerate.Array.Sugar - (Tuple(NilTup, SnocTup), - EltRepr, Elt(eltType, toElt, fromElt), ) -import Data.Array.Accelerate.Smart (Exp(Exp), PreExp(Tuple, Prj), ) +import Data.Array.Accelerate (Lift(lift), Unlift(unlift), Plain, Exp) +import Data.Array.Accelerate.Sugar.Elt (Elt) import Data.Typeable (Typeable, ) import qualified Test.QuickCheck as QC +-- cf. colour-accelerate-0.4.0.0 newtype Sign a = Sign {getSign :: a} - deriving (Eq, Show, Typeable) - -type instance EltRepr (Sign a) = EltRepr a + deriving (Eq, Show, Typeable, A.Generic) -instance Elt a => Elt (Sign a) where - eltType = eltType . getSign - toElt = Sign . toElt - fromElt = fromElt . getSign +{-# COMPLETE Sign_ #-} +pattern Sign_ :: Elt a => Exp a -> Exp (Sign a) +pattern Sign_ x = A.Pattern x -instance (cst a) => IsProduct cst (Sign a) where - type ProdRepr (Sign a) = ((), a) - fromProd _ (Sign a) = ((), a) - toProd _ ((), a) = Sign a - prod _ (Sign _) = ProdRsnoc ProdRunit +instance Elt a => Elt (Sign a) instance (Lift Exp a, Elt (Plain a)) => Lift Exp (Sign a) where type Plain (Sign a) = Sign (Plain a) - lift (Sign a) = Exp $ Tuple (NilTup `SnocTup` lift a) + lift (Sign a) = Sign_ (lift a) instance Elt a => Unlift Exp (Sign (Exp a)) where - unlift e = Sign $ Exp $ ZeroTupIdx `Prj` e + unlift (Sign_ a) = Sign a forward, inverse :: Num a => Sign a diff --git a/src/Data/Array/Accelerate/Permutation.hs b/src/Data/Array/Accelerate/Permutation.hs --- a/src/Data/Array/Accelerate/Permutation.hs +++ b/src/Data/Array/Accelerate/Permutation.hs @@ -69,7 +69,7 @@ inverse perm = A.permute (+) (A.fill (A.shape perm) 0) - (A.index1 . (perm!)) + (A.Just_ . A.index1 . (perm!)) (A.generate (A.shape perm) A.unindex1) reverse :: T -> T