accelerate-examples 1.0.0.0 → 1.1.0.0
raw patch · 33 files changed
+428/−529 lines, 33 filesdep −accelerate-cudadep −accelerate-icc-opencldep ~acceleratedep ~accelerate-examplesdep ~accelerate-fft
Dependencies removed: accelerate-cuda, accelerate-icc-opencl
Dependency ranges changed: accelerate, accelerate-examples, accelerate-fft, accelerate-llvm-native, accelerate-llvm-ptx, base, criterion
Files
- README.md +67/−0
- accelerate-examples.cabal +228/−122
- examples/canny/src-acc/Canny.hs +10/−10
- examples/crystal/Main.hs +1/−1
- examples/fluid/src-acc/Config.hs +1/−1
- examples/fluid/src-acc/Event.hs +11/−4
- examples/fluid/src-acc/Fluid.hs +6/−6
- examples/fluid/src-acc/Main.hs +2/−2
- examples/fluid/src-acc/Type.hs +2/−2
- examples/kmeans/GenSamples.hs +0/−114
- examples/mandelbrot/README.md +1/−1
- examples/mandelbrot/World.hs +3/−3
- examples/n-body/Common/Dump.hs +0/−52
- examples/nofib/Test/Foreign.hs +2/−2
- examples/nofib/Test/Foreign/CUDA.hs +0/−43
- examples/nofib/Test/Imaginary/DotP.hs +1/−1
- examples/nofib/Test/Imaginary/SAXPY.hs +1/−1
- examples/nofib/Test/Issues/Issue264.hs +4/−4
- examples/nofib/Test/Issues/Issue286.hs +2/−2
- examples/nofib/Test/Prelude/Backpermute.hs +5/−5
- examples/nofib/Test/Prelude/Filter.hs +1/−1
- examples/nofib/Test/Prelude/Fold.hs +5/−5
- examples/nofib/Test/Prelude/Permute.hs +3/−3
- examples/nofib/Test/Prelude/Scan.hs +6/−6
- examples/nofib/Test/Prelude/Stencil.hs +7/−7
- examples/nofib/Test/Prelude/ZipWith.hs +30/−30
- examples/nofib/Test/Sharing.hs +4/−4
- examples/nofib/Test/Spectral/SMVM.hs +1/−1
- examples/smoothlife/Gloss/Simulate.hs +4/−2
- examples/smoothlife/SmoothLife.hs +5/−4
- examples/tunnel/Main.hs +1/−1
- lib/Data/Array/Accelerate/Examples/Internal/Backend.hs +12/−89
- lib/Data/Array/Accelerate/Examples/Internal/Monitoring.hs +2/−0
+ README.md view
@@ -0,0 +1,67 @@+Examples programs using Accelerate+==================================++[](https://travis-ci.org/AccelerateHS/accelerate-examples)+[](https://hackage.haskell.org/package/accelerate-examples)+[](https://hub.docker.com/r/tmcdonell/accelerate-examples/)+[](https://microbadger.com/images/tmcdonell/accelerate-examples)++Example programs using the Accelerate library. If you add new features to the+base library or find a bug, please add a test case. The aim is for this program+to evolve and be useful for both performance and regression testing.++If you have found a bug, please report it to:+https://github.com/AccelerateHS/accelerate/issues+++Installation+------------++### External dependencies++Installation of `accelerate-examples` and its dependencies requires several+external packages. You may need to adjust the package names or versions slightly+for your system.++ * Ubuntu/Debian (apt-get):+ - llvm-4.0-dev+ - freeglut3-dev+ - libfftw3-dev++ * Mac OS ([homebrew](http://brew.sh/index.html))+ - fftw+ - libffi+ - llvm-hs/homebrew-llvm/llvm-4.0++If you want to use the CUDA GPU enabled backend+[`accelerate-llvm-ptx`](https://github.com/AccelerateHS/accelerate-llvm), you+will also need to install the CUDA toolkit for your system. You can find an+installer on NVIDIA's website here:++ * https://developer.nvidia.com/cuda-downloads+++### stack++For development, the recommend build method is via the+[`stack`](http://haskellstack.org) tool. This will simplify pulling in+dependencies not yet on Hackage. For example, to build using ghc-8.0:++```bash+ln -s stack-8.0.yaml stack.yaml # only once+stack build # or, 'stack install' to install the executables globally+```++Before building, you may want to edit the `stack.yaml` file to change the build+configuration. In particular, the `flags` section at the bottom can be used to+enable or disable individual example programs and accelerate backends, as well+as features such as monitoring and debug output.+++Adding new backends+-------------------++Adding support for new Accelerate backends should require only a few minor+additions to the cabal file and the module+'Data.Array.Accelerate.Examples.Internal.Backend'. +
accelerate-examples.cabal view
@@ -1,5 +1,5 @@ Name: accelerate-examples-Version: 1.0.0.0+Version: 1.1.0.0 Cabal-version: >=1.8 Tested-with: GHC >= 7.8 Build-type: Simple@@ -25,6 +25,7 @@ Stability: Experimental Extra-source-files:+ README.md data/matrices/README.md examples/canny/README.md examples/fluid/README.md@@ -51,21 +52,13 @@ -- Flags that control which Accelerate backends that are linked against ---Flag cuda- Description: Enable the CUDA parallel backend for NVIDIA GPUs- Default: False- Flag llvm-cpu Description: Enable the LLVM backend for multicore CPUs- Default: False+ Default: True Flag llvm-ptx Description: Enable the LLVM PTX backend for NVIDIA GPUs- Default: False--Flag cilk- Description: Enable the Cilk backend for multicore CPUs- Default: False+ Default: True -- Flags to specify which programs to build --@@ -132,8 +125,8 @@ Library hs-source-dirs: lib Build-depends:- base >= 4.7 && < 4.10- , accelerate == 1.0.*+ base >= 4.7 && < 4.11+ , accelerate == 1.1.* , ansi-wl-pprint >= 0.6 , containers >= 0.5 , criterion >= 1.0@@ -170,25 +163,20 @@ if flag(gui) CPP-options: -DACCELERATE_ENABLE_GUI - if flag(cuda)- CPP-options: -DACCELERATE_CUDA_BACKEND- build-depends:- accelerate-cuda == 0.17.*+ -- if flag(cuda)+ -- CPP-options: -DACCELERATE_CUDA_BACKEND+ -- build-depends:+ -- accelerate-cuda == 0.17.* if flag(llvm-cpu) CPP-options: -DACCELERATE_LLVM_NATIVE_BACKEND build-depends:- accelerate-llvm-native == 1.0.*+ accelerate-llvm-native == 1.1.* if flag(llvm-ptx) CPP-options: -DACCELERATE_LLVM_PTX_BACKEND build-depends:- accelerate-llvm-ptx == 1.0.*-- if flag(cilk)- CPP-options: -DACCELERATE_CILK_BACKEND- build-depends:- accelerate-icc-opencl == 1.0.*+ accelerate-llvm-ptx == 1.1.* if flag(ekg) CPP-options: -DACCELERATE_ENABLE_EKG@@ -283,6 +271,7 @@ -rtsopts -with-rtsopts=-n2M -with-rtsopts=-A64M+ -with-rtsopts=-qg ghc-prof-options: -auto-all@@ -291,13 +280,13 @@ c-sources: examples/nofib/Test/IO/fill_with_values.cpp examples/nofib/Test/Spectral/BlackScholes.cpp - if flag(cuda)- CPP-options: -DACCELERATE_CUDA_BACKEND- build-depends:- accelerate-cuda == 0.17.*-- other-modules:- Test.Foreign.CUDA+ -- if flag(cuda)+ -- CPP-options: -DACCELERATE_CUDA_BACKEND+ -- build-depends:+ -- accelerate-cuda == 0.17.*+ --+ -- other-modules:+ -- Test.Foreign.CUDA if flag(ekg) ghc-options: -with-rtsopts=-T@@ -306,11 +295,11 @@ buildable: False else build-depends:- base >= 4.7 && < 4.10- , accelerate == 1.0.*- , accelerate-examples == 1.0.*- , accelerate-fft == 1.0.*- , accelerate-io == 1.0.*+ base >= 4.7 && < 4.11+ , accelerate == 1.1.*+ , accelerate-examples+ , accelerate-fft >= 1.0+ , accelerate-io >= 1.0 , array >= 0.3 , containers >= 0.5 , fclabels >= 2.0@@ -332,9 +321,18 @@ Main-is: Main.hs other-modules: Config Matrix SMVM - ghc-prof-options: -auto-all- ghc-options: -Wall -threaded -eventlog -rtsopts -with-rtsopts=-n2M -with-rtsopts=-A64M+ ghc-options:+ -Wall+ -threaded+ -eventlog+ -rtsopts+ -with-rtsopts=-n2M+ -with-rtsopts=-A64M+ -with-rtsopts=-qg + ghc-prof-options:+ -auto-all+ if impl(ghc >= 7.6) ghc-options: -fsimpl-tick-factor=130 @@ -345,10 +343,10 @@ buildable: False else build-depends:- base >= 4.7 && < 4.10- , accelerate == 1.0.*- , accelerate-examples == 1.0.*- , accelerate-io == 1.0.*+ base >= 4.7 && < 4.11+ , accelerate == 1.1.*+ , accelerate-examples+ , accelerate-io >= 1.0 , fclabels >= 2.0 , matrix-market-attoparsec >= 0.1 , mwc-random >= 0.8@@ -365,9 +363,18 @@ Main-is: Main.hs other-modules: Config - ghc-prof-options: -auto-all- ghc-options: -Wall -threaded -eventlog -rtsopts -with-rtsopts=-n2M -with-rtsopts=-A64M+ ghc-options:+ -Wall+ -threaded+ -eventlog+ -rtsopts+ -with-rtsopts=-n2M+ -with-rtsopts=-A64M+ -with-rtsopts=-qg + ghc-prof-options:+ -auto-all+ if flag(ekg) ghc-options: -with-rtsopts=-T @@ -375,12 +382,12 @@ buildable: False else build-depends:- base >= 4.7 && < 4.10- , accelerate == 1.0.*- , accelerate-examples == 1.0.*+ base >= 4.7 && < 4.11+ , accelerate == 1.1.*+ , accelerate-examples , colour-accelerate >= 0.1 , fclabels >= 2.0- , gloss-raster-accelerate >= 0.2+ , gloss-raster-accelerate >= 2.0 -- The slit-scan effect creating a Doctor Who time vortex@@ -391,9 +398,18 @@ Main-is: Main.hs other-modules: Config - ghc-prof-options: -auto-all- ghc-options: -Wall -threaded -eventlog -rtsopts -with-rtsopts=-n2M -with-rtsopts=-A64M+ ghc-options:+ -Wall+ -threaded+ -eventlog+ -rtsopts+ -with-rtsopts=-n2M+ -with-rtsopts=-A64M+ -with-rtsopts=-qg + ghc-prof-options:+ -auto-all+ if flag(ekg) ghc-options: -with-rtsopts=-T @@ -401,11 +417,11 @@ buildable: False else build-depends:- base >= 4.7 && < 4.10- , accelerate == 1.0.*- , accelerate-examples == 1.0.*+ base >= 4.7 && < 4.11+ , accelerate == 1.1.*+ , accelerate-examples , fclabels >= 2.0- , gloss-raster-accelerate >= 0.2+ , gloss-raster-accelerate >= 2.0 , lens-accelerate >= 0.1 , linear-accelerate >= 0.3 @@ -418,9 +434,19 @@ Main-is: Main.hs other-modules: Config Canny Wildfire - ghc-prof-options: -auto-all- ghc-options: -Wall -threaded -Odph -eventlog -rtsopts -with-rtsopts=-n2M -with-rtsopts=-A64M+ ghc-options:+ -Wall+ -threaded+ -Odph+ -eventlog+ -rtsopts+ -with-rtsopts=-n2M+ -with-rtsopts=-A64M+ -with-rtsopts=-qg + ghc-prof-options:+ -auto-all+ if flag(ekg) ghc-options: -with-rtsopts=-T @@ -428,10 +454,10 @@ buildable: False else build-depends:- base >= 4.7 && < 4.10- , accelerate == 1.0.*- , accelerate-examples == 1.0.*- , accelerate-io == 1.0.*+ base >= 4.7 && < 4.11+ , accelerate == 1.1.*+ , accelerate-examples+ , accelerate-io >= 1.0 , colour-accelerate >= 0.1 , fclabels >= 2.0 , repa >= 3.1@@ -447,9 +473,18 @@ Main-is: Main.hs other-modules: Config Mandel World - ghc-prof-options: -auto-all- ghc-options: -Wall -threaded -eventlog -rtsopts -with-rtsopts=-n2M -with-rtsopts=-A64M+ ghc-options:+ -Wall+ -threaded+ -eventlog+ -rtsopts+ -with-rtsopts=-n2M+ -with-rtsopts=-A64M+ -with-rtsopts=-qg + ghc-prof-options:+ -auto-all+ if flag(ekg) ghc-options: -with-rtsopts=-T @@ -457,14 +492,14 @@ buildable: False else build-depends:- base >= 4.7 && < 4.10- , accelerate == 1.0.*- , accelerate-examples == 1.0.*- , accelerate-io == 1.0.*+ base >= 4.7 && < 4.11+ , accelerate == 1.1.*+ , accelerate-examples+ , accelerate-io >= 1.0 , colour-accelerate >= 0.1 , fclabels >= 2.0 , gloss >= 1.7- , gloss-accelerate >= 0.2+ , gloss-accelerate >= 2.0 -- A stable fluid simulation@@ -475,9 +510,18 @@ hs-source-dirs: examples/fluid/src-acc other-modules: Config Event Fluid Type World - ghc-prof-options: -auto-all- ghc-options: -Wall -threaded -eventlog -rtsopts -with-rtsopts=-n2M -with-rtsopts=-A64M+ ghc-options:+ -Wall+ -threaded+ -eventlog+ -rtsopts+ -with-rtsopts=-n2M+ -with-rtsopts=-A64M+ -with-rtsopts=-qg + ghc-prof-options:+ -auto-all+ if flag(ekg) ghc-options: -with-rtsopts=-T @@ -485,10 +529,10 @@ buildable: False else build-depends:- base >= 4.7 && < 4.10- , accelerate == 1.0.*- , accelerate-examples == 1.0.*- , accelerate-io == 1.0.*+ base >= 4.7 && < 4.11+ , accelerate == 1.1.*+ , accelerate-examples+ , accelerate-io >= 1.0 , bmp >= 1.2 , colour-accelerate >= 0.1 , fclabels >= 2.0@@ -504,7 +548,6 @@ Main-is: Main.hs other-modules: Common.Body- Common.Dump Common.Tree Common.Type Common.World@@ -518,9 +561,18 @@ Solver.Naive2 Test - ghc-prof-options: -auto-all- ghc-options: -Wall -threaded -eventlog -rtsopts -with-rtsopts=-n2M -with-rtsopts=-A64M+ ghc-options:+ -Wall+ -threaded+ -eventlog+ -rtsopts+ -with-rtsopts=-n2M+ -with-rtsopts=-A64M+ -with-rtsopts=-qg + ghc-prof-options:+ -auto-all+ if flag(ekg) ghc-options: -with-rtsopts=-T @@ -528,9 +580,9 @@ buildable: False else build-depends:- base >= 4.7 && < 4.10- , accelerate == 1.0.*- , accelerate-examples == 1.0.*+ base >= 4.7 && < 4.11+ , accelerate == 1.1.*+ , accelerate-examples , fclabels >= 2.0 , gloss >= 1.7 , lens-accelerate >= 0.1@@ -552,14 +604,23 @@ Random.Splat SmoothLife - ghc-prof-options: -auto-all- ghc-options: -Wall -threaded -eventlog -rtsopts -with-rtsopts=-n2M -with-rtsopts=-A64M+ ghc-options:+ -Wall+ -threaded+ -eventlog+ -rtsopts+ -with-rtsopts=-n2M+ -with-rtsopts=-A64M+ -with-rtsopts=-qg - if flag(cuda)- cpp-options: -DACCELERATE_CUDA_BACKEND- build-depends:- accelerate-cuda == 0.17.*+ ghc-prof-options:+ -auto-all + -- if flag(cuda)+ -- cpp-options: -DACCELERATE_CUDA_BACKEND+ -- build-depends:+ -- accelerate-cuda == 0.17.*+ if flag(ekg) ghc-options: -with-rtsopts=-T @@ -567,14 +628,14 @@ buildable: False else build-depends:- base >= 4.7 && < 4.10- , accelerate == 1.0.*- , accelerate-examples == 1.0.*- , accelerate-fft == 1.0.*+ base >= 4.7 && < 4.11+ , accelerate == 1.1.*+ , accelerate-examples+ , accelerate-fft >= 1.0 , colour-accelerate >= 0.1 , fclabels >= 2.0 , gloss >= 1.7- , gloss-accelerate >= 0.2+ , gloss-accelerate >= 2.0 , mwc-random >= 0.8 @@ -586,9 +647,18 @@ Main-is: Main.hs other-modules: Config Digest MD5 - ghc-prof-options: -auto-all- ghc-options: -Wall -threaded -eventlog -rtsopts -with-rtsopts=-n2M -with-rtsopts=-A64M+ ghc-options:+ -Wall+ -threaded+ -eventlog+ -rtsopts+ -with-rtsopts=-n2M+ -with-rtsopts=-A64M+ -with-rtsopts=-qg + ghc-prof-options:+ -auto-all+ if flag(ekg) ghc-options: -with-rtsopts=-T @@ -596,9 +666,9 @@ buildable: False else build-depends:- base >= 4.7 && < 4.10- , accelerate == 1.0.*- , accelerate-examples == 1.0.*+ base >= 4.7 && < 4.11+ , accelerate == 1.1.*+ , accelerate-examples , bytestring >= 0.9 , bytestring-lexing >= 0.5 , cereal >= 0.3@@ -615,9 +685,18 @@ hs-source-dirs: examples/fft/src-acc other-modules: Config HighPass FFT - ghc-prof-options: -auto-all- ghc-options: -Wall -threaded -eventlog -rtsopts -with-rtsopts=-n2M -with-rtsopts=-A64M+ ghc-options:+ -Wall+ -threaded+ -eventlog+ -rtsopts+ -with-rtsopts=-n2M+ -with-rtsopts=-A64M+ -with-rtsopts=-qg + ghc-prof-options:+ -auto-all+ if flag(ekg) ghc-options: -with-rtsopts=-T @@ -625,11 +704,11 @@ buildable: False else build-depends:- base >= 4.7 && < 4.10- , accelerate == 1.0.*- , accelerate-examples == 1.0.*- , accelerate-fft == 1.0.*- , accelerate-io == 1.0.*+ base >= 4.7 && < 4.11+ , accelerate == 1.1.*+ , accelerate-examples+ , accelerate-fft >= 1.0+ , accelerate-io >= 1.0 , colour-accelerate >= 0.1 , fclabels >= 2.0 , filepath >= 1.0@@ -649,9 +728,18 @@ Rank Step - ghc-prof-options: -auto-all- ghc-options: -Wall -threaded -eventlog -rtsopts -with-rtsopts=-n2M -with-rtsopts=-A64M+ ghc-options:+ -Wall+ -threaded+ -eventlog+ -rtsopts+ -with-rtsopts=-n2M+ -with-rtsopts=-A64M+ -with-rtsopts=-qg + ghc-prof-options:+ -auto-all+ if flag(ekg) ghc-options: -with-rtsopts=-T @@ -659,10 +747,10 @@ buildable: False else build-depends:- base >= 4.7 && < 4.10- , accelerate == 1.0.*- , accelerate-examples == 1.0.*- , accelerate-io == 1.0.*+ base >= 4.7 && < 4.11+ , accelerate == 1.1.*+ , accelerate-examples+ , accelerate-io >= 1.0 , bytestring >= 0.9.2 , containers >= 0.4.2 , directory >= 1.1@@ -689,9 +777,18 @@ Scene.State Scene.World - ghc-prof-options: -auto-all- ghc-options: -Wall -threaded -eventlog -rtsopts -with-rtsopts=-n2M -with-rtsopts=-A64M+ ghc-options:+ -Wall+ -threaded+ -eventlog+ -rtsopts+ -with-rtsopts=-n2M+ -with-rtsopts=-A64M+ -with-rtsopts=-qg + ghc-prof-options:+ -auto-all+ if flag(ekg) ghc-options: -with-rtsopts=-T @@ -699,14 +796,14 @@ buildable: False else build-depends:- base >= 4.7 && < 4.10- , accelerate == 1.0.*- , accelerate-examples == 1.0.*+ base >= 4.7 && < 4.11+ , accelerate == 1.1.*+ , accelerate-examples , colour-accelerate >= 0.1 , fclabels >= 1.0 , gloss >= 1.8- , gloss-accelerate >= 0.2- , gloss-raster-accelerate >= 0.2+ , gloss-accelerate >= 2.0+ , gloss-raster-accelerate >= 2.0 , lens-accelerate >= 0.1 , linear-accelerate >= 0.3 @@ -717,11 +814,20 @@ Executable accelerate-kmeans hs-source-dirs: examples/kmeans Main-is: Main.hs- other-modules: Config Main Kmeans GenSamples+ other-modules: Config Kmeans - ghc-prof-options: -auto-all- ghc-options: -Wall -threaded -eventlog -rtsopts -with-rtsopts=-n2M -with-rtsopts=-A64M+ ghc-options:+ -Wall+ -threaded+ -eventlog+ -rtsopts+ -with-rtsopts=-n2M+ -with-rtsopts=-A64M+ -with-rtsopts=-qg + ghc-prof-options:+ -auto-all+ if flag(ekg) ghc-options: -with-rtsopts=-T @@ -729,9 +835,9 @@ buildable: False else build-depends:- base >= 4.7 && < 4.10- , accelerate == 1.0.*- , accelerate-examples == 1.0.*+ base >= 4.7 && < 4.11+ , accelerate == 1.1.*+ , accelerate-examples , binary >= 0.7 , directory >= 1.1 , fclabels >= 1.0@@ -745,7 +851,7 @@ source-repository this type: git- tag: 1.0.0.0+ tag: 1.1.0.0 location: https://github.com/AccelerateHS/accelerate-examples -- vim: nospell
examples/canny/src-acc/Canny.hs view
@@ -18,7 +18,7 @@ import Data.Array.Accelerate as A import Data.Array.Accelerate.IO as A-import Data.Array.Accelerate.Data.Colour.RGB hiding ( clamp )+import Data.Array.Accelerate.Data.Colour.RGB -- Canny algorithm -------------------------------------------------------------@@ -82,12 +82,12 @@ -- Separable Gaussian blur in the x- and y-directions -- gaussianX :: Acc (Image Float) -> Acc (Image Float)-gaussianX = stencil (convolve5x1 gaussian) Clamp+gaussianX = stencil (convolve5x1 gaussian) A.clamp where gaussian = P.map (/16) [ 1, 4, 6, 4, 1 ] gaussianY :: Acc (Image Float) -> Acc (Image Float)-gaussianY = stencil (convolve1x5 gaussian) Clamp+gaussianY = stencil (convolve1x5 gaussian) A.clamp where gaussian = P.map (/16) [ 1, 4, 6, 4, 1 ] @@ -95,7 +95,7 @@ -- Gradients in the x- and y- directions -- gradientX :: Acc (Image Float) -> Acc (Image Float)-gradientX = stencil grad Clamp+gradientX = stencil grad A.clamp where grad :: Stencil3x3 Float -> Exp Float grad ((u, _, x)@@ -103,7 +103,7 @@ ,(w, _, z)) = x + (2*y) + z - u - (2*v) - w gradientY :: Acc (Image Float) -> Acc (Image Float)-gradientY = stencil grad Clamp+gradientY = stencil grad A.clamp where grad :: Stencil3x3 Float -> Exp Float grad ((x, y, z)@@ -121,7 +121,7 @@ :: Exp Float -> Acc (Image Float) -> Acc (Array DIM2 (Float,Int))-gradientMagDir low = stencil magdir Clamp+gradientMagDir low = stencil magdir A.clamp where magdir :: Stencil3x3 Float -> Exp (Float,Int) magdir ((v0, v1, v2)@@ -183,10 +183,10 @@ offsetx = dir > orient' Vert ? (-1, dir < orient' Vert ? (1, 0)) offsety = dir < orient' Horiz ? (-1, 0) - (fwd, _) = unlift $ magdir ! lift (clamp (Z :. y+offsety :. x+offsetx)) :: (Exp Float, Exp Int)- (rev, _) = unlift $ magdir ! lift (clamp (Z :. y-offsety :. x-offsetx)) :: (Exp Float, Exp Int)+ (fwd, _) = unlift $ magdir ! lift (limit (Z :. y+offsety :. x+offsetx)) :: (Exp Float, Exp Int)+ (rev, _) = unlift $ magdir ! lift (limit (Z :. y-offsety :. x-offsetx)) :: (Exp Float, Exp Int) - clamp (Z:.u:.v) = Z :. 0 `max` u `min` (h-1) :. 0 `max` v `min` (w-1)+ limit (Z:.u:.v) = Z :. 0 `max` u `min` (h-1) :. 0 `max` v `min` (w-1) -- Try to avoid doing explicit tests to avoid warp divergence. --@@ -203,7 +203,7 @@ -> Acc (Array DIM1 Int) selectStrong img = let strong = map (\x -> boolToInt (x == edge' Strong)) (flatten img)- (targetIdx, len) = scanl' (+) 0 strong+ (targetIdx, len) = unlift (scanl' (+) 0 strong) indices = enumFromN (index1 $ size img) 0 zeros = fill (index1 $ the len) 0 in
examples/crystal/Main.hs view
@@ -13,7 +13,7 @@ import Data.Label ( get ) -import Data.Array.Accelerate as A hiding ( size, (==) )+import Data.Array.Accelerate as A hiding ( (==), size, wrap ) import Data.Array.Accelerate.Examples.Internal as A import Data.Array.Accelerate.Data.Colour.RGBA
examples/fluid/src-acc/Config.hs view
@@ -201,7 +201,7 @@ makeField_empty :: FieldElt e => Backend -> Int -> Int -> Field e makeField_empty backend width height = run backend- $ A.fill (constant (Z:.height:.width)) (constant zero)+ $ A.fill (constant (Z:.height:.width)) zero makeDensity_checks :: Backend -> Int -> Int -> DensityField
examples/fluid/src-acc/Event.hs view
@@ -68,11 +68,18 @@ , velocitySource = addVelocity x0y0 xy } _ -> world --- addDensity (x,y) = (Z:.y:.x, density) : densitySource world+ inbounds (x,y) = x >= 0 && x < get simulationWidth opt+ && y >= 0 && y < get simulationHeight opt - addVelocity (x0,y0) (x1,y1) = let u = fromIntegral (x1-x0)- v = fromIntegral (y1-y0)- in (Z:.y0:.x0, (u * velocity, v * velocity)) : velocitySource world+ addDensity ix@(x,y)+ | inbounds ix = (Z:.y:.x, density) : densitySource world+ | otherwise = densitySource world++ addVelocity ix@(x0,y0) (x1,y1)+ | inbounds ix = let u = fromIntegral (x1-x0)+ v = fromIntegral (y1-y0)+ in (Z:.y0:.x0, (u * velocity, v * velocity)) : velocitySource world+ | otherwise = velocitySource world -- density = get inputDensity opt velocity = get inputVelocity opt
examples/fluid/src-acc/Fluid.hs view
@@ -10,8 +10,8 @@ ) where import Type-import Data.Array.Accelerate as A +import Data.Array.Accelerate as A hiding ( clamp ) import qualified Prelude as P @@ -56,10 +56,10 @@ -- Ensure the velocity field conserves mass -- project :: Int -> Acc VelocityField -> Acc VelocityField-project steps vf = A.stencil2 poisson (A.Constant zero) vf (A.Constant zero) p+project steps vf = A.stencil2 poisson (function $ const zero) vf (function $ const zero) p where- grad = A.stencil divF (A.Constant zero) vf- p1 = A.stencil2 pF (A.Constant zero) grad (A.Constant zero)+ grad = A.stencil divF (function $ const zero) vf+ p1 = A.stencil2 pF (function $ const zero) grad (function $ const zero) p = P.foldl1 (.) (P.replicate steps p1) grad poisson :: A.Stencil3x3 Velocity -> A.Stencil3x3 Float -> Exp Velocity@@ -126,7 +126,7 @@ a = A.constant dt * A.constant dn * (A.fromIntegral (A.size df0)) c = 1 + 4*a - diffuse1 df = A.stencil2 relax (A.Constant zero) df0 (A.Constant zero) df+ diffuse1 df = A.stencil2 relax (function $ const zero) df0 (function $ const zero) df relax :: FieldElt e => A.Stencil3x3 e -> A.Stencil3x3 e -> Exp e relax (_,(_,x0,_),_) ((_,t,_), (l,_,r), (_,b,_)) = (x0 .+. a .*. (l.+.t.+.r.+.b)) ./. c@@ -170,7 +170,7 @@ -- read the density values surrounding the calculated advection point get ix'@(Z :. j' :. i') = (j' A.< 0 || i' A.< 0 || j' >= h || i' >= w)- ? (A.constant zero, df A.! A.lift ix')+ ? (zero, df A.! A.lift ix') d00 = get (Z :. j0 :. i0) d10 = get (Z :. j1 :. i0)
examples/fluid/src-acc/Main.hs view
@@ -52,9 +52,9 @@ -- Critically, we use the run1 execution form to ensure we bypass all -- front-end conversion phases. --+ step = run1 backend (fluid steps dt dp dn) simulate world =- let step = run1 backend (fluid steps dt dp dn)- ds = sources (densitySource world)+ let ds = sources (densitySource world) vs = sources (velocitySource world) (df', vf') = step ( ds, vs, densityField world, velocityField world ) in
examples/fluid/src-acc/Type.hs view
@@ -40,7 +40,7 @@ infixl 7 ./. class Elt e => FieldElt e where- zero :: e+ zero :: Exp e (.+.) :: Exp e -> Exp e -> Exp e (.-.) :: Exp e -> Exp e -> Exp e (.*.) :: Exp Float -> Exp e -> Exp e@@ -54,7 +54,7 @@ (./.) = (/) instance FieldElt Velocity where- zero = (0, 0)+ zero = constant (0, 0) (.+.) = app2 (+) (.-.) = app2 (-) c .*. xy = let (x,y) = unlift xy in lift (c*x, c*y)
− examples/kmeans/GenSamples.hs
@@ -1,114 +0,0 @@------ Adapted from K-Means sample from "Parallel and Concurrent Programming in--- Haskell", (c) Simon Marlow, 2013.------ ./generate-samples 5 50000 100000 1010-----import Control.Monad-import Data.Array-import Data.Binary-import Data.List-import Data.Word-import Data.Random.Normal-import System.Environment-import System.IO-import System.Random----- Points--- --------type Point = (Float, Float)--zeroPoint :: Point-zeroPoint = (0,0)----- Clusters--------------type Cluster = (Word32, Point)--makeCluster :: Int -> [Point] -> Cluster-makeCluster clid points- = ( fromIntegral clid- , (a / fromIntegral count, b / fromIntegral count))- where- (a,b) = foldl' addPoint zeroPoint points- count = length points-- addPoint :: Point -> Point -> Point- addPoint (x,y) (u,v) = (x+u,y+v)----- Generate random points--- ------------------------minX, maxX, minY, maxY, minSD, maxSD :: Float-minX = -10-maxX = 10-minY = -10-maxY = 10-minSD = 1.5-maxSD = 2.0--main :: IO ()-main = do- n: minp: maxp: rest <- fmap (fmap read) getArgs-- case rest of- [seed] -> setStdGen (mkStdGen seed)- _ -> return ()-- nps <- replicateM n (randomRIO (minp, maxp))- xs <- replicateM n (randomRIO (minX, maxX))- ys <- replicateM n (randomRIO (minY, maxY))- sds <- replicateM n (randomRIO (minSD, maxSD))-- let params = zip5 nps xs ys sds sds-- -- first generate a set of points for each set of sample parameters- ss <- mapM (\(a,b,c,d,e) -> generate2DSamples a b c d e) params- let points = concat ss-- -- dump all the points into the file "points"- hsamp <- openFile "points" WriteMode- mapM_ (printPoint hsamp) points- hClose hsamp-- encodeFile "points.bin" points-- -- generate the initial clusters by assigning each point to random- -- cluster.- gen <- newStdGen- let- rand_clusters = randomRs (0,n-1) gen :: [Int]- arr = accumArray (flip (:)) [] (0,n-1) $- zip rand_clusters points- clusters = map (uncurry makeCluster) (assocs arr)- writeFile "clusters" (show clusters)-- -- so we can tell what the answer should be:- writeFile "params" (show params)---printPoint :: Handle -> Point -> IO ()-printPoint h (x,y) = do- hPutStr h (show x)- hPutChar h ' '- hPutStr h (show y)- hPutChar h '\n'--generate2DSamples- :: Int -- number of samples to generate- -> Float -> Float -- X and Y of the mean- -> Float -> Float -- X and Y standard deviations- -> IO [Point]-generate2DSamples n mx my sdx sdy = do- gen <- newStdGen- let (genx, geny) = split gen- xsamples = normals' (mx,sdx) genx- ysamples = normals' (my,sdy) geny- return (zipWith (,) (take n xsamples) ysamples)-
examples/mandelbrot/README.md view
@@ -12,5 +12,5 @@ [wiki-mandelbrot]: https://en.wikipedia.org/wiki/Mandelbrot_set- [mandelbrot-img]: https://github.com/AccelerateHS/accelerate-examples/raw/master/samples/mandelbrot2.jpg+ [mandelbrot-img]: https://github.com/AccelerateHS/accelerate-examples/raw/master/samples/mandelbrot.jpg
examples/mandelbrot/World.hs view
@@ -56,17 +56,17 @@ initialWorld :: Config -> Options -> World initialWorld conf opts- = setPrecision opts Float+ = setPrecision opts Double $ loadPreset 0 $ World { worldDirty = True- , worldPrecision = Float+ , worldPrecision = Double , worldPicture = blank , worldPalette = run (get optBackend opts) (ultraPalette 2048) , worldSizeX = get configWidth conf , worldSizeY = get configHeight conf , worldPanning = Nothing , worldZooming = Nothing- , worldPosX = unit 0 :: Scalar Float+ , worldPosX = unit 0 :: Scalar Double , worldPosY = unit 0 , worldWidth = unit 0 , worldRadius = unit 0
− examples/n-body/Common/Dump.hs
@@ -1,52 +0,0 @@--module Common.Dump ( dumpWorld, printWorld )- where--import Common.Body-import Common.World--import System.IO-import Data.List-import Text.Printf-import qualified Data.Array.Accelerate as A----- | Dump the bodies in a world to a file.----dumpWorld :: World -> FilePath -> IO ()-dumpWorld world filePath- = withFile filePath WriteMode- $ \h -> hWriteWorld h world---- | Print the bodies in a world to stdout----printWorld :: World -> IO ()-printWorld world- = hWriteWorld stdout world----- | Write a world to a handle----hWriteWorld :: Handle -> World -> IO ()-hWriteWorld h world- = mapM_ (hWriteBody h)- $ A.toList- $ worldBodies world---- | Write a single body to a handle----hWriteBody :: Handle -> Body -> IO ()-hWriteBody h (((px, py), mass), (vx, vy), (ax, ay))- = hPutStrLn h- $ concat- $ ( (padRc 8 ' ' $ show mass)- : " "- : (intersperse " " $ map (\f -> printf "%15.8f" f) [ px, py, vx, vy, ax, ay ]))----- | Right justify a doc, padding with a given character.----padRc :: Int -> Char -> String -> String-padRc n c str- = replicate (n - length str) c ++ str-
examples/nofib/Test/Foreign.hs view
@@ -15,11 +15,11 @@ test_foreign :: Backend -> Config -> Test-test_foreign be conf =+test_foreign _be _conf = testGroup "foreign" [ #ifdef ACCELERATE_CUDA_BACKEND- test_cuda be conf+ test_cuda _be _conf #endif ]
− examples/nofib/Test/Foreign/CUDA.hs
@@ -1,43 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--module Test.Foreign.CUDA- where--import Config-import QuickCheck.Arbitrary.Array ()--import Prelude as P-import Data.Array.Accelerate as A-import Data.Array.Accelerate.Examples.Internal as A-import Data.Array.Accelerate.CUDA.Foreign as A---test_cuda :: Backend -> Config -> Test-test_cuda backend _conf = testGroup "CUDA"- $ case backend of- CUDA -> [ testExpf, testFmaf ]- _ -> [ ]- where- testExpf :: Test- testExpf = testProperty "expf" test_expf- where- test_expf :: Array DIM1 Float -> Property- test_expf xs = run1 backend (A.map (A.foreignExp (A.CUDAForeignExp [] "__expf") exp)) xs- ~?= mapRef exp xs-- testFmaf :: Test- testFmaf = testProperty "fmaf" test_fmaf- where- test_fmaf :: Array DIM1 (Float, Float, Float) -> Property- test_fmaf xs = run1 backend (A.map (A.foreignExp (A.CUDAForeignExp [] "__fmaf_rz") fmaf)) xs- ~?= mapRef (\(x,y,z) -> x * y + z) xs- where- fmaf v = let (x,y,z) = unlift v in x * y + z---mapRef :: (Shape sh, Elt b) => (a -> b) -> Array sh a -> Array sh b-mapRef f xs- = fromList (arrayShape xs)- $ P.map f- $ toList xs-
examples/nofib/Test/Imaginary/DotP.hs view
@@ -47,7 +47,7 @@ $ testProperty (show (typeOf (undefined :: a))) (run_dotp :: Vector a -> Vector a -> Property) run_dotp xs ys =- run2 backend dotp xs ys `indexArray` Z+ runN backend dotp xs ys `indexArray` Z ~?= P.sum [ x * y | x <- toList xs | y <- toList ys ]
examples/nofib/Test/Imaginary/SAXPY.hs view
@@ -48,7 +48,7 @@ $ testProperty (show (typeOf (undefined :: a))) (run_saxpy :: a -> Vector a -> Vector a -> Property) run_saxpy alpha xs ys =- toList (run2 backend (saxpy (constant alpha)) xs ys)+ toList (runN backend (saxpy (constant alpha)) xs ys) ~?= [ alpha * x + y | x <- toList xs | y <- toList ys ]
examples/nofib/Test/Issues/Issue264.hs view
@@ -70,19 +70,19 @@ test_negneg xs = run1 backend (A.map negate . A.map negate) xs ~?= mapRef (negate . negate) xs test_notnot xs = run1 backend (A.map A.not . A.map A.not) xs ~?= mapRef (P.not . P.not) xs - test_andnot xs ys = run2 backend (A.zipWith (\x y -> A.not (x A.&& y))) xs ys+ test_andnot xs ys = runN backend (A.zipWith (\x y -> A.not (x A.&& y))) xs ys ~?= zipWithRef (\x y -> P.not (x P.&& y)) xs ys - test_ornot xs ys = run2 backend (A.zipWith (\x y -> A.not (x A.|| y))) xs ys+ test_ornot xs ys = runN backend (A.zipWith (\x y -> A.not (x A.|| y))) xs ys ~?= zipWithRef (\x y -> P.not (x P.|| y)) xs ys - test_andnotnot xs ys = run2 backend (A.zipWith (\x y -> A.not (A.not (x A.&& y)))) xs ys+ test_andnotnot xs ys = runN backend (A.zipWith (\x y -> A.not (A.not (x A.&& y)))) xs ys ~?= zipWithRef (\x y -> P.not (P.not (x P.&& y))) xs ys - test_ornotnot xs ys = run2 backend (A.zipWith (\x y -> A.not (A.not (x A.|| y)))) xs ys+ test_ornotnot xs ys = runN backend (A.zipWith (\x y -> A.not (A.not (x A.|| y)))) xs ys ~?= zipWithRef (\x y -> P.not (P.not (x P.|| y))) xs ys
examples/nofib/Test/Issues/Issue286.hs view
@@ -83,7 +83,7 @@ acc_consume_sv :: DIM2 -> Backend -> Consumer (S.Vector Word8) IO () acc_consume_sv sh backend = consumer' 0 0 where- go = run1 backend (A.sum . A.map A.fromIntegral)+ go = run1 backend (A.sum . A.flatten . A.map A.fromIntegral) consumer' :: Int -> Float -> Consumer (S.Vector Word8) IO () consumer' n acc = do@@ -100,7 +100,7 @@ acc_consume_acc :: Backend -> Consumer (Array DIM2 Word8) IO () acc_consume_acc backend = consumer' 0 0 where- go = run1 backend (A.sum . A.map A.fromIntegral)+ go = run1 backend (A.sum . A.flatten . A.map A.fromIntegral) consumer' :: Int -> Float -> Consumer (Array DIM2 Word8) IO () consumer' n acc = do
examples/nofib/Test/Prelude/Backpermute.hs view
@@ -92,7 +92,7 @@ test_drop xs = let n = arraySize (arrayShape xs) in forAll (choose (0, 0 `P.max` (n-1))) $ \i ->- toList (run2 backend (\i' -> A.drop (the i')) (scalar i) xs)+ toList (runN backend (\i' -> A.drop (the i')) (scalar i) xs) ~?= P.drop i (toList xs) @@ -100,7 +100,7 @@ test_take xs@(Array _ adata) = let Z :. n = arrayShape xs in forAll (choose (0, 0 `P.max` (n-1))) $ \i ->- run2 backend (\i' -> A.take (the i')) (scalar i) xs+ runN backend (\i' -> A.take (the i')) (scalar i) xs ~?= Array ((),i) adata @@ -109,7 +109,7 @@ let n = arraySize (arrayShape xs) in forAll (choose (0, 0 `P.max` (n-1))) $ \i -> forAll (choose (0, 0 `P.max` (n-1-i))) $ \j ->- toList (run3 backend (\i' j' -> A.slit (the i') (the j')) (scalar i) (scalar j) xs)+ toList (runN backend (\i' j' -> A.slit (the i') (the j')) (scalar i) (scalar j) xs) ~?= P.take j (P.drop i (toList xs)) @@ -121,7 +121,7 @@ in n P.> 0 ==> forAll arbitrary $ \(sh' :: DIM1) -> forAll (arbitraryArrayOf sh' (choose (0,n-1))) $ \mapv ->- toList (run2 backend A.gather mapv xs)+ toList (runN backend A.gather mapv xs) ~?= [ xs `indexArray` (Z:.i) | i <- toList mapv ] @@ -134,7 +134,7 @@ -- forAll (arbitraryArrayOf sh' (choose (0,n'))) $ \mapv -> -- forAll (arbitraryArray sh') $ \(maskv :: Vector Int) -> -- forAll (arbitraryArray sh') $ \defaultv ->- -- toList (run4 backend (\p m d x -> A.gatherIf p m A.even d x) mapv maskv defaultv xs)+ -- toList (runN backend (\p m d x -> A.gatherIf p m A.even d x) mapv maskv defaultv xs) -- ~?= -- gatherIfRef P.even mapv maskv defaultv xs
examples/nofib/Test/Prelude/Filter.hs view
@@ -13,7 +13,7 @@ import Data.Label import Data.Maybe import Data.Typeable-import Test.QuickCheck+import Test.QuickCheck ( Arbitrary ) import Test.Framework import Test.Framework.Providers.QuickCheck2
examples/nofib/Test/Prelude/Fold.hs view
@@ -93,7 +93,7 @@ test_sum' :: Array sh e -> NonZero e -> Property test_sum' xs (NonZero z) =- run2 backend (\z' -> A.foldAll (+) (the z')) (scalar z) xs+ runN backend (\z' -> A.foldAll (+) (the z')) (scalar z) xs ~?= foldAllRef (+) z xs @@ -157,7 +157,7 @@ test_sum' :: Array (sh:.Int) e -> NonZero e -> Property test_sum' xs (NonZero z) =- run2 backend (\z' -> A.fold (+) (the z')) (scalar z) xs ~?= foldRef (+) z xs+ runN backend (\z' -> A.fold (+) (the z')) (scalar z) xs ~?= foldRef (+) z xs test_mss :: (sh:.Int) -> e -> Property test_mss sz _@@ -197,18 +197,18 @@ testProperty "sum" $ forAllShrink arbitrarySegments shrinkSegments $ \(seg :: Segments Int32) -> forAllShrink (arbitrarySegmentedArray seg) shrinkSegmentedArray $ \(xs :: Array (sh:.Int) e) ->- run2 backend (A.foldSeg (+) 0) xs seg ~?= foldSegRef (+) 0 xs seg+ runN backend (A.foldSeg (+) 0) xs seg ~?= foldSegRef (+) 0 xs seg , testProperty "non-neutral sum" $ forAllShrink arbitrarySegments shrinkSegments $ \(seg :: Segments Int32) -> forAllShrink (arbitrarySegmentedArray seg) shrinkSegmentedArray $ \(xs :: Array (sh:.Int) e) -> forAll arbitrary $ \(NonZero z) ->- run3 backend (\z' -> A.foldSeg (+) (the z')) (scalar z) xs seg ~?= foldSegRef (+) z xs seg+ runN backend (\z' -> A.foldSeg (+) (the z')) (scalar z) xs seg ~?= foldSegRef (+) z xs seg , testProperty "minimum" $ forAllShrink arbitrarySegments1 shrinkSegments1 $ \(seg :: Segments Int32) -> forAllShrink (arbitrarySegmentedArray seg) shrinkSegmentedArray $ \(xs :: Array (sh:.Int) e) ->- run2 backend (A.fold1Seg A.min) xs seg ~?= fold1SegRef P.min xs seg+ runN backend (A.fold1Seg A.min) xs seg ~?= fold1SegRef P.min xs seg ]
examples/nofib/Test/Prelude/Permute.hs view
@@ -99,7 +99,7 @@ test_histogram :: (P.Num e, A.Num e, Similar e, IArray UArray e) => (Exp e -> Exp Int) -> (e -> Int) -> Vector e -> Property test_histogram f g xs = forAll arbitrary $ \(Positive n) ->- run2 backend (histogramAcc f) (scalar n) xs ~?= histogramRef n g xs+ runN backend (histogramAcc f) (scalar n) xs ~?= histogramRef n g xs histogramAcc :: A.Num e => (Exp e -> Exp Int) -> Acc (Scalar Int) -> Acc (Vector e) -> Acc (Vector e) histogramAcc f n xs =@@ -123,7 +123,7 @@ forAll (arbitraryArray (Z:.m+1)) $ \defaultV -> forAll (arbitraryUniqueVectorOf (choose (0, m))) $ \mapV -> let n = arraySize (arrayShape mapV) in forAll (arbitraryArray (Z:.n)) $ \(inputV :: Vector e) ->- toList (run3 backend A.scatter mapV defaultV inputV)+ toList (runN backend A.scatter mapV defaultV inputV) ~?= IArray.elems (scatterRef (toIArray mapV) (toIArray defaultV) (toIArray inputV)) @@ -134,7 +134,7 @@ -- forAll (arbitraryUniqueVectorOf (choose (0, m))) $ \mapV -> let n = arraySize (arrayShape mapV) in -- forAll (arbitraryArray (Z:.n)) $ \(maskV :: Vector Int) -> -- forAll (arbitraryArray (Z:.n)) $ \(inputV :: Vector e) ->- -- toList (run4 backend (\p v d x -> A.scatterIf p v A.even d x) mapV maskV defaultV inputV)+ -- toList (runN backend (\p v d x -> A.scatterIf p v A.even d x) mapV maskV defaultV inputV) -- ~?= -- IArray.elems (scatterIfRef (toIArray mapV) (toIArray maskV) P.even (toIArray defaultV) (toIArray inputV))
examples/nofib/Test/Prelude/Scan.hs view
@@ -137,7 +137,7 @@ forAllShrink arbitrarySegments1 shrinkSegments1 $ \(seg :: Vector Int32) -> forAllShrink (arbitrarySegmentedArray seg) shrinkSegmentedArray $ \xs -> arraySize (arrayShape xs) > 0 ==>- (run2 backend (A.scanl1Seg (+))) xs seg+ (runN backend (A.scanl1Seg (+))) xs seg ~?= scanl1SegRef (+) (xs `asTypeOf` elt) seg @@ -145,35 +145,35 @@ forAllShrink arbitrarySegments1 shrinkSegments1 $ \(seg :: Vector Int32) -> forAllShrink (arbitrarySegmentedArray seg) shrinkSegmentedArray $ \xs -> arraySize (arrayShape xs) > 0 ==>- (run2 backend (A.scanr1Seg (+))) xs seg+ (runN backend (A.scanr1Seg (+))) xs seg ~?= scanr1SegRef (+) (xs `asTypeOf` elt) seg test_scanlseg elt = forAllShrink arbitrarySegments shrinkSegments $ \(seg :: Vector Int32) -> forAllShrink (arbitrarySegmentedArray seg) shrinkSegmentedArray $ \xs ->- (run2 backend (A.scanlSeg (+) 0)) xs seg+ (runN backend (A.scanlSeg (+) 0)) xs seg ~?= scanlSegRef (+) 0 (xs `asTypeOf` elt) seg test_scanrseg elt = forAllShrink arbitrarySegments shrinkSegments $ \(seg :: Vector Int32) -> forAllShrink (arbitrarySegmentedArray seg) shrinkSegmentedArray $ \xs ->- (run2 backend (A.scanrSeg (+) 0)) xs seg+ (runN backend (A.scanrSeg (+) 0)) xs seg ~?= scanrSegRef (+) 0 (xs `asTypeOf` elt) seg test_scanl'seg elt = forAllShrink arbitrarySegments shrinkSegments $ \(seg :: Vector Int32) -> forAllShrink (arbitrarySegmentedArray seg) shrinkSegmentedArray $ \xs ->- (run2 backend (lift $$ A.scanl'Seg (+) 0)) xs seg+ (runN backend (A.scanl'Seg (+) 0)) xs seg ~?= scanl'SegRef (+) 0 (xs `asTypeOf` elt) seg test_scanr'seg elt = forAllShrink arbitrarySegments shrinkSegments $ \(seg :: Vector Int32) -> forAllShrink (arbitrarySegmentedArray seg) shrinkSegmentedArray $ \xs ->- (run2 backend (lift $$ A.scanr'Seg (+) 0)) xs seg+ (runN backend (A.scanr'Seg (+) 0)) xs seg ~?= scanr'SegRef (+) 0 (xs `asTypeOf` elt) seg
examples/nofib/Test/Prelude/Stencil.hs view
@@ -14,8 +14,8 @@ import Data.Label import Data.Maybe import Data.Typeable-import Test.QuickCheck-import Test.HUnit ((@?=))+import Test.QuickCheck ( Arbitrary )+import Test.HUnit ( (@?=) ) import Test.Framework import Test.Framework.Providers.QuickCheck2 import Test.Framework.Providers.HUnit@@ -75,7 +75,7 @@ where pattern (x,y,z) = x + z - 2 * y - acc xs = run1 backend (stencil pattern Clamp) xs+ acc xs = run1 backend (stencil pattern clamp) xs ref :: (P.Num e, IArray UArray e) => UArray Int e -> UArray Int e ref xs =@@ -95,7 +95,7 @@ ) = (t1 + t2 + t3 - l + 4*m - r - b1 - b2 - b3) - acc xs = run1 backend (stencil pattern (Constant 0)) xs+ acc xs = run1 backend (stencil pattern (function (const 0))) xs ref :: (P.Num a, IArray UArray a) => UArray (Int,Int) a -> UArray (Int,Int) a ref xs =@@ -122,7 +122,7 @@ let pattern' :: A.Num a => Stencil3x3 a -> Exp a pattern' = pattern in- run1 backend (stencil pattern' Clamp) xs+ run1 backend (stencil pattern' clamp) xs ref :: (P.Num a, IArray UArray a) => UArray (Int,Int) a -> UArray (Int,Int) a ref xs =@@ -150,7 +150,7 @@ in x1 - y2 + y1 - z2 + z1 - x2 - acc xs = run1 backend (stencil pattern (Constant (0,0))) xs+ acc xs = run1 backend (stencil pattern (function (\_ -> constant (0,0)))) xs ref :: P.Num a => IArray.Array (Int,Int) (a,a) -> IArray.Array (Int,Int) a ref xs =@@ -167,7 +167,7 @@ testBoundary :: Maybe Test testBoundary = Just . testCase "boundary segfault" $ do let f ((x,_,_,_,_),_,_,_,_) = x- b = Constant 0+ b = function (const 0) s = stencil (f::Stencil5x5 Int -> Exp Int) b (A.fill (lift (Z:.1:.1000000 :: DIM2)) (0::Exp Int)) a = run backend s indexArray a (Z:.0:.0) @?= 0
examples/nofib/Test/Prelude/ZipWith.hs view
@@ -90,23 +90,23 @@ , testProperty "max" (test_max :: Array sh a -> Array sh a -> Property) ] where- test_quot xs ys = run2 backend (A.zipWith quot) xs ys ~?= zipWithRef quot xs ys- test_rem xs ys = run2 backend (A.zipWith rem) xs ys ~?= zipWithRef rem xs ys- test_quotRem xs ys = run2 backend (A.zipWith (lift $$ quotRem)) xs ys ~?= zipWithRef quotRem xs ys- test_div xs ys = run2 backend (A.zipWith div) xs ys ~?= zipWithRef div xs ys- test_mod xs ys = run2 backend (A.zipWith mod) xs ys ~?= zipWithRef mod xs ys- test_divMod xs ys = run2 backend (A.zipWith (lift $$ divMod)) xs ys ~?= zipWithRef divMod xs ys+ test_quot xs ys = runN backend (A.zipWith quot) xs ys ~?= zipWithRef quot xs ys+ test_rem xs ys = runN backend (A.zipWith rem) xs ys ~?= zipWithRef rem xs ys+ test_quotRem xs ys = runN backend (A.zipWith (lift $$ quotRem)) xs ys ~?= zipWithRef quotRem xs ys+ test_div xs ys = runN backend (A.zipWith div) xs ys ~?= zipWithRef div xs ys+ test_mod xs ys = runN backend (A.zipWith mod) xs ys ~?= zipWithRef mod xs ys+ test_divMod xs ys = runN backend (A.zipWith (lift $$ divMod)) xs ys ~?= zipWithRef divMod xs ys - test_band xs ys = run2 backend (A.zipWith (A..&.)) xs ys ~?= zipWithRef (P..&.) xs ys- test_bor xs ys = run2 backend (A.zipWith (A..|.)) xs ys ~?= zipWithRef (P..|.) xs ys- test_xor xs ys = run2 backend (A.zipWith A.xor) xs ys ~?= zipWithRef P.xor xs ys+ test_band xs ys = runN backend (A.zipWith (A..&.)) xs ys ~?= zipWithRef (P..&.) xs ys+ test_bor xs ys = runN backend (A.zipWith (A..|.)) xs ys ~?= zipWithRef (P..|.) xs ys+ test_xor xs ys = runN backend (A.zipWith A.xor) xs ys ~?= zipWithRef P.xor xs ys - test_shift xs ys = run2 backend (A.zipWith A.shift) xs ys ~?= zipWithRef P.shift xs ys- test_shiftL xs ys = run2 backend (A.zipWith A.shiftL) xs ys ~?= zipWithRef P.shiftL xs ys- test_shiftR xs ys = run2 backend (A.zipWith A.shiftR) xs ys ~?= zipWithRef P.shiftR xs ys- test_rotate xs ys = run2 backend (A.zipWith A.rotate) xs ys ~?= zipWithRef P.rotate xs ys- test_rotateL xs ys = run2 backend (A.zipWith A.rotateL) xs ys ~?= zipWithRef P.rotateL xs ys- test_rotateR xs ys = run2 backend (A.zipWith A.rotateR) xs ys ~?= zipWithRef P.rotateR xs ys+ test_shift xs ys = runN backend (A.zipWith A.shift) xs ys ~?= zipWithRef P.shift xs ys+ test_shiftL xs ys = runN backend (A.zipWith A.shiftL) xs ys ~?= zipWithRef P.shiftL xs ys+ test_shiftR xs ys = runN backend (A.zipWith A.shiftR) xs ys ~?= zipWithRef P.shiftR xs ys+ test_rotate xs ys = runN backend (A.zipWith A.rotate) xs ys ~?= zipWithRef P.rotate xs ys+ test_rotateL xs ys = runN backend (A.zipWith A.rotateL) xs ys ~?= zipWithRef P.rotateL xs ys+ test_rotateR xs ys = runN backend (A.zipWith A.rotateR) xs ys ~?= zipWithRef P.rotateR xs ys testFloatingElt :: forall a. (P.RealFrac a, P.RealFloat a, A.RealFloat a, A.RealFrac a, Arbitrary a, Similar a) => (Config :-> Bool) -> a -> Maybe Test testFloatingElt ok _@@ -142,23 +142,23 @@ , testProperty "max" (test_max :: Array sh a -> Array sh a -> Property) ] where- test_div xs ys = run2 backend (A.zipWith (/)) xs ys ~?= zipWithRef (/) xs ys- test_pow xs ys = run2 backend (A.zipWith (**)) xs ys ~?= zipWithRef (**) xs ys- test_atan2 xs ys = run2 backend (A.zipWith A.atan2) xs ys ~?= zipWithRef P.atan2 xs ys- test_logBase xs ys = run2 backend (A.zipWith logBase) xs ys ~?= zipWithRef logBase xs ys+ test_div xs ys = runN backend (A.zipWith (/)) xs ys ~?= zipWithRef (/) xs ys+ test_pow xs ys = runN backend (A.zipWith (**)) xs ys ~?= zipWithRef (**) xs ys+ test_atan2 xs ys = runN backend (A.zipWith A.atan2) xs ys ~?= zipWithRef P.atan2 xs ys+ test_logBase xs ys = runN backend (A.zipWith logBase) xs ys ~?= zipWithRef logBase xs ys - test_plus xs ys = run2 backend (A.zipWith (+)) xs ys ~?= zipWithRef (+) xs ys- test_minus xs ys = run2 backend (A.zipWith (-)) xs ys ~?= zipWithRef (-) xs ys- test_mult xs ys = run2 backend (A.zipWith (*)) xs ys ~?= zipWithRef (*) xs ys+ test_plus xs ys = runN backend (A.zipWith (+)) xs ys ~?= zipWithRef (+) xs ys+ test_minus xs ys = runN backend (A.zipWith (-)) xs ys ~?= zipWithRef (-) xs ys+ test_mult xs ys = runN backend (A.zipWith (*)) xs ys ~?= zipWithRef (*) xs ys - test_lt xs ys = run2 backend (A.zipWith (A.<)) xs ys ~?= zipWithRef (P.<) xs ys- test_gt xs ys = run2 backend (A.zipWith (A.>)) xs ys ~?= zipWithRef (P.>) xs ys- test_lte xs ys = run2 backend (A.zipWith (A.<=)) xs ys ~?= zipWithRef (P.<=) xs ys- test_gte xs ys = run2 backend (A.zipWith (A.>=)) xs ys ~?= zipWithRef (P.>=) xs ys- test_eq xs ys = run2 backend (A.zipWith (A.==)) xs ys ~?= zipWithRef (P.==) xs ys- test_neq xs ys = run2 backend (A.zipWith (A./=)) xs ys ~?= zipWithRef (P./=) xs ys- test_min xs ys = run2 backend (A.zipWith (A.min)) xs ys ~?= zipWithRef (P.min) xs ys- test_max xs ys = run2 backend (A.zipWith (A.max)) xs ys ~?= zipWithRef (P.max) xs ys+ test_lt xs ys = runN backend (A.zipWith (A.<)) xs ys ~?= zipWithRef (P.<) xs ys+ test_gt xs ys = runN backend (A.zipWith (A.>)) xs ys ~?= zipWithRef (P.>) xs ys+ test_lte xs ys = runN backend (A.zipWith (A.<=)) xs ys ~?= zipWithRef (P.<=) xs ys+ test_gte xs ys = runN backend (A.zipWith (A.>=)) xs ys ~?= zipWithRef (P.>=) xs ys+ test_eq xs ys = runN backend (A.zipWith (A.==)) xs ys ~?= zipWithRef (P.==) xs ys+ test_neq xs ys = runN backend (A.zipWith (A./=)) xs ys ~?= zipWithRef (P./=) xs ys+ test_min xs ys = runN backend (A.zipWith (A.min)) xs ys ~?= zipWithRef (P.min) xs ys+ test_max xs ys = runN backend (A.zipWith (A.max)) xs ys ~?= zipWithRef (P.max) xs ys {-# INLINE denom #-} denom f = forAllShrink arbitrary shrink $ \xs ->
examples/nofib/Test/Sharing.hs view
@@ -124,7 +124,7 @@ bits = A.map (\a -> (A.testBit a bitNum) ? (1, 0)) keys bitsInv = A.map (\b -> (b A.== 0) ? (1, 0)) bits - (falses, numZeroes) = A.scanl' (+) 0 bitsInv+ (falses, numZeroes) = unlift (A.scanl' (+) 0 bitsInv) trues = A.map (\x -> (A.the numZeroes) + (A.fst x) - (A.snd x)) $ A.zip ixs falses @@ -195,19 +195,19 @@ fs = fromList (Z:.10:.10) [0..] -- Ignoring the first parameter- first = stencil2 centre Clamp (use fs) Clamp (use is)+ first = stencil2 centre clamp (use fs) clamp (use is) where centre :: Stencil3x3 Float -> Stencil3x3 Int -> Exp Int centre _ (_,(_,y,_),_) = y -- Using both- both = stencil2 centre Clamp (use fs) Clamp (use is)+ both = stencil2 centre clamp (use fs) clamp (use is) where centre :: Stencil3x3 Float -> Stencil3x3 Int -> Exp Float centre (_,(_,x,_),_) (_,(_,y,_),_) = x + A.fromIntegral y -- Not using the second parameter- second = stencil2 centre Clamp (use fs) Clamp (use is)+ second = stencil2 centre clamp (use fs) clamp (use is) where centre :: Stencil3x3 Float -> Stencil3x3 Int -> Exp Float centre (_,(_,x,_),_) _ = x
examples/nofib/Test/Spectral/SMVM.hs view
@@ -52,7 +52,7 @@ run_smvm _ = forAll arbitraryCSRMatrix $ \(segd, svec :: Vector (Int32,a), cols) -> forAll (arbitraryArray (Z :. cols)) $ \vec ->- run2 backend smvm (segd, svec) vec+ runN backend smvm (segd, svec) vec ~?= smvmRef segd svec vec
examples/smoothlife/Gloss/Simulate.hs view
@@ -2,11 +2,13 @@ module Gloss.Simulate ( - Simulate(..),+ Mode(..),+ Simulate, sigmoidMode, mixingMode,+ initialise, ) where -import Config+import Config ( Config ) import Data.Label
examples/smoothlife/SmoothLife.hs view
@@ -16,7 +16,7 @@ import qualified Prelude as P import Data.Label-import Data.Array.Accelerate as A hiding ( size )+import Data.Array.Accelerate as A hiding ( size, clamp ) import Data.Array.Accelerate.Examples.Internal as A hiding ( nf ) import Data.Array.Accelerate.Math.FFT import Data.Array.Accelerate.Math.DFT.Centre@@ -63,8 +63,8 @@ -- initial state --- kflr = sum kr- kfld = sum kd+ kflr = sum (flatten kr)+ kfld = sum (flatten kd) krf = fft2D' Forward sh (shift2D (complex kr)) kdf = fft2D' Forward sh (shift2D (complex kd)) @@ -102,7 +102,8 @@ timestepModes f g = [ f , g + dt*(2.0*f-1.0)- , g + dt*(f-g) ]+ , g + dt*(f-g)+ ] -- Equation 6: s(n,m)
examples/tunnel/Main.hs view
@@ -12,7 +12,7 @@ import Data.Label -import Data.Array.Accelerate as A+import Data.Array.Accelerate as A hiding ( clamp ) import Data.Array.Accelerate.Examples.Internal as A import Data.Array.Accelerate.Linear.Metric
lib/Data/Array/Accelerate/Examples/Internal/Backend.hs view
@@ -17,30 +17,23 @@ module Data.Array.Accelerate.Examples.Internal.Backend where -import Prelude as P+import Prelude as P import Data.Label import System.Console.GetOpt import Data.Array.Accelerate-import qualified Data.Array.Accelerate as A-import qualified Data.Array.Accelerate.Interpreter as Interp+import Data.Array.Accelerate.Trafo ( Afunction, AfunctionR )+import qualified Data.Array.Accelerate.Interpreter as Interp #ifdef ACCELERATE_LLVM_NATIVE_BACKEND-import qualified Data.Array.Accelerate.LLVM.Native as CPU+import qualified Data.Array.Accelerate.LLVM.Native as CPU #endif #ifdef ACCELERATE_LLVM_PTX_BACKEND-import qualified Data.Array.Accelerate.LLVM.PTX as PTX-#endif-#ifdef ACCELERATE_CUDA_BACKEND-import qualified Data.Array.Accelerate.CUDA as CUDA-#endif-#ifdef ACCELERATE_CILK_BACKEND-import qualified Data.Array.Accelerate.Cilk as Cilk+import qualified Data.Array.Accelerate.LLVM.PTX as PTX #endif -- | Execute Accelerate expressions ---{-# INLINE run #-} run :: Arrays a => Backend -> Acc a -> a run Interpreter = Interp.run #ifdef ACCELERATE_LLVM_NATIVE_BACKEND@@ -49,50 +42,20 @@ #ifdef ACCELERATE_LLVM_PTX_BACKEND run PTX = PTX.run #endif-#ifdef ACCELERATE_CUDA_BACKEND-run CUDA = CUDA.run-#endif-#ifdef ACCELERATE_CILK_BACKEND-run Cilk = Cilk.run-#endif --{-# INLINE run1 #-} run1 :: (Arrays a, Arrays b) => Backend -> (Acc a -> Acc b) -> a -> b-run1 Interpreter f = Interp.run1 f+run1 = runN++runN :: Afunction f => Backend -> f -> AfunctionR f+runN Interpreter = Interp.runN #ifdef ACCELERATE_LLVM_NATIVE_BACKEND-run1 CPU f = CPU.run1 f+runN CPU = CPU.runN #endif #ifdef ACCELERATE_LLVM_PTX_BACKEND-run1 PTX f = PTX.run1 f-#endif-#ifdef ACCELERATE_CUDA_BACKEND-run1 CUDA f = CUDA.run1 f-#endif-#ifdef ACCELERATE_CILK_BACKEND-run1 Cilk f = Cilk.run . f . use+runN PTX = PTX.runN #endif -{-# INLINE run2 #-}-run2 :: (Arrays a, Arrays b, Arrays c) => Backend -> (Acc a -> Acc b -> Acc c) -> a -> b -> c-run2 backend f x y = go (x,y)- where- !go = run1 backend (A.uncurry f) -{-# INLINE run3 #-}-run3 :: (Arrays a, Arrays b, Arrays c, Arrays d) => Backend -> (Acc a -> Acc b -> Acc c -> Acc d) -> a -> b -> c -> d-run3 backend f x y z = go (x,y,z)- where- !go = run1 backend (\t -> let (a,b,c) = unlift t in f a b c)---{-# INLINE run4 #-}-run4 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e) => Backend -> (Acc a -> Acc b -> Acc c -> Acc d -> Acc e) -> a -> b -> c -> d -> e-run4 backend f x y z w = go (x,y,z,w)- where- !go = run1 backend (\t -> let (a,b,c,d) = unlift t in f a b c d)-- -- | The set of backends available to execute the program. -- data Backend = Interpreter@@ -102,15 +65,6 @@ #ifdef ACCELERATE_LLVM_PTX_BACKEND | PTX #endif-#ifdef ACCELERATE_CUDA_BACKEND- | CUDA-#endif-#ifdef ACCELERATE_LLVM_MULTIDEV_BACKEND- | Multi-#endif-#ifdef ACCELERATE_CILK_BACKEND- | Cilk-#endif deriving (P.Eq, P.Enum, P.Bounded) @@ -125,15 +79,6 @@ #ifdef ACCELERATE_LLVM_PTX_BACKEND show PTX = "llvm-ptx" #endif-#ifdef ACCELERATE_CUDA_BACKEND- show CUDA = "cuda"-#endif-#ifdef ACCELERATE_LLVM_MULTIDEV_BACKEND- show Multi = "llvm-multi"-#endif-#ifdef ACCELERATE_CILK_BACKEND- show Cilk = "cilk"-#endif -- The default backend to use. Use one of the accelerated backends whenever@@ -153,8 +98,7 @@ availableBackends optBackend = [ Option [] [show Interpreter] (NoArg (set optBackend Interpreter))- "reference implementation (sequential)"-+ "reference implementation (sequential, slow)" #ifdef ACCELERATE_LLVM_NATIVE_BACKEND , Option [] [show CPU] (NoArg (set optBackend CPU))@@ -165,21 +109,6 @@ (NoArg (set optBackend PTX)) "LLVM based implementation for NVIDIA GPUs (parallel)" #endif-#ifdef ACCELERATE_CUDA_BACKEND- , Option [] [show CUDA]- (NoArg (set optBackend CUDA))- "CUDA based implementation for NVIDIA GPUs (parallel)"-#endif-#ifdef ACCELERATE_LLVM_MULTIDEV_BACKEND- , Option [] [show Multi]- (NoArg (set optBackend Multi))- "LLVM based multi-device implementation using CPUs and GPUs (parallel)"-#endif-#ifdef ACCELERATE_CILK_BACKEND- , Option [] [show Cilk]- (NoArg (set optBackend Cilk))- "Cilk based implementation for multicore CPUs (parallel)"-#endif ] @@ -211,11 +140,5 @@ #endif #ifdef ACCELERATE_LLVM_PTX_BACKEND concurrentBackends PTX = Nothing-#endif-#ifdef ACCELERATE_CUDA_BACKEND-concurrentBackends CUDA = Just 1 -- not thread safe-#endif-#ifdef ACCELERATE_CILK_BACKEND-concurrentBackends Cilk = Just 1 -- not thread safe #endif
lib/Data/Array/Accelerate/Examples/Internal/Monitoring.hs view
@@ -16,7 +16,9 @@ ) where +#ifdef ACCELERATE_ENABLE_EKG import qualified Data.Array.Accelerate.Debug as Debug+#endif -- | Launch a monitoring server that will collect statistics on the running