diff --git a/LICENCE b/LICENCE deleted file mode 100644 --- a/LICENCE +++ /dev/null @@ -1,7 +0,0 @@ -Copyright (c) 2011 Daniel Fischer - -Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,16 @@ +Copyright (c) 2011 Daniel Fischer + +Permission is hereby granted, free of charge, to any person obtaining a copy of this software and + associated documentation files (the "Software"), to deal in the Software without restriction, + including without limitation the rights to use, copy, modify, merge, publish, distribute, + sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all copies or +substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT +LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. + IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN + CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/Math/NumberTheory/Moduli.hs b/Math/NumberTheory/Moduli.hs --- a/Math/NumberTheory/Moduli.hs +++ b/Math/NumberTheory/Moduli.hs @@ -34,7 +34,9 @@ #include "MachDeps.h" +#if __GLASGOW_HASKELL__ < 709 import Data.Word +#endif import Data.Bits import Data.Array.Unboxed import Data.Array.Base (unsafeAt) diff --git a/Math/NumberTheory/Powers/Cubes.hs b/Math/NumberTheory/Powers/Cubes.hs --- a/Math/NumberTheory/Powers/Cubes.hs +++ b/Math/NumberTheory/Powers/Cubes.hs @@ -25,7 +25,9 @@ import Data.Array.ST import Data.Bits +#if __GLASGOW_HASKELL__ < 705 import Data.Word +#endif import GHC.Base import GHC.Integer @@ -201,13 +203,24 @@ appCuRt :: Integer -> Integer appCuRt (S# i#) = case double2Int# (int2Double# i# **## (1.0## /## 3.0##)) of r# -> S# r# +#if __GLASGOW_HASKELL__ < 709 appCuRt n@(J# s# _) | isTrue# (s# <# THRESH#) = floor (fromInteger n ** (1.0/3.0) :: Double) +#else +appCuRt n@(Jp# bn#) + | isTrue# ((sizeofBigNat# bn#) <# THRESH#) = + floor (fromInteger n ** (1.0/3.0) :: Double) +#endif | otherwise = case integerLog2# n of l# -> case (l# `quotInt#` 3#) -# 51# of h# -> case shiftRInteger n (3# *# h#) of m -> case floor (fromInteger m ** (1.0/3.0) :: Double) of r -> shiftLInteger r h# +#if __GLASGOW_HASKELL__ >= 709 +-- There's already handling for negative in integerCubeRoot, +-- but integerCubeRoot' is exported directly too. +appCuRt _ = error "integerCubeRoot': negative argument" +#endif -- not very discriminating, but cheap, so it's an overall gain cr512 :: UArray Int Bool diff --git a/Math/NumberTheory/Powers/Fourth.hs b/Math/NumberTheory/Powers/Fourth.hs --- a/Math/NumberTheory/Powers/Fourth.hs +++ b/Math/NumberTheory/Powers/Fourth.hs @@ -140,13 +140,24 @@ -- About 48 bits should be correct for large Integers. appBiSqrt :: Integer -> Integer appBiSqrt (S# i#) = S# (double2Int# (sqrtDouble# (sqrtDouble# (int2Double# i#)))) +#if __GLASGOW_HASKELL__ < 709 appBiSqrt n@(J# s# _) | isTrue# (s# <# THRESH#) = floor (sqrt . sqrt $ fromInteger n :: Double) +#else +appBiSqrt n@(Jp# bn#) + | isTrue# ((sizeofBigNat# bn#) <# THRESH#) = + floor (sqrt . sqrt $ fromInteger n :: Double) +#endif | otherwise = case integerLog2# n of l# -> case uncheckedIShiftRA# l# 2# -# 47# of h# -> case shiftRInteger n (4# *# h#) of m -> case floor (sqrt $ sqrt $ fromInteger m :: Double) of r -> shiftLInteger r h# +#if __GLASGOW_HASKELL__ >= 709 +-- There's already a check for negative in integerFourthRoot, +-- but integerFourthRoot' is exported directly too. +appBiSqrt _ = error "integerFourthRoot': negative argument" +#endif biSqRes256 :: UArray Int Bool diff --git a/Math/NumberTheory/Powers/General.hs b/Math/NumberTheory/Powers/General.hs --- a/Math/NumberTheory/Powers/General.hs +++ b/Math/NumberTheory/Powers/General.hs @@ -217,7 +217,7 @@ -- here, k > 4 and n > 31 appKthRoot :: Int -> Integer -> Integer appKthRoot (I# k#) (S# n#) = S# (double2Int# (int2Double# n# **## (1.0## /## int2Double# k#))) -appKthRoot k@(I# k#) n@(J# _ _) = +appKthRoot k@(I# k#) n = case integerLog2# n of l# -> case l# `quotInt#` k# of 0# -> 1 diff --git a/Math/NumberTheory/Powers/Squares.hs b/Math/NumberTheory/Powers/Squares.hs --- a/Math/NumberTheory/Powers/Squares.hs +++ b/Math/NumberTheory/Powers/Squares.hs @@ -193,13 +193,24 @@ -- for large Integers. appSqrt :: Integer -> Integer appSqrt (S# i#) = S# (double2Int# (sqrtDouble# (int2Double# i#))) +#if __GLASGOW_HASKELL__ < 709 appSqrt n@(J# s# _) | isTrue# (s# <# THRESH#) = floor (sqrt $ fromInteger n :: Double) +#else +appSqrt n@(Jp# bn#) + | isTrue# ((sizeofBigNat# bn#) <# THRESH#) = + floor (sqrt $ fromInteger n :: Double) +#endif | otherwise = case integerLog2# n of l# -> case uncheckedIShiftRA# l# 1# -# 47# of h# -> case shiftRInteger n (2# *# h#) of m -> case floor (sqrt $ fromInteger m :: Double) of r -> shiftLInteger r h# +#if __GLASGOW_HASKELL__ >= 709 +-- There's already a check for negative in integerSquareRoot, +-- but integerSquareRoot' is exported directly too. +appSqrt _ = error "integerSquareRoot': negative argument" +#endif -- Auxiliaries diff --git a/Math/NumberTheory/Primes/Factorisation/Certified.hs b/Math/NumberTheory/Primes/Factorisation/Certified.hs --- a/Math/NumberTheory/Primes/Factorisation/Certified.hs +++ b/Math/NumberTheory/Primes/Factorisation/Certified.hs @@ -10,7 +10,7 @@ -- -- For large numbers, this will be very slow in general. -- Use only if you're paranoid or must be /really/ sure. -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BangPatterns, CPP #-} module Math.NumberTheory.Primes.Factorisation.Certified ( certifiedFactorisation , certificateFactorisation @@ -19,7 +19,9 @@ import System.Random import Control.Monad.State.Strict +#if __GLASGOW_HASKELL__ < 709 import Control.Applicative +#endif import Data.Maybe import Data.Bits diff --git a/Math/NumberTheory/Primes/Factorisation/Montgomery.hs b/Math/NumberTheory/Primes/Factorisation/Montgomery.hs --- a/Math/NumberTheory/Primes/Factorisation/Montgomery.hs +++ b/Math/NumberTheory/Primes/Factorisation/Montgomery.hs @@ -50,7 +50,9 @@ import System.Random import Control.Monad.State.Strict +#if __GLASGOW_HASKELL__ < 709 import Control.Applicative +#endif import Data.Bits import Data.Maybe diff --git a/Math/NumberTheory/Primes/Heap.hs b/Math/NumberTheory/Primes/Heap.hs --- a/Math/NumberTheory/Primes/Heap.hs +++ b/Math/NumberTheory/Primes/Heap.hs @@ -26,7 +26,9 @@ import Data.Array.ST import Control.Monad.ST import Data.List (foldl') +#if __GLASGOW_HASKELL__ < 709 import Data.Word +#endif #ifndef SH_SIZE #define SH_SIZE 31 diff --git a/Math/NumberTheory/Primes/Sieve/Eratosthenes.hs b/Math/NumberTheory/Primes/Sieve/Eratosthenes.hs --- a/Math/NumberTheory/Primes/Sieve/Eratosthenes.hs +++ b/Math/NumberTheory/Primes/Sieve/Eratosthenes.hs @@ -42,7 +42,9 @@ #endif import Control.Monad (when) import Data.Bits +#if __GLASGOW_HASKELL__ < 709 import Data.Word +#endif import Math.NumberTheory.Powers.Squares (integerSquareRoot) import Math.NumberTheory.Utils diff --git a/Math/NumberTheory/Primes/Testing/Certificates/Internal.hs b/Math/NumberTheory/Primes/Testing/Certificates/Internal.hs --- a/Math/NumberTheory/Primes/Testing/Certificates/Internal.hs +++ b/Math/NumberTheory/Primes/Testing/Certificates/Internal.hs @@ -7,6 +7,7 @@ -- Portability: Non-portable (GHC extensions) -- -- Certificates for primality or compositeness. +{-# LANGUAGE CPP #-} {-# OPTIONS_HADDOCK hide #-} module Math.NumberTheory.Primes.Testing.Certificates.Internal ( Certificate(..) @@ -29,7 +30,9 @@ ) where import Data.List +#if __GLASGOW_HASKELL__ < 709 import Data.Word +#endif import Data.Bits import Data.Maybe diff --git a/Math/NumberTheory/Primes/Testing/Probabilistic.hs b/Math/NumberTheory/Primes/Testing/Probabilistic.hs --- a/Math/NumberTheory/Primes/Testing/Probabilistic.hs +++ b/Math/NumberTheory/Primes/Testing/Probabilistic.hs @@ -195,9 +195,16 @@ v2n1 = ((un1 - (2*q)*un)*vn-qn) `rem` n q2n = (qn*qn) `rem` n q2n1 = (qn*qn*q) `rem` n +#if __GLASGOW_HASKELL__ < 709 testLucas n q (J# s# ba#) = test (s# -# 1#) where test j# = case indexWordArray# ba# j# of +#else +testLucas n q (Jp# bn#) = test (s# -# 1#) + where + s# = sizeofBigNat# bn# + test j# = case indexBigNat# bn# j# of +#endif 0## -> test (j# -# 1#) w# -> look (j# -# 1#) (W# w#) (WORD_SIZE_IN_BITS - 1) look j# w i @@ -206,7 +213,11 @@ go k# w i un un1 vn qn | i < 0 = if isTrue# (k# <# 0#) then (un,vn,qn) +#if __GLASGOW_HASKELL__ < 709 else go (k# -# 1#) (W# (indexWordArray# ba# k#)) (WORD_SIZE_IN_BITS - 1) un un1 vn qn +#else + else go (k# -# 1#) (W# (indexBigNat# bn# k#)) (WORD_SIZE_IN_BITS - 1) un un1 vn qn +#endif | testBit w i = go k# w (i-1) u2n1 u2n2 v2n1 q2n1 | otherwise = go k# w (i-1) u2n u2n1 v2n q2n where @@ -217,6 +228,10 @@ v2n1 = ((un1 - (2*q)*un)*vn-qn) `rem` n q2n = (qn*qn) `rem` n q2n1 = (qn*qn*q) `rem` n +#if __GLASGOW_HASKELL__ >= 709 +-- Listed as a precondition of lucasTest +testLucas _ _ _ = error "lucasTest: negative argument" +#endif smallPrimes :: [Integer] smallPrimes = 2:3:5:prs diff --git a/Math/NumberTheory/Utils.hs b/Math/NumberTheory/Utils.hs --- a/Math/NumberTheory/Utils.hs +++ b/Math/NumberTheory/Utils.hs @@ -87,15 +87,35 @@ (# z#, w# #) | isTrue# (z# ==# 0#) -> (0, n) | otherwise -> (I# z#, S# (word2Int# w#)) +#if __GLASGOW_HASKELL__ < 709 shiftOCInteger n@(J# _ ba#) = case count 0# 0# of +#else +shiftOCInteger n@(Jp# bn#) = case bigNatZeroCount bn# of 0# -> (0, n) z# -> (I# z#, n `shiftRInteger` z#) +shiftOCInteger n@(Jn# bn#) = case bigNatZeroCount bn# of +#endif + 0# -> (0, n) + z# -> (I# z#, n `shiftRInteger` z#) +#if __GLASGOW_HASKELL__ < 709 where count a# i# = case indexWordArray# ba# i# of + 0## -> count (a# +# WORD_SIZE_IN_BITS#) (i# +# 1#) + w# -> a# +# trailZeros# w# +#endif + +#if __GLASGOW_HASKELL__ >= 709 +-- | Count trailing zeros in a @'BigNat'@. +-- Precondition: argument nonzero (not checked, Integer invariant). +bigNatZeroCount :: BigNat -> Int# +bigNatZeroCount bn# = count 0# 0# + where + count a# i# = + case indexBigNat# bn# i# of 0## -> count (a# +# WORD_SIZE_IN_BITS#) (i# +# 1#) w# -> a# +# trailZeros# w# - +#endif -- | Remove factors of @2@. If @n = 2^k*m@ with @m@ odd, the result is @m@. -- Precondition: argument not @0@ (not checked). @@ -122,14 +142,23 @@ -- Precondition: argument nonzero (not checked). shiftOInteger :: Integer -> Integer shiftOInteger (S# i#) = S# (word2Int# (shiftToOdd# (int2Word# i#))) +#if __GLASGOW_HASKELL__ < 709 shiftOInteger n@(J# _ ba#) = case count 0# 0# of +#else +shiftOInteger n@(Jn# bn#) = case bigNatZeroCount bn# of 0# -> n z# -> n `shiftRInteger` z# +shiftOInteger n@(Jp# bn#) = case bigNatZeroCount bn# of +#endif + 0# -> n + z# -> n `shiftRInteger` z# +#if __GLASGOW_HASKELL__ < 709 where count a# i# = case indexWordArray# ba# i# of 0## -> count (a# +# WORD_SIZE_IN_BITS#) (i# +# 1#) w# -> a# +# trailZeros# w# +#endif -- | Shift argument right until the result is odd. -- Precondition: argument not @0@, not checked. diff --git a/arithmoi.cabal b/arithmoi.cabal --- a/arithmoi.cabal +++ b/arithmoi.cabal @@ -1,10 +1,10 @@ name : arithmoi -version : 0.4.1.2 -cabal-version : >= 1.6 +version : 0.4.1.3 +cabal-version : >= 1.10 author : Daniel Fischer copyright : (c) 2011 Daniel Fischer license : MIT -license-file : LICENCE +license-file : LICENSE maintainer : Carter Schonwald carter at wellposed dot com build-type : Simple stability : Provisional @@ -37,9 +37,15 @@ manual : True library - build-depends : base >= 4 && < 5, array >= 0.3 && < 0.6, ghc-prim, - integer-gmp<1, containers >= 0.3 && < 0.6, random >= 1.0 && < 1.2, - mtl >= 2.0 && < 2.3 + default-language: Haskell2010 + build-depends : base >= 4 && < 5 + , array >= 0.3 && < 0.6 + , ghc-prim < 0.5 + , integer-gmp < 1.1 + , containers >= 0.3 && < 0.6 + , random >= 1.0 && < 1.2 + , mtl >= 2.0 && < 2.3 + exposed-modules : Math.NumberTheory.Logarithms Math.NumberTheory.Moduli Math.NumberTheory.MoebiusInversion @@ -74,7 +80,8 @@ Math.NumberTheory.Primes.Testing.Probabilistic Math.NumberTheory.Primes.Testing.Certified Math.NumberTheory.Primes.Testing.Certificates.Internal - extensions : BangPatterns + other-extensions : BangPatterns + ghc-options : -O2 -Wall if flag(llvm) ghc-options : -fllvm @@ -83,3 +90,24 @@ source-repository head type: git location: https://github.com/cartazio/arithmoi + + +benchmark criterion + build-depends: base + ,arithmoi + ,criterion + hs-source-dirs: benchmark + main-is: Bench.hs + type: exitcode-stdio-1.0 + default-language: Haskell2010 + +test-suite spec + type: exitcode-stdio-1.0 + hs-source-dirs: test-suite + ghc-options: -Wall + main-is: Spec.hs + default-language: Haskell2010 + build-depends: base + ,hspec + ,arithmoi + diff --git a/benchmark/Bench.hs b/benchmark/Bench.hs new file mode 100644 --- /dev/null +++ b/benchmark/Bench.hs @@ -0,0 +1,3 @@ +module Main where + +main = return () diff --git a/test-suite/Spec.hs b/test-suite/Spec.hs new file mode 100644 --- /dev/null +++ b/test-suite/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}