diff --git a/accelerate-examples.cabal b/accelerate-examples.cabal --- a/accelerate-examples.cabal +++ b/accelerate-examples.cabal @@ -1,5 +1,5 @@ Name: accelerate-examples -Version: 1.1.0.0 +Version: 1.2.0.0 Cabal-version: >=1.8 Tested-with: GHC >= 7.8 Build-type: Simple @@ -62,10 +62,6 @@ -- Flags to specify which programs to build -- -Flag nofib - Description: Regression test suite - Default: True - Flag smvm Description: Sparse-matrix vector multiplication benchmark Default: True @@ -125,8 +121,8 @@ Library hs-source-dirs: lib Build-depends: - base >= 4.7 && < 4.11 - , accelerate == 1.1.* + base >= 4.7 && < 4.12 + , accelerate >= 1.2 , ansi-wl-pprint >= 0.6 , containers >= 0.5 , criterion >= 1.0 @@ -163,20 +159,15 @@ if flag(gui) CPP-options: -DACCELERATE_ENABLE_GUI - -- 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.1.* + accelerate-llvm-native >= 1.2 if flag(llvm-ptx) CPP-options: -DACCELERATE_LLVM_PTX_BACKEND build-depends: - accelerate-llvm-ptx == 1.1.* + accelerate-llvm-ptx >= 1.2 if flag(ekg) CPP-options: -DACCELERATE_ENABLE_EKG @@ -200,119 +191,6 @@ Data.Array.Accelerate.Examples.Internal.TH --- The main test program. This includes randomised quickcheck testing for array --- primitives, unit tests, imaginary/spectral/real programs, and benchmarks. --- --- TODO: add an analysis script to scrape benchmark results --- -Executable accelerate-nofib - Main-is: Main.hs - hs-source-dirs: - examples/nofib - examples/smvm - - other-modules: - Config - QuickCheck.Arbitrary.Array - QuickCheck.Arbitrary.Shape - SMVM - Test.Base - Test.FFT - Test.Foreign - Test.Imaginary - Test.Imaginary.DotP - Test.Imaginary.SASUM - Test.Imaginary.SAXPY - Test.IO - Test.IO.Ptr - Test.IO.Vector - Test.Issues - Test.Issues.Issue93 - Test.Issues.Issue102 - Test.Issues.Issue114 - Test.Issues.Issue119 - Test.Issues.Issue123 - Test.Issues.Issue137 - Test.Issues.Issue168 - Test.Issues.Issue184 - Test.Issues.Issue185 - Test.Issues.Issue187 - Test.Issues.Issue228 - Test.Issues.Issue255 - Test.Issues.Issue264 - Test.Issues.Issue286 - Test.Issues.Issue287 - Test.Issues.Issue288 - Test.Issues.Issue362 - Test.Prelude - Test.Prelude.Backpermute - Test.Prelude.Filter - Test.Prelude.Fold - Test.Prelude.Map - Test.Prelude.Permute - Test.Prelude.Replicate - Test.Prelude.Scan - -- Test.Prelude.Sequences - Test.Prelude.Stencil - Test.Prelude.ZipWith - Test.Sharing - Test.Spectral - Test.Spectral.BlackScholes - Test.Spectral.RadixSort - Test.Spectral.SMVM - - ghc-options: - -O2 - -Wall - -threaded - -fpedantic-bottoms - -fno-excess-precision - -eventlog - -rtsopts - -with-rtsopts=-n2M - -with-rtsopts=-A64M - -with-rtsopts=-qg - - ghc-prof-options: - -auto-all - - extra-libraries: stdc++ - 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(ekg) - ghc-options: -with-rtsopts=-T - - if !flag(nofib) - buildable: False - else - build-depends: - 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 - , HUnit >= 1.2 - , pipes >= 4.1.6 - , QuickCheck >= 2.7 - , random - , test-framework >= 0.5 - , test-framework-hunit >= 0.3 - , test-framework-quickcheck2 >= 0.2 - , vector >= 0.7 - - -- Sparse matrix vector multiplication -- ----------------------------------- @@ -343,10 +221,10 @@ buildable: False else build-depends: - base >= 4.7 && < 4.11 - , accelerate == 1.1.* + base >= 4.7 && < 4.12 + , accelerate >= 1.2 , accelerate-examples - , accelerate-io >= 1.0 + , accelerate-io >= 1.1 , fclabels >= 2.0 , matrix-market-attoparsec >= 0.1 , mwc-random >= 0.8 @@ -382,8 +260,8 @@ buildable: False else build-depends: - base >= 4.7 && < 4.11 - , accelerate == 1.1.* + base >= 4.7 && < 4.12 + , accelerate >= 1.2 , accelerate-examples , colour-accelerate >= 0.1 , fclabels >= 2.0 @@ -417,8 +295,8 @@ buildable: False else build-depends: - base >= 4.7 && < 4.11 - , accelerate == 1.1.* + base >= 4.7 && < 4.12 + , accelerate >= 1.2 , accelerate-examples , fclabels >= 2.0 , gloss-raster-accelerate >= 2.0 @@ -454,10 +332,10 @@ buildable: False else build-depends: - base >= 4.7 && < 4.11 - , accelerate == 1.1.* + base >= 4.7 && < 4.12 + , accelerate >= 1.2 , accelerate-examples - , accelerate-io >= 1.0 + , accelerate-io >= 1.2 , colour-accelerate >= 0.1 , fclabels >= 2.0 , repa >= 3.1 @@ -492,10 +370,10 @@ buildable: False else build-depends: - base >= 4.7 && < 4.11 - , accelerate == 1.1.* + base >= 4.7 && < 4.12 + , accelerate >= 1.2 , accelerate-examples - , accelerate-io >= 1.0 + , accelerate-io >= 1.2 , colour-accelerate >= 0.1 , fclabels >= 2.0 , gloss >= 1.7 @@ -529,10 +407,10 @@ buildable: False else build-depends: - base >= 4.7 && < 4.11 - , accelerate == 1.1.* + base >= 4.7 && < 4.12 + , accelerate >= 1.2 , accelerate-examples - , accelerate-io >= 1.0 + , accelerate-io >= 1.2 , bmp >= 1.2 , colour-accelerate >= 0.1 , fclabels >= 2.0 @@ -580,8 +458,8 @@ buildable: False else build-depends: - base >= 4.7 && < 4.11 - , accelerate == 1.1.* + base >= 4.7 && < 4.12 + , accelerate >= 1.2 , accelerate-examples , fclabels >= 2.0 , gloss >= 1.7 @@ -616,11 +494,6 @@ 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 @@ -628,10 +501,10 @@ buildable: False else build-depends: - base >= 4.7 && < 4.11 - , accelerate == 1.1.* + base >= 4.7 && < 4.12 + , accelerate >= 1.2 , accelerate-examples - , accelerate-fft >= 1.0 + , accelerate-fft >= 1.2 , colour-accelerate >= 0.1 , fclabels >= 2.0 , gloss >= 1.7 @@ -666,8 +539,8 @@ buildable: False else build-depends: - base >= 4.7 && < 4.11 - , accelerate == 1.1.* + base >= 4.7 && < 4.12 + , accelerate >= 1.2 , accelerate-examples , bytestring >= 0.9 , bytestring-lexing >= 0.5 @@ -704,11 +577,11 @@ buildable: False else build-depends: - base >= 4.7 && < 4.11 - , accelerate == 1.1.* + base >= 4.7 && < 4.12 + , accelerate >= 1.2 , accelerate-examples - , accelerate-fft >= 1.0 - , accelerate-io >= 1.0 + , accelerate-fft >= 1.2 + , accelerate-io >= 1.2 , colour-accelerate >= 0.1 , fclabels >= 2.0 , filepath >= 1.0 @@ -747,10 +620,10 @@ buildable: False else build-depends: - base >= 4.7 && < 4.11 - , accelerate == 1.1.* + base >= 4.7 && < 4.12 + , accelerate >= 1.2 , accelerate-examples - , accelerate-io >= 1.0 + , accelerate-io >= 1.2 , bytestring >= 0.9.2 , containers >= 0.4.2 , directory >= 1.1 @@ -796,8 +669,8 @@ buildable: False else build-depends: - base >= 4.7 && < 4.11 - , accelerate == 1.1.* + base >= 4.7 && < 4.12 + , accelerate >= 1.2 , accelerate-examples , colour-accelerate >= 0.1 , fclabels >= 1.0 @@ -835,8 +708,8 @@ buildable: False else build-depends: - base >= 4.7 && < 4.11 - , accelerate == 1.1.* + base >= 4.7 && < 4.12 + , accelerate >= 1.2 , accelerate-examples , binary >= 0.7 , directory >= 1.1 @@ -851,8 +724,7 @@ source-repository this type: git - tag: 1.1.0.0 + tag: 1.2.0.0 location: https://github.com/AccelerateHS/accelerate-examples -- vim: nospell - diff --git a/examples/canny/src-acc/Canny.hs b/examples/canny/src-acc/Canny.hs --- a/examples/canny/src-acc/Canny.hs +++ b/examples/canny/src-acc/Canny.hs @@ -17,7 +17,7 @@ import qualified Prelude as P import Data.Array.Accelerate as A -import Data.Array.Accelerate.IO as A +import Data.Array.Accelerate.IO.Codec.BMP as A import Data.Array.Accelerate.Data.Colour.RGB diff --git a/examples/canny/src-acc/Main.hs b/examples/canny/src-acc/Main.hs --- a/examples/canny/src-acc/Main.hs +++ b/examples/canny/src-acc/Main.hs @@ -11,8 +11,10 @@ import Data.Array.Accelerate as A import Data.Array.Accelerate.Examples.Internal as A -import qualified Data.Array.Accelerate.IO as A +import qualified Data.Array.Accelerate.IO.Codec.BMP as A +import qualified Data.Array.Repa as R import qualified Data.Array.Repa.IO.BMP as R +import qualified Data.Array.Repa.Repr.Accelerate as A import qualified Data.Array.Repa.Repr.Unboxed as R @@ -53,7 +55,7 @@ -- write the final image to file -- let (image, strong) = run backend $ A.lift (canny threshLow threshHigh (use img)) - edges <- wildfire (A.toRepa image) (A.toRepa strong) + edges <- flipV <$> wildfire (A.toRepa image) (A.toRepa strong) R.writeImageToBMP fileOut (R.zip3 edges edges edges) else do @@ -77,4 +79,14 @@ , bench "run1" $ whnf (run1 backend (P.snd . canny threshLow threshHigh)) img ] ] + +-- | Flip the image vertically +-- +flipV :: R.Array R.U R.DIM2 Word8 -> R.Array R.U R.DIM2 Word8 +flipV arr + = R.computeUnboxedS + $ R.backpermute sh p arr + where + sh@(R.Z R.:. rows R.:. _) = R.extent arr + p (R.Z R.:. j R.:. i) = R.Z R.:. rows-j-1 R.:. i diff --git a/examples/canny/src-acc/Wildfire.hs b/examples/canny/src-acc/Wildfire.hs --- a/examples/canny/src-acc/Wildfire.hs +++ b/examples/canny/src-acc/Wildfire.hs @@ -16,7 +16,7 @@ import Canny import Data.Word -import Data.Array.Accelerate.IO ( A ) +import Data.Array.Repa.Repr.Accelerate ( A ) import Data.Array.Repa.Repr.Unboxed ( U ) import qualified Data.Array.Repa as R import qualified Data.Vector.Unboxed as V diff --git a/examples/fft/src-acc/Config.hs b/examples/fft/src-acc/Config.hs --- a/examples/fft/src-acc/Config.hs +++ b/examples/fft/src-acc/Config.hs @@ -49,8 +49,6 @@ , "" , "Usage: accelerate-fft [OPTIONS] fileIn.bmp fileOut.bmp" , "" - , "Image dimensions must be a power of two, eg 128x512 or 64x256" - , "" , "For FFT, the output magnitude has a high dynamic range. We need to clip it" , "otherwise most of the pixels in the output BMP will be black. Start with a" , "value equal to about the width of the image (eg 512)" diff --git a/examples/fft/src-acc/FFT.hs b/examples/fft/src-acc/FFT.hs --- a/examples/fft/src-acc/FFT.hs +++ b/examples/fft/src-acc/FFT.hs @@ -1,18 +1,19 @@ +{-# LANGUAGE FlexibleContexts #-} module FFT where import qualified Prelude as P import Data.Array.Accelerate as A -import Data.Array.Accelerate.IO as A +import Data.Array.Accelerate.IO.Codec.BMP as A import Data.Array.Accelerate.Data.Colour.RGBA as A import Data.Array.Accelerate.Data.Complex as A import Data.Array.Accelerate.Math.FFT as A import Data.Array.Accelerate.Math.DFT.Centre as A -imageFFT :: DIM2 -> Int -> Acc (Array DIM2 RGBA32) -> Acc (Array DIM2 RGBA32, Array DIM2 RGBA32) -imageFFT sh cutoff img = lift (arrMag, arrPhase) +imageFFT :: Int -> Acc (Array DIM2 RGBA32) -> Acc (Array DIM2 RGBA32, Array DIM2 RGBA32) +imageFFT cutoff img = lift (arrMag, arrPhase) where -- Load in the image luminance arrComplex :: Acc (Array DIM2 (Complex Float)) @@ -24,7 +25,7 @@ arrCentered = centre2D arrComplex -- Do the transform - arrFreq = fft2D' Forward sh arrCentered + arrFreq = fft2D Forward arrCentered -- Clip the magnitude of the transformed array clipMag = the (unit (constant (P.fromIntegral cutoff))) diff --git a/examples/fft/src-acc/HighPass.hs b/examples/fft/src-acc/HighPass.hs --- a/examples/fft/src-acc/HighPass.hs +++ b/examples/fft/src-acc/HighPass.hs @@ -4,29 +4,29 @@ where import Data.Array.Accelerate as A -import Data.Array.Accelerate.IO as A +import Data.Array.Accelerate.IO.Codec.BMP as A import Data.Array.Accelerate.Data.Colour.RGBA as A import Data.Array.Accelerate.Math.FFT as A import Data.Array.Accelerate.Math.DFT.Centre as A import Data.Array.Accelerate.Data.Complex as A -highpassFFT :: DIM2 -> Int -> Acc (Array DIM2 RGBA32) -> Acc (Array DIM2 RGBA32) -highpassFFT sh cutoff img = img' +highpassFFT :: Int -> Acc (Array DIM2 RGBA32) -> Acc (Array DIM2 RGBA32) +highpassFFT cutoff img = img' where (r,g,b,a) = A.unzip4 $ A.map (\c -> let RGBA x y z w = unlift c :: RGBA (Exp Word8) in lift (x,y,z,w) :: Exp (Word8, Word8, Word8, Word8)) $ A.map unpackRGBA8 img - r' = transform sh cutoff r - g' = transform sh cutoff g - b' = transform sh cutoff b + r' = transform cutoff r + g' = transform cutoff g + b' = transform cutoff b -- img' = A.zipWith4 (\x y z w -> packRGBA8 . lift $ RGBA x y z w) r' g' b' a -transform :: DIM2 -> Int -> Acc (Array DIM2 Word8) -> Acc (Array DIM2 Word8) -transform sh@(Z :. height :. width) cutoff' arrReal = arrResult +transform :: Int -> Acc (Array DIM2 Word8) -> Acc (Array DIM2 Word8) +transform cutoff' arrReal = arrResult where cutoff = the (unit (constant cutoff')) @@ -35,11 +35,12 @@ -- Do the 2D transform arrCentered = centre2D arrComplex - arrFreq = fft2D' Forward sh arrCentered + arrFreq = fft2D Forward arrCentered -- Zap out the low-frequency components - centreX = constant (width `div` 2) - centreY = constant (height `div` 2) + Z :. h :. w = unlift (shape arrReal) + centreX = w `div` 2 + centreY = h `div` 2 zap ix = let (Z :. y :. x) = unlift ix inx = x > centreX - cutoff && x A.< centreX + cutoff @@ -50,7 +51,7 @@ arrFilt = A.generate (A.shape arrFreq) zap -- Do the inverse transform to get back to image space - arrInv = fft2D' Inverse sh arrFilt + arrInv = fft2D Inverse arrFilt -- The magnitude of the transformed array arrResult = A.map (A.truncate . magnitude) arrInv diff --git a/examples/fft/src-acc/Main.hs b/examples/fft/src-acc/Main.hs --- a/examples/fft/src-acc/Main.hs +++ b/examples/fft/src-acc/Main.hs @@ -12,7 +12,7 @@ import System.FilePath import Data.Array.Accelerate as A -import Data.Array.Accelerate.IO as A +import Data.Array.Accelerate.IO.Codec.BMP as A import Data.Array.Accelerate.Examples.Internal as A @@ -41,20 +41,18 @@ clip = get configClip conf backend = get optBackend opts - sh = A.arrayShape img - -- Write out the images to file -- - highpass = run backend $ highpassFFT sh cutoff (use img) - (mag, phase) = run backend $ imageFFT sh clip (use img) + highpass = run backend $ highpassFFT cutoff (use img) + (mag, phase) = run backend $ imageFFT clip (use img) writeImageToBMP fileHP highpass writeImageToBMP fileMag mag writeImageToBMP filePhase phase runBenchmarks opts (P.drop 2 rest) - [ bench "highpass" $ whnf (run1 backend (highpassFFT sh cutoff)) img - , bench "fft" $ whnf (run1 backend (imageFFT sh clip)) img + [ bench "highpass" $ whnf (run1 backend (highpassFFT cutoff)) img + , bench "fft" $ whnf (run1 backend (imageFFT clip)) img ] diff --git a/examples/fluid/src-acc/Config.hs b/examples/fluid/src-acc/Config.hs --- a/examples/fluid/src-acc/Config.hs +++ b/examples/fluid/src-acc/Config.hs @@ -14,7 +14,7 @@ import Prelude as P import Data.Array.Accelerate as A -import Data.Array.Accelerate.IO as A +import Data.Array.Accelerate.IO.Codec.BMP as A import Data.Array.Accelerate.Data.Colour.RGBA as A import Data.Array.Accelerate.Examples.Internal as A diff --git a/examples/hashcat/Config.hs b/examples/hashcat/Config.hs --- a/examples/hashcat/Config.hs +++ b/examples/hashcat/Config.hs @@ -17,8 +17,6 @@ , _configMaxWords :: Maybe Int , _configSkipWords :: Int -- , _configNoSeq :: Bool - - , _configHelp :: Bool } deriving Show @@ -32,7 +30,6 @@ , _configMaxWords = Nothing , _configSkipWords = 0 -- , _configNoSeq = True - , _configHelp = False } @@ -59,10 +56,6 @@ -- , Option [] ["noseq"] -- (NoArg (set configNoSeq True)) -- "do not use sequencing" - - , Option ['h', '?'] ["help"] - (NoArg (set configHelp True)) - "show this help message" ] diff --git a/examples/hashcat/MD5.hs b/examples/hashcat/MD5.hs --- a/examples/hashcat/MD5.hs +++ b/examples/hashcat/MD5.hs @@ -29,9 +29,10 @@ -- matches the given unknown md5, returns the index into the dictionary of said -- match. If not found, this returns (-1). -- -hashcatDict :: Acc Dictionary - -> Acc (Scalar MD5) - -> Acc (Scalar Int) +hashcatDict + :: Acc Dictionary + -> Acc (Scalar MD5) + -> Acc (Scalar Int) hashcatDict dict passwd = reshape (constant Z) $ permute const res (\ix -> crypt A.! ix `cmp` the passwd ? (constant (Z:.0), ignore)) @@ -49,10 +50,11 @@ -- given unknown md5, returns the given index. If not matched, this -- returns (-1). -- -hashcatWord :: Acc (Scalar MD5) - -> Acc (Vector Word32) - -> Acc (Scalar Int) - -> Acc (Scalar Int) +hashcatWord + :: Acc (Scalar MD5) + -> Acc (Vector Word32) + -> Acc (Scalar Int) + -> Acc (Scalar Int) hashcatWord passwd word ix = unit (crypt `cmp` the passwd ? (the ix, -1)) where @@ -174,3 +176,4 @@ return . P.fst $ fromMaybe (error "readHex32be: parse failure") (readHexadecimal s) in either error id . S.runGetLazy get + diff --git a/examples/hashcat/Main.hs b/examples/hashcat/Main.hs --- a/examples/hashcat/Main.hs +++ b/examples/hashcat/Main.hs @@ -71,8 +71,9 @@ --} recover hash = - let abcd = readMD5 hash - idx = run1 backend (hashcatDict (A.use dict)) (A.fromList Z [abcd]) + let !go = runN backend (hashcatDict (A.use dict)) + abcd = readMD5 hash + idx = go (A.fromList Z [abcd]) -- in case idx `A.indexArray` Z of -1 -> Nothing diff --git a/examples/mandelbrot/Main.hs b/examples/mandelbrot/Main.hs --- a/examples/mandelbrot/Main.hs +++ b/examples/mandelbrot/Main.hs @@ -9,7 +9,7 @@ import Data.Label import Prelude as P -import Data.Array.Accelerate.IO as A +import Data.Array.Accelerate.IO.Codec.BMP as A import Data.Array.Accelerate.Examples.Internal as A import qualified Graphics.Gloss.Interface.IO.Game as G diff --git a/examples/mandelbrot/Mandel.hs b/examples/mandelbrot/Mandel.hs --- a/examples/mandelbrot/Mandel.hs +++ b/examples/mandelbrot/Mandel.hs @@ -7,7 +7,7 @@ module Mandel where -import Data.Array.Accelerate as A +import Data.Array.Accelerate as A hiding ( fromInteger ) import Data.Array.Accelerate.Data.Complex as A import Data.Array.Accelerate.Data.Colour.RGB as A import Data.Array.Accelerate.Data.Colour.Names as A @@ -17,7 +17,7 @@ mandelbrot - :: forall a. (Num a, RealFloat a, FromIntegral Int a) + :: forall a. (Num a, RealFloat a, FromIntegral Int a, Elt (Complex a)) => Int -- ^ image width -> Int -- ^ image height -> Acc (Scalar a) -- ^ centre x @@ -71,7 +71,7 @@ -- -- escapeToColour - :: (RealFloat a, ToFloating Int32 a) + :: (RealFloat a, ToFloating Int32 a, Elt (Complex a)) => Acc (Scalar Int32) -> Exp (Complex a, Int32) -> Exp Colour @@ -89,7 +89,7 @@ points = 2048 :: Exp Int escapeToRGBA - :: (RealFloat a, ToFloating Int32 a) + :: (RealFloat a, ToFloating Int32 a, Elt (Complex a)) => Acc (Scalar Int32) -> Acc (Vector Word32) -> Exp (Complex a, Int32) diff --git a/examples/mandelbrot/World.hs b/examples/mandelbrot/World.hs --- a/examples/mandelbrot/World.hs +++ b/examples/mandelbrot/World.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} @@ -26,6 +27,7 @@ import Prelude as P import Data.Array.Accelerate ( Arrays, Array, Scalar, Vector, DIM2, Elt, Acc, Z(..), (:.)(..) ) +import Data.Array.Accelerate.Data.Complex import Data.Array.Accelerate.Examples.Internal as A import qualified Data.Array.Accelerate as A @@ -36,11 +38,11 @@ data Precision = Float | Double data World where - World :: (P.RealFloat a, A.RealFloat a) => + World :: (P.RealFloat a, A.RealFloat a, A.Elt (Complex a)) => { worldPicture :: !Picture , worldDirty :: Bool , worldPrecision :: Precision - , worldPalette :: Vector Word32 + , worldPalette :: !(Vector Word32) , worldRender :: (Scalar a, Scalar a, Scalar a, Scalar Int32, Scalar a) -> Array DIM2 Word32 , worldSizeX :: !Int , worldSizeY :: !Int @@ -77,7 +79,7 @@ setPrecision :: Options -> Precision -> World -> World setPrecision opts prec World{..} = let - mandel :: (A.RealFloat a, A.FromIntegral Int a, A.ToFloating Int32 a) + mandel :: (A.RealFloat a, A.FromIntegral Int a, A.ToFloating Int32 a, A.Elt (Complex a)) => Acc (Scalar a) -> Acc (Scalar a) -> Acc (Scalar a) -> Acc (Scalar Int32) -> Acc (Scalar a) -> Acc (Array DIM2 Word32) mandel x y w l r = A.map (escapeToRGBA l (A.use worldPalette)) $ mandelbrot worldSizeX worldSizeY x y w l r @@ -188,7 +190,8 @@ renderWorld :: World -> Array DIM2 Word32 renderWorld World{..} = - worldRender (worldPosX, worldPosY, worldWidth, worldIters, worldRadius) + let !r = worldRender (worldPosX, worldPosY, worldWidth, worldIters, worldRadius) + in r -- Miscellaneous diff --git a/examples/nofib/Config.hs b/examples/nofib/Config.hs deleted file mode 100644 --- a/examples/nofib/Config.hs +++ /dev/null @@ -1,126 +0,0 @@ -{-# LANGUAGE PatternGuards #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE ViewPatterns #-} -{-# OPTIONS_GHC -fno-warn-name-shadowing #-} - -module Config where - -import Data.Label -import Data.Maybe -import Data.Bits -import System.Console.GetOpt - - -data Config - = Config - { - -- Which QuickCheck test types to enable? - _configDouble :: Bool - , _configFloat :: Bool - , _configInt64 :: Bool - , _configInt32 :: Bool - , _configInt16 :: Bool - , _configInt8 :: Bool - , _configWord64 :: Bool - , _configWord32 :: Bool - , _configWord16 :: Bool - , _configWord8 :: Bool - } - -$(mkLabel ''Config) - - -defaults :: Config -defaults = Config - { - _configDouble = True - , _configFloat = False - , _configInt64 = $( [e| finiteBitSize (undefined::Int) == 64 |] ) - , _configInt32 = $( [e| finiteBitSize (undefined::Int) == 32 |] ) - , _configInt16 = False - , _configInt8 = False - , _configWord64 = False - , _configWord32 = False - , _configWord16 = False - , _configWord8 = False - } - -extensive :: Config -extensive = Config - { - _configDouble = True - , _configFloat = True - , _configInt64 = True - , _configInt32 = True - , _configInt16 = True - , _configInt8 = True - , _configWord64 = True - , _configWord32 = True - , _configWord16 = True - , _configWord8 = True - } - - -options :: [OptDescr (Config -> Config)] -options = - [ Option [] ["all"] - (NoArg (const extensive)) - "enable tests on all primitive types" - - , Option [] ["double"] - (OptArg (set configDouble . read . fromMaybe "True") "BOOL") - (describe configDouble "enable double-precision tests") - - , Option [] ["float"] - (OptArg (set configFloat . read . fromMaybe "True") "BOOL") - (describe configFloat "enable single-precision tests") - - , Option [] ["int64"] - (OptArg (set configInt64 . read . fromMaybe "True") "BOOL") - (describe configInt64 "enable 64-bit integer tests") - - , Option [] ["int32"] - (OptArg (set configInt32 . read . fromMaybe "True") "BOOL") - (describe configInt32 "enable 32-bit integer tests") - - , Option [] ["int16"] - (OptArg (set configInt16 . read . fromMaybe "True") "BOOL") - (describe configInt16 "enable 16-bit integer tests") - - , Option [] ["int8"] - (OptArg (set configInt8 . read . fromMaybe "True") "BOOL") - (describe configInt8 "enable 8-bit integer tests") - - , Option [] ["word64"] - (OptArg (set configWord64 . read . fromMaybe "True") "BOOL") - (describe configWord64 "enable 64-bit unsigned integer tests") - - , Option [] ["word32"] - (OptArg (set configWord32 . read . fromMaybe "True") "BOOL") - (describe configWord32 "enable 32-bit unsigned integer tests") - - , Option [] ["word16"] - (OptArg (set configWord16 . read . fromMaybe "True") "BOOL") - (describe configWord16 "enable 16-bit unsigned integer tests") - - , Option [] ["word8"] - (OptArg (set configWord8 . read . fromMaybe "True") "BOOL") - (describe configWord8 "enable 8-bit unsigned integer tests") - ] - where - describe f msg - = msg ++ " (" ++ show (get f defaults) ++ ")" - -header :: [String] -header = - [ "accelerate-nofib (c) [2013] The Accelerate Team" - , "" - , "Usage: accelerate-nofib [OPTIONS]" - , "" - ] - -footer :: [String] -footer = [ "" ] - diff --git a/examples/nofib/Main.hs b/examples/nofib/Main.hs deleted file mode 100644 --- a/examples/nofib/Main.hs +++ /dev/null @@ -1,52 +0,0 @@ - -module Main where - -import Data.Label - -import Config -import Test.FFT -import Test.IO -import Test.Prelude -import Test.Sharing -import Test.Imaginary -import Test.Spectral -import Test.Issues -import Test.Foreign - -import Data.Array.Accelerate.Examples.Internal - - -main :: IO () -main = do - - -- Kick off EKG monitoring. Perhaps not particularly useful since we spend a - -- lot of time just generating random data, etc. - -- - beginMonitoring - - -- process command line args, and print a brief usage message - -- - (conf, opts, rest) <- parseArgs options defaults header footer - let backend = get optBackend opts - - -- Run tests, executing the simplest first. More complex operations, such as - -- segmented operations, generally depend on simpler tests. We build up to the - -- larger test programs. - -- - runTests opts rest - [ test_prelude backend conf - , test_sharing conf - , test_io conf - , test_imaginary backend conf - , test_spectral backend conf - , test_fft backend conf - , test_foreign backend conf - , test_issues backend conf - ] - - -- Now run some criterion benchmarks. - -- - -- TODO: We should dump the results to file so that they can be analysed and - -- checked for regressions. - -- - diff --git a/examples/nofib/QuickCheck/Arbitrary/Array.hs b/examples/nofib/QuickCheck/Arbitrary/Array.hs deleted file mode 100644 --- a/examples/nofib/QuickCheck/Arbitrary/Array.hs +++ /dev/null @@ -1,187 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -module QuickCheck.Arbitrary.Array where - -import QuickCheck.Arbitrary.Shape - -import Test.QuickCheck -import System.Random ( Random ) -import Data.Array.Accelerate.Array.Sugar ( Array(..), Segments, Shape, Elt, Z(..), (:.)(..), (!), DIM1, DIM2 ) -import qualified Data.Array.Accelerate.Array.Sugar as Sugar -import qualified Data.Set as Set - - - -instance (Elt e, Arbitrary e) => Arbitrary (Array Z e) where - arbitrary = arbitraryArray Z - shrink arr = [ Sugar.fromList Z [x] | x <- shrink (arr ! Z) ] - -instance (Elt e, Arbitrary e) => Arbitrary (Array DIM1 e) where - arbitrary = arbitraryArray =<< arbitrary - shrink arr = [ Sugar.fromList (Z :. length sl) sl | sl <- shrink (Sugar.toList arr) ] - -instance (Elt e, Arbitrary e) => Arbitrary (Array DIM2 e) where - arbitrary = arbitraryArray =<< arbitrary - shrink arr = - let - xs = Sugar.toList arr - sh@(Z:.h:.w) = Sugar.shape arr - in - [ q | Z:.m:.n <- shrink sh, m > 0, n > 0 - , q <- [ Sugar.fromFunction (Z :. m :. n) (\ix -> arr Sugar.! ix) -- top-left - , Sugar.fromFunction (Z :. m :. w-n) (\(Z:.u:.v) -> arr Sugar.! (Z:.u :.(n+v))) -- top-right - , Sugar.fromFunction (Z :. h-m :. n) (\(Z:.u:.v) -> arr Sugar.! (Z:.(m+u):.v)) -- bottom-left - , Sugar.fromFunction (Z :. h-m :. w-n) (\(Z:.u:.v) -> arr Sugar.! (Z:.(m+u):.(n+v))) -- bottom-right - ]] ++ - [ Sugar.fromList sh sl | sl <- shrinkOne xs ] - -instance (Shape sh, Elt e, Arbitrary sh, Arbitrary e) => Arbitrary (Array (sh:.Int:.Int:.Int) e) where - arbitrary = arbitraryArray =<< arbitrary - shrink arr@(Array _ adata) = - let - sh = Sugar.shape arr - xs = Sugar.toList arr - in - [ Array (Sugar.fromElt sh') adata | sh' <- shrink sh ] ++ - [ Sugar.fromList sh sl | sl <- shrinkOne xs ] - - --- Generate an arbitrary array of the given shape using the default element --- generator --- -arbitraryArray :: (Shape sh, Elt e, Arbitrary e) => sh -> Gen (Array sh e) -arbitraryArray sh = arbitraryArrayOf sh arbitrary - --- Generate an array of the given shape using the supplied element generator --- function. --- -arbitraryArrayOf :: (Shape sh, Elt e) => sh -> Gen e -> Gen (Array sh e) -arbitraryArrayOf sh gen = Sugar.fromList sh `fmap` vectorOf (Sugar.size sh) gen - -{-- - -- A version that does not use fromList. It does not gain us anything while - -- being much more complex in implementation. - -- -arbitraryArrayOf :: (Shape sh, Elt e, Arbitrary e) => sh -> Gen e -> Gen (Array sh e) -arbitraryArrayOf sh (MkGen gen) - = MkGen - $ \g k -> let !n = Sugar.size sh - (adata, _) = runArrayData $ do - arr <- newArrayData n - let go _ !i | i >= n = return () - go !r !i = - let (r1,r2) = split r - v = gen r1 k - in - unsafeWriteArrayData arr i (Sugar.fromElt v) >> go r2 (i+1) - -- - go g 0 - return (arr, undefined) - in - adata `seq` Sugar.Array (Sugar.fromElt sh) adata ---} - --- Generate an array where the outermost dimension satisfies the given segmented --- array descriptor. --- -arbitrarySegmentedArray - :: (Integral i, Shape sh, Elt e, Arbitrary sh, Arbitrary e) - => Segments i - -> Gen (Array (sh :. Int) e) -arbitrarySegmentedArray segs = do - let sz = fromIntegral . sum $ Sugar.toList segs - sh <- sized $ \n -> arbitraryShape (n `div` 2) - arbitraryArray (sh :. sz) - -shrinkSegmentedArray - :: (Shape sh, Elt e, Arbitrary sh, Arbitrary e) - => Array (sh :. Int) e - -> [Array (sh :. Int) e] -shrinkSegmentedArray arr@(Array _ adata) = - let - sh@(sz :. n) = Sugar.shape arr - in - [ Array (Sugar.fromElt sz',n) adata | sz' <- shrink sz ] ++ - [ Sugar.fromList sh sl | sl <- shrinkOne (Sugar.toList arr) ] - - --- Generate a segment descriptor. Both the array and individual segments might --- be empty. --- -arbitrarySegments :: (Elt i, Integral i, Random i) => Gen (Segments i) -arbitrarySegments = - sized $ \n -> do - k <- choose (0,n) - arbitraryArrayOf (Z:.k) (choose (0, fromIntegral n)) - -shrinkSegments :: (Elt i, Integral i, Arbitrary i) => Segments i -> [Segments i] -shrinkSegments arr = - let - shrinkSeg (x:y:zs) = [ xy:zs | xy <- (x+y) : shrink (x+y), xy >= 0 ] - ++ [ x:yzs' | yzs' <- shrinkSeg (y:zs) ] - shrinkSeg _ = [] - in - [ Sugar.fromList (Z :. length sl) sl | sl <- shrinkSeg (Sugar.toList arr) ] ++ - [ Sugar.fromList (Z :. length sl) sl | sl <- shrinkList (\x -> [ s | s <- shrink x, s >= 0]) (Sugar.toList arr) ] - --- Generate a possibly empty segment descriptor, where each segment is non-empty --- -arbitrarySegments1 :: (Elt i, Integral i, Random i) => Gen (Segments i) -arbitrarySegments1 = - sized $ \n -> do - k <- choose (0,n) - arbitraryArrayOf (Z:.k) (choose (1, 1 `max` fromIntegral n)) - -shrinkSegments1 :: (Elt i, Integral i, Arbitrary i) => Segments i -> [Segments i] -shrinkSegments1 arr = - let - shrinkSeg (x:y:zs) = [ xy:zs | xy <- (x+y) : shrink (x+y), xy >= 1 ] - ++ [ x:yzs' | yzs' <- shrinkSeg (y:zs) ] - shrinkSeg _ = [] - in - [ Sugar.fromList (Z :. length sl) sl | sl <- shrinkSeg (Sugar.toList arr) ] ++ - [ Sugar.fromList (Z :. length sl) sl | sl <- shrinkList (\x -> [ s | s <- shrink x, s >= 1]) (Sugar.toList arr) ] - - --- Generate an vector where every element in the array is unique. The maximum --- size is based on the current 'sized' parameter. --- -arbitraryUniqueVectorOf :: (Elt e, Ord e) => Gen e -> Gen (Array DIM1 e) -arbitraryUniqueVectorOf gen = - sized $ \n -> do - set <- fmap Set.fromList (vectorOf n gen) - k <- choose (0, Set.size set) - return $! Sugar.fromList (Z :. k) (Set.toList set) - - --- Generate an arbitrary CSR matrix. The first parameter is the segment --- descriptor, the second a sparse vector of (index,value) pairs, and the third --- the matrix width (number of columns). --- --- The matrix size is based on the current `sized` parameter. --- -arbitraryCSRMatrix - :: (Elt i, Integral i, Random i, Elt e, Arbitrary e) - => Gen ( Array DIM1 i, Array DIM1 (i,e), Int ) -arbitraryCSRMatrix = - sized $ \cols -> do - segd <- arbitrarySegments - let nnz = fromIntegral . sum $ Sugar.toList segd - smat <- arbitraryArrayOf (Z :. nnz) $ do - val <- arbitrary - ind <- choose (0, fromIntegral cols - 1) - return (ind, val) - return (segd, smat, cols) - - --- Helpers --- ------- - -shrinkOne :: Arbitrary a => [a] -> [[a]] -shrinkOne [] = [] -shrinkOne (x:xs) = [ x':xs | x' <- shrink x ] - ++ [ x:xs' | xs' <- shrinkOne xs ] - diff --git a/examples/nofib/QuickCheck/Arbitrary/Shape.hs b/examples/nofib/QuickCheck/Arbitrary/Shape.hs deleted file mode 100644 --- a/examples/nofib/QuickCheck/Arbitrary/Shape.hs +++ /dev/null @@ -1,53 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -module QuickCheck.Arbitrary.Shape where - -import Test.QuickCheck -import Data.Array.Accelerate ( Shape, Z(..), (:.)(..) ) -import qualified Data.Array.Accelerate.Array.Sugar as Sugar - - -instance Arbitrary Z where - arbitrary = return Z - shrink _ = [] - -instance Arbitrary sh => Arbitrary (sh :. Int) where - arbitrary = do - sh <- arbitrary - NonNegative sz <- arbitrary - return (sh :. sz) - -- - shrink (sh :. sz) = - [ sh :. sz' | sz' <- shrink sz, sz' >= 0 ] ++ - [ sh' :. sz | sh' <- shrink sh ] - - --- Generate an arbitrary shape with approximately this many elements in each --- dimension. If the generated shape does not contain approximately the --- specified number of elements (within 10%), the shape is thrown out and a new --- one is generated. --- --- NOTE: --- * Shapes of zero dimension ignore the target size. --- * Requesting high dimension shapes of very few elements may take same time --- to generate an appropriate random instance. --- -arbitraryShape :: forall sh. (Shape sh, Arbitrary sh) => Int -> Gen sh -arbitraryShape size = - let - eps = 0.1 :: Double - dim = Sugar.rank (undefined :: sh) - target - | dim == 0 = 1 - | otherwise = size * dim - - wiggle = round $ fromIntegral target * eps - minsize = target - wiggle - maxsize = target + wiggle - in - arbitrary `suchThat` \sh -> let n = Sugar.size sh - in n >= minsize && n <= maxsize - diff --git a/examples/nofib/Test/Base.hs b/examples/nofib/Test/Base.hs deleted file mode 100644 --- a/examples/nofib/Test/Base.hs +++ /dev/null @@ -1,50 +0,0 @@ -{-# LANGUAGE TypeOperators #-} - -module Test.Base where - -import Prelude as P -import Data.Array.Accelerate as A -import Data.Array.Accelerate.Array.Sugar - - --- Miscellaneous --- -indexHead :: sh:.Int -> Int -indexHead (_ :. sz) = sz - -indexTail :: sh:.Int -> sh -indexTail (sh :. _) = sh - -isEmptyArray :: Shape sh => Array sh e -> Bool -isEmptyArray arr = arraySize (arrayShape arr) P.== 0 - -mkDim :: Shape sh => Int -> sh -mkDim n = listToShape (P.replicate n 0) - -dim0 :: DIM0 -dim0 = mkDim 0 - -dim1 :: DIM1 -dim1 = mkDim 1 - -dim2 :: DIM2 -dim2 = mkDim 2 - -dim3 :: DIM3 -dim3 = mkDim 3 - -dim4 :: DIM4 -dim4 = mkDim 4 - -splitEvery :: Int -> [a] -> [[a]] -splitEvery _ [] = cycle [[]] -splitEvery n xs = - let (h,t) = splitAt n xs - in h : splitEvery n t - -splitPlaces :: P.Integral i => [i] -> [a] -> [[a]] -splitPlaces [] _ = [] -splitPlaces (i:is) vs = - let (h,t) = splitAt (P.fromIntegral i) vs - in h : splitPlaces is t - diff --git a/examples/nofib/Test/FFT.hs b/examples/nofib/Test/FFT.hs deleted file mode 100644 --- a/examples/nofib/Test/FFT.hs +++ /dev/null @@ -1,148 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} - -module Test.FFT ( - - test_fft - -) where - -import Config - -import Test.QuickCheck hiding ( (.&.) ) -import Test.Framework -import Test.Framework.Providers.QuickCheck2 -import QuickCheck.Arbitrary.Array - -import Data.Array.Accelerate.Math.DFT -import Data.Array.Accelerate.Math.FFT - -import Data.Array.Accelerate as A hiding ( (!), Ord(..), Eq(..) ) -import Data.Array.Accelerate.Examples.Internal as A -import Data.Array.Accelerate.Data.Complex - -import Data.Bits -import Data.Label -import Data.Maybe -import Data.Typeable -import Prelude as P - - -newtype PowerOf2Array sh e = PowerOf2Array (Array sh e) - deriving Show - -instance (Arbitrary e, Elt e) => Arbitrary (PowerOf2Array DIM1 e) where - arbitrary = do - Z :. n <- arbitrary - arr <- arbitraryArray (Z :. ceilPow2 n) - return $ PowerOf2Array arr - - shrink (PowerOf2Array arr) = - [ PowerOf2Array arr' | arr' <- shrink arr - , let Z :. n = arrayShape arr' in isPow2 n ] - -instance (Arbitrary e, Elt e) => Arbitrary (PowerOf2Array DIM2 e) where - arbitrary = do - Z :. h :. w <- arbitrary - arr <- arbitraryArray (Z :. ceilPow2 h :. ceilPow2 w) - return $ PowerOf2Array arr - -- - shrink (PowerOf2Array arr) = - [ PowerOf2Array arr' | arr' <- shrink arr - , let Z :. h :. w = arrayShape arr' in isPow2 h P.&& isPow2 w ] - -instance (Arbitrary e, Elt e) => Arbitrary (PowerOf2Array DIM3 e) where - arbitrary = do - Z :. d :. h :. w <- arbitrary - arr <- arbitraryArray (Z :. ceilPow2 d :. ceilPow2 h :. ceilPow2 w) - return $ PowerOf2Array arr - -- - shrink (PowerOf2Array arr) = - [ PowerOf2Array arr' | arr' <- shrink arr - , let Z :. d :. h :. w = arrayShape arr' in isPow2 d P.&& isPow2 h P.&& isPow2 w ] - - -isPow2 :: Int -> Bool -isPow2 0 = True -isPow2 1 = False -isPow2 n = n .&. (n - 1) == 0 - -ceilPow2 :: Int -> Int -ceilPow2 n - | isPow2 n = n - | otherwise = - let x = P.logBase 2 (P.fromIntegral n) :: Double - y = P.floor x + 1 - in - 1 `shiftL` y - - -test_fft :: Backend -> Config -> Test -test_fft backend opt = testGroup "fft" $ catMaybes - [ testElt configFloat (undefined::Float) - , testElt configDouble (undefined::Double) - ] - where - testElt :: forall a. (Similar a, Arbitrary a, P.RealFloat a, A.RealFloat a, A.IsFloating a, A.FromIntegral Int a) - => (Config :-> Bool) - -> a - -> Maybe Test - testElt ok _ - | P.not (get ok opt) = Nothing - | otherwise = Just $ testGroup (show (typeOf (undefined :: a))) - [ testDIM1 - , testDIM2 - , testDIM3 - ] - where - testDIM1 :: Test - testDIM1 = - testGroup "DIM1" - [ testProperty "ifft.fft" (test_fft_ifft :: PowerOf2Array DIM1 (Complex a) -> Property) - , testProperty "fft==dft" (test_fft_dft :: PowerOf2Array DIM1 (Complex a) -> Property) - ] - where - test_fft_ifft (PowerOf2Array xs) = - let sh = arrayShape xs - in arraySize sh > 0 ==> - run backend (fft1D' Inverse sh . fft1D' Forward sh $ use xs) ~?= xs - - test_fft_dft (PowerOf2Array xs) = - let sh = (arrayShape xs) - in arraySize sh > 0 ==> - run backend (fft1D' Forward sh $ use xs) ~?= run1 backend dft xs - - testDIM2 :: Test - testDIM2 = - testGroup "DIM2" - [ testProperty "ifft.fft" (test_fft_ifft :: PowerOf2Array DIM2 (Complex a) -> Property) - , testProperty "transpose" (test_trans :: PowerOf2Array DIM2 (Complex a) -> Property) - ] - where - test_trans (PowerOf2Array xs) = - let sh@(Z:.h:.w) = arrayShape xs - sh' = Z :. w :. h - in arraySize sh > 0 ==> - run backend (A.transpose . fft2D' Forward sh $ use xs) - ~?= run backend (fft2D' Forward sh' . A.transpose $ use xs) - - test_fft_ifft (PowerOf2Array xs) = - let sh = arrayShape xs - in arraySize (arrayShape xs) > 0 ==> - run backend (fft2D' Inverse sh . fft2D' Forward sh $ use xs) ~?= xs - - testDIM3 :: Test - testDIM3 = - testGroup "DIM3" - [ testProperty "ifft.fft" (test_fft_ifft :: PowerOf2Array DIM3 (Complex a) -> Property) - ] - where - test_fft_ifft (PowerOf2Array xs) = - let sh = arrayShape xs - in arraySize (arrayShape xs) > 0 ==> - run backend (fft3D' Inverse sh . fft3D' Forward sh $ use xs) ~?= xs - diff --git a/examples/nofib/Test/Foreign.hs b/examples/nofib/Test/Foreign.hs deleted file mode 100644 --- a/examples/nofib/Test/Foreign.hs +++ /dev/null @@ -1,25 +0,0 @@ -{-# LANGUAGE CPP #-} - -module Test.Foreign ( - - test_foreign - -) where - -import Config -#ifdef ACCELERATE_CUDA_BACKEND -import Test.Foreign.CUDA -#endif - -import Data.Array.Accelerate.Examples.Internal - - -test_foreign :: Backend -> Config -> Test -test_foreign _be _conf = - testGroup "foreign" - [ -#ifdef ACCELERATE_CUDA_BACKEND - test_cuda _be _conf -#endif - ] - diff --git a/examples/nofib/Test/IO.hs b/examples/nofib/Test/IO.hs deleted file mode 100644 --- a/examples/nofib/Test/IO.hs +++ /dev/null @@ -1,17 +0,0 @@ - -module Test.IO where - -import Config - -import Test.Framework -import Test.IO.Ptr -import Test.IO.Vector - - -test_io :: Config -> Test -test_io conf = - testGroup "io" - [ test_ptr conf - , test_vector conf - ] - diff --git a/examples/nofib/Test/IO/Ptr.hs b/examples/nofib/Test/IO/Ptr.hs deleted file mode 100644 --- a/examples/nofib/Test/IO/Ptr.hs +++ /dev/null @@ -1,114 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} - -module Test.IO.Ptr ( - - test_ptr, - -) where - -import Config - -import Prelude as P -import Foreign.C -import Foreign.Ptr -import Test.Framework -import Test.HUnit ( Assertion, (@?=) ) -import Test.Framework.Providers.HUnit - -import Data.Array.Accelerate -import Data.Array.Accelerate.IO - - -test_ptr :: Config -> Test -test_ptr _ = - testGroup "block copy" - [ - testCase "toPtr Int16" toPtrInt16 - , testCase "toPtr Int32" toPtrInt32 - , testCase "toPtr Int64" toPtrInt64 - , testCase "fromPtr Int32" fromPtrInt32 - , testCase "fromPtr (Int32,Double)" fromPtrIntDouble - , testCase "fromArray Int32" fromArrayInt32 - ] - - --- Unit tests ------------------------------------------------------------------ --- -intToBool :: P.Integral a => a -> Bool -intToBool 0 = False -intToBool _ = True - -fromPtrInt32 :: Assertion -fromPtrInt32 = do - ptr <- oneToTen - arr <- fromPtr (Z :. 10) ptr :: IO (Vector Int32) - toList arr @?= [1..10] - -fromPtrIntDouble :: Assertion -fromPtrIntDouble = do - intPtr <- oneToTen - doublePtr <- tenToOne - arr <- fromPtr (Z :. 10) (((), intPtr), doublePtr) :: IO (Vector (Int32, Double)) - toList arr @?= [ (x, P.fromIntegral (11 - x)) | x <- [1..10]] - - -toPtrInt16 :: IO () -toPtrInt16 = do - let n = 50 - arr :: Vector Int16 - arr = fromList (Z:.n) [2 * P.fromIntegral x | x <- [0..n-1]] - -- - ohi <- nInt16s (P.fromIntegral n) - toPtr arr ohi - b <- isFilledWithEvens16 ohi (P.fromIntegral n) - intToBool b @?= True - -toPtrInt32 :: IO () -toPtrInt32 = do - let n = 100 - arr :: Array DIM2 Int32 - arr = fromList (Z:.10:.10) [2 * P.fromIntegral x | x <- [0..n-1]] - -- - ohi <- nInt32s n - toPtr arr ohi - b <- isFilledWithEvens32 ohi n - intToBool b @?= True - -toPtrInt64 :: IO () -toPtrInt64 = do - let n = 73 - arr :: Vector Int64 - arr = fromList (Z:.n) [2 * P.fromIntegral x | x <- [0..n-1]] - -- - ohi <- nInt64s (P.fromIntegral n) - toPtr arr ohi - b <- isFilledWithEvens64 ohi (P.fromIntegral n) - intToBool b @?= True - - -fromArrayInt32 :: IO () -fromArrayInt32 = do - let n = 5 P.^ (3::Int) - arr :: Array DIM3 Int32 - arr = fromList (Z:.5:.5:.5) [2*x | x <- [0..n-1]] - -- - ohi <- nInt32s (P.fromIntegral n) - fromArray arr (memcpy ohi) - b <- isFilledWithEvens32 ohi (P.fromIntegral n) - intToBool b @?= True - - --- Foreign functions ----------------------------------------------------------- --- -foreign import ccall "one_to_ten" oneToTen :: IO (Ptr Int32) -foreign import ccall "ten_to_one" tenToOne :: IO (Ptr Double) -foreign import ccall "n_int_16s" nInt16s :: CInt -> IO (Ptr Int16) -foreign import ccall "n_int_32s" nInt32s :: CInt -> IO (Ptr Int32) -foreign import ccall "n_int_64s" nInt64s :: CInt -> IO (Ptr Int64) -foreign import ccall "is_filled_with_evens_16" isFilledWithEvens16 :: Ptr Int16 -> CInt -> IO CInt -foreign import ccall "is_filled_with_evens_32" isFilledWithEvens32 :: Ptr Int32 -> CInt -> IO CInt -foreign import ccall "is_filled_with_evens_64" isFilledWithEvens64 :: Ptr Int64 -> CInt -> IO CInt -foreign import ccall memcpy :: Ptr a -> Ptr b -> Int -> IO () - diff --git a/examples/nofib/Test/IO/Vector.hs b/examples/nofib/Test/IO/Vector.hs deleted file mode 100644 --- a/examples/nofib/Test/IO/Vector.hs +++ /dev/null @@ -1,54 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} - -module Test.IO.Vector (test_vector) - where - -import Prelude as P -import Config -import Data.Label -import Data.Maybe -import Data.Typeable -import Test.Base -import Test.QuickCheck -import Test.Framework -import Test.Framework.Providers.QuickCheck2 -import QuickCheck.Arbitrary.Array () - -import Data.Array.Accelerate -import Data.Array.Accelerate.IO ( toVectors, fromVectors ) -import Data.Array.Accelerate.Array.Sugar as Sugar -import Data.Array.Accelerate.Examples.Internal - - -test_vector :: Config -> Test -test_vector opt = testGroup "vector" $ catMaybes - [ testElt configInt8 (undefined :: Int8) - , testElt configInt16 (undefined :: Int16) - , testElt configInt32 (undefined :: Int32) - , testElt configInt64 (undefined :: Int64) - , testElt configWord8 (undefined :: Word8) - , testElt configWord16 (undefined :: Word16) - , testElt configWord32 (undefined :: Word32) - , testElt configWord64 (undefined :: Word64) - , testElt configFloat (undefined :: Float) - , testElt configDouble (undefined :: Double) - ] - where - testElt :: forall a. (Elt a, Arbitrary a, Similar a) => (Config :-> Bool) -> a -> Maybe Test - testElt ok _ - | P.not (get ok opt) = Nothing - | otherwise = Just $ testGroup (show (typeOf (undefined :: a))) - [ testDim dim0 - , testDim dim1 - , testDim dim2 - ] - where - testDim :: forall sh. (Shape sh, P.Eq sh, Arbitrary (Array sh a)) => sh -> Test - testDim sh = testProperty ("DIM" P.++ show (rank sh)) (roundtrip :: Array sh a -> Property) - - roundtrip arr = - let sh = arrayShape arr - in fromVectors sh (toVectors arr) ~?= arr - diff --git a/examples/nofib/Test/IO/fill_with_values.cpp b/examples/nofib/Test/IO/fill_with_values.cpp deleted file mode 100644 --- a/examples/nofib/Test/IO/fill_with_values.cpp +++ /dev/null @@ -1,81 +0,0 @@ -#include -#include -#include - -/* Returns one if it's filled with even values starting at 0 */ -template -int is_filled_with_evens(T *p, int size) { - T prev = 0; - int result = 1; // default to true - int i; - - if (p[0] != 0) { - result = 0; - } - - for (i=1; result && i < size; i++) { - if (p[i] != prev + 2) { - result = 0; - } - else { - prev = p[i]; - } - } - - return result; -} - - -#ifdef __cplusplus -extern "C" { -#endif - -int32_t *one_to_ten() { - int32_t *p = (int32_t*) malloc(sizeof(int32_t) * 10); - int i; - for (i=0; i<10; i++) { - p[i] = i+1; - } - return p; -} - -double *ten_to_one() { - double *p = (double*) malloc(sizeof(double) * 10); - int i; - for (i=0; i< 10; i++) { - p[i] = 10.0 - (double) i; - } - return p; -} - -int32_t *n_int_32s (int n) { - return (int32_t*) malloc(sizeof(int32_t) * n); -} - -int16_t *n_int_16s(int n) { - return (int16_t*) malloc(sizeof(int16_t) * n); -} - -int64_t *n_int_64s(int n) { - return (int64_t*) malloc(sizeof(int64_t) * n); -} - -int is_filled_with_evens_16(int16_t *p, int size) -{ - return is_filled_with_evens(p, size); -} - -int is_filled_with_evens_32(int32_t *p, int size) -{ - return is_filled_with_evens(p, size); -} - -int is_filled_with_evens_64(int64_t *p, int size) -{ - return is_filled_with_evens(p, size); -} - -#ifdef __cplusplus -} -#endif - diff --git a/examples/nofib/Test/Imaginary.hs b/examples/nofib/Test/Imaginary.hs deleted file mode 100644 --- a/examples/nofib/Test/Imaginary.hs +++ /dev/null @@ -1,25 +0,0 @@ - -module Test.Imaginary ( - - test_imaginary - -) where - -import Config - -import Test.Framework -import Test.Imaginary.DotP -import Test.Imaginary.SASUM -import Test.Imaginary.SAXPY - -import Data.Array.Accelerate.Examples.Internal - - -test_imaginary :: Backend -> Config -> Test -test_imaginary be conf = - testGroup "imaginary" - [ test_sasum be conf - , test_saxpy be conf - , test_dotp be conf - ] - diff --git a/examples/nofib/Test/Imaginary/DotP.hs b/examples/nofib/Test/Imaginary/DotP.hs deleted file mode 100644 --- a/examples/nofib/Test/Imaginary/DotP.hs +++ /dev/null @@ -1,64 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ParallelListComp #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} - -module Test.Imaginary.DotP ( - - test_dotp, - -) 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.Label -import Data.Maybe -import Data.Typeable -import Test.QuickCheck - - -test_dotp :: Backend -> Config -> Test -test_dotp backend opt = testGroup "dot-product" $ catMaybes - [ testElt configInt8 (undefined :: Int8) - , testElt configInt16 (undefined :: Int16) - , testElt configInt32 (undefined :: Int32) - , testElt configInt64 (undefined :: Int64) - , testElt configWord8 (undefined :: Word8) - , testElt configWord16 (undefined :: Word16) - , testElt configWord32 (undefined :: Word32) - , testElt configWord64 (undefined :: Word64) - , testElt configFloat (undefined :: Float) - , testElt configDouble (undefined :: Double) - ] - where - testElt :: forall a. (P.Num a, A.Num a, Similar a, Arbitrary a) - => (Config :-> Bool) - -> a - -> Maybe Test - testElt ok _ - | P.not (get ok opt) = Nothing - | otherwise = Just - $ testProperty (show (typeOf (undefined :: a))) (run_dotp :: Vector a -> Vector a -> Property) - - run_dotp xs ys = - runN backend dotp xs ys `indexArray` Z - ~?= - P.sum [ x * y | x <- toList xs | y <- toList ys ] - - --- Accelerate implementation --------------------------------------------------- - -dotp :: A.Num e - => Acc (Vector e) - -> Acc (Vector e) - -> Acc (Scalar e) -dotp xs ys - = A.fold (+) 0 - $ A.zipWith (*) xs ys - diff --git a/examples/nofib/Test/Imaginary/SASUM.hs b/examples/nofib/Test/Imaginary/SASUM.hs deleted file mode 100644 --- a/examples/nofib/Test/Imaginary/SASUM.hs +++ /dev/null @@ -1,58 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} - -module Test.Imaginary.SASUM ( - - test_sasum, - -) 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.Label -import Data.Maybe -import Data.Typeable -import Test.QuickCheck - - -test_sasum :: Backend -> Config -> Test -test_sasum backend opt = testGroup "sasum" $ catMaybes - [ testElt configInt8 (undefined :: Int8) - , testElt configInt16 (undefined :: Int16) - , testElt configInt32 (undefined :: Int32) - , testElt configInt64 (undefined :: Int64) - , testElt configWord8 (undefined :: Word8) - , testElt configWord16 (undefined :: Word16) - , testElt configWord32 (undefined :: Word32) - , testElt configWord64 (undefined :: Word64) - , testElt configFloat (undefined :: Float) - , testElt configDouble (undefined :: Double) - ] - where - testElt :: forall a. (P.Num a, A.Num a, Similar a, Arbitrary a) - => (Config :-> Bool) - -> a - -> Maybe Test - testElt ok _ - | P.not (get ok opt) = Nothing - | otherwise = Just - $ testProperty (show (typeOf (undefined :: a))) (run_sasum :: Vector a -> Property) - - run_sasum xs = - run1 backend sasum xs `indexArray` Z - ~?= - P.sum (P.map abs (toList xs)) - - --- Accelerate implementation --------------------------------------------------- - -sasum :: A.Num e => Acc (Vector e) -> Acc (Scalar e) -sasum = A.fold (+) 0 . A.map abs - diff --git a/examples/nofib/Test/Imaginary/SAXPY.hs b/examples/nofib/Test/Imaginary/SAXPY.hs deleted file mode 100644 --- a/examples/nofib/Test/Imaginary/SAXPY.hs +++ /dev/null @@ -1,67 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ParallelListComp #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} - -module Test.Imaginary.SAXPY ( - - test_saxpy, - -) 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.Label -import Data.Maybe -import Data.Typeable -import Test.QuickCheck - - -test_saxpy :: Backend -> Config -> Test -test_saxpy backend opt = testGroup "saxpy" $ catMaybes - [ testElt configInt8 (undefined :: Int8) - , testElt configInt16 (undefined :: Int16) - , testElt configInt32 (undefined :: Int32) - , testElt configInt64 (undefined :: Int64) - , testElt configWord8 (undefined :: Word8) - , testElt configWord16 (undefined :: Word16) - , testElt configWord32 (undefined :: Word32) - , testElt configWord64 (undefined :: Word64) - , testElt configFloat (undefined :: Float) - , testElt configDouble (undefined :: Double) - ] - where - testElt :: forall a. (P.Num a, A.Num a, Similar a, Arbitrary a) - => (Config :-> Bool) - -> a - -> Maybe Test - testElt ok _ - | P.not (get ok opt) = Nothing - | otherwise = Just - $ testProperty (show (typeOf (undefined :: a))) (run_saxpy :: a -> Vector a -> Vector a -> Property) - - run_saxpy alpha xs ys = - toList (runN backend (saxpy (constant alpha)) xs ys) - ~?= - [ alpha * x + y | x <- toList xs | y <- toList ys ] - - --- Accelerate implementation --------------------------------------------------- - -saxpy :: A.Num e - => Exp e - -> Acc (Vector e) - -> Acc (Vector e) - -> Acc (Vector e) -saxpy alpha xs ys = - let alpha' = the (unit alpha) - in - A.zipWith (\x y -> alpha' * x + y) xs ys - diff --git a/examples/nofib/Test/Issues.hs b/examples/nofib/Test/Issues.hs deleted file mode 100644 --- a/examples/nofib/Test/Issues.hs +++ /dev/null @@ -1,54 +0,0 @@ - -module Test.Issues ( - - test_issues - -) where - -import Config - -import Test.Framework -import Test.Issues.Issue93 -import Test.Issues.Issue102 -import Test.Issues.Issue114 -import Test.Issues.Issue119 -import Test.Issues.Issue123 -import Test.Issues.Issue137 -import Test.Issues.Issue168 -import Test.Issues.Issue184 -import Test.Issues.Issue185 -import Test.Issues.Issue187 -import Test.Issues.Issue228 -import Test.Issues.Issue255 -import Test.Issues.Issue264 -import Test.Issues.Issue286 -import Test.Issues.Issue287 -import Test.Issues.Issue288 -import Test.Issues.Issue362 - -import Data.Array.Accelerate.Examples.Internal - - -test_issues :: Backend -> Config -> Test -test_issues be conf = - testGroup "issues" - [ - test_issue93 be conf - , test_issue102 be conf - , test_issue114 be conf - , test_issue119 be conf - , test_issue123 be conf - , test_issue137 be conf - , test_issue168 be conf - , test_issue184 be conf - , test_issue185 be conf - , test_issue187 be conf - , test_issue228 be conf - , test_issue255 be conf - , test_issue264 be conf - , test_issue286 be conf - , test_issue287 be conf - , test_issue288 be conf - , test_issue362 be conf - ] - diff --git a/examples/nofib/Test/Issues/Issue102.hs b/examples/nofib/Test/Issues/Issue102.hs deleted file mode 100644 --- a/examples/nofib/Test/Issues/Issue102.hs +++ /dev/null @@ -1,58 +0,0 @@ -{-# LANGUAGE TypeOperators #-} - -module Test.Issues.Issue102 (test_issue102) - where - -import Config -import Test.Framework -import Test.Framework.Providers.HUnit - -import Prelude as P -import Data.Array.Accelerate as A -import Data.Array.Accelerate.Examples.Internal as A - - -test_issue102 :: Backend -> Config -> Test -test_issue102 backend _conf = - testCase "102" (assertEqual ref1 $ run backend test1) - - -ref1 :: Array DIM3 Int -ref1 = fromList (Z :. 1 :. 3 :. 1) [4,4,4] - -test1 :: Acc (Array DIM3 Int) -test1 = - let p = 3 - lts = 1 - rts = 1 - rustride = 1 - - v = fill (constant (Z:.(p-1))) (constant 2) - ru' = fill (constant (Z:.(p-1))) (constant 1) - - -- generate a vector with phi(p)=p-1 elements - x' = reshape (constant (Z :. lts :. (p-1) :. rts)) v - - --embed into a vector of length p - y = generate (constant (Z :. lts :. p :. rts)) - (\ix -> let (Z :. l :. i :. r) = unlift ix :: Z :. Exp Int :. Exp Int :. Exp Int - in i A.== 0 ? (0, x' ! (lift $ Z :. l :. i-1 :. r))) - - -- do a DFT_p - y' = reshape (constant (Z :. lts :. p :. rts)) (flatten y) - dftrus = generate (constant (Z :. p :. p)) - (\ix -> let (Z :. i :. j) = unlift ix :: Z :. Exp Int :. Exp Int - in ru' ! (lift (Z :. (i*j*rustride `mod` (constant p))))) - - tensorDFTCoeffs = A.replicate (lift (Z:.lts:.All:.rts:.All)) dftrus - tensorInputCoeffs = generate (shape tensorDFTCoeffs) - (\ix -> let (Z:.l:._:.r:.col) = unlift ix :: Z :. Exp Int :. Exp Int :. Exp Int :. Exp Int - in y' ! (lift $ Z:.l:.col:.r)) - - dftans = flatten $ fold (+) (constant 0) $ A.zipWith (*) tensorDFTCoeffs tensorInputCoeffs - - --continue the alternate transform, but this line breaks - dfty = reshape (shape y) $ dftans - in - dfty - diff --git a/examples/nofib/Test/Issues/Issue114.hs b/examples/nofib/Test/Issues/Issue114.hs deleted file mode 100644 --- a/examples/nofib/Test/Issues/Issue114.hs +++ /dev/null @@ -1,61 +0,0 @@ - -module Test.Issues.Issue114 (test_issue114) - where - -import Config -import Test.Framework -import Test.Framework.Providers.HUnit - -import Prelude as P -import Data.Array.Accelerate as A -import Data.Array.Accelerate.Examples.Internal as A - - -test_issue114 :: Backend -> Config -> Test -test_issue114 backend _conf = testGroup "114" - [ testCase "A" (assertEqual ref1 $ run backend test1) - , testCase "B" (assertEqual ref2 $ run backend test2) - ] - - -type EFloat = (Float, Float) -- Represents a real number with a value and error - -fromFloat :: Float -> EFloat -fromFloat x = (x, 0) - --- toFloat :: EFloat -> Float --- toFloat (val, err) = val + err - -add :: Exp EFloat -> Exp EFloat -> Exp EFloat -add = lift2 f - where - f :: (Exp Float, Exp Float) -> (Exp Float, Exp Float) -> (Exp Float, Exp Float) - f (aval, aerr) (bval, berr) = (val, err) - where - val = aval + bval - err = aval - (val - det) + (bval - det) + aerr + berr - det = val - aval - -esum :: Acc (Vector EFloat) -> Acc (Scalar EFloat) -esum x = A.fold1 add x - -epsum :: Acc (Vector EFloat) -> Acc (Vector EFloat) -epsum x = A.scanl1 add x - -xs :: Acc (Vector EFloat) -xs = use $ fromFunction (Z :. 100) (\_ -> fromFloat 1.01) - - -ref1 :: Scalar EFloat -ref1 = fromList Z [(101,0)] - -test1 :: Acc (Scalar EFloat) -test1 = esum xs - - -ref2 :: Vector EFloat -ref2 = fromList (Z :. 100) [ (1.01 * i, 0) | i <- [1..]] - -test2 :: Acc (Vector EFloat) -test2 = epsum xs - diff --git a/examples/nofib/Test/Issues/Issue119.hs b/examples/nofib/Test/Issues/Issue119.hs deleted file mode 100644 --- a/examples/nofib/Test/Issues/Issue119.hs +++ /dev/null @@ -1,169 +0,0 @@ - -module Test.Issues.Issue119 (test_issue119) - where - -import Config -import Test.Framework -import Test.Framework.Providers.HUnit - -import Prelude as P -import Data.Array.Accelerate as A -import Data.Array.Accelerate.Examples.Internal as A - - -test_issue119 :: Backend -> Config -> Test -test_issue119 backend _conf = testGroup "119" - [ testCase "A" (assertEqual ref1 (run backend test1)) - , testCase "B" (assertEqual ref2 (run backend test2)) - , testCase "C" (assertEqual ref3 (run backend test3)) - , testCase "D" (assertEqual ref4 (run backend test4)) - , testCase "E" (assertEqual ref5 (run backend test5)) - , testCase "F" (assertEqual ref6 (run backend test6)) - , testCase "G" (assertEqual ref7 (run backend test7)) - , testCase "H" (assertEqual ref8 (run backend test8)) - , testCase "I" (assertEqual ref9 (run backend test9)) - , testCase "J" (assertEqual ref10 (run backend test10)) - , testCase "K" (assertEqual ref11 (run backend test11)) - ] - - --- Fold tests --- ---------- - -ref1 :: Scalar Int32 -ref1 = fromList Z [734889155] - -test1 :: Acc (Scalar Int32) -test1 = A.foldAll (+) 0 xs - where - xs :: Acc (Array DIM2 Int32) - xs = use $ fromList (Z :. 5 :. 28) [14769239,-43969807,34096869,26467320,-21446403,-19566997,-20757196,-66879020,19321522,16802755,51423005,-30832656,12956743,-12318583,-48025228,61945796,-2250529,18157252,-44635606,-57062680,54654752,-45950438,-45550976,-62875929,66292458,64296866,34105235,20487639,30133337,-34016948,46574440,-21782247,7668293,8257005,-52134520,65769526,-53807259,56265864,44995988,2419563,50453876,57043978,32058611,41795482,1356242,28417251,5365744,-50462079,-4690548,-63375747,-46568125,17130936,-9136428,53870799,65779607,65381795,-32284364,1085336,41766147,-48032615,-8611290,-31457130,52882781,-11785315,31039408,14338797,11749455,4037928,-28111863,50044760,-63234128,17276128,8579326,57409776,64794871,-43959064,17740348,33371212,-18433618,303726,8599511,14055754,38794127,-49407153,-20949080,-66174156,-43639360,13828228,-36941738,-2879784,-32949921,5454298,46134687,58015243,-2497378,-35813131,-66438706,-28087800,-22569678,21234344,51086800,-17488916,62884654,55526000,31676635,7777220,38149962,66027320,-23764609,41016045,18232856,6488342,20118159,28851925,-6610856,23434278,-57333215,57974240,-66022236,55082111,61254643,-52552004,-62140522,-13018201,17313534,6955448,52914957,8368369,-25845462,50594480,-32920224,-26202745,-25861093,55035780,-60835478,6582276,55668636,26991003,228691,62551594] - - -ref2 :: Scalar Int32 -ref2 = fromList Z [638248245] - -test2 :: Acc (Scalar Int32) -test2 = A.foldAll (+) z xs - where - z = constant 0 - xs :: Acc (Array DIM2 Int32) - xs = use $ fromList (Z :. 28 :. 5) [30332431,6796098,-15522385,-32163376,-22219878,10020835,22638601,20673036,-30769405,-23271551,16790184,-17975968,29134928,29540030,15695897,-9531463,12041364,15327083,-7856190,28479946,24497912,-13994046,5037581,-25167431,11992516,-25544745,26910784,-29607037,21237332,30371276,1858744,20239265,1576853,5549626,1732708,21169707,-8592014,-17303153,-4691351,29659929,-17704246,-13035309,-21373638,14713362,21130870,-6403753,13321799,22126635,30318513,-25651322,-10668441,-24247707,24353923,-5541473,15335372,-7118652,-28357515,30896735,19938864,21360170,16766774,29976096,10055680,9181294,10294712,-23189559,28234139,19443020,20018378,18990662,12790940,-31136432,7945796,-11687674,4320146,-1353679,21896288,2731169,24625097,12506224,27189679,-10270450,3097174,-11012112,29232397,3162933,-11403300,30059570,-9243914,13047945,16513682,-8138375,-17921376,30769432,23685828,21912950,9206743,25339626,11122590,-13094182,-20380905,-8019817,3199026,21598845,4761221,9104850,-30744683,29597011,-26264428,-17658633,831337,-8352528,-27450307,-29451038,9006711,-21943478,25866183,21329008,-7148827,14493559,-14888430,-26543546,25318288,-14096306,-9132505,2388950,9740892,-12973005,10141734,28363840,-1974095,12753649,26765381,23979765,15399126,20204488,19148086,14457571,-18842735,31509219] - - -ref3 :: Scalar Int64 -ref3 = fromList Z [-2304750112110] - -test3 :: Acc (Scalar Int64) -test3 = A.foldAll (+) 0 xs - where - xs :: Acc (Array DIM2 Int64) - xs = use $ fromList (Z :. 4 :. 34) [-119582066848,211418632971,-273814068829,-441336869225,49277660114,545904743034,-107108516086,272730345990,-227553979182,-205217278623,-334933374202,51481780401,-243087611110,499367622597,-281520298752,183942102289,-352104016609,-411607044687,-462706494917,-405072342281,-443472456667,57859494326,340657028984,268146891294,319572181437,-328099124733,-499762864333,435940295598,310279498548,-450247211372,101309611345,508483612496,170564579262,-18976287892,-455590358368,171197058025,-370071394217,238505304901,201668743044,498589419201,297393267447,303651235875,504136702140,240153057419,227119976864,-54751959043,-389119831605,35618580405,-155315665549,539301360661,461515245841,-420790558552,-407621743214,512382547226,64401598442,75455583959,-422914101157,-444213359875,-464670739203,-151444593289,12666639431,366304035864,33213351756,-337126953996,469279395971,-318783703943,524684201810,-360908771731,-365270829375,95123780502,-392655992888,-76730831811,479382581014,-223793301821,-405318001331,-478562160184,-163914780202,-411178397558,-73093917592,322239790820,420249956833,-122752719617,-420777967956,-489170073738,232626269189,398537832770,136477711761,-117743069079,473757016199,461956975541,75333205695,122914427050,-277154707123,-344965932671,18790179442,242296707870,183037500718,380718816714,-433509147619,305765602753,436058308076,-140428136472,-289391463887,-530251700495,-306686789129,224410693891,-484184400934,463805089162,-501756254322,393903748222,-269147001559,-359942689809,-163943277620,74971067748,-202611183518,-308196672762,320023013452,75437650523,475680122061,446935336626,114910599577,-421539248344,-25530906498,-424571606102,-396438535665,354002379792,134141026509,-543141869270,-347289264435,333557662160,33168540124,-167015747466,268026632123,-65645693801,-196414232999,393080421747] - -ref4 :: Scalar Int64 -ref4 = fromList Z [-1982037004259] - -test4 :: Acc (Scalar Int64) -test4 = A.foldAll (+) z xs - where - z = constant 0 - xs :: Acc (Array DIM2 Int64) - xs = use $ fromList (Z :. 27 :. 5) [-516950650221,-198681319472,-62248207215,-368566588052,-221815889746,-404814200669,15045398798,430679777170,163443360209,58097521335,-87590898111,497607465075,-27049301510,149071552167,-119172901827,-108679661992,412502711937,-213838885992,-491807426758,-169121244505,377480661744,-364997600163,452887211838,498386633616,-196697034533,426777341897,-459406805363,-239048240471,250937389006,-453316577416,477182495522,-79624988438,-483304189443,141157669081,355197721240,-328308821798,10400185896,398549525265,-141936649498,218818467494,402542618206,456236393213,-503876199918,52591145304,-149056547666,-336820739966,-101305073619,-472113159559,-321357874802,-95088218225,47976047271,509800579620,-145214377978,258457805786,252700511510,537909713977,247668230739,-259697031014,-230995125913,77530842572,283307049087,-411792373178,324606551065,302376540936,500057254214,36752111995,-55143618182,-42362785469,-68090351859,-345780793879,485419604422,-525756197664,-67428156655,121298292757,-523227354037,542168812603,-63016595487,404709620252,492764196616,173842446373,-251029882829,53802486346,-530196219472,38098754466,-451928062539,-198941999979,-430777494835,356103891588,-478934564072,421540513969,129261909711,267834058695,-449200229070,-153755923804,548585896851,-362848223110,166182675419,272214294990,-530215315236,-342214087116,-474705180756,168367792089,-53404310532,-472623730372,-147327201280,519069543952,-135155501227,159093854025,-268230727831,529927846798,-135583708544,-435621161817,-482622020289,-337169671550,-199594728505,85511984309,389604901651,276696290309,336198922744,-456923645150,186500760911,388034346215,-121368960575,168640682551,-7576869074,69728513684,276429408489,-383852114311,-496978282447,-257731685849,286922686952,332263669356,-371802274827,144134413275,-524312126151] - - -ref5 :: Vector Int32 -ref5 = fromList (Z :. 1) [-564354555] - -test5 :: Acc (Vector Int32) -test5 = A.fold (+) 0 xs - where - xs :: Acc (Array DIM2 Int32) - xs = use $ fromList (Z :. 1 :. 130) [-4457702,-122533607,-128044610,-118567484,-51241069,207290580,-220286030,4228986,27469434,-150317120,-203604157,-825364,-5199079,33434421,-254928269,215941275,-84557225,155733915,171166525,94162372,46201848,74472984,-20540100,203227620,-205035659,139581872,-64200870,-95685833,-248817216,181149788,-51154438,5754365,-39623339,-30285278,-124075023,-116700449,198097791,-79621402,-6975987,-103294438,-193880739,-42554593,-52665481,-6774561,-145101208,217440464,-234644017,-165019600,-141695655,-110020351,179140674,66343428,43188757,192222207,196444242,72638801,260767189,-234015110,238745515,-12235263,114454889,-117207038,-56788533,-166739373,207303540,-52047526,-2280395,31679387,87315138,181256391,-197760275,147977350,-105987066,-126709084,-180021047,-91253871,88115823,-220087038,141701192,-100881541,197803243,-35493996,71878227,123953012,190031396,233047641,-172754808,-87849442,-82869836,-208702873,-91940076,-42225767,124028996,-129061972,7648559,28609363,258568067,-156621004,154765390,-15205853,-189458486,-55442626,133343504,-107377067,-153448167,-83812681,216682270,235806226,-155366374,-29170502,-113839485,-249632147,220516680,159108225,49056288,-14524239,148547005,151302845,53892421,-215278906,-59578587,-36754634,169714732,-4520583,40832244,159375461,236429345,-257962058,-19375172,-98736004] - - --- Scan tests --- ---------- - -ref6 :: Vector Int64 -ref6 = fromList (Z :. 748) [9125498,-16063035,-50980,-27239361,-28337646,-37708670,-21121249,-11217118,-13848672,-39334849,-46707491,-66531944,-43011362,-52687842,-22827761,-971267,-5223404,-4411473,-18981275,13313900,6542877,11493167,22215941,15573052,-4268436,13222384,11042779,-3043325,-30361025,-12714603,3072363,31204175,3603936,1445050,3106420,-10215901,-35287878,-41312051,-33332828,-8728274,-5932326,15089470,15341055,22710136,33070009,20938516,9183939,13338488,27196906,10726312,-19896886,-5528880,-25763431,-47546113,-21147316,8321444,1963928,-26863855,-250164,32934074,44835086,57843946,26305229,6456986,-26980567,-41996719,-70804933,-84259108,-87879612,-110692672,-142798291,-116098588,-85567404,-116207069,-123821326,12584983,25114364,-7860303,1367004,22680794,6730923,24499547,45160622,66310423,75777515,95908783,82670280,75336288,86887135,72442174,70887722,56336211,86112478,69983042,71665675,72070119,94687414,125141027,117692500,91136141,111363947,94258056,102908356,70818523,80142514,92859070,122763909,93075287,77155392,54968337,29421292,31177870,1920103,6519230,-19551499,-21222657,-570094,-24097292,-21808392,-10348212,-25233388,1173489,-9736680,16762526,28315631,29037674,11984290,21576469,34826173,1642762,32046691,35140081,58642652,77835445,80197959,89973092,115910407,129847184,118117169,95353096,79367357,62093373,28767797,-2146590,-10917398,20424644,4676917,7932556,3312401,-15966908,-7189949,5420963,8175943,4434171,-23666656,-10061080,-6041726,-31631217,-46272817,-61706087,-29314516,-7596012,14721710,37426611,63932827,37620518,28457552,40061842,31619691,27526728,56295666,80222812,105097861,88788604,97864477,79172130,10011195,-11909105,14225322,47137915,41586134,43468287,16346843,33297215,32170527,53289540,54985040,81533030,110490559,94932129,-13972154,-562189,-26994686,-56883836,-38812939,-13124808,-40371526,-52769442,-21433054,-38472715,-27141571,-29136605,-25500474,-3609550,2499409,-5483029,7386627,-24798720,-19594335,-27615046,-27638210,-60052370,-60759465,21354265,35287006,20122081,39265392,30972278,-57680,-32797288,-40752069,-27338717,-42161108,-14223907,-26783347,2619156,-14191849,6138144,7386063,-2032880,-1427633,24663443,12623199,41575592,41247980,57154315,51594681,59172894,71372344,62594824,88295328,58813946,37705204,28408628,16061632,9164297,-20127170,-9336346,-19571825,-52179514,-68566225,-54477198,-47004940,-29937062,-26901831,-4920101,3005622,7980962,8028145,29521179,4597970,28713400,59139068,43239497,14548340,-5703663,19550414,41133083,40431977,71464673,71868771,61227439,41134554,31050857,8517828,36666702,67999523,50219401,20584724,22991750,27378599,54105073,39320349,15820114,40457939,41491964,23091500,7320002,-21415520,9737506,37844167,55041071,80397844,102622122,100100178,86108928,104370032,96478192,129355326,154538582,125989958,143228198,145176468,139822044,153528336,178316046,164246971,175794520,146308152,146195800,176242327,204855629,175565103,7396173,21863242,35694390,20236011,2751512,20138366,15394266,-820941,-4081067,-14269206,6911689,-11814644,-29241281,-49447821,29070717,12178489,4706892,-12315553,-19458729,-21356132,32958033,45401858,53370676,28467559,19593822,-2362034,-22117369,-7304152,-39099651,-22225335,-11600163,-22285664,2291892,-7750742,-7695599,6170980,-15707745,-37482681,-55991916,-82981918,-83046513,-56843137,-84028152,-114039097,-143926441,-152072244,-126187325,-147424750,-167404074,-162720270,-190867797,-167936982,-141061455,-109557195,-97843277,-111686956,-136635385,-104293809,-74950582,25017856,23279847,50087106,44767052,28328844,44871147,17608101,35664270,61602884,52831414,70249540,1819043,3429541,11974074,-13604141,-9364540,-31853055,1318244,-32151004,-31320318,-44830769,-21132509,-13995287,9516139,-22382471,-15989865,-4087485,-14545639,-41647841,-35817861,-30140793,-62661641,-37684047,-10791435,-31361559,-28965957,-35074554,-18300410,5455270,23648211,32414689,50928057,84178047,64930378,93870236,79795842,86863035,105461553,79769102,80114784,54005743,33702322,65727435,62447610,52138169,43806272,31938677,37096050,70218042,77215870,106108777,139027677,114174251,126267131,140175411,160639557,193663077,206137637,220658257,202941018,-12251575,-23552773,-55866025,-23809513,-20926637,-31109913,-39762123,-46364008,-60594496,-42978446,-13334636,-30452598,-50434052,-61031253,-74842844,-93367283,-61532012,-84351158,-84841171,-104231070,-100891101,-126393754,-103372367,-130732559,-19187634,14573150,41644350,15935939,-17222201,13190162,18958067,-14125622,-24081209,3812159,26073207,1502885,27132466,50360103,32308017,43791273,28658841,-3014391,17498899,39691132,55285193,24930027,1313945,8269524,-3616873,-6270603,18469472,36099131,39395283,19467169,35946131,56127923,23068454,-3858447,127864,80862,7732537,-19112498,-51201127,-26195163,-56817262,-25264735,8237471,22946551,43448141,44527962,15371977,41182890,37330623,23803440,25133955,21428283,16975035,3669458,-3948266,-18836608,-46801069,-52964698,-22530552,-43387214,-61356367,-25196164,14528267,42710847,12057272,-28567150,-4999302,-9802327,-40044668,-50932747,-55517409,-42227774,-46720093,-55222219,-78741202,-85956859,-66535020,-46117937,-27770713,-58407711,-78187327,-69135214,1202125,-12657006,-36736334,-5285746,1284850,13974673,6428450,-2859916,11195300,21966510,41773652,75026766,86232546,65434150,56281777,31791084,-27496239,-11755947,-38243335,-15570305,-44944537,-56626147,-35689712,-29230541,-1790980,4913883,30309378,35999451,4247731,19877599,30464878,23724438,22283982,54499416,24386456,49397482,20056046,2245136,10370839,11303423,-17409033,-42771071,-74956837,-48166691,-43816115,-57542384,-70157229,-70862427,30408652,58898077,77293926,73729762,95277184,81563941,57283977,-771117,-456441,-29488849,22679627,5899338,-18076694,-37016795,-11679478,-41387957,-66065963,-88627508,-59231050,-72154351,-87239154,-98183118,-86163605,-100655815,-71105015,-71941883,-79022844,-95476326,-106781948,-122827571,-3991744,-12632889,-27237421,-19346941,-5049031,25932613,27025347,58034895,43432663,12227336,8100095,-24316081,-26074118,1861244,10308239,-14252133,-42882738,-11297680,-4134810,4642524,-2106749,4520659,4934233,-11147022,-19198158,-2631779,-7452327,10453095,2109765,-2103352,-13046685,5993258,-6044315,-8865526,-36469279,-34399945,-33492684,-66014105,-74152720,-100291068,-74237210,-51603820,-42707028,-25514375,-19566946,-28671426,-45101886,-57481104,-39262753,-53578037,-75105802,-8050453,-27079364,-31976388,-59853991,-76305099,-80118582,-75523310,-53358835,-33059777,23735157,-1173436,28637604,45579674,38153401,33484359,6520549,-19987615,-17046612,-49115976,-67297686,-76330959,-92100052,-78367933,-49573941,-47282497,-45204417,-26379619,-54724537,-31225313,-47054807,-31957234,-31249236,-45845237,-22124907,10320350,14739088,-4252207,-7762331,7155734,29164118,9070424,5290023,22450707,17614712,35173605,15421806,21377612,-11164562,-19598904,-6382529,-10075749,-31582043,-24288750,-17233764,-46634709,-51009691,-37586000,-22709095,-15330330,-41238844,-38766663,-55248088,-35014428,-8943742,5195603,18754494,8744144,17178020,48895778,81969511,58113659] - -test6 :: Acc (Vector Int64) -test6 = A.scanl1Seg (+) xs seg - where - xs :: Acc (Vector Int64) - xs = use $ fromList (Z :. 748) [9125498,-25188533,16012055,-27188381,-1098285,-9371024,16587421,9904131,-2631554,-25486177,-7372642,-19824453,23520582,-9676480,-22827761,21856494,-4252137,811931,-14569802,32295175,-6771023,4950290,10722774,-6642889,-19841488,17490820,-2179605,-14086104,-27317700,17646422,15786966,28131812,-27600239,-2158886,1661370,-13322321,-25071977,-6024173,7979223,24604554,2795948,21021796,251585,7369081,10359873,20938516,-11754577,4154549,13858418,-16470594,-30623198,14368006,-20234551,-21782682,26398797,29468760,-6357516,-28827783,26613691,33184238,11901012,13008860,-31538717,-19848243,-33437553,-15016152,-28808214,-13454175,-3620504,-22813060,-32105619,26699703,30531184,-30639665,-7614257,12584983,12529381,-32974667,9227307,21313790,-15949871,17768624,20661075,21149801,9467092,20131268,-13238503,-7333992,11550847,-14444961,-1554452,-14551511,29776267,-16129436,1682633,404444,22617295,30453613,-7448527,-26556359,20227806,-17105891,8650300,-32089833,9323991,12716556,29904839,-29688622,-15919895,-22187055,29421292,1756578,-29257767,4599127,-26070729,-1671158,20652563,-23527198,2288900,11460180,-14885176,26406877,-10910169,26499206,11553105,722043,-17053384,9592179,13249704,-33183411,30403929,3093390,23502571,19192793,2362514,9775133,25937315,13936777,-11730015,-22764073,-15985739,-17273984,-33325576,-30914387,-8770808,31342042,-15747727,7932556,-4620155,-19279309,8776959,12610912,2754980,-3741772,-28100827,13605576,4019354,-25589491,-14641600,-15433270,32391571,-7596012,22317722,22704901,26506216,-26312309,-9162966,11604290,-8442151,-4092963,28768938,23927146,24875049,-16309257,9075873,-18692347,10011195,-21920300,26134427,32912593,-5551781,1882153,-27121444,16950372,-1126688,21119013,1695500,26547990,28957529,-15558430,-13972154,13409965,-26432497,-29889150,18070897,25688131,-27246718,-12397916,31336388,-17039661,11331144,-1995034,3636131,21890924,6108959,-7982438,12869656,-32185347,5204385,-8020711,-23164,-32414160,-707095,21354265,13932741,-15164925,19143311,-8293114,-31029958,-32739608,-7954781,13413352,-14822391,27937201,-12559440,2619156,-16811005,20329993,1247919,-9418943,605247,26091076,-12040244,28952393,-327612,15906335,-5559634,7578213,12199450,-8777520,25700504,-29481382,-21108742,-9296576,-12346996,-6897335,-29291467,10790824,-10235479,-32607689,-16386711,14089027,7472258,17067878,3035231,21981730,7925723,4975340,47183,21493034,4597970,24115430,30425668,-15899571,-28691157,-20252003,25254077,21582669,-701106,31032696,404098,-10641332,-20092885,-10083697,-22533029,28148874,31332821,-17780122,-29634677,2407026,4386849,26726474,-14784724,-23500235,24637825,1034025,-18400464,-15771498,-21415520,31153026,28106661,17196904,25356773,22224278,-2521944,-13991250,18261104,-7891840,32877134,25183256,-28548624,17238240,1948270,-5354424,13706292,24787710,-14069075,11547549,-29486368,-112352,30046527,28613302,-29290526,7396173,14467069,13831148,-15458379,-17484499,17386854,-4744100,-16215207,-3260126,-10188139,21180895,-18726333,-17426637,-20206540,29070717,-16892228,4706892,-17022445,-7143176,-1897403,32958033,12443825,7968818,-24903117,-8873737,-21955856,-19755335,14813217,-31795499,16874316,10625172,-10685501,24577556,-10042634,55143,13866579,-21878725,-21774936,-18509235,-26990002,-64595,26203376,-27185015,-30010945,-29887344,-8145803,25884919,-21237425,-19979324,4683804,-28147527,22930815,26875527,31504260,11713918,-13843679,-24948429,32341576,29343227,25017856,-1738009,26807259,-5320054,-16438208,16542303,-27263046,18056169,25938614,-8771470,17418126,1819043,1610498,8544533,-25578215,4239601,-22488515,33171299,-33469248,830686,-13510451,23698260,7137222,23511426,-31898610,6392606,11902380,-10458154,-27102202,5829980,5677068,-32520848,24977594,26892612,-20570124,2395602,-6108597,-18300410,23755680,18192941,8766478,18513368,33249990,-19247669,28939858,-14074394,7067193,18598518,-25692451,345682,-26109041,-20303421,32025113,-3279825,-10309441,-8331897,-11867595,5157373,33121992,6997828,28892907,32918900,-24853426,12092880,13908280,20464146,33023520,12474560,14520620,-17717239,-12251575,-11301198,-32313252,32056512,2882876,-10183276,-8652210,-6601885,-14230488,17616050,29643810,-17117962,-19981454,-10597201,-13811591,-18524439,31835271,-22819146,-490013,-19389899,3339969,-25502653,23021387,-27360192,-19187634,14573150,27071200,-25708411,-33158140,30412363,5767905,-14125622,-9955587,27893368,22261048,-24570322,25629581,23227637,-18052086,11483256,-15132432,-31673232,20513290,22192233,15594061,-30355166,-23616082,6955579,-11886397,-2653730,24740075,17629659,3296152,-19928114,16478962,20181792,-33059469,-26926901,3986311,-47002,7732537,-26845035,-32088629,25005964,-30622099,31552527,33502206,14709080,20501590,1079821,-29155985,25810913,-3852267,-13527183,1330515,-3705672,-4453248,-13305577,-7617724,-14888342,-27964461,-6163629,30434146,-20856662,-17969153,-25196164,14528267,28182580,-30653575,-28567150,23567848,-4803025,-30242341,-10888079,-4584662,13289635,-4492319,-8502126,-23518983,-7215657,19421839,20417083,18347224,-30636998,-19779616,9052113,1202125,-13859131,-24079328,31450588,6570596,12689823,-7546223,-9288366,14055216,10771210,19807142,33253114,11205780,-20798396,-9152373,-24490693,-27496239,15740292,-26487388,22673030,-29374232,-11681610,20936435,6459171,27439561,6704863,25395495,5690073,-31751720,15629868,10587279,-6740440,-1440456,32215434,-30112960,25011026,-29341436,-17810910,8125703,932584,-28712456,-25362038,-32185766,26790146,4350576,-13726269,-12614845,-705198,30408652,28489425,18395849,-3564164,21547422,-13713243,-24279964,-771117,314676,-29032408,22679627,-16780289,-23976032,-18940101,25337317,-29708479,-24678006,-22561545,29396458,-12923301,-15084803,-10943964,12019513,-14492210,29550800,-836868,-7080961,-16453482,-11305622,-16045623,-3991744,-8641145,-14604532,7890480,14297910,30981644,27025347,31009548,-14602232,-31205327,-4127241,-32416176,-26074118,27935362,8446995,-24560372,-28630605,31585058,7162870,8777334,-6749273,6627408,413574,-16081255,-8051136,16566379,-4820548,17905422,-8343330,-4213117,-10943333,19039943,-12037573,-8865526,-27603753,2069334,907261,-32521421,-8138615,-26138348,26053858,22633390,8896792,17192653,5947429,-9104480,-16430460,-12379218,18218351,-14315284,-21527765,-8050453,-19028911,-4897024,-27877603,-16451108,-3813483,4595272,22164475,20299058,23735157,-24908593,29811040,16942070,-7426273,-4669042,-26963810,-26508164,2941003,-32069364,-18181710,-9033273,-15769093,13732119,28793992,2291444,2078080,18824798,-28344918,23499224,-15829494,15097573,-31249236,-14596001,23720330,32445257,4418738,-18991295,-3510124,14918065,22008384,-20093694,-3780401,17160684,-4835995,17558893,-19751799,5955806,-32542174,-8434342,13216375,-3693220,-21506294,7293293,7054986,-29400945,-4374982,13423691,14876905,7378765,-25908514,2472181,-16481425,20233660,26070686,14139345,13558891,-10010350,8433876,31717758,33073733,-23855852] - - seg :: Acc (Segments Int32) - seg = use $ fromList (Z :. 40) [14,31,30,35,37,14,15,14,23,12,35,28,25,14,2,4,39,11,26,33,24,1,6,29,25,1,3,17,16,32,7,3,20,6,6,21,18,9,22,40] - - -ref7 :: Vector Int64 -ref7 = fromList (Z :. 738) [-48782707,-48069783,-76099136,-54652346,-25365627,-15287764,6356466,-12813466,-8407583,19978290,-9072659,-5915918,-36585578,-15711835,15422422,-9019547,-22292746,-32631763,-37371290,-15640610,71266024,76379806,62728369,44496969,47936553,67925416,42543207,28256825,46993513,68696441,62762548,88843983,77734052,65986283,34730508,52119715,67762330,58853279,38574549,13150417,14186593,36907720,65459740,40756535,72731638,74649918,46434954,15908233,-16539565,-31475560,-51915490,-26886587,-15628016,676507,80785577,97966741,122492495,96127350,125381692,121887919,114659417,115475678,82844858,67113463,85021319,117361113,94819908,69936468,84937047,90201353,56988036,23644741,45179661,23562116,38281224,66172480,73193812,82782863,65386382,50390098,43128359,36249064,14980469,108493316,92959780,62909215,43183526,43891523,28202405,38141961,38711587,22173107,33427444,5089227,-19895449,9446767,-9329550,15990062,27937078,10302744,-15427015,-24032122,220227,-244305648,-248544880,-216775110,-202718801,-203420228,-192771970,-167669427,-197813315,-199494672,-197082872,-207854928,-211196422,-193844772,-181103988,-181876034,-165735816,-133474822,-106956023,-82248081,-49842013,-69252000,-65369160,-46610625,-13293665,-86242428,-77700448,-54939430,-49026334,-81348375,-63863233,-81374276,-66370269,-64109103,-82546545,-101149747,-117134127,-97831968,-79075256,-93927664,-106999178,-116193016,-111355657,-142840401,-149392627,-128125153,-121344215,-116284247,-146348780,-122554770,-94499397,-65672590,-75420069,-49490678,-44521996,-49552615,-22516329,-31498419,-59429269,-30793092,-17012933,-19585098,-19894459,-11313269,17242975,26384275,20837140,-39580349,-32039154,-58779061,-31809529,-31860791,-62928294,-45073900,-71749150,-59563687,-46788878,-79384275,-68620575,-48661520,-21830363,-31430266,21524909,35884674,36972475,29674096,20377847,20983226,38258246,20827628,-14124025,-41503458,-57583707,-42613410,-71982937,-49774496,-41193192,-53347165,-62309796,-71478479,-45886895,-78704146,-59158164,-67547671,-44882655,-16244584,-38481867,-30340794,1470458,17149252,36086423,59062879,56262539,35254717,13744500,14429826,20662188,3507389,12225467,22022073,20840496,49430785,30701622,-176961463,-151524797,-172754811,-202787227,-209645388,-208244461,-196470369,-206049987,-190830353,-171109808,-139130211,-111671490,-132637043,-125735699,-106374742,-94463283,-74530374,-102363645,-88879041,-75249338,-86163630,-58293022,-71134360,-74292036,-41027036,-43611173,-45664281,-46838277,-14775189,-21989256,-215581,4895895,26505964,9881215,6006006,21791812,30399863,11059334,-15405962,-40457904,-51506444,-34718154,-12018577,6175960,31133560,-15381417,-24454448,-5290847,-23131138,-90166937,-94603634,-110598990,-102018157,-103077965,-101919562,-112451349,-79323195,-69828212,-41204487,-48476615,-16487710,-19288308,-19650316,-15196570,-14200432,14249659,26415718,-1787516,24530828,-3765711,22589689,20470588,11663379,13847971,-19004777,-8662105,-16191632,-16504147,-18339663,6010780,26824986,-263637509,-233180488,-217662025,-240293973,-229737496,-233942831,-266581338,-240283840,-221970049,-192160233,-186556300,-156510619,-157980671,-159298043,-191254443,-165340852,-181342218,-154490961,-142888991,-125613381,-105764731,-74423852,-43553208,-71733054,-38403655,-65769516,-41776811,-66580138,-58084207,-60606933,-31855509,-30976667,-60210984,-46087807,-45645362,-18703486,-11448733,-18539947,-44401293,-77378414,-104806024,-119161329,-145595331,-128577399,-102240384,-131731412,-153965054,-138203406,-136107911,-169236957,-171380864,-177805907,-154124779,-177987589,-154112100,-137736720,-122295605,-123319691,-152104867,-133462923,-163731604,-137346078,-141974369,-139229959,-115343677,-100246891,-101857581,-79635122,-58498597,-56956671,-27846111,2514723,14539638,-856211,6094147,-143939605,-114556906,-93259166,-62776322,-51886782,-49805668,-49431917,-74588752,-52582864,-69028392,-49573309,-53206133,-29967317,-15913522,-35424192,-42953149,-34525589,-22120615,-22458128,-37201856,-59870268,-63601712,-55156115,-39259547,-20561668,-13924991,-4343294,-3802313,122068251,133014364,106044038,103669137,134430169,148789334,141929442,110101523,78227591,63166498,42545018,37401662,43844352,61892182,38965269,61152447,43991599,42367631,56420014,48147227,16120995,13523168,-12973607,1166745,20340645,-8645743,69400609,62637313,33238840,5342820,17405647,4881263,10407925,-22227407,-9285528,-24279449,-31837105,-12669381,-34047179,-2711090,-26208960,2899657,-97174441,-112298451,-79439394,-84329209,-78384623,-105840777,-126752608,-110394917,-138128377,-134889126,-108654091,-114727725,-98923120,-66683703,-35041593,-51372583,-34976067,-61712406,-48730299,-26309307,-3152004,30193014,162071102,135062608,113614122,97742763,89441064,68362698,89887651,72658190,54790707,28888401,14596198,6934234,-51398793,-36048649,-64586259,-77001171,-108515514,-101660672,-120183736,-103974869,-107572971,-126104081,-97581382,-67174136,-69001306,-76561059,-48904254,-50376102,-47702115,-29837381,-44448701,-52078856,-20635428,-24924851,-35615675,-68278334,-96389847,-97000000,-80417765,-49553418,-27291772,-38508142,-30069928,-59576150,-51106683,-24593113,75962,138863600,158599246,130947464,109890205,82891951,55655298,43959461,18718460,27418095,1490441,-25173893,-41233589,-11411110,-4784998,21180595,-20092951,-19866345,-14625234,-1393509,-30003860,48038753,41278966,56150464,24427936,48510687,46956838,18206865,-14599729,-12438450,-12136742,-20552578,-34069029,-41733751,-22523991,-55669734,-46280266,-31205428,-27829333,-4518109,-37115511,-20546874,3069181,1104372,31215428,35398190,14119871,-8341624,-19741499,-6338114,7013637,-12550393,10571885,17180134,22004968,26290384,15424987,-12196414,-27805732,3893455,3705021,34303755,10858903,44234506,69653623,59799317,41855292,47636949,70210705,49577396,32263101,12862903,-3141227,8704244,-15735990,-42463538,-14281982,-34140899,-29944926,-48194015,-73380186,-53981004,-25683673,3436705,-347326,-13473324,-28337288,-6060609,-36670246,-40321076,-26406623,-25136754,-50993989,-19489063,11995210,-11523983,-31765052,-19746897,13123904,22054274,35973231,46315575,58458518,64785448,37087818,60336567,50407722,60213274,88311583,75588379,50392946,50310126,60156227,28023981,-4599077,-15670813,-480659,66326700,88952449,112560471,80424796,59167705,49073681,69439599,36559892,13608188,-10849505,-27511038,-18002566,-11679162,-14245301,-33196908,-59458637,-88762770,-76931280,-75985853,-73664670,-54646553,-73314781,-98519275,-131515581,-101578410,-70993721,-48717455,-34490455,-9721647,-33346014,-64431160,-74351523,-48527265,-47818443,-39778144,-27056813,3172756,16428504,32078563,27314822,-84911462,-70883891,-67734204,-58203952,-29560484,-7636085,-32316716,-33073244,-31465591,-19382415,-19463832,-51250364,-69332001,-43742902,-15587162,-18707052,-27391604,-8628411,-29019238,-14338164,-32687266,-34755132,-21912223,-40789415,-56697052,-30869305,8245928,22216157,-1300450,-8539733,15367658,-4898165,-23038236,-8233426,20237515,-1488029,-3344902,24899437,13240791,356287,30134185,24453047,-6857567,-11423381,8820097,40066727,55587484,72052998,100594380,76094952,61642627,29001112,9974448,42079530,9172704,-11553890,-34131793,-8675576,-36427927,-22535570,-42072165,-27144828] - -test7 :: Acc (Vector Int64) -test7 = A.scanr1Seg (+) xs seg - where - xs :: Acc (Vector Int64) - xs = use $ fromList (Z :. 738) [-712924,28029353,-21446790,-29286719,-10077863,-21644230,19169932,-4405883,-28385873,29050949,-3156741,30669660,-20873743,-31134257,24441969,13273199,10339017,4739527,-21730680,-15640610,-5113782,13651437,18231400,-3439584,-19988863,25382209,14286382,-18736688,-21702928,5933893,-26081435,11109931,11747769,31255775,-17389207,-15642615,8909051,20278730,25424132,-1036176,-22721127,-28552020,24703205,-31975103,-1918280,28214964,30526721,32447798,14935995,20439930,-25028903,-11258571,-16304523,676507,-17181164,-24525754,26365145,-29254342,3493773,7228502,-816261,32630820,15731395,-17907856,-32339794,22541205,24883440,-15000579,-5264306,33213317,33343295,-21534920,21617545,-14719108,-27891256,-7021332,-9589051,17396481,14996284,7261739,6879295,21268595,14980469,15533536,30050565,19725689,-707997,15689118,-9939556,-569626,16538480,-11254337,28338217,24984676,-29342216,18776317,-25319612,-11947016,17634334,25729759,8605107,-24252349,220227,4239232,-31769770,-14056309,701427,-10648258,-25102543,30143888,1681357,-2411800,10772056,3341494,-17351650,-12740784,772046,-16140218,-32260994,-26518799,-24707942,-32406068,19409987,-3882840,-18758535,-33316960,-13293665,-8541980,-22761018,-5913096,32322041,-17485142,17511043,-15004007,-2261166,18437442,18603202,15984380,-19302159,-18756712,14852408,13071514,9193838,-4837359,31484744,6552226,-21267474,-6780938,-5059968,30064533,-23794010,-28055373,-28826807,9747479,-25929391,-4968682,5030619,-27036286,8982090,-31498419,-28636177,-13780159,2572165,309361,-8581190,-28556244,-9141300,5547135,20837140,-7541195,26739907,-26969532,51262,31067503,-17854394,26675250,-12185463,-12774809,32595397,-10763700,-19959055,-26831157,9599903,-31430266,-14359765,-1087801,7298379,9296249,-605379,-17275020,17430618,20827628,27379433,16080249,-14970297,29369527,-22208441,-8581304,12153973,8962631,9168683,-25591584,32817251,-19545982,8389507,-22665016,-28638071,22237283,-8141073,-31811252,-15678794,-18937171,-22976456,2800340,21007822,21510217,-685326,-6232362,17154799,-8718078,-9796606,1181577,-28590289,18729163,30701622,-25436666,21230014,30032416,6858161,-1400927,-11774092,9579618,-15219634,-19720545,-31979597,-27458721,20965553,-6901344,-19360957,-11911459,-19932909,27833271,-13484604,-13629703,10914292,-27870608,12841338,3157676,-33265000,2584137,2053108,1173996,-32063088,7214067,-21773675,-5111476,-21610069,16624749,3875209,-15785806,21791812,19340529,26465296,25051942,11048540,-16788290,-22699577,-18194537,-24957600,31133560,9073031,-19163601,17840291,-23131138,4436697,15995356,-8580833,1059808,-1158403,10531787,-33128154,-9494983,-28623725,7272128,-31988905,2800598,362008,-4453746,-996138,-28450091,-12166059,28203234,-1787516,28296539,-26355400,2119101,8807209,-2184592,32852748,-10342672,7529527,312515,1835516,-24350443,-20814206,26824986,-30457021,-15518463,22631948,-10556477,4205335,32638507,-26297498,-18313791,-29809816,-5603933,-30045681,1470052,1317372,31956400,-25913591,16001366,-26851257,-11601970,-17275610,-19848650,-31340879,-30870644,28179846,-33329399,27365861,-23992705,24803327,-8495931,2522726,-28751424,-878842,29234317,-14123177,-442445,-26941876,-7254753,-11448733,25861346,32977121,27427610,14355305,26434002,-17017932,-26337015,29491028,22233642,-15761648,-2095495,33129046,2143907,6425043,-23681128,23862810,-23875489,-16375380,-15441115,1024086,28785176,-18641944,30268681,-26385526,4628291,-2744410,-23886282,-15096786,1610690,-22222459,-21136525,-1541926,-29110560,-30360834,-12024915,15395849,-6950358,6094147,-29382699,-21297740,-30482844,-10889540,-2081114,-373751,25156835,-22005888,16445528,-19455083,3632824,-23238816,-14053795,19510670,7528957,-8427560,-12404974,337513,14743728,22668412,3731444,-8445597,-15896568,-18697879,-20561668,-9581697,-540981,-3802313,-10946113,26970326,2374901,-30761032,-14359165,6859892,31827919,31873932,15061093,20621480,5143356,-6442690,-18047830,22926913,-22187178,17160848,1623968,-14052383,8272787,32026232,2597827,26496775,-14140352,-19173900,28986388,-8645743,6763296,29398473,27896020,-12062827,12524384,-5526662,32635332,-12941879,14993921,7557656,-19167724,21377798,-31336089,23497870,-29108617,2899657,15124010,-32859057,4889815,-5944586,27456154,20911831,-16357691,27733460,-3239251,-26235035,6073634,-15804605,-32239417,-31642110,16330990,-16396516,26736339,-12982107,-22420992,-23157303,-33345018,30193014,27008494,21448486,15871359,8301699,21078366,-21524953,17229461,17867483,25902306,14292203,7661964,6934234,-15350144,28537610,12414912,31514343,-6854842,18523064,-16208867,3598102,18531110,-28522699,-30407246,1827170,7559753,-27656805,1471848,-2673987,-17864734,14611320,7630155,-31443428,4289423,10690824,32662659,28111513,610153,-16582235,-30864347,-22261646,11216370,-8438214,29506222,-8469467,-26513570,-24669075,75962,-19735646,27651782,21057259,26998254,27236653,11695837,25241001,-8699635,25927654,26664334,16059696,-29822479,-6626112,-25965593,21180595,-226606,-5241111,-13231725,28610351,-30003860,6759787,-14871498,31722528,-24082751,1553849,28749973,32806594,-2161279,-301708,8415836,13516451,7664722,-19209760,33145743,-9389468,-15074838,-3376095,-23311224,32597402,-16568637,-23616055,1964809,-30111056,-4182762,21278319,22461495,11399875,-13403385,-13351751,19564030,-23122278,-6608249,-4824834,22004968,10865397,27621401,15609318,-31699187,188434,-30598734,23444852,-33375603,-25419117,9854306,17944025,-5781657,-22573756,20633309,17314295,19400198,16004130,-11845471,24440234,26727548,-28181556,19858917,-4195973,18249089,25186171,-19399182,-28297331,-29120378,3436705,13125998,14863964,-22276679,30609637,3650830,-13914453,-1269869,25857235,-31504926,-31484273,23519193,20241069,-12018155,-32870801,-8930370,-13918957,-10342344,-12142943,-6326930,27697630,-23248749,9928845,-9805552,-28098309,12723204,25195433,82820,-9846101,32132246,32623058,11071736,-15190154,-480659,-22625749,-23608022,32135675,21257091,10094024,-20365918,32879707,22951704,24457693,16661533,-9508472,-6323404,2566139,18951607,26261729,29304133,-11831490,-945427,-2321183,-19018117,18668228,25204494,32996306,-29937171,-30584689,-22276266,-14227000,-24768808,23624367,31085146,9920363,-25824258,-708822,-8040299,-12721331,-30229569,-13255748,-15650059,4763741,27314822,-14027571,-3149687,-9530252,-28643468,-21924399,24680631,756528,-1607653,-12083176,81417,31786532,18081637,-25589099,-28155740,3119890,8684552,-18763193,20390827,-14681074,18349102,2067866,-12842909,18877192,15907637,-25827747,-30869305,-13970229,23516607,7239283,-23907391,20265823,18140071,-23038236,-28470941,21725544,1856873,-28244339,11658646,12884504,-29777898,5681138,31310614,4565814,-20243478,-31246630,-15520757,-16465514,-28541382,24499428,14452325,32641515,19026664,-32105082,32906826,20726594,22577903,-25456217,27752351,-13892357,19536595,-14927337,-27144828] - - seg :: Acc (Segments Int32) - seg = use $ fromList (Z :. 33) [20,34,29,20,24,33,9,15,8,33,36,9,4,19,13,37,38,25,3,26,16,22,12,35,15,5,34,29,33,40,26,7,29] - - -ref8 :: Vector Int64 -ref8 = fromList (Z :. 645) [0,-3770243,-5579205,-7046208,-10121610,-11747201,-13282326,-17283687,-18231759,-20046491,-21926492,-22713980,-26318076,-28006910,-31889802,-34194230,-38096679,-39693040,-35966076,-38959249,-41938765,-41994560,-41013600,-41922485,-39410829,-38960516,-35942875,-33376608,-29844503,-29318389,-28736296,-25580458,-29739876,-32401640,-36553276,-40171099,0,345952,-2993267,-5717922,-9907694,-10027890,-13870687,-11867126,-9328942,-6192885,-8184575,-11674536,-10400036,-11388719,-10353407,-8145138,-6678399,-2486811,-6487953,-8733058,-10561951,-6480166,-7972853,0,1139992,-104326,1079373,3348511,0,3395695,6337287,4100926,1022638,1452658,0,3593867,3814687,6806052,3747065,2713485,3570566,5270237,6848581,6155011,1966243,5365176,3983882,286985,2324988,721490,466546,-700995,-338083,2411347,3365002,3154319,3507792,4576100,0,-2285386,-4288389,-7082102,-4660000,-857446,721455,660475,273568,-2789646,-6674913,-9130960,-11826040,-9536699,-6104295,-9673441,-11613956,-10411885,-12286738,-8645110,-8436095,-7590486,-4452638,-1581976,0,-934927,1608397,304641,-2958108,-942792,-1396361,-3542834,0,2350876,227658,-3779069,-1035644,-972794,-3797476,-4505766,-4865910,-7425388,-7182479,-9067132,-10043764,-8627455,-4953615,-3166350,0,1298211,4883021,8143644,9991079,13383006,11704147,11985221,8647018,8086113,7664604,8718062,11039021,7936960,4598083,5635829,1450422,159881,3657858,4103183,3527017,883273,-1321504,-2478748,-1006972,455760,4266983,7194819,11232555,9833490,12524076,16207697,20249758,19286134,17160940,18352071,0,-1562519,-3710355,-2848884,0,741078,2195352,1715399,4902918,2472295,-1673954,951060,-205765,-410930,2925408,0,2661266,6376248,6698089,7240432,9214046,10362817,13102857,16942419,20040610,19554929,18142416,20333122,24002080,25936153,26861250,28286514,25107483,27772679,25952139,0,124429,3721751,0,4171155,4260049,3631576,713779,-1444554,1964929,2806146,4319313,995223,3554404,-282429,96550,1888015,3379400,3874424,5448190,8604326,7429367,4814852,0,-3835274,170581,-3872285,-4136902,-6586985,-8127633,-9740679,-10940596,-11302147,-14863360,-16636561,-15426039,-18342257,-16067741,-12830665,-14394729,-17308091,-13537763,-10075189,-6255542,-4427649,-8416077,-10456703,-8195749,-5827305,-4993142,-3673480,0,869492,1594197,4025097,2848783,0,2126507,3949710,4447981,1253204,3235070,7367011,5351006,6654097,2818742,5393616,4706372,3331207,1161359,0,1885699,1289175,-763581,2481999,2068732,6240239,9030236,6369832,3409522,1150603,-1677392,-773316,-3184156,404696,-683547,910053,-2491074,-94029,-2827691,-5512379,-7783991,-8736510,-6524861,-2725098,-5093277,-6514413,0,742604,-606571,-725780,1744947,3431452,-405237,-457263,709944,4319401,624627,-2608016,0,3642681,2908707,5512358,5530669,0,-3215609,-7345078,-8196654,-11105059,-12591552,-15198735,-11340348,-10281817,-12147811,-10530601,-11500997,-7477780,-10439606,-9986548,0,3533811,4486946,5531887,1511249,-557775,435067,1631130,1815263,-1867113,2273415,1514738,-1206877,555832,741913,-3166709,-287429,-4411008,-4700935,-3946601,-4617892,-7550664,-6112017,0,-667061,-1239970,1156892,-722075,-4186731,-7404810,-11407733,-13636105,-12949852,-11213787,-11386775,-15541235,-18076969,-21589829,-19336525,-21546880,-20418698,-24006743,-23003415,-19580602,-16414098,-17729103,-17560035,-21218247,0,-781526,1156089,-2142153,-419575,-3055657,-716334,-2312034,118635,711944,4112840,7878285,7762706,8255775,8380414,11299416,12714032,15289946,14300365,15027849,19200256,22844171,0,-1224713,1837521,62083,-2435081,-280845,3789736,4259660,7108468,3611361,1501427,4453169,6217988,9274431,13178646,16388059,15410829,13060952,14279789,17319316,14533179,13976967,9836157,7001049,5716786,5459256,5101104,7249617,8962409,9911065,7505371,7218925,8578944,5307366,0,859492,-3077001,-4576770,-8344542,-8263692,-9244057,-8761336,-10520101,-11364186,-10078629,-11263983,-11008053,-14512411,-14775947,-16672625,-14513613,0,694423,-1173637,-2704935,1260688,4786656,1709582,-249261,-2458089,-4733195,-3473620,-3843053,-150511,-4048267,-6698308,-2513431,-6005597,-4249435,-4821144,-8932215,-8692409,-4892474,-3015738,-914415,773709,4562402,8689641,8298796,12102005,13700416,12590982,9153649,7960537,6137906,4292150,2600272,-1457822,0,-1806374,1041907,-2078323,-842307,-3701664,0,-2626906,-2068475,1803835,-316068,-1526877,-3914878,-1840677,-2474665,-4520977,-6059889,0,-161266,2625449,4235821,4877373,1374740,118771,2880196,4463038,3245456,6984711,3642280,2229177,3494184,3387547,5293512,1401776,4539065,6886384,11057250,14889641,15259441,13231998,10138107,7266168,8228888,5129351,1841256,1082772,724230,-2146010,-859151,1049573,2686216,-1006176,1740846,0,-2567334,487038,-3421145,-4411824,-6418173,-4404660,0,2828945,6815455,7060886,6549094,9292080,13211354,12694643,14924363,12485234,14542169,14311383,16026086,17059251,18866314,15263353,18915246,20747408,20628390,21408706,20042728,24104321,21412324,24779975,23077325,20881558,22407427,20391992,21407566,19978783,0,1589469,-794608,-1541980,-1274750,-1931789,-3719881,-175562,1353495,3729793,4102597,330109,-90750,2740945,4316009,2734066,4093765,656207,-844822,-3930596,-1093202,-2998732,564186,3880070,5179086,6959784,10449214,14577355,13359512,0,1964984,3384303,1505373,3694802,6588743,0,1412262,5040779,5239461,9430965,6115620,10111491,10560650,8218897,4044049,4210501,1038630,1711549,0,-3317531,-4953062,-1809142,-1092410,-3951290,-7965161] - -test8 :: Acc (Vector Int64) -test8 = A.scanlSeg (+) 0 xs seg - where - xs :: Acc (Vector Int64) - xs = use $ fromList (Z :. 609) [-3770243,-1808962,-1467003,-3075402,-1625591,-1535125,-4001361,-948072,-1814732,-1880001,-787488,-3604096,-1688834,-3882892,-2304428,-3902449,-1596361,3726964,-2993173,-2979516,-55795,980960,-908885,2511656,450313,3017641,2566267,3532105,526114,582093,3155838,-4159418,-2661764,-4151636,-3617823,345952,-3339219,-2724655,-4189772,-120196,-3842797,2003561,2538184,3136057,-1991690,-3489961,1274500,-988683,1035312,2208269,1466739,4191588,-4001142,-2245105,-1828893,4081785,-1492687,1139992,-1244318,1183699,2269138,3395695,2941592,-2236361,-3078288,430020,3593867,220820,2991365,-3058987,-1033580,857081,1699671,1578344,-693570,-4188768,3398933,-1381294,-3696897,2038003,-1603498,-254944,-1167541,362912,2749430,953655,-210683,353473,1068308,-2285386,-2003003,-2793713,2422102,3802554,1578901,-60980,-386907,-3063214,-3885267,-2456047,-2695080,2289341,3432404,-3569146,-1940515,1202071,-1874853,3641628,209015,845609,3137848,2870662,-934927,2543324,-1303756,-3262749,2015316,-453569,-2146473,2350876,-2123218,-4006727,2743425,62850,-2824682,-708290,-360144,-2559478,242909,-1884653,-976632,1416309,3673840,1787265,1298211,3584810,3260623,1847435,3391927,-1678859,281074,-3338203,-560905,-421509,1053458,2320959,-3102061,-3338877,1037746,-4185407,-1290541,3497977,445325,-576166,-2643744,-2204777,-1157244,1471776,1462732,3811223,2927836,4037736,-1399065,2690586,3683621,4042061,-963624,-2125194,1191131,-1562519,-2147836,861471,741078,1454274,-479953,3187519,-2430623,-4146249,2625014,-1156825,-205165,3336338,2661266,3714982,321841,542343,1973614,1148771,2740040,3839562,3098191,-485681,-1412513,2190706,3668958,1934073,925097,1425264,-3179031,2665196,-1820540,124429,3597322,4171155,88894,-628473,-2917797,-2158333,3409483,841217,1513167,-3324090,2559181,-3836833,378979,1791465,1491385,495024,1573766,3156136,-1174959,-2614515,-3835274,4005855,-4042866,-264617,-2450083,-1540648,-1613046,-1199917,-361551,-3561213,-1773201,1210522,-2916218,2274516,3237076,-1564064,-2913362,3770328,3462574,3819647,1827893,-3988428,-2040626,2260954,2368444,834163,1319662,869492,724705,2430900,-1176314,2126507,1823203,498271,-3194777,1981866,4131941,-2016005,1303091,-3835355,2574874,-687244,-1375165,-2169848,1885699,-596524,-2052756,3245580,-413267,4171507,2789997,-2660404,-2960310,-2258919,-2827995,904076,-2410840,3588852,-1088243,1593600,-3401127,2397045,-2733662,-2684688,-2271612,-952519,2211649,3799763,-2368179,-1421136,742604,-1349175,-119209,2470727,1686505,-3836689,-52026,1167207,3609457,-3694774,-3232643,3642681,-733974,2603651,18311,-3215609,-4129469,-851576,-2908405,-1486493,-2607183,3858387,1058531,-1865994,1617210,-970396,4023217,-2961826,453058,3533811,953135,1044941,-4020638,-2069024,992842,1196063,184133,-3682376,4140528,-758677,-2721615,1762709,186081,-3908622,2879280,-4123579,-289927,754334,-671291,-2932772,1438647,-667061,-572909,2396862,-1878967,-3464656,-3218079,-4002923,-2228372,686253,1736065,-172988,-4154460,-2535734,-3512860,2253304,-2210355,1128182,-3588045,1003328,3422813,3166504,-1315005,169068,-3658212,-781526,1937615,-3298242,1722578,-2636082,2339323,-1595700,2430669,593309,3400896,3765445,-115579,493069,124639,2919002,1414616,2575914,-989581,727484,4172407,3643915,-1224713,3062234,-1775438,-2497164,2154236,4070581,469924,2848808,-3497107,-2109934,2951742,1764819,3056443,3904215,3209413,-977230,-2349877,1218837,3039527,-2786137,-556212,-4140810,-2835108,-1284263,-257530,-358152,2148513,1712792,948656,-2405694,-286446,1360019,-3271578,859492,-3936493,-1499769,-3767772,80850,-980365,482721,-1758765,-844085,1285557,-1185354,255930,-3504358,-263536,-1896678,2159012,694423,-1868060,-1531298,3965623,3525968,-3077074,-1958843,-2208828,-2275106,1259575,-369433,3692542,-3897756,-2650041,4184877,-3492166,1756162,-571709,-4111071,239806,3799935,1876736,2101323,1688124,3788693,4127239,-390845,3803209,1598411,-1109434,-3437333,-1193112,-1822631,-1845756,-1691878,-4058094,-1806374,2848281,-3120230,1236016,-2859357,-2626906,558431,3872310,-2119903,-1210809,-2388001,2074201,-633988,-2046312,-1538912,-161266,2786715,1610372,641552,-3502633,-1255969,2761425,1582842,-1217582,3739255,-3342431,-1413103,1265007,-106637,1905965,-3891736,3137289,2347319,4170866,3832391,369800,-2027443,-3093891,-2871939,962720,-3099537,-3288095,-758484,-358542,-2870240,1286859,1908724,1636643,-3692392,2747022,-2567334,3054372,-3908183,-990679,-2006349,2013513,2828945,3986510,245431,-511792,2742986,3919274,-516711,2229720,-2439129,2056935,-230786,1714703,1033165,1807063,-3602961,3651893,1832162,-119018,780316,-1365978,4061593,-2691997,3367651,-1702650,-2195767,1525869,-2015435,1015574,-1428783,1589469,-2384077,-747372,267230,-657039,-1788092,3544319,1529057,2376298,372804,-3772488,-420859,2831695,1575064,-1581943,1359699,-3437558,-1501029,-3085774,2837394,-1905530,3562918,3315884,1299016,1780698,3489430,4128141,-1217843,1964984,1419319,-1878930,2189429,2893941,1412262,3628517,198682,4191504,-3315345,3995871,449159,-2341753,-4174848,166452,-3171871,672919,-3317531,-1635531,3143920,716732,-2858880,-4013871] - - seg :: Acc (Segments Int32) - seg = use $ fromList (Z :. 36) [35,22,4,5,23,23,7,15,35,3,10,19,2,19,27,4,13,26,11,4,14,22,24,21,33,16,36,5,10,35,6,29,28,5,12,6] - - -ref9 :: Vector Int64 -ref9 = fromList (Z :. 661) [-23545410,-19092190,-15199726,-12351144,-19787110,-24907783,-28924702,-22582323,-15004292,-7986712,-15814964,-12796809,-20874665,-23199295,-21814743,-14474247,-11428070,-11326540,-11987400,-14049880,-15904429,-16813716,-20127269,-27880670,-27115572,-22970078,-19161294,-20116738,-25696300,-20399870,-12598014,-4441841,-5339204,0,5258152,-3047807,-4983198,-152087,-6694074,-2774154,3094062,8979166,16074241,10127078,17254868,10052255,14618407,7297758,13556880,7757925,4862968,0,7035358,13265906,15886283,9773585,17111824,11482952,10360509,16178260,11573685,8057435,8957179,1861100,-4510903,2522742,-1952534,343602,-931257,1182026,8572670,9866510,5314905,0,9915533,6504277,14881592,17126294,9902843,9461226,11857883,12119033,7534110,13764697,17029680,12738298,10093900,9378149,1497597,4121921,6980765,5509560,13297927,19208174,13439826,9261637,3697126,1029090,5742435,7165092,9870407,4667463,9603255,3143595,0,19520337,24293005,18170289,16949209,24484583,25098797,16940571,17168669,20017902,18512677,17276624,20668621,23764749,18559293,19179431,13603545,6821021,4128258,5178140,1807923,625766,-5793038,557951,8468013,16821699,9014973,10154282,13712629,15418321,17772979,13187310,9341891,9346469,3562777,-4236026,3943064,1821268,0,-17597987,-14338111,-13160839,-21095607,-13659930,-5524189,-447843,3198401,-3906944,2444625,4930508,0,-1780995,4941517,3428221,6945832,5471438,-2089694,-1840520,-748417,-622281,-4266815,-3578951,4175923,1214444,-6157294,-11771424,-4253316,122413,-5115729,-2403737,-2280632,-7692875,-7176319,165603,-4608911,2275343,4121415,3691356,8960495,8220951,6560764,3361772,122451,2068485,2266879,0,-23261891,-21773982,-18640394,-16250482,-8288981,-14366391,-12019056,-4951591,0,10327511,16096523,11513457,3775062,1456323,950660,0,39500473,42134191,49326132,44908043,44189915,40545597,42583889,36771665,37976838,42637161,43042497,41877155,36320177,36033649,30456233,23955666,24578825,25647024,25212428,22072107,15320240,7407492,5131363,10409387,17711966,18345108,25613171,20134088,18672784,20466069,19103089,11665491,5005634,2753606,2758578,0,-23237696,-29354162,-28222112,-22820572,-18856465,-11451199,-6544145,-13678867,-15169991,-16665935,-8801766,-16956831,-22118443,-14855674,-19710134,-18333052,-12310671,-12903337,-8724596,-6190610,-12330615,-6733634,-2371106,277264,-6820245,0,9171599,16241475,9734750,11053683,4530017,-3696390,3735716,11641789,12422324,8541343,10317301,6602275,6515789,1853520,2351453,6520804,8199852,16513029,15956233,17535751,12479352,11996485,11488976,15956849,19335984,20273115,14309339,8502747,5054202,4792421,-1998961,6344690,0,8641635,14614220,22621519,24778420,22934500,30033834,31388539,31358268,35741081,35363404,28488749,35704092,39869443,33641031,41683686,43114143,37049122,42162389,38581957,30630741,33093671,29883603,26722722,28918564,23162080,17010863,15643511,8259148,0,67812641,73385203,68588801,71302771,70440392,68339659,72121169,71757257,71620440,66640453,59362044,56439252,50169030,50545377,46897589,42431129,34191912,25809204,22184527,16142939,18006336,15320689,8056937,4727494,4455178,4714354,-2929312,3315582,-712782,0,-10533559,-7453596,-7355822,-11184899,-5346034,-5517666,-5655507,-13233681,-11036355,-15169542,-11673998,-13330134,-12975730,-15731486,-23927365,-15672527,-7651033,-41473,5213372,8569093,5202320,-1932697,4629347,7838047,-310810,-1472760,-1483648,-7832330,-10302351,-7461765,0,56489872,57285707,49989598,56584906,62675766,58030500,53272676,57170277,51364588,45405741,41313157,33038217,27969264,30537052,29338965,24226308,21920794,18781965,16276111,17831599,19945279,12010786,11775519,15528815,8084160,6735740,1256501,0,-4316639,-649184,-2875249,-1265836,-8062475,-1039628,-4165745,2818361,3338123,3984362,-2416008,1539566,1949311,7282131,1416000,2812559,4846439,-1681841,0,17517431,20918622,15129697,12644787,9788494,4980177,4751268,5168036,12807316,6885561,0,-12911606,-7044558,-4259336,-1778572,3942903,-99590,-1755397,1187146,-5227554,-2697658,-5743694,-9164574,-17324325,-9573146,-9518972,-7544657,-3459738,4724166,-2766402,0,-28888665,-23766795,-17908909,-23193011,-18768818,-18321941,-12120774,-4097683,3882582,11680259,16891026,8958627,9777882,4023025,0,-28142843,-31706317,-23725731,-17057441,-23215793,-22411703,-21651678,-16896450,-9881916,-14102625,-16892825,-11726368,-6761066,-8913778,-8706274,-16789108,-15505593,-17559207,-10278334,-2276389,2567755,8618151,12914239,11325856,6127225,622598,8390786,12165621,9912453,4123344,214225,-3540061,-3451397,0,22049876,24841111,19336800,18657023,17237080,16187600,12259897,11391983,6247808,12737198,14285951,16115720,7891953,5229659,12852009,14056688,10927973,15415445,15884318,9189272,15118784,14926893,16328727,24176496,21498476,13130655,9949458,7428893,4075586,2266204,2732845,0,-5712816,-5352191,521344,-2229408,265697,7718151,0,10535066,8408094,12259060,5061913,7346875,12522051,9215406,7737787,3313157,9824900,8315680,14840204,13742226,6034361,12850753,5702446,-584149,-132181,5582800,12810567,7762879,5801224,3571657,2874166,0,-24212535,-26325437,-21693913,-14975748,-19464741,-17568114,-22144287,-26451701,-24659593,-27491447,-34368798,-33273519,-31645836,-27659172,-19824103,-17292768,-17232842,-21445918,-17409995,-11585791,-18676054,-13722054,-6234778,0,-26835027,-26837945,-31679362,-27828204,-24983789,-27977465,-22748208,-18058978,-9787299,-2368565,4785532,-149793,-1166138,-1765051,6274501,-215131,2298449,-4372183,-5668260,-4416255,570850,-3446772,2138867,-3249857,3212736,5020102,6795919,0,-22301653,-17085039,-17386088,-12674648,-7197062,-4438712,2099952,6419507,10331533,18614405,16136985,16786718,17272339,12394596,15925356,21566888,14364344,8727743,12639637,16706011,14337230,9800607,6454097,8805762,2901622,2003370,0] - -test9 :: Acc (Vector Int64) -test9 = A.scanrSeg (+) 0 xs seg - where - xs :: Acc (Vector Int64) - xs = use $ fromList (Z :. 634) [-4453220,-3892464,-2848582,7435966,5120673,4016919,-6342379,-7578031,-7017580,7828252,-3018155,8077856,2324630,-1384552,-7340496,-3046177,-101530,660860,2062480,1854549,909287,3313553,7753401,-765098,-4145494,-3808784,955444,5579562,-5296430,-7801856,-8156173,897363,-5339204,8305959,1935391,-4831111,6541987,-3919920,-5868216,-5885104,-7095075,5947163,-7127790,7202613,-4566152,7320649,-6259122,5798955,2894957,4862968,-6230548,-2620377,6112698,-7338239,5628872,1122443,-5817751,4604575,3516250,-899744,7096079,6372003,-7033645,4475276,-2296136,1274859,-2113283,-7390644,-1293840,4551605,5314905,3411256,-8377315,-2244702,7223451,441617,-2396657,-261150,4584923,-6230587,-3264983,4291382,2644398,715751,7880552,-2624324,-2858844,1471205,-7788367,-5910247,5768348,4178189,5564511,2668036,-4713345,-1422657,-2705315,5202944,-4935792,6459660,3143595,-4772668,6122716,1221080,-7535374,-614214,8158226,-228098,-2849233,1505225,1236053,-3391997,-3096128,5205456,-620138,5575886,6782524,2692763,-1049882,3370217,1182157,6418804,-6350989,-7910062,-8353686,7806726,-1139309,-3558347,-1705692,-2354658,4585669,3845419,-4578,5783692,7798803,-8179090,2121796,1821268,-3259876,-1177272,7934768,-7435677,-8135741,-5076346,-3646244,7105345,-6351569,-2485883,4930508,-6722512,1513296,-3517611,1474394,7561132,-249174,-1092103,-126136,3644534,-687864,-7754874,2961479,7371738,5614130,-7518108,-4375729,5238142,-2711992,-123105,5412243,-516556,-7341922,4774514,-6884254,-1846072,430059,-5269139,739544,1660187,3198992,3239321,-1946034,-198394,2266879,-1487909,-3133588,-2389912,-7961501,6077410,-2347335,-7067465,-4951591,-5769012,4583066,7738395,2318739,505663,950660,-2633718,-7191941,4418089,718128,3644318,-2038292,5812224,-1205173,-4660323,-405336,1165342,5556978,286528,5577416,6500567,-623159,-1068199,434596,3140321,6751867,7912748,2276129,-5278024,-7302579,-633142,-7268063,5479083,1461304,-1793285,1362980,7437598,6659857,2252028,-4972,2758578,6116466,-1132050,-5401540,-3964107,-7405266,-4907054,7134722,1491124,1495944,-7864169,8155065,5161612,-7262769,4854460,-1377082,-6022381,592666,-4178741,-2533986,6140005,-5596981,-4362528,-2648370,7097509,-6820245,-7069876,6506725,-1318933,6523666,8226407,-7432106,-7906073,-780535,3880981,-1775958,3715026,86486,4662269,-497933,-4169351,-1679048,-8313177,556796,-1579518,5056399,482867,507509,-4467873,-3379135,-937131,5963776,5806592,3448545,261781,6791382,-8343651,6344690,-5972585,-8007299,-2156901,1843920,-7099334,-1354705,30271,-4382813,377677,6874655,-7215343,-4165351,6228412,-8042655,-1430457,6065021,-5113267,3580432,7951216,-2462930,3210068,3160881,-2195842,5756484,6151217,1367352,7384363,8259148,-5572562,4796402,-2713970,862379,2100733,-3781510,363912,136817,4979987,7278409,2922792,6270222,-376347,3647788,4466460,8239217,8382708,3624677,6041588,-1863397,2685647,7263752,3329443,272316,-259176,7643666,-6244894,4028364,-712782,-3079963,-97774,3829077,-5838865,171632,137841,7578174,-2197326,4133187,-3495544,1656136,-354404,2755756,8195879,-8254838,-8021494,-7609560,-5254845,-3355721,3366773,7135017,-6562044,-3208700,8148857,1161950,10888,6348682,2470021,-2840586,-7461765,-795835,7296109,-6595308,-6090860,4645266,4757824,-3897601,5805689,5958847,4092584,8274940,5068953,-2567788,1198087,5112657,2305514,3138829,2505854,-1555488,-2113680,7934493,235267,-3753296,7444655,1348420,5479239,1256501,-3667455,2226065,-1609413,6796639,-7022847,3126117,-6984106,-519762,-646239,6400370,-3955574,-409745,-5332820,5866131,-1396559,-2033880,6528280,-1681841,-3401191,5788925,2484910,2856293,4808317,228909,-416768,-7639280,5921755,6885561,-5867048,-2785222,-2480764,-5721475,4042493,1655807,-2942543,6414700,-2529896,3046036,3420880,8159751,-7751179,-54174,-1974315,-4084919,-8183904,7490568,-2766402,-5121870,-5857886,5284102,-4424193,-446877,-6201167,-8023091,-7980265,-7797677,-5210767,7932399,-819255,5754857,4023025,3563474,-7980586,-6668290,6158352,-804090,-760025,-4755228,-7014534,4220709,2790200,-5166457,-4965302,2152712,-207504,8082834,-1283515,2053614,-7280873,-8001945,-4844144,-6050396,-4296088,1588383,5198631,5504627,-7768188,-3774835,2253168,5789109,3909119,3754286,-88664,-3451397,-2791235,5504311,679777,1419943,1049480,3927703,867914,5144175,-6489390,-1548753,-1829769,8223767,2662294,-7622350,-1204679,3128715,-4487472,-468873,6695046,-5929512,191891,-1401834,-7847769,2678020,8367821,3181197,2520565,3353307,1809382,-466641,2732845,-360625,-5873535,2750752,-2495105,-7452454,7718151,2126972,-3850966,7197147,-2284962,-5175176,3306645,1477619,4424630,-6511743,1509220,-6524524,1097978,7707865,-6816392,7148307,6286595,-451968,-5714981,-7227767,5047688,1961655,2229567,697491,2874166,2112902,-4631524,-6718165,4488993,-1896627,4576173,4307414,-1792108,2831854,6877351,-1095279,-1627683,-3986664,-7835069,-2531335,-59926,4213076,-4035923,-5824204,7090263,-4954000,-7487276,-6234778,2918,4841417,-3851158,-2844415,2993676,-5229257,-4689230,-8271679,-7418734,-7154097,4935325,1016345,598913,-8039552,6489632,-2513580,6670632,1296077,-1252005,-4987105,4017622,-5585639,5388724,-6462593,-1807366,-1775817,6795919,-5216614,301049,-4711440,-5477586,-2758350,-6538664,-4319555,-3912026,-8282872,2477420,-649733,-485621,4877743,-3530760,-5641532,7202544,5636601,-3911894,-4066374,2368781,4536623,3346510,-2351665,5904140,898252,2003370] - - seg :: Acc (Segments Int32) - seg = use $ fromList (Z :. 27) [33,17,21,30,37,11,34,8,6,35,25,32,28,29,30,27,18,10,19,14,33,31,6,24,23,27,26] - - -ref10 :: (Vector Int64, Vector Int64) -ref10 = (ps, rs) - where - ps = fromList (Z :. 569) [0,-66818,0,251795,699710,802697,480274,853290,752860,1138919,862260,939763,894697,1099711,1557688,1971825,2058686,2243003,2277978,1888289,1704690,1494021,1883285,2376628,2742325,2967694,0,-332732,-837801,-1190081,-1155758,-864618,-1011546,-1506561,-1455653,-1461081,-1468925,0,-17398,-499085,-748440,-252548,-711966,-497932,-195879,220930,-206548,-255380,-568898,-757326,-427050,-393296,-111710,-602208,-649037,-444294,-18070,-10846,275102,386815,-81884,-314019,-787111,-444473,-623219,-786284,-1224148,-948653,0,83288,141789,-376897,-801010,-1229392,-1437542,-1343774,-1252581,-1407581,-1230786,-1080778,-887420,-1407282,-1684415,-1586879,-1817380,-1644980,-2018396,-1578302,-2078661,-2403312,0,-348073,-61579,-410265,-889716,-590911,-305754,14324,90455,238709,0,-514467,-18980,-246615,-269435,47130,486843,133713,-235497,231266,18100,49540,309653,128285,358799,71567,-82550,-153304,220347,510910,469921,274902,621062,1078829,872577,737543,784276,1024881,903770,582412,557177,0,-79157,156274,608119,229318,288224,717375,977407,469445,324953,457611,641493,880116,360122,700100,821083,939413,1353849,1301020,1159702,1066315,1313991,1759726,0,64229,71186,-445530,-895389,-788935,-1273825,-1752166,-1318004,-925613,-1174396,-723669,-699056,-956311,-472962,-854802,-631555,-568744,-121748,262164,315678,286142,516418,774854,802149,0,242513,-78471,-447748,-208334,80367,353728,395938,349793,843076,665615,217631,152661,369532,391974,528953,54121,-213080,0,-379824,-596797,-930399,-1233561,0,49961,470555,-8966,-421041,-358131,-522150,-438106,-257326,-388186,-349745,-150297,-321019,196862,-303784,-753841,-673582,0,-214043,-451282,-817091,-960814,-680287,-213731,-513040,-214838,188079,567961,716777,411753,456206,168684,5973,275529,253742,173181,179486,571390,660839,1011720,1004275,736990,0,486399,121062,152334,-63078,263827,149145,660440,499071,805451,578235,959506,1402219,1313257,873908,1270627,845536,422653,125870,-131875,40533,-20688,217854,732938,722699,1196205,735699,266278,419403,821116,925710,0,370129,684573,735026,1258789,911909,583991,400539,247903,534707,541244,391465,0,-59023,-409311,-21312,-433939,-148438,-668644,-386892,-631301,-1038008,-574634,-1058043,0,265219,578285,758977,1231768,805524,487154,300489,389030,-120499,311989,-44810,-112116,-251032,-86539,-435986,-866365,-443801,-14900,309866,444678,-26681,324055,68761,544046,622794,0,74157,-317149,23825,481577,562395,875574,840706,1160287,1619936,1498032,1475610,1164467,949769,1280500,1015376,1063969,905518,615928,0,-87002,-594303,-548189,-192022,-133977,74580,549869,205817,162377,410494,90138,597008,664846,830524,377126,735741,778767,353906,382320,613333,979868,770860,604628,887587,1280914,956452,1320009,1428155,1055994,0,168619,-88538,-351560,109200,531151,46281,-461996,-305458,-431157,-351578,-445572,-193773,222034,454655,416443,229141,16838,482113,458503,-36529,37212,336796,-124876,-247953,-568505,-351627,0,174429,326398,0,479713,860680,1036211,514896,729323,669741,578086,375592,810904,1314492,0,516330,592423,921726,929593,1045808,747506,626620,597816,458291,216687,699340,216117,-132060,-312354,-2136,-520935,-569805,-970137,-1267749,-880767,-1038096,0,118085,-218891,-76411,-133008,70809,-229674,61482,463032,157647,74287,65534,406373,241452,697069,1054306,708766,949749,1455240,1211918,1300078,1171212,1214004,1127868,1159521,0,183087,153680,15177,-116973,21188,233956,-64713,-354746,-877965,-1342227,-1529732,-1008952,-1394152,-1765713,-1975211,0,-481619,-382778,78075,191489,507177,333103,613687,506194,597264,96635,-69800,-337325,-620875,-885881,-521276,-776467,-401089,-240095,-174539,-655262,-662689,-309418,-543461,-287504,-502363,-425626,-135632,-634977,-125686,0,-406528,-758206,-879047,-365289,-104346,-472971,-535915,-48760,328278,251722,321627,-127699,-192224,248204,-32639,-104266,-265995,207560,-284650,-231682,0,-61639,-279193,-294943,-445218,-331468,-365358,141884,-55123,-528518,-56843,-482234,-590206,-389883,-77870,42781,466913,753792,0,154707,337717,186947,-17501,-222052,-205272,247871,705,307861,459828,791604,945119,1286260,934495,425248,514350,276711,257592,748516,730039,673631] - rs = fromList (Z :. 30) [215752,2738275,-1800525,-1372798,-2118027,296082,207526,2063381,312429,-190965,-907082,-914710,442481,1282782,716990,-1224980,1060351,109154,849522,130337,247166,1435364,-1200037,1292937,-2157594,-649389,-498810,970579,243783,0] - -test10 :: Acc (Vector Int64, Vector Int64) -test10 = A.scanl'Seg (+) 0 xs seg - where - xs :: Acc (Vector Int64) - xs = use $ fromList (Z :. 569) [-66818,282570,251795,447915,102987,-322423,373016,-100430,386059,-276659,77503,-45066,205014,457977,414137,86861,184317,34975,-389689,-183599,-210669,389264,493343,365697,225369,-229419,-332732,-505069,-352280,34323,291140,-146928,-495015,50908,-5428,-7844,-331600,-17398,-481687,-249355,495892,-459418,214034,302053,416809,-427478,-48832,-313518,-188428,330276,33754,281586,-490498,-46829,204743,426224,7224,285948,111713,-468699,-232135,-473092,342638,-178746,-163065,-437864,275495,-424145,83288,58501,-518686,-424113,-428382,-208150,93768,91193,-155000,176795,150008,193358,-519862,-277133,97536,-230501,172400,-373416,440094,-500359,-324651,285285,-348073,286494,-348686,-479451,298805,285157,320078,76131,148254,57373,-514467,495487,-227635,-22820,316565,439713,-353130,-369210,466763,-213166,31440,260113,-181368,230514,-287232,-154117,-70754,373651,290563,-40989,-195019,346160,457767,-206252,-135034,46733,240605,-121111,-321358,-25235,-349651,-79157,235431,451845,-378801,58906,429151,260032,-507962,-144492,132658,183882,238623,-519994,339978,120983,118330,414436,-52829,-141318,-93387,247676,445735,303655,64229,6957,-516716,-449859,106454,-484890,-478341,434162,392391,-248783,450727,24613,-257255,483349,-381840,223247,62811,446996,383912,53514,-29536,230276,258436,27295,-489720,242513,-320984,-369277,239414,288701,273361,42210,-46145,493283,-177461,-447984,-64970,216871,22442,136979,-474832,-267201,22115,-379824,-216973,-333602,-303162,326479,49961,420594,-479521,-412075,62910,-164019,84044,180780,-130860,38441,199448,-170722,517881,-500646,-450057,80259,-241128,-214043,-237239,-365809,-143723,280527,466556,-299309,298202,402917,379882,148816,-305024,44453,-287522,-162711,269556,-21787,-80561,6305,391904,89449,350881,-7445,-267285,-294509,486399,-365337,31272,-215412,326905,-114682,511295,-161369,306380,-227216,381271,442713,-88962,-439349,396719,-425091,-422883,-296783,-257745,172408,-61221,238542,515084,-10239,473506,-460506,-469421,153125,401713,104594,357072,370129,314444,50453,523763,-346880,-327918,-183452,-152636,286804,6537,-149779,325525,-59023,-350288,387999,-412627,285501,-520206,281752,-244409,-406707,463374,-483409,-166937,265219,313066,180692,472791,-426244,-318370,-186665,88541,-509529,432488,-356799,-67306,-138916,164493,-349447,-430379,422564,428901,324766,134812,-471359,350736,-255294,475285,78748,437557,74157,-391306,340974,457752,80818,313179,-34868,319581,459649,-121904,-22422,-311143,-214698,330731,-265124,48593,-158451,-289590,-506774,-87002,-507301,46114,356167,58045,208557,475289,-344052,-43440,248117,-320356,506870,67838,165678,-453398,358615,43026,-424861,28414,231013,366535,-209008,-166232,282959,393327,-324462,363557,108146,-372161,-206472,168619,-257157,-263022,460760,421951,-484870,-508277,156538,-125699,79579,-93994,251799,415807,232621,-38212,-187302,-212303,465275,-23610,-495032,73741,299584,-461672,-123077,-320552,216878,481964,174429,151969,-79232,479713,380967,175531,-521315,214427,-59582,-91655,-202494,435312,503588,120872,516330,76093,329303,7867,116215,-298302,-120886,-28804,-139525,-241604,482653,-483223,-348177,-180294,310218,-518799,-48870,-400332,-297612,386982,-157329,-161941,118085,-336976,142480,-56597,203817,-300483,291156,401550,-305385,-83360,-8753,340839,-164921,455617,357237,-345540,240983,505491,-243322,88160,-128866,42792,-86136,31653,133416,183087,-29407,-138503,-132150,138161,212768,-298669,-290033,-523219,-464262,-187505,520780,-385200,-371561,-209498,-182383,-481619,98841,460853,113414,315688,-174074,280584,-107493,91070,-500629,-166435,-267525,-283550,-265006,364605,-255191,375378,160994,65556,-480723,-7427,353271,-234043,255957,-214859,76737,289994,-499345,509291,-523703,-406528,-351678,-120841,513758,260943,-368625,-62944,487155,377038,-76556,69905,-449326,-64525,440428,-280843,-71627,-161729,473555,-492210,52968,-267128,-61639,-217554,-15750,-150275,113750,-33890,507242,-197007,-473395,471675,-425391,-107972,200323,312013,120651,424132,286879,216787,154707,183010,-150770,-204448,-204551,16780,453143,-247166,307156,151967,331776,153515,341141,-351765,-509247,89102,-237639,-19119,490924,-18477,-56408,-429848] - - seg :: Acc (Segments Int32) - seg = use $ fromList (Z :. 30) [2,24,11,31,22,10,31,23,25,18,5,17,25,31,12,12,26,19,30,27,3,11,22,25,16,30,21,18,22,0] - - -ref11 :: (Vector Int64, Vector Int64) -ref11 = (ps, rs) - where - ps = fromList (Z :. 750) [300202,-3934108,-7293301,118329,0,-9620841,-6707242,194332,33523,-2362285,4356093,8130701,7381954,6320569,13020915,19242062,20405079,12162531,9328566,2344030,6249515,1195987,714789,-3387204,-1156156,-4385845,-1505374,3054547,10517703,14551257,7158564,5521908,4076566,9423606,9791035,15883498,13341839,5338906,7755970,0,8449937,14272421,7658262,4242448,106786,-1538494,6329826,-1969224,-3562793,-5238381,-11479790,-19204769,-23383409,-15529258,-9197176,-3153045,2044602,7324780,0,-4389691,3327745,6304656,5225571,10231407,12003136,8669740,11482531,16463383,14927577,18131497,21726278,19113902,24183865,18037487,12252168,20461643,15647208,19992282,16169909,8901867,3534110,5568184,6826591,1884406,-4706766,-6388012,94426,-8160379,-4083019,-10378695,-15486623,-7206171,-695686,4860798,0,10857061,3955448,-1061568,6951301,-1071594,0,-13446920,-12173160,-8243921,-11230304,-8734571,-16936920,-16750142,-9949134,-10991997,-3350146,-8268859,0,-14302173,-16276308,-11142092,-13546302,-15960168,-15744133,-20140592,-27616401,-23636225,-24849690,-18571631,-14996447,-8469842,-2690306,-1586836,1141087,-1808235,-5396094,-6508579,0,33601076,40110614,40470091,39158954,31965378,23662135,26792692,22837593,15375475,7595486,5806140,0,5557752,6250667,3210301,4771732,10208018,9244194,1488326,-6840876,-5503541,-6377388,1921887,8701362,436706,5155610,4702952,9854658,12359455,11367064,17274738,12815997,16178778,13979944,14676004,11309648,10910551,8856116,1692110,6290491,9917167,13883564,6354535,2315726,2456500,-3357012,-2245597,5286714,0,27838965,23929687,16271002,14334800,12447318,8856790,5550657,2872825,5216149,1984481,6519741,-380267,-2676926,5698169,-2416327,5822052,12780665,13247384,20633185,15313341,14149220,12991370,11193529,10073298,4257177,8166119,6158966,7167487,8065374,4626067,5253098,221789,0,-22666015,-19830708,-26450648,-22323702,-14812315,-12769333,-8380998,-124066,-3429801,1735354,8675238,5922004,3773612,4863814,8973510,8243987,8052797,-131886,-1218987,944425,-5693971,-10284458,-3771161,-6911370,1215128,6417910,7616391,10888675,12684613,15718607,12760177,4418538,0,-19124759,-16690729,-14466748,-7312246,-8934031,-14128478,-6391701,-5586522,-3281158,-6126513,-12086460,-11947805,-8977838,-4679499,-7044384,-3585849,2517797,4187257,1143610,5599470,12556,468724,0,-38086726,-38209271,-34895951,-29641991,-33756478,-34159294,-29272266,-24192985,-18907102,-10553406,-8755717,-5576171,1187225,5646949,0,-26021214,-24968854,-16606604,-23345266,-26556968,-27031671,-32169558,-29741461,-22232488,-21561792,-17815214,-9755318,-5676615,-1531928,0,-7082738,-2096546,69095,1247646,-2028294,278676,1852334,4571352,-3233037,-3429729,-6398514,-9422414,-2191733,2284645,-864442,-254370,1472191,0,3756457,650062,-4943727,-6384744,-850321,-5359348,-645558,-2506083,-3114762,-366178,-6339582,-4052845,0,65534,-7573163,-12029806,-18419840,-13680249,-6009158,-7346388,0,-39890208,-43517086,-35311112,-37123834,-36260718,-33030305,-34707046,-39911126,-35939603,-30275083,-36082502,-32249760,-27147583,-23233819,-25620860,-25554234,-22141128,-25506989,-22929605,-15879316,-24134083,-16570735,-9997301,-4200711,-2668164,1487850,3578750,-1305145,1080697,-6119380,-6192140,-4780925,-6340276,0,-26181571,-18058810,-10653064,-6588755,-9696374,-5833999,-9675119,-10632518,-11082908,-10756776,-10864096,-13002610,-7721565,-9182352,-6394042,-2752356,-9605533,-4366062,-8172748,0,-16273637,-12506792,-8904008,-8280500,-10173545,-6329127,-3926250,-8763799,-8461557,-5251290,1921403,9241406,2219290,2078592,1370230,2365533,0,-36174378,-34747120,-36960421,-38916018,-33713341,-27862565,-19493548,-13614863,-18329350,-13726747,-18636836,-21433533,-22047575,-17828457,-18477083,-18912228,-16845393,-14834848,-10961203,-4503372,2709924,-5670489,0,8244107,7371898,1062426,-5349784,-1530037,-4243202,1657954,0,58761276,64777759,62710415,55540126,63734805,67828569,66998117,65406433,58629880,51628041,49304089,52468514,44515601,37206921,40107031,36553913,32964413,28315600,22177065,24792502,21656741,20411694,28296854,21119658,16847130,10142928,6275059,10233804,7892690,6605617,812948,-4276554,421536,-282529,0,10264903,3489193,0,47453090,48772541,54603425,48519299,46216432,50441440,48516811,45678872,39908077,32646114,28833886,23180980,15877983,14237392,6679178,13066338,6271764,8380814,1833690,-4162730,-1918105,5114142,0,-25911951,-28491981,-26929631,-23869603,-20710623,-28958111,-23436032,-16629161,-16368397,-15117344,-13086145,-7862262,-3970195,-1325162,69199,2584855,-390927,-753348,-7662405,0,44746008,36954219,37811396,37926769,38442648,38288713,29989290,27015712,25484790,22372796,17537520,16774727,8552613,13943585,17093179,10142287,5721997,10994509,9787684,9382836,9256805,16015565,8545047,10254145,12213051,12551830,8902381,12267197,4492349,3729047,8190040,1659416,-5162630,0,-39096550,-32628259,-39002248,-31910093,-31760558,-26048323,-23199546,-18154141,-15577194,-20921838,-13620329,-5287668,-10372255,-7345019,-13225631,-8543390,-10782084,-10995673,-6251002,1830175,-5731084,-3491981,-9221778,-10184068,-15385965,-16015517,-7715802,-1442733,6174121,2371134,-1808823,5881932,0,-10833715,-9130099,-7149409,-89049,-6363174,-3030367,884814,0,4329246,-712705,-2477029,-4838047,-6361858,-758166,6976202,50092,-5046096,2007750,-5232448,-1895517,-5590470,-4630085,-5205817,-5003092,1356974,0,-30933008,-25815115,-26412272,-27208148,-28291145,-30761072,-24801972,-20136889,-20802009,-17119600,-9796191,-5951994,-3024348,-6817180,-10261727,-12018141,-6423630,-7809004,-12362519,-15505819,-17738534,-12482571,-16777356,-8514106,-10646693,-13579392,-17091140,-10886710,-8783584,-3787667,0,-10399417,-9783351,-11140112,-10286438,-18016415,-24699666,-29534073,-30173237,-22982316,-16232479,-20550054,-17508444,-20456501,-15338123,-16089893,-19682049,-17509739,-17545850,-20482200,-16092902,-10112370,-9857530,-7086012,-5758886,-13713007,-18431943,-12663085,-10395688,-9242682,-3627676,-4124458,324696,0,-1239916,-1099231,0,-52728448,-49740852,-53462736,-48128709,-51184308,-50512793,-51205907,-44973519,-45435372,-48750664,-42361329,-35515045,-32329339,-31125840,-23377216,-15586974,-16058124,-22592883,-17078262,-10577077,-10527747,-13404618,-8157252,-2726103,-4759099,-9619550,-11889364,-13992613,-14997209,-7958218,0,11463857,11389338,6395972,4491458,0,9908832,4627071,2514558,5454929,3049640,-3347579,-4585603,-8139773,-4727321,-5405095,-5516549,-1072707,2091727,10164364,8109479,13221076,11835227,5915534,7266805,10176116,7976055,487672,-1039582,4809829,-3150159,0,-5576241,2649236,-4909388,2973172,0] - rs = fromList (Z :. 37) [1828591,-5649957,12711572,-882080,8724897,-5592479,-16715596,30682536,8434130,20924927,-21828584,-20372532,-33000591,-25847170,-2348236,7144729,-7521765,-37600334,-21413350,-17584160,-30265145,2716955,54962523,15814454,52796336,-29414196,44937491,-41772916,-13871531,5751378,-32142219,-11167891,-5978481,-54925970,6000925,17510325,-13863452] - -test11 :: Acc (Vector Int64, Vector Int64) -test11 = A.scanr'Seg (+) 0 xs seg - where - xs :: Acc (Vector Int64) - xs = use $ fromList (Z :. 750) [1528389,4234310,3359193,-7411630,118329,3970884,-2913599,-6901574,160809,2395808,-6718378,-3774608,748747,1061385,-6700346,-6221147,-1163017,8242548,2833965,6984536,-3905485,5053528,481198,4101993,-2231048,3229689,-2880471,-4559921,-7463156,-4033554,7392693,1636656,1445342,-5347040,-367429,-6092463,2541659,8002933,-2417064,7755970,4261635,-5822484,6614159,3415814,4135662,1645280,-7868320,8299050,1593569,1675588,6241409,7724979,4178640,-7854151,-6332082,-6044131,-5197647,-5280178,7324780,3507611,-7717436,-2976911,1079085,-5005836,-1771729,3333396,-2812791,-4980852,1535806,-3203920,-3594781,2612376,-5069963,6146378,5785319,-8209475,4814435,-4345074,3822373,7268042,5367757,-2034074,-1258407,4942185,6591172,1681246,-6482438,8254805,-4077360,6295676,5107928,-8280452,-6510485,-5556484,4860798,-2132164,6901613,5017016,-8012869,8022895,-1071594,7854441,-1273760,-3929239,2986383,-2495733,8202349,-186778,-6801008,1042863,-7641851,4918713,-8268859,-2413423,1974135,-5134216,2404210,2413866,-216035,4396459,7475809,-3980176,1213465,-6278059,-3575184,-6526605,-5779536,-1103470,-2727923,2949322,3587859,1112485,-6508579,-2918540,-6509538,-359477,1311137,7193576,8303243,-3130557,3955099,7462118,7779989,1789346,5806140,2876378,-692915,3040366,-1561431,-5436286,963824,7755868,8329202,-1337335,873847,-8299275,-6779475,8264656,-4718904,452658,-5151706,-2504797,992391,-5907674,4458741,-3362781,2198834,-696060,3366356,399097,2054435,7164006,-4598381,-3626676,-3966397,7529029,4038809,-140774,5813512,-1111415,-7532311,5286714,-6914038,3909278,7658685,1936202,1887482,3590528,3306133,2677832,-2343324,3231668,-4535260,6900008,2296659,-8375095,8114496,-8238379,-6958613,-466719,-7385801,5319844,1164121,1157850,1797841,1120231,5816121,-3908942,2007153,-1008521,-897887,3439307,-627031,5031309,221789,837431,-2835307,6619940,-4126946,-7511387,-2042982,-4388335,-8256932,3305735,-5165155,-6939884,2753234,2148392,-1090202,-4109696,729523,191190,8184683,1087101,-2163412,6638396,4590487,-6513297,3140209,-8126498,-5202782,-1198481,-3272284,-1795938,-3033994,2958430,8341639,4418538,-1247773,-2434030,-2223981,-7154502,1621785,5194447,-7736777,-805179,-2305364,2845355,5959947,-138655,-2969967,-4298339,2364885,-3458535,-6103646,-1669460,3043647,-4455860,5586914,-456168,468724,5086135,122545,-3313320,-5253960,4114487,402816,-4887028,-5079281,-5285883,-8353696,-1797689,-3179546,-6763396,-4459724,5646949,174044,-1052360,-8362250,6738662,3211702,474703,5137887,-2428097,-7508973,-670696,-3746578,-8059896,-4078703,-4144687,-1531928,4734502,-4986192,-2165641,-1178551,3275940,-2306970,-1573658,-2719018,7804389,196692,2968785,3023900,-7230681,-4476378,3149087,-610072,-1726561,1472191,3388272,3106395,5593789,1441017,-5534423,4509027,-4713790,1860525,608679,-2748584,5973404,-2286737,-4052845,-7587299,7638697,4456643,6390034,-4739591,-7671091,1337230,-7346388,2289874,3626878,-8205974,1812722,-863116,-3230413,1676741,5204080,-3971523,-5664520,5807419,-3832742,-5102177,-3913764,2387041,-66626,-3413106,3365861,-2577384,-7050289,8254767,-7563348,-6573434,-5796590,-1532547,-4156014,-2090900,4883895,-2385842,7200077,72760,-1411215,1559351,-6340276,4768221,-8122761,-7405746,-4064309,3107619,-3862375,3841120,957399,450390,-326132,107320,2138514,-5281045,1460787,-2788310,-3641686,6853177,-5239471,3806686,-8172748,-1310523,-3766845,-3602784,-623508,1893045,-3844418,-2402877,4837549,-302242,-3210267,-7172693,-7320003,7022116,140698,708362,-995303,2365533,5909233,-1427258,2213301,1955597,-5202677,-5850776,-8369017,-5878685,4714487,-4602603,4910089,2796697,614042,-4219118,648626,435145,-2066835,-2010545,-3873645,-6457831,-7213296,8380413,-5670489,-5527152,872209,6309472,6412210,-3819747,2713165,-5901156,1657954,-3798753,-6016483,2067344,7170289,-8194679,-4093764,830452,1591684,6776553,7001839,2323952,-3164425,7952913,7308680,-2900110,3553118,3589500,4648813,6138535,-2615437,3135761,1245047,-7885160,7177196,4272528,6704202,3867869,-3958745,2341114,1287073,5792669,5089502,-4698090,704065,-282529,5549551,6775710,3489193,5343246,-1319451,-5830884,6084126,2302867,-4225008,1924629,2837939,5770795,7261963,3812228,5652906,7302997,1640591,7558214,-6387160,6794574,-2109050,6547124,5996420,-2244625,-7032247,5114142,-3502245,2580030,-1562350,-3060028,-3158980,8247488,-5522079,-6806871,-260764,-1251053,-2031199,-5223883,-3892067,-2645033,-1394361,-2515656,2975782,362421,6909057,-7662405,191483,7791789,-857177,-115373,-515879,153935,8299423,2973578,1530922,3111994,4835276,762793,8222114,-5390972,-3149594,6950892,4420290,-5272512,1206825,404848,126031,-6758760,7470518,-1709098,-1958906,-338779,3649449,-3364816,7774848,763302,-4460993,6530624,6822046,-5162630,-2676366,-6468291,6373989,-7092155,-149535,-5712235,-2848777,-5045405,-2576947,5344644,-7301509,-8332661,5084587,-3027236,5880612,-4682241,2238694,213589,-4744671,-8081177,7561259,-2239103,5729797,962290,5201897,629552,-8299715,-6273069,-7616854,3802987,4179957,-7690755,5881932,-3037816,-1703616,-1980690,-7060360,6274125,-3332807,-3915181,884814,1422132,5041951,1764324,2361018,1523811,-5603692,-7734368,6926110,5096188,-7053846,7240198,-3336931,3694953,-960385,575732,-202725,-6360066,1356974,-1209211,-5117893,597157,795876,1082997,2469927,-5959100,-4665083,665120,-3682409,-7323409,-3844197,-2927646,3792832,3444547,1756414,-5594511,1385374,4553515,3143300,2232715,-5255963,4294785,-8263250,2132587,2932699,3511748,-6204430,-2103126,-4995917,-3787667,-768474,-616066,1356761,-853674,7729977,6683251,4834407,639164,-7190921,-6749837,4317575,-3041610,2948057,-5118378,751770,3592156,-2172310,36111,2936350,-4389298,-5980532,-254840,-2771518,-1327126,7954121,4718936,-5768858,-2267397,-1153006,-5615006,496782,-4449154,324696,-4738565,-140685,-1099231,-2197522,-2987596,3721884,-5334027,3055599,-671515,693114,-6232388,461853,3315292,-6389335,-6846284,-3185706,-1203499,-7748624,-7790242,471150,6534759,-5514621,-6501185,-49330,2876871,-5247366,-5431149,2032996,4860451,2269814,2103249,1004596,-7038991,-7958218,-5462932,74519,4993366,1904514,4491458,7601493,5281761,2112513,-2940371,2405289,6397219,1238024,3554170,-3412452,677774,111454,-4443842,-3164434,-8072637,2054885,-5111597,1385849,5919693,-1351271,-2909311,2200061,7488383,1527254,-5849411,7959988,-3150159,-8287211,-8225477,7558624,-7882560,2973172] - - seg :: Acc (Segments Int32) - seg = use $ fromList (Z :. 37) [5,35,19,36,6,12,20,12,37,33,33,23,15,15,18,13,8,34,20,17,23,8,35,3,23,20,34,33,8,18,31,33,3,31,5,26,5] - diff --git a/examples/nofib/Test/Issues/Issue123.hs b/examples/nofib/Test/Issues/Issue123.hs deleted file mode 100644 --- a/examples/nofib/Test/Issues/Issue123.hs +++ /dev/null @@ -1,26 +0,0 @@ - -module Test.Issues.Issue123 (test_issue123) - where - -import Config -import Test.Framework -import Test.Framework.Providers.HUnit - -import Prelude as P -import Data.Array.Accelerate as A -import Data.Array.Accelerate.Examples.Internal as A - - -test_issue123 :: Backend -> Config -> Test -test_issue123 backend _conf = - testCase "123" (assertEqual ref1 $ run backend (test1 n)) - where - n = 100 - ref1 = fromList Z [n] - - -test1 :: Int -> Acc (Scalar Int) -test1 n - = fold (+) 0 - $ fill (constant (Z:.n)) 1 - diff --git a/examples/nofib/Test/Issues/Issue137.hs b/examples/nofib/Test/Issues/Issue137.hs deleted file mode 100644 --- a/examples/nofib/Test/Issues/Issue137.hs +++ /dev/null @@ -1,43 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} - -module Test.Issues.Issue137 (test_issue137) - where - -import Config -import Test.Framework -import Test.Framework.Providers.HUnit - -import Prelude as P -import Data.Array.Accelerate as A -import Data.Array.Accelerate.Examples.Internal as A - - -test_issue137 :: Backend -> Config -> Test -test_issue137 backend _conf = - testCase "137" (assertEqual ref1 $ run backend test1) - - -ref1 :: Vector (Int,Int) -ref1 = fromList (Z:.384) [(1,2),(0,1),(2,3),(0,1),(3,4),(0,1),(4,5),(0,1),(5,5),(0,1),(4,5),(0,1),(3,4),(0,1),(2,3),(0,1),(1,2),(1,2),(0,1),(2,3),(0,1),(3,4),(0,1),(4,5),(0,1),(5,5),(0,1),(4,5),(0,1),(3,4),(0,1),(2,3),(0,1),(1,2),(1,2),(0,1),(2,3),(0,1),(3,4),(0,1),(4,5),(0,1),(5,5),(0,1),(4,5),(0,1),(3,4),(0,1),(2,3),(0,1),(1,2),(1,2),(0,1),(2,3),(0,1),(3,4),(0,1),(4,5),(0,1),(5,5),(0,1),(4,5),(0,1),(3,4),(0,1),(2,3),(0,1),(1,2),(1,2),(0,1),(2,3),(0,1),(3,4),(0,1),(4,5),(0,1),(5,5),(0,1),(4,5),(0,1),(3,4),(0,1),(2,3),(0,1),(1,2),(1,2),(0,1),(2,3),(0,1),(3,4),(0,1),(4,5),(0,1),(5,5),(0,1),(4,5),(0,1),(3,4),(0,1),(2,3),(0,1),(1,2),(1,2),(0,1),(2,3),(0,1),(3,4),(0,1),(4,5),(0,1),(5,5),(0,1),(4,5),(0,1),(3,4),(0,1),(2,3),(0,1),(1,2),(1,2),(0,1),(2,3),(0,1),(3,4),(0,1),(4,5),(0,1),(5,5),(0,1),(4,5),(0,1),(3,4),(0,1),(2,3),(0,1),(1,2),(1,2),(0,1),(2,3),(0,1),(3,4),(0,1),(4,5),(0,1),(5,5),(0,1),(4,5),(0,1),(3,4),(0,1),(2,3),(0,1),(1,2),(1,2),(0,1),(2,3),(0,1),(3,4),(0,1),(4,5),(0,1),(5,5),(0,1),(4,5),(0,1),(3,4),(0,1),(2,3),(0,1),(1,2),(1,2),(0,1),(2,3),(0,1),(3,4),(0,1),(4,5),(0,1),(5,5),(0,1),(4,5),(0,1),(3,4),(0,1),(2,3),(0,1),(1,2),(1,2),(0,1),(2,3),(0,1),(3,4),(0,1),(4,5),(0,1),(5,5),(0,1),(4,5),(0,1),(3,4),(0,1),(2,3),(0,1),(1,2),(1,2),(0,1),(2,3),(0,1),(3,4),(0,1),(4,5),(0,1),(5,5),(0,1),(4,5),(0,1),(3,4),(0,1),(2,3),(0,1),(1,2),(1,2),(0,1),(2,3),(0,1),(3,4),(0,1),(4,5),(0,1),(5,5),(0,1),(4,5),(0,1),(3,4),(0,1),(2,3),(0,1),(1,2),(1,2),(0,1),(2,3),(0,1),(3,4),(0,1),(4,5),(0,1),(5,5),(0,1),(4,5),(0,1),(3,4),(0,1),(2,3),(0,1),(1,2),(1,2),(0,1),(2,3),(0,1),(3,4),(0,1),(4,5),(0,1),(5,5),(0,1),(4,5),(0,1),(3,4),(0,1),(2,3),(0,1),(1,2),(1,2),(0,1),(2,3),(0,1),(3,4),(0,1),(4,5),(0,1),(5,5),(0,1),(4,5),(0,1),(3,4),(0,1),(2,3),(0,1),(1,2),(1,2),(0,1),(2,3),(0,1),(3,4),(0,1),(4,5),(0,1),(5,5),(0,1),(4,5),(0,1),(3,4),(0,1),(2,3),(0,1),(1,2),(1,2),(0,1),(2,3),(0,1),(3,4),(0,1),(4,5),(0,1),(5,5),(0,1),(4,5),(0,1),(3,4),(0,1),(2,3),(0,1),(1,2),(1,2),(0,1),(2,3),(0,1),(3,4),(0,1),(4,5),(0,1),(5,5),(0,1),(4,5),(0,1),(3,4),(0,1),(2,3),(0,1),(1,2),(1,2),(0,1),(2,3),(0,1),(3,4),(0,1),(4,5),(0,1),(5,5),(0,1),(4,5),(0,1),(3,4),(0,1),(2,3),(0,1),(1,2),(1,2),(0,1),(2,3),(0,1),(3,4),(0,1),(4,5),(0,1),(5,5),(0,1),(4,5),(0,1),(3,4),(0,1),(2,3),(0,1),(1,2),(1,2),(0,10000),(10000,10000),(10000,10000),(10000,10000),(10000,10000),(10000,10000),(10000,10000),(10000,10000),(10000,10000)] - -test1 :: Acc (Vector (Int,Int)) -test1 = - let - sz = 3000 :: Int - interm_arrA = use $ A.fromList (Z :. sz) [ P.fromIntegral $ 8 - (a `mod` 17) | a <- [1..sz]] - msA = use $ A.fromList (Z :. sz) [ P.fromIntegral $ (a `div` 8) | a <- [1..sz]] - inf = 10000 :: Exp Int - infsA = A.generate (index1 (384 :: Exp Int)) (\_ -> lift (inf,inf)) - inpA = A.map (\v -> lift (abs v,inf) :: Exp (Int,Int)) interm_arrA - in - A.permute (\a12 b12 -> let (a1,a2) = unlift a12 - (b1,b2) = unlift b12 - in (a1 A.<= b1) - ? ( lift (a1, A.min a2 b1) - , lift (b1, A.min b2 a1) - )) - infsA - (\ix -> index1 (msA A.! ix)) - inpA - diff --git a/examples/nofib/Test/Issues/Issue168.hs b/examples/nofib/Test/Issues/Issue168.hs deleted file mode 100644 --- a/examples/nofib/Test/Issues/Issue168.hs +++ /dev/null @@ -1,54 +0,0 @@ - -module Test.Issues.Issue168 (test_issue168) - where - -import Config -import Test.Framework -import Test.Framework.Providers.HUnit - -import Prelude as P -import Data.Array.Accelerate as A -import Data.Array.Accelerate.Examples.Internal as A - - -test_issue168 :: Backend -> Config -> Test -test_issue168 backend _conf = testGroup "168" - [ testCase "A" (assertEqual ref1 $ run backend (A.fill sh test1)) - , testCase "B" (assertEqual ref2 $ run backend (A.fill sh test2)) - , testCase "C" (assertEqual ref3 $ run backend (A.fill sh test3)) - ] - where - sh = index1 (constant 1) :: Exp DIM1 - - -- Test 1 - -- ------ - dqc1 :: (Exp Float, Exp Float) - dqc1 = (2,1) - - qMult1 :: (Exp Float, Exp Float) -> (Exp Float, Exp Float) - qMult1 (a1,_) = (3, a1) - - ref1 = fromList (Z:.1) [(3.0,2.0)] - - test1 :: Exp (Float, Float) - test1 = P.iterate (lift1 qMult1) (lift dqc1) P.!! 1 - - ref2 = ref1 - - test2 :: Exp (Float, Float) - test2 = A.iterate (constant 1) (lift1 qMult1) (lift dqc1) - - -- Test 2 - -- ------ - ref3 = fromList (Z:.1) [(1.0,2.0,3.0,4.0,5.0,6.0)] - - dqc3 :: (Exp Float, Exp Float, Exp Float, Exp Float, Exp Float, Exp Float) - dqc3 = (6,5,4,3,2,1) - - qMult3 :: (Exp Float, Exp Float, Exp Float, Exp Float, Exp Float, Exp Float) - -> (Exp Float, Exp Float, Exp Float, Exp Float, Exp Float, Exp Float) - qMult3 (a1,b1,c1,d1,e1,f1) = (f1,e1,d1,c1,b1,a1) - - test3 :: Exp (Float,Float,Float,Float,Float,Float) - test3 = A.iterate (constant 1) (lift1 qMult3) (lift dqc3) - diff --git a/examples/nofib/Test/Issues/Issue184.hs b/examples/nofib/Test/Issues/Issue184.hs deleted file mode 100644 --- a/examples/nofib/Test/Issues/Issue184.hs +++ /dev/null @@ -1,52 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} - -module Test.Issues.Issue184 (test_issue184) - where - -import Config -import Test.Framework -import Test.Framework.Providers.HUnit - -import Data.Array.Accelerate as A -import Data.Array.Accelerate.Examples.Internal as A - - -test_issue184 :: Backend -> Config -> Test -test_issue184 backend _conf = testGroup "184" - [ testCase "A" (assertEqual ref1 $ run backend test1) - , testCase "B" (assertEqual ref2 $ run backend test2) - , testCase "C" (assertEqual ref3 $ run backend test3) - ] - - -ref1 :: Vector Int -ref1 = fromList (Z :. 1000) [1,4,9,16,25,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0] - -test1 :: Acc (Vector Int) -test1 = - let v = use (fromList (Z :. 5) [1,2,3,4,5] :: Vector Int) - f x = x < 5 ? (let y = v !! x in y*y, 0) - in generate (index1 1000) (f . unindex1) - - -ref2 :: Scalar Bool -ref2 = fromList Z [True] - -test2 :: Acc (Scalar Bool) -test2 = - let x = constant 1 :: Exp Int - v = use (fromList (Z :. 5) [1,2,3,4,5] :: Vector Int) - y = (x == 1 || v !! (-1) == 1) - in unit y - - -ref3 :: Scalar Bool -ref3 = fromList Z [False] - -test3 :: Acc (Scalar Bool) -test3 = - let x = constant 1 :: Exp Int - v = use (fromList (Z :. 5) [1,2,3,4,5] :: Vector Int) - y = (x /= 1 && v !! (-1) == 1) - in unit y - diff --git a/examples/nofib/Test/Issues/Issue185.hs b/examples/nofib/Test/Issues/Issue185.hs deleted file mode 100644 --- a/examples/nofib/Test/Issues/Issue185.hs +++ /dev/null @@ -1,133 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedLists #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} - -module Test.Issues.Issue185 (test_issue185) - where - -import Config -import Test.Framework -import Test.Framework.Providers.HUnit - -import Prelude as P -import Data.Array.Accelerate as A -import Data.Array.Accelerate.Examples.Internal as A - - -test_issue185 :: Backend -> Config -> Test -test_issue185 backend _conf = testGroup "185" - [ testCase "A" (assertEqual ref1 (run backend acc1 :: Vector Int)) - , testCase "B" (assertEqual ref2 (run backend acc2 :: Vector Int)) - , testCase "C" (assertEqual ref3 (run backend acc3 :: Vector Int)) - , testCase "D" (assertEqual ref4 (run backend acc4 :: Vector Int)) - , testCase "E" (assertEqual ref5 (run backend acc5 :: Vector Int)) - , testCase "F" (assertEqual ref6 (run backend acc6 :: Vector Int)) - ] - - -ref1 :: (Elt a, P.Num a) => Vector a -ref1 = fromList (Z :. 9) [0,1,4,9,0,4,0,6,2] - -acc1 :: (Elt a, P.Num a) => Acc (Vector a) -acc1 = A.scatter to over xs - where - over = use [0, 0, 0, 0, 0, 0, 0, 0, 0] - xs = use [1, 9, 6, 4, 4, 2, 5] - to = use [1, 3, 7, 2, 5, 8] - - -ref2 :: (Elt a, P.Num a) => Vector a -ref2 = fromList (Z :. 9) [0,1,0,9,0,0,0,6,0] - -acc2 :: (Elt a, P.Num a) => Acc (Vector a) -acc2 = A.scatter to over xs - where - over = use [0, 0, 0, 0, 0, 0, 0, 0, 0] - xs = use [1, 9, 6] - to = use [1, 3, 7, 2, 5, 8] - - -ref3 :: (Elt a, P.Num a) => Vector a -ref3 = fromList (Z :. 9) [0,0,0,0,0,4,0,6,2] - -acc3 :: (Elt a, P.Num a) => Acc (Vector a) -acc3 = scatterIf to mask p over xs - where - over = use [0, 0, 0, 0, 0, 0, 0, 0, 0] - to = use [1, 3, 7, 2, 5, 8] - xs = use [1, 9, 6, 4, 4, 2, 5] - - mask :: Acc (Vector Int32) - mask = use [3, 4, 9, 2, 7, 5] - p = (A.> 4) - - -ref4 :: (Elt a, P.Num a) => Vector a -ref4 = fromList (Z :. 9) [0,0,0,0,0,0,0,6,0] - -acc4 :: (Elt a, P.Num a) => Acc (Vector a) -acc4 = scatterIf to mask p over xs - where - over = use [0, 0, 0, 0, 0, 0, 0, 0, 0] - to = use [1, 3, 7, 2, 5, 8] - xs = use [1, 9, 6] - - mask :: Acc (Vector Int32) - mask = use [3, 4, 9, 2, 7, 5] - p = (A.> 4) - - -ref5 :: (Elt a, P.Num a) => Vector a -ref5 = fromList (Z :. 6) [9,4,1,6,2,4] - -acc5 :: (Elt a, P.Num a) => Acc (Vector a) -acc5 = A.gather from xs - where - from = use [1, 3, 7, 2, 5, 3] - xs = use [1, 9, 6, 4, 4, 2, 0, 1, 2] - - -ref6 :: (Elt a, P.Num a) => Vector a -ref6 = fromList (Z :. 6) [6,6,1,6,2,4] - -acc6 :: (Elt a, P.Num a) => Acc (Vector a) -acc6 = gatherIf from mask p over xs - where - over = use [6, 6, 6, 6, 6, 6] - from = use [1, 3, 7, 2, 5, 3] - xs = use [1, 9, 6, 4, 4, 2, 0, 1, 2] - - mask :: Acc (Vector Int32) - mask = use [3, 4, 9, 2, 7, 5] - p = (A.> 4) - - -gatherIf - :: (Elt a, Elt b) - => Acc (Vector Int) -- ^ source indices to gather from - -> Acc (Vector a) -- ^ mask vector - -> (Exp a -> Exp Bool) -- ^ predicate function - -> Acc (Vector b) -- ^ default values - -> Acc (Vector b) -- ^ source values - -> Acc (Vector b) -gatherIf from maskV p def input = A.zipWith zf pf gatheredV - where - zf ok g = ok ? (unlift g) - gatheredV = A.zip (gather from input) def - pf = A.map p maskV - -scatterIf - :: (Elt e, Elt e') - => Acc (Vector Int) -- ^ destination indices to scatter into - -> Acc (Vector e) -- ^ mask vector - -> (Exp e -> Exp Bool) -- ^ predicate function - -> Acc (Vector e') -- ^ default values - -> Acc (Vector e') -- ^ source values - -> Acc (Vector e') -scatterIf to maskV p def input = permute const def pf input' - where - pf ix = p (maskV ! ix) ? ( index1 (to ! ix), ignore ) - input' = backpermute (shape to `intersect` shape input) id input - diff --git a/examples/nofib/Test/Issues/Issue187.hs b/examples/nofib/Test/Issues/Issue187.hs deleted file mode 100644 --- a/examples/nofib/Test/Issues/Issue187.hs +++ /dev/null @@ -1,42 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} - -module Test.Issues.Issue187 (test_issue187) - where - -import Config -import Test.Framework -import Test.Framework.Providers.HUnit - -import Data.Array.Accelerate as A -import Data.Array.Accelerate.Examples.Internal as A - - -test_issue187 :: Backend -> Config -> Test -test_issue187 backend _conf = testGroup "187" - [ testCase "A" (assertEqual ref1 $ run backend test1) - , testCase "B" (assertEqual ref2 $ run backend test2) - ] - - -ref1 :: Scalar Bool -ref1 = fromList Z [True] - -test1 :: Acc (Scalar Bool) -test1 = - let x = constant 1 :: Exp Int - v = use (fromList (Z :. 5) [1,2,3,4,5] :: Vector Int) - y = (x == 1 || v A.!! (-1) == 1) - in generate (constant Z) (const y) - - -ref2 :: Scalar Bool -ref2 = fromList Z [True] - -test2 :: Acc (Scalar Bool) -test2 = - let x = constant 1 :: Exp Int - x' = unit x - v = use (fromList (Z :. 5) [1,2,3,4,5] :: Vector Int) - y = (x == the x' || let y' = v A.!! (-1) in y'*y' == 1) - in generate (constant Z) (const y) - diff --git a/examples/nofib/Test/Issues/Issue228.hs b/examples/nofib/Test/Issues/Issue228.hs deleted file mode 100644 --- a/examples/nofib/Test/Issues/Issue228.hs +++ /dev/null @@ -1,54 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} --- https://github.com/AccelerateHS/accelerate/issues/228 --- - -module Test.Issues.Issue228 (test_issue228) - where - -import Config -import Test.Framework -import Test.Framework.Providers.HUnit - -import Prelude as P -import Data.Array.Accelerate as A -import Data.Array.Accelerate.Examples.Internal as A - - -test_issue228 :: Backend -> Config -> Test -test_issue228 backend _conf = - testGroup "228" - [ testCase "A" (assertEqual ref1 $ run backend (A.fold mergeExp z1 (use test1))) - , testCase "B" (assertEqual ref1 $ run backend (A.fold1 mergeExp (use test1))) - ] - -test1 :: Vector (Int,Int) -test1 = fromList (Z:.3) [(1,1),(0,0),(1,1)] - -z1 :: Exp (Int,Int) -z1 = constant (1,0) - -ref1 :: Scalar (Int,Int) -ref1 = fromList Z [(0,1)] - -{-- -testAssociativity = - quickCheck $ \(x, y, z) -> mergeB x (mergeB y z) == mergeB (mergeB x y) z - -mergeB :: (Bool,Int) -> (Bool,Int) -> (Bool,Int) -mergeB (b1,l1) (b2,l2) = (toEnum v3,l3) - where - (v3,l3) = merge (fromEnum b1,l1) (fromEnum b2,l2) ---} - -merge :: P.Num a => (a,a) -> (a,a) -> (a,a) -merge (onL, lenL) (onR, lenR) = (onL * onR, onL * lenR + lenL) - -mergeExp :: Exp (Int,Int) -> Exp (Int,Int) -> Exp (Int,Int) -mergeExp e1 e2 = - let - v1 = unlift e1 :: (Exp Int,Exp Int) - v2 = unlift e2 :: (Exp Int,Exp Int) - in - lift $ merge v1 v2 - diff --git a/examples/nofib/Test/Issues/Issue255.hs b/examples/nofib/Test/Issues/Issue255.hs deleted file mode 100644 --- a/examples/nofib/Test/Issues/Issue255.hs +++ /dev/null @@ -1,76 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE ViewPatterns #-} - --- https://github.com/AccelerateHS/accelerate/issues/255 --- - -module Test.Issues.Issue255 (test_issue255) - where - -import Config -import Test.HUnit ( assertFailure ) -import Test.Framework -import Test.Framework.Providers.HUnit - -import Data.Array.Accelerate as A -import Data.Array.Accelerate.Examples.Internal as A - -import Control.Exception -import System.Timeout -import Data.List as P -import Prelude as P - - -test_issue255 :: Backend -> Config -> Test -test_issue255 backend _conf = - testGroup "255" - [ testCase "0" (within lIMIT $ total (as P.!! 0)) - , testCase "2" (within lIMIT $ total (as P.!! 2)) - , testCase "4" (within lIMIT $ total (as P.!! 4)) - , testCase "20" (within lIMIT $ total (as P.!! 20)) - , testCase "100" (within lIMIT $ total (as P.!! 100)) - -- , testCase "200" (within lIMIT $ total (as P.!! 200)) - -- , testCase "300" (within lIMIT $ total (as P.!! 300)) - ] - where - lIMIT = 30 * 1000 * 1000 -- microseconds - n = 20 * 1024 * 1024 -- 160 * MiB (8 bytes per Double) - - as :: [A.Vector Double] - as = sums (A.fromList (Z:.n) (repeat 0)) (A.fromList (Z:.n) (repeat 1)) - - sums :: A.Vector Double -> A.Vector Double -> [A.Vector Double] - sums a0 b - = a0 - : ( P.snd - $ P.mapAccumL - (\a' i -> let a = run1 backend step (a', b, scalar i) - in (a, a)) - a0 - [0 .. 500] - ) - - step :: Acc (A.Vector Double, A.Vector Double, A.Scalar Int) -> Acc (A.Vector Double) - step (unlift -> (a, b, A.the -> _i::Exp Int)) = A.zipWith (+) a b - - total :: A.Vector Double -> A.Scalar Double - total a = - run backend $ A.sum $ A.map id $ A.use a - - -- print $ total $ as P.!! 0 - -- print $ total $ as P.!! 2 - -- print $ total $ as P.!! 4 - -- print $ total $ as P.!! 20 - -- print $ total $ as P.!! 100 - -- print $ total $ as P.!! 200 - -- print $ total $ as P.!! 300 - - -within :: Int -> Scalar Double -> Assertion -within n arr = do - r <- timeout n $ evaluate (indexArray arr Z `seq` ()) - case r of - Nothing -> assertFailure "timeout: backend is too slow or memory manager stuck?" - Just () -> return () - diff --git a/examples/nofib/Test/Issues/Issue264.hs b/examples/nofib/Test/Issues/Issue264.hs deleted file mode 100644 --- a/examples/nofib/Test/Issues/Issue264.hs +++ /dev/null @@ -1,102 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} --- https://github.com/AccelerateHS/accelerate/issues/264 --- - -module Test.Issues.Issue264 (test_issue264) - where - -import Config -import Test.Framework -import Test.Framework.Providers.QuickCheck2 -import Test.QuickCheck hiding ( (.&.) ) -import QuickCheck.Arbitrary.Array () - -import Prelude as P -import Data.Bits as P -import Data.Label -import Data.Maybe -import Data.Typeable -import Data.Array.Accelerate as A -import Data.Array.Accelerate.Data.Bits as A -import Data.Array.Accelerate.Examples.Internal as A - -import qualified Data.Array.Accelerate.Array.Sugar as S -import qualified Data.Array.Accelerate.Array.Representation as R - - -test_issue264 :: Backend -> Config -> Test -test_issue264 backend opt - = testGroup "264" - $ catMaybes - [ testBool - , testIntegralElt configInt8 (undefined :: Int8) - , testIntegralElt configInt16 (undefined :: Int16) - , testIntegralElt configInt32 (undefined :: Int32) - , testIntegralElt configInt64 (undefined :: Int64) - , testIntegralElt configWord8 (undefined :: Word8) - , testIntegralElt configWord16 (undefined :: Word16) - , testIntegralElt configWord32 (undefined :: Word32) - , testIntegralElt configWord64 (undefined :: Word64) - , testFloatingElt configFloat (undefined :: Float) - , testFloatingElt configDouble (undefined :: Double) - ] - where - testBool :: Maybe Test - testBool = Just $ testGroup "Bool" - [ testProperty "not.not" (test_notnot :: Vector Bool -> Property) - , testProperty "not(x&&y)" (test_andnot :: Vector Bool -> Vector Bool -> Property) - , testProperty "not(x||y)" (test_ornot :: Vector Bool -> Vector Bool -> Property) - , testProperty "not(not(x&&y))" (test_andnotnot :: Vector Bool -> Vector Bool -> Property) - , testProperty "not(not(x||y))" (test_ornotnot :: Vector Bool -> Vector Bool -> Property) - ] - - testIntegralElt :: forall a. (P.Integral a, P.Bits a, A.Integral a, A.Bits a, Arbitrary a, Similar a, A.FromIntegral a Float) => (Config :-> Bool) -> a -> Maybe Test - testIntegralElt ok _ - | P.not (get ok opt) = Nothing - | otherwise = Just $ testGroup (show (typeOf (undefined :: a))) - [ testProperty "neg.neg" (test_negneg :: Vector a -> Property) - ] - - testFloatingElt :: forall a. (P.Floating a, P.RealFloat a, A.Floating a, A.RealFloat a, Arbitrary a, Similar a) => (Config :-> Bool) -> a -> Maybe Test - testFloatingElt ok _ - | P.not (get ok opt) = Nothing - | otherwise = Just $ testGroup (show (typeOf (undefined :: a))) - [ testProperty "neg.neg" (test_negneg :: Vector a -> Property) - ] - - 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 = 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 = 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 = 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 = 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 - -mapRef :: (Shape sh, Elt b) => (a -> b) -> Array sh a -> Array sh b -mapRef f xs - = fromList (arrayShape xs) - $ P.map f - $ toList xs - -zipWithRef :: (Shape sh, Elt c) => (a -> b -> c) -> Array sh a -> Array sh b -> Array sh c -zipWithRef f xs ys = - let shx = S.fromElt (S.shape xs) - shy = S.fromElt (S.shape ys) - sh = S.toElt (R.intersect shx shy) - in - fromFunction sh (\ix -> f (xs S.! ix) (ys S.! ix)) - diff --git a/examples/nofib/Test/Issues/Issue286.hs b/examples/nofib/Test/Issues/Issue286.hs deleted file mode 100644 --- a/examples/nofib/Test/Issues/Issue286.hs +++ /dev/null @@ -1,122 +0,0 @@ --- https://github.com/AccelerateHS/accelerate/issues/286 --- - -module Test.Issues.Issue286 (test_issue286) - where - -import Config -import Test.Framework -import Test.Framework.Providers.HUnit - -import Prelude as P -import Data.Array.Accelerate as A hiding ( (>->), (==) ) -import Data.Array.Accelerate.IO as A -import Data.Array.Accelerate.Examples.Internal as A - -import Pipes -import Data.Vector.Storable as S - - -test_issue286 :: Backend -> Config -> Test -test_issue286 backend _conf = - testGroup "286 (run with +RTS -M4M -RTS or check heap profile in EKG or similar)" - [ - testCase "hs.hs" (void $ runEffect $ hs_producer sh >-> hs_consume_sv) - , testCase "hs.acc" (void $ runEffect $ hs_producer sh >-> acc_consume_sv sh backend) - , testCase "acc.hs" (void $ runEffect $ acc_producer sh >-> hs_consume_acc) - , testCase "acc.acc" (void $ runEffect $ acc_producer sh >-> acc_consume_acc backend) - ] - where - sh :: DIM2 - sh = Z :. 120 :. 659 - -hs_producer :: DIM2 -> Producer (S.Vector Word8) IO () -hs_producer sh = producer' 0 - where - producer' :: Int -> Producer (S.Vector Word8) IO () - producer' i = do - yield $ S.replicate (arraySize sh) 1 - if i == 5 - then producer' 0 - else producer' (i+1) - -hs_consume_sv :: Consumer (S.Vector Word8) IO () -hs_consume_sv = consumer' 0 0 - where - consumer' :: Int -> Float -> Consumer (S.Vector Word8) IO () - consumer' n acc = do - v <- await - let - i = S.sum $ S.map P.fromIntegral v - i' = i + acc - n' = n + 1 - if i' `seq` n' `seq` (n == lIMIT) - then acc `seq` return () - else consumer' n' i' - -hs_consume_acc :: Consumer (Array DIM2 Word8) IO () -hs_consume_acc = consumer' 0 0 - where - consumer' :: Int -> Float -> Consumer (Array DIM2 Word8) IO () - consumer' n acc = do - v <- await - let - a = toVectors v :: S.Vector Word8 - i = S.sum $ S.map P.fromIntegral a - i' = i + acc - n' = n + 1 - if i' `seq` n' `seq` (n == lIMIT) - then acc `seq` return () - else consumer' n' i' - -acc_producer :: DIM2 -> Producer (Array DIM2 Word8) IO () -acc_producer sh = producer' 0 - where - producer' :: Int -> Producer (Array DIM2 Word8) IO () - producer' i = - do - yield $ A.fromFunction sh (\_ -> 1) - if i == 5 - then producer' 0 - else producer' (i+1) - -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.flatten . A.map A.fromIntegral) - - consumer' :: Int -> Float -> Consumer (S.Vector Word8) IO () - consumer' n acc = do - v <- await - let - a = fromVectors sh v :: Array DIM2 Word8 - i = the' $ go a - i' = i + acc - n' = n + 1 - if i' `seq` n' `seq` (n == lIMIT) - then acc `seq` return () - else consumer' n' i' - -acc_consume_acc :: Backend -> Consumer (Array DIM2 Word8) IO () -acc_consume_acc backend = consumer' 0 0 - where - go = run1 backend (A.sum . A.flatten . A.map A.fromIntegral) - - consumer' :: Int -> Float -> Consumer (Array DIM2 Word8) IO () - consumer' n acc = do - a <- await - let - i = the' $ go a - i' = i + acc - n' = n + 1 - if i' `seq` n' `seq` (n == lIMIT) - then acc `seq` return () - else consumer' n' i' - - -lIMIT :: Int -lIMIT = 50000 - -the' :: Scalar a -> a -the' x = indexArray x Z - diff --git a/examples/nofib/Test/Issues/Issue287.hs b/examples/nofib/Test/Issues/Issue287.hs deleted file mode 100644 --- a/examples/nofib/Test/Issues/Issue287.hs +++ /dev/null @@ -1,91 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ScopedTypeVariables #-} --- https://github.com/AccelerateHS/accelerate/issues/287 --- https://gist.github.com/cpdurham/7c11134bc345f12a8863 --- - -module Test.Issues.Issue287 (test_issue287) - where - -import Config -import Test.Framework -import Test.Framework.Providers.HUnit - -import Prelude as P -import Data.Array.Accelerate as A -import Data.Array.Accelerate.Examples.Internal as A - - -test_issue287 :: Backend -> Config -> Test -test_issue287 backend _conf = - testGroup "287" - [ testCase "A" (assertEqual ref1 $ run1 backend (\x -> A.scanl1 f x) arr1) - , testCase "B" (assertEqual ref1 $ run1 backend (\x -> A.scanl1Seg (\_ b -> b) x (use segs)) arr1) - , testCase "C" (assertEqual ref1 $ run1 backend (\x -> A.scanl1Seg f x (use segs)) arr1) - ] - -ref1 :: Vector (Int,Int,Int,Int,Int,Int) -ref1 = fromList (Z:.4) [(0,0,0,0,0,0),(0,0,0,0,0,0),(0,0,0,0,0,0),(0,0,0,0,0,0)] - -arr1 :: Vector (Int,Int,Int,Int,Int,Int) -arr1 = fromList (Z:.4) [(0,0,0,0,0,0),(0,0,0,0,0,0),(0,0,0,0,0,0),(0,0,0,0,0,0)] - -segs :: Segments Int -segs = A.fromList (Z:.2) [2,2] - -f :: forall a. (A.Num a, A.Ord a) - => Exp (a,a,a,a,a,a) - -> Exp (a,a,a,a,a,a) - -> Exp (a,a,a,a,a,a) -f x y = lift (mi3,l3,c3,r3,li3,ri3) - where - ( mi1,l1, c1,r1, li1,ri1) = unlift x :: (Exp a, Exp a, Exp a, Exp a, Exp a, Exp a) - (_mi2,l2,_c2,r2,_li2,ri2) = unlift y :: (Exp a, Exp a, Exp a, Exp a, Exp a, Exp a) - -- - l3 = l1 - c3 = c1 - r3 = r2 * r1 - mi3 = A.max mi1 (ri1+l2) - li3 = li1 - ri3 = ri2 - --- fExp --- :: Exp (Int,Int,Int,Int,Int,Int) --- -> Exp (Int,Int,Int,Int,Int,Int) --- -> Exp (Int,Int,Int,Int,Int,Int) --- fExp e1 e2 = --- let --- v1 = unlift6E e1 --- v2 = unlift6E e2 --- in --- lift $ f v1 v2 - --- unlift6E --- :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f) --- => Exp (a,b,c,d,e,f) --- -> (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f) --- unlift6E = unlift - --- lift6E --- :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f) --- => (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f) --- -> Exp (a,b,c,d,e,f) --- lift6E = lift - --- convert --- :: Acc (Array DIM1 Int) --- -> Acc (Array DIM1 (Int,Int,Int,Int,Int,Int)) --- convert = A.map (\_ -> lift6E (0,0,0,0,0,0)) - --- arr2 = I.run1 convert (A.fromList (Z :. 4 :: DIM1) ([1,1,1,1]) :: Array DIM1 Int) - --- print $ C.run1 (\x -> A.scanl1 fExp x) $ arr2 --- --no problem - --- print $ C.run1 (\x -> A.scanl1Seg (\_ b -> b) x segs) $ arr2 --- --no problem - --- print $ C.run1 (\x -> A.scanl1Seg fExp x segs) $ arr2 --- -- CUDA exception: invalid argument - diff --git a/examples/nofib/Test/Issues/Issue288.hs b/examples/nofib/Test/Issues/Issue288.hs deleted file mode 100644 --- a/examples/nofib/Test/Issues/Issue288.hs +++ /dev/null @@ -1,25 +0,0 @@ --- https://github.com/AccelerateHS/accelerate/issues/288 --- - -module Test.Issues.Issue288 (test_issue288) - where - -import Config -import Test.Framework -import Test.Framework.Providers.HUnit - -import Prelude as P -import Data.Array.Accelerate as A -import Data.Array.Accelerate.Examples.Internal as A - - -test_issue288 :: Backend -> Config -> Test -test_issue288 backend _conf = - testCase "288" (assertEqual xs $ run1 backend (A.map f) xs) - -f :: Exp (Int, Int) -> Exp (Int, Int) -f e = while (const (lift False)) id e - -xs :: Vector (Int, Int) -xs = fromList (Z:.10) (P.zip [1..] [1..]) - diff --git a/examples/nofib/Test/Issues/Issue362.hs b/examples/nofib/Test/Issues/Issue362.hs deleted file mode 100644 --- a/examples/nofib/Test/Issues/Issue362.hs +++ /dev/null @@ -1,52 +0,0 @@ - --- https://github.com/AccelerateHS/accelerate-llvm/issues/12 --- - -module Test.Issues.Issue362 (test_issue362) - where - -import Config -import Test.Framework -import Test.Framework.Providers.HUnit - -import Prelude as P -import Data.Array.Accelerate as A -import Data.Array.Accelerate.Examples.Internal as A - - -test_issue362 :: Backend -> Config -> Test -test_issue362 backend _conf = - testGroup "362" - [ testCase "A" (assertEqual e1 $ run backend t1) - , testCase "B" (assertEqual e2 $ run backend t2) - ] - --- should work -e1 :: Vector (Int,Int,Int,Int) -e1 = fromList (Z:.10) [(0,0,0,0),(1,1,1,1),(3,3,3,3),(6,6,6,6),(10,10,10,10),(15,15,15,15),(21,21,21,21),(28,28,28,28),(36,36,36,36),(45,45,45,45)] - -t1 :: Acc (Vector (Int,Int,Int,Int)) -t1 = A.scanl1 (lift2 f) xs - where - xs = use $ fromList (Z:.10) [ (x,x,x,x) | x <- [0..9] ] - -- - f :: (Exp Int, Exp Int, Exp Int, Exp Int) - -> (Exp Int, Exp Int, Exp Int, Exp Int) - -> (Exp Int, Exp Int, Exp Int, Exp Int) - f (x1,x2,x3,x4) (y1,y2,y3,y4) = (x1+y1,x2+y2,x3+y3,x4+y4) - - --- was broken on pascal -e2 :: Vector (Int,Int,Int,Int,Int) -e2 = fromList (Z:.10) [(0,0,0,0,0),(1,1,1,1,1),(3,3,3,3,3),(6,6,6,6,6),(10,10,10,10,10),(15,15,15,15,15),(21,21,21,21,21),(28,28,28,28,28),(36,36,36,36,36),(45,45,45,45,45)] - -t2 :: Acc (Vector (Int,Int,Int,Int,Int)) -t2 = A.scanl1 (lift2 f) xs - where - xs = use $ fromList (Z:.10) [ (x,x,x,x,x) | x <- [0..9] ] - -- - f :: (Exp Int, Exp Int, Exp Int, Exp Int, Exp Int) - -> (Exp Int, Exp Int, Exp Int, Exp Int, Exp Int) - -> (Exp Int, Exp Int, Exp Int, Exp Int, Exp Int) - f (x1,x2,x3,x4,x5) (y1,y2,y3,y4,y5) = (x1+y1,x2+y2,x3+y3,x4+y4,x5+y5) - diff --git a/examples/nofib/Test/Issues/Issue93.hs b/examples/nofib/Test/Issues/Issue93.hs deleted file mode 100644 --- a/examples/nofib/Test/Issues/Issue93.hs +++ /dev/null @@ -1,26 +0,0 @@ - -module Test.Issues.Issue93 (test_issue93) - where - -import Config -import Test.Framework -import Test.Framework.Providers.HUnit - -import Prelude as P -import Data.Array.Accelerate as A -import Data.Array.Accelerate.Examples.Internal as A - - -test_issue93 :: Backend -> Config -> Test -test_issue93 backend _conf = - testCase "93" (assertEqual xs $ run backend test1) - - -xs :: Array DIM2 Int -xs = fromList (Z :. 1 :. 1) [5] - -test1 :: Acc (Array DIM2 Int) -test1 = permute (\c _ -> c) (fill (shape xs') (constant 0)) id xs' - where - xs' = use xs - diff --git a/examples/nofib/Test/Prelude.hs b/examples/nofib/Test/Prelude.hs deleted file mode 100644 --- a/examples/nofib/Test/Prelude.hs +++ /dev/null @@ -1,34 +0,0 @@ - -module Test.Prelude where - -import Config -import Data.Array.Accelerate.Examples.Internal - -import Test.Prelude.Backpermute -import Test.Prelude.Filter -import Test.Prelude.Fold -import Test.Prelude.Map -import Test.Prelude.Permute -import Test.Prelude.Replicate -import Test.Prelude.Scan --- import Test.Prelude.Sequences -import Test.Prelude.Stencil -import Test.Prelude.ZipWith - - -test_prelude :: Backend -> Config -> Test -test_prelude be conf = - testGroup "prelude" - [ test_map be conf - , test_zipWith be conf - , test_foldAll be conf - , test_fold be conf - , test_backpermute be conf - , test_permute be conf - , test_scan be conf -- requires fold - , test_foldSeg be conf -- requires scan - , test_stencil be conf - , test_replicate be conf - , test_filter be conf - -- , test_sequences be conf - ] diff --git a/examples/nofib/Test/Prelude/Backpermute.hs b/examples/nofib/Test/Prelude/Backpermute.hs deleted file mode 100644 --- a/examples/nofib/Test/Prelude/Backpermute.hs +++ /dev/null @@ -1,153 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} - -module Test.Prelude.Backpermute ( - - test_backpermute - -) where - -import Prelude as P -import Data.Label -import Data.Maybe -import Data.Typeable -import Test.QuickCheck -import Test.Framework -import Test.Framework.Providers.QuickCheck2 - -import Config -import Test.Base -import QuickCheck.Arbitrary.Array - -import Data.Array.Accelerate as A -import Data.Array.Accelerate.Array.Sugar as A ( Array(..) ) -import Data.Array.Accelerate.Examples.Internal as A - - --- --- Backward permutation -------------------------------------------------------- --- - -test_backpermute :: Backend -> Config -> Test -test_backpermute backend opt = testGroup "backpermute" $ catMaybes - [ testElt configInt8 (undefined :: Int8) - , testElt configInt16 (undefined :: Int16) - , testElt configInt32 (undefined :: Int32) - , testElt configInt64 (undefined :: Int64) - , testElt configWord8 (undefined :: Word8) - , testElt configWord16 (undefined :: Word16) - , testElt configWord32 (undefined :: Word32) - , testElt configWord64 (undefined :: Word64) - , testElt configFloat (undefined :: Float) - , testElt configDouble (undefined :: Double) - ] - where - testElt :: forall e. (Elt e, Similar e, Arbitrary e) => (Config :-> Bool) -> e -> Maybe Test - testElt ok _ - | P.not (get ok opt) = Nothing - | otherwise = Just $ testGroup (show (typeOf (undefined::e))) - [ testProperty "reverse" (test_reverse :: Array DIM1 e -> Property) - , testProperty "transpose" (test_transpose :: Array DIM2 e -> Property) - , testProperty "init" (test_init :: Array DIM1 e -> Property) - , testProperty "tail" (test_tail :: Array DIM1 e -> Property) - , testProperty "take" (test_take :: Array DIM1 e -> Property) - , testProperty "drop" (test_drop :: Array DIM1 e -> Property) - , testProperty "slit" (test_slit :: Array DIM1 e -> Property) - , testProperty "gather" (test_gather :: Array DIM1 e -> Property) - -- , testProperty "gatherIf" (test_gatherIf :: Array DIM1 e -> Property) - ] - where - test_reverse :: Vector e -> Property - test_reverse xs = run1 backend A.reverse xs ~?= reverseRef xs - - test_transpose :: Array DIM2 e -> Property - test_transpose xs = run1 backend A.transpose xs ~?= transposeRef xs - - -- Reverse a vector - -- - reverseRef xs = fromList (arrayShape xs) (P.reverse $ toList xs) - - -- Transpose a 2D matrix - -- - transposeRef xs = - let swap (Z:.x:.y) = Z :. y :. x - in fromFunction (swap (arrayShape xs)) (\ix -> indexArray xs (swap ix)) - - -- Extracting sub-vectors - -- - test_init :: Vector e -> Property - test_init xs = - P.not (isEmptyArray xs) - ==> toList (run1 backend A.init xs) ~?= P.init (toList xs) - - test_tail :: Vector e -> Property - test_tail xs = - P.not (isEmptyArray xs) - ==> toList (run1 backend A.tail xs) ~?= P.tail (toList xs) - - test_drop :: Vector e -> Property - test_drop xs = - let n = arraySize (arrayShape xs) - in forAll (choose (0, 0 `P.max` (n-1))) $ \i -> - toList (runN backend (\i' -> A.drop (the i')) (scalar i) xs) - ~?= - P.drop i (toList xs) - - test_take :: Vector e -> Property - test_take xs@(Array _ adata) = - let Z :. n = arrayShape xs - in forAll (choose (0, 0 `P.max` (n-1))) $ \i -> - runN backend (\i' -> A.take (the i')) (scalar i) xs - ~?= - Array ((),i) adata - - test_slit :: Vector e -> Property - test_slit xs = - 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 (runN backend (\i' j' -> A.slit (the i') (the j')) (scalar i) (scalar j) xs) - ~?= - P.take j (P.drop i (toList xs)) - - -- Gathering - -- - test_gather :: Vector e -> Property - test_gather xs = - let Z :. n = arrayShape xs - in n P.> 0 ==> - forAll arbitrary $ \(sh' :: DIM1) -> - forAll (arbitraryArrayOf sh' (choose (0,n-1))) $ \mapv -> - toList (runN backend A.gather mapv xs) - ~?= - [ xs `indexArray` (Z:.i) | i <- toList mapv ] - - -- test_gatherIf :: Vector e -> Property - -- test_gatherIf xs = - -- let n = arraySize (arrayShape xs) - -- n' = 0 `P.max` (n-1) - -- in - -- forAll arbitrary $ \sh' -> - -- forAll (arbitraryArrayOf sh' (choose (0,n'))) $ \mapv -> - -- forAll (arbitraryArray sh') $ \(maskv :: Vector Int) -> - -- forAll (arbitraryArray sh') $ \defaultv -> - -- 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 - - --- Reference Implementation --- ------------------------ - --- gatherIfRef :: (e -> Bool) -> Vector Int -> Vector e -> Vector t -> Vector t -> [t] --- gatherIfRef g mapv maskv defaultv inputv --- = let n = arraySize (arrayShape defaultv) --- select ix --- | g (maskv `indexArray` ix) = inputv `indexArray` (Z :. mapv `indexArray` ix) --- | otherwise = defaultv `indexArray` ix --- in --- [ select ix | i <- [0 .. n-1], let ix = Z :. i ] - diff --git a/examples/nofib/Test/Prelude/Filter.hs b/examples/nofib/Test/Prelude/Filter.hs deleted file mode 100644 --- a/examples/nofib/Test/Prelude/Filter.hs +++ /dev/null @@ -1,86 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} - -module Test.Prelude.Filter ( - - test_filter - -) where - -import Prelude as P -import Data.Label -import Data.Maybe -import Data.Typeable -import Test.QuickCheck ( Arbitrary ) -import Test.Framework -import Test.Framework.Providers.QuickCheck2 - -import Config -import Test.Base -import QuickCheck.Arbitrary.Array () -import Data.Array.Accelerate as A hiding ( size ) -import Data.Array.Accelerate.Examples.Internal as A -import Data.Array.Accelerate.Array.Sugar as Sugar - --- --- Filter ---------------------------------------------------------------------- --- - -test_filter :: Backend -> Config -> Test -test_filter backend opt = testGroup "filter" $ catMaybes - [ testIntegralElt configInt8 (undefined :: Int8) - , testIntegralElt configInt16 (undefined :: Int16) - , testIntegralElt configInt32 (undefined :: Int32) - , testIntegralElt configInt64 (undefined :: Int64) - , testIntegralElt configWord8 (undefined :: Word8) - , testIntegralElt configWord16 (undefined :: Word16) - , testIntegralElt configWord32 (undefined :: Word32) - , testIntegralElt configWord64 (undefined :: Word64) - , testFloatingElt configFloat (undefined :: Float) - , testFloatingElt configDouble (undefined :: Double) - ] - where - testIntegralElt :: forall e. (P.Integral e, A.Integral e, Arbitrary e, Similar e) => (Config :-> Bool) -> e -> Maybe Test - testIntegralElt ok _ - | P.not (get ok opt) = Nothing - | otherwise = Just $ testGroup (show (typeOf (undefined::e))) - [ testDim dim1 - , testDim dim2 - ] - where - testDim :: forall sh. (Shape sh, Slice sh, P.Eq sh, Arbitrary (Array (sh:.Int) e)) => (sh:.Int) -> Test - testDim sh = testGroup ("DIM" P.++ show (rank sh)) - [ testProperty "even" (run_filter A.even P.even :: Array (sh:.Int) e -> Property) - ] - - testFloatingElt :: forall e. (P.RealFrac e, A.RealFrac e, Arbitrary e, Similar e) => (Config :-> Bool) -> e -> Maybe Test - testFloatingElt ok _ - | P.not (get ok opt) = Nothing - | otherwise = Just $ testGroup (show (typeOf (undefined::e))) - [ testDim dim1 - , testDim dim2 - ] - where - testDim :: forall sh. (Shape sh, Slice sh, P.Eq sh, Arbitrary (Array (sh:.Int) e)) => (sh:.Int) -> Test - testDim sh = testGroup ("DIM" P.++ show (rank sh)) - [ testProperty "positive" (run_filter (A.> 0) (P.> 0) :: Array (sh:.Int) e -> Property) - ] - - run_filter f g xs - = run1 backend (A.filter f) xs ~?= filterRef g xs - - -filterRef - :: (Shape sh, Elt e) - => (e -> Bool) - -> Array (sh:.Int) e - -> (Vector e, Array sh Int) -filterRef f arr = (fromList (Z:.total) (concat result), fromList sh len) - where - sh :. n = arrayShape arr - result = P.take (size sh) [ P.filter f sub | sub <- splitEvery n (toList arr) ] - len = P.map P.length result - total = P.sum len - diff --git a/examples/nofib/Test/Prelude/Fold.hs b/examples/nofib/Test/Prelude/Fold.hs deleted file mode 100644 --- a/examples/nofib/Test/Prelude/Fold.hs +++ /dev/null @@ -1,314 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE PatternGuards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE ViewPatterns #-} - -module Test.Prelude.Fold ( - - test_fold, - test_foldAll, - test_foldSeg, - -) where - -import Prelude as P -import Data.List -import Data.Label -import Data.Maybe -import Data.Typeable -import Test.QuickCheck -import Test.Framework -import Test.Framework.Providers.QuickCheck2 -import Data.Array.Accelerate as A hiding ( Ord(..), indexHead, indexTail ) -import Data.Array.Accelerate.Type -import Data.Array.Accelerate.Array.Sugar as Sugar -import Data.Array.Accelerate.Examples.Internal as A -import qualified Data.Array.Accelerate as A - -import Config -import Test.Base -import System.Random -import QuickCheck.Arbitrary.Array - - - --- --- Reduction ------------------------------------------------------------------- --- - --- foldAll --- ------- - -test_foldAll :: Backend -> Config -> Test -test_foldAll backend opt = testGroup "foldAll" $ catMaybes - [ testElt configInt8 (undefined :: Int8) - , testElt configInt16 (undefined :: Int16) - , testElt configInt32 (undefined :: Int32) - , testElt configInt64 (undefined :: Int64) - , testElt configWord8 (undefined :: Word8) - , testElt configWord16 (undefined :: Word16) - , testElt configWord32 (undefined :: Word32) - , testElt configWord64 (undefined :: Word64) - , testElt configFloat (undefined :: Float) - , testElt configDouble (undefined :: Double) - ] - where - testElt :: forall e. (P.Num e, P.Ord e, A.Num e, A.Ord e, Similar e, Arbitrary e, Random e) => (Config :-> Bool) -> e -> Maybe Test - testElt ok _ - | P.not (get ok opt) = Nothing - | otherwise = Just $ testGroup (show (typeOf (undefined :: e))) - [ testDim dim0 - , testDim dim1 - , testDim dim2 - ] - where - testDim :: forall sh. (Shape sh, Arbitrary sh, Arbitrary (Array sh e)) => sh -> Test - testDim sh = testGroup ("DIM" P.++ show (rank sh)) - [ - testProperty "sum" (test_sum :: Array sh e -> Property) - , testProperty "non-neutral sum" (test_sum' :: Array sh e -> NonZero e -> Property) - , testProperty "non-commutative" (test_mss :: sh -> e -> Property) - , testProperty "minimum" (test_min :: Array sh e -> Property) - , testProperty "maximum" (test_max :: Array sh e -> Property) - ] - where - -- - -- The tests - -- - test_min :: Array sh e -> Property - test_min xs - = arraySize (arrayShape xs) > 0 - ==> run1 backend (A.fold1All A.min) xs ~?= fold1AllRef P.min xs - - test_max :: Array sh e -> Property - test_max xs - = arraySize (arrayShape xs) > 0 - ==> run1 backend (A.fold1All A.max) xs ~?= fold1AllRef P.max xs - - test_sum :: Array sh e -> Property - test_sum xs = run1 backend (A.foldAll (+) 0) xs ~?= foldAllRef (+) 0 xs - - test_sum' :: Array sh e -> NonZero e -> Property - test_sum' xs (NonZero z) = - runN backend (\z' -> A.foldAll (+) (the z')) (scalar z) xs - ~?= - foldAllRef (+) z xs - - test_mss :: sh -> e -> Property - test_mss (arraySize -> n) _ - = n > 0 - ==> forAll (arbitraryArrayOf (Z:.n) smallArbitrary) $ \(xs :: Vector e) -> - run1 backend maximumSegmentSum xs ~?= maximumSegmentSumRef xs - - --- multidimensional fold --- --------------------- - -test_fold :: Backend -> Config -> Test -test_fold backend opt = testGroup "fold" $ catMaybes - [ testElt configInt8 (undefined :: Int8) - , testElt configInt16 (undefined :: Int16) - , testElt configInt32 (undefined :: Int32) - , testElt configInt64 (undefined :: Int64) - , testElt configWord8 (undefined :: Word8) - , testElt configWord16 (undefined :: Word16) - , testElt configWord32 (undefined :: Word32) - , testElt configWord64 (undefined :: Word64) - , testElt configFloat (undefined :: Float) - , testElt configDouble (undefined :: Double) - ] - where - testElt :: forall e. (P.Num e, P.Ord e, A.Num e, A.Ord e, Similar e, Arbitrary e, Random e) => (Config :-> Bool) -> e -> Maybe Test - testElt ok _ - | P.not (get ok opt) = Nothing - | otherwise = Just $ testGroup (show (typeOf (undefined :: e))) - [ testDim dim1 - , testDim dim2 - ] - where - testDim :: forall sh. (Shape sh, P.Eq sh, Arbitrary (sh :. Int), Arbitrary (Array (sh:.Int) e)) => (sh:.Int) -> Test - testDim sh = testGroup ("DIM" P.++ show (rank sh)) - [ - testProperty "sum" (test_sum :: Array (sh :. Int) e -> Property) - , testProperty "non-neutral sum" (test_sum' :: Array (sh :. Int) e -> NonZero e -> Property) - , testProperty "non-commutative" (test_mss :: (sh :. Int) -> e -> Property) - , testProperty "minimum" (test_min :: Array (sh :. Int) e -> Property) - , testProperty "maximum" (test_max :: Array (sh :. Int) e -> Property) - ] - where - -- - -- The tests - -- - test_min :: Array (sh:.Int) e -> Property - test_min xs - = indexHead (arrayShape xs) > 0 - ==> run1 backend (A.fold1 A.min) xs ~?= fold1Ref P.min xs - - test_max :: Array (sh:.Int) e -> Property - test_max xs - = indexHead (arrayShape xs) > 0 - ==> run1 backend (A.fold1 A.max) xs ~?= fold1Ref P.max xs - - test_sum :: Array (sh:.Int) e -> Property - test_sum xs = run1 backend (A.fold (+) 0) xs ~?= foldRef (+) 0 xs - - test_sum' :: Array (sh:.Int) e -> NonZero e -> Property - test_sum' xs (NonZero z) = - runN backend (\z' -> A.fold (+) (the z')) (scalar z) xs ~?= foldRef (+) z xs - - test_mss :: (sh:.Int) -> e -> Property - test_mss sz _ - = indexHead sz > 0 - ==> forAll (arbitraryArrayOf sz smallArbitrary) $ \(xs :: Array (sh:.Int) e) -> - run1 backend maximumSegmentSum xs ~?= maximumSegmentSumRef xs - - --- segmented fold --- -------------- - -test_foldSeg :: Backend -> Config -> Test -test_foldSeg backend opt = testGroup "foldSeg" $ catMaybes - [ testElt configInt8 (undefined :: Int8) - , testElt configInt16 (undefined :: Int16) - , testElt configInt32 (undefined :: Int32) - , testElt configInt64 (undefined :: Int64) - , testElt configWord8 (undefined :: Word8) - , testElt configWord16 (undefined :: Word16) - , testElt configWord32 (undefined :: Word32) - , testElt configWord64 (undefined :: Word64) - , testElt configFloat (undefined :: Float) - , testElt configDouble (undefined :: Double) - ] - where - testElt :: forall e. (P.Num e, P.Ord e, A.Num e, A.Ord e, Similar e, Arbitrary e) => (Config :-> Bool) -> e -> Maybe Test - testElt ok _ - | P.not (get ok opt) = Nothing - | otherwise = Just $ testGroup (show (typeOf (undefined :: e))) - [ testDim dim1 - , testDim dim2 - ] - where - testDim :: forall sh. (Shape sh, P.Eq sh, Arbitrary sh) => (sh:.Int) -> Test - testDim sh = testGroup ("DIM" P.++ show (rank sh)) - [ - testProperty "sum" - $ forAllShrink arbitrarySegments shrinkSegments $ \(seg :: Segments Int32) -> - forAllShrink (arbitrarySegmentedArray seg) shrinkSegmentedArray $ \(xs :: Array (sh:.Int) e) -> - 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) -> - 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) -> - runN backend (A.fold1Seg A.min) xs seg ~?= fold1SegRef P.min xs seg - ] - - --- Reference implementation --- ------------------------ - -foldAllRef :: Elt e => (e -> e -> e) -> e -> Array sh e -> Array Z e -foldAllRef f z - = A.fromList Z - . return - . foldl' f z - . A.toList - -fold1AllRef :: Elt e => (e -> e -> e) -> Array sh e -> Array Z e -fold1AllRef f - = A.fromList Z - . return - . foldl1' f - . A.toList - -foldRef :: (Shape sh, Elt e) => (e -> e -> e) -> e -> Array (sh :. Int) e -> Array sh e -foldRef f z arr = - let (sh :. n) = arrayShape arr - sh' = listToShape . P.map (P.max 1) . shapeToList $ sh - in fromList sh' [ foldl' f z sub | sub <- splitEvery n (toList arr) ] - -fold1Ref :: (Shape sh, Elt e) => (e -> e -> e) -> Array (sh :. Int) e -> Array sh e -fold1Ref f arr = - let (sh :. n) = arrayShape arr - in fromList sh [ foldl1' f sub | sub <- splitEvery n (toList arr) ] - -foldSegRef :: (Shape sh, Elt e, P.Integral i) => (e -> e -> e) -> e -> Array (sh :. Int) e -> Segments i -> Array (sh :. Int) e -foldSegRef f z arr seg = fromList (sh :. sz) $ concat [ foldseg sub | sub <- splitEvery n (toList arr) ] - where - (sh :. n) = arrayShape arr - (Z :. sz) = arrayShape seg - seg' = toList seg - foldseg xs = P.map (foldl' f z) (splitPlaces seg' xs) - -fold1SegRef :: (Shape sh, Elt e, P.Integral i) => (e -> e -> e) -> Array (sh :. Int) e -> Segments i -> Array (sh :. Int) e -fold1SegRef f arr seg = fromList (sh :. sz) $ concat [ foldseg sub | sub <- splitEvery n (toList arr) ] - where - (sh :. n) = arrayShape arr - (Z :. sz) = arrayShape seg - seg' = toList seg - foldseg xs = P.map (foldl1' f) (splitPlaces seg' xs) - -maximumSegmentSum :: forall sh e. (Shape sh, A.Num e, A.Ord e) => Acc (Array (sh :. Int) e) -> Acc (Array sh e) -maximumSegmentSum - = A.map (\v -> let (x,_,_,_) = unlift v :: (Exp e, Exp e, Exp e, Exp e) in x) - . A.fold1 f - . A.map g - where - f :: (A.Num a, A.Ord a) => Exp (a,a,a,a) -> Exp (a,a,a,a) -> Exp (a,a,a,a) - f x y = - let (mssx, misx, mcsx, tsx) = unlift x - (mssy, misy, mcsy, tsy) = unlift y - in - lift ( mssx `A.max` (mssy `A.max` (mcsx+misy)) - , misx `A.max` (tsx+misy) - , mcsy `A.max` (mcsx+tsy) - , tsx+tsy - ) - - g :: (A.Num a, A.Ord a) => Exp a -> Exp (a,a,a,a) - g x = let y = A.max x 0 - in lift (y,y,y,x) - - -maximumSegmentSumRef :: (P.Num e, P.Ord e, Shape sh, Elt e) => Array (sh :. Int) e -> Array sh e -maximumSegmentSumRef arr = fromList sh [ go 0 0 sub | sub <- splitEvery n (toList arr) ] - where - sh :. n = arrayShape arr - -- - go _ v [] = v - go u v (x:xs) = - let u' = 0 `P.max` (u+x) - v' = v `P.max` u' - in - go u' v' xs - - -smallArbitrary :: forall e. (P.Num e, Elt e, Arbitrary e, Random e) => Gen e -smallArbitrary - | SingleTuple t <- eltType (undefined::e) - , NumScalarType s <- t - , IntegralNumType i <- s - = case i of - TypeInt{} -> choose (-100,100) - TypeInt8{} -> choose (-1,1) - TypeInt16{} -> choose (-10,10) - TypeInt32{} -> choose (-1000,1000) - TypeInt64{} -> choose (-10000,10000) - TypeWord{} -> choose (0,1000) - TypeWord8{} -> choose (0,1) - TypeWord16{} -> choose (0,10) - TypeWord32{} -> choose (0,1000) - TypeWord64{} -> choose (0,10000) - _ -> arbitrary - - | otherwise - = arbitrary - diff --git a/examples/nofib/Test/Prelude/Map.hs b/examples/nofib/Test/Prelude/Map.hs deleted file mode 100644 --- a/examples/nofib/Test/Prelude/Map.hs +++ /dev/null @@ -1,209 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} - -module Test.Prelude.Map ( - - test_map - -) where - -import Prelude as P -import Data.Bits as P -import Data.Label -import Data.Maybe -import Data.Typeable -import System.Random -import Test.QuickCheck hiding ( (.&.), suchThat ) -import Test.Framework -import Test.Framework.Providers.QuickCheck2 - -import Config -import Test.Base -import QuickCheck.Arbitrary.Array -import QuickCheck.Arbitrary.Shape -import Data.Array.Accelerate as A hiding ( Ord(..) ) -import Data.Array.Accelerate.Data.Bits as A -import Data.Array.Accelerate.Examples.Internal as A -import Data.Array.Accelerate.Array.Sugar as Sugar - --- --- Map ------------------------------------------------------------------------- --- - -test_map :: Backend -> Config -> Test -test_map backend opt = testGroup "map" $ catMaybes - [ testIntegralElt configInt8 (undefined :: Int8) - , testIntegralElt configInt16 (undefined :: Int16) - , testIntegralElt configInt32 (undefined :: Int32) - , testIntegralElt configInt64 (undefined :: Int64) - , testIntegralElt configWord8 (undefined :: Word8) - , testIntegralElt configWord16 (undefined :: Word16) - , testIntegralElt configWord32 (undefined :: Word32) - , testIntegralElt configWord64 (undefined :: Word64) - , testFloatingElt configFloat (undefined :: Float) - , testFloatingElt configDouble (undefined :: Double) - ] - where - testIntegralElt :: forall a. (P.Integral a, P.FiniteBits a, A.Integral a, A.FiniteBits a, Arbitrary a, Similar a, A.FromIntegral a Float) => (Config :-> Bool) -> a -> Maybe Test - testIntegralElt ok _ - | P.not (get ok opt) = Nothing - | otherwise = Just $ testGroup (show (typeOf (undefined :: a))) - [ testDim dim0 - , testDim dim1 - , testDim dim2 - ] - where - testDim :: forall sh. (Shape sh, P.Eq sh, Arbitrary (Array sh a)) => sh -> Test - testDim sh = testGroup ("DIM" P.++ show (rank sh)) - [ -- operators on Num - testProperty "neg" (test_negate :: Array sh a -> Property) - , testProperty "abs" (test_abs :: Array sh a -> Property) - , testProperty "signum" (test_signum :: Array sh a -> Property) - - -- operators on Integral & Bits - , testProperty "complement" (test_complement :: Array sh a -> Property) - , testProperty "popCount" (test_popCount :: Array sh a -> Property) - , testProperty "countLeadingZeros" (test_countLeadingZeros :: Array sh a -> Property) - , testProperty "countTrailingZeros" (test_countTrailingZeros :: Array sh a -> Property) - - -- conversions - , testProperty "fromIntegral" (test_fromIntegral :: Array sh a -> Property) - ] - where - test_fromIntegral xs = run1 backend (A.map A.fromIntegral) xs ~?= mapRef (P.fromIntegral :: a -> Float) xs - - testFloatingElt :: forall a. (P.Floating a, P.RealFloat a, A.Floating a, A.RealFloat a, Random a, Arbitrary a, Similar a) => (Config :-> Bool) -> a -> Maybe Test - testFloatingElt ok _ - | P.not (get ok opt) = Nothing - | otherwise = Just $ testGroup (show (typeOf (undefined :: a))) - [ testDim dim0 - , testDim dim1 - , testDim dim2 - ] - where - testDim :: forall sh. (Shape sh, P.Eq sh, Random a, Arbitrary sh, Arbitrary (Array sh a)) => sh -> Test - testDim _ = testGroup ("DIM" P.++ show (rank (undefined::sh))) - [ -- operators on Num - testProperty "neg" (test_negate :: Array sh a -> Property) - , testProperty "abs" (test_abs :: Array sh a -> Property) - , testProperty "signum" (test_signum :: Array sh a -> Property) - - -- operators on Fractional, Floating, RealFrac & RealFloat - , testProperty "recip" (test_recip :: Array sh a -> Property) - , testProperty "sin" (test_sin :: Array sh a -> Property) - , testProperty "cos" (test_cos :: Array sh a -> Property) - , testProperty "tan" (requiring (\x -> P.not (sin x ~= 1)) (test_tan :: Array sh a -> Property)) - , testProperty "asin" (forAll (sized arbitraryShape) $ \sh -> - forAll (arbitraryArrayOf sh (choose (-1,1))) $ \(xs :: Array sh a) -> test_asin xs) - , testProperty "acos" (forAll (sized arbitraryShape) $ \sh -> - forAll (arbitraryArrayOf sh (choose (-1,1))) $ \(xs :: Array sh a) -> test_acos xs) - , testProperty "atan" (test_atan :: Array sh a -> Property) - , testProperty "asinh" (test_asinh :: Array sh a -> Property) - , testProperty "acosh" (requiring (>= 1) (test_acosh :: Array sh a -> Property)) - , testProperty "atanh" (forAll (sized arbitraryShape) $ \sh -> - forAll (arbitraryArrayOf sh (choose (-1,1))) $ \(xs :: Array sh a) -> test_atanh xs) - , testProperty "exp" (test_exp :: Array sh a -> Property) - , testProperty "sqrt" (requiring (>= 0) (test_sqrt :: Array sh a -> Property)) - , testProperty "log" (requiring (> 0) (test_log :: Array sh a -> Property)) - , testProperty "truncate" (test_truncate :: Array sh a -> Property) - , testProperty "round" (test_round :: Array sh a -> Property) - , testProperty "floor" (test_floor :: Array sh a -> Property) - , testProperty "ceiling" (test_ceiling :: Array sh a -> Property) - ] - where - test_truncate xs = run1 backend (A.map A.truncate) xs ~?= mapRef (P.truncate :: a -> Int) xs - test_round xs = run1 backend (A.map A.round) xs ~?= mapRef (P.round :: a -> Int) xs - test_floor xs = run1 backend (A.map A.floor) xs ~?= mapRef (P.floor :: a -> Int) xs - test_ceiling xs = run1 backend (A.map A.ceiling) xs ~?= mapRef (P.ceiling :: a -> Int) xs - - test_negate xs = run1 backend (A.map negate) xs ~?= mapRef negate xs - test_abs xs = run1 backend (A.map abs) xs ~?= mapRef abs xs - test_signum xs = run1 backend (A.map signum) xs ~?= mapRef signum xs - - test_complement xs = run1 backend (A.map A.complement) xs ~?= mapRef P.complement xs - test_popCount xs = run1 backend (A.map A.popCount) xs ~?= mapRef P.popCount xs - test_countLeadingZeros xs = run1 backend (A.map A.countLeadingZeros) xs ~?= mapRef countLeadingZerosRef xs - test_countTrailingZeros xs = run1 backend (A.map A.countTrailingZeros) xs ~?= mapRef countTrailingZerosRef xs - - test_recip xs = run1 backend (A.map recip) xs ~?= mapRef recip xs - test_sin xs = run1 backend (A.map sin) xs ~?= mapRef sin xs - test_cos xs = run1 backend (A.map cos) xs ~?= mapRef cos xs - test_tan xs = run1 backend (A.map tan) xs ~?= mapRef tan xs - test_asin xs = run1 backend (A.map asin) xs ~?= mapRef asin xs - test_acos xs = run1 backend (A.map acos) xs ~?= mapRef acos xs - test_atan xs = run1 backend (A.map atan) xs ~?= mapRef atan xs - test_asinh xs = run1 backend (A.map asinh) xs ~?= mapRef asinh xs - test_acosh xs = run1 backend (A.map acosh) xs ~?= mapRef acosh xs - test_atanh xs = run1 backend (A.map atanh) xs ~?= mapRef atanh xs - test_exp xs = run1 backend (A.map exp) xs ~?= mapRef exp xs - test_sqrt xs = run1 backend (A.map sqrt) xs ~?= mapRef sqrt xs - test_log xs = run1 backend (A.map log) xs ~?= mapRef log xs - - -suchThat :: Gen a -> (a -> Bool) -> Gen a -suchThat gen p = do - x <- gen - case p x of - True -> return x - False -> sized $ \n -> resize (n+1) (suchThat gen p) - - -{-# INLINE requiring #-} -requiring - :: (Elt e, Shape sh, Arbitrary e, Arbitrary sh, Testable prop) - => (e -> Bool) - -> (Array sh e -> prop) - -> Property -requiring f go = - let - shrinkRequiring arr = [ fromList (Sugar.shape arr) sl | sl <- shrinkOneRequiring (toList arr) ] - shrinkOneRequiring [] = [] - shrinkOneRequiring (x:xs) = [ x':xs | x' <- shrink x, f x' ] - P.++ [ x:xs' | xs' <- shrinkOneRequiring xs ] - in - forAllShrink arbitrary shrink $ \sh -> - forAllShrink (arbitraryArrayOf sh (arbitrary `suchThat` f)) shrinkRequiring $ \arr -> - go arr - - --- Reference Implementation --- ------------------------ - -mapRef :: (Shape sh, Elt b) => (a -> b) -> Array sh a -> Array sh b -mapRef f xs - = fromList (arrayShape xs) - $ P.map f - $ toList xs - -countLeadingZerosRef :: P.FiniteBits a => a -> Int -#if __GLASGOW_HASKELL__ >= 710 -countLeadingZerosRef = P.countLeadingZeros -#else -countLeadingZerosRef = clz - where - clz x = (w-1) - go (w-1) - where - go i | i < 0 = i -- no bit set - | P.testBit x i = i - | otherwise = go (i-1) - w = P.finiteBitSize x -#endif - -countTrailingZerosRef :: P.FiniteBits a => a -> Int -#if __GLASGOW_HASKELL__ >= 710 -countTrailingZerosRef = P.countTrailingZeros -#else -countTrailingZerosRef = ctz - where - ctz x = go 0 - where - go i | i >= w = i - | P.testBit x i = i - | otherwise = go (i+1) - w = P.finiteBitSize x -#endif - diff --git a/examples/nofib/Test/Prelude/Permute.hs b/examples/nofib/Test/Prelude/Permute.hs deleted file mode 100644 --- a/examples/nofib/Test/Prelude/Permute.hs +++ /dev/null @@ -1,171 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} - -module Test.Prelude.Permute ( - - test_permute - -) where - -import Prelude as P -import Data.Label -import Data.Maybe -import Data.Typeable -import Control.Monad -import Test.QuickCheck -import Test.Framework -import Test.Framework.Providers.QuickCheck2 - -import Config -import Test.Base -import QuickCheck.Arbitrary.Array - -import Data.Array.Accelerate as A -import Data.Array.Accelerate.IO as A -import Data.Array.Accelerate.Array.Sugar ( rank ) -import Data.Array.Accelerate.Examples.Internal as A - -import Data.Array.ST ( runSTArray ) -import Data.Array.Unboxed ( IArray, UArray ) -import qualified Data.Array.Unboxed as IArray -import qualified Data.Array.MArray as M - - --- --- Forward permutation --------------------------------------------------------- --- - -test_permute :: Backend -> Config -> Test -test_permute backend opt = testGroup "permute" $ catMaybes - [ testIntegralElt configInt8 (undefined :: Int8) - , testIntegralElt configInt16 (undefined :: Int16) - , testIntegralElt configInt32 (undefined :: Int32) - , testIntegralElt configInt64 (undefined :: Int64) - , testIntegralElt configWord8 (undefined :: Word8) - , testIntegralElt configWord16 (undefined :: Word16) - , testIntegralElt configWord32 (undefined :: Word32) - , testIntegralElt configWord64 (undefined :: Word64) - , testFloatingElt configFloat (undefined :: Float) - , testFloatingElt configDouble (undefined :: Double) - ] - where - testIntegralElt :: forall e. (P.Integral e, A.Integral e, A.FromIntegral e Int, Arbitrary e, Similar e, IArray UArray e) => (Config :-> Bool) -> e -> Maybe Test - testIntegralElt ok _ - | P.not (get ok opt) = Nothing - | otherwise = Just $ testGroup (show (typeOf (undefined :: e))) - [ - test_fill (undefined :: e) - , testProperty "scatter" (test_scatter :: e -> Property) - -- , testProperty "scatterIf" (test_scatterIf :: e -> Property) - , testProperty "histogram" (test_histogram A.fromIntegral P.fromIntegral :: Vector e -> Property) - ] - - testFloatingElt :: forall e. (P.RealFrac e, A.RealFrac e, Arbitrary e, Similar e, IArray UArray e) => (Config :-> Bool) -> e -> Maybe Test - testFloatingElt ok _ - | P.not (get ok opt) = Nothing - | otherwise = Just $ testGroup (show (typeOf (undefined :: e))) - [ - test_fill (undefined :: e) - , testProperty "scatter" (test_scatter :: e -> Property) - -- , testProperty "scatterIf" (test_scatterIf :: e -> Property) - , testProperty "histogram" (test_histogram A.floor P.floor :: Vector e -> Property) - ] - - -- Test is permutation works by just copying elements directly from one - -- array to the other. Does not attempt to use elements from the defaults - -- array. Additionally, works for any dimension. (c.f. Issue #93) - -- - test_fill :: forall e. (P.Num e, A.Num e, Arbitrary e, Similar e) => e -> Test - test_fill _ = testGroup "fill" - [ -- testDim dim0 -- Accelerate issue #87 - testDim dim1 - , testDim dim2 - ] - where - testDim :: forall sh. (Shape sh, P.Eq sh, Arbitrary (Array sh e)) => sh -> Test - testDim sh = testProperty ("DIM" P.++ show (rank sh)) (push_fill :: Array sh e -> Property) - where - push_fill :: Array sh e -> Property - push_fill xs = run1 backend go xs ~?= xs - where - go arr = permute const (A.fill (A.shape arr) (constant 0)) id arr - - -- Test if the combining operation for forward permutation works, by - -- building a histogram. Often tricky for parallel backends. - -- - 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) -> - 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 = - let zeros = A.fill (index1 $ the n) 0 - ones = A.fill (shape xs) 1 - in - permute (+) zeros (\ix -> index1 $ f (xs A.! ix) `mod` the n) ones - - histogramRef :: forall e. (Elt e, P.Num e, IArray UArray e) => Int -> (e -> Int) -> Vector e -> Vector e - histogramRef n f xs = - let arr :: IArray.UArray Int e - arr = IArray.accumArray (+) 0 (0, n-1) [ (f e `mod` n, 1) | e <- toList xs ] - in - fromIArray arr - - -- Test for scattering functions - -- - test_scatter :: forall e. (Elt e, Similar e, Arbitrary e) => e -> Property - test_scatter _ = - forAll (sized $ \n -> choose (0,n)) $ \k -> let m = 2*k in - 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 (runN backend A.scatter mapV defaultV inputV) - ~?= - IArray.elems (scatterRef (toIArray mapV) (toIArray defaultV) (toIArray inputV)) - - -- test_scatterIf :: forall e. (Elt e, Similar e, Arbitrary e) => e -> Property - -- test_scatterIf _ = - -- forAll (sized $ \n -> choose (0,n)) $ \k -> let m = 2*k in - -- forAll (arbitraryArray (Z:.m+1)) $ \defaultV -> - -- 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 (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)) - - - --- Reference Implementation --- ------------------------ - -scatterRef - :: IArray.UArray Int Int - -> IArray.Array Int e - -> IArray.Array Int e - -> IArray.Array Int e -scatterRef mapV defaultV inputV - = runSTArray - $ do mu <- M.thaw defaultV - forM_ (IArray.assocs mapV) $ \(inIx, outIx) -> M.writeArray mu outIx (inputV IArray.! inIx) - return mu - --- scatterIfRef --- :: IArray.UArray Int Int --- -> IArray.Array Int e --- -> (e -> Bool) --- -> IArray.Array Int t --- -> IArray.Array Int t --- -> IArray.Array Int t --- scatterIfRef mapV maskV f defaultV inputV --- = runSTArray --- $ do mu <- M.thaw defaultV --- forM_ (IArray.assocs mapV) $ \(inIx, outIx) -> --- when (f (maskV IArray.! inIx)) $ --- M.writeArray mu outIx (inputV IArray.! inIx) --- return mu - diff --git a/examples/nofib/Test/Prelude/Replicate.hs b/examples/nofib/Test/Prelude/Replicate.hs deleted file mode 100644 --- a/examples/nofib/Test/Prelude/Replicate.hs +++ /dev/null @@ -1,135 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} - -module Test.Prelude.Replicate ( - - test_replicate, - -) where - -import Config -import Test.Framework - -import Prelude as P -import Data.Array.Accelerate as A -import Data.Array.Accelerate.IO as A -import Data.Array.Accelerate.Examples.Internal as A -import Data.Array.Unboxed as IArray hiding ( Array ) -import Data.Label -import Data.Maybe -import Data.Typeable -import Test.HUnit hiding ( Test ) - - --- --- Slice ----------------------------------------------------------------------- --- - -test_replicate :: Backend -> Config -> Test -test_replicate backend opt = testGroup "replicate" $ catMaybes - [ testElt configInt8 (undefined :: Int8) - , testElt configInt16 (undefined :: Int16) - , testElt configInt32 (undefined :: Int32) - , testElt configInt64 (undefined :: Int64) - , testElt configWord8 (undefined :: Word8) - , testElt configWord16 (undefined :: Word16) - , testElt configWord32 (undefined :: Word32) - , testElt configWord64 (undefined :: Word64) - , testElt configFloat (undefined :: Float) - , testElt configDouble (undefined :: Double) - ] - where - testElt :: forall e. (P.Num e, A.Num e, P.Eq e, IArray UArray e) => (Config :-> Bool) -> e -> Maybe Test - testElt ok _ - | P.not (get ok opt) = Nothing - | otherwise = Just $ testGroup (show (typeOf (undefined :: e))) - [ - testCase "(Z:.2:.All:.All)" $ ref1 @=? run' test1 - , testCase "(Z:.All:.2:.All)" $ ref2 @=? run' test2 - , testCase "(Z:.All:.All:.2)" $ ref3 @=? run' test3 - , testCase "(Any:.2)" $ ref4 @=? run' test4 - ] - - where - arr :: Acc (Array DIM2 e) - arr = use $ fromList (Z:.2:.2) [1,2,3,4] - - run' = toIArray . run backend - - -- Replicate into z-axis - -- should produce [1,2,3,4,1,2,3,4] - test1 :: Acc (Array DIM3 e) - test1 = A.replicate slice1 arr - - slice1 :: Exp (Z:.Int:.All:.All) - slice1 = lift $ Z:.(2::Int):.All:.All - - ref1 :: UArray (Int,Int,Int) e - ref1 = array ((0,0,0),(1,1,1)) [ ((0,0,0), 1) - , ((0,0,1), 2) - , ((0,1,0), 3) - , ((0,1,1), 4) - , ((1,0,0), 1) - , ((1,0,1), 2) - , ((1,1,0), 3) - , ((1,1,1), 4) ] - - -- Replicate into y-axis - -- should produce [1,2,1,2,3,4,3,4] - test2 :: Acc (Array DIM3 e) - test2 = A.replicate slice2 arr - - slice2 :: Exp (Z:.All:.Int:.All) - slice2 = lift $ Z:.All:.(2::Int):.All - - ref2 :: UArray (Int,Int,Int) e - ref2 = array ((0,0,0),(1,1,1)) [ ((0,0,0), 1) - , ((0,0,1), 2) - , ((0,1,0), 1) - , ((0,1,1), 2) - , ((1,0,0), 3) - , ((1,0,1), 4) - , ((1,1,0), 3) - , ((1,1,1), 4) ] - - -- Replicate into x-axis - -- should produce [1,1,2,2,3,3,4,4] - test3 :: Acc (Array DIM3 e) - test3 = A.replicate slice3 arr - - slice3 :: Exp (Z:.All:.All:.Int) - slice3 = lift $ Z:.All:.All:.(2::Int) - - ref3 :: UArray (Int,Int,Int) e - ref3 = array ((0,0,0),(1,1,1)) [ ((0,0,0), 1) - , ((0,0,1), 1) - , ((0,1,0), 2) - , ((0,1,1), 2) - , ((1,0,0), 3) - , ((1,0,1), 3) - , ((1,1,0), 4) - , ((1,1,1), 4) ] - - -- Replicates an array into the rightmost dimension of the result array. - -- - repN :: forall sh a. (Shape sh, Elt a) - => Int - -> Acc (Array sh a) - -> Acc (Array (sh:.Int) a) - repN n a = A.replicate (lift (Any:.n :: Any sh:.Int)) a - - test4 :: Acc (Array DIM3 e) - test4 = repN 2 arr - - ref4 :: UArray (Int,Int,Int) e - ref4 = array ((0,0,0),(1,1,1)) [ ((0,0,0), 1) - , ((0,0,1), 1) - , ((0,1,0), 2) - , ((0,1,1), 2) - , ((1,0,0), 3) - , ((1,0,1), 3) - , ((1,1,0), 4) - , ((1,1,1), 4) ] - diff --git a/examples/nofib/Test/Prelude/Scan.hs b/examples/nofib/Test/Prelude/Scan.hs deleted file mode 100644 --- a/examples/nofib/Test/Prelude/Scan.hs +++ /dev/null @@ -1,358 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} - -module Test.Prelude.Scan ( - - test_scan, - -) where - -import Prelude as P -import Test.QuickCheck -import Data.Label -import Data.Maybe -import Data.Typeable -import Test.Framework -import Test.Framework.Providers.QuickCheck2 - -import Config -import Test.Base -import QuickCheck.Arbitrary.Array -import QuickCheck.Arbitrary.Shape () -import Data.Array.Accelerate as A hiding ( Ord(..) ) -import Data.Array.Accelerate.Examples.Internal as A -import Data.Array.Accelerate.Array.Sugar as Sugar -import qualified Data.Array.Accelerate as A - - --- --- scan ------------------------------------------------------------------------ --- - -test_scan :: Backend -> Config -> Test -test_scan backend opt = testGroup "scan" $ catMaybes - [ testElt configInt8 (undefined :: Int8) - , testElt configInt16 (undefined :: Int16) - , testElt configInt32 (undefined :: Int32) - , testElt configInt64 (undefined :: Int64) - , testElt configWord8 (undefined :: Word8) - , testElt configWord16 (undefined :: Word16) - , testElt configWord32 (undefined :: Word32) - , testElt configWord64 (undefined :: Word64) - , testElt configFloat (undefined :: Float) - , testElt configDouble (undefined :: Double) - ] - where - testElt :: forall e. (P.Num e, P.Ord e, A.Num e, A.Ord e, P.Enum e, Similar e, Arbitrary e) => (Config :-> Bool) -> e -> Maybe Test - testElt ok _ - | P.not (get ok opt) = Nothing - | otherwise = Just $ testGroup (show (typeOf (undefined :: e))) - [ testDim dim1 - , testDim dim2 - ] - where - testDim :: forall sh. (Shape sh, Slice sh, P.Eq sh, Arbitrary sh, Arbitrary (Array (sh:.Int) e)) => sh:.Int -> Test - testDim _sh = testGroup ("DIM" P.++ show (rank _sh)) - [ testGroup "scanl" - [ testProperty "sum" (test_scanl :: Array (sh:.Int) e -> Property) - , testProperty "interval" (intv_scanl :: sh -> NonNegative Int -> Property) - ] - , testGroup "scanl'" - [ testProperty "sum" (test_scanl' :: Array (sh:.Int) e -> Property) - , testProperty "interval" (intv_scanl' :: sh -> NonNegative Int -> Property) - ] - , testGroup "scanl1" - [ testProperty "sum" (test_scanl1 :: Array (sh:.Int) e -> Property) - , testProperty "interval" (intv_scanl1 :: sh -> Positive Int -> Property) - ] - , testGroup "scanr" - [ testProperty "sum" (test_scanr :: Array (sh:.Int) e -> Property) - , testProperty "interval" (intv_scanr :: sh -> NonNegative Int -> Property) - ] - , testGroup "scanr'" - [ testProperty "sum" (test_scanr' :: Array (sh:.Int) e -> Property) - , testProperty "interval" (intv_scanr' :: sh -> NonNegative Int -> Property) - ] - , testGroup "scanr1" - [ testProperty "sum" (test_scanr1 :: Array (sh:.Int) e -> Property) - , testProperty "interval" (intv_scanr1 :: sh -> Positive Int -> Property) - ] - -- - , testProperty "scanl1Seg" (test_scanl1seg (undefined::Array (sh:.Int) e)) - , testProperty "scanr1Seg" (test_scanr1seg (undefined::Array (sh:.Int) e)) - , testProperty "scanlSeg" (test_scanlseg (undefined::Array (sh:.Int) e)) - , testProperty "scanrSeg" (test_scanrseg (undefined::Array (sh:.Int) e)) - , testProperty "scanl'Seg" (test_scanl'seg (undefined::Array (sh:.Int) e)) - , testProperty "scanr'Seg" (test_scanr'seg (undefined::Array (sh:.Int) e)) - ] - where - -- left scan - -- - test_scanl xs = (run1 backend (A.scanl (+) 0)) xs ~?= scanlRef (+) 0 xs - test_scanl' xs = (run1 backend (A.lift . A.scanl' (+) 0)) xs ~?= scanl'Ref (+) 0 xs - test_scanl1 xs = - arraySize (arrayShape xs) > 0 ==> - (run1 backend (A.scanl1 A.min)) xs ~?= scanl1Ref P.min xs - - intv_scanl sh (NonNegative sz) = - let xs = intervalArray sh sz - in (run1 backend (A.scanl iappend' (constant one))) xs ~?= scanlRef iappend one xs - - intv_scanl' sh (NonNegative sz) = - let xs = intervalArray sh sz - in (run1 backend (A.lift . A.scanl' iappend' (constant one))) xs ~?= scanl'Ref iappend one xs - - intv_scanl1 sh (Positive sz) = - arraySize sh > 0 ==> - let xs = intervalArray sh sz - in (run1 backend (A.scanl1 iappend')) xs ~?= scanl1Ref iappend xs - - -- right scan - -- - test_scanr xs = run1 backend (A.scanr (+) 0) xs ~?= scanrRef (+) 0 xs - test_scanr' xs = run1 backend (A.lift . A.scanr' (+) 0) xs ~?= scanr'Ref (+) 0 xs - test_scanr1 xs = - arraySize (arrayShape xs) > 0 ==> - (run1 backend (A.scanr1 A.max)) xs ~?= scanr1Ref P.max xs - - intv_scanr sh (NonNegative sz) = - let xs = intervalArray sh sz - in (run1 backend (A.scanr iappend' (constant one))) xs ~?= scanrRef iappend one xs - - intv_scanr' sh (NonNegative sz) = - let xs = intervalArray sh sz - in (run1 backend (A.lift . A.scanr' iappend' (constant one))) xs ~?= scanr'Ref iappend one xs - - intv_scanr1 sh (Positive sz) = - arraySize sh > 0 ==> - let xs = intervalArray sh sz - in (run1 backend (A.scanr1 iappend')) xs ~?= scanr1Ref iappend xs - - -- segmented left/right scan - -- - test_scanl1seg elt = - forAllShrink arbitrarySegments1 shrinkSegments1 $ \(seg :: Vector Int32) -> - forAllShrink (arbitrarySegmentedArray seg) shrinkSegmentedArray $ \xs -> - arraySize (arrayShape xs) > 0 ==> - (runN backend (A.scanl1Seg (+))) xs seg - ~?= - scanl1SegRef (+) (xs `asTypeOf` elt) seg - - test_scanr1seg elt = - forAllShrink arbitrarySegments1 shrinkSegments1 $ \(seg :: Vector Int32) -> - forAllShrink (arbitrarySegmentedArray seg) shrinkSegmentedArray $ \xs -> - arraySize (arrayShape xs) > 0 ==> - (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 -> - (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 -> - (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 -> - (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 -> - (runN backend (A.scanr'Seg (+) 0)) xs seg - ~?= - scanr'SegRef (+) 0 (xs `asTypeOf` elt) seg - - -- interval of summations monoid - -- - one,top :: (e,e) - one = (-1,-1) - top = (-2,-2) - - iappend :: (e,e) -> (e,e) -> (e,e) - iappend x y - | x P.== one = y - | y P.== one = x - | x P.== top P.|| y P.== top = top - iappend (x1,x2) (y1,y2) - | x2 + 1 P.== y1 = (x1,y2) - | otherwise = top - - iappend' :: Exp (e,e) -> Exp (e,e) -> Exp (e,e) - iappend' x y - = x A.== constant one ? ( y - , y A.== constant one ? ( x - , x A.== constant top ? ( constant top -- A.|| y A.== constant top; see AccelerateHS/accelerate#364 - , let - (x1,x2) = unlift x :: (Exp e, Exp e) - (y1,y2) = unlift y :: (Exp e, Exp e) - in - x2 + 1 A.== y1 ? ( lift (x1,y2) , constant top ) - ))) - - intervalArray :: sh -> Int -> Array (sh:.Int) (e,e) - intervalArray sh n = fromList (sh:.n) - . concat - $ P.replicate (Sugar.size sh) [ (i,i) | i <- [0.. (P.fromIntegral n-1)] ] - - --- Reference implementation --- ------------------------ - -scanlRef :: (Shape sh, Elt e) => (e -> e -> e) -> e -> Array (sh:.Int) e -> Array (sh:.Int) e -scanlRef f z arr = - let sz :. n = arrayShape arr - arr' = [ P.scanl f z sub | sub <- splitEvery n (toList arr) ] - in - A.fromList (sz :. n+1) (concat arr') - -scanl'Ref :: (Shape sh, Elt e) => (e -> e -> e) -> e -> Array (sh:.Int) e -> (Array (sh:.Int) e, Array sh e) -scanl'Ref f z arr = - let sz :. n = arrayShape arr - (arr',sums) = P.unzip [ P.splitAt n (P.scanl f z sub) | sub <- splitEvery n (toList arr) ] - in - ( A.fromList (sz:.n) (concat arr'), A.fromList sz (concat sums) ) - -scanl1Ref :: (Shape sh, Elt e) => (e -> e -> e) -> Array (sh:.Int) e -> Array (sh:.Int) e -scanl1Ref f arr = - let sz :. n = arrayShape arr - arr' = [ P.scanl1 f sub | sub <- splitEvery n (toList arr) ] - in - A.fromList (sz:.n) (concat arr') - -scanrRef :: (Shape sh, Elt e) => (e -> e -> e) -> e -> Array (sh:.Int) e -> Array (sh:.Int) e -scanrRef f z arr = - let sz :. n = arrayShape arr - arr' = [ P.scanr f z sub | sub <- splitEvery n (toList arr) ] - in - A.fromList (sz :. n+1) (concat arr') - -scanr'Ref :: (Shape sh, Elt e) => (e -> e -> e) -> e -> Array (sh:.Int) e -> (Array (sh:.Int) e, Array sh e) -scanr'Ref f z arr = - let sz :. n = arrayShape arr - (sums,arr') = P.unzip [ P.splitAt 1 (P.scanr f z sub) | sub <- splitEvery n (toList arr) ] - in - ( A.fromList (sz:.n) (concat arr'), A.fromList sz (concat sums) ) - -scanr1Ref :: (Shape sh, Elt e) => (e -> e -> e) -> Array (sh:.Int) e -> Array (sh:.Int) e -scanr1Ref f arr = - let sz :. n = arrayShape arr - arr' = [ P.scanr1 f sub | sub <- splitEvery n (toList arr) ] - in - A.fromList (sz:.n) (concat arr') - - --- segmented operations --- -scanlSegRef - :: (Shape sh, Elt e, P.Integral i) - => (e -> e -> e) - -> e - -> Array (sh:.Int) e - -> Segments i - -> Array (sh:.Int) e -scanlSegRef f z arr seg = - let - sz :. n = arrayShape arr - seg' = toList seg - n' = P.sum $ P.map (\x -> P.fromIntegral x + 1) seg' - arr' = [ P.scanl f z sec | sub <- splitEvery n (toList arr) - , sec <- splitPlaces seg' sub ] - in - A.fromList (sz:.n') (concat arr') - -scanl1SegRef - :: (Shape sh, Elt e, P.Integral i) - => (e -> e -> e) - -> Array (sh:.Int) e - -> Segments i - -> Array (sh:.Int) e -scanl1SegRef f arr seg = - let - sz :. n = arrayShape arr - seg' = toList seg - n' = P.fromIntegral (P.sum seg') - arr' = [ P.scanl1 f sec | sub <- splitEvery n (toList arr) - , sec <- splitPlaces seg' sub ] - in - A.fromList (sz:.n') (concat arr') - -scanl'SegRef - :: (Shape sh, Elt e, P.Integral i) - => (e -> e -> e) - -> e - -> Array (sh:.Int) e - -> Segments i - -> (Array (sh:.Int) e, Array (sh:.Int) e) -scanl'SegRef f z arr seg = - let - sz :. n = arrayShape arr - Z :. s = arrayShape seg - scanl'_ v = P.splitAt (P.length v) (P.scanl f z v) - (arr',sums) = P.unzip [ scanl'_ sec | sub <- splitEvery n (toList arr) - , sec <- splitPlaces (toList seg) sub ] - in - ( A.fromList (sz:.n) (concat arr'), A.fromList (sz:.s) (concat sums) ) - -scanrSegRef - :: (Shape sh, Elt e, P.Integral i) - => (e -> e -> e) - -> e - -> Array (sh:.Int) e - -> Segments i - -> Array (sh:.Int) e -scanrSegRef f z arr seg = - let - sz :. n = arrayShape arr - seg' = toList seg - n' = P.sum $ P.map (\x -> P.fromIntegral x + 1) seg' - arr' = [ P.scanr f z sec | sub <- splitEvery n (toList arr) - , sec <- splitPlaces seg' sub ] - in - A.fromList (sz:.n') (concat arr') - -scanr1SegRef - :: (Shape sh, Elt e, P.Integral i) - => (e -> e -> e) - -> Array (sh:.Int) e - -> Segments i - -> Array (sh:.Int) e -scanr1SegRef f arr seg = - let sz :. n = arrayShape arr - seg' = toList seg - n' = P.fromIntegral (P.sum seg') - arr' = [ P.scanr1 f sec | sub <- splitEvery n (toList arr) - , sec <- splitPlaces seg' sub ] - in - A.fromList (sz:.n') (concat arr') - -scanr'SegRef - :: (Shape sh, Elt e, P.Integral i) - => (e -> e -> e) - -> e - -> Array (sh:.Int) e - -> Segments i - -> (Array (sh:.Int) e, Array (sh:.Int) e) -scanr'SegRef f z arr seg = - let - sz :. n = arrayShape arr - Z :. s = arrayShape seg - (sums, arr') = P.unzip [ P.splitAt 1 (P.scanr f z sec) | sub <- splitEvery n (toList arr) - , sec <- splitPlaces (toList seg) sub ] - in - ( A.fromList (sz:.n) (concat arr'), A.fromList (sz:.s) (concat sums) ) - diff --git a/examples/nofib/Test/Prelude/Stencil.hs b/examples/nofib/Test/Prelude/Stencil.hs deleted file mode 100644 --- a/examples/nofib/Test/Prelude/Stencil.hs +++ /dev/null @@ -1,223 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} -{-# OPTIONS_GHC -fno-warn-name-shadowing #-} - -module Test.Prelude.Stencil ( - - test_stencil, - -) where - -import Prelude as P -import Data.Label -import Data.Maybe -import Data.Typeable -import Test.QuickCheck ( Arbitrary ) -import Test.HUnit ( (@?=) ) -import Test.Framework -import Test.Framework.Providers.QuickCheck2 -import Test.Framework.Providers.HUnit - -import Config -import QuickCheck.Arbitrary.Array () - -import Data.Array.Accelerate as A -import Data.Array.Accelerate.IO as A -import Data.Array.Accelerate.Examples.Internal as A -import Data.Array.Unboxed as IArray hiding ( Array ) -import qualified Data.Array.IArray as IArray - - --- TODO: --- --- * Tests for boundary conditions: Mirror and Wrap --- * Higher dimensional stencils --- - --- --- Stencil --------------------------------------------------------------------- --- - -test_stencil :: Backend -> Config -> Test -test_stencil backend opt = testGroup "stencil" $ catMaybes - [ testElt configInt8 (undefined :: Int8) - , testElt configInt16 (undefined :: Int16) - , testElt configInt32 (undefined :: Int32) - , testElt configInt64 (undefined :: Int64) - , testElt configWord8 (undefined :: Word8) - , testElt configWord16 (undefined :: Word16) - , testElt configWord32 (undefined :: Word32) - , testElt configWord64 (undefined :: Word64) - , testElt configFloat (undefined :: Float) - , testElt configDouble (undefined :: Double) - , testBoundary - ] - where - testElt :: forall a. (P.Num a, A.Num a, Similar a, Arbitrary a, IArray UArray a) - => (Config :-> Bool) - -> a - -> Maybe Test - testElt ok _ - | P.not (get ok opt) = Nothing - | otherwise = Just $ testGroup (show (typeOf (undefined :: a))) - [ testProperty "1D" (test_stencil1D :: Array DIM1 a -> Property) - , testProperty "2D 3x3 dense" (test_stencil2D1 :: Array DIM2 a -> Property) - , testProperty "2D 3x3 cross" (test_stencil2D2 :: Array DIM2 a -> Property) - , testProperty "2D non-symmetric" (test_stencil2D3 :: Array DIM2 (a,a) -> Property) - ] - - -- 1D Stencil - -- - test_stencil1D :: (P.Num a, A.Num a, Similar a, IArray UArray a) => Vector a -> Property - test_stencil1D vec = toList (acc vec) ~?= elems (ref (toIArray vec)) - where - pattern (x,y,z) = x + z - 2 * y - - acc xs = run1 backend (stencil pattern clamp) xs - - ref :: (P.Num e, IArray UArray e) => UArray Int e -> UArray Int e - ref xs = - let (minx,maxx) = bounds xs - clamp x = Right (minx `P.max` x `P.min` maxx) - in - stencil1DRef pattern clamp xs - - -- 2D Stencil - -- - test_stencil2D1 :: (P.Num a, A.Num a, Similar a, IArray UArray a) => Array DIM2 a -> Property - test_stencil2D1 vec = toList (acc vec) ~?= elems (ref (toIArray vec)) - where - pattern ( (t1, t2, t3) - , (l , m, r ) - , (b1, b2, b3) - ) - = (t1 + t2 + t3 - l + 4*m - r - b1 - b2 - b3) - - 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 = - let - sh = bounds xs - constant ix - | inRange sh ix = Right ix - | otherwise = Left 0 - - in - stencil2DRef pattern constant xs - - - test_stencil2D2 :: (P.Num a, A.Num a, Similar a, IArray UArray a) => Array DIM2 a -> Property - test_stencil2D2 vec = toList (acc vec) ~?= elems (ref (toIArray vec)) - where - pattern ( (_, t, _) - , (l, m, r) - , (_, b, _) - ) - = (t + l + r + b - 4 * m) - - acc xs = - let pattern' :: A.Num a => Stencil3x3 a -> Exp a - pattern' = pattern - in - run1 backend (stencil pattern' clamp) xs - - ref :: (P.Num a, IArray UArray a) => UArray (Int,Int) a -> UArray (Int,Int) a - ref xs = - let ((minu,minv),(maxu,maxv)) = bounds xs - clamp (u,v) = Right (minu `P.max` u `P.min` maxu - ,minv `P.max` v `P.min` maxv) - in - stencil2DRef pattern clamp xs - - test_stencil2D3 :: (P.Num a, A.Num a, Similar a) => Array DIM2 (a,a) -> Property - test_stencil2D3 vec = toList (acc vec) ~?= elems (ref (toIArray vec)) - where - pattern :: forall a. A.Num a => Stencil3x3 (a,a) -> Exp a - pattern ( (_, _, _) , (x, _, _) , (y, _, z)) - = let (x1,x2) = unlift x - (y1,y2) = unlift y - (z1,z2) = unlift z - in - x1 - y2 + y1 - z2 + z1 - x2 - - pattern' ( (_, _, _) , (x, _, _) , (y, _, z)) - = let (x1,x2) = x - (y1,y2) = y - (z1,z2) = z - in - x1 - y2 + y1 - z2 + z1 - x2 - - 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 = - let - sh = bounds xs - constant ix - | inRange sh ix = Right ix - | otherwise = Left (0,0) - in - stencil2DRef pattern' constant xs - - -- If the constant boundary is not properly implemented, - -- then this will lead to a segmentation fault. - testBoundary :: Maybe Test - testBoundary = Just . testCase "boundary segfault" $ do - let f ((x,_,_,_,_),_,_,_,_) = x - 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 - --- --- Reference implementation --- -stencil1DRef - :: (IArray array a, IArray array b) - => ((a,a,a) -> b) - -> (Int -> Either a Int) - -> array Int a - -> array Int b -stencil1DRef pattern boundary xs = - let - indexAt ix = case boundary ix of - Left e -> e - Right ix' -> xs IArray.! ix' - - f ix = let x = indexAt (ix-1) - y = indexAt ix - z = indexAt (ix+1) - in - pattern (x,y,z) - in - array (bounds xs) [(ix, f ix) | ix <- indices xs] - - -stencil2DRef :: (IArray array a, IArray array b) - => (((a,a,a), (a,a,a), (a,a,a)) -> b) - -> ((Int,Int) -> Either a (Int,Int)) - -> array (Int,Int) a - -> array (Int,Int) b -stencil2DRef pattern boundary xs = - let - indexAt ix = case boundary ix of - Left e -> e - Right ix' -> xs IArray.! ix' - - f (y,x) = let t1 = indexAt (y-1,x-1) - t2 = indexAt (y-1,x ) - t3 = indexAt (y-1,x+1) - l = indexAt (y, x-1) - m = indexAt (y, x ) - r = indexAt (y, x+1) - b1 = indexAt (y+1,x-1) - b2 = indexAt (y+1,x ) - b3 = indexAt (y+1,x+1) - in - pattern ((t1,t2,t3), (l,m,r), (b1,b2,b3)) - in - array (bounds xs) [(ix, f ix) | ix <- indices xs] - diff --git a/examples/nofib/Test/Prelude/ZipWith.hs b/examples/nofib/Test/Prelude/ZipWith.hs deleted file mode 100644 --- a/examples/nofib/Test/Prelude/ZipWith.hs +++ /dev/null @@ -1,203 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} - -module Test.Prelude.ZipWith ( - - test_zipWith - -) where - -import Prelude as P -import Data.Bits as P -import Data.Label -import Data.Maybe -import Data.Typeable -import Test.QuickCheck hiding ( (.&.), suchThat ) -import Test.Framework -import Test.Framework.Providers.QuickCheck2 - -import Config -import Test.Base -import QuickCheck.Arbitrary.Array -import Data.Array.Accelerate as A -import Data.Array.Accelerate.Data.Bits as A -import Data.Array.Accelerate.Examples.Internal as A -import Data.Array.Accelerate.Array.Sugar as Sugar -import qualified Data.Array.Accelerate.Array.Representation as R - --- --- ZipWith --------------------------------------------------------------------- --- - -test_zipWith :: Backend -> Config -> Test -test_zipWith backend opt = testGroup "zipWith" $ catMaybes - [ testIntegralElt configInt8 (undefined :: Int8) - , testIntegralElt configInt16 (undefined :: Int16) - , testIntegralElt configInt32 (undefined :: Int32) - , testIntegralElt configInt64 (undefined :: Int64) - , testIntegralElt configWord8 (undefined :: Word8) - , testIntegralElt configWord16 (undefined :: Word16) - , testIntegralElt configWord32 (undefined :: Word32) - , testIntegralElt configWord64 (undefined :: Word64) - , testFloatingElt configFloat (undefined :: Float) - , testFloatingElt configDouble (undefined :: Double) - ] - where - testIntegralElt :: forall a. (P.Integral a, P.Bits a, A.Integral a, A.Bits a, Arbitrary a, Similar a) => (Config :-> Bool) -> a -> Maybe Test - testIntegralElt ok _ - | P.not (get ok opt) = Nothing - | otherwise = Just $ testGroup (show (typeOf (undefined :: a))) - [ testDim dim0 - , testDim dim1 - , testDim dim2 - ] - where - testDim :: forall sh. (Shape sh, P.Eq sh, Arbitrary sh, Arbitrary (Array sh a), Arbitrary (Array sh Int)) => sh -> Test - testDim sh = testGroup ("DIM" P.++ show (rank sh)) - [ -- operators on Num - testProperty "(+)" (test_plus :: Array sh a -> Array sh a -> Property) - , testProperty "(-)" (test_minus :: Array sh a -> Array sh a -> Property) - , testProperty "(*)" (test_mult :: Array sh a -> Array sh a -> Property) - - -- operators on Integral & Bits - , testProperty "quot" (denom (test_quot :: Array sh a -> Array sh a -> Property)) - , testProperty "rem" (denom (test_rem :: Array sh a -> Array sh a -> Property)) - , testProperty "quotRem" (denom (test_quotRem :: Array sh a -> Array sh a -> Property)) - , testProperty "div" (denom (test_div :: Array sh a -> Array sh a -> Property)) - , testProperty "mod" (denom (test_mod :: Array sh a -> Array sh a -> Property)) - , testProperty "divMod" (denom (test_divMod :: Array sh a -> Array sh a -> Property)) - , testProperty "(.&.)" (test_band :: Array sh a -> Array sh a -> Property) - , testProperty "(.|.)" (test_bor :: Array sh a -> Array sh a -> Property) - , testProperty "xor" (test_xor :: Array sh a -> Array sh a -> Property) - , testProperty "shift" (test_shift :: Array sh a -> Array sh Int -> Property) - , testProperty "shiftL" (requiring (P.>= 0) (flip test_shiftL :: Array sh Int -> Array sh a -> Property)) - , testProperty "shiftR" (requiring (P.>= 0) (flip test_shiftR :: Array sh Int -> Array sh a -> Property)) - , testProperty "rotate" (test_rotate :: Array sh a -> Array sh Int -> Property) - , testProperty "rotateL" (requiring (P.>= 0) (flip test_rotateL :: Array sh Int -> Array sh a -> Property)) - , testProperty "rotateR" (requiring (P.>= 0) (flip test_rotateR :: Array sh Int -> Array sh a -> Property)) - - -- relational and equality operators - , testProperty "(<)" (test_lt :: Array sh a -> Array sh a -> Property) - , testProperty "(>)" (test_gt :: Array sh a -> Array sh a -> Property) - , testProperty "(<=)" (test_lte :: Array sh a -> Array sh a -> Property) - , testProperty "(>=)" (test_gte :: Array sh a -> Array sh a -> Property) - , testProperty "(==)" (test_eq :: Array sh a -> Array sh a -> Property) - , testProperty "(/=)" (test_neq :: Array sh a -> Array sh a -> Property) - , testProperty "min" (test_min :: Array sh a -> Array sh a -> Property) - , testProperty "max" (test_max :: Array sh a -> Array sh a -> Property) - ] - where - 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 = 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 = 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 _ - | P.not (get ok opt) = Nothing - | otherwise = Just $ testGroup (show (typeOf (undefined :: a))) - [ testDim dim0 - , testDim dim1 - , testDim dim2 - ] - where - testDim :: forall sh. (Shape sh, P.Eq sh, Arbitrary sh, Arbitrary (Array sh a)) => sh -> Test - testDim sh = testGroup ("DIM" P.++ show (rank sh)) - [ -- operators on Num - testProperty "(+)" (test_plus :: Array sh a -> Array sh a -> Property) - , testProperty "(-)" (test_minus :: Array sh a -> Array sh a -> Property) - , testProperty "(*)" (test_mult :: Array sh a -> Array sh a -> Property) - - -- operators on Fractional, Floating, RealFrac & RealFloat - , testProperty "(/)" (denom (test_div :: Array sh a -> Array sh a -> Property)) - , testProperty "(**)" (test_pow :: Array sh a -> Array sh a -> Property) - , testProperty "atan2" (test_atan2 :: Array sh a -> Array sh a -> Property) - , testProperty "logBase" (requiring (P.> 0) $ \(xs :: Array sh a) -> - requiring (P.> 0) $ \(ys :: Array sh a) -> test_logBase xs ys) - - -- relational and equality operators - , testProperty "(<)" (test_lt :: Array sh a -> Array sh a -> Property) - , testProperty "(>)" (test_gt :: Array sh a -> Array sh a -> Property) - , testProperty "(<=)" (test_lte :: Array sh a -> Array sh a -> Property) - , testProperty "(>=)" (test_gte :: Array sh a -> Array sh a -> Property) - , testProperty "(==)" (test_eq :: Array sh a -> Array sh a -> Property) - , testProperty "(/=)" (test_neq :: Array sh a -> Array sh a -> Property) - , testProperty "min" (test_min :: Array sh a -> Array sh a -> Property) - , testProperty "max" (test_max :: Array sh a -> Array sh a -> Property) - ] - where - 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 = 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 = 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 -> - requiring (P./= 0) $ \ys -> f xs ys - - -suchThat :: Gen a -> (a -> Bool) -> Gen a -suchThat gen p = do - x <- gen - case p x of - True -> return x - False -> sized $ \n -> resize (n+1) (suchThat gen p) - -{-# INLINE requiring #-} -requiring - :: (Elt e, Shape sh, Arbitrary e, Arbitrary sh, Testable prop) - => (e -> Bool) - -> (Array sh e -> prop) - -> Property -requiring f go = - let - shrinkRequiring arr = [ fromList (Sugar.shape arr) sl | sl <- shrinkOneRequiring (toList arr) ] - shrinkOneRequiring [] = [] - shrinkOneRequiring (x:xs) = [ x':xs | x' <- shrink x, f x' ] - P.++ [ x:xs' | xs' <- shrinkOneRequiring xs ] - in - forAllShrink arbitrary shrink $ \sh -> - forAllShrink (arbitraryArrayOf sh (arbitrary `suchThat` f)) shrinkRequiring $ \arr -> - go arr - - --- Reference Implementation --- ------------------------ - -zipWithRef :: (Shape sh, Elt c) => (a -> b -> c) -> Array sh a -> Array sh b -> Array sh c -zipWithRef f xs ys = - let shx = fromElt (arrayShape xs) - shy = fromElt (arrayShape ys) - sh = toElt (R.intersect shx shy) - in - fromFunction sh (\ix -> f (xs Sugar.! ix) (ys Sugar.! ix)) - diff --git a/examples/nofib/Test/Sharing.hs b/examples/nofib/Test/Sharing.hs deleted file mode 100644 --- a/examples/nofib/Test/Sharing.hs +++ /dev/null @@ -1,301 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} - -module Test.Sharing ( - - test_sharing - -) where - -import Config - -import Prelude as P -import Data.Array.Accelerate as A -import Data.Array.Accelerate.Data.Bits as A -import Test.Framework -import Test.Framework.Providers.HUnit - - -test_sharing :: Config -> Test -test_sharing _ = - testGroup "sharing recovery" - [ - sharing "simple" simple - , sharing "order fail" orderFail - , sharing "test sort" testSort - , sharing "much sharing" (muchSharing 20) - , sharing "bfs fail" bfsFail - , sharing "two lets same level" twoLetsSameLevel - , sharing "two lets same level" twoLetsSameLevel2 - , sharing "no let at top" noLetAtTop - , sharing "no let at top" noLetAtTop2 - , sharing "pipe" pipe - , sharing "bound variables" varUse - , sharing "big tuple" bigTuple - , iteration - ] - where - sharing :: Show a => TestName -> a -> Test - sharing name acc = - testCase name (P.length (show acc) `seq` return ()) - - - --------------------------------------------------------------------------------- --- --- Some tests to make sure that sharing recovery is working. --- - -mkArray :: Int -> Acc (Array DIM1 Int) -mkArray n = use $ fromList (Z:.1) [n] - -muchSharing :: Int -> Acc (Array DIM1 Int) -muchSharing 0 = (mkArray 0) -muchSharing n = A.map (\_ -> newArr ! (lift (Z:.(0::Int))) + - newArr ! (lift (Z:.(1::Int)))) (mkArray n) - where - newArr = muchSharing (n-1) - -idx :: Int -> Exp DIM1 -idx i = lift (Z:.i) - -bfsFail :: Acc (Array DIM1 Int) -bfsFail = A.map (\x -> (map2 ! (idx 1)) + (map1 ! (idx 2)) + x) arr - where - map1 :: Acc (Array DIM1 Int) - map1 = A.map (\y -> (map2 ! (idx 3)) + y) arr - - map2 :: Acc (Array DIM1 Int) - map2 = A.map (\z -> z + 1) arr - - arr :: Acc (Array DIM1 Int) - arr = mkArray 666 - -twoLetsSameLevel :: Acc (Array DIM1 Int) -twoLetsSameLevel = - let arr1 = mkArray 1 - in let arr2 = mkArray 2 - in A.map (\_ -> arr1!(idx 1) + arr1!(idx 2) + arr2!(idx 3) + arr2!(idx 4)) (mkArray 3) - -twoLetsSameLevel2 :: Acc (Array DIM1 Int) -twoLetsSameLevel2 = - let arr2 = mkArray 2 - in let arr1 = mkArray 1 - in A.map (\_ -> arr1!(idx 1) + arr1!(idx 2) + arr2!(idx 3) + arr2!(idx 4)) (mkArray 3) - - --- These two programs test that lets can be introduced not just at the top of a AST --- but in intermediate nodes. --- -noLetAtTop :: Acc (Array DIM1 Int) -noLetAtTop = A.map (\x -> x + 1) bfsFail - -noLetAtTop2 :: Acc (Array DIM1 Int) -noLetAtTop2 - = A.map (\x -> x + 2) - $ A.map (\x -> x + 1) bfsFail - --- --- --- -simple :: Acc (Array DIM1 (Int,Int)) -simple = A.map (\_ -> a ! (idx 1)) d - where - c = use $ A.fromList (Z :. 3) [1..] - d = A.map (+1) c - a = A.zip d c - - --- sortKey is a real program that Ben Lever wrote. It has some pretty interesting --- sharing going on. --- -sortKey :: (Elt e) - => (Exp e -> Exp Int) -- ^mapping function to produce key array from input array - -> Acc (Vector e) - -> Acc (Vector e) -sortKey keyFun arr = foldl sortOneBit arr (P.map lift ([0..31] :: [Int])) - where - sortOneBit inArr bitNum = outArr - where - keys = A.map keyFun inArr - - bits = A.map (\a -> (A.testBit a bitNum) ? (1, 0)) keys - bitsInv = A.map (\b -> (b A.== 0) ? (1, 0)) bits - - (falses, numZeroes) = unlift (A.scanl' (+) 0 bitsInv) - trues = A.map (\x -> (A.the numZeroes) + (A.fst x) - (A.snd x)) - $ A.zip ixs falses - - dstIxs = A.map (\x -> let (b, t, f) = unlift x in (b A.== (constant (0::Int))) ? (f, t)) - $ A.zip3 bits trues falses - outArr = scatter dstIxs inArr inArr -- just use input as default array - --(we're writing over everything anyway) - -- - ixs = enumeratedArray (shape arr) - --- Create an array where each element is the value of its corresponding --- row-major index. --- ---enumeratedArray :: (Shape sh) => Exp sh -> Acc (Array sh Int) ---enumeratedArray sh = A.reshape sh --- $ A.generate (index1 $ shapeSize sh) unindex1 - -enumeratedArray :: Exp DIM1 -> Acc (Array DIM1 Int) -enumeratedArray sh = A.generate sh unindex1 - -testSort :: Acc (Vector Int) -testSort = sortKey id $ use $ fromList (Z:.10) [9,8,7,6,5,4,3,2,1,0] - - --- map1 has children map3 and map2. --- map2 has child map3. --- Back when we still used a list for the NodeCounts data structure this mean that --- you would be merging [1,3,2] with [2,3] which violated precondition of (+++). --- This tests that the new algorithm works just fine on this. --- -orderFail :: Acc (Array DIM1 Int) -orderFail = A.map (\_ -> map1 ! (idx 1) + map2 ! (idx 1)) arr - where - map1 = A.map (\_ -> map3 ! (idx 1) + map2 ! (idx 2)) arr - map2 = A.map (\_ -> map3 ! (idx 3)) arr - map3 = A.map (+1) arr - arr = mkArray 42 - - --- Tests array-valued lambdas in conjunction with sharing recovery. --- -pipe :: Acc (Vector Int) -pipe = (acc1 >-> acc2) xs - where - z :: Acc (Scalar Int) - z = unit 0 - - xs :: Acc (Vector Int) - xs = use $ fromList (Z:.10) [0..] - - acc1 :: Acc (Vector Int) -> Acc (Vector Int) - acc1 = A.map (\_ -> the z) - - acc2 :: Acc (Vector Int) -> Acc (Vector Int) - acc2 arr = let arr2 = use $ fromList (Z:.10) [10..] - in A.map (\_ -> arr2!constant (Z:.(0::Int))) (A.zip arr arr2) - - --- Test for bound variables --- -varUse :: (Acc (Array DIM2 Int), Acc (Array DIM2 Float), Acc (Array DIM2 Float)) -varUse = (first, both, second) - where - is :: Array DIM2 Int - is = fromList (Z:.10:.10) [0..] - - fs :: Array DIM2 Float - fs = fromList (Z:.10:.10) [0..] - - -- Ignoring the first parameter - 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) - 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) - where - centre :: Stencil3x3 Float -> Stencil3x3 Int -> Exp Float - centre (_,(_,x,_),_) _ = x - --- Test for 8 and 9 tuples --- -bigTuple :: (Exp (Int,Int,Int,Int,Int,Int,Int,Int), Exp (Int,Int,Int,Int,Int,Int,Int,Int,Int)) -bigTuple = (A.constant (0,0,0,0,0,0,0,0), A.constant (0,0,0,0,0,0,0,0,0)) - --- Tests for sharing recovery of iteration --- -iteration :: Test -iteration = testGroup "iteration" - [ - iter "simple" test1 - , iter "outside" test2 - , iter "body and condition" test3 - , iter "awhile" awhile_test - , iter "iterate" iterate_test - , iter "nested" nested - , iter "unused" unused - ] - where - iter :: Show a => TestName -> a -> Test - iter name acc = testCase name (P.length (show acc) `seq` return ()) - - vec :: Acc (Vector Float) - vec = use $ fromList (Z:.10) [0..] - - test1 :: Acc (Vector Float) - test1 = flip A.map vec - $ \x -> A.while (A.< x) (+1) 0 - - test2 :: Acc (Vector Float) - test2 = flip A.map vec - $ \x -> let y = 2*pi - in y + A.while (A.< 10) (+y) x - - test3 :: Acc (Vector Float) - test3 = flip A.map vec - $ \x -> A.while (A.< x) (+x) 0 - - awhile_test :: Acc (Vector Float) - awhile_test = A.awhile (\a -> A.unit (the (A.sum a) A.< 200)) (A.map (+1)) vec - - iterate_test :: Acc (Vector Float) - iterate_test = flip A.map vec - $ \x -> let y = 2*x - in y + A.iterate (constant 10) (\x' -> y + x' + 10) x - - for :: Elt a => Exp Int -> (Exp Int -> Exp a -> Exp a) -> Exp a -> Exp a - for n f seed - = A.snd - $ A.iterate n (\v -> let (i, x) = unlift v - in lift (i+1, f i x)) - (lift (constant 0, seed)) - - nested :: Exp Int - nested - = for 64 (\i _ -> - for 64 (\j acc' -> i + j + acc') 0) 0 - - unused :: Exp Int - = A.while (A.== 10) (const 10) 5 - ----------------------------------------------------------------------- - --- This program contains nested data-parallelism and thus sharing recovery --- will fail. --- -_shouldFail :: Acc (Vector Float) -_shouldFail = mvm (use $ fromList (Z:.10:.10) [0..]) (use $ fromList (Z:.10) [0..]) - where - dotp :: A.Num e => Acc (Vector e) -> Acc (Vector e) -> Acc (Scalar e) - dotp xs ys = A.fold (+) 0 $ A.zipWith (*) xs ys - - takeRow :: Elt e => Exp Int -> Acc (Array DIM2 e) -> Acc (Vector e) - takeRow n mat = - let Z :. _ :. cols = unlift (shape mat) :: Z:. Exp Int :. Exp Int - in backpermute (index1 cols) - (\ix -> index2 n (unindex1 ix)) - mat - - mvm :: A.Num e => Acc (Array DIM2 e) -> Acc (Vector e) -> Acc (Vector e) - mvm mat vec = - let Z :. rows :. _ = unlift (shape mat) :: Z :. Exp Int :. Exp Int - in generate (index1 rows) - (\ix -> the (vec `dotp` takeRow (unindex1 ix) mat)) - - - diff --git a/examples/nofib/Test/Spectral.hs b/examples/nofib/Test/Spectral.hs deleted file mode 100644 --- a/examples/nofib/Test/Spectral.hs +++ /dev/null @@ -1,25 +0,0 @@ - -module Test.Spectral ( - - test_spectral - -) where - -import Config - -import Test.Framework -import Test.Spectral.BlackScholes -import Test.Spectral.SMVM -import Test.Spectral.RadixSort - -import Data.Array.Accelerate.Examples.Internal - - -test_spectral :: Backend -> Config -> Test -test_spectral be conf = - testGroup "spectral" - [ test_blackscholes be conf - , test_smvm be conf - , test_radixsort be conf - ] - diff --git a/examples/nofib/Test/Spectral/BlackScholes.cpp b/examples/nofib/Test/Spectral/BlackScholes.cpp deleted file mode 100644 --- a/examples/nofib/Test/Spectral/BlackScholes.cpp +++ /dev/null @@ -1,116 +0,0 @@ - -#include - - -/* - * Polynomial approximation of cumulative normal distribution function - */ -template -static T CND(T d) -{ - const T a1 = 0.31938153; - const T a2 = -0.356563782; - const T a3 = 1.781477937; - const T a4 = -1.821255978; - const T a5 = 1.330274429; - const T rsqrt2pi = 0.39894228040143267793994605993438; - - T k = 1.0 / (1.0 + 0.2316419 * fabs(d)); - - T cnd = rsqrt2pi * exp(- 0.5 * d * d) - * (k * (a1 + k * (a2 + k * (a3 + k * (a4 + k * a5))))); - - if (d > 0) - cnd = 1.0 - cnd; - - return cnd; -} - - -/* - * Black-Scholes formula for both call and put - */ -template -static void BlackScholesBody -( - T &callResult, - T &putResult, - T sf, // Stock price - T xf, // Option strike - T tf, // Option years - T rf, // Riskless rate - T vf // Volatility rate -) -{ - T s = sf, x = xf, t = tf, r = rf, v = vf; - - T sqrtT = sqrt(t); - T d1 = (log(s / x) + (r + 0.5 * v * v) * t) / (v * sqrtT); - T d2 = d1 - v * sqrtT; - T CNDD1 = CND(d1); - T CNDD2 = CND(d2); - - //Calculate Call and Put simultaneously - T expRT = exp(- r * t); - callResult = (s * CNDD1 - x * expRT * CNDD2); - putResult = (x * expRT * (1.0 - CNDD2) - s * (1.0 - CNDD1)); -} - - -/* - * Process an array of optN options - */ -extern "C" -void BlackScholes_f -( - float *CallResult, - float *PutResult, - float *StockPrice, - float *OptionStrike, - float *OptionYears, - float Riskfree, - float Volatility, - int optN -) -{ - for (int opt = 0; opt < optN; opt++) { - BlackScholesBody - ( - CallResult[opt], - PutResult[opt], - StockPrice[opt], - OptionStrike[opt], - OptionYears[opt], - Riskfree, - Volatility - ); - } -} - -extern "C" -void BlackScholes_d -( - double *CallResult, - double *PutResult, - double *StockPrice, - double *OptionStrike, - double *OptionYears, - double Riskfree, - double Volatility, - int optN -) -{ - for (int opt = 0; opt < optN; opt++) { - BlackScholesBody - ( - CallResult[opt], - PutResult[opt], - StockPrice[opt], - OptionStrike[opt], - OptionYears[opt], - Riskfree, - Volatility - ); - } -} - diff --git a/examples/nofib/Test/Spectral/BlackScholes.hs b/examples/nofib/Test/Spectral/BlackScholes.hs deleted file mode 100644 --- a/examples/nofib/Test/Spectral/BlackScholes.hs +++ /dev/null @@ -1,134 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} - -module Test.Spectral.BlackScholes ( - - test_blackscholes - -) where - -import Control.Applicative -import Data.Label -import Data.Maybe -import Data.Typeable -import Foreign.Marshal -import Foreign.Ptr -import Foreign.Storable -import System.Random -import Test.Framework -import Test.Framework.Providers.QuickCheck2 -import Test.QuickCheck -import Prelude as P - -import Config -import QuickCheck.Arbitrary.Array -import Data.Array.Accelerate as A -import Data.Array.Accelerate.Array.Sugar as A -import Data.Array.Accelerate.Examples.Internal as A -import Data.Array.Accelerate.IO as A - - -test_blackscholes :: Backend -> Config -> Test -test_blackscholes backend opt = testGroup "black-scholes" $ catMaybes - [ testElt configFloat c_BlackScholes_f - , testElt configDouble c_BlackScholes_d - ] - where - testElt :: forall a. ( P.Floating a, A.Floating a, A.Ord a, Similar a, Arbitrary a, Random a, Storable a - , BlockPtrs (EltRepr a) ~ Ptr a ) - => (Config :-> Bool) - -> BlackScholes a - -> Maybe Test - testElt ok cfun - | P.not (get ok opt) = Nothing - | otherwise = Just - $ testProperty (show (typeOf (undefined :: a))) (run_blackscholes cfun) - - opts :: (P.Floating a, Random a) => Gen (a,a,a) - opts = (,,) <$> choose (5,30) <*> choose (1,100) <*> choose (0.25,10) - - run_blackscholes :: forall a. ( P.Floating a, A.Floating a, A.Ord a, Similar a, Storable a, Random a - , BlockPtrs (EltRepr a) ~ Ptr a ) - => BlackScholes a - -> Property - run_blackscholes cfun = - forAll (sized return) $ \nmax -> - forAll (choose (0,nmax)) $ \n -> - forAll (arbitraryArrayOf (Z:.n) opts) $ \psy -> ioProperty $ do - let actual = run1 backend blackscholes psy - expected <- blackScholesRef cfun psy - return $ expected ~?= actual - - --- --- Black-Scholes option pricing ------------------------------------------------ --- - -riskfree, volatility :: P.Floating a => a -riskfree = 0.02 -volatility = 0.30 - -horner :: P.Num a => [a] -> a -> a -horner coeff x = x * foldr1 madd coeff - where - madd a b = a + x*b - -cnd' :: P.Floating a => a -> a -cnd' d = - let poly = horner coeff - coeff = [0.31938153,-0.356563782,1.781477937,-1.821255978,1.330274429] - rsqrt2pi = 0.39894228040143267793994605993438 - k = 1.0 / (1.0 + 0.2316419 * abs d) - in - rsqrt2pi * exp (-0.5*d*d) * poly k - - -blackscholes :: (P.Floating a, A.Floating a, A.Ord a) => Acc (Vector (a, a, a)) -> Acc (Vector (a, a)) -blackscholes = A.map go - where - go x = - let (price, strike, years) = A.unlift x - r = A.constant riskfree - v = A.constant volatility - v_sqrtT = v * sqrt years - d1 = (log (price / strike) + (r + 0.5 * v * v) * years) / v_sqrtT - d2 = d1 - v_sqrtT - cnd d = let c = cnd' d in d A.> 0 ? (1.0 - c, c) - cndD1 = cnd d1 - cndD2 = cnd d2 - x_expRT = strike * exp (-r * years) - in - A.lift ( price * cndD1 - x_expRT * cndD2 - , x_expRT * (1.0 - cndD2) - price * (1.0 - cndD1)) - - --- Reference implementation, stolen from the CUDA SDK examples reference --- implementation and modified for our purposes. --- -type BlackScholes a = Ptr a -> Ptr a -> Ptr a -> Ptr a -> Ptr a -> a -> a -> Int32 -> IO () - -blackScholesRef - :: forall a. (Storable a, P.Floating a, A.Floating a, BlockPtrs (EltRepr a) ~ Ptr a) - => BlackScholes a - -> Vector (a,a,a) - -> IO (Vector (a,a)) -blackScholesRef cfun xs = - let (Z :. n) = arrayShape xs - in - allocaArray n $ \p_call -> - allocaArray n $ \p_put -> - allocaArray n $ \p_price -> - allocaArray n $ \p_strike -> - allocaArray n $ \p_years -> do - toPtr xs ((((), p_price), p_strike), p_years) - cfun p_call p_put p_price p_strike p_years riskfree volatility (P.fromIntegral n) - fromPtr (Z :. n) (((), p_call), p_put) - - -foreign import ccall unsafe "BlackScholes_f" c_BlackScholes_f :: Ptr Float -> Ptr Float -> Ptr Float -> Ptr Float -> Ptr Float -> Float -> Float -> Int32 -> IO () -foreign import ccall unsafe "BlackScholes_d" c_BlackScholes_d :: Ptr Double -> Ptr Double -> Ptr Double -> Ptr Double -> Ptr Double -> Double -> Double -> Int32 -> IO () - diff --git a/examples/nofib/Test/Spectral/RadixSort.hs b/examples/nofib/Test/Spectral/RadixSort.hs deleted file mode 100644 --- a/examples/nofib/Test/Spectral/RadixSort.hs +++ /dev/null @@ -1,132 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} --- --- Radix sort for a subclass of element types --- - -module Test.Spectral.RadixSort ( - - test_radixsort, - -) where - -import Prelude as P -import Data.Bits as P ( finiteBitSize ) -import Data.List -import Data.Label -import Data.Maybe -import Data.Function -import Data.Typeable -import Test.QuickCheck ( Arbitrary ) -import Test.Framework -import Test.Framework.Providers.QuickCheck2 - -import Config -import QuickCheck.Arbitrary.Array () -import Data.Array.Accelerate as A -import Data.Array.Accelerate.Data.Bits as A -import Data.Array.Accelerate.Examples.Internal as A - - --- --- Radix sort ------------------------------------------------------------------ --- --- This is rather slow. Speeding up the reference implementation by using, say, --- vector-algorithms, does not significantly change the runtime. Thus, we stick --- to the simple list-based representation for the time being. --- - -test_radixsort :: Backend -> Config -> Test -test_radixsort backend opt = testGroup "radix sort" $ catMaybes - [ testElt configInt8 (undefined :: Int8) - , testElt configInt16 (undefined :: Int16) - , testElt configInt32 (undefined :: Int32) - , testElt configInt64 (undefined :: Int64) - , testElt configWord8 (undefined :: Word8) - , testElt configWord16 (undefined :: Word16) - , testElt configWord32 (undefined :: Word32) - , testElt configWord64 (undefined :: Word64) - ] - where - testElt :: forall a. (Radix a, P.Ord a, A.Integral a, Similar a, Arbitrary a) - => (Config :-> Bool) - -> a - -> Maybe Test - testElt ok _ - | P.not (get ok opt) = Nothing - | otherwise = Just $ testGroup (show (typeOf (undefined :: a))) - [ - testProperty "ascending" (test_ascending :: Vector a -> Property) - , testProperty "descending" (test_descending :: Vector a -> Property) - , testProperty "(key,val)" (test_keyval :: Vector (a,Float) -> Property) - ] - - test_ascending xs = toList (run1 backend radixsort xs) ~?= sort (toList xs) - test_descending xs = toList (run1 backend (radixsortBy complement) xs) ~?= sortBy (flip compare) (toList xs) - test_keyval xs = toList (run1 backend (radixsortBy A.fst) xs) ~?= sortBy (compare `on` P.fst) (toList xs) - - --- Implementation --- -------------- - -class A.Bits e => Radix e where - passes :: e {- dummy -} -> Int - radix :: Exp Int -> Exp e -> Exp Int - -#define signed(ty) \ -instance Radix ty where ; \ - passes = P.finiteBitSize ; \ - radix = radixOfSigned ; - -#define unsigned(ty) \ -instance Radix ty where ; \ - passes = P.finiteBitSize ; \ - radix = radixOfUnsigned ; - -signed(Int) -signed(Int8) -signed(Int16) -signed(Int32) -signed(Int64) -unsigned(Word) -unsigned(Word8) -unsigned(Word16) -unsigned(Word32) -unsigned(Word64) - -radixOfSigned :: forall e. (Radix e, A.Bounded e, A.Integral e, A.FromIntegral e Int) => Exp Int -> Exp e -> Exp Int -radixOfSigned i e = i A.== (passes' - 1) ? (radix' (e `xor` minBound), radix' e) - where - radix' x = A.fromIntegral $ (x `A.shiftR` i) .&. 1 - passes' = constant (passes (undefined :: e)) - -radixOfUnsigned :: (Radix e, A.Integral e, A.FromIntegral e Int) => Exp Int -> Exp e -> Exp Int -radixOfUnsigned i e = A.fromIntegral $ (e `A.shiftR` i) .&. 1 - - --- A simple (parallel) radix sort implementation [1]. --- --- [1] G. E. Blelloch. "Prefix sums and their applications." Technical Report --- CMU-CS-90-190. Carnegie Mellon University. 1990. --- -radixsort :: Radix a => Acc (Vector a) -> Acc (Vector a) -radixsort = radixsortBy id - -radixsortBy :: forall a r. (Elt a, Radix r) => (Exp a -> Exp r) -> Acc (Vector a) -> Acc (Vector a) -radixsortBy rdx arr = foldr1 (>->) (P.map radixPass [0..p-1]) arr - where - p = passes (undefined :: r) - -- - deal f x = let (a,b) = unlift x in (f A.== 0) ? (a,b) - radixPass k v = let k' = unit (constant k) - flags = A.map (radix (the k') . rdx) v - idown = prescanl (+) 0 . A.map (xor 1) $ flags - iup = A.map (size v - 1 -) . prescanr (+) 0 $ flags - index = A.zipWith deal flags (A.zip idown iup) - in - permute const v (\ix -> index1 (index!ix)) v - - diff --git a/examples/nofib/Test/Spectral/SMVM.hs b/examples/nofib/Test/Spectral/SMVM.hs deleted file mode 100644 --- a/examples/nofib/Test/Spectral/SMVM.hs +++ /dev/null @@ -1,72 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module Test.Spectral.SMVM ( - - test_smvm - -) where - --- from the accelerate-smvm program -import SMVM - -import Prelude as P -import Data.Array.Accelerate as A -import Data.Array.Accelerate.Examples.Internal as A -import Data.Label -import Data.Maybe -import Data.Typeable -import Test.QuickCheck - -import Config -import Test.Base -import QuickCheck.Arbitrary.Array - - -test_smvm :: Backend -> Config -> Test -test_smvm backend opt = testGroup "smvm" $ catMaybes --- [ testElt configInt8 (undefined :: Int8) --- , testElt configInt16 (undefined :: Int16) --- , testElt configInt32 (undefined :: Int32) --- , testElt configInt64 (undefined :: Int64) --- , testElt configWord8 (undefined :: Word8) --- , testElt configWord16 (undefined :: Word16) --- , testElt configWord32 (undefined :: Word32) --- , testElt configWord64 (undefined :: Word64) - [ testElt configFloat (undefined :: Float) - , testElt configDouble (undefined :: Double) - ] - where - testElt :: forall a. (P.Num a, A.Num a, Similar a, Arbitrary a) - => (Config :-> Bool) - -> a - -> Maybe Test - testElt ok _ - | P.not (get ok opt) = Nothing - | otherwise = Just - $ testProperty (show (typeOf (undefined :: a))) (run_smvm (undefined :: a)) - - run_smvm :: forall a. (P.Num a, A.Num a, Similar a, Arbitrary a) => a -> Property - run_smvm _ = - forAll arbitraryCSRMatrix $ \(segd, svec :: Vector (Int32,a), cols) -> - forAll (arbitraryArray (Z :. cols)) $ \vec -> - runN backend smvm (segd, svec) vec - ~?= - smvmRef segd svec vec - - --- Reference implementation --- ------------------------ - -smvmRef :: (Elt a, P.Num a) - => Segments Int32 - -> Vector (Int32, a) - -> Vector a - -> Vector a -smvmRef segd smat vec = - fromList (arrayShape segd) - [ P.sum [ val * indexArray vec (Z :. P.fromIntegral i) | (i,val) <- row ] - | row <- splitPlaces (toList segd) (toList smat) ] - diff --git a/examples/pagerank/Rank.hs b/examples/pagerank/Rank.hs --- a/examples/pagerank/Rank.hs +++ b/examples/pagerank/Rank.hs @@ -14,7 +14,7 @@ import Data.Array.Accelerate as A import Data.Array.Accelerate.Array.Sugar as A ( EltRepr ) import Data.Array.Accelerate.Examples.Internal as A -import Data.Array.Accelerate.IO as A +import Data.Array.Accelerate.IO.Data.Vector.Storable as A import Control.Monad import System.CPUTime @@ -55,11 +55,12 @@ -- | Construct the initial ranks vector. initialRanks :: Backend -> Int -> A.Vector Rank initialRanks backend pageCount - = let !startRank = 1 / P.fromIntegral pageCount + = let !startRank = 1 / P.fromIntegral pageCount in run backend $ A.fill (index1 (A.lift pageCount)) startRank -- | Run several iterations of the internal PageRank algorithm. +-- pageRank :: Backend -> Bool -- ^ Do not use Accelerate sequencing. @@ -72,7 +73,6 @@ -> FilePath -- ^ Path to titles file. -> A.Vector Rank -- ^ Initial ranks. -> IO () - pageRank backend _noSeq maxIters chunkSize pageCount from to sizes0 _titlesFile ranks0 = go maxIters ranks0 where @@ -93,26 +93,26 @@ -- Run a step of the algorithm. -- let ranks1 = if noSeq then stepInChunks ranks zeros 0 else stepInSeq ranks - let ranks1 = stepInChunks ranks zeros 0 - let ranks2 = addDangles (ranks1, sizes0) + let !ranks1 = stepInChunks ranks zeros 0 + let !ranks2 = addDangles ranks1 sizes0 -- Sum up the ranks for all the pages, -- this should be very close to 1, minus some some round-off error. - let rankSum = run1 backend A.sum ranks2 + let rankSum = runN backend A.sum ranks2 putStrLn $ " rank sum : " P.++ show rankSum go (i - 1) ranks2 -- Add to the rank the score due to dangling vectors. - addDangles :: (Vector Rank, Vector Int) -> Vector Rank - addDangles = run1 backend $ A.uncurry $ \ranks sizes -> let - - dangleScore = A.fold (+) 0 (A.zipWith d ranks sizes) + addDangles :: Vector Rank -> Vector Int -> Vector Rank + addDangles = runN backend $ \ !ranks !sizes -> + let + dangleScore = A.fold (+) 0 (A.zipWith d ranks sizes) - dangleContrib :: Acc (Scalar Rank) - dangleContrib = A.unit (the dangleScore / (A.lift (P.fromIntegral pageCount :: Float))) + dangleContrib :: Acc (Scalar Rank) + dangleContrib = A.unit (the dangleScore / (A.lift (P.fromIntegral pageCount :: Float))) - d r s = s A.== 0 ? (r, 0) + d r s = s A.== 0 ? (r, 0) in A.map (+ A.the dangleContrib) ranks @@ -130,17 +130,18 @@ | start P.>= edgeCount = parRanks | otherwise - = let end = P.min (start + chunkSize) edgeCount - from' = S.slice start (end - start) from - to' = S.slice start (end - start) to - !pages = A.fromVectors (Z:.(end - start)) (((), from'), to') - !parRanks1 = step (pages, sizes0, ranks, parRanks) - in stepInChunks ranks parRanks1 (start + chunkSize) + = let end = P.min (start + chunkSize) edgeCount + from' = S.slice start (end - start) from + to' = S.slice start (end - start) to + !pages = A.fromVectors (Z:.(end - start)) (((), from'), to') + !parRanks1 = step pages sizes0 ranks parRanks + in + stepInChunks ranks parRanks1 (start + chunkSize) - step :: (PageGraph, Vector Int, Vector Rank, Vector Rank) -> Vector Rank - step = run1 backend $ (\t -> let (p,s,r,pr) = unlift t in stepRank p s r pr) + step :: PageGraph -> Vector Int -> Vector Rank -> Vector Rank -> Vector Rank + step = runN backend stepRank -- Computer the index of the maximum rank. maxIndex :: A.Vector Rank -> A.Scalar Int - maxIndex = run1 backend $ (\ranks -> A.fold (\x y -> ranks ! index1 x A.> ranks ! index1 y ? (x,y)) 0 (A.enumFromN (A.shape ranks) 0)) + maxIndex = runN backend $ (\ranks -> A.fold (\x y -> ranks ! index1 x A.> ranks ! index1 y ? (x,y)) 0 (A.enumFromN (A.shape ranks) 0)) diff --git a/examples/ray/Scene/Light.hs b/examples/ray/Scene/Light.hs --- a/examples/ray/Scene/Light.hs +++ b/examples/ray/Scene/Light.hs @@ -105,10 +105,10 @@ fromElt (Light p c) = fromElt (p,c) instance IsProduct Elt Light where - type ProdRepr Light = ProdRepr (Position, Colour) - fromProd _ (Light p c) = fromTuple (p,c) - toProd _ t = let (p,c) = toTuple t in Light p c - prod cst _ = prod cst (undefined :: (Position, Colour)) + type ProdRepr Light = ProdRepr (Position, Colour) + fromProd _ (Light p c) = fromTuple (p,c) + toProd _ t = let (p,c) = toTuple t in Light p c + prod cst _ = prod cst (undefined :: (Position, Colour)) instance Lift Exp Light where type Plain Light = Light diff --git a/examples/ray/Scene/Object.hs b/examples/ray/Scene/Object.hs --- a/examples/ray/Scene/Object.hs +++ b/examples/ray/Scene/Object.hs @@ -195,10 +195,10 @@ fromElt (Plane p n c s) = fromElt (p, n, c, s) instance IsProduct Elt Plane where - type ProdRepr Plane = ProdRepr (Position, Direction, Colour, Float) - fromProd _ (Plane p n c s) = fromTuple (p, n, c, s) - toProd _ t = let (p, n, c, s) = toTuple t in Plane p n c s - prod cst _ = prod cst (undefined :: (Position, Direction, Colour, Float)) + type ProdRepr Plane = ProdRepr (Position, Direction, Colour, Float) + fromProd _ (Plane p n c s) = fromTuple (p, n, c, s) + toProd _ t = let (p, n, c, s) = toTuple t in Plane p n c s + prod cst _ = prod cst (undefined :: (Position, Direction, Colour, Float)) instance Lift Exp Plane where type Plain Plane = Plane diff --git a/examples/smoothlife/Config.hs b/examples/smoothlife/Config.hs --- a/examples/smoothlife/Config.hs +++ b/examples/smoothlife/Config.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} module Config @@ -11,7 +12,9 @@ import Control.Category import System.Console.GetOpt +#if !MIN_VERSION_accelerate(1,2,0) import Data.Array.Accelerate ( Array, DIM2 ) +#endif import Data.Array.Accelerate.Data.Complex ( Complex ) @@ -20,7 +23,9 @@ type R = Float type C = Complex R type RGBA32 = Word32 +#if !MIN_VERSION_accelerate(1,2,0) type Matrix a = Array DIM2 a +#endif data SigmoidFunction = Hard diff --git a/examples/smoothlife/SmoothLife.hs b/examples/smoothlife/SmoothLife.hs --- a/examples/smoothlife/SmoothLife.hs +++ b/examples/smoothlife/SmoothLife.hs @@ -34,16 +34,16 @@ -> Options -> Acc (Matrix R) -> Acc (Matrix R) -smoothlife conf opts aa +smoothlife conf _opts aa = aa'' where -- A simulation step -- - aaf = fft2D' Forward sh (complex aa) - nf = zipWith (*) aaf (use krf') - mf = zipWith (*) aaf (use kdf') - n = map (\x -> real x / kflr'') (fft2D' Inverse sh nf) - m = map (\x -> real x / kfld'') (fft2D' Inverse sh mf) + aaf = fft2D Forward (complex aa) + nf = zipWith (*) aaf krf + mf = zipWith (*) aaf kdf + n = map (\x -> real x / the kflr) (fft2D Inverse nf) + m = map (\x -> real x / the kfld) (fft2D Inverse mf) aa' = snm conf sn sm b1 b2 d1 d2 n m aa'' = clamp $ zipWith timestepMode aa' aa @@ -65,17 +65,17 @@ -- kflr = sum (flatten kr) kfld = sum (flatten kd) - krf = fft2D' Forward sh (shift2D (complex kr)) - kdf = fft2D' Forward sh (shift2D (complex kd)) + krf = fft2D Forward (shift2D (complex kr)) + kdf = fft2D Forward (shift2D (complex kd)) kd = generate (constant sh) (\ix -> 1 - linear (radius ix) ri b) kr = generate (constant sh) (\ix -> let r = radius ix in linear r ri b * (1 - linear r ra b)) - kflr'' = constant (kflr' `A.indexArray` Z) - kfld'' = constant (kfld' `A.indexArray` Z) - (kflr', kfld', krf', kdf') - = run (get optBackend opts) $ lift (kflr, kfld, krf, kdf) + -- kflr'' = constant (kflr' `A.indexArray` Z) + -- kfld'' = constant (kfld' `A.indexArray` Z) + -- (kflr', kfld', krf', kdf') + -- = run (get optBackend opts) $ lift (kflr, kfld, krf, kdf) -- Auxiliary -- diff --git a/examples/smvm/Main.hs b/examples/smvm/Main.hs --- a/examples/smvm/Main.hs +++ b/examples/smvm/Main.hs @@ -5,7 +5,7 @@ import Data.Array.Accelerate as A import Data.Array.Accelerate.Examples.Internal as A -import Data.Array.Accelerate.IO as A +import Data.Array.Accelerate.IO.Data.Vector.Storable as A import Data.Label ( get ) import Data.Matrix.MatrixMarket ( readMatrix ) diff --git a/lib/Data/Array/Accelerate/Examples/Internal/Criterion/Config.hs b/lib/Data/Array/Accelerate/Examples/Internal/Criterion/Config.hs --- a/lib/Data/Array/Accelerate/Examples/Internal/Criterion/Config.hs +++ b/lib/Data/Array/Accelerate/Examples/Internal/Criterion/Config.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} -- | @@ -44,9 +45,11 @@ (ReqArg (set confInterval . read) "CI") (describe confInterval "confidence interval") +#if !MIN_VERSION_criterion(1,1,0) , Option [] ["no-gc"] (NoArg (set forceGC False)) "do not collect garbage between iterations" +#endif , Option [] ["time-limit"] (ReqArg (set timeLimit . read) "SECS") diff --git a/lib/Data/Array/Accelerate/Examples/Internal/ParseArgs.hs b/lib/Data/Array/Accelerate/Examples/Internal/ParseArgs.hs --- a/lib/Data/Array/Accelerate/Examples/Internal/ParseArgs.hs +++ b/lib/Data/Array/Accelerate/Examples/Internal/ParseArgs.hs @@ -27,7 +27,9 @@ ) where +#if !MIN_VERSION_accelerate(1,2,0) import Data.Array.Accelerate.Debug ( accInit ) +#endif import Data.Array.Accelerate.Examples.Internal.Backend import qualified Data.Array.Accelerate.Examples.Internal.Criterion.Config as Criterion import qualified Data.Array.Accelerate.Examples.Internal.TestFramework.Config as TestFramework @@ -213,7 +215,9 @@ -> [String] -- ^ footer text -> IO (config, Options, [String]) parseArgs programOptions programConfig header footer = do +#if !MIN_VERSION_accelerate(1,2,0) accInit +#endif args <- getArgs let