accelerate-bignum 0.2.0.0 → 0.3.0.0
raw patch · 35 files changed
+565/−488 lines, 35 filesdep +accelerate-io-vectordep −accelerate-iodep ~acceleratedep ~accelerate-llvmdep ~accelerate-llvm-nativePVP ok
version bump matches the API change (PVP)
Dependencies added: accelerate-io-vector
Dependencies removed: accelerate-io
Dependency ranges changed: accelerate, accelerate-llvm, accelerate-llvm-native, accelerate-llvm-ptx, base
API changes (from Hackage documentation)
Files
- CHANGELOG.md +11/−3
- LICENSE +1/−1
- README.md +17/−5
- accelerate-bignum.cabal +14/−15
- bench/Accelerate.hs +1/−6
- src/Data/Array/Accelerate/Data/BigInt.hs +2/−2
- src/Data/Array/Accelerate/Data/BigWord.hs +2/−2
- src/Data/Array/Accelerate/Internal/BigInt.hs +5/−3
- src/Data/Array/Accelerate/Internal/BigInt.hs-boot +1/−1
- src/Data/Array/Accelerate/Internal/BigWord.hs +5/−3
- src/Data/Array/Accelerate/Internal/LLVM/Native.hs +4/−3
- src/Data/Array/Accelerate/Internal/LLVM/PTX.hs +4/−3
- src/Data/Array/Accelerate/Internal/LLVM/Prim.hs +101/−78
- src/Data/Array/Accelerate/Internal/Num2.hs +2/−2
- src/Data/Array/Accelerate/Internal/Orphans.hs +2/−2
- src/Data/Array/Accelerate/Internal/Orphans/Base.hs +271/−217
- src/Data/Array/Accelerate/Internal/Orphans/Elt.hs +26/−46
- test/Test/Base.hs +5/−4
- test/Test/BigNum.hs +2/−2
- test/Test/BigNum/Bits.hs +19/−19
- test/Test/BigNum/Bounded.hs +5/−5
- test/Test/BigNum/Enum.hs +2/−2
- test/Test/BigNum/Eq.hs +5/−5
- test/Test/BigNum/FiniteBits.hs +5/−5
- test/Test/BigNum/FromIntegral.hs +4/−4
- test/Test/BigNum/Integral.hs +9/−9
- test/Test/BigNum/Num.hs +10/−10
- test/Test/BigNum/Num2.hs +7/−7
- test/Test/BigNum/Ord.hs +7/−7
- test/Test/BigNum/Real.hs +2/−2
- test/Test/Iso.hs +6/−7
- test/Test/ShowType.hs +2/−2
- test/Test/Types.hs +2/−2
- test/TestNative.hs +2/−2
- test/TestPTX.hs +2/−2
CHANGELOG.md view
@@ -7,14 +7,22 @@ (PVP)](https://pvp.haskell.org) +## [0.3.0.0] - 2020-08-26+### Changed+ * update for accelerate-1.3+ * support LLVM-9+ ## [0.2.0.0] - 2018-04-03- * update for accelerate-1.2- * support LLVM-6.0+### Changed+ * update for accelerate-1.2+ * support LLVM-6.0 ## [0.1.0.0] - 2017-03-31- * initial release+### New+ * initial release +[0.3.0.0]: https://github.com/tmcdonell/accelerate-bignum/compare/0.2.0.0...v0.3.0.0 [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
LICENSE view
@@ -1,4 +1,4 @@-Copyright Trevor L. McDonell (c) 2017+Copyright Trevor L. McDonell (c) [2016..2020] All rights reserved.
README.md view
@@ -1,12 +1,24 @@-Big-number arithmetic for Accelerate-====================================+<div align="center">+<img width="450" src="https://github.com/AccelerateHS/accelerate/raw/master/images/accelerate-logo-text-v.png?raw=true" alt="henlo, my name is Theia"/> -[](https://travis-ci.org/tmcdonell/accelerate-bignum)+# Big-number arithmetic++[](https://github.com/tmcdonell/accelerate-bignum/actions)+[](https://gitter.im/AccelerateHS/Lobby)+<br>+[](https://stackage.org/lts/package/accelerate-bignum)+[](https://stackage.org/nightly/package/accelerate-bignum) [](https://hackage.haskell.org/package/accelerate-bignum) +</div>+ 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+for [Accelerate][accelerate]. Signed and unsigned 96, 128, 160, 192, 224, 256, and 512-bit types are predefined. -For details on Accelerate refer to the [main repository](https://github.com/AccelerateHS/accelerate).+Contributions and bug reports are welcome!<br>+Please feel free to contact me through [GitHub][accelerate] or [gitter.im][gitter.im].++ [accelerate]: https://github.com/AccelerateHS/accelerate+ [gitter.im]: https://gitter.im/AccelerateHS/Lobby
accelerate-bignum.cabal view
@@ -1,5 +1,5 @@ name: accelerate-bignum-version: 0.2.0.0+version: 0.3.0.0 synopsis: Fixed-length large integer arithmetic for Accelerate description: This package provides fixed-length large integer types and arithmetic@@ -14,9 +14,9 @@ license: BSD3 license-file: LICENSE author: Trevor L. McDonell-maintainer: Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+maintainer: Trevor L. McDonell <trevor.mcdonell@gmail.com> copyright: BSD3-category: Compilers/Interpreters, Concurrency, Data, Parallelism+category: Accelerate, Data build-type: Simple cabal-version: >= 1.10 @@ -50,16 +50,16 @@ Data.Array.Accelerate.Internal.Orphans.Elt build-depends:- base >= 4.8 && < 4.12- , accelerate >= 1.0+ base >= 4.8 && < 5+ , accelerate >= 1.3 , ghc-prim , template-haskell if flag(llvm-cpu) cpp-options: -DACCELERATE_LLVM_NATIVE_BACKEND build-depends:- accelerate-llvm >= 1.0- , accelerate-llvm-native >= 1.0+ accelerate-llvm >= 1.3+ , accelerate-llvm-native >= 1.3 , llvm-hs-pure >= 3.9 -- other-modules:@@ -68,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.3+ , accelerate-llvm-ptx >= 1.3 , llvm-hs-pure >= 3.9 -- other-modules:@@ -100,7 +100,7 @@ buildable: False build-depends:- base >= 4.7 && < 4.12+ base >= 4.7 && < 5 , accelerate , accelerate-bignum , accelerate-llvm-native@@ -144,7 +144,7 @@ buildable: False build-depends:- base >= 4.7 && < 4.12+ base >= 4.7 && < 5 , accelerate , accelerate-bignum , accelerate-llvm-ptx@@ -187,10 +187,10 @@ WideWord build-depends:- base >= 4.8 && < 4.12+ base >= 4.8 && < 5 , accelerate , accelerate-bignum- , accelerate-io >= 0.16+ , accelerate-io-vector >= 0.1 , criterion >= 1.0 , mwc-random >= 0.13 , vector >= 0.11@@ -225,8 +225,7 @@ source-repository this type: git- tag: 0.2.0.0+ tag: v0.3.0.0 location: https://github.com/tmcdonell/accelerate-bignum -- vim: nospell-
bench/Accelerate.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PolyKinds #-}@@ -12,15 +11,11 @@ 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-import Prelude ( String, Show(..), undefined )+import Prelude ( String, Show(..) ) import Text.Printf import qualified Data.Bits as P import qualified Data.Vector.Unboxed as U
src/Data/Array/Accelerate/Data/BigInt.hs view
@@ -1,9 +1,9 @@ -- | -- Module : Data.Array.Accelerate.Data.BigInt--- Copyright : [2016] Trevor L. McDonell+-- Copyright : [2016..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --
src/Data/Array/Accelerate/Data/BigWord.hs view
@@ -1,9 +1,9 @@ -- | -- Module : Data.Array.Accelerate.Data.BigWord--- Copyright : [2016] Trevor L. McDonell+-- Copyright : [2016..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --
src/Data/Array/Accelerate/Internal/BigInt.hs view
@@ -1,14 +1,15 @@ {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -- | -- Module : Data.Array.Accelerate.Internal.BigInt--- Copyright : [2016] Trevor L. McDonell+-- Copyright : [2016..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --@@ -38,6 +39,7 @@ import Data.Int import Data.Ratio import Data.Word+import GHC.Generics import Data.Array.Accelerate.Internal.BigWord import Data.Array.Accelerate.Internal.Num2@@ -55,7 +57,7 @@ -- | Large integers of fixed size represented as separate (signed) high and -- (unsigned) low words. ---data BigInt hi lo = I2 !hi !lo+data BigInt hi lo = I2 !hi !lo deriving Generic type BigIntCtx hi lo = (hi ~ Signed hi, lo ~ Unsigned lo, Signed (Unsigned hi) ~ hi)
src/Data/Array/Accelerate/Internal/BigInt.hs-boot view
@@ -3,7 +3,7 @@ -- Copyright : [2016] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --
src/Data/Array/Accelerate/Internal/BigWord.hs view
@@ -1,14 +1,15 @@ {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -- | -- Module : Data.Array.Accelerate.Internal.BigWord--- Copyright : [2016] Trevor L. McDonell+-- Copyright : [2016..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --@@ -42,6 +43,7 @@ import Data.Bits import Data.Ratio import Data.Word+import GHC.Generics import {-# SOURCE #-} Data.Array.Accelerate.Internal.BigInt import Data.Array.Accelerate.Internal.Num2@@ -59,7 +61,7 @@ -- | Large word of fixed size represented as separate high and low (unsigned) -- words. ---data BigWord hi lo = W2 !hi !lo+data BigWord hi lo = W2 !hi !lo deriving Generic type BigWordCtx hi lo = (hi ~ Unsigned hi, lo ~ Unsigned lo)
src/Data/Array/Accelerate/Internal/LLVM/Native.hs view
@@ -2,10 +2,10 @@ {-# LANGUAGE MagicHash #-} -- | -- Module : Data.Array.Accelerate.Internal.LLVM.Native--- Copyright : [2016] Trevor L. McDonell+-- Copyright : [2016..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --@@ -27,6 +27,7 @@ ) where import Data.Array.Accelerate as A+import Data.Array.Accelerate.Sugar.Elt import Data.Array.Accelerate.Internal.BigInt import Data.Array.Accelerate.Internal.BigWord import Data.Array.Accelerate.Internal.Orphans.Elt ()@@ -41,7 +42,7 @@ #ifdef ACCELERATE_LLVM_NATIVE_BACKEND wrap2 :: (Elt a, Elt b, Elt c) => String -- name of the operation- -> IRFun1 Native () ((a, b) -> c) -- foreign implementation+ -> IRFun1 Native () (EltR (a, b) -> EltR c) -- foreign implementation -> (Exp a -> Exp b -> Exp c) -- fallback implementation -> Exp a -> Exp b
src/Data/Array/Accelerate/Internal/LLVM/PTX.hs view
@@ -2,10 +2,10 @@ {-# LANGUAGE MagicHash #-} -- | -- Module : Data.Array.Accelerate.Internal.LLVM.PTX--- Copyright : [2016] Trevor L. McDonell+-- Copyright : [2016..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --@@ -27,6 +27,7 @@ ) where import Data.Array.Accelerate as A+import Data.Array.Accelerate.Sugar.Elt import Data.Array.Accelerate.Internal.BigInt import Data.Array.Accelerate.Internal.BigWord import Data.Array.Accelerate.Internal.Orphans.Elt ()@@ -41,7 +42,7 @@ #ifdef ACCELERATE_LLVM_PTX_BACKEND wrap2 :: (Elt a, Elt b, Elt c) => String -- name of the operation- -> IRFun1 PTX () ((a, b) -> c) -- foreign implementation+ -> IRFun1 PTX () (EltR (a, b) -> EltR c) -- foreign implementation -> (Exp a -> Exp b -> Exp c) -- fallback implementation -> Exp a -> Exp b
src/Data/Array/Accelerate/Internal/LLVM/Prim.hs view
@@ -1,13 +1,12 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE TypeFamilies #-} -- | -- Module : Data.Array.Accelerate.Internal.LLVM.Prim--- Copyright : [2016] Trevor L. McDonell+-- Copyright : [2016..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --@@ -30,103 +29,119 @@ ) where -import Data.Int-import Data.Word- import Data.Array.Accelerate.Error+import Data.Array.Accelerate.Sugar.Elt import Data.Array.Accelerate.Internal.BigInt import Data.Array.Accelerate.Internal.BigWord import Data.Array.Accelerate.Internal.Orphans.Elt () -import Data.Array.Accelerate.LLVM.CodeGen.Downcast-import Data.Array.Accelerate.LLVM.CodeGen.IR ( IR(..), Operands(..) )+import Data.Array.Accelerate.LLVM.CodeGen.IR ( Operands(..) ) import Data.Array.Accelerate.LLVM.CodeGen.Monad ( CodeGen, freshName, instr_ ) import Data.Array.Accelerate.LLVM.CodeGen.Sugar-import qualified Data.Array.Accelerate.LLVM.CodeGen.Arithmetic as A import qualified LLVM.AST.Type.Name as A import qualified LLVM.AST.Type.Operand as A import qualified LLVM.AST.Type.Representation as A+#if MIN_VERSION_accelerate_llvm(1,3,0)+import LLVM.AST.Type.Downcast ( downcast )+#else+import Data.Array.Accelerate.LLVM.CodeGen.Downcast ( downcast )+#endif import LLVM.AST.Constant ( Constant(Int) ) import LLVM.AST.Instruction hiding ( nsw, nuw )-import LLVM.AST.Name-import LLVM.AST.Operand+import LLVM.AST.Name ( Name(..) )+import LLVM.AST.Operand ( Operand(..) ) import LLVM.AST.Type +import Data.Int+import Data.Word+import Prelude hiding ( uncurry ) ++uncurry :: (Operands a -> Operands b -> c) -> Operands (((), a), b) -> c+uncurry f (OP_Unit `OP_Pair` x `OP_Pair` y) = f x y+ -- Primitive instruction wrappers -- ------------------------------ -- Operations from Num2 -- -------------------- -addWithCarryInt64# :: IRFun1 arch () ((Int64, Int64) -> (Int64, Word64))-addWithCarryInt64# = IRFun1 $ A.uncurry (prim_wideningInt64 (Add nsw nuw))+addWithCarryInt64# :: IRFun1 arch () (EltR (Int64, Int64) -> EltR (Int64, Word64))+addWithCarryInt64# = IRFun1 $ uncurry (prim_wideningInt64 (Add nsw nuw)) -mulWithCarryInt64# :: IRFun1 arch () ((Int64, Int64) -> (Int64, Word64))-mulWithCarryInt64# = IRFun1 $ A.uncurry (prim_wideningInt64 (Mul nsw nuw))+mulWithCarryInt64# :: IRFun1 arch () (EltR (Int64, Int64) -> EltR (Int64, Word64))+mulWithCarryInt64# = IRFun1 $ uncurry (prim_wideningInt64 (Mul nsw nuw)) -addWithCarryWord64# :: IRFun1 arch () ((Word64, Word64) -> (Word64, Word64))-addWithCarryWord64# = IRFun1 $ A.uncurry (prim_wideningWord64 (Add nsw nuw))+addWithCarryWord64# :: IRFun1 arch () (EltR (Word64, Word64) -> EltR (Word64, Word64))+addWithCarryWord64# = IRFun1 $ uncurry (prim_wideningWord64 (Add nsw nuw)) -mulWithCarryWord64# :: IRFun1 arch () ((Word64, Word64) -> (Word64, Word64))-mulWithCarryWord64# = IRFun1 $ A.uncurry (prim_wideningWord64 (Mul nsw nuw))+mulWithCarryWord64# :: IRFun1 arch () (EltR (Word64, Word64) -> EltR (Word64, Word64))+mulWithCarryWord64# = IRFun1 $ uncurry (prim_wideningWord64 (Mul nsw nuw)) -prim_wideningInt64 :: (Operand -> Operand -> InstructionMetadata -> Instruction) -> IR Int64 -> IR Int64 -> CodeGen (IR (Int64, Word64))-prim_wideningInt64 op (IR (OP_Int64 x)) (IR (OP_Int64 y)) = do+prim_wideningInt64+ :: (Operand -> Operand -> InstructionMetadata -> Instruction)+ -> Operands Int64+ -> Operands Int64+ -> CodeGen arch (Operands (((), Int64), Word64))+prim_wideningInt64 op (OP_Int64 x) (OP_Int64 y) = do a <- instr i128 (SExt (downcast x) i128 md) b <- instr i128 (SExt (downcast y) i128 md) c <- instr i128 (op a b md) (d,e) <- unpackInt128 c- return $ A.pair (IR (upcastInt64 d)) (IR (upcastWord64 e))+ return $ OP_Unit `OP_Pair` upcastInt64 d `OP_Pair` upcastWord64 e -prim_wideningWord64 :: (Operand -> Operand -> InstructionMetadata -> Instruction) -> IR Word64 -> IR Word64 -> CodeGen (IR (Word64, Word64))-prim_wideningWord64 op (IR (OP_Word64 x)) (IR (OP_Word64 y)) = do+prim_wideningWord64+ :: (Operand -> Operand -> InstructionMetadata -> Instruction)+ -> Operands Word64+ -> Operands Word64+ -> CodeGen arch (Operands (((), Word64), Word64))+prim_wideningWord64 op (OP_Word64 x) (OP_Word64 y) = do a <- instr i128 (ZExt (downcast x) i128 md) b <- instr i128 (ZExt (downcast y) i128 md) c <- instr i128 (op a b md) (d,e) <- unpackWord128 c- return $ A.pair (IR (upcastWord64 d)) (IR (upcastWord64 e))+ return $ OP_Unit `OP_Pair` upcastWord64 d `OP_Pair` upcastWord64 e -- Operations from Num -- ------------------- -addInt128# :: IRFun1 arch () ((Int128, Int128) -> Int128)-addInt128# = IRFun1 $ A.uncurry (prim_binaryInt128 (Add nsw nuw))+addInt128# :: IRFun1 arch () (EltR (Int128, Int128) -> EltR Int128)+addInt128# = IRFun1 $ uncurry (prim_binaryInt128 (Add nsw nuw)) -subInt128# :: IRFun1 arch () ((Int128, Int128) -> Int128)-subInt128# = IRFun1 $ A.uncurry (prim_binaryInt128 (Sub nsw nuw))+subInt128# :: IRFun1 arch () (EltR (Int128, Int128) -> EltR Int128)+subInt128# = IRFun1 $ uncurry (prim_binaryInt128 (Sub nsw nuw)) -mulInt128# :: IRFun1 arch () ((Int128, Int128) -> Int128)-mulInt128# = IRFun1 $ A.uncurry (prim_binaryInt128 (Mul nsw nuw))+mulInt128# :: IRFun1 arch () (EltR (Int128, Int128) -> EltR Int128)+mulInt128# = IRFun1 $ uncurry (prim_binaryInt128 (Mul nsw nuw)) -addWord128# :: IRFun1 arch () ((Word128, Word128) -> Word128)-addWord128# = IRFun1 $ A.uncurry (prim_binaryWord128 (Add nsw nuw))+addWord128# :: IRFun1 arch () (EltR (Word128, Word128) -> EltR Word128)+addWord128# = IRFun1 $ uncurry (prim_binaryWord128 (Add nsw nuw)) -subWord128# :: IRFun1 arch () ((Word128, Word128) -> Word128)-subWord128# = IRFun1 $ A.uncurry (prim_binaryWord128 (Sub nsw nuw))+subWord128# :: IRFun1 arch () (EltR (Word128, Word128) -> EltR Word128)+subWord128# = IRFun1 $ uncurry (prim_binaryWord128 (Sub nsw nuw)) -mulWord128# :: IRFun1 arch () ((Word128, Word128) -> Word128)-mulWord128# = IRFun1 $ A.uncurry (prim_binaryWord128 (Mul nsw nuw))+mulWord128# :: IRFun1 arch () (EltR (Word128, Word128) -> EltR Word128)+mulWord128# = IRFun1 $ uncurry (prim_binaryWord128 (Mul nsw nuw)) -- Operations from Integral -- ------------------------ -quotInt128# :: IRFun1 arch () ((Int128, Int128) -> Int128)-quotInt128# = IRFun1 $ A.uncurry (prim_binaryInt128 (SDiv False))+quotInt128# :: IRFun1 arch () (EltR (Int128, Int128) -> EltR Int128)+quotInt128# = IRFun1 $ uncurry (prim_binaryInt128 (SDiv False)) -remInt128# :: IRFun1 arch () ((Int128, Int128) -> Int128)-remInt128# = IRFun1 $ A.uncurry (prim_binaryInt128 SRem)+remInt128# :: IRFun1 arch () (EltR (Int128, Int128) -> EltR Int128)+remInt128# = IRFun1 $ uncurry (prim_binaryInt128 SRem) -quotRemInt128# :: IRFun1 arch () ((Int128, Int128) -> (Int128,Int128))-quotRemInt128# = IRFun1 $ A.uncurry quotRem'+quotRemInt128# :: IRFun1 arch () (EltR (Int128, Int128) -> EltR (Int128, Int128))+quotRemInt128# = IRFun1 $ uncurry quotRem' where- quotRem' :: IR Int128 -> IR Int128 -> CodeGen (IR (Int128, Int128))- quotRem' (IR xx) (IR yy)+ quotRem' :: Operands (EltR Int128) -> Operands (EltR Int128) -> CodeGen arch (Operands (EltR (Int128, Int128)))+ quotRem' xx yy | OP_Pair (OP_Pair OP_Unit (OP_Int64 xh)) (OP_Word64 xl) <- xx , OP_Pair (OP_Pair OP_Unit (OP_Int64 yh)) (OP_Word64 yl) <- yy = do@@ -137,20 +152,20 @@ r <- instr i128 (Sub nsw nuw x z md) (qh,ql) <- unpackInt128 q (rh,rl) <- unpackInt128 r- return $ A.pair (upcastInt128 qh ql) (upcastInt128 rh rl)+ return $ OP_Unit `OP_Pair` upcastInt128 qh ql `OP_Pair` upcastInt128 rh rl -quotWord128# :: IRFun1 arch () ((Word128, Word128) -> Word128)-quotWord128# = IRFun1 $ A.uncurry (prim_binaryWord128 (UDiv False))+quotWord128# :: IRFun1 arch () (EltR (Word128, Word128) -> EltR Word128)+quotWord128# = IRFun1 $ uncurry (prim_binaryWord128 (UDiv False)) -remWord128# :: IRFun1 arch () ((Word128, Word128) -> Word128)-remWord128# = IRFun1 $ A.uncurry (prim_binaryWord128 URem)+remWord128# :: IRFun1 arch () (EltR (Word128, Word128) -> EltR Word128)+remWord128# = IRFun1 $ uncurry (prim_binaryWord128 URem) -quotRemWord128# :: IRFun1 arch () ((Word128, Word128) -> (Word128,Word128))-quotRemWord128# = IRFun1 $ A.uncurry quotRem'+quotRemWord128# :: IRFun1 arch () (EltR (Word128, Word128) -> EltR (Word128, Word128))+quotRemWord128# = IRFun1 $ uncurry quotRem' where- quotRem' :: IR Word128 -> IR Word128 -> CodeGen (IR (Word128, Word128))- quotRem' (IR xx) (IR yy)+ quotRem' :: Operands (EltR Word128) -> Operands (EltR Word128) -> CodeGen arch (Operands (EltR (Word128, Word128)))+ quotRem' xx yy | OP_Pair (OP_Pair OP_Unit (OP_Word64 xh)) (OP_Word64 xl) <- xx , OP_Pair (OP_Pair OP_Unit (OP_Word64 yh)) (OP_Word64 yl) <- yy = do@@ -161,15 +176,19 @@ r <- instr i128 (Sub nsw nuw x z md) (qh,ql) <- unpackWord128 q (rh,rl) <- unpackWord128 r- return $ A.pair (upcastWord128 qh ql) (upcastWord128 rh rl)+ return $ OP_Unit `OP_Pair` upcastWord128 qh ql `OP_Pair` upcastWord128 rh rl -- Helpers -prim_binaryWord128 :: (Operand -> Operand -> InstructionMetadata -> Instruction) -> IR Word128 -> IR Word128 -> CodeGen (IR Word128)+prim_binaryWord128+ :: (Operand -> Operand -> InstructionMetadata -> Instruction)+ -> Operands (EltR Word128)+ -> Operands (EltR Word128)+ -> CodeGen arch (Operands (EltR Word128)) prim_binaryWord128 op xx yy- | IR (OP_Pair (OP_Pair OP_Unit (OP_Word64 xh)) (OP_Word64 xl)) <- xx- , IR (OP_Pair (OP_Pair OP_Unit (OP_Word64 yh)) (OP_Word64 yl)) <- yy+ | OP_Pair (OP_Pair OP_Unit (OP_Word64 xh)) (OP_Word64 xl) <- xx+ , OP_Pair (OP_Pair OP_Unit (OP_Word64 yh)) (OP_Word64 yl) <- yy = do x' <- packWord128 (downcast xh) (downcast xl) y' <- packWord128 (downcast yh) (downcast yl)@@ -177,10 +196,14 @@ (hi,lo) <- unpackWord128 r return $ upcastWord128 hi lo -prim_binaryInt128 :: (Operand -> Operand -> InstructionMetadata -> Instruction) -> IR Int128 -> IR Int128 -> CodeGen (IR Int128)+prim_binaryInt128+ :: (Operand -> Operand -> InstructionMetadata -> Instruction)+ -> Operands (EltR Int128)+ -> Operands (EltR Int128)+ -> CodeGen arch (Operands (EltR Int128)) prim_binaryInt128 op xx yy- | IR (OP_Pair (OP_Pair OP_Unit (OP_Int64 xh)) (OP_Word64 xl)) <- xx- , IR (OP_Pair (OP_Pair OP_Unit (OP_Int64 yh)) (OP_Word64 yl)) <- yy+ | OP_Pair (OP_Pair OP_Unit (OP_Int64 xh)) (OP_Word64 xl) <- xx+ , OP_Pair (OP_Pair OP_Unit (OP_Int64 yh)) (OP_Word64 yl) <- yy = do x' <- packInt128 (downcast xh) (downcast xl) y' <- packInt128 (downcast yh) (downcast yl)@@ -201,16 +224,16 @@ md :: InstructionMetadata md = [] -fresh :: CodeGen Name+fresh :: CodeGen arch Name fresh = downcast <$> freshName -instr :: Type -> Instruction -> CodeGen Operand+instr :: Type -> Instruction -> CodeGen arch Operand instr ty ins = do name <- fresh instr_ (name := ins) return (LocalReference ty name) -packInt128 :: Operand -> Operand -> CodeGen Operand+packInt128 :: Operand -> Operand -> CodeGen arch Operand packInt128 hi lo = do a <- instr i128 (SExt hi i128 md) b <- instr i128 (Shl nsw nuw a (ConstantOperand (Int 128 64)) md)@@ -218,7 +241,7 @@ d <- instr i128 (Or b c md) return d -packWord128 :: Operand -> Operand -> CodeGen Operand+packWord128 :: Operand -> Operand -> CodeGen arch Operand packWord128 hi lo = do a <- instr i128 (ZExt hi i128 md) b <- instr i128 (Shl nsw nuw a (ConstantOperand (Int 128 64)) md)@@ -226,31 +249,31 @@ d <- instr i128 (Or b c md) return d -unpackInt128 :: Operand -> CodeGen (Operand,Operand)+unpackInt128 :: Operand -> CodeGen arch (Operand,Operand) unpackInt128 x = do a <- instr i128 (AShr False x (ConstantOperand (Int 128 64)) md) b <- instr i64 (Trunc a i64 md) c <- instr i64 (Trunc x i64 md) return (b,c) -unpackWord128 :: Operand -> CodeGen (Operand,Operand)+unpackWord128 :: Operand -> CodeGen arch (Operand,Operand) unpackWord128 x = do a <- instr i128 (LShr False x (ConstantOperand (Int 128 64)) md) b <- instr i64 (Trunc a i64 md) c <- instr i64 (Trunc x i64 md) return (b,c) -upcastInt64 :: Operand -> Operands Int64+upcastInt64 :: HasCallStack => Operand -> Operands Int64 upcastInt64 (LocalReference (IntegerType 64) (UnName x)) = OP_Int64 (A.LocalReference A.type' (A.UnName x))-upcastInt64 _ = $internalError "upcastInt64" "expected local reference"+upcastInt64 _ = internalError "expected local reference" -upcastWord64 :: Operand -> Operands Word64+upcastWord64 :: HasCallStack => Operand -> Operands Word64 upcastWord64 (LocalReference (IntegerType 64) (UnName x)) = OP_Word64 (A.LocalReference A.type' (A.UnName x))-upcastWord64 _ = $internalError "upcastWord64" "expected local reference"+upcastWord64 _ = internalError "expected local reference" -upcastInt128 :: Operand -> Operand -> IR Int128-upcastInt128 hi lo = IR $ OP_Pair (OP_Pair OP_Unit (upcastInt64 hi)) (upcastWord64 lo)+upcastInt128 :: Operand -> Operand -> Operands (EltR Int128)+upcastInt128 hi lo = OP_Pair (OP_Pair OP_Unit (upcastInt64 hi)) (upcastWord64 lo) -upcastWord128 :: Operand -> Operand -> IR Word128-upcastWord128 hi lo = IR $ OP_Pair (OP_Pair OP_Unit (upcastWord64 hi)) (upcastWord64 lo)+upcastWord128 :: Operand -> Operand -> Operands (EltR Word128)+upcastWord128 hi lo = OP_Pair (OP_Pair OP_Unit (upcastWord64 hi)) (upcastWord64 lo)
src/Data/Array/Accelerate/Internal/Num2.hs view
@@ -7,10 +7,10 @@ {-# LANGUAGE UnboxedTuples #-} -- | -- Module : Data.Array.Accelerate.Internal.Num2--- Copyright : [2016] Trevor L. McDonell+-- Copyright : [2016..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --
src/Data/Array/Accelerate/Internal/Orphans.hs view
@@ -1,9 +1,9 @@ -- | -- Module : Data.Array.Accelerate.Internal.Orphans--- Copyright : [2016] Trevor L. McDonell+-- Copyright : [2016..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --
src/Data/Array/Accelerate/Internal/Orphans/Base.hs view
@@ -8,6 +8,7 @@ {-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}@@ -15,10 +16,10 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -- | -- Module : Data.Array.Accelerate.Internal.Orphans.Base--- Copyright : [2016] Trevor L. McDonell+-- Copyright : [2016..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --@@ -27,29 +28,30 @@ -- excessive class constraints by placing instances next to each other. -- +#include "MachDeps.h"+ module Data.Array.Accelerate.Internal.Orphans.Base () where import Data.Array.Accelerate.Internal.BigInt import Data.Array.Accelerate.Internal.BigWord import Data.Array.Accelerate.Internal.Num2-import Data.Array.Accelerate.Internal.Orphans.Elt ()+import Data.Array.Accelerate.Internal.Orphans.Elt 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 hiding ( fromInteger )-import Data.Array.Accelerate.Array.Sugar as A ( eltType )+import Data.Array.Accelerate.Sugar.Elt import Data.Array.Accelerate.Analysis.Match as A import Data.Array.Accelerate.Data.Bits as A import Data.Array.Accelerate.Smart import Control.Monad-import Data.Maybe-import Data.Typeable import Language.Haskell.TH hiding ( Exp ) import Text.Printf-import Prelude ( id, fromInteger, otherwise )+import Unsafe.Coerce+import Prelude ( id, fromInteger ) import qualified Prelude as P @@ -64,25 +66,22 @@ , Exp lo ~ Unsigned (Exp lo) ) -mkW2 :: (Elt a, Elt b, Elt (BigWord a b)) => Exp a -> Exp b -> Exp (BigWord a b)-mkW2 a b = lift (W2 a b) - instance (Bounded a, Bounded b, Elt (BigWord a b)) => P.Bounded (Exp (BigWord a b)) where- minBound = mkW2 minBound minBound- maxBound = mkW2 maxBound maxBound+ minBound = W2_ minBound minBound+ maxBound = W2_ maxBound maxBound instance (Eq a, Eq b, Elt (BigWord a b)) => Eq (BigWord a b) where- (unlift -> W2 xh xl) == (unlift -> W2 yh yl) = xh == yh && xl == yl- (unlift -> W2 xh xl) /= (unlift -> W2 yh yl) = xh /= yh || xl /= yl+ W2_ xh xl == W2_ yh yl = xh == yh && xl == yl+ W2_ xh xl /= W2_ yh yl = xh /= yh || xl /= yl instance (Ord a, Ord b, Elt (BigWord a b)) => Ord (BigWord a b) where- (unlift -> W2 xh xl) < (unlift -> W2 yh yl) = xh == yh ? ( xl < yl, xh < yh )- (unlift -> W2 xh xl) > (unlift -> W2 yh yl) = xh == yh ? ( xl > yl, xh > yh )- (unlift -> W2 xh xl) <= (unlift -> W2 yh yl) = xh == yh ? ( xl <= yl, xh <= yh )- (unlift -> W2 xh xl) >= (unlift -> W2 yh yl) = xh == yh ? ( xl >= yl, xh >= yh )+ W2_ xh xl < W2_ yh yl = xh == yh ? ( xl < yl, xh < yh )+ W2_ xh xl > W2_ yh yl = xh == yh ? ( xl > yl, xh > yh )+ W2_ xh xl <= W2_ yh yl = xh == yh ? ( xl <= yl, xh <= yh )+ W2_ xh xl >= W2_ yh yl = xh == yh ? ( xl >= yl, xh >= yh ) instance ( Num a@@ -92,35 +91,35 @@ , BigWordCtx a b ) => P.Num (Exp (BigWord a b)) where- negate (unlift -> W2 hi lo) =+ negate (W2_ hi lo) = if lo == 0- then mkW2 (negate hi) 0- else mkW2 (negate (hi+1)) (negate lo)+ then W2_ (negate hi) 0+ else W2_ (negate (hi+1)) (negate lo) abs = id signum x = x == 0 ? (0,1) fromInteger = constant . P.fromInteger {-# SPECIALIZE (+) :: Exp Word128 -> Exp Word128 -> Exp Word128 #-}- (+) | Just Refl <- matchWord128 (undefined::BigWord a b) = CPU.addWord128# $ PTX.addWord128# add- | otherwise = add+ (+) | Just Refl <- matchWord128 @(BigWord a b) = CPU.addWord128# $ PTX.addWord128# add+ | otherwise = add where add :: Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)- add (unlift -> W2 xh xl) (unlift -> W2 yh yl) = mkW2 hi lo+ add (W2_ xh xl) (W2_ yh yl) = W2_ hi lo where lo = xl + yl hi = xh + yh + if lo < xl then 1 else 0 {-# SPECIALIZE (-) :: Exp Word128 -> Exp Word128 -> Exp Word128 #-}- (-) | Just Refl <- matchWord128 (undefined::BigWord a b) = CPU.subWord128# $ PTX.subWord128# (\x y -> x + negate y)- | otherwise = \x y -> x + negate y+ (-) | Just Refl <- matchWord128 @(BigWord a b) = CPU.subWord128# $ PTX.subWord128# (\x y -> x + negate y)+ | otherwise = \x y -> x + negate y {-# SPECIALIZE (*) :: Exp Word128 -> Exp Word128 -> Exp Word128 #-}- (*) | Just Refl <- matchWord128 (undefined::BigWord a b) = CPU.mulWord128# $ PTX.mulWord128# mul- | otherwise = mul+ (*) | Just Refl <- matchWord128 @(BigWord a b) = CPU.mulWord128# $ PTX.mulWord128# mul+ | otherwise = mul where mul :: Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)- mul (unlift -> W2 xh xl) (unlift -> W2 yh yl) = mkW2 hi lo+ mul (W2_ xh xl) (W2_ yh yl) = W2_ hi lo where hi = xh * fromIntegral yl + yh * fromIntegral xl + fromIntegral c (c,lo) = mulWithCarry xl yl@@ -146,86 +145,85 @@ divMod = quotRem {-# SPECIALISE quot :: Exp Word128 -> Exp Word128 -> Exp Word128 #-}- quot | Just Refl <- matchWord128 (undefined::BigWord a b) = CPU.quotWord128# $ PTX.quotWord128# go- | otherwise = go+ quot | Just Refl <- matchWord128 @(BigWord a b) = CPU.quotWord128# $ PTX.quotWord128# go+ | otherwise = go where go x y = P.fst (quotRem x y) {-# SPECIALISE rem :: Exp Word128 -> Exp Word128 -> Exp Word128 #-}- rem | Just Refl <- matchWord128 (undefined::BigWord a b) = CPU.remWord128# $ PTX.remWord128# go- | otherwise = go+ rem | Just Refl <- matchWord128 @(BigWord a b) = CPU.remWord128# $ PTX.remWord128# go+ | otherwise = go where go x y = P.snd (quotRem x y) {-# SPECIALISE quotRem :: Exp Word128 -> Exp Word128 -> (Exp Word128, Exp Word128) #-}- quotRem | Just Refl <- matchWord128 (undefined::BigWord a b) = untup2 $$ CPU.quotRemWord128# $ PTX.quotRemWord128# quotRem'- | otherwise = untup2 $$ quotRem'+ quotRem | Just Refl <- matchWord128 @(BigWord a b) = untup2 $$ CPU.quotRemWord128# $ PTX.quotRemWord128# quotRem'+ | otherwise = untup2 $$ quotRem' where quotRem' :: Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b, BigWord a b)- quotRem' x@(unlift -> W2 xh xl) y@(unlift -> W2 yh yl)- = xh < yh ? ( tup2 (0, x)- , xh == yh ? ( xl < yl ? ( tup2 (0, x)- , xl == yl ? ( tup2 (1, 0)+ quotRem' x@(W2_ xh xl) y@(W2_ yh yl)+ = xh < yh ? ( T2 0 x+ , xh == yh ? ( xl < yl ? ( T2 0 x+ , xl == yl ? ( T2 1 0 , {-xl > yl -} yh == 0 ? ( let (t2,t1) = quotRem xl yl- in lift (mkW2 0 t2, mkW2 0 t1)- , tup2 (1, mkW2 0 (xl-yl))+ in lift (W2_ 0 t2, W2_ 0 t1)+ , T2 1 (W2_ 0 (xl-yl)) ) )) ,{- xh > yh -} yl == 0 ? ( let (t2,t1) = quotRem xh yh- in lift (mkW2 0 (fromIntegral t2), W2 t1 xl)+ in lift (W2_ 0 (fromIntegral t2), W2 t1 xl) , yh == 0 && yl == maxBound ? ( let z = fromIntegral xh (t2,t1) = addWithCarry z xl in t2 == 0 ? ( t1 == maxBound ?- ( tup2 ((mkW2 0 z) + 1, 0)- , tup2 (mkW2 0 z, mkW2 0 t1)+ ( T2 ((W2_ 0 z) + 1) 0+ , T2 (W2_ 0 z) (W2_ 0 t1) ) , t1 == maxBound ?- ( tup2 ((mkW2 0 z) + 2, 1)+ ( T2 ((W2_ 0 z) + 2) 1 , t1 == xor maxBound 1 ?- ( tup2 ((mkW2 0 z) + 2, 0)- , tup2 ((mkW2 0 z) + 1, mkW2 0 (t1+1))+ ( T2 ((W2_ 0 z) + 2) 0+ , T2 ((W2_ 0 z) + 1) (W2_ 0 (t1+1)) ) ) ) , yh == 0 ? ( let (t2,t1) = untup2 (div1 xh xl yl)- in tup2 (t2, mkW2 0 t1)+ in T2 t2 (W2_ 0 t1) , {- otherwise -}- let t1 = countLeadingZeros xh- t2 = countLeadingZeros yh- z = shiftR xh (finiteBitSize (undefined::Exp a) - t2)- u = shiftL x t2- v = shiftL y t2- W2 hhh hll = unlift u :: BigWord (Exp a) (Exp b)- W2 lhh lll = unlift v :: BigWord (Exp a) (Exp b)- -- -- z hhh hll / lhh lll- (q1, r1) = div2 z hhh lhh- (t4, t3) = mulWithCarry (fromIntegral q1) lll- t5 = mkW2 (fromIntegral t4) t3- t6 = mkW2 r1 hll- (t8, t7) = addWithCarry t6 v- (t10, t9) = addWithCarry t7 v- loWord w = let W2 _ l = unlift w :: BigWord (Exp a) (Exp b)- in l- qr2 = t5 > t6 ?- ( loWord t8 == 0 ?- ( t7 >= t5 ?- ( tup2 (q1-1, t7-t5)- , loWord t10 == 0 ?- ( tup2 (q1-2, t9-t5)- , tup2 (q1-2, (maxBound-t5) + t9 + 1)+ let t1 = countLeadingZeros xh+ t2 = countLeadingZeros yh+ z = shiftR xh (finiteBitSize (undefined::Exp a) - t2)+ u = shiftL x t2+ v = shiftL y t2+ W2_ hhh hll = u+ W2_ lhh lll = v+ -- z hhh hll / lhh lll+ (q1, r1) = div2 z hhh lhh+ (t4, t3) = mulWithCarry (fromIntegral q1) lll+ t5 = W2_ (fromIntegral t4) t3+ t6 = W2_ r1 hll+ (t8, t7) = addWithCarry t6 v+ (t10, t9) = addWithCarry t7 v+ loWord (W2_ _ l) = l :: Exp b+ qr2 = t5 > t6 ?+ ( loWord t8 == 0 ?+ ( t7 >= t5 ?+ ( T2 (q1-1) (t7-t5)+ , loWord t10 == 0 ?+ ( T2 (q1-2) (t9-t5)+ , T2 (q1-2) ((maxBound-t5) + t9 + 1)+ )+ )+ , T2 (q1-1) ((maxBound-t5) + t7 + 1)+ )+ , T2 (q1) (t6-t5) )- )- , tup2 (q1-1, (maxBound-t5) + t7 + 1)- )- , tup2 (q1, t6-t5)- )- (q2,r2) = unlift qr2+ (q2,r2) = untup2 qr2 in- t1 == t2 ? ( tup2 (1, x-y)- , lift (mkW2 0 (fromIntegral q2), shiftR r2 t2)+ t1 == t2 ? ( T2 1 (x-y)+ , lift (W2_ 0 (fromIntegral q2), shiftR r2 t2) ) ))) ))@@ -247,7 +245,7 @@ (t6, _t5) = addWithCarry t3 l z = t4 + t6 - body h l c = lift (fromIntegral z, t5, c + (mkW2 (fromIntegral t8) t7))+ body h l c = lift (fromIntegral z, t5, c + (W2_ (fromIntegral t8) t7)) where h1 = fromIntegral h (t4, t3) = mulWithCarry h1 (t1 + 1)@@ -255,7 +253,7 @@ z = t4 + t6 (t8, t7) = mulWithCarry h1 t2 - after h l c = lift (c + mkW2 (fromIntegral t8) t7 + mkW2 0 t10, t9)+ after h l c = lift (c + W2_ (fromIntegral t8) t7 + W2_ 0 t10, t9) where h1 = fromIntegral h (_t4, t3) = mulWithCarry h1 (t1 + 1)@@ -265,7 +263,7 @@ div2 :: Exp a -> Exp a -> Exp a -> (Exp a, Exp a)- div2 hhh hll by = go hhh hll (tup2 (0,0))+ div2 hhh hll by = go hhh hll (T2 0 0) where go :: Exp a -> Exp a -> Exp (a,a) -> (Exp a, Exp a) go h l c = uncurry3 after $ while (not . uncurry3 done) (uncurry3 body) (lift (h,l,c))@@ -280,7 +278,7 @@ z = t4 + t6 body :: Exp a -> Exp a -> Exp (a,a) -> Exp (a, a, (a,a))- body h l c = lift (z, t5, (addT (unlift c) (t8,t7)))+ body h l c = lift (z, t5, (addT (untup2 c) (t8,t7))) where (t4, t3) = mulWithCarry h (t1 + 1) (t6, t5) = addWithCarry t3 l@@ -294,7 +292,7 @@ (_t6, t5) = addWithCarry t3 l (t8, t7) = mulWithCarry h t2 (t10, t9) = quotRem t5 by- q = addT (unlift (addT (unlift c) (t8, t7))) (0, t10)+ q = addT (untup2 (addT (untup2 c) (t8, t7))) (0, t10) addT :: (Exp a, Exp a) -> (Exp a, Exp a) -> Exp (a,a) addT (lhh, lhl) (llh, lll) =@@ -315,19 +313,19 @@ type Signed (Exp (BigWord a b)) = Exp (BigInt (Signed a) b) type Unsigned (Exp (BigWord a b)) = Exp (BigWord a b) --- signed (unlift -> W2 (hi::Exp a) lo) = mkI2 (signed hi) lo+ signed (W2_ hi lo) = I2_ (signed hi) lo unsigned = id --- addWithCarry (unlift -> W2 xh xl) (unlift -> W2 yh yl) = (mkW2 0 w, mkW2 v u)+ addWithCarry (W2_ xh xl) (W2_ yh yl) = (W2_ 0 w, W2_ v u) where (t1, u) = addWithCarry xl yl (t3, t2) = addWithCarry xh (fromIntegral t1) (t4, v) = addWithCarry t2 yh w = fromIntegral (t3 + t4) - mulWithCarry (unlift -> W2 xh xl) (unlift -> W2 yh yl) =- ( mkW2 (hhh + fromIntegral (shiftR t9 y) + shiftL x z) (shiftL t9 z .|. shiftR t3 y)- , mkW2 (fromIntegral t3) lll)+ mulWithCarry (W2_ xh xl) (W2_ yh yl) =+ ( W2_ (hhh + fromIntegral (shiftR t9 y) + shiftL x z) (shiftL t9 z .|. shiftR t3 y)+ , W2_ (fromIntegral t3) lll) where (llh, lll) = mulWithCarry xl yl (hlh, hll) = mulWithCarry (fromIntegral xh) yl@@ -351,19 +349,19 @@ isSigned _ = constant False - (unlift -> W2 xh xl) .&. (unlift -> W2 yh yl) = mkW2 (xh .&. yh) (xl .&. yl)- (unlift -> W2 xh xl) .|. (unlift -> W2 yh yl) = mkW2 (xh .|. yh) (xl .|. yl)- (unlift -> W2 xh xl) `xor` (unlift -> W2 yh yl) = mkW2 (xh `xor` yh) (xl `xor` yl)- complement (unlift -> W2 hi lo) = mkW2 (complement hi) (complement lo)+ W2_ xh xl .&. W2_ yh yl = W2_ (xh .&. yh) (xl .&. yl)+ W2_ xh xl .|. W2_ yh yl = W2_ (xh .|. yh) (xl .|. yl)+ W2_ xh xl `xor` W2_ yh yl = W2_ (xh `xor` yh) (xl `xor` yl)+ complement (W2_ hi lo) = W2_ (complement hi) (complement lo) - shiftL (unlift -> W2 hi lo) x =+ shiftL (W2_ hi lo) x = if y > 0- then mkW2 (shiftL hi x .|. fromIntegral (shiftR lo y)) (shiftL lo x)- else mkW2 (fromIntegral (shiftL lo (negate y))) (0::Exp b)+ then W2_ (shiftL hi x .|. fromIntegral (shiftR lo y)) (shiftL lo x)+ else W2_ (fromIntegral (shiftL lo (negate y))) (0::Exp b) where y = finiteBitSize (undefined::Exp b) - x - shiftR (unlift -> W2 hi lo) x = mkW2 hi' lo'+ shiftR (W2_ hi lo) x = W2_ hi' lo' where hi' = shiftR hi x lo' = if y >= 0 then shiftL (fromIntegral hi) y .|. shiftR lo x@@ -372,12 +370,12 @@ y = finiteBitSize (undefined::Exp b) - x z = shiftR (fromIntegral hi) (negate y) - rotateL (unlift -> W2 hi lo) x =+ rotateL (W2_ hi lo) x = if y >= 0- then mkW2 (fromIntegral (shiftL lo y) .|. shiftR hi z)- (shiftL (fromIntegral hi) (finiteBitSize (undefined::Exp b) - z) .|. shiftR lo z)- else mkW2 (fromIntegral (shiftR lo (negate y)) .|. shiftL hi x)- (shift (fromIntegral hi) (finiteBitSize (undefined::Exp b) - z) .|. shiftL lo x .|. shiftR lo z)+ then W2_ (fromIntegral (shiftL lo y) .|. shiftR hi z)+ (shiftL (fromIntegral hi) (finiteBitSize (undefined::Exp b) - z) .|. shiftR lo z)+ else W2_ (fromIntegral (shiftR lo (negate y)) .|. shiftL hi x)+ (shift (fromIntegral hi) (finiteBitSize (undefined::Exp b) - z) .|. shiftL lo x .|. shiftR lo z) where y = x - finiteBitSize (undefined::Exp b) z = finiteBitSize (undefined::Exp (BigWord a b)) - x@@ -386,40 +384,40 @@ bit n = if m >= 0- then mkW2 (bit m) 0- else mkW2 0 (bit n)+ then W2_ (bit m) 0+ else W2_ 0 (bit n) where m = n - finiteBitSize (undefined::Exp b) - testBit (unlift -> W2 hi lo) n =+ testBit (W2_ hi lo) n = if m >= 0 then testBit hi m else testBit lo n where m = n - finiteBitSize (undefined::Exp b) - setBit (unlift -> W2 hi lo) n =+ setBit (W2_ hi lo) n = if m >= 0- then mkW2 (setBit hi m) lo- else mkW2 hi (setBit lo n)+ then W2_ (setBit hi m) lo+ else W2_ hi (setBit lo n) where m = n - finiteBitSize (undefined::Exp b) - clearBit (unlift -> W2 hi lo) n =+ clearBit (W2_ hi lo) n = if m >= 0- then mkW2 (clearBit hi m) lo- else mkW2 hi (clearBit lo n)+ then W2_ (clearBit hi m) lo+ else W2_ hi (clearBit lo n) where m = n - finiteBitSize (undefined::Exp b) - complementBit (unlift -> W2 hi lo) n =+ complementBit (W2_ hi lo) n = if m >= 0- then mkW2 (complementBit hi m) lo- else mkW2 hi (complementBit lo n)+ then W2_ (complementBit hi m) lo+ else W2_ hi (complementBit lo n) where m = n - finiteBitSize (undefined::Exp b) - popCount (unlift -> W2 hi lo) = popCount hi + popCount lo+ popCount (W2_ hi lo) = popCount hi + popCount lo instance ( Integral a, FiniteBits a, FromIntegral a b@@ -430,14 +428,14 @@ finiteBitSize _ = finiteBitSize (undefined::Exp a) + finiteBitSize (undefined::Exp b) - countLeadingZeros (unlift -> W2 hi lo) =+ countLeadingZeros (W2_ hi lo) = hlz == wsib ? (wsib + llz, hlz) where hlz = countLeadingZeros hi llz = countLeadingZeros lo wsib = finiteBitSize (undefined::Exp a) - countTrailingZeros (unlift -> W2 hi lo) =+ countTrailingZeros (W2_ hi lo) = ltz == wsib ? (wsib + htz, ltz) where ltz = countTrailingZeros lo@@ -457,25 +455,22 @@ , Exp lo ~ Unsigned (Exp lo) ) -mkI2 :: (Elt a, Elt b, Elt (BigInt a b)) => Exp a -> Exp b -> Exp (BigInt a b)-mkI2 a b = lift (I2 a b) - instance (Bounded a, Bounded b, Elt (BigInt a b)) => P.Bounded (Exp (BigInt a b)) where- minBound = mkI2 minBound minBound- maxBound = mkI2 maxBound maxBound+ minBound = I2_ minBound minBound+ maxBound = I2_ maxBound maxBound instance (Eq a, Eq b, Elt (BigInt a b)) => Eq (BigInt a b) where- (unlift -> I2 xh xl) == (unlift -> I2 yh yl) = xh == yh && xl == yl- (unlift -> I2 xh xl) /= (unlift -> I2 yh yl) = xh /= yh || xl /= yl+ I2_ xh xl == I2_ yh yl = xh == yh && xl == yl+ I2_ xh xl /= I2_ yh yl = xh /= yh || xl /= yl instance (Ord a, Ord b, Elt (BigInt a b)) => Ord (BigInt a b) where- (unlift -> I2 xh xl) < (unlift -> I2 yh yl) = xh == yh ? ( xl < yl, xh < yh )- (unlift -> I2 xh xl) > (unlift -> I2 yh yl) = xh == yh ? ( xl > yl, xh > yh )- (unlift -> I2 xh xl) <= (unlift -> I2 yh yl) = xh == yh ? ( xl <= yl, xh <= yh )- (unlift -> I2 xh xl) >= (unlift -> I2 yh yl) = xh == yh ? ( xl >= yl, xh >= yh )+ I2_ xh xl < I2_ yh yl = xh == yh ? ( xl < yl, xh < yh )+ I2_ xh xl > I2_ yh yl = xh == yh ? ( xl > yl, xh > yh )+ I2_ xh xl <= I2_ yh yl = xh == yh ? ( xl <= yl, xh <= yh )+ I2_ xh xl >= I2_ yh yl = xh == yh ? ( xl >= yl, xh >= yh ) instance ( Num a, Ord a@@ -487,15 +482,15 @@ , BigIntCtx a b ) => P.Num (Exp (BigInt a b)) where- negate (unlift -> I2 hi lo) =+ negate (I2_ hi lo) = if lo == 0- then mkI2 (negate hi) 0- else mkI2 (negate (hi+1)) (negate lo)+ then I2_ (negate hi) 0+ else I2_ (negate (hi+1)) (negate lo) - signum (unlift -> I2 hi lo :: BigInt (Exp a) (Exp b)) =- if hi < 0 then mkI2 (-1) maxBound else+ signum (I2_ hi lo) =+ if hi < 0 then I2_ (-1) maxBound else if hi == 0 then if lo == 0 then 0 else 1- else mkI2 0 1+ else I2_ 0 1 abs x = if x < 0 then negate x@@ -504,22 +499,22 @@ fromInteger = constant . fromInteger {-# SPECIALIZE (+) :: Exp Int128 -> Exp Int128 -> Exp Int128 #-}- (+) | Just Refl <- matchInt128 (undefined::BigInt a b) = CPU.addInt128# $ PTX.addInt128# add- | otherwise = add+ (+) | Just Refl <- matchInt128 @(BigInt a b) = CPU.addInt128# $ PTX.addInt128# add+ | otherwise = add where add :: Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)- add (unlift -> I2 xh xl) (unlift -> I2 yh yl) = mkI2 hi lo+ add (I2_ xh xl) (I2_ yh yl) = I2_ hi lo where lo = xl + yl hi = xh + yh + if lo < xl then 1 else 0 {-# SPECIALIZE (-) :: Exp Int128 -> Exp Int128 -> Exp Int128 #-}- (-) | Just Refl <- matchInt128 (undefined::BigInt a b) = CPU.subInt128# $ PTX.subInt128# (\x y -> x + negate y)- | otherwise = \x y -> x + negate y+ (-) | Just Refl <- matchInt128 @(BigInt a b) = CPU.subInt128# $ PTX.subInt128# (\x y -> x + negate y)+ | otherwise = \x y -> x + negate y {-# SPECIALIZE (*) :: Exp Int128 -> Exp Int128 -> Exp Int128 #-}- (*) | Just Refl <- matchInt128 (undefined::BigInt a b) = CPU.mulInt128# $ PTX.mulInt128# mul- | otherwise = mul+ (*) | Just Refl <- matchInt128 @(BigInt a b) = CPU.mulInt128# $ PTX.mulInt128# mul+ | otherwise = mul where mul :: Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b) mul x y = signed (unsigned x * unsigned y)@@ -541,37 +536,37 @@ 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- | otherwise = go+ quot | Just Refl <- matchInt128 @(BigInt a b) = CPU.quotInt128# $ PTX.quotInt128# go+ | otherwise = go where go x y = P.fst (quotRem x y) {-# SPECIALIZE rem :: Exp Int128 -> Exp Int128 -> Exp Int128 #-}- rem | Just Refl <- matchInt128 (undefined::BigInt a b) = CPU.remInt128# $ PTX.remInt128# go- | otherwise = go+ rem | Just Refl <- matchInt128 @(BigInt a b) = CPU.remInt128# $ PTX.remInt128# go+ | otherwise = go where go x y = P.snd (quotRem x y) {-# SPECIALISE quotRem :: Exp Int128 -> Exp Int128 -> (Exp Int128, Exp Int128) #-}- quotRem | Just Refl <- matchInt128 (undefined::BigInt a b) = untup2 $$ CPU.quotRemInt128# $ PTX.quotRemInt128# quotRem'- | otherwise = untup2 $$ quotRem'+ quotRem | Just Refl <- matchInt128 @(BigInt a b) = untup2 $$ CPU.quotRemInt128# $ PTX.quotRemInt128# quotRem'+ | otherwise = untup2 $$ quotRem' where quotRem' x y = if x < 0 then if y < 0 then let (q,r) = quotRem (negate (unsigned x)) (negate (unsigned y))- in tup2 (signed q, signed (negate r))+ in T2 (signed q) (signed (negate r)) else let (q,r) = quotRem (negate (unsigned x)) (unsigned y)- in tup2 (signed (negate q), signed (negate r))+ in T2 (signed (negate q)) (signed (negate r)) else if y < 0 then let (q,r) = quotRem (unsigned x) (negate (unsigned y))- in tup2 (signed (negate q), signed r)+ in T2 (signed (negate q)) (signed r) else let (q,r) = quotRem (unsigned x) (unsigned y)- in tup2 (signed q, signed r)+ in T2 (signed q) (signed r) {-# SPECIALIZE div :: Exp Int128 -> Exp Int128 -> Exp Int128 #-} {-# SPECIALIZE mod :: Exp Int128 -> Exp Int128 -> Exp Int128 #-}@@ -583,23 +578,23 @@ if x < 0 then if y < 0 then let (q,r) = quotRem (negate (unsigned x)) (negate (unsigned y))- in tup2 (signed q, signed (negate r))+ in T2 (signed q) (signed (negate r)) else let (q,r) = quotRem (negate (unsigned x)) (unsigned y) q' = signed (negate q) r' = signed (negate r) in- if r == 0 then tup2 (q', r')- else tup2 (q'-1, r'+y)+ if r == 0 then T2 q' r'+ else T2 (q'-1) ( r'+y) else if y < 0 then let (q,r) = quotRem (unsigned x) (negate (unsigned y)) q' = signed (negate q) r' = signed r in if r == 0- then tup2 (q', r')- else tup2 (q'-1, r'+y)+ then T2 q' r'+ else T2 (q'-1) (r'+y) else let (q,r) = quotRem (unsigned x) (unsigned y)- in tup2 (signed q, signed r)+ in T2 (signed q) (signed r) instance ( FiniteBits a, Integral a, FromIntegral a b, FromIntegral a (Signed b)@@ -614,19 +609,19 @@ => Bits (BigInt a b) where isSigned _ = constant True - (unlift -> I2 xh xl) .&. (unlift -> I2 yh yl) = mkI2 (xh .&. yh) (xl .&. yl)- (unlift -> I2 xh xl) .|. (unlift -> I2 yh yl) = mkI2 (xh .|. yh) (xl .|. yl)- (unlift -> I2 xh xl) `xor` (unlift -> I2 yh yl) = mkI2 (xh `xor` yh) (xl `xor` yl)- complement (unlift -> I2 hi lo) = mkI2 (complement hi) (complement lo)+ I2_ xh xl .&. I2_ yh yl = I2_ (xh .&. yh) (xl .&. yl)+ I2_ xh xl .|. I2_ yh yl = I2_ (xh .|. yh) (xl .|. yl)+ I2_ xh xl `xor` I2_ yh yl = I2_ (xh `xor` yh) (xl `xor` yl)+ complement (I2_ hi lo) = I2_ (complement hi) (complement lo) - shiftL (unlift -> I2 hi lo) x =+ shiftL (I2_ hi lo) x = if y > 0- then mkI2 (shiftL hi x .|. fromIntegral (shiftR lo y)) (shiftL lo x)- else mkI2 (fromIntegral (shiftL lo (negate y))) 0+ then I2_ (shiftL hi x .|. fromIntegral (shiftR lo y)) (shiftL lo x)+ else I2_ (fromIntegral (shiftL lo (negate y))) 0 where y = finiteBitSize (undefined::Exp b) - x - shiftR (unlift -> I2 hi lo) x = mkI2 hi' lo'+ shiftR (I2_ hi lo) x = I2_ hi' lo' where hi' = shiftR hi x lo' = if y >= 0 then shiftL (fromIntegral hi) y .|. shiftR lo x@@ -639,36 +634,36 @@ rotateR x y = rotateL x (finiteBitSize (undefined::Exp (BigInt a b)) - y) bit n =- if m >= 0 then mkI2 (bit m) 0- else mkI2 0 (bit n)+ if m >= 0 then I2_ (bit m) 0+ else I2_ 0 (bit n) where m = n - finiteBitSize (undefined::Exp b) - testBit (unlift -> I2 hi lo) n =+ testBit (I2_ hi lo) n = if m >= 0 then testBit hi m else testBit lo n where m = n - finiteBitSize (undefined::Exp b) - setBit (unlift -> I2 hi lo) n =- if m >= 0 then mkI2 (setBit hi m) lo- else mkI2 hi (setBit lo n)+ setBit (I2_ hi lo) n =+ if m >= 0 then I2_ (setBit hi m) lo+ else I2_ hi (setBit lo n) where m = n - finiteBitSize (undefined::Exp b) - clearBit (unlift -> I2 hi lo) n =- if m >= 0 then mkI2 (clearBit hi m) lo- else mkI2 hi (clearBit lo n)+ clearBit (I2_ hi lo) n =+ if m >= 0 then I2_ (clearBit hi m) lo+ else I2_ hi (clearBit lo n) where m = n - finiteBitSize (undefined::Exp b) - complementBit (unlift -> I2 hi lo) n =- if m >= 0 then mkI2 (complementBit hi m) lo- else mkI2 hi (complementBit lo n)+ complementBit (I2_ hi lo) n =+ if m >= 0 then I2_ (complementBit hi m) lo+ else I2_ hi (complementBit lo n) where m = n - finiteBitSize (undefined::Exp b) - popCount (unlift -> I2 hi lo) = popCount hi + popCount lo+ popCount (I2_ hi lo) = popCount hi + popCount lo instance ( FiniteBits a@@ -704,7 +699,7 @@ type Unsigned (Exp (BigInt a b)) = Exp (BigWord (Unsigned a) b) -- signed = id- unsigned (unlift -> I2 (hi::Exp a) lo) = mkW2 (unsigned hi) lo+ unsigned (I2_ hi lo) = W2_ (unsigned hi) lo -- addWithCarry x y = (c, r) where@@ -713,7 +708,7 @@ (t3, r) = addWithCarry (unsigned x) (unsigned y) c = signed (t1+t2+t3) - mulWithCarry x@(unlift -> I2 xh (_::Exp b)) y@(unlift -> I2 yh (_::Exp b)) = (hi,lo)+ mulWithCarry x@(I2_ xh _) y@(I2_ yh _) = (hi,lo) where t1 = complement y + 1 t2 = complement x + 1@@ -793,7 +788,7 @@ unsigned = fromIntegral addWithCarry = untup2 $$ CPU.addWithCarryInt64# $ PTX.addWithCarryInt64# awc where- awc x y = tup2 (hi,lo)+ awc x y = T2 hi lo where extX = x < 0 ? (maxBound, 0) extY = y < 0 ? (maxBound, 0)@@ -802,7 +797,7 @@ mulWithCarry = untup2 $$ CPU.mulWithCarryInt64# $ PTX.mulWithCarryInt64# mwc where- mwc x y = tup2 (hi,lo)+ mwc x y = T2 hi lo where extX = x < 0 ? (negate y, 0) extY = y < 0 ? (negate x, 0)@@ -817,14 +812,14 @@ unsigned = id addWithCarry = untup2 $$ CPU.addWithCarryWord64# $ PTX.addWithCarryWord64# awc where- awc x y = tup2 (hi,lo)+ awc x y = T2 hi lo where lo = x + y hi = lo < x ? (1,0) mulWithCarry = untup2 $$ CPU.mulWithCarryWord64# $ PTX.mulWithCarryWord64# mwc where- mwc x y = tup2 (hi,lo)+ mwc x y = T2 hi lo where xHi = shiftR x 32 yHi = shiftR y 32@@ -858,18 +853,24 @@ -- Utilities -- --------- -matchInt128 :: Elt (BigInt a b) => BigInt a b -> Maybe (BigInt a b :~: Int128)-matchInt128 t- | Just Refl <- matchTupleType (eltType t) (eltType (undefined::Int128))- = gcast Refl-matchInt128 _+untup2 :: (Elt a, Elt b) => Exp (a, b) -> (Exp a, Exp b)+untup2 (T2 a b) = (a, b)++untup3 :: (Elt a, Elt b, Elt c) => Exp (a, b, c) -> (Exp a, Exp b, Exp c)+untup3 (T3 a b c) = (a, b, c)++matchInt128 :: forall t. Elt t => Maybe (t :~: Int128)+matchInt128+ | Just Refl <- matchTypeR (eltR @t) (eltR @Int128)+ = Just (unsafeCoerce Refl)+ | otherwise = Nothing -matchWord128 :: Elt (BigWord a b) => BigWord a b -> Maybe (BigWord a b :~: Word128)-matchWord128 t- | Just Refl <- matchTupleType (eltType t) (eltType (undefined::Word128))- = gcast Refl-matchWord128 _+matchWord128 :: forall t. Elt t => Maybe (t :~: Word128)+matchWord128+ | Just Refl <- matchTypeR (eltR @t) (eltR @Word128)+ = Just (unsafeCoerce Refl)+ | otherwise = Nothing @@ -922,62 +923,115 @@ fromIntegral = id instance FromIntegral $(bigIntT big) $(bigWordT big) where- fromIntegral (unlift -> I2 hi lo) = mkW2 (fromIntegral hi) lo+ fromIntegral (I2_ hi lo) = W2_ (fromIntegral hi) lo instance FromIntegral $(bigWordT big) $(bigIntT big) where- fromIntegral (unlift -> W2 hi lo) = mkI2 (fromIntegral hi) lo+ fromIntegral (W2_ hi lo) = I2_ (fromIntegral hi) lo++ instance FromIntegral Int $(bigIntT big) where+ fromIntegral x =+#if WORD_SIZE_IN_BITS == 32+ fromIntegral (fromIntegral x :: Exp Int32)+#elif WORD_SIZE_IN_BITS == 64+ fromIntegral (fromIntegral x :: Exp Int64)+#endif++ instance FromIntegral Int $(bigWordT big) where+ fromIntegral x =+#if WORD_SIZE_IN_BITS == 32+ fromIntegral (fromIntegral x :: Exp Int32)+#elif WORD_SIZE_IN_BITS == 64+ fromIntegral (fromIntegral x :: Exp Int64)+#endif++ instance FromIntegral Word $(bigIntT big) where+ fromIntegral x =+#if WORD_SIZE_IN_BITS == 32+ fromIntegral (fromIntegral x :: Exp Word32)+#elif WORD_SIZE_IN_BITS == 64+ fromIntegral (fromIntegral x :: Exp Word64)+#endif++ instance FromIntegral Word $(bigWordT big) where+ fromIntegral x =+#if WORD_SIZE_IN_BITS == 32+ fromIntegral (fromIntegral x :: Exp Word32)+#elif WORD_SIZE_IN_BITS == 64+ fromIntegral (fromIntegral x :: Exp Word64)+#endif |] thFromIntegral2 :: (Int,Int) -> Int -> Q [Dec]- thFromIntegral2 big@(bigH,bigL) little =+ thFromIntegral2 big little = [d| -- convert from primitive type to bignum type instance FromIntegral $(wordT little) $(bigWordT big) where- fromIntegral x = mkW2 0 (fromIntegral x)+ fromIntegral x = W2_ 0 (fromIntegral x) instance FromIntegral $(wordT little) $(bigIntT big) where- fromIntegral x = mkI2 0 (fromIntegral x)+ fromIntegral x = I2_ 0 (fromIntegral x) instance FromIntegral $(intT little) $(bigWordT big) where fromIntegral x@(fromIntegral -> x') =- if x < 0 then mkW2 maxBound x'- else mkW2 0 x'+ if x < 0 then W2_ maxBound x'+ else W2_ 0 x' instance FromIntegral $(intT little) $(bigIntT big) where fromIntegral x@(fromIntegral -> x') =- if x < 0 then mkI2 (-1) x'- else mkI2 0 x'+ if x < 0 then I2_ (-1) x'+ else I2_ 0 x' -- convert from bignum type to primitive type instance FromIntegral $(bigWordT big) $(wordT little) where- fromIntegral x =- let W2 _ lo = unlift x :: BigWord (Exp $(wordT bigH)) (Exp $(wordT bigL))- in fromIntegral lo+ fromIntegral (W2_ _ lo) = fromIntegral lo instance FromIntegral $(bigWordT big) $(intT little) where- fromIntegral x =- let W2 _ lo = unlift x :: BigWord (Exp $(wordT bigH)) (Exp $(wordT bigL))- in fromIntegral lo+ fromIntegral (W2_ _ lo) = fromIntegral lo instance FromIntegral $(bigIntT big) $(wordT little) where- fromIntegral x =- let I2 _ lo = unlift x :: BigInt (Exp $(intT bigH)) (Exp $(wordT bigL))- in fromIntegral lo+ fromIntegral (I2_ _ lo) = fromIntegral lo instance FromIntegral $(bigIntT big) $(intT little) where- fromIntegral x =- let I2 _ lo = unlift x :: BigInt (Exp $(intT bigH)) (Exp $(wordT bigL))- in fromIntegral lo+ fromIntegral (I2_ _ lo) = fromIntegral lo |]++ thToFloating :: (Int,Int) -> Q [Dec]+ thToFloating big@(_,b) =+ [d|+ instance ToFloating $(bigIntT big) Half where+ toFloating (I2_ hi lo) =+ toFloating hi * (P.fromIntegral (maxBound :: $(wordT b)) + 1) + toFloating lo++ instance ToFloating $(bigIntT big) Float where+ toFloating (I2_ hi lo) =+ toFloating hi * (P.fromIntegral (maxBound :: $(wordT b)) + 1) + toFloating lo++ instance ToFloating $(bigIntT big) Double where+ toFloating (I2_ hi lo) =+ toFloating hi * (P.fromIntegral (maxBound :: $(wordT b)) + 1) + toFloating lo++ instance ToFloating $(bigWordT big) Half where+ toFloating (W2_ hi lo) =+ toFloating hi * (P.fromIntegral (maxBound :: $(wordT b)) + 1) + toFloating lo++ instance ToFloating $(bigWordT big) Float where+ toFloating (W2_ hi lo) =+ toFloating hi * (P.fromIntegral (maxBound :: $(wordT b)) + 1) + toFloating lo++ instance ToFloating $(bigWordT big) Double where+ toFloating (W2_ hi lo) =+ toFloating hi * (P.fromIntegral (maxBound :: $(wordT b)) + 1) + toFloating lo+ |] -- #if MIN_VERSION_accelerate(1,2,0) e1 <- sequence [ thEnum x | x <- bigNums ] #else- e1 <- return []+ e1 <- return [] #endif d1 <- sequence [ thFromIntegral1 x | x <- bigNums ] d2 <- sequence [ thFromIntegral2 x y | x <- bigNums, y <- lilNums ]+ d3 <- sequence [ thToFloating x | x <- bigNums ] --- return $ P.concat (e1 P.++ d1 P.++ d2)+ return $ P.concat (e1 P.++ d1 P.++ d2 P.++ d3) )
src/Data/Array/Accelerate/Internal/Orphans/Elt.hs view
@@ -2,82 +2,62 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | -- Module : Data.Array.Accelerate.Internal.Orphans.Elt--- Copyright : [2016] Trevor L. McDonell+-- Copyright : [2016..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) -- -- Orphan Elt instances for BigWord and BigInt -- -module Data.Array.Accelerate.Internal.Orphans.Elt ()- where+module Data.Array.Accelerate.Internal.Orphans.Elt ( -import Data.Array.Accelerate.Internal.BigInt-import Data.Array.Accelerate.Internal.BigWord+ pattern W2_,+ pattern I2_, -import Data.Array.Accelerate-import Data.Array.Accelerate.Array.Sugar-import Data.Array.Accelerate.Product-import Data.Array.Accelerate.Smart+) where +import Data.Array.Accelerate.Internal.BigInt+import Data.Array.Accelerate.Internal.BigWord -type instance EltRepr (BigInt a b) = EltRepr (a,b)-type instance EltRepr (BigWord a b) = EltRepr (a,b)+import Data.Array.Accelerate hiding ( pattern I2 ) -instance (Elt a, Elt b, Show (BigWord a b)) => Elt (BigWord a b) where- eltType _ = eltType (undefined :: (a,b))- toElt w = let (a,b) = toElt w in W2 a b- fromElt (W2 a b) = fromElt (a,b)+instance (Elt a, Elt b) => Elt (BigWord a b) -instance (cst a, cst b) => IsProduct cst (BigWord a b) where- type ProdRepr (BigWord a b) = ProdRepr (a,b)- fromProd cst (W2 a b) = fromProd cst (a,b)- toProd cst w = let (a,b) = toProd cst w in W2 a b- prod cst _ = prod cst (undefined :: (a,b))+pattern W2_ :: (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)+pattern W2_ a b = Pattern (a, b)+{-# COMPLETE W2_ #-} -instance (Lift Exp a, Lift Exp b, Elt (Plain a), Elt (Plain b), Show (BigWord (Plain a) (Plain b)))+instance (Lift Exp a, Lift Exp b, Elt (Plain a), Elt (Plain b)) => Lift Exp (BigWord a b) where type Plain (BigWord a b) = BigWord (Plain a) (Plain b)- lift (W2 a b) = Exp $ Tuple (NilTup `SnocTup` lift a `SnocTup` lift b)+ lift (W2 a b) = W2_ (lift a) (lift b) -instance (Elt a, Elt b, Show (BigWord a b)) => Unlift Exp (BigWord (Exp a) (Exp b)) where- unlift w =- let a = Exp $ SuccTupIdx ZeroTupIdx `Prj` w- b = Exp $ ZeroTupIdx `Prj` w- in- W2 a b+instance (Elt a, Elt b) => Unlift Exp (BigWord (Exp a) (Exp b)) where+ unlift (W2_ a b) = W2 a b -instance (Elt a, Elt b, Show (BigInt a b)) => Elt (BigInt a b) where- eltType _ = eltType (undefined :: (a,b))- toElt w = let (a,b) = toElt w in I2 a b- fromElt (I2 a b) = fromElt (a,b)+instance (Elt a, Elt b) => Elt (BigInt a b) -instance (cst a, cst b) => IsProduct cst (BigInt a b) where- type ProdRepr (BigInt a b) = ProdRepr (a,b)- fromProd cst (I2 a b) = fromProd cst (a,b)- toProd cst w = let (a,b) = toProd cst w in I2 a b- prod cst _ = prod cst (undefined :: (a,b))+pattern I2_ :: (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigInt a b)+pattern I2_ a b = Pattern (a, b)+{-# COMPLETE I2_ #-} -instance (Lift Exp a, Lift Exp b, Elt (Plain a), Elt (Plain b), Show (BigInt (Plain a) (Plain b)))+instance (Lift Exp a, Lift Exp b, Elt (Plain a), Elt (Plain b)) => Lift Exp (BigInt a b) where type Plain (BigInt a b) = BigInt (Plain a) (Plain b)- lift (I2 a b) = Exp $ Tuple (NilTup `SnocTup` lift a `SnocTup` lift b)+ lift (I2 a b) = I2_ (lift a) (lift b) -instance (Elt a, Elt b, Show (BigInt a b)) => Unlift Exp (BigInt (Exp a) (Exp b)) where- unlift w =- let a = Exp $ SuccTupIdx ZeroTupIdx `Prj` w- b = Exp $ ZeroTupIdx `Prj` w- in- I2 a b+instance (Elt a, Elt b) => Unlift Exp (BigInt (Exp a) (Exp b)) where+ unlift (I2_ a b) = I2 a b
test/Test/Base.hs view
@@ -4,10 +4,10 @@ {-# LANGUAGE RankNTypes #-} -- | -- Module : Test.Base--- Copyright : [2017] Trevor L. McDonell+-- Copyright : [2017..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --@@ -15,8 +15,9 @@ 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.Sugar.Shape ( size )+import Data.Array.Accelerate.Trafo ( Afunction )+import Data.Array.Accelerate.Trafo.Sharing ( AfunctionR ) import Data.Array.Accelerate.Data.Complex import Data.Array.Accelerate.Data.BigInt
test/Test/BigNum.hs view
@@ -1,10 +1,10 @@ {-# LANGUAGE RankNTypes #-} -- | -- Module : Test.BigNum--- Copyright : [2017] Trevor L. McDonell+-- Copyright : [2017..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --
test/Test/BigNum/Bits.hs view
@@ -4,10 +4,10 @@ {-# LANGUAGE ScopedTypeVariables #-} -- | -- Module : Test.BigNum.Bits--- Copyright : [2017] Trevor L. McDonell+-- Copyright : [2017..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --@@ -70,7 +70,7 @@ , testProperty "popCount" $ prop_popCount a b ] - testAcc :: (Eq a, FiniteBits a, A.FiniteBits a, Show (ArgType a))+ testAcc :: (Show a, Eq a, FiniteBits a, A.FiniteBits a, Show (ArgType a)) => Gen a -> TestTree testAcc a =@@ -266,7 +266,7 @@ prop_unary' popCount popCount b x prop_acc_complement- :: (Bits a, A.Bits a)+ :: (Show a, Bits a, A.Bits a) => RunN -> Gen a -> Property@@ -276,7 +276,7 @@ prop_acc_unary complement A.complement runN x prop_acc_xor- :: (Bits a, A.Bits a)+ :: (Show a, Bits a, A.Bits a) => RunN -> Gen a -> Property@@ -287,7 +287,7 @@ prop_acc_binary xor A.xor runN x y prop_acc_band- :: (Bits a, A.Bits a)+ :: (Show a, Bits a, A.Bits a) => RunN -> Gen a -> Property@@ -298,7 +298,7 @@ prop_acc_binary (.&.) (A..&.) runN x y prop_acc_bor- :: (Bits a, A.Bits a)+ :: (Show a, Bits a, A.Bits a) => RunN -> Gen a -> Property@@ -310,7 +310,7 @@ prop_acc_shiftL- :: (FiniteBits a, A.FiniteBits a)+ :: (Show a, FiniteBits a, A.FiniteBits a) => RunN -> Gen a -> Property@@ -321,7 +321,7 @@ prop_acc_binary shiftL A.shiftL runN x n prop_acc_shiftR- :: (FiniteBits a, A.FiniteBits a)+ :: (Show a, FiniteBits a, A.FiniteBits a) => RunN -> Gen a -> Property@@ -332,7 +332,7 @@ prop_acc_binary shiftR A.shiftR runN x n prop_acc_rotateL- :: (FiniteBits a, A.FiniteBits a)+ :: (Show a, FiniteBits a, A.FiniteBits a) => RunN -> Gen a -> Property@@ -343,7 +343,7 @@ prop_acc_binary rotateL A.rotateL runN x n prop_acc_rotateR- :: (FiniteBits a, A.FiniteBits a)+ :: (Show a, FiniteBits a, A.FiniteBits a) => RunN -> Gen a -> Property@@ -354,7 +354,7 @@ prop_acc_binary rotateR A.rotateR runN x n prop_acc_shift- :: (FiniteBits a, A.FiniteBits a)+ :: (Show a, FiniteBits a, A.FiniteBits a) => RunN -> Gen a -> Property@@ -365,7 +365,7 @@ prop_acc_binary shift A.shift runN x n prop_acc_rotate- :: (FiniteBits a, A.FiniteBits a)+ :: (Show a, FiniteBits a, A.FiniteBits a) => RunN -> Gen a -> Property@@ -376,7 +376,7 @@ prop_acc_binary rotate A.rotate runN x n prop_acc_bit- :: forall proxy a. (FiniteBits a, A.FiniteBits a)+ :: forall proxy a. (Show a, FiniteBits a, A.FiniteBits a) => RunN -> proxy a -> Property@@ -386,7 +386,7 @@ prop_acc_testBit- :: (FiniteBits a, A.FiniteBits a)+ :: (Show a, FiniteBits a, A.FiniteBits a) => RunN -> Gen a -> Property@@ -397,7 +397,7 @@ prop_acc_binary testBit A.testBit runN x n prop_acc_setBit- :: (FiniteBits a, A.FiniteBits a)+ :: (Show a, FiniteBits a, A.FiniteBits a) => RunN -> Gen a -> Property@@ -408,7 +408,7 @@ prop_acc_binary setBit A.setBit runN x n prop_acc_clearBit- :: (FiniteBits a, A.FiniteBits a)+ :: (Show a, FiniteBits a, A.FiniteBits a) => RunN -> Gen a -> Property@@ -419,7 +419,7 @@ prop_acc_binary clearBit A.clearBit runN x n prop_acc_complementBit- :: (FiniteBits a, A.FiniteBits a)+ :: (Show a, FiniteBits a, A.FiniteBits a) => RunN -> Gen a -> Property@@ -430,7 +430,7 @@ prop_acc_binary complementBit A.complementBit runN x n prop_acc_popCount- :: (FiniteBits a, A.FiniteBits a)+ :: (Show a, FiniteBits a, A.FiniteBits a) => RunN -> Gen a -> Property
test/Test/BigNum/Bounded.hs view
@@ -4,10 +4,10 @@ {-# LANGUAGE ScopedTypeVariables #-} -- | -- Module : Test.BigNum.Bounded--- Copyright : [2017] Trevor L. McDonell+-- Copyright : [2017..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --@@ -52,7 +52,7 @@ , testProperty "maxBound" $ prop_maxBound p ] - testAcc :: (Eq a, Bounded a, A.Bounded a, Show (ArgType a))+ testAcc :: (Show a, Eq a, Bounded a, A.Bounded a, Show (ArgType a)) => Proxy a -> TestTree testAcc p =@@ -79,7 +79,7 @@ maxBound === fromIso p maxBound prop_acc_minBound- :: forall a. (Eq a, Bounded a, A.Bounded a)+ :: forall a. (Show a, Eq a, Bounded a, A.Bounded a) => RunN -> Proxy a -> Property@@ -88,7 +88,7 @@ minBound === isoL (runN (A.unit (minBound :: A.Exp a))) prop_acc_maxBound- :: forall a. (Eq a, Bounded a, A.Bounded a)+ :: forall a. (Show a, Eq a, Bounded a, A.Bounded a) => RunN -> Proxy a -> Property
test/Test/BigNum/Enum.hs view
@@ -2,10 +2,10 @@ {-# LANGUAGE FlexibleContexts #-} -- | -- Module : Test.BigNum.Enum--- Copyright : [2017] Trevor L. McDonell+-- Copyright : [2017..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --
test/Test/BigNum/Eq.hs view
@@ -3,10 +3,10 @@ {-# LANGUAGE RankNTypes #-} -- | -- Module : Test.BigNum.Eq--- Copyright : [2017] Trevor L. McDonell+-- Copyright : [2017..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --@@ -50,7 +50,7 @@ , testProperty "(/=)" $ prop_neq a b ] - testAcc :: (Eq a, A.Eq a, Show (ArgType a))+ testAcc :: (Show a, Eq a, A.Eq a, Show (ArgType a)) => Gen a -> TestTree testAcc a =@@ -83,7 +83,7 @@ prop_binary' (/=) (/=) b x y prop_acc_eq- :: (Eq a, A.Eq a)+ :: (Show a, Eq a, A.Eq a) => RunN -> Gen a -> Property@@ -94,7 +94,7 @@ prop_acc_binary (==) (A.==) runN x y prop_acc_neq- :: (Eq a, A.Eq a)+ :: (Show a, Eq a, A.Eq a) => RunN -> Gen a -> Property
test/Test/BigNum/FiniteBits.hs view
@@ -3,10 +3,10 @@ {-# LANGUAGE RankNTypes #-} -- | -- Module : Test.BigNum.FiniteBits--- Copyright : [2017] Trevor L. McDonell+-- Copyright : [2017..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --@@ -51,7 +51,7 @@ , testProperty "countTrailingZeros" $ prop_ctz a b ] - testAcc :: (Eq a, FiniteBits a, A.FiniteBits a, Show (ArgType a))+ testAcc :: (Show a, Eq a, FiniteBits a, A.FiniteBits a, Show (ArgType a)) => Gen a -> TestTree testAcc a =@@ -82,7 +82,7 @@ prop_unary' countTrailingZeros countTrailingZeros b x prop_acc_clz- :: (FiniteBits a, A.FiniteBits a)+ :: (Show a, FiniteBits a, A.FiniteBits a) => RunN -> Gen a -> Property@@ -92,7 +92,7 @@ prop_acc_unary countLeadingZeros A.countLeadingZeros runN x prop_acc_ctz- :: (FiniteBits a, A.FiniteBits a)+ :: (Show a, FiniteBits a, A.FiniteBits a) => RunN -> Gen a -> Property
test/Test/BigNum/FromIntegral.hs view
@@ -5,10 +5,10 @@ {-# LANGUAGE ScopedTypeVariables #-} -- | -- Module : Test.BigNum.FromIntegral--- Copyright : [2017] Trevor L. McDonell+-- Copyright : [2017..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --@@ -75,7 +75,7 @@ ] where testElt- :: (Integral a, Num b, Eq b, A.Integral a, A.Num b, A.FromIntegral a b, Show (ArgType a), Show (ArgType b))+ :: (Show a, Show b, 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@@ -84,7 +84,7 @@ prop_fromIntegral- :: forall a b. (Integral a, Num b, Eq b, A.Integral a, A.Num b, A.FromIntegral a b)+ :: forall a b. (Show a, Show b, Integral a, Num b, Eq b, A.Integral a, A.Num b, A.FromIntegral a b) => RunN -> Gen a -> Proxy b
test/Test/BigNum/Integral.hs view
@@ -4,10 +4,10 @@ {-# LANGUAGE RankNTypes #-} -- | -- Module : Test.BigNum.Integral--- Copyright : [2017] Trevor L. McDonell+-- Copyright : [2017..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --@@ -56,7 +56,7 @@ , testProperty "toInteger" $ prop_toInteger a b ] - testAcc :: (Eq a, Integral a, A.Integral a, Show (ArgType a))+ testAcc :: (Show a, Eq a, Integral a, A.Integral a, Show (ArgType a)) => Gen a -> TestTree testAcc a =@@ -153,7 +153,7 @@ prop_unary' toInteger toInteger b x prop_acc_quot- :: (Integral a, A.Integral a)+ :: (Show a, Integral a, A.Integral a) => RunN -> Gen a -> Property@@ -164,7 +164,7 @@ prop_acc_binary quot quot runN x y prop_acc_rem- :: (Integral a, A.Integral a)+ :: (Show a, Integral a, A.Integral a) => RunN -> Gen a -> Property@@ -175,7 +175,7 @@ prop_acc_binary rem rem runN x y prop_acc_div- :: (Integral a, A.Integral a)+ :: (Show a, Integral a, A.Integral a) => RunN -> Gen a -> Property@@ -186,7 +186,7 @@ prop_acc_binary div div runN x y prop_acc_mod- :: (Integral a, A.Integral a)+ :: (Show a, Integral a, A.Integral a) => RunN -> Gen a -> Property@@ -197,7 +197,7 @@ prop_acc_binary mod mod runN x y prop_acc_quotRem- :: (Integral a, A.Integral a)+ :: (Show a, Integral a, A.Integral a) => RunN -> Gen a -> Property@@ -208,7 +208,7 @@ prop_acc_binary quotRem (A.lift $$ quotRem) runN x y prop_acc_divMod- :: (Integral a, A.Integral a)+ :: (Show a, Integral a, A.Integral a) => RunN -> Gen a -> Property
test/Test/BigNum/Num.hs view
@@ -4,10 +4,10 @@ {-# LANGUAGE ScopedTypeVariables #-} -- | -- Module : Test.BigNum.Num--- Copyright : [2017] Trevor L. McDonell+-- Copyright : [2017..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --@@ -56,7 +56,7 @@ , testProperty "fromInteger" $ prop_fromInteger b ] - testAcc :: (Eq a, Num a, A.Num a, Show (ArgType a))+ testAcc :: (Show a, Eq a, Num a, A.Num a, Show (ArgType a)) => Gen a -> TestTree testAcc a =@@ -145,7 +145,7 @@ prop_acc_negate- :: (Num a, A.Num a, Eq a)+ :: (Show a, Num a, A.Num a, Eq a) => RunN -> Gen a -> Property@@ -155,7 +155,7 @@ prop_acc_unary negate negate runN x prop_acc_abs- :: (Num a, A.Num a, Eq a)+ :: (Show a, Num a, A.Num a, Eq a) => RunN -> Gen a -> Property@@ -165,7 +165,7 @@ prop_acc_unary abs abs runN x prop_acc_signum- :: (Num a, A.Num a, Eq a)+ :: (Show a, Num a, A.Num a, Eq a) => RunN -> Gen a -> Property@@ -175,7 +175,7 @@ prop_acc_unary signum signum runN x prop_acc_add- :: (Num a, A.Num a, Eq a)+ :: (Show a, Num a, A.Num a, Eq a) => RunN -> Gen a -> Property@@ -186,7 +186,7 @@ prop_acc_binary (+) (+) runN x y prop_acc_sub- :: (Num a, A.Num a, Eq a)+ :: (Show a, Num a, A.Num a, Eq a) => RunN -> Gen a -> Property@@ -197,7 +197,7 @@ prop_acc_binary (-) (-) runN x y prop_acc_mul- :: (Num a, A.Num a, Eq a)+ :: (Show a, Num a, A.Num a, Eq a) => RunN -> Gen a -> Property@@ -208,7 +208,7 @@ prop_acc_binary (*) (*) runN x y prop_acc_fromInteger- :: forall proxy a. (Num a, Eq a, A.Num a)+ :: forall proxy a. (Show a, Num a, Eq a, A.Num a) => RunN -> proxy a -> Property
test/Test/BigNum/Num2.hs view
@@ -4,10 +4,10 @@ {-# LANGUAGE TypeFamilies #-} -- | -- Module : Test.BigNum.Num2--- Copyright : [2017] Trevor L. McDonell+-- Copyright : [2017..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --@@ -42,7 +42,7 @@ , testElt i64 ] where- testElt :: ( Num2 e, Integral e, Show e, Show (ArgType e), FiniteBits (Unsigned e), Integral (Unsigned e)+ testElt :: ( Show e, 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@@ -57,7 +57,7 @@ prop_addWithCarry- :: (Num2 e, Integral e, Show e, FiniteBits (Unsigned e), Integral (Unsigned e))+ :: (Show e, Num2 e, Integral e, Show e, FiniteBits (Unsigned e), Integral (Unsigned e)) => Gen e -> Property prop_addWithCarry e =@@ -67,7 +67,7 @@ uncurry toInteger2 (addWithCarry x y) === toInteger x + toInteger y prop_mulWithCarry- :: (Num2 e, Integral e, Show e, FiniteBits (Unsigned e), Integral (Unsigned e))+ :: (Show e, Num2 e, Integral e, Show e, FiniteBits (Unsigned e), Integral (Unsigned e)) => Gen e -> Property prop_mulWithCarry e =@@ -77,7 +77,7 @@ uncurry toInteger2 (mulWithCarry x y) === toInteger x * toInteger y prop_acc_addWithCarry- :: ( Num2 (Exp e), Integral e, FiniteBits (Unsigned e), Integral (Unsigned e)+ :: ( Show e, 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@@ -89,7 +89,7 @@ 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)+ :: ( Show e, 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
test/Test/BigNum/Ord.hs view
@@ -3,10 +3,10 @@ {-# LANGUAGE RankNTypes #-} -- | -- Module : Test.BigNum.Ord--- Copyright : [2017] Trevor L. McDonell+-- Copyright : [2017..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --@@ -49,7 +49,7 @@ [ testProperty "compare" $ prop_compare a b ] - testAcc :: (Ord a, A.Ord a, Show (ArgType a))+ testAcc :: (Show a, Ord a, A.Ord a, Show (ArgType a)) => Gen a -> TestTree testAcc a =@@ -73,7 +73,7 @@ prop_binary' compare compare b x y prop_acc_lt- :: (Ord a, A.Ord a)+ :: (Show a, Ord a, A.Ord a) => RunN -> Gen a -> Property@@ -84,7 +84,7 @@ prop_acc_binary (<) (A.<) runN x y prop_acc_gt- :: (Ord a, A.Ord a)+ :: (Show a, Ord a, A.Ord a) => RunN -> Gen a -> Property@@ -95,7 +95,7 @@ prop_acc_binary (>) (A.>) runN x y prop_acc_lte- :: (Ord a, A.Ord a)+ :: (Show a, Ord a, A.Ord a) => RunN -> Gen a -> Property@@ -106,7 +106,7 @@ prop_acc_binary (<=) (A.<=) runN x y prop_acc_gte- :: (Ord a, A.Ord a)+ :: (Show a, Ord a, A.Ord a) => RunN -> Gen a -> Property
test/Test/BigNum/Real.hs view
@@ -2,10 +2,10 @@ {-# LANGUAGE FlexibleContexts #-} -- | -- Module : Test.BigNum.Real--- Copyright : [2017] Trevor L. McDonell+-- Copyright : [2017..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --
test/Test/Iso.hs view
@@ -8,10 +8,10 @@ {-# LANGUAGE TypeSynonymInstances #-} -- | -- Module : Test.Iso--- Copyright : [2017] Trevor L. McDonell+-- Copyright : [2017..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --@@ -20,8 +20,7 @@ import Test.Base -import Data.Array.Accelerate.Array.Sugar-import Data.Array.Accelerate ( Exp )+import Data.Array.Accelerate ( Exp, Elt, Scalar, fromFunction, indexArray, Z(..) ) import qualified Data.Array.Accelerate as A import Hedgehog@@ -39,7 +38,7 @@ instance Elt a => Iso a (Scalar a) where isoR x = fromFunction Z (const x)- isoL x = x ! Z+ isoL x = indexArray x Z with_unary :: Iso a b => proxy b -> (b -> b) -> a -> a@@ -121,7 +120,7 @@ {-# INLINE prop_acc_unary #-} prop_acc_unary- :: (Elt a, Elt b, Eq b, MonadTest m)+ :: (Elt a, Elt b, Eq b, Show b, MonadTest m) => (a -> b) -> (Exp a -> Exp b) -> RunN@@ -131,7 +130,7 @@ {-# INLINE prop_acc_binary #-} prop_acc_binary- :: (Elt a, Elt b, Elt c, Eq c, MonadTest m)+ :: (Elt a, Elt b, Elt c, Eq c, Show c, MonadTest m) => (a -> b -> c) -> (Exp a -> Exp b -> Exp c) -> RunN
test/Test/ShowType.hs view
@@ -5,10 +5,10 @@ {-# LANGUAGE ScopedTypeVariables #-} -- | -- Module : Test.ShowType--- Copyright : [2017] Trevor L. McDonell+-- Copyright : [2017..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --
test/Test/Types.hs view
@@ -2,10 +2,10 @@ {-# LANGUAGE MultiParamTypeClasses #-} -- | -- Module : Test.Types--- Copyright : [2017] Trevor L. McDonell+-- Copyright : [2017..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --
test/TestNative.hs view
@@ -1,9 +1,9 @@ -- | -- Module : TestNative--- Copyright : [2017] Trevor L. McDonell+-- Copyright : [2017..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --
test/TestPTX.hs view
@@ -1,9 +1,9 @@ -- | -- Module : TestPTX--- Copyright : [2017] Trevor L. McDonell+-- Copyright : [2017..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --