accelerate-bignum 0.1.0.0 → 0.2.0.0
raw patch · 24 files changed
+2224/−731 lines, 24 filesdep +hedgehogdep +tasty-hedgehogdep −tasty-quickcheckdep ~acceleratedep ~base
Dependencies added: hedgehog, tasty-hedgehog
Dependencies removed: tasty-quickcheck
Dependency ranges changed: accelerate, base
Files
- CHANGELOG.md +22/−0
- README.md +1/−0
- accelerate-bignum.cabal +85/−28
- bench/Accelerate.hs +6/−1
- src/Data/Array/Accelerate/Internal/Orphans/Base.hs +34/−4
- test/Main.hs +0/−698
- test/Test/Base.hs +107/−0
- test/Test/BigNum.hs +49/−0
- test/Test/BigNum/Bits.hs +441/−0
- test/Test/BigNum/Bounded.hs +98/−0
- test/Test/BigNum/Enum.hs +66/−0
- test/Test/BigNum/Eq.hs +106/−0
- test/Test/BigNum/FiniteBits.hs +103/−0
- test/Test/BigNum/FromIntegral.hs +96/−0
- test/Test/BigNum/Integral.hs +220/−0
- test/Test/BigNum/Num.hs +219/−0
- test/Test/BigNum/Num2.hs +102/−0
- test/Test/BigNum/Ord.hs +118/−0
- test/Test/BigNum/Real.hs +55/−0
- test/Test/Iso.hs +142/−0
- test/Test/ShowType.hs +54/−0
- test/Test/Types.hs +62/−0
- test/TestNative.hs +19/−0
- test/TestPTX.hs +19/−0
+ CHANGELOG.md view
@@ -0,0 +1,22 @@+# Revision history for accelerate-bignum++Notable changes to the project will be documented in this file.++The format is based on [Keep a Changelog](http://keepachangelog.com/) and the+project adheres to the [Haskell Package Versioning Policy+(PVP)](https://pvp.haskell.org)+++## [0.2.0.0] - 2018-04-03+ * update for accelerate-1.2+ * support LLVM-6.0++## [0.1.0.0] - 2017-03-31+ * initial release+++[0.2.0.0]: https://github.com/tmcdonell/accelerate-bignum/compare/0.1.0.0...0.2.0.0+[0.1.0.0]: https://github.com/tmcdonell/accelerate-bignum/compare/e290717323f3e7c56064e3c848d1ea9d6ac1a8f5...HEAD++<!-- vim: nospell+ -->
README.md view
@@ -2,6 +2,7 @@ ==================================== [](https://travis-ci.org/tmcdonell/accelerate-bignum)+[](https://hackage.haskell.org/package/accelerate-bignum) This package provides fixed-length large integer types and arithmetic operations for Accelerate. Signed and unsigned 96, 128, 160, 192, 224, 256, and 512-bit
accelerate-bignum.cabal view
@@ -1,5 +1,5 @@ name: accelerate-bignum-version: 0.1.0.0+version: 0.2.0.0 synopsis: Fixed-length large integer arithmetic for Accelerate description: This package provides fixed-length large integer types and arithmetic@@ -18,9 +18,12 @@ copyright: BSD3 category: Compilers/Interpreters, Concurrency, Data, Parallelism build-type: Simple-extra-source-files: README.md cabal-version: >= 1.10 +extra-source-files:+ README.md+ CHANGELOG.md+ flag llvm-cpu description: Enable primpos for the LLVM CPU backend default: True@@ -47,16 +50,16 @@ Data.Array.Accelerate.Internal.Orphans.Elt build-depends:- base >= 4.8 && < 4.10+ base >= 4.8 && < 4.12+ , accelerate >= 1.0 , ghc-prim , template-haskell- , accelerate == 1.0.* if flag(llvm-cpu) cpp-options: -DACCELERATE_LLVM_NATIVE_BACKEND build-depends:- accelerate-llvm == 1.0.*- , accelerate-llvm-native == 1.0.*+ accelerate-llvm >= 1.0+ , accelerate-llvm-native >= 1.0 , llvm-hs-pure >= 3.9 -- other-modules:@@ -65,8 +68,8 @@ if flag(llvm-ptx) cpp-options: -DACCELERATE_LLVM_PTX_BACKEND build-depends:- accelerate-llvm == 1.0.*- , accelerate-llvm-ptx == 1.0.*+ accelerate-llvm >= 1.0+ , accelerate-llvm-ptx >= 1.0 , llvm-hs-pure >= 3.9 -- other-modules:@@ -86,39 +89,93 @@ -O0 -test-suite accelerate-bignum-test+test-suite test-llvm-native+ type: exitcode-stdio-1.0 default-language: Haskell2010+ hs-source-dirs: test+ main-is: TestNative.hs+ ghc-options: -main-is TestNative++ if !flag(llvm-cpu)+ buildable: False++ build-depends:+ base >= 4.7 && < 4.12+ , accelerate+ , accelerate-bignum+ , accelerate-llvm-native+ , hedgehog+ , tasty+ , tasty-hedgehog++ ghc-options:+ -O2+ -Wall+ -threaded+ -rtsopts++ other-modules:+ Test.Base+ Test.BigNum+ Test.BigNum.Bits+ Test.BigNum.Bounded+ Test.BigNum.Enum+ Test.BigNum.Eq+ Test.BigNum.FiniteBits+ Test.BigNum.FromIntegral+ Test.BigNum.Integral+ Test.BigNum.Num+ Test.BigNum.Num2+ Test.BigNum.Ord+ Test.BigNum.Real+ Test.Iso+ Test.ShowType+ Test.Types+++test-suite test-llvm-ptx type: exitcode-stdio-1.0+ default-language: Haskell2010 hs-source-dirs: test- main-is: Main.hs+ main-is: TestPTX.hs+ ghc-options: -main-is TestPTX + if !flag(llvm-ptx)+ buildable: False+ build-depends:- base >= 4.8 && < 4.10- , accelerate >= 0.16+ base >= 4.7 && < 4.12+ , accelerate , accelerate-bignum+ , accelerate-llvm-ptx+ , hedgehog , tasty- , tasty-quickcheck+ , tasty-hedgehog ghc-options: -O2 -Wall -threaded -rtsopts- -fno-liberate-case- -funfolding-use-threshold=200- -with-rtsopts=-N- -with-rtsopts=-n2M- -with-rtsopts=-A64M - if flag(llvm-cpu)- cpp-options: -DACCELERATE_LLVM_NATIVE_BACKEND- build-depends:- accelerate-llvm-native+ other-modules:+ Test.Base+ Test.BigNum+ Test.BigNum.Bits+ Test.BigNum.Bounded+ Test.BigNum.Enum+ Test.BigNum.Eq+ Test.BigNum.FiniteBits+ Test.BigNum.FromIntegral+ Test.BigNum.Integral+ Test.BigNum.Num+ Test.BigNum.Num2+ Test.BigNum.Ord+ Test.BigNum.Real+ Test.Iso+ Test.ShowType+ Test.Types - if flag(llvm-ptx)- cpp-options: -DACCELERATE_LLVM_PTX_BACKEND- build-depends:- accelerate-llvm-ptx benchmark accelerate-bignum-bench default-language: Haskell2010@@ -130,7 +187,7 @@ WideWord build-depends:- base >= 4.8 && < 4.10+ base >= 4.8 && < 4.12 , accelerate , accelerate-bignum , accelerate-io >= 0.16@@ -168,7 +225,7 @@ source-repository this type: git- tag: 0.1.0.0+ tag: 0.2.0.0 location: https://github.com/tmcdonell/accelerate-bignum -- vim: nospell
bench/Accelerate.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PolyKinds #-}@@ -8,10 +9,14 @@ module Accelerate where import Data.Array.Accelerate as A-import Data.Array.Accelerate.IO import Data.Array.Accelerate.Data.Bits as A import Data.Array.Accelerate.Data.BigWord import Data.Array.Accelerate.Data.BigInt+#if !MIN_VERSION_accelerate_io(1,2,0)+import Data.Array.Accelerate.IO+#else+import Data.Array.Accelerate.IO.Data.Vector.Storable+#endif import Criterion.Main import Data.Proxy
src/Data/Array/Accelerate/Internal/Orphans/Base.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}@@ -37,7 +38,7 @@ import qualified Data.Array.Accelerate.Internal.LLVM.Native as CPU import qualified Data.Array.Accelerate.Internal.LLVM.PTX as PTX -import Data.Array.Accelerate as A+import Data.Array.Accelerate as A hiding ( fromInteger ) import Data.Array.Accelerate.Array.Sugar as A ( eltType ) import Data.Array.Accelerate.Analysis.Match as A import Data.Array.Accelerate.Data.Bits as A@@ -130,9 +131,12 @@ , Num (BigWord a b) , Num2 (Exp (BigWord a b)) , BigWordCtx a b+#if MIN_VERSION_accelerate(1,2,0)+ , Enum (BigWord a b)+#endif ) => P.Integral (Exp (BigWord a b)) where- toInteger = error "Prelude.toInteger not supported for Accelerate types"+ toInteger = error "Prelude.toInteger is not supported for Accelerate types" {-# SPECIALIZE div :: Exp Word128 -> Exp Word128 -> Exp Word128 #-} {-# SPECIALIZE mod :: Exp Word128 -> Exp Word128 -> Exp Word128 #-}@@ -529,9 +533,12 @@ , Num2 (Exp (BigInt a b)) , Num2 (Exp (BigWord (Unsigned a) b)) , BigIntCtx a b+#if MIN_VERSION_accelerate(1,2,0)+ , Enum (BigInt a b)+#endif ) => P.Integral (Exp (BigInt a b)) where- toInteger = error "Prelude.toInteger not supported for Accelerate types"+ toInteger = error "Prelude.toInteger is not supported for Accelerate types" {-# SPECIALIZE quot :: Exp Int128 -> Exp Int128 -> Exp Int128 #-} quot | Just Refl <- matchInt128 (undefined::BigInt a b) = CPU.quotInt128# $ PTX.quotInt128# go@@ -886,6 +893,24 @@ bigIntT :: (Int,Int) -> Q Type bigIntT (hi,lo) = intT (hi+lo) +#if MIN_VERSION_accelerate(1,2,0)+ thEnum :: (Int,Int) -> Q [Dec]+ thEnum big =+ [d|+ instance P.Enum (Exp $(bigIntT big)) where+ succ x = x + 1+ pred x = x - 1+ toEnum = error "Prelude.toEnum is not supported for Accelerate types"+ fromEnum = error "Prelude.fromEnum is not supported for Accelerate types"++ instance P.Enum (Exp $(bigWordT big)) where+ succ x = x + 1+ pred x = x - 1+ toEnum = error "Prelude.toEnum is not supported for Accelerate types"+ fromEnum = error "Prelude.fromEnum is not supported for Accelerate types"+ |]+#endif+ thFromIntegral1 :: (Int,Int) -> Q [Dec] thFromIntegral1 big = [d|@@ -945,9 +970,14 @@ in fromIntegral lo |] --+#if MIN_VERSION_accelerate(1,2,0)+ e1 <- sequence [ thEnum x | x <- bigNums ]+#else+ e1 <- return []+#endif d1 <- sequence [ thFromIntegral1 x | x <- bigNums ] d2 <- sequence [ thFromIntegral2 x y | x <- bigNums, y <- lilNums ] --- return $ P.concat (d1 P.++ d2)+ return $ P.concat (e1 P.++ d1 P.++ d2) )
− test/Main.hs
@@ -1,698 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Main where--import Data.Bits-import Data.Int-import Data.Proxy-import Data.Word-import Test.Tasty-import Test.Tasty.QuickCheck hiding ( (.&.) )-import Text.Printf--import Data.Array.Accelerate.Data.BigInt-import Data.Array.Accelerate.Data.BigWord--import Data.Array.Accelerate ( Arrays, Acc, Scalar, Elt, Exp, Lift, Plain )-import Data.Array.Accelerate.Debug ( accInit )-import qualified Data.Array.Accelerate as A-import qualified Data.Array.Accelerate.Data.Bits as A-import qualified Data.Array.Accelerate.Interpreter as I-#ifdef ACCELERATE_LLVM_NATIVE_BACKEND-import qualified Data.Array.Accelerate.LLVM.Native as CPU-#endif-#ifdef ACCELERATE_LLVM_PTX_BACKEND-import qualified Data.Array.Accelerate.LLVM.PTX as PTX-#endif---main :: IO ()-main = do- accInit- defaultMain- $ localOption (QuickCheckTests 10000)- $ testGroup "accelerate-bignum"- [ testGroup "base"- [ testGroup "Num2"- [ testNum2 (Proxy::Proxy Word8)- , testNum2 (Proxy::Proxy Word16)- , testNum2 (Proxy::Proxy Word32)- , testNum2 (Proxy::Proxy Word64)- , testNum2 (Proxy::Proxy Int8)- , testNum2 (Proxy::Proxy Int16)- , testNum2 (Proxy::Proxy Int32)- , testNum2 (Proxy::Proxy Int64)- ]- , testMain (Proxy::Proxy U64)- , testMain (Proxy::Proxy I64)- , testMain (Proxy::Proxy UU64)- , testMain (Proxy::Proxy II64)- ]- , testGroup "accelerate"- [ testAcc Interpreter-#ifdef ACCELERATE_LLVM_NATIVE_BACKEND- , testAcc Native-#endif-#ifdef ACCELERATE_LLVM_PTX_BACKEND- , testAcc PTX-#endif- ]- ]--testAcc :: Backend -> TestTree-testAcc backend = testGroup (show backend)- [ testGroup "Num2"- [ testNum2Acc backend (Proxy::Proxy Word8)- , testNum2Acc backend (Proxy::Proxy Word16)- , testNum2Acc backend (Proxy::Proxy Word32)- , testNum2Acc backend (Proxy::Proxy Word64)- , testNum2Acc backend (Proxy::Proxy Int8)- , testNum2Acc backend (Proxy::Proxy Int16)- , testNum2Acc backend (Proxy::Proxy Int32)- , testNum2Acc backend (Proxy::Proxy Int64)- ]- , testGroup "FromIntegral"- -- little -> big- [ testFromIntegral backend (Proxy::Proxy Int32) (Proxy::Proxy Int128)- , testFromIntegral backend (Proxy::Proxy Int32) (Proxy::Proxy Int192)- , testFromIntegral backend (Proxy::Proxy Int32) (Proxy::Proxy Word128)- , testFromIntegral backend (Proxy::Proxy Int32) (Proxy::Proxy Word192)- , testFromIntegral backend (Proxy::Proxy Int64) (Proxy::Proxy Int128)- , testFromIntegral backend (Proxy::Proxy Int64) (Proxy::Proxy Int192)- , testFromIntegral backend (Proxy::Proxy Int64) (Proxy::Proxy Word128)- , testFromIntegral backend (Proxy::Proxy Int64) (Proxy::Proxy Word192)- , testFromIntegral backend (Proxy::Proxy Word32) (Proxy::Proxy Int128)- , testFromIntegral backend (Proxy::Proxy Word32) (Proxy::Proxy Int192)- , testFromIntegral backend (Proxy::Proxy Word32) (Proxy::Proxy Word128)- , testFromIntegral backend (Proxy::Proxy Word32) (Proxy::Proxy Word192)- , testFromIntegral backend (Proxy::Proxy Word64) (Proxy::Proxy Int128)- , testFromIntegral backend (Proxy::Proxy Word64) (Proxy::Proxy Int192)- , testFromIntegral backend (Proxy::Proxy Word64) (Proxy::Proxy Word128)- , testFromIntegral backend (Proxy::Proxy Word64) (Proxy::Proxy Word192)- -- big -> little- , testFromIntegral backend (Proxy::Proxy Int128) (Proxy::Proxy Int32)- , testFromIntegral backend (Proxy::Proxy Int192) (Proxy::Proxy Int32)- , testFromIntegral backend (Proxy::Proxy Word128) (Proxy::Proxy Int32)- , testFromIntegral backend (Proxy::Proxy Word192) (Proxy::Proxy Int32)- , testFromIntegral backend (Proxy::Proxy Int128) (Proxy::Proxy Int64)- , testFromIntegral backend (Proxy::Proxy Int192) (Proxy::Proxy Int64)- , testFromIntegral backend (Proxy::Proxy Word128) (Proxy::Proxy Int64)- , testFromIntegral backend (Proxy::Proxy Word192) (Proxy::Proxy Int64)- , testFromIntegral backend (Proxy::Proxy Int128) (Proxy::Proxy Word32)- , testFromIntegral backend (Proxy::Proxy Int192) (Proxy::Proxy Word32)- , testFromIntegral backend (Proxy::Proxy Word128) (Proxy::Proxy Word32)- , testFromIntegral backend (Proxy::Proxy Word192) (Proxy::Proxy Word32)- , testFromIntegral backend (Proxy::Proxy Int128) (Proxy::Proxy Word64)- , testFromIntegral backend (Proxy::Proxy Int192) (Proxy::Proxy Word64)- , testFromIntegral backend (Proxy::Proxy Word128) (Proxy::Proxy Word64)- , testFromIntegral backend (Proxy::Proxy Word192) (Proxy::Proxy Word64)- ]- , testMainAcc backend (Proxy::Proxy Word96)- , testMainAcc backend (Proxy::Proxy Word128)- , testMainAcc backend (Proxy::Proxy Int96)- , testMainAcc backend (Proxy::Proxy Int128)- ]---testNum2- :: (Show (ArgType a), Show a, Num2 a, FiniteBits (Unsigned a), Integral a, Integral (Unsigned a), Bounded a)- => proxy a- -> TestTree-testNum2 t = testGroup (showType t)- [ testProperty "addWithCarry" $ prop_addWithCarry t- , testProperty "mulWithCarry" $ prop_mulWithCarry t- ]--testMain- :: ( Iso a b, Arbitrary a, Show a, Show (ArgType b)- , Ord a, Bounded a, Real a, Integral a, FiniteBits a- , Ord b, Bounded b, Real b, Integral b, FiniteBits b- )- => proxy b- -> TestTree-testMain t = testGroup (showType t)- [ testProperty "iso" $ prop_iso t- , testGroup "Eq"- [ testProperty "(==)" $ prop_eq t- , testProperty "(/=)" $ prop_neq t- ]- , testGroup "Ord"- [ testProperty "compare" $ prop_compare t- ]- , testGroup "Bounded"- [ testProperty "minBound" $ prop_minBound t- , testProperty "maxBound" $ prop_maxBound t- ]- , testGroup "Enum"- [ testProperty "succ" $ prop_succ t- , testProperty "pred" $ prop_pred t- ]- , testGroup "Num"- [ testProperty "negate" $ prop_negate t- , testProperty "abs" $ prop_abs t- , testProperty "signum" $ prop_signum t- , testProperty "(+)" $ prop_add t- , testProperty "(-)" $ prop_sub t- , testProperty "(*)" $ prop_mul t- , testProperty "fromInteger" $ prop_fromInteger t- ]- , testGroup "Real"- [ testProperty "toRational" $ prop_toRational t- ]- , testGroup "Integral"- [ testProperty "toInteger" $ prop_toInteger t- , testProperty "quot" $ prop_quot t- , testProperty "rem" $ prop_rem t- , testProperty "quotRem" $ prop_quotRem t- , testProperty "div" $ prop_div t- , testProperty "mod" $ prop_mod t- , testProperty "divMod" $ prop_divMod t- ]- , testGroup "Bits"- [ testProperty "complement" $ prop_complement t- , testProperty "xor" $ prop_xor t- , testProperty "(.&.)" $ prop_band t- , testProperty "(.|.)" $ prop_bor t- , testProperty "shiftL" $ prop_shiftL t- , testProperty "shiftR" $ prop_shiftR t- , testProperty "shift" $ prop_shift t- , testProperty "rotateL" $ prop_rotateL t- , testProperty "rotateR" $ prop_rotateR t- , testProperty "rotate" $ prop_rotate t- , testProperty "bit" $ prop_bit t- , testProperty "testBit" $ prop_testBit t- , testProperty "setBit" $ prop_setBit t- , testProperty "clearBit" $ prop_clearBit t- , testProperty "complementBit" $ prop_complementBit t- , testProperty "popCount" $ prop_popCount t- ]- , testGroup "FiniteBits"- [ testProperty "countLeadingZeros" $ prop_clz t- , testProperty "countTrailingZeros" $ prop_ctz t- ]- ]--testNum2Acc- :: ( Show (ArgType a), Bounded a, Integral a, Integral (Unsigned a), FiniteBits (Unsigned a)- , Elt a, Elt (Unsigned a), Num2 (Exp a)- , Lift Exp (Unsigned (Exp a)), Plain (Unsigned (Exp a)) ~ Unsigned a- )- => Backend- -> proxy a- -> TestTree-testNum2Acc b t = testGroup (showType t)- [ testProperty "addWithCarry" $ prop_addWithCarry' b t- , testProperty "mulWithCarry" $ prop_mulWithCarry' b t- ]--testFromIntegral- :: (Show (ArgType a), Show (ArgType b), Arbitrary a, Integral a, Num b, Eq b, A.Integral a, A.Num b, A.FromIntegral a b)- => Backend- -> proxy a- -> proxy b- -> TestTree-testFromIntegral b ta tb =- testProperty (printf "%s->%s" (showType ta) (showType tb)) $ prop_fromIntegral b ta tb--testMainAcc- :: ( Arbitrary a, Show (ArgType a)- , Ord a, Integral a, Bounded a, FiniteBits a- , A.Ord a, A.Integral a, A.Bounded a, A.FiniteBits a- )- => Backend- -> proxy a- -> TestTree-testMainAcc b t = testGroup (showType t)- [ testGroup "Eq"- [ testProperty "(==)" $ prop_eq' b t- , testProperty "(/=)" $ prop_neq' b t- ]- , testGroup "Ord"- [ testProperty "(<)" $ prop_lt' b t- , testProperty "(>)" $ prop_gt' b t- , testProperty "(<=)" $ prop_lte' b t- , testProperty "(>=)" $ prop_gte' b t- ]- , testGroup "Bounded"- [ testProperty "minBound" $ prop_minBound' b t- , testProperty "maxBound" $ prop_maxBound' b t- ]- , testGroup "Num"- [ testProperty "negate" $ prop_negate' b t- , testProperty "abs" $ prop_abs' b t- , testProperty "signum" $ prop_signum' b t- , testProperty "(+)" $ prop_add' b t- , testProperty "(-)" $ prop_sub' b t- , testProperty "(*)" $ prop_mul' b t- , testProperty "fromInteger" $ prop_fromInteger' b t- ]- , testGroup "Integral"- [ testProperty "quot" $ prop_quot' b t- , testProperty "rem" $ prop_rem' b t- , testProperty "quotRem" $ prop_quotRem' b t- , testProperty "div" $ prop_div' b t- , testProperty "mod" $ prop_mod' b t- , testProperty "divMod" $ prop_divMod' b t- ]- , testGroup "Bits"- [ testProperty "complement" $ prop_complement' b t- , testProperty "xor" $ prop_xor' b t- , testProperty "(.&.)" $ prop_band' b t- , testProperty "(.|.)" $ prop_bor' b t- , testProperty "shiftL" $ prop_shiftL' b t- , testProperty "shiftR" $ prop_shiftR' b t- , testProperty "shift" $ prop_shift' b t- , testProperty "rotateL" $ prop_rotateL' b t- , testProperty "rotateR" $ prop_rotateR' b t- , testProperty "rotate" $ prop_rotate' b t- , testProperty "bit" $ prop_bit' b t- , testProperty "testBit" $ prop_testBit' b t- , testProperty "setBit" $ prop_setBit' b t- , testProperty "clearBit" $ prop_clearBit' b t- , testProperty "complementBit" $ prop_complementBit' b t- , testProperty "popCount" $ prop_popCount' b t- ]- , testGroup "FiniteBits"- [ testProperty "countLeadingZeros" $ prop_clz' b t- , testProperty "countTrailingZeros" $ prop_ctz' b t- ]- ]---prop_addWithCarry, prop_mulWithCarry :: (Num2 a, Integral a, FiniteBits (Unsigned a), Integral (Unsigned a)) => proxy a -> Large a -> Large a -> Bool-prop_addWithCarry _ (Large x) (Large y) = uncurry toInteger2 (addWithCarry x y) == toInteger x + toInteger y-prop_mulWithCarry _ (Large x) (Large y) = uncurry toInteger2 (mulWithCarry x y) == toInteger x * toInteger y--toInteger2 :: (Integral a, Integral b, FiniteBits b) => a -> b -> Integer-toInteger2 h l = toInteger h * 2 ^ finiteBitSize l + toInteger l--prop_iso :: (Iso a b, Eq a) => proxy b -> a -> Bool-prop_iso t x = isoL (toIso t x) == x--prop_eq, prop_neq :: (Iso a b, Eq a, Eq b) => proxy b -> a -> a -> Bool-prop_eq = prop_binary' (==) (==)-prop_neq = prop_binary' (/=) (/=)--prop_compare :: (Iso a b, Ord a, Ord b) => proxy b -> a -> a -> Bool-prop_compare = prop_binary' compare compare--prop_minBound, prop_maxBound :: (Iso a b, Bounded a, Bounded b, Eq a) => proxy b -> Bool-prop_minBound t = minBound == fromIso t minBound-prop_maxBound t = maxBound == fromIso t maxBound--prop_succ, prop_pred :: (Bounded a, Enum a, Enum b, Eq a, Iso a b) => proxy b -> a -> Property-prop_succ t x = (x /= maxBound) ==> (succ x == with_unary t succ x)-prop_pred t x = (x /= minBound) ==> (pred x == with_unary t pred x)--prop_negate, prop_abs, prop_signum :: (Iso a b, Num a, Num b, Eq a) => proxy b -> a -> Bool-prop_negate = prop_unary negate negate-prop_abs = prop_unary abs abs-prop_signum = prop_unary signum signum--prop_add, prop_sub, prop_mul :: (Iso a b, Num a, Num b, Eq a) => proxy b -> a -> a -> Bool-prop_add = prop_binary (+) (+)-prop_sub = prop_binary (-) (-)-prop_mul = prop_binary (*) (*)--prop_fromInteger :: (Iso a b, Num a, Eq a, Num b) => proxy b -> Integer -> Bool-prop_fromInteger t x = fromInteger x == fromIso t (fromInteger x)--prop_toRational :: (Iso a b, Real a, Real b) => proxy b -> a -> Bool-prop_toRational = prop_unary' toRational toRational--prop_toInteger :: (Iso a b, Integral a, Integral b) => proxy b -> a -> Bool-prop_toInteger = prop_unary' toInteger toInteger--prop_quot, prop_rem, prop_div, prop_mod :: (Iso a b, Integral a, Integral b) => proxy b -> a -> NonZero a -> Bool-prop_quot t x (NonZero y) = prop_binary quot quot t x y-prop_rem t x (NonZero y) = prop_binary rem rem t x y-prop_div t x (NonZero y) = prop_binary div div t x y-prop_mod t x (NonZero y) = prop_binary mod mod t x y--prop_quotRem :: (Iso a b, Integral a, Integral b) => proxy b -> a -> NonZero a -> Bool-prop_quotRem t x (NonZero y) =- let qr = quotRem x y- (q,r) = quotRem (toIso t x) (toIso t y)- in- qr == (fromIso t q, fromIso t r)--prop_divMod :: (Iso a b, Integral a, Integral b) => proxy b -> a -> NonZero a -> Bool-prop_divMod t x (NonZero y) =- let qr = divMod x y- (q,r) = divMod (toIso t x) (toIso t y)- in- qr == (fromIso t q, fromIso t r)--prop_complement :: (Iso a b, Bits a, Bits b) => proxy b -> a -> Bool-prop_complement = prop_unary complement complement--prop_xor, prop_band, prop_bor :: (Iso a b, Bits a, Bits b) => proxy b -> a -> a -> Bool-prop_xor = prop_binary xor xor-prop_band = prop_binary (.&.) (.&.)-prop_bor = prop_binary (.|.) (.|.)--prop_shiftL, prop_shiftR, prop_rotateL, prop_rotateR :: (Iso a b, FiniteBits a, FiniteBits b) => proxy b -> a -> NonNegative Int -> Property-prop_shiftL t x (NonNegative n) = n < finiteBitSize x ==> prop_unary (`shiftL` n) (`shiftL` n) t x-prop_shiftR t x (NonNegative n) = n < finiteBitSize x ==> prop_unary (`shiftR` n) (`shiftR` n) t x-prop_rotateL t x (NonNegative n) = n < finiteBitSize x ==> prop_unary (`rotateL` n) (`rotateL` n) t x-prop_rotateR t x (NonNegative n) = n < finiteBitSize x ==> prop_unary (`rotateR` n) (`rotateR` n) t x--prop_shift, prop_rotate :: (Iso a b, FiniteBits a, FiniteBits b) => proxy b -> a -> Int -> Property-prop_shift t x n = abs n < finiteBitSize x ==> prop_unary (`shift` n) (`shift` n) t x-prop_rotate t x n = abs n < finiteBitSize x ==> prop_unary (`rotate` n) (`rotate` n) t x--prop_bit :: forall proxy a b. (Iso a b, FiniteBits a, FiniteBits b) => proxy b -> Bool-prop_bit t = all (\b -> bit b == fromIso t (bit b)) [0 .. finiteBitSize (undefined::a) - 1]--prop_testBit, prop_setBit, prop_clearBit, prop_complementBit :: (Iso a b, FiniteBits a, FiniteBits b) => proxy b -> a -> NonNegative Int -> Property-prop_testBit t x (NonNegative n) = n < finiteBitSize x ==> prop_unary' (`testBit` n) (`testBit` n) t x-prop_setBit t x (NonNegative n) = n < finiteBitSize x ==> prop_unary (`setBit` n) (`setBit` n) t x-prop_clearBit t x (NonNegative n) = n < finiteBitSize x ==> prop_unary (`clearBit` n) (`clearBit` n) t x-prop_complementBit t x (NonNegative n) = n < finiteBitSize x ==> prop_unary (`complementBit` n) (`complementBit` n) t x--prop_popCount :: (Iso a b, FiniteBits a, FiniteBits b) => proxy b -> a -> Bool-prop_popCount = prop_unary' popCount popCount--prop_clz, prop_ctz :: (Iso a b, FiniteBits a, FiniteBits b) => proxy b -> a -> Bool-prop_clz = prop_unary' countLeadingZeros countLeadingZeros-prop_ctz = prop_unary' countTrailingZeros countTrailingZeros---fromIso :: Iso a b => proxy b -> b -> a-fromIso _ = isoL--toIso :: Iso a b => proxy b -> a -> b-toIso _ = isoR--with_unary :: Iso a b => proxy b -> (b -> b) -> a -> a-with_unary _ f = isoL . f . isoR--with_unary' :: Iso a b => proxy b -> (b -> r) -> a -> r-with_unary' _ f x = f (isoR x)--prop_unary :: (Iso a b, Eq a) => (a -> a) -> (b -> b) -> proxy b -> a -> Bool-prop_unary f g p x = f x == with_unary p g x--prop_unary' :: (Iso a b, Eq r) => (a -> r) -> (b -> r) -> proxy b -> a -> Bool-prop_unary' f g p x = f x == with_unary' p g x--prop_binary :: (Iso a b, Eq a) => (a -> a -> a) -> (b -> b -> b) -> proxy b -> a -> a -> Bool-prop_binary f g p x y = f x y == with_binary p g x y--with_binary :: Iso a b => proxy b -> (b -> b -> b) -> a -> a -> a-with_binary _ f x y = isoL $ f (isoR x) (isoR y)--with_binary' :: Iso a b => proxy b -> (b -> b -> r) -> a -> a -> r-with_binary' _ f x y = f (isoR x) (isoR y)--prop_binary' :: (Iso a b, Eq r) => (a -> a -> r) -> (b -> b -> r) -> proxy b -> a -> a -> Bool-prop_binary' f g p x y = f x y == with_binary' p g x y---type I64 = BigInt Int32 Word32-type U64 = BigWord Word32 Word32--type II64 = BigInt Int16 (BigWord Word16 Word32)-type UU64 = BigWord Word16 (BigWord Word16 Word32)--class Iso a b | b -> a where- isoR :: a -> b- isoL :: b -> a--instance Iso Word64 U64 where- isoR w = W2 (fromIntegral (w `shiftR` 32)) (fromIntegral w)- isoL (W2 h l) = fromIntegral h `shiftL` 32 .|. fromIntegral l--instance Iso Word64 UU64 where- isoR w = W2 (fromIntegral (w `shiftR` 48)) (W2 (fromIntegral (w `shiftR` 32)) (fromIntegral w))- isoL (W2 h (W2 lh ll)) = fromIntegral h `shiftL` 48- .|. fromIntegral lh `shiftL` 32- .|. fromIntegral ll--instance Iso Int64 I64 where- isoR w = I2 (fromIntegral (w `shiftR` 32)) (fromIntegral w)- isoL (I2 h l) = fromIntegral h `shiftL` 32 .|. fromIntegral l--instance Iso Int64 II64 where- isoR w = I2 (fromIntegral (w `shiftR` 48)) (W2 (fromIntegral (w `shiftR` 32)) (fromIntegral w))- isoL (I2 h (W2 lh ll)) = fromIntegral h `shiftL` 48- .|. fromIntegral lh `shiftL` 32- .|. fromIntegral ll--instance Elt a => Iso a (Scalar a) where- isoR x = A.fromList A.Z [x]- isoL x = A.indexArray x A.Z--instance (Arbitrary a, Arbitrary b) => Arbitrary (BigWord a b) where- arbitrary = W2 <$> arbitrary <*> arbitrary- shrink (W2 hi lo) = [ W2 hi' lo' | (hi',lo') <- shrink (hi,lo) ]--instance (Arbitrary a, Arbitrary b) => Arbitrary (BigInt a b) where- arbitrary = I2 <$> arbitrary <*> arbitrary- shrink (I2 hi lo) = [ I2 hi' lo' | (hi',lo') <- shrink (hi,lo) ]---{-# INLINE prop_unary_acc #-}-prop_unary_acc :: (Elt a, Elt r, Eq r) => (a -> r) -> (Exp a -> Exp r) -> Backend -> proxy a -> a -> Bool-prop_unary_acc f g b p x = f x == with_unary_acc b p g x--{-# INLINE prop_binary_acc #-}-prop_binary_acc :: (Elt a, Elt r, Eq r) => (a -> a -> r) -> (Exp a -> Exp a -> Exp r) -> Backend -> proxy a -> a -> a -> Bool-prop_binary_acc f g b p x y = f x y == with_binary_acc b p g x y--{-# INLINE prop_binary_acc' #-}-prop_binary_acc' :: (Elt a, Elt r, Eq r) => (a -> Int -> r) -> (Exp a -> Exp Int -> Exp r) -> Backend -> proxy a -> a -> Int -> Bool-prop_binary_acc' f g b p x y = f x y == with_binary_acc' b p g x y---- TLM: make sure to pass the operation though a 'run', otherwise the expression--- will be constant-folded away before hitting the backend.----{-# INLINE with_unary_acc #-}-with_unary_acc :: forall proxy a r. (Elt a, Elt r) => Backend -> proxy a -> (Exp a -> Exp r) -> a -> r-with_unary_acc b _ f = isoL . go . isoR- where- go :: Scalar a -> Scalar r- !go = run1 b (A.map f)--{-# INLINE with_binary_acc #-}-with_binary_acc :: forall proxy a r. (Elt a, Elt r) => Backend -> proxy a -> (Exp a -> Exp a -> Exp r) -> a -> a -> r-with_binary_acc b _ f x y = isoL $ go (isoR x) (isoR y)- where- go :: Scalar a -> Scalar a -> Scalar r- !go = run2 b (A.zipWith f)--{-# INLINE with_binary_acc' #-}-with_binary_acc' :: forall proxy a r. (Elt a, Elt r) => Backend -> proxy a -> (Exp a -> Exp Int -> Exp r) -> a -> Int -> r-with_binary_acc' b _ f x y = isoL $ go (isoR x) (isoR y)- where- go :: Scalar a -> Scalar Int -> Scalar r- !go = run2 b (A.zipWith f)--data Backend = Interpreter-#ifdef ACCELERATE_LLVM_NATIVE_BACKEND- | Native-#endif-#ifdef ACCELERATE_LLVM_PTX_BACKEND- | PTX-#endif--instance Show Backend where- show Interpreter = "interpreter"-#ifdef ACCELERATE_LLVM_NATIVE_BACKEND- show Native = "llvm-cpu"-#endif-#ifdef ACCELERATE_LLVM_PTX_BACKEND- show PTX = "llvm-ptx"-#endif--{-# INLINE run #-}-run :: Arrays a => Backend -> Acc a -> a-run Interpreter = I.run-#ifdef ACCELERATE_LLVM_NATIVE_BACKEND-run Native = CPU.run-#endif-#ifdef ACCELERATE_LLVM_PTX_BACKEND-run PTX = PTX.run-#endif---{-# INLINE run1 #-}-run1 :: (Arrays a, Arrays b) => Backend -> (Acc a -> Acc b) -> a -> b-run1 Interpreter f = I.run1 f-#ifdef ACCELERATE_LLVM_NATIVE_BACKEND-run1 Native f = CPU.run1 f-#endif-#ifdef ACCELERATE_LLVM_PTX_BACKEND-run1 PTX f = PTX.run1 f-#endif--{-# INLINE run2 #-}-run2 :: (Arrays a, Arrays b, Arrays c) => Backend -> (Acc a -> Acc b -> Acc c) -> a -> b -> c-run2 b f x y = go (x,y)- where- !go = run1 b (A.uncurry f)--infixr 0 $$-($$) :: (b -> a) -> (c -> d -> b) -> c -> d -> a-(f $$ g) x y = f (g x y)---{-# INLINE prop_addWithCarry' #-}-{-# INLINE prop_mulWithCarry' #-}-prop_addWithCarry', prop_mulWithCarry'- :: (Num2 (Exp a), Elt a, Elt (Unsigned a), Integral a, Integral (Unsigned a), FiniteBits (Unsigned a), A.Lift Exp (Unsigned (Exp a)), Plain (Unsigned (Exp a)) ~ Unsigned a)- => Backend- -> proxy a- -> Large a- -> Large a- -> Bool-prop_addWithCarry' b t (Large x) (Large y) = uncurry toInteger2 (with_binary_acc b t (A.lift $$ addWithCarry) x y) == toInteger x + toInteger y-prop_mulWithCarry' b t (Large x) (Large y) = uncurry toInteger2 (with_binary_acc b t (A.lift $$ mulWithCarry) x y) == toInteger x * toInteger y--{-# INLINE prop_fromIntegral #-}-prop_fromIntegral- :: forall proxy a b. (Integral a, Num b, Eq b, A.Integral a, A.Num b, A.FromIntegral a b)- => Backend- -> proxy a- -> proxy b- -> a- -> Bool-prop_fromIntegral b a _ = prop_unary_acc fromIntegral (A.fromIntegral :: Exp a -> Exp b) b a--{-# INLINE prop_eq' #-}-{-# INLINE prop_neq' #-}-prop_eq', prop_neq' :: (Eq a, A.Eq a) => Backend -> proxy a -> a -> a -> Bool-prop_eq' = prop_binary_acc (==) (A.==)-prop_neq' = prop_binary_acc (/=) (A./=)--{-# INLINE prop_lt' #-}-{-# INLINE prop_gt' #-}-{-# INLINE prop_lte' #-}-{-# INLINE prop_gte' #-}-prop_lt', prop_lte', prop_gt', prop_gte' :: (Ord a, A.Ord a) => Backend -> proxy a -> a -> a -> Bool-prop_lt' = prop_binary_acc (<) (A.<)-prop_gt' = prop_binary_acc (>) (A.>)-prop_lte' = prop_binary_acc (<=) (A.<=)-prop_gte' = prop_binary_acc (>=) (A.>=)--{-# INLINE prop_minBound' #-}-{-# INLINE prop_maxBound' #-}-prop_minBound', prop_maxBound' :: forall proxy a. (Bounded a, Eq a, A.Bounded a) => Backend -> proxy a -> Bool-prop_minBound' b _ = minBound == isoL (run b (A.unit (minBound :: Exp a)))-prop_maxBound' b _ = maxBound == isoL (run b (A.unit (maxBound :: Exp a)))--{-# INLINE prop_negate' #-}-{-# INLINE prop_abs' #-}-{-# INLINE prop_signum' #-}-prop_negate', prop_abs', prop_signum' :: (Num a, A.Num a, Eq a) => Backend -> proxy a -> a -> Bool-prop_negate' = prop_unary_acc negate negate-prop_abs' = prop_unary_acc abs abs-prop_signum' = prop_unary_acc signum signum--{-# INLINE prop_add' #-}-{-# INLINE prop_sub' #-}-{-# INLINE prop_mul' #-}-prop_add', prop_sub', prop_mul' :: (Num a, A.Num a, Eq a) => Backend -> proxy a -> a -> a -> Bool-prop_add' = prop_binary_acc (+) (+)-prop_sub' = prop_binary_acc (-) (-)-prop_mul' = prop_binary_acc (*) (*)--{-# INLINE prop_fromInteger' #-}-prop_fromInteger' :: forall proxy a. (Num a, Eq a, A.Num a) => Backend -> proxy a -> Integer -> Bool-prop_fromInteger' b _ x = fromInteger x == isoL (run b (A.unit (fromInteger x :: Exp a)))--{-# INLINE prop_quot' #-}-{-# INLINE prop_rem' #-}-{-# INLINE prop_div' #-}-{-# INLINE prop_mod' #-}-{-# INLINE prop_quotRem' #-}-{-# INLINE prop_divMod' #-}-prop_quot', prop_rem', prop_div', prop_mod', prop_quotRem', prop_divMod' :: (Integral a, A.Integral a) => Backend -> proxy a -> a -> NonZero a -> Bool-prop_quot' b t x (NonZero y) = prop_binary_acc quot quot b t x y-prop_rem' b t x (NonZero y) = prop_binary_acc rem rem b t x y-prop_div' b t x (NonZero y) = prop_binary_acc div div b t x y-prop_mod' b t x (NonZero y) = prop_binary_acc mod mod b t x y-prop_quotRem' b t x (NonZero y) = prop_binary_acc quotRem (A.lift $$ quotRem) b t x y-prop_divMod' b t x (NonZero y) = prop_binary_acc divMod (A.lift $$ divMod) b t x y--{-# INLINE prop_complement' #-}-prop_complement' :: (Bits a, A.Bits a) => Backend -> proxy a -> a -> Bool-prop_complement' = prop_unary_acc complement A.complement--{-# INLINE prop_xor' #-}-{-# INLINE prop_band' #-}-{-# INLINE prop_bor' #-}-prop_xor', prop_band', prop_bor' :: (Bits a, A.Bits a) => Backend -> proxy a -> a -> a -> Bool-prop_xor' = prop_binary_acc xor A.xor-prop_band' = prop_binary_acc (.&.) (A..&.)-prop_bor' = prop_binary_acc (.|.) (A..|.)--{-# INLINE prop_shiftL' #-}-{-# INLINE prop_shiftR' #-}-{-# INLINE prop_rotateL' #-}-{-# INLINE prop_rotateR' #-}-prop_shiftL', prop_shiftR', prop_rotateL', prop_rotateR' :: (FiniteBits a, A.FiniteBits a) => Backend -> proxy a -> a -> NonNegative Int -> Property-prop_shiftL' b t x (NonNegative n) = n < finiteBitSize x ==> prop_binary_acc' shiftL A.shiftL b t x n-prop_shiftR' b t x (NonNegative n) = n < finiteBitSize x ==> prop_binary_acc' shiftR A.shiftR b t x n-prop_rotateL' b t x (NonNegative n) = n < finiteBitSize x ==> prop_binary_acc' rotateL A.rotateL b t x n-prop_rotateR' b t x (NonNegative n) = n < finiteBitSize x ==> prop_binary_acc' rotateR A.rotateR b t x n--{-# INLINE prop_shift' #-}-{-# INLINE prop_rotate' #-}-prop_shift', prop_rotate' :: (FiniteBits a, A.FiniteBits a) => Backend -> proxy a -> a -> Int -> Property-prop_shift' b t x n = abs n < finiteBitSize x ==> prop_binary_acc' shift A.shift b t x n-prop_rotate' b t x n = abs n < finiteBitSize x ==> prop_binary_acc' rotate A.rotate b t x n--prop_bit' :: forall proxy a. (FiniteBits a, A.FiniteBits a) => Backend -> proxy a -> Bool-prop_bit' b _ = all (prop_unary_acc (bit :: Int -> a) A.bit b Proxy) [0 .. finiteBitSize (undefined::a) - 1]--{-# INLINE prop_testBit' #-}-{-# INLINE prop_setBit' #-}-{-# INLINE prop_clearBit' #-}-{-# INLINE prop_complementBit' #-}-prop_testBit', prop_setBit', prop_clearBit', prop_complementBit' :: (FiniteBits a, A.FiniteBits a) => Backend -> proxy a -> a -> NonNegative Int -> Property-prop_testBit' b t x (NonNegative n) = n < finiteBitSize x ==> prop_binary_acc' testBit A.testBit b t x-prop_setBit' b t x (NonNegative n) = n < finiteBitSize x ==> prop_binary_acc' setBit A.setBit b t x-prop_clearBit' b t x (NonNegative n) = n < finiteBitSize x ==> prop_binary_acc' clearBit A.clearBit b t x-prop_complementBit' b t x (NonNegative n) = n < finiteBitSize x ==> prop_binary_acc' complementBit A.complementBit b t x--{-# INLINE prop_popCount' #-}-prop_popCount' :: (FiniteBits a, A.FiniteBits a) => Backend -> proxy a -> a -> Bool-prop_popCount' = prop_unary_acc popCount A.popCount--{-# INLINE prop_clz' #-}-{-# INLINE prop_ctz' #-}-prop_clz', prop_ctz' :: (FiniteBits a, A.FiniteBits a) => Backend -> proxy a -> a -> Bool-prop_clz' = prop_unary_acc countLeadingZeros A.countLeadingZeros-prop_ctz' = prop_unary_acc countTrailingZeros A.countTrailingZeros---data ArgType (a :: *) = AT--showType :: forall proxy a. Show (ArgType a) => proxy a -> String-showType _ = show (AT :: ArgType a)--instance FiniteBits (BigWord a b) => Show (ArgType (BigWord a b)) where- show _ = printf "Word%d" (finiteBitSize (undefined::BigWord a b))--instance FiniteBits (BigInt a b) => Show (ArgType (BigInt a b)) where- show _ = printf "Int%d" (finiteBitSize (undefined::BigInt a b))--instance Show (ArgType Int8) where show _ = "Int8"-instance Show (ArgType Int16) where show _ = "Int16"-instance Show (ArgType Int32) where show _ = "Int32"-instance Show (ArgType Int64) where show _ = "Int64"-instance Show (ArgType Word8) where show _ = "Word8"-instance Show (ArgType Word16) where show _ = "Word16"-instance Show (ArgType Word32) where show _ = "Word32"-instance Show (ArgType Word64) where show _ = "Word64"-
+ test/Test/Base.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RankNTypes #-}+-- |+-- Module : Test.Base+-- Copyright : [2017] Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Test.Base where++import Data.Array.Accelerate ( Acc, Arrays, Array, Shape, Elt, fromList )+import Data.Array.Accelerate.Array.Sugar ( size )+import Data.Array.Accelerate.Trafo ( Afunction, AfunctionR )+import Data.Array.Accelerate.Data.Complex++import Data.Array.Accelerate.Data.BigInt+import Data.Array.Accelerate.Data.BigWord++import Data.Bits+import Data.Int+import Data.Word+import Control.Monad ( when )++import Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+++type Run = forall a. Arrays a => Acc a -> a+type RunN = forall f. Afunction f => f -> AfunctionR f++floating :: RealFloat a => Gen a+floating = Gen.realFloat (Range.linearFracFrom 0 (-1) 1)++complex :: Gen a -> Gen (Complex a)+complex f = (:+) <$> f <*> f++array :: (Shape sh, Elt e) => sh -> Gen e -> Gen (Array sh e)+array sh gen = fromList sh <$> Gen.list (Range.singleton (size sh)) gen++i8 :: Gen Int8+i8 = Gen.int8 Range.linearBounded++i16 :: Gen Int16+i16 = Gen.int16 Range.linearBounded++i32 :: Gen Int32+i32 = Gen.int32 Range.linearBounded++i64 :: Gen Int64+i64 = Gen.int64 Range.linearBounded++i96 :: Gen Int96+i96 = I2 <$> i32 <*> w64++i128 :: Gen Int128+i128 = I2 <$> i64 <*> w64++i192 :: Gen Int192+i192 = I2 <$> i64 <*> w128++w8 :: Gen Word8+w8 = Gen.word8 Range.linearBounded++w16 :: Gen Word16+w16 = Gen.word16 Range.linearBounded++w32 :: Gen Word32+w32 = Gen.word32 Range.linearBounded++w64 :: Gen Word64+w64 = Gen.word64 Range.linearBounded++w96 :: Gen Word96+w96 = W2 <$> w32 <*> w64++w128 :: Gen Word128+w128 = W2 <$> w64 <*> w64++w192 :: Gen Word192+w192 = W2 <$> w64 <*> w128+++integer :: Gen Integer+integer =+ let b = 2 * toInteger (maxBound :: Int64)+ in Gen.integral (Range.linearFrom 0 (-b) b)++except :: Gen e -> (e -> Bool) -> Gen e+except gen f = do+ v <- gen+ when (f v) Gen.discard+ return v++toInteger2 :: (Integral a, Integral b, FiniteBits b) => a -> b -> Integer+toInteger2 h l = toInteger h * 2 ^ finiteBitSize l + toInteger l++infixr 0 $$+($$) :: (b -> a) -> (c -> d -> b) -> c -> d -> a+(f $$ g) x y = f (g x y)+
+ test/Test/BigNum.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE RankNTypes #-}+-- |+-- Module : Test.BigNum+-- Copyright : [2017] Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Test.BigNum where++import Test.Base+import Test.BigNum.Num2+import Test.BigNum.Eq+import Test.BigNum.Ord+import Test.BigNum.Bounded+import Test.BigNum.Enum+import Test.BigNum.Num+import Test.BigNum.Real+import Test.BigNum.Integral+import Test.BigNum.Bits+import Test.BigNum.FiniteBits+import Test.BigNum.FromIntegral++import Test.Tasty+import System.Environment+++bignum :: RunN -> IO ()+bignum runN = do+ setEnv "TASTY_HEDGEHOG_TESTS" "1000"+ me <- getProgName+ defaultMain $+ testGroup me+ [ test_num2 runN+ , test_eq runN+ , test_ord runN+ , test_bounded runN+ , test_enum+ , test_num runN+ , test_real+ , test_integral runN+ , test_bits runN+ , test_finitebits runN+ , test_fromIntegral runN+ ]+
+ test/Test/BigNum/Bits.hs view
@@ -0,0 +1,441 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- |+-- Module : Test.BigNum.Bits+-- Copyright : [2017] Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Test.BigNum.Bits ( test_bits )+ where++import Test.Iso+import Test.Base+import Test.Types+import Test.ShowType++import Data.Array.Accelerate ( Exp )+import qualified Data.Array.Accelerate.Data.Bits as A++import Data.Bits+import Data.Proxy+import Test.Tasty+import Test.Tasty.Hedgehog++import Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+++test_bits :: RunN -> TestTree+test_bits runN =+ testGroup "Bits"+ [ testElt i64 (Proxy :: Proxy I64)+ , testElt w64 (Proxy :: Proxy U64)+ , testElt i64 (Proxy :: Proxy II64)+ , testElt w64 (Proxy :: Proxy UU64)+ , testAcc w96+ , testAcc i96+ , testAcc w128+ , testAcc i128+ ]+ where+ testElt :: (Iso a b, Eq a, Eq b, FiniteBits a, FiniteBits b, Show a, Show b, Show (ArgType b))+ => Gen a+ -> Proxy b+ -> TestTree+ testElt a b =+ testGroup (showType b)+ [ testProperty "complement" $ prop_complement a b+ , testProperty "xor" $ prop_xor a b+ , testProperty "(.&.)" $ prop_band a b+ , testProperty "(.|.)" $ prop_bor a b+ , testProperty "shiftL" $ prop_shiftL a b+ , testProperty "shiftR" $ prop_shiftR a b+ , testProperty "shift" $ prop_shift a b+ , testProperty "rotateL" $ prop_rotateL a b+ , testProperty "rotateR" $ prop_rotateR a b+ , testProperty "rotate" $ prop_rotate a b+ , testProperty "bit" $ prop_bit b+ , testProperty "testBit" $ prop_testBit a b+ , testProperty "setBit" $ prop_setBit a b+ , testProperty "clearBit" $ prop_clearBit a b+ , testProperty "complementBit" $ prop_complementBit a b+ , testProperty "popCount" $ prop_popCount a b+ ]++ testAcc :: (Eq a, FiniteBits a, A.FiniteBits a, Show (ArgType a))+ => Gen a+ -> TestTree+ testAcc a =+ testGroup (showType a)+ [ testProperty "complement" $ prop_acc_complement runN a+ , testProperty "xor" $ prop_acc_xor runN a+ , testProperty "(.&.)" $ prop_acc_band runN a+ , testProperty "(.|.)" $ prop_acc_bor runN a+ , testProperty "shiftL" $ prop_acc_shiftL runN a+ , testProperty "shiftR" $ prop_acc_shiftR runN a+ , testProperty "shift" $ prop_acc_shift runN a+ , testProperty "rotateL" $ prop_acc_rotateL runN a+ , testProperty "rotateR" $ prop_acc_rotateR runN a+ , testProperty "rotate" $ prop_acc_rotate runN a+ , testProperty "bit" $ prop_acc_bit runN a+ , testProperty "testBit" $ prop_acc_testBit runN a+ , testProperty "setBit" $ prop_acc_setBit runN a+ , testProperty "clearBit" $ prop_acc_clearBit runN a+ , testProperty "complementBit" $ prop_acc_complementBit runN a+ , testProperty "popCount" $ prop_acc_popCount runN a+ ]+++prop_complement+ :: (Iso a b, Bits a, Bits b, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_complement a b =+ property $ do+ x <- forAll a+ prop_unary complement complement b x++prop_xor+ :: (Iso a b, Bits a, Bits b, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_xor a b =+ property $ do+ x <- forAll a+ y <- forAll a+ prop_binary xor xor b x y++prop_band+ :: (Iso a b, Bits a, Bits b, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_band a b =+ property $ do+ x <- forAll a+ y <- forAll a+ prop_binary (.&.) (.&.) b x y++prop_bor+ :: (Iso a b, Bits a, Bits b, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_bor a b =+ property $ do+ x <- forAll a+ y <- forAll a+ prop_binary (.|.) (.|.) b x y++prop_shiftL+ :: (Iso a b, FiniteBits a, FiniteBits b, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_shiftL a b =+ property $ do+ x <- forAll a+ n <- forAll (Gen.int (Range.linear 0 (finiteBitSize x)))+ prop_unary (`shiftL` n) (`shiftL` n) b x++prop_shiftR+ :: (Iso a b, FiniteBits a, FiniteBits b, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_shiftR a b =+ property $ do+ x <- forAll a+ n <- forAll (Gen.int (Range.linear 0 (finiteBitSize x)))+ prop_unary (`shiftR` n) (`shiftR` n) b x++prop_rotateL+ :: (Iso a b, FiniteBits a, FiniteBits b, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_rotateL a b =+ property $ do+ x <- forAll a+ n <- forAll (Gen.int (Range.linear 0 (finiteBitSize x)))+ prop_unary (`rotateL` n) (`rotateL` n) b x++prop_rotateR+ :: (Iso a b, FiniteBits a, FiniteBits b, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_rotateR a b =+ property $ do+ x <- forAll a+ n <- forAll (Gen.int (Range.linear 0 (finiteBitSize x)))+ prop_unary (`rotateR` n) (`rotateR` n) b x++prop_shift+ :: (Iso a b, FiniteBits a, FiniteBits b, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_shift a b =+ property $ do+ x <- forAll a+ n <- forAll (Gen.int (Range.linearFrom 0 (-finiteBitSize x) (finiteBitSize x)))+ prop_unary (`shift` n) (`shift` n) b x++prop_rotate+ :: (Iso a b, FiniteBits a, FiniteBits b, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_rotate a b =+ property $ do+ x <- forAll a+ n <- forAll (Gen.int (Range.linearFrom 0 (-finiteBitSize x) (finiteBitSize x)))+ prop_unary (`rotate` n) (`rotate` n) b x++prop_bit+ :: forall a b. (Iso a b, FiniteBits a, FiniteBits b, Show a, Show b)+ => Proxy b+ -> Property+prop_bit b =+ property $ do+ mapM_ (\i -> bit i === fromIso b (bit i)) [0 .. finiteBitSize (undefined::a) - 1]++prop_testBit+ :: (Iso a b, FiniteBits a, FiniteBits b, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_testBit a b =+ property $ do+ x <- forAll a+ n <- forAll (Gen.int (Range.linear 0 (finiteBitSize x)))+ prop_unary' (`testBit` n) (`testBit` n) b x++prop_setBit+ :: (Iso a b, FiniteBits a, FiniteBits b, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_setBit a b =+ property $ do+ x <- forAll a+ n <- forAll (Gen.int (Range.linear 0 (finiteBitSize x)))+ prop_unary (`setBit` n) (`setBit` n) b x++prop_clearBit+ :: (Iso a b, FiniteBits a, FiniteBits b, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_clearBit a b =+ property $ do+ x <- forAll a+ n <- forAll (Gen.int (Range.linear 0 (finiteBitSize x)))+ prop_unary (`clearBit` n) (`clearBit` n) b x++prop_complementBit+ :: (Iso a b, FiniteBits a, FiniteBits b, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_complementBit a b =+ property $ do+ x <- forAll a+ n <- forAll (Gen.int (Range.linear 0 (finiteBitSize x)))+ prop_unary (`complementBit` n) (`complementBit` n) b x++prop_popCount+ :: (Iso a b, FiniteBits a, FiniteBits b, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_popCount a b =+ property $ do+ x <- forAll a+ prop_unary' popCount popCount b x++prop_acc_complement+ :: (Bits a, A.Bits a)+ => RunN+ -> Gen a+ -> Property+prop_acc_complement runN a =+ property $ do+ x <- forAll a+ prop_acc_unary complement A.complement runN x++prop_acc_xor+ :: (Bits a, A.Bits a)+ => RunN+ -> Gen a+ -> Property+prop_acc_xor runN a =+ property $ do+ x <- forAll a+ y <- forAll a+ prop_acc_binary xor A.xor runN x y++prop_acc_band+ :: (Bits a, A.Bits a)+ => RunN+ -> Gen a+ -> Property+prop_acc_band runN a =+ property $ do+ x <- forAll a+ y <- forAll a+ prop_acc_binary (.&.) (A..&.) runN x y++prop_acc_bor+ :: (Bits a, A.Bits a)+ => RunN+ -> Gen a+ -> Property+prop_acc_bor runN a =+ property $ do+ x <- forAll a+ y <- forAll a+ prop_acc_binary (.|.) (A..|.) runN x y+++prop_acc_shiftL+ :: (FiniteBits a, A.FiniteBits a)+ => RunN+ -> Gen a+ -> Property+prop_acc_shiftL runN a =+ property $ do+ x <- forAll a+ n <- forAll (Gen.int (Range.linear 0 (finiteBitSize x)))+ prop_acc_binary shiftL A.shiftL runN x n++prop_acc_shiftR+ :: (FiniteBits a, A.FiniteBits a)+ => RunN+ -> Gen a+ -> Property+prop_acc_shiftR runN a =+ property $ do+ x <- forAll a+ n <- forAll (Gen.int (Range.linear 0 (finiteBitSize x)))+ prop_acc_binary shiftR A.shiftR runN x n++prop_acc_rotateL+ :: (FiniteBits a, A.FiniteBits a)+ => RunN+ -> Gen a+ -> Property+prop_acc_rotateL runN a =+ property $ do+ x <- forAll a+ n <- forAll (Gen.int (Range.linear 0 (finiteBitSize x)))+ prop_acc_binary rotateL A.rotateL runN x n++prop_acc_rotateR+ :: (FiniteBits a, A.FiniteBits a)+ => RunN+ -> Gen a+ -> Property+prop_acc_rotateR runN a =+ property $ do+ x <- forAll a+ n <- forAll (Gen.int (Range.linear 0 (finiteBitSize x)))+ prop_acc_binary rotateR A.rotateR runN x n++prop_acc_shift+ :: (FiniteBits a, A.FiniteBits a)+ => RunN+ -> Gen a+ -> Property+prop_acc_shift runN a =+ property $ do+ x <- forAll a+ n <- forAll (Gen.int (Range.linearFrom 0 (-finiteBitSize x) (finiteBitSize x)))+ prop_acc_binary shift A.shift runN x n++prop_acc_rotate+ :: (FiniteBits a, A.FiniteBits a)+ => RunN+ -> Gen a+ -> Property+prop_acc_rotate runN a =+ property $ do+ x <- forAll a+ n <- forAll (Gen.int (Range.linearFrom 0 (-finiteBitSize x) (finiteBitSize x)))+ prop_acc_binary rotate A.rotate runN x n++prop_acc_bit+ :: forall proxy a. (FiniteBits a, A.FiniteBits a)+ => RunN+ -> proxy a+ -> Property+prop_acc_bit runN _ =+ property $ do+ mapM_ (\i -> bit i === with_acc_unary runN (A.bit :: Exp Int -> Exp a) i) [0 .. finiteBitSize (undefined::a) - 1]+++prop_acc_testBit+ :: (FiniteBits a, A.FiniteBits a)+ => RunN+ -> Gen a+ -> Property+prop_acc_testBit runN a =+ property $ do+ x <- forAll a+ n <- forAll (Gen.int (Range.linear 0 (finiteBitSize x)))+ prop_acc_binary testBit A.testBit runN x n++prop_acc_setBit+ :: (FiniteBits a, A.FiniteBits a)+ => RunN+ -> Gen a+ -> Property+prop_acc_setBit runN a =+ property $ do+ x <- forAll a+ n <- forAll (Gen.int (Range.linear 0 (finiteBitSize x)))+ prop_acc_binary setBit A.setBit runN x n++prop_acc_clearBit+ :: (FiniteBits a, A.FiniteBits a)+ => RunN+ -> Gen a+ -> Property+prop_acc_clearBit runN a =+ property $ do+ x <- forAll a+ n <- forAll (Gen.int (Range.linear 0 (finiteBitSize x)))+ prop_acc_binary clearBit A.clearBit runN x n++prop_acc_complementBit+ :: (FiniteBits a, A.FiniteBits a)+ => RunN+ -> Gen a+ -> Property+prop_acc_complementBit runN a =+ property $ do+ x <- forAll a+ n <- forAll (Gen.int (Range.linear 0 (finiteBitSize x)))+ prop_acc_binary complementBit A.complementBit runN x n++prop_acc_popCount+ :: (FiniteBits a, A.FiniteBits a)+ => RunN+ -> Gen a+ -> Property+prop_acc_popCount runN a =+ property $ do+ x <- forAll a+ prop_acc_unary popCount A.popCount runN x+
+ test/Test/BigNum/Bounded.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- |+-- Module : Test.BigNum.Bounded+-- Copyright : [2017] Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Test.BigNum.Bounded ( test_bounded )+ where++import Test.Iso+import Test.Base+import Test.Types+import Test.ShowType++import Data.Array.Accelerate.Data.BigInt+import Data.Array.Accelerate.Data.BigWord+import qualified Data.Array.Accelerate as A++import Data.Proxy+import Hedgehog+import Test.Tasty+import Test.Tasty.Hedgehog+++test_bounded :: RunN -> TestTree+test_bounded runN =+ testGroup "Bounded"+ [ testElt (Proxy :: Proxy U64)+ , testElt (Proxy :: Proxy I64)+ , testElt (Proxy :: Proxy UU64)+ , testElt (Proxy :: Proxy II64)+ , testAcc (Proxy :: Proxy Word96)+ , testAcc (Proxy :: Proxy Int96)+ , testAcc (Proxy :: Proxy Word128)+ , testAcc (Proxy :: Proxy Int128)+ ]+ where+ testElt :: (Iso a b, Eq a, Bounded a, Bounded b, Show a, Show b, Show (ArgType b))+ => Proxy b+ -> TestTree+ testElt p =+ testGroup (showType p)+ [ testProperty "minBound" $ prop_minBound p+ , testProperty "maxBound" $ prop_maxBound p+ ]++ testAcc :: (Eq a, Bounded a, A.Bounded a, Show (ArgType a))+ => Proxy a+ -> TestTree+ testAcc p =+ testGroup (showType p)+ [ testProperty "minBound" $ prop_acc_minBound runN p+ , testProperty "maxBound" $ prop_acc_maxBound runN p+ ]+++prop_minBound+ :: (Iso a b, Bounded a, Bounded b, Eq a, Show a)+ => Proxy b+ -> Property+prop_minBound p =+ property $+ minBound === fromIso p minBound++prop_maxBound+ :: (Iso a b, Bounded a, Bounded b, Eq a, Show a)+ => Proxy b+ -> Property+prop_maxBound p =+ property $+ maxBound === fromIso p maxBound++prop_acc_minBound+ :: forall a. (Eq a, Bounded a, A.Bounded a)+ => RunN+ -> Proxy a+ -> Property+prop_acc_minBound runN _ =+ property $+ minBound === isoL (runN (A.unit (minBound :: A.Exp a)))++prop_acc_maxBound+ :: forall a. (Eq a, Bounded a, A.Bounded a)+ => RunN+ -> Proxy a+ -> Property+prop_acc_maxBound runN _ =+ property $+ maxBound === isoL (runN (A.unit (maxBound :: A.Exp a)))+
+ test/Test/BigNum/Enum.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+-- |+-- Module : Test.BigNum.Enum+-- Copyright : [2017] Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Test.BigNum.Enum ( test_enum )+ where++import Test.Iso+import Test.Base+import Test.Types+import Test.ShowType++import Data.Proxy+import Hedgehog+import Test.Tasty+import Test.Tasty.Hedgehog+++test_enum :: TestTree+test_enum =+ testGroup "Enum"+ [ testElt i64 (Proxy :: Proxy I64)+ , testElt w64 (Proxy :: Proxy U64)+ , testElt i64 (Proxy :: Proxy II64)+ , testElt w64 (Proxy :: Proxy UU64)+ ]+ where+ testElt :: (Iso a b, Eq a, Bounded a, Enum a, Enum b, Show a, Show b, Show (ArgType b))+ => Gen a+ -> Proxy b+ -> TestTree+ testElt a b =+ testGroup (showType b)+ [ testProperty "succ" $ prop_succ a b+ , testProperty "pred" $ prop_pred a b+ ]+++prop_succ+ :: (Iso a b, Bounded a, Enum a, Enum b, Eq a, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_succ a b =+ property $ do+ x <- forAll (a `except` (== maxBound))+ succ x === with_unary b succ x++prop_pred+ :: (Iso a b, Bounded a, Enum a, Enum b, Eq a, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_pred a b =+ property $ do+ x <- forAll (a `except` (== minBound))+ pred x === with_unary b pred x+
+ test/Test/BigNum/Eq.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+-- |+-- Module : Test.BigNum.Eq+-- Copyright : [2017] Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Test.BigNum.Eq ( test_eq )+ where++import Test.Iso+import Test.Base+import Test.Types+import Test.ShowType++import qualified Data.Array.Accelerate as A++import Data.Proxy+import Hedgehog+import Test.Tasty+import Test.Tasty.Hedgehog+++test_eq :: RunN -> TestTree+test_eq runN =+ testGroup "Eq"+ [ testElt w64 (Proxy :: Proxy U64)+ , testElt i64 (Proxy :: Proxy I64)+ , testElt w64 (Proxy :: Proxy UU64)+ , testElt i64 (Proxy :: Proxy II64)+ , testAcc w96+ , testAcc i96+ , testAcc w128+ , testAcc i128+ ]+ where+ testElt :: (Iso a b, Eq a, Eq b, Show a, Show b, Show (ArgType b))+ => Gen a+ -> Proxy b+ -> TestTree+ testElt a b =+ testGroup (showType b)+ [ testProperty "(==)" $ prop_eq a b+ , testProperty "(/=)" $ prop_neq a b+ ]++ testAcc :: (Eq a, A.Eq a, Show (ArgType a))+ => Gen a+ -> TestTree+ testAcc a =+ testGroup (showType a)+ [ testProperty "(==)" $ prop_acc_eq runN a+ , testProperty "(/=)" $ prop_acc_neq runN a+ ]+++prop_eq+ :: (Iso a b, Eq a, Eq b, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_eq a b =+ property $ do+ x <- forAll a+ y <- forAll a+ prop_binary' (==) (==) b x y++prop_neq+ :: (Iso a b, Eq a, Eq b, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_neq a b =+ property $ do+ x <- forAll a+ y <- forAll a+ prop_binary' (/=) (/=) b x y++prop_acc_eq+ :: (Eq a, A.Eq a)+ => RunN+ -> Gen a+ -> Property+prop_acc_eq runN a =+ property $ do+ x <- forAll a+ y <- forAll a+ prop_acc_binary (==) (A.==) runN x y++prop_acc_neq+ :: (Eq a, A.Eq a)+ => RunN+ -> Gen a+ -> Property+prop_acc_neq runN a =+ property $ do+ x <- forAll a+ y <- forAll a+ prop_acc_binary (/=) (A./=) runN x y+
+ test/Test/BigNum/FiniteBits.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+-- |+-- Module : Test.BigNum.FiniteBits+-- Copyright : [2017] Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Test.BigNum.FiniteBits ( test_finitebits )+ where++import Test.Iso+import Test.Base+import Test.Types+import Test.ShowType++import qualified Data.Array.Accelerate.Data.Bits as A++import Data.Bits+import Data.Proxy+import Hedgehog+import Test.Tasty+import Test.Tasty.Hedgehog+++test_finitebits :: RunN -> TestTree+test_finitebits runN =+ testGroup "FiniteBits"+ [ testElt i64 (Proxy :: Proxy I64)+ , testElt w64 (Proxy :: Proxy U64)+ , testElt i64 (Proxy :: Proxy II64)+ , testElt w64 (Proxy :: Proxy UU64)+ , testAcc w96+ , testAcc i96+ , testAcc w128+ , testAcc i128+ ]+ where+ testElt :: (Iso a b, Eq a, Eq b, FiniteBits a, FiniteBits b, Show a, Show b, Show (ArgType b))+ => Gen a+ -> Proxy b+ -> TestTree+ testElt a b =+ testGroup (showType b)+ [ testProperty "countLeadingZeros" $ prop_clz a b+ , testProperty "countTrailingZeros" $ prop_ctz a b+ ]++ testAcc :: (Eq a, FiniteBits a, A.FiniteBits a, Show (ArgType a))+ => Gen a+ -> TestTree+ testAcc a =+ testGroup (showType a)+ [ testProperty "countLeadingZeros" $ prop_acc_clz runN a+ , testProperty "countTrailingZeros" $ prop_acc_ctz runN a+ ]+++prop_clz+ :: (Iso a b, FiniteBits a, FiniteBits b, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_clz a b =+ property $ do+ x <- forAll a+ prop_unary' countLeadingZeros countLeadingZeros b x++prop_ctz+ :: (Iso a b, FiniteBits a, FiniteBits b, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_ctz a b =+ property $ do+ x <- forAll a+ prop_unary' countTrailingZeros countTrailingZeros b x++prop_acc_clz+ :: (FiniteBits a, A.FiniteBits a)+ => RunN+ -> Gen a+ -> Property+prop_acc_clz runN a =+ property $ do+ x <- forAll a+ prop_acc_unary countLeadingZeros A.countLeadingZeros runN x++prop_acc_ctz+ :: (FiniteBits a, A.FiniteBits a)+ => RunN+ -> Gen a+ -> Property+prop_acc_ctz runN a =+ property $ do+ x <- forAll a+ prop_acc_unary countTrailingZeros A.countTrailingZeros runN x+
+ test/Test/BigNum/FromIntegral.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- |+-- Module : Test.BigNum.FromIntegral+-- Copyright : [2017] Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Test.BigNum.FromIntegral ( test_fromIntegral )+ where++import Test.Iso+import Test.Base+import Test.ShowType++import Data.Array.Accelerate.Data.BigInt+import Data.Array.Accelerate.Data.BigWord++import Data.Array.Accelerate ( Exp )+import qualified Data.Array.Accelerate as A++import Data.Int+import Data.Proxy+import Data.Word+import Hedgehog+import Test.Tasty+import Test.Tasty.Hedgehog+import Text.Printf+++test_fromIntegral :: RunN -> TestTree+test_fromIntegral runN =+ testGroup "FromIntegral"+ [ -- little -> big+ testElt w32 (Proxy::Proxy Word128)+ , testElt w32 (Proxy::Proxy Word192)+ , testElt w32 (Proxy::Proxy Int128)+ , testElt w32 (Proxy::Proxy Int192)+ , testElt i32 (Proxy::Proxy Word128)+ , testElt i32 (Proxy::Proxy Word192)+ , testElt i32 (Proxy::Proxy Int128)+ , testElt i32 (Proxy::Proxy Int192)+ , testElt w64 (Proxy::Proxy Word128)+ , testElt w64 (Proxy::Proxy Word192)+ , testElt w64 (Proxy::Proxy Int128)+ , testElt w64 (Proxy::Proxy Int192)+ , testElt i64 (Proxy::Proxy Word128)+ , testElt i64 (Proxy::Proxy Word192)+ , testElt i64 (Proxy::Proxy Int128)+ , testElt i64 (Proxy::Proxy Int192)+ -- big -> little+ , testElt w128 (Proxy::Proxy Word32)+ , testElt w192 (Proxy::Proxy Word32)+ , testElt i128 (Proxy::Proxy Word32)+ , testElt i192 (Proxy::Proxy Word32)+ , testElt w128 (Proxy::Proxy Word64)+ , testElt w192 (Proxy::Proxy Word64)+ , testElt i128 (Proxy::Proxy Word64)+ , testElt i192 (Proxy::Proxy Word64)+ , testElt w128 (Proxy::Proxy Int32)+ , testElt w192 (Proxy::Proxy Int32)+ , testElt i128 (Proxy::Proxy Int32)+ , testElt i192 (Proxy::Proxy Int32)+ , testElt w128 (Proxy::Proxy Int64)+ , testElt w192 (Proxy::Proxy Int64)+ , testElt i128 (Proxy::Proxy Int64)+ , testElt i192 (Proxy::Proxy Int64)+ ]+ where+ testElt+ :: (Integral a, Num b, Eq b, A.Integral a, A.Num b, A.FromIntegral a b, Show (ArgType a), Show (ArgType b))+ => Gen a+ -> Proxy b+ -> TestTree+ testElt a b =+ testProperty (printf "%s->%s" (showType a) (showType b)) $ prop_fromIntegral runN a b+++prop_fromIntegral+ :: forall a b. (Integral a, Num b, Eq b, A.Integral a, A.Num b, A.FromIntegral a b)+ => RunN+ -> Gen a+ -> Proxy b+ -> Property+prop_fromIntegral runN a _ =+ property $ do+ x <- forAll a+ prop_acc_unary fromIntegral (A.fromIntegral :: Exp a -> Exp b) runN x+
+ test/Test/BigNum/Integral.hs view
@@ -0,0 +1,220 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE RankNTypes #-}+-- |+-- Module : Test.BigNum.Integral+-- Copyright : [2017] Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Test.BigNum.Integral ( test_integral )+ where++import Test.Iso+import Test.Base+import Test.Types+import Test.ShowType++import qualified Data.Array.Accelerate as A++import Data.Proxy+import Hedgehog+import Test.Tasty+import Test.Tasty.Hedgehog+++test_integral :: RunN -> TestTree+test_integral runN =+ testGroup "Integral"+ [ testElt i64 (Proxy :: Proxy I64)+ , testElt w64 (Proxy :: Proxy U64)+ , testElt i64 (Proxy :: Proxy II64)+ , testElt w64 (Proxy :: Proxy UU64)+ , testAcc w96+ , testAcc i96+ , testAcc w128+ , testAcc i128+ ]+ where+ testElt :: (Iso a b, Eq a, Eq b, Integral a, Integral b, Show a, Show b, Show (ArgType b))+ => Gen a+ -> Proxy b+ -> TestTree+ testElt a b =+ testGroup (showType b)+ [ testProperty "quot" $ prop_quot a b+ , testProperty "rem" $ prop_rem a b+ , testProperty "div" $ prop_div a b+ , testProperty "mod" $ prop_mod a b+ , testProperty "quotRem" $ prop_quotRem a b+ , testProperty "divMod" $ prop_divMod a b+ , testProperty "toInteger" $ prop_toInteger a b+ ]++ testAcc :: (Eq a, Integral a, A.Integral a, Show (ArgType a))+ => Gen a+ -> TestTree+ testAcc a =+ testGroup (showType a)+ [ testProperty "quot" $ prop_acc_quot runN a+ , testProperty "rem" $ prop_acc_rem runN a+ , testProperty "quotRem" $ prop_acc_quotRem runN a+ , testProperty "div" $ prop_acc_div runN a+ , testProperty "mod" $ prop_acc_mod runN a+ , testProperty "divMod" $ prop_acc_divMod runN a+ ]+++prop_quot+ :: (Iso a b, Integral a, Integral b, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_quot a b =+ property $ do+ x <- forAll a+ y <- forAll (a `except` (== 0))+ prop_binary quot quot b x y++prop_rem+ :: (Iso a b, Integral a, Integral b, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_rem a b =+ property $ do+ x <- forAll a+ y <- forAll (a `except` (== 0))+ prop_binary rem rem b x y++prop_div+ :: (Iso a b, Integral a, Integral b, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_div a b =+ property $ do+ x <- forAll a+ y <- forAll (a `except` (== 0))+ prop_binary div div b x y++prop_mod+ :: (Iso a b, Integral a, Integral b, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_mod a b =+ property $ do+ x <- forAll a+ y <- forAll (a `except` (== 0))+ prop_binary mod mod b x y++prop_quotRem+ :: (Iso a b, Integral a, Integral b, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_quotRem a b =+ property $ do+ x <- forAll a+ y <- forAll (a `except` (== 0))+ let qr = quotRem x y+ (q,r) = quotRem (toIso b x) (toIso b y)+ --+ qr === (fromIso b q, fromIso b r)++prop_divMod+ :: (Iso a b, Integral a, Integral b, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_divMod a b =+ property $ do+ x <- forAll a+ y <- forAll (a `except` (== 0))+ let qr = divMod x y+ (q,r) = divMod (toIso b x) (toIso b y)+ --+ qr === (fromIso b q, fromIso b r)++prop_toInteger+ :: (Iso a b, Integral a, Integral b, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_toInteger a b =+ property $ do+ x <- forAll a+ prop_unary' toInteger toInteger b x++prop_acc_quot+ :: (Integral a, A.Integral a)+ => RunN+ -> Gen a+ -> Property+prop_acc_quot runN a =+ property $ do+ x <- forAll a+ y <- forAll (a `except` (== 0))+ prop_acc_binary quot quot runN x y++prop_acc_rem+ :: (Integral a, A.Integral a)+ => RunN+ -> Gen a+ -> Property+prop_acc_rem runN a =+ property $ do+ x <- forAll a+ y <- forAll (a `except` (== 0))+ prop_acc_binary rem rem runN x y++prop_acc_div+ :: (Integral a, A.Integral a)+ => RunN+ -> Gen a+ -> Property+prop_acc_div runN a =+ property $ do+ x <- forAll a+ y <- forAll (a `except` (== 0))+ prop_acc_binary div div runN x y++prop_acc_mod+ :: (Integral a, A.Integral a)+ => RunN+ -> Gen a+ -> Property+prop_acc_mod runN a =+ property $ do+ x <- forAll a+ y <- forAll (a `except` (== 0))+ prop_acc_binary mod mod runN x y++prop_acc_quotRem+ :: (Integral a, A.Integral a)+ => RunN+ -> Gen a+ -> Property+prop_acc_quotRem runN a =+ property $ do+ x <- forAll a+ y <- forAll (a `except` (== 0))+ prop_acc_binary quotRem (A.lift $$ quotRem) runN x y++prop_acc_divMod+ :: (Integral a, A.Integral a)+ => RunN+ -> Gen a+ -> Property+prop_acc_divMod runN a =+ property $ do+ x <- forAll a+ y <- forAll (a `except` (== 0))+ prop_acc_binary divMod (A.lift $$ divMod) runN x y+
+ test/Test/BigNum/Num.hs view
@@ -0,0 +1,219 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- |+-- Module : Test.BigNum.Num+-- Copyright : [2017] Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Test.BigNum.Num ( test_num )+ where++import Test.Iso+import Test.Base+import Test.Types+import Test.ShowType++import qualified Data.Array.Accelerate as A++import Data.Proxy+import Hedgehog+import Test.Tasty+import Test.Tasty.Hedgehog+++test_num :: RunN -> TestTree+test_num runN =+ testGroup "Num"+ [ testElt i64 (Proxy :: Proxy I64)+ , testElt w64 (Proxy :: Proxy U64)+ , testElt i64 (Proxy :: Proxy II64)+ , testElt w64 (Proxy :: Proxy UU64)+ , testAcc w96+ , testAcc i96+ , testAcc w128+ , testAcc i128+ ]+ where+ testElt :: (Iso a b, Eq a, Eq b, Num a, Num b, Show a, Show b, Show (ArgType b))+ => Gen a+ -> Proxy b+ -> TestTree+ testElt a b =+ testGroup (showType b)+ [ testProperty "negate" $ prop_negate a b+ , testProperty "abs" $ prop_abs a b+ , testProperty "signum" $ prop_signum a b+ , testProperty "(+)" $ prop_add a b+ , testProperty "(-)" $ prop_sub a b+ , testProperty "(*)" $ prop_mul a b+ , testProperty "fromInteger" $ prop_fromInteger b+ ]++ testAcc :: (Eq a, Num a, A.Num a, Show (ArgType a))+ => Gen a+ -> TestTree+ testAcc a =+ testGroup (showType a)+ [ testProperty "negate" $ prop_acc_negate runN a+ , testProperty "abs" $ prop_acc_abs runN a+ , testProperty "signum" $ prop_acc_signum runN a+ , testProperty "(+)" $ prop_acc_add runN a+ , testProperty "(-)" $ prop_acc_sub runN a+ , testProperty "(*)" $ prop_acc_mul runN a+ , testProperty "fromInteger" $ prop_acc_fromInteger runN a+ ]+++prop_negate+ :: (Iso a b, Num a, Num b, Eq a, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_negate a b =+ property $ do+ x <- forAll a+ prop_unary negate negate b x++prop_abs+ :: (Iso a b, Num a, Num b, Eq a, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_abs a b =+ property $ do+ x <- forAll a+ prop_unary abs abs b x++prop_signum+ :: (Iso a b, Num a, Num b, Eq a, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_signum a b =+ property $ do+ x <- forAll a+ prop_unary signum signum b x++prop_add+ :: (Iso a b, Num a, Num b, Eq a, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_add a b =+ property $ do+ x <- forAll a+ y <- forAll a+ prop_binary (+) (+) b x y++prop_sub+ :: (Iso a b, Num a, Num b, Eq a, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_sub a b =+ property $ do+ x <- forAll a+ y <- forAll a+ prop_binary (-) (-) b x y++prop_mul+ :: (Iso a b, Num a, Num b, Eq a, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_mul a b =+ property $ do+ x <- forAll a+ y <- forAll a+ prop_binary (*) (*) b x y++prop_fromInteger+ :: (Iso a b, Num a, Num b, Eq a, Show a, Show b)+ => Proxy b+ -> Property+prop_fromInteger t =+ property $ do+ x <- forAll integer+ fromInteger x === fromIso t (fromInteger x)+++prop_acc_negate+ :: (Num a, A.Num a, Eq a)+ => RunN+ -> Gen a+ -> Property+prop_acc_negate runN a =+ property $ do+ x <- forAll a+ prop_acc_unary negate negate runN x++prop_acc_abs+ :: (Num a, A.Num a, Eq a)+ => RunN+ -> Gen a+ -> Property+prop_acc_abs runN a =+ property $ do+ x <- forAll a+ prop_acc_unary abs abs runN x++prop_acc_signum+ :: (Num a, A.Num a, Eq a)+ => RunN+ -> Gen a+ -> Property+prop_acc_signum runN a =+ property $ do+ x <- forAll a+ prop_acc_unary signum signum runN x++prop_acc_add+ :: (Num a, A.Num a, Eq a)+ => RunN+ -> Gen a+ -> Property+prop_acc_add runN a =+ property $ do+ x <- forAll a+ y <- forAll a+ prop_acc_binary (+) (+) runN x y++prop_acc_sub+ :: (Num a, A.Num a, Eq a)+ => RunN+ -> Gen a+ -> Property+prop_acc_sub runN a =+ property $ do+ x <- forAll a+ y <- forAll a+ prop_acc_binary (-) (-) runN x y++prop_acc_mul+ :: (Num a, A.Num a, Eq a)+ => RunN+ -> Gen a+ -> Property+prop_acc_mul runN a =+ property $ do+ x <- forAll a+ y <- forAll a+ prop_acc_binary (*) (*) runN x y++prop_acc_fromInteger+ :: forall proxy a. (Num a, Eq a, A.Num a)+ => RunN+ -> proxy a+ -> Property+prop_acc_fromInteger runN _ =+ property $ do+ x <- forAll integer+ fromInteger x === isoL (runN (A.unit (fromInteger x :: A.Exp a)))+
+ test/Test/BigNum/Num2.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+-- |+-- Module : Test.BigNum.Num2+-- Copyright : [2017] Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Test.BigNum.Num2 ( test_num2 )+ where++import Test.Base+import Test.Iso+import Test.ShowType++import Data.Array.Accelerate.Data.BigInt+import Data.Array.Accelerate ( Elt, Exp, Plain, Lift )+import qualified Data.Array.Accelerate as A++import Data.Bits+import Hedgehog+import Test.Tasty+import Test.Tasty.Hedgehog+++test_num2 :: RunN -> TestTree+test_num2 runN =+ testGroup "Num2"+ [ testElt w8+ , testElt w16+ , testElt w32+ , testElt w64+ , testElt i8+ , testElt i16+ , testElt i32+ , testElt i64+ ]+ where+ testElt :: ( Num2 e, Integral e, Show e, Show (ArgType e), FiniteBits (Unsigned e), Integral (Unsigned e)+ , Num2 (Exp e), Elt e, Elt (Unsigned e), Lift Exp (Unsigned (Exp e)), Plain (Unsigned (Exp e)) ~ Unsigned e )+ => Gen e+ -> TestTree+ testElt e =+ testGroup (showType e)+ [ testProperty "addWithCarry" $ prop_addWithCarry e+ , testProperty "mulWithCarry" $ prop_mulWithCarry e+ --+ , testProperty "addWithCarry" $ prop_acc_addWithCarry runN e+ , testProperty "mulWithCarry" $ prop_acc_mulWithCarry runN e+ ]+++prop_addWithCarry+ :: (Num2 e, Integral e, Show e, FiniteBits (Unsigned e), Integral (Unsigned e))+ => Gen e+ -> Property+prop_addWithCarry e =+ property $ do+ x <- forAll e+ y <- forAll e+ uncurry toInteger2 (addWithCarry x y) === toInteger x + toInteger y++prop_mulWithCarry+ :: (Num2 e, Integral e, Show e, FiniteBits (Unsigned e), Integral (Unsigned e))+ => Gen e+ -> Property+prop_mulWithCarry e =+ property $ do+ x <- forAll e+ y <- forAll e+ uncurry toInteger2 (mulWithCarry x y) === toInteger x * toInteger y++prop_acc_addWithCarry+ :: ( Num2 (Exp e), Integral e, FiniteBits (Unsigned e), Integral (Unsigned e)+ , Elt e, Elt (Unsigned e), Lift Exp (Unsigned (Exp e)), Plain (Unsigned (Exp e)) ~ Unsigned e )+ => RunN+ -> Gen e+ -> Property+prop_acc_addWithCarry runN e =+ property $ do+ x <- forAll e+ y <- forAll e+ uncurry toInteger2 (with_acc_binary runN (A.lift $$ addWithCarry) x y) === toInteger x + toInteger y++prop_acc_mulWithCarry+ :: ( Num2 (Exp e), Integral e, FiniteBits (Unsigned e), Integral (Unsigned e)+ , Elt e, Elt (Unsigned e), Lift Exp (Unsigned (Exp e)), Plain (Unsigned (Exp e)) ~ Unsigned e )+ => RunN+ -> Gen e+ -> Property+prop_acc_mulWithCarry runN e =+ property $ do+ x <- forAll e+ y <- forAll e+ uncurry toInteger2 (with_acc_binary runN (A.lift $$ mulWithCarry) x y) === toInteger x * toInteger y+
+ test/Test/BigNum/Ord.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+-- |+-- Module : Test.BigNum.Ord+-- Copyright : [2017] Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Test.BigNum.Ord ( test_ord )+ where++import Test.Iso+import Test.Base+import Test.Types+import Test.ShowType++import qualified Data.Array.Accelerate as A++import Data.Proxy+import Hedgehog+import Test.Tasty+import Test.Tasty.Hedgehog+++test_ord :: RunN -> TestTree+test_ord runN =+ testGroup "Ord"+ [ testElt w64 (Proxy :: Proxy U64)+ , testElt i64 (Proxy :: Proxy I64)+ , testElt w64 (Proxy :: Proxy UU64)+ , testElt i64 (Proxy :: Proxy II64)+ , testAcc w96+ , testAcc i96+ , testAcc w128+ , testAcc i128+ ]+ where+ testElt :: (Iso a b, Ord a, Ord b, Show a, Show b, Show (ArgType b))+ => Gen a+ -> Proxy b+ -> TestTree+ testElt a b =+ testGroup (showType b)+ [ testProperty "compare" $ prop_compare a b+ ]++ testAcc :: (Ord a, A.Ord a, Show (ArgType a))+ => Gen a+ -> TestTree+ testAcc a =+ testGroup (showType a)+ [ testProperty "(<)" $ prop_acc_lt runN a+ , testProperty "(>)" $ prop_acc_gt runN a+ , testProperty "(<=)" $ prop_acc_lte runN a+ , testProperty "(>=)" $ prop_acc_gte runN a+ ]+++prop_compare+ :: (Iso a b, Ord a, Ord b, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_compare a b =+ property $ do+ x <- forAll a+ y <- forAll a+ prop_binary' compare compare b x y++prop_acc_lt+ :: (Ord a, A.Ord a)+ => RunN+ -> Gen a+ -> Property+prop_acc_lt runN a =+ property $ do+ x <- forAll a+ y <- forAll a+ prop_acc_binary (<) (A.<) runN x y++prop_acc_gt+ :: (Ord a, A.Ord a)+ => RunN+ -> Gen a+ -> Property+prop_acc_gt runN a =+ property $ do+ x <- forAll a+ y <- forAll a+ prop_acc_binary (>) (A.>) runN x y++prop_acc_lte+ :: (Ord a, A.Ord a)+ => RunN+ -> Gen a+ -> Property+prop_acc_lte runN a =+ property $ do+ x <- forAll a+ y <- forAll a+ prop_acc_binary (<=) (A.<=) runN x y++prop_acc_gte+ :: (Ord a, A.Ord a)+ => RunN+ -> Gen a+ -> Property+prop_acc_gte runN a =+ property $ do+ x <- forAll a+ y <- forAll a+ prop_acc_binary (>=) (A.>=) runN x y+
+ test/Test/BigNum/Real.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+-- |+-- Module : Test.BigNum.Real+-- Copyright : [2017] Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Test.BigNum.Real ( test_real )+ where++import Test.Iso+import Test.Base+import Test.Types+import Test.ShowType++import Data.Proxy+import Hedgehog+import Test.Tasty+import Test.Tasty.Hedgehog+++test_real :: TestTree+test_real =+ testGroup "Real"+ [ testElt i64 (Proxy :: Proxy I64)+ , testElt w64 (Proxy :: Proxy U64)+ , testElt i64 (Proxy :: Proxy II64)+ , testElt w64 (Proxy :: Proxy UU64)+ ]+ where+ testElt :: (Iso a b, Eq a, Eq b, Real a, Real b, Show a, Show b, Show (ArgType b))+ => Gen a+ -> Proxy b+ -> TestTree+ testElt a b =+ testGroup (showType b)+ [ testProperty "toRational" $ prop_toRational a b+ ]+++prop_toRational+ :: (Iso a b, Real a, Real b, Show a, Show b)+ => Gen a+ -> Proxy b+ -> Property+prop_toRational a b =+ property $ do+ x <- forAll a+ prop_unary' toRational toRational b x+
+ test/Test/Iso.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeSynonymInstances #-}+-- |+-- Module : Test.Iso+-- Copyright : [2017] Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Test.Iso where++import Test.Base++import Data.Array.Accelerate.Array.Sugar+import Data.Array.Accelerate ( Exp )+import qualified Data.Array.Accelerate as A++import Hedgehog+++class Iso a b | b -> a where+ isoR :: a -> b+ isoL :: b -> a++fromIso :: Iso a b => proxy b -> b -> a+fromIso _ = isoL++toIso :: Iso a b => proxy b -> a -> b+toIso _ = isoR++instance Elt a => Iso a (Scalar a) where+ isoR x = fromFunction Z (const x)+ isoL x = x ! Z+++with_unary :: Iso a b => proxy b -> (b -> b) -> a -> a+with_unary _ f = isoL . f . isoR++with_unary' :: Iso a b => proxy b -> (b -> r) -> a -> r+with_unary' _ f x = f (isoR x)++with_binary :: Iso a b => proxy b -> (b -> b -> b) -> a -> a -> a+with_binary _ f x y = isoL $ f (isoR x) (isoR y)++with_binary' :: Iso a b => proxy b -> (b -> b -> r) -> a -> a -> r+with_binary' _ f x y = f (isoR x) (isoR y)+++prop_unary+ :: (Iso a b, Eq a, Show a, MonadTest m)+ => (a -> a)+ -> (b -> b)+ -> proxy b+ -> a+ -> m ()+prop_unary f g p x = f x === with_unary p g x++prop_unary'+ :: (Iso a b, Eq r, Show r, MonadTest m)+ => (a -> r)+ -> (b -> r)+ -> proxy b+ -> a+ -> m ()+prop_unary' f g p x = f x === with_unary' p g x++prop_binary+ :: (Iso a b, Eq a, Show a, MonadTest m)+ => (a -> a -> a)+ -> (b -> b -> b)+ -> proxy b+ -> a+ -> a+ -> m ()+prop_binary f g p x y = f x y === with_binary p g x y++prop_binary'+ :: (Iso a b, Eq r, Show r, MonadTest m)+ => (a -> a -> r)+ -> (b -> b -> r)+ -> proxy b+ -> a+ -> a+ -> m ()+prop_binary' f g p x y = f x y === with_binary' p g x y+++{-# INLINE with_acc_unary #-}+with_acc_unary+ :: forall a b. (Elt a, Elt b)+ => RunN+ -> (Exp a -> Exp b)+ -> a+ -> b+with_acc_unary runN f = isoL . go . isoR+ where+ go :: Scalar a -> Scalar b+ !go = runN (A.map f)++{-# INLINE with_acc_binary #-}+with_acc_binary+ :: forall a b c. (Elt a, Elt b, Elt c)+ => RunN+ -> (Exp a -> Exp b -> Exp c)+ -> a+ -> b+ -> c+with_acc_binary runN f x y = isoL $ go (isoR x) (isoR y)+ where+ go :: Scalar a -> Scalar b -> Scalar c+ !go = runN (A.zipWith f)++{-# INLINE prop_acc_unary #-}+prop_acc_unary+ :: (Elt a, Elt b, Eq b, MonadTest m)+ => (a -> b)+ -> (Exp a -> Exp b)+ -> RunN+ -> a+ -> m ()+prop_acc_unary f g runN x = f x === with_acc_unary runN g x++{-# INLINE prop_acc_binary #-}+prop_acc_binary+ :: (Elt a, Elt b, Elt c, Eq c, MonadTest m)+ => (a -> b -> c)+ -> (Exp a -> Exp b -> Exp c)+ -> RunN+ -> a+ -> b+ -> m ()+prop_acc_binary f g runN x y = f x y === with_acc_binary runN g x y+
+ test/Test/ShowType.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- |+-- Module : Test.ShowType+-- Copyright : [2017] Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Test.ShowType ( ArgType, showType )+ where++import Data.Bits+import Data.Int+import Data.Word+import Text.Printf++import Test.Types++import Data.Array.Accelerate.Data.BigInt+import Data.Array.Accelerate.Data.BigWord+++showType :: forall proxy a. Show (ArgType a) => proxy a -> String+showType _ = show (AT :: ArgType a)++data ArgType (a :: *) = AT++instance FiniteBits (BigWord a b) => Show (ArgType (BigWord a b)) where+ show _ = printf "Word%d" (finiteBitSize (undefined::BigWord a b))++instance FiniteBits (BigInt a b) => Show (ArgType (BigInt a b)) where+ show _ = printf "Int%d" (finiteBitSize (undefined::BigInt a b))++instance Show (ArgType Int8) where show _ = "Int8"+instance Show (ArgType Int16) where show _ = "Int16"+instance Show (ArgType Int32) where show _ = "Int32"+instance Show (ArgType Int64) where show _ = "Int64"+instance Show (ArgType Word8) where show _ = "Word8"+instance Show (ArgType Word16) where show _ = "Word16"+instance Show (ArgType Word32) where show _ = "Word32"+instance Show (ArgType Word64) where show _ = "Word64"++instance Show (ArgType I64) where show _ = "I64"+instance Show (ArgType U64) where show _ = "U64"+instance Show (ArgType II64) where show _ = "II64"+instance Show (ArgType UU64) where show _ = "UU64"+
+ test/Test/Types.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+-- |+-- Module : Test.Types+-- Copyright : [2017] Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Test.Types where++import Test.Iso++import Data.Array.Accelerate.Data.BigInt+import Data.Array.Accelerate.Data.BigWord++import Data.Bits+import Data.Int+import Data.Word+++newtype I64 = I64 (BigInt Int32 Word32)+ deriving (Show, Eq, Ord, Bounded, Num, Real, Enum, Integral, Bits, FiniteBits)++newtype U64 = U64 (BigWord Word32 Word32)+ deriving (Show, Eq, Ord, Bounded, Num, Real, Enum, Integral, Bits, FiniteBits)++newtype II64 = II64 (BigInt Int16 (BigWord Word16 Word32))+ deriving (Show, Eq, Ord, Bounded, Num, Real, Enum, Integral, Bits, FiniteBits)++newtype UU64 = UU64 (BigWord Word16 (BigWord Word16 Word32))+ deriving (Show, Eq, Ord, Bounded, Num, Real, Enum, Integral, Bits, FiniteBits)++instance Iso Int64 I64 where+ isoR w = I64 (I2 (fromIntegral (w `shiftR` 32)) (fromIntegral w))+ isoL (I64 (I2 h l)) = fromIntegral h `shiftL` 32 .|. fromIntegral l++instance Iso Word64 U64 where+ isoR w = U64 (W2 (fromIntegral (w `shiftR` 32)) (fromIntegral w))+ isoL (U64 (W2 h l)) = fromIntegral h `shiftL` 32 .|. fromIntegral l++instance Iso Int64 II64 where+ isoR w+ = II64 (I2 (fromIntegral (w `shiftR` 48)) (W2 (fromIntegral (w `shiftR` 32)) (fromIntegral w)))++ isoL (II64 (I2 h (W2 lh ll)))+ = fromIntegral h `shiftL` 48+ .|. fromIntegral lh `shiftL` 32+ .|. fromIntegral ll++instance Iso Word64 UU64 where+ isoR w+ = UU64 (W2 (fromIntegral (w `shiftR` 48)) (W2 (fromIntegral (w `shiftR` 32)) (fromIntegral w)))++ isoL (UU64 (W2 h (W2 lh ll)))+ = fromIntegral h `shiftL` 48+ .|. fromIntegral lh `shiftL` 32+ .|. fromIntegral ll+
+ test/TestNative.hs view
@@ -0,0 +1,19 @@+-- |+-- Module : TestNative+-- Copyright : [2017] Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module TestNative+ where++import Test.BigNum+import Data.Array.Accelerate.LLVM.Native as CPU++main :: IO ()+main = bignum CPU.runN+
+ test/TestPTX.hs view
@@ -0,0 +1,19 @@+-- |+-- Module : TestPTX+-- Copyright : [2017] Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module TestPTX+ where++import Test.BigNum+import Data.Array.Accelerate.LLVM.PTX as PTX++main :: IO ()+main = bignum PTX.runN+