quote-quot-0.2.1.0/0000755000000000000000000000000007346545000012164 5ustar0000000000000000quote-quot-0.2.1.0/LICENSE0000644000000000000000000000300007346545000013162 0ustar0000000000000000Copyright Andrew Lelechenko (c) 2020-2022 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Andrew Lelechenko nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. quote-quot-0.2.1.0/README.md0000644000000000000000000000444007346545000013445 0ustar0000000000000000# quote-quot [![Hackage](http://img.shields.io/hackage/v/quote-quot.svg)](https://hackage.haskell.org/package/quote-quot) [![Stackage LTS](http://stackage.org/package/quote-quot/badge/lts)](http://stackage.org/lts/package/quote-quot) [![Stackage Nightly](http://stackage.org/package/quote-quot/badge/nightly)](http://stackage.org/nightly/package/quote-quot) Generate routines for integer division, employing arithmetic and bitwise operations only, which are __2.5x-3.5x faster__ than `quot`. Divisors must be known in compile-time and be positive. ```haskell {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -ddump-splices -ddump-simpl -dsuppress-all #-} import Numeric.QuoteQuot -- Equivalent to (`quot` 10). quot10 :: Word -> Word quot10 = $$(quoteQuot 10) ``` ```haskell >>> quot10 123 12 ``` Here `-ddump-splices` demonstrates the chosen implementation for division by 10: ```haskell Splicing expression quoteQuot 10 ======> ((`shiftR` 3) . ((\ (W# w_a9N4) -> let !(# hi_a9N5, _ #) = (timesWord2# w_a9N4) 14757395258967641293## in W# hi_a9N5) . id)) ``` And `-ddump-simpl` demonstrates generated Core: ```haskell quot10 = \ x_a5t2 -> case x_a5t2 of { W# w_acHY -> case timesWord2# w_acHY 14757395258967641293## of { (# hi_acIg, ds_dcIs #) -> W# (uncheckedShiftRL# hi_acIg 3#) } } ``` Benchmarks show that this implementation is __3.5x faster__ than ``(`quot` 10)``: ```haskell {-# LANGUAGE TemplateHaskell #-} import Data.List import Numeric.QuoteQuot import System.CPUTime measure :: String -> (Word -> Word) -> IO () measure name f = do t0 <- getCPUTime print $ foldl' (+) 0 $ map f [0..100000000] t1 <- getCPUTime putStrLn $ name ++ " " ++ show ((t1 - t0) `quot` 1000000000) ++ " ms" {-# INLINE measure #-} main :: IO () main = do measure " (`quot` 10)" (`quot` 10) measure "$$(quoteQuot 10)" $$(quoteQuot 10) ``` ``` 499999960000000 (`quot` 10) 316 ms 499999960000000 $$(quoteQuot 10) 89 ms ``` Conventional wisdom is that such microoptimizations are negligible in practice, but this is not always the case. For instance, quite surprisingly, this trick alone [made Unicode normalization of Hangul characters twice faster](https://github.com/composewell/unicode-transforms/pull/42) in [`unicode-transforms`](http://hackage.haskell.org/package/unicode-transforms). quote-quot-0.2.1.0/bench/0000755000000000000000000000000007346545000013243 5ustar0000000000000000quote-quot-0.2.1.0/bench/Bench.hs0000644000000000000000000000306407346545000014621 0ustar0000000000000000-- | -- Copyright: (c) 2020-2022 Andrew Lelechenko -- Licence: BSD3 -- {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TemplateHaskell #-} module Main (main) where import GHC.Exts import Numeric.QuoteQuot import Test.Tasty.Bench measureWord :: String -> (Word -> Word) -> Benchmark measureWord name f = bench name $ whnf (\(W# n#) -> W# (go 0## n#)) 100000000 where go acc# 0## = acc# go acc# k# = go (let !(W# fk) = f (W# k#) in acc# `plusWord#` fk) (k# `minusWord#` 1##) {-# INLINE measureWord #-} measureInt :: String -> (Int -> Int) -> Benchmark measureInt name f = bench name $ whnf (\(I# n#) -> I# (go 0# n#)) 100000000 where go acc# 0# = acc# go acc# k# = go (let !(I# fk) = f (I# k#) in acc# +# fk) (k# -# 1#) {-# INLINE measureInt #-} #define benchWord(n) \ bgroup (show (n :: Word)) \ [ measureWord "quot" (`quot` (n :: Word)) \ , bcompare ("$NF == \"quot\" && $(NF-1) == \"" ++ show (n :: Word) ++ "\" && $(NF-2) == \"Word\"") \ $ measureWord "quoteQuot" $$(quoteQuot (n :: Word)) \ ] #define benchInt(n) \ bgroup (show (n :: Int)) \ [ measureInt "quot" (`quot` (n :: Int)) \ , bcompare ("$NF == \"quot\" && $(NF-1) == \"" ++ show (n :: Int) ++ "\" && $(NF-2) == \"Int\"") \ $ measureInt "quoteQuot" $$(quoteQuot (n :: Int)) \ ] main :: IO () main = defaultMain [ bgroup "Word" [ benchWord(3) , benchWord(5) , benchWord(7) ] #if MIN_VERSION_base(4,15,0) , bgroup "Int" [ benchInt(3) , benchInt(5) , benchInt(7) ] #endif ] quote-quot-0.2.1.0/changelog.md0000644000000000000000000000031707346545000014436 0ustar0000000000000000## 0.2.1.0 * Add `quoteAST` and `assumeNonNegArg`. ## 0.2.0.0 * Make `quoteQuot` polymorphic. * Support `template-haskell-2.17`. * Support signed division (GHC 9.0+ only). ## 0.1.0.0 * Initial release. quote-quot-0.2.1.0/quote-quot.cabal0000644000000000000000000000321707346545000015276 0ustar0000000000000000cabal-version: >=1.10 name: quote-quot version: 0.2.1.0 license: BSD3 license-file: LICENSE copyright: 2020-2022 Andrew Lelechenko maintainer: andrew.lelechenko@gmail.com author: Andrew Lelechenko tested-with: ghc ==8.10.7, ghc ==9.0.2, ghc ==9.2.2 homepage: https://github.com/Bodigrim/quote-quot#readme synopsis: Divide without division description: Generate routines for integer division, employing arithmetic and bitwise operations only, which are __2.5x-3.5x faster__ than 'quot'. Divisors must be known in compile-time and be positive. category: Math, Numerical build-type: Simple extra-source-files: changelog.md README.md source-repository head type: git location: https://github.com/Bodigrim/quote-quot library exposed-modules: Numeric.QuoteQuot hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall -Wcompat build-depends: base < 5, template-haskell >=2.16 test-suite quote-quot-tests type: exitcode-stdio-1.0 main-is: Test.hs hs-source-dirs: tests default-language: Haskell2010 ghc-options: -Wall -threaded -rtsopts -Wcompat build-depends: base, quote-quot, tasty, tasty-quickcheck, -- wide-word >=0.1.1.2, -- word24, template-haskell benchmark quote-quot-bench type: exitcode-stdio-1.0 main-is: Bench.hs hs-source-dirs: bench default-language: Haskell2010 ghc-options: -Wall -O2 -Wcompat build-depends: base, quote-quot, tasty-bench >= 0.3, template-haskell quote-quot-0.2.1.0/src/Numeric/0000755000000000000000000000000007346545000014355 5ustar0000000000000000quote-quot-0.2.1.0/src/Numeric/QuoteQuot.hs0000644000000000000000000002204307346545000016660 0ustar0000000000000000-- | -- Module: Numeric.QuoteQuot -- Copyright: (c) 2020-2022 Andrew Lelechenko -- Licence: BSD3 -- Maintainer: Andrew Lelechenko -- -- Generate routines for integer division, employing arithmetic -- and bitwise operations only, which are __2.5x-3.5x faster__ -- than 'quot'. Divisors must be known in compile-time and be positive. -- {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_GHC -Wno-missing-signatures #-} module Numeric.QuoteQuot ( -- * Quasiquoters quoteQuot , quoteRem , quoteQuotRem -- * AST , astQuot , AST(..) , interpretAST , quoteAST , assumeNonNegArg , MulHi(..) ) where #include "MachDeps.h" import Prelude import Data.Bits import Data.Int import Data.Word import GHC.Exts import Language.Haskell.TH.Syntax -- | Quote integer division ('quot') by a compile-time known divisor, -- which generates source code, employing arithmetic and bitwise operations only. -- This is usually __2.5x-3.5x faster__ than using normal 'quot'. -- -- > {-# LANGUAGE TemplateHaskell #-} -- > {-# OPTIONS_GHC -ddump-splices -ddump-simpl -dsuppress-all #-} -- > module Example where -- > import Numeric.QuoteQuot -- > -- > -- Equivalent to (`quot` 10). -- > quot10 :: Word -> Word -- > quot10 = $$(quoteQuot 10) -- -- >>> quot10 123 -- 12 -- -- Here @-ddump-splices@ demonstrates the chosen implementation -- for division by 10: -- -- > Splicing expression quoteQuot 10 ======> -- > ((`shiftR` 3) . ((\ (W# w_a9N4) -> -- > let !(# hi_a9N5, _ #) = (timesWord2# w_a9N4) 14757395258967641293## -- > in W# hi_a9N5) . id)) -- -- And @-ddump-simpl@ demonstrates generated Core: -- -- > quot10 = \ x_a5t2 -> -- > case x_a5t2 of { W# w_acHY -> -- > case timesWord2# w_acHY 14757395258967641293## of -- > { (# hi_acIg, ds_dcIs #) -> -- > W# (uncheckedShiftRL# hi_acIg 3#) -- > } -- > } -- -- Benchmarks show that this implementation is __3.5x faster__ -- than @(`@'quot'@` 10)@. -- quoteQuot :: #if MIN_VERSION_template_haskell(2,17,0) (MulHi a, Lift a, Quote m) => a -> Code m (a -> a) #else (MulHi a, Lift a) => a -> Q (TExp (a -> a)) #endif quoteQuot d = quoteAST (astQuot d) -- | Similar to 'quoteQuot', but for 'rem'. quoteRem :: #if MIN_VERSION_template_haskell(2,17,0) (MulHi a, Lift a, Quote m) => a -> Code m (a -> a) #else (MulHi a, Lift a) => a -> Q (TExp (a -> a)) #endif quoteRem d = [|| snd . $$(quoteQuotRem d) ||] -- | Similar to 'quoteQuot', but for 'quotRem'. quoteQuotRem :: #if MIN_VERSION_template_haskell(2,17,0) (MulHi a, Lift a, Quote m) => a -> Code m (a -> (a, a)) #else (MulHi a, Lift a) => a -> Q (TExp (a -> (a, a))) #endif quoteQuotRem d = [|| \w -> let q = $$(quoteQuot d) w in (q, w - d * q) ||] -- | Types allowing to multiply wide and return the high word of result. class (Integral a, FiniteBits a) => MulHi a where mulHi :: a -> a -> a instance MulHi Word8 where mulHi x y = fromIntegral ((fromIntegral x * fromIntegral y :: Word16) `shiftR` 8) instance MulHi Word16 where mulHi x y = fromIntegral ((fromIntegral x * fromIntegral y :: Word32) `shiftR` 16) instance MulHi Word32 where mulHi x y = fromIntegral ((fromIntegral x * fromIntegral y :: Word64) `shiftR` 32) #if WORD_SIZE_IN_BITS == 64 instance MulHi Word64 where mulHi x y = fromIntegral (fromIntegral x `mulHi` fromIntegral y :: Word) #endif instance MulHi Word where mulHi (W# x) (W# y) = let !(# hi, _ #) = timesWord2# x y in W# hi instance MulHi Int8 where mulHi x y = fromIntegral ((fromIntegral x * fromIntegral y :: Int16) `shiftR` 8) instance MulHi Int16 where mulHi x y = fromIntegral ((fromIntegral x * fromIntegral y :: Int32) `shiftR` 16) instance MulHi Int32 where mulHi x y = fromIntegral ((fromIntegral x * fromIntegral y :: Int64) `shiftR` 32) #if MIN_VERSION_base(4,15,0) #if WORD_SIZE_IN_BITS == 64 instance MulHi Int64 where mulHi x y = fromIntegral (fromIntegral x `mulHi` fromIntegral y :: Int) #endif instance MulHi Int where mulHi (I# x) (I# y) = let !(# _, hi, _ #) = timesInt2# x y in I# hi #endif -- | An abstract syntax tree to represent -- a function of one argument. data AST a = Arg -- ^ Argument of the function | MulHi (AST a) a -- ^ Multiply wide and return the high word of result | MulLo (AST a) a -- ^ Multiply | Add (AST a) (AST a) -- ^ Add | Sub (AST a) (AST a) -- ^ Subtract | Shl (AST a) Int -- ^ Shift left | Shr (AST a) Int -- ^ Shift right with sign extension | CmpGE (AST a) a -- ^ 1 if greater than or equal, 0 otherwise | CmpLT (AST a) a -- ^ 1 if less than, 0 otherwise deriving (Show) -- | Optimize 'AST', assuming that 'Arg' is non-negative. assumeNonNegArg :: (Ord a, Num a) => AST a -> AST a assumeNonNegArg = \case Add x (CmpLT Arg n) | n <= 0 -> x Sub x (CmpLT Arg n) | n <= 0 -> x Add x (MulLo (CmpLT Arg n) _) | n <= 0 -> x e -> e -- | Reference (but slow) interpreter of 'AST'. -- It is not meant to be used in production -- and is provided primarily for testing purposes. -- -- >>> interpretAST (astQuot (10 :: Data.Word.Word8)) 123 -- 12 -- interpretAST :: (Integral a, FiniteBits a) => AST a -> (a -> a) interpretAST ast n = go ast where go = \case Arg -> n MulHi x k -> fromInteger $ (toInteger (go x) * toInteger k) `shiftR` finiteBitSize k MulLo x k -> go x * k Add x y -> go x + go y Sub x y -> go x - go y Shl x k -> go x `shiftL` k Shr x k -> go x `shiftR` k CmpGE x k -> if go x >= k then 1 else 0 CmpLT x k -> if go x < k then 1 else 0 -- | Embed 'AST' into Haskell expression. quoteAST :: #if MIN_VERSION_template_haskell(2,17,0) (MulHi a, Lift a, Quote m) => AST a -> Code m (a -> a) #else (MulHi a, Lift a) => AST a -> Q (TExp (a -> a)) #endif quoteAST = \case Arg -> [|| id ||] Shr x k -> [|| (`shiftR` k) . $$(quoteAST x) ||] Shl x k -> [|| (`shiftL` k) . $$(quoteAST x) ||] MulHi x k -> [|| (`mulHi` k) . $$(quoteAST x) ||] MulLo x k -> [|| (* k) . $$(quoteAST x) ||] Add x y -> [|| \w -> $$(quoteAST x) w + $$(quoteAST y) w ||] Sub x y -> [|| \w -> $$(quoteAST x) w - $$(quoteAST y) w ||] CmpGE x k -> [|| (\w -> fromIntegral (I# (dataToTag# (w >= k)))) . $$(quoteAST x) ||] CmpLT x k -> [|| (\w -> fromIntegral (I# (dataToTag# (w < k)))) . $$(quoteAST x) ||] -- | 'astQuot' @d@ constructs an 'AST' representing -- a function, equivalent to 'quot' @a@ for positive @a@, -- but avoiding division instructions. -- -- >>> astQuot (10 :: Data.Word.Word8) -- Shr (MulHi Arg 205) 3 -- -- And indeed to divide 'Data.Word.Word8' by 10 -- one can multiply it by 205, take the high byte and -- shift it right by 3. Somewhat counterintuitively, -- this sequence of operations is faster than a single -- division on most modern achitectures. -- -- 'astQuot' function is polymorphic and supports both signed -- and unsigned operands of arbitrary finite bitness. -- Implementation is based on -- Ch. 10 of Hacker's Delight by Henry S. Warren, 2012. -- astQuot :: (Integral a, FiniteBits a) => a -> AST a astQuot k | isSigned k = signedQuot k | otherwise = unsignedQuot k unsignedQuot :: (Integral a, FiniteBits a) => a -> AST a unsignedQuot k' | isSigned k = error "unsignedQuot works for unsigned types only" | k' == 0 = error "divisor must be positive" | k' == 1 = Arg | k == 1 = shr Arg kZeros | k' >= 1 `shiftL` (fbs - 1) = CmpGE Arg k' -- Hacker's Delight, 10-8, Listing 1 | k >= 1 `shiftL` shft = shr (MulHi Arg magic) (shft + kZeros) -- Hacker's Delight, 10-8, Listing 3 | otherwise = shr (Add (shr (Sub Arg (MulHi Arg magic)) 1) (MulHi Arg magic)) (shft - 1 + kZeros) where fbs = finiteBitSize k' kZeros = countTrailingZeros k' k = k' `shiftR` kZeros r0 = fromInteger ((1 `shiftL` fbs) `rem` toInteger k) shft = go r0 0 magic = fromInteger ((1 `shiftL` (fbs + shft)) `quot` toInteger k + 1) go r s | (k - r) < 1 `shiftL` s = s | otherwise = go (r `shiftL` 1 `rem` k) (s + 1) signedQuot :: (Integral a, FiniteBits a) => a -> AST a signedQuot k' | not (isSigned k) = error "signedQuot works for signed types only" | k' <= 0 = error "divisor must be positive" | k' == 1 = Arg -- Hacker's Delight, 10-1, Listing 2 | k == 1 = shr (Add Arg (MulLo (CmpLT Arg 0) (k' - 1))) kZeros | k' >= 1 `shiftL` (fbs - 2) = Sub (CmpGE Arg k') (CmpLT Arg (1 - k')) -- Hacker's Delight, 10-3, Listing 2 | magic >= 0 = Add (shr (MulHi Arg magic) (shft + kZeros)) (CmpLT Arg 0) -- Hacker's Delight, 10-3, Listing 3 | otherwise = Add (shr (Add Arg (MulHi Arg magic)) (shft + kZeros)) (CmpLT Arg 0) where fbs = finiteBitSize k' kZeros = countTrailingZeros k' k = k' `shiftR` kZeros r0 = fromInteger ((1 `shiftL` fbs) `rem` toInteger k) shft = go r0 0 magic = fromInteger ((1 `shiftL` (fbs + shft)) `quot` toInteger k + 1) go r s | (k - r) < 1 `shiftL` (s + 1) = s | otherwise = go (r `shiftL` 1 `rem` k) (s + 1) shr :: AST a -> Int -> AST a shr x 0 = x shr x k = Shr x k quote-quot-0.2.1.0/tests/0000755000000000000000000000000007346545000013326 5ustar0000000000000000quote-quot-0.2.1.0/tests/Test.hs0000644000000000000000000001165507346545000014611 0ustar0000000000000000-- | -- Copyright: (c) 2020-2022 Andrew Lelechenko -- Licence: BSD3 -- {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Main (main) where import Data.Bits import Data.Int import Data.Proxy import Data.Word import Numeric.QuoteQuot import Test.Tasty import Test.Tasty.QuickCheck import Text.Printf #ifdef MIN_VERSION_word24 import Data.Int.Int24 import Data.Word.Word24 #endif #ifdef MIN_VERSION_wide_word import Data.WideWord #endif main :: IO () main = defaultMain $ testGroup "All" [testAst, testQuotes] testAst :: TestTree testAst = testGroup "Ast" [ testGroup "Word" (mkTests (Proxy @Word)) , testGroup "Word8" (mkTests (Proxy @Word8)) , testGroup "Word16" (mkTests (Proxy @Word16)) , testGroup "Word32" (mkTests (Proxy @Word32)) , testGroup "Word64" (mkTests (Proxy @Word64)) , testGroup "Int" (mkTests (Proxy @Int)) , testGroup "Int8" (mkTests (Proxy @Int8)) , testGroup "Int16" (mkTests (Proxy @Int16)) , testGroup "Int32" (mkTests (Proxy @Int32)) , testGroup "Int64" (mkTests (Proxy @Int64)) #ifdef MIN_VERSION_word24 , testGroup "Word24" (mkTests (Proxy @Word24)) , testGroup "Int24" (mkTests (Proxy @Int24)) #endif #ifdef MIN_VERSION_wide_word , testGroup "Word128" (mkTests (Proxy @Word128)) , testGroup "Word256" (mkTests (Proxy @Word256)) , testGroup "Int128" (mkTests (Proxy @Int128)) #endif ] mkTests :: forall a. (Integral a, FiniteBits a, Show a, Bounded a, Arbitrary a) => Proxy a -> [TestTree] mkTests _ | isSigned (undefined :: a) = [ testProperty "above zero" (prop @a . getNonNegative) , testProperty "above zero assumeNonNegArg" (propNonNeg @a) , testProperty "below zero" (prop @a . negate . getNonNegative) , testProperty "above minBound" (prop @a . (minBound +) . getNonNegative) , testProperty "below maxBound" (prop @a . (maxBound -) . getNonNegative) , testProperty "below maxBound assumeNonNegArg" (propNonNeg @a . NonNegative . (maxBound -) . getNonNegative) ] | otherwise = [ testProperty "above zero" (prop @a) , testProperty "below maxBound" (prop @a . (maxBound -)) ] prop :: (Integral a, FiniteBits a, Show a) => a -> Positive a -> Property prop x (Positive y) = counterexample (printf "%s `quot` %s = %s /= %s = eval (%s) %s" (show x) (show y) (show ref) (show q) (show ast) (show x)) (q == ref) where ref = x `quot` y ast = astQuot y q = interpretAST ast x propNonNeg :: (Integral a, FiniteBits a, Show a) => NonNegative a -> Positive a -> Property propNonNeg (NonNegative x) (Positive y) = counterexample (printf "%s `quot` %s = %s /= %s = eval (%s) %s" (show x) (show y) (show ref) (show q) (show ast) (show x)) (q == ref) where ref = x `quot` y ast = assumeNonNegArg $ astQuot y q = interpretAST ast x #ifdef MIN_VERSION_word24 instance Arbitrary Word24 where arbitrary = arbitrarySizedBoundedIntegral instance Arbitrary Int24 where arbitrary = arbitrarySizedBoundedIntegral #endif #ifdef MIN_VERSION_wide_word instance Arbitrary Word128 where arbitrary = arbitrarySizedBoundedIntegral instance Arbitrary Word256 where arbitrary = arbitrarySizedBoundedIntegral instance Arbitrary Int128 where arbitrary = arbitrarySizedBoundedIntegral #endif #define testQuotes(ty) \ [ testProperty "1" $ \x -> $$(quoteQuotRem (1 :: ty)) x === x `quotRem` 1 \ , testProperty "2" $ \x -> $$(quoteQuotRem (2 :: ty)) x === x `quotRem` 2 \ , testProperty "3" $ \x -> $$(quoteQuotRem (3 :: ty)) x === x `quotRem` 3 \ , testProperty "4" $ \x -> $$(quoteQuotRem (4 :: ty)) x === x `quotRem` 4 \ , testProperty "5" $ \x -> $$(quoteQuotRem (5 :: ty)) x === x `quotRem` 5 \ , testProperty "6" $ \x -> $$(quoteQuotRem (6 :: ty)) x === x `quotRem` 6 \ , testProperty "7" $ \x -> $$(quoteQuotRem (7 :: ty)) x === x `quotRem` 7 \ , testProperty "8" $ \x -> $$(quoteQuotRem (8 :: ty)) x === x `quotRem` 8 \ , testProperty "9" $ \x -> $$(quoteQuotRem (9 :: ty)) x === x `quotRem` 9 \ , testProperty "10" $ \x -> $$(quoteQuotRem (10 :: ty)) x === x `quotRem` 10 \ , testProperty "maxBound" $ \x -> $$(quoteQuotRem (maxBound :: ty)) x === x `quotRem` maxBound \ , testProperty "maxBound - 1" $ \x -> $$(quoteQuotRem (maxBound - 1 :: ty)) x === x `quotRem` (maxBound - 1) \ ] \ testQuotes :: TestTree testQuotes = testGroup "Quotes" [ testGroup "Word8" testQuotes(Word8) , testGroup "Word16" testQuotes(Word16) , testGroup "Word32" testQuotes(Word32) #if WORD_SIZE_IN_BITS == 64 , testGroup "Word64" testQuotes(Word64) #endif , testGroup "Word" testQuotes(Word) , testGroup "Int8" testQuotes(Int8) , testGroup "Int16" testQuotes(Int16) , testGroup "Int32" testQuotes(Int32) #if MIN_VERSION_base(4,15,0) #if WORD_SIZE_IN_BITS == 64 , testGroup "Int64" testQuotes(Int64) #endif , testGroup "Int" testQuotes(Int) #endif ]