Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package ghc-quote-quot for openSUSE:Factory
checked in at 2026-11-06 19:49:39
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-quote-quot (Old)
and /work/SRC/openSUSE:Factory/.ghc-quote-quot.new.3759290 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-quote-quot"
Fri Nov 6 19:49:39 2026 rev:2 rq:1395552 version:0.2.2.0
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-quote-quot/ghc-quote-quot.changes
2023-09-28 00:33:37.590282764 +0200
+++
/work/SRC/openSUSE:Factory/.ghc-quote-quot.new.3759290/ghc-quote-quot.changes
2026-11-06 19:56:35.357696725 +0100
@@ -1,0 +2,9 @@
+Sun Aug 2 00:07:01 UTC 2026 - Peter Simons <[email protected]>
+
+- Update quote-quot to version 0.2.2.0.
+ ## 0.2.2.0
+
+ * Add `quoteDiv`, `quoteMod` and `quoteDivMod`.
+ * Define `instance MulHi {Int,Word}64` even on 32-bit arch.
+
+-------------------------------------------------------------------
Old:
----
quote-quot-0.2.1.0.tar.gz
New:
----
quote-quot-0.2.2.0.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-quote-quot.spec ++++++
--- /var/tmp/diff_new_pack.lTPLsy/_old 2026-11-06 19:56:37.263776515 +0100
+++ /var/tmp/diff_new_pack.lTPLsy/_new 2026-11-06 19:56:37.265776598 +0100
@@ -1,7 +1,7 @@
#
# spec file for package ghc-quote-quot
#
-# Copyright (c) 2022 SUSE LLC
+# Copyright (c) 2026 SUSE LLC
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -20,7 +20,7 @@
%global pkgver %{pkg_name}-%{version}
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.2.1.0
+Version: 0.2.2.0
Release: 0
Summary: Divide without division
License: BSD-3-Clause
@@ -30,8 +30,8 @@
BuildRequires: ghc-base-devel
BuildRequires: ghc-base-prof
BuildRequires: ghc-rpm-macros
-BuildRequires: ghc-template-haskell-devel
-BuildRequires: ghc-template-haskell-prof
+BuildRequires: ghc-template-haskell-lift-devel
+BuildRequires: ghc-template-haskell-lift-prof
ExcludeArch: %{ix86}
%if %{with tests}
BuildRequires: ghc-tasty-devel
++++++ quote-quot-0.2.1.0.tar.gz -> quote-quot-0.2.2.0.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/quote-quot-0.2.1.0/bench/Bench.hs
new/quote-quot-0.2.2.0/bench/Bench.hs
--- old/quote-quot-0.2.1.0/bench/Bench.hs 2001-09-09 03:46:40.000000000
+0200
+++ new/quote-quot-0.2.2.0/bench/Bench.hs 2001-09-09 03:46:40.000000000
+0200
@@ -6,6 +6,7 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
module Main (main) where
@@ -44,18 +45,33 @@
$ measureInt "quoteQuot" $$(quoteQuot (n :: Int)) \
]
+#define benchDivInt(n) \
+ bgroup (show (n :: Int)) \
+ [ measureInt "div" (`div` (n :: Int)) \
+ , bcompare ("$NF == \"div\" && $(NF-1) == \"" ++ show (n :: Int) ++ "\" &&
$(NF-2) == \"Int\"") \
+ $ measureInt "quoteDiv" $$(quoteDiv (n :: Int)) \
+ ]
+
main :: IO ()
main = defaultMain
[ bgroup "Word"
[ benchWord(3)
, benchWord(5)
, benchWord(7)
+ , benchWord(10000)
]
#if MIN_VERSION_base(4,15,0)
, bgroup "Int"
[ benchInt(3)
, benchInt(5)
, benchInt(7)
+ , benchInt(10000)
+ ]
+ , bgroup "DivInt"
+ [ benchDivInt(3)
+ , benchDivInt(5)
+ , benchDivInt(7)
+ , benchDivInt(10000)
]
#endif
]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/quote-quot-0.2.1.0/changelog.md
new/quote-quot-0.2.2.0/changelog.md
--- old/quote-quot-0.2.1.0/changelog.md 2001-09-09 03:46:40.000000000 +0200
+++ new/quote-quot-0.2.2.0/changelog.md 2001-09-09 03:46:40.000000000 +0200
@@ -1,3 +1,8 @@
+## 0.2.2.0
+
+* Add `quoteDiv`, `quoteMod` and `quoteDivMod`.
+* Define `instance MulHi {Int,Word}64` even on 32-bit arch.
+
## 0.2.1.0
* Add `quoteAST` and `assumeNonNegArg`.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/quote-quot-0.2.1.0/quote-quot.cabal
new/quote-quot-0.2.2.0/quote-quot.cabal
--- old/quote-quot-0.2.1.0/quote-quot.cabal 2001-09-09 03:46:40.000000000
+0200
+++ new/quote-quot-0.2.2.0/quote-quot.cabal 2001-09-09 03:46:40.000000000
+0200
@@ -1,12 +1,15 @@
-cabal-version: >=1.10
+cabal-version: 2.2
name: quote-quot
-version: 0.2.1.0
-license: BSD3
+version: 0.2.2.0
+license: BSD-3-Clause
license-file: LICENSE
copyright: 2020-2022 Andrew Lelechenko
maintainer: [email protected]
author: Andrew Lelechenko
-tested-with: ghc ==8.10.7, ghc ==9.0.2, ghc ==9.2.2
+tested-with:
+ ghc ==9.2.8 ghc ==9.4.8 ghc ==9.6.7 ghc ==9.8.4 ghc ==9.10.3
+ ghc ==9.12.2 ghc ==9.14.1
+
homepage: https://github.com/Bodigrim/quote-quot#readme
synopsis: Divide without division
description:
@@ -16,7 +19,7 @@
category: Math, Numerical
build-type: Simple
-extra-source-files:
+extra-doc-files:
changelog.md
README.md
@@ -30,8 +33,8 @@
default-language: Haskell2010
ghc-options: -Wall -Wcompat
build-depends:
- base < 5,
- template-haskell >=2.16
+ base >=4.18 && < 5,
+ template-haskell-lift >= 0.1 && < 0.2
test-suite quote-quot-tests
type: exitcode-stdio-1.0
@@ -43,19 +46,17 @@
base,
quote-quot,
tasty,
- tasty-quickcheck,
- -- wide-word >=0.1.1.2,
+ tasty-quickcheck
+ -- wide-word >=0.1.9,
-- 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
+ ghc-options: -Wall -O2 -Wcompat -fproc-alignment=64
build-depends:
base,
quote-quot,
- tasty-bench >= 0.3,
- template-haskell
+ tasty-bench >= 0.3.3
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/quote-quot-0.2.1.0/src/Numeric/QuoteQuot.hs
new/quote-quot-0.2.2.0/src/Numeric/QuoteQuot.hs
--- old/quote-quot-0.2.1.0/src/Numeric/QuoteQuot.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/quote-quot-0.2.2.0/src/Numeric/QuoteQuot.hs 2001-09-09
03:46:40.000000000 +0200
@@ -10,13 +10,17 @@
--
{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE LexicalNegation #-}
{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TemplateHaskellQuotes #-}
+{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnboxedTuples #-}
-
-{-# OPTIONS_GHC -Wno-missing-signatures #-}
+{- HLINT ignore "Redundant lambda" -}
module Numeric.QuoteQuot
(
@@ -24,6 +28,9 @@
quoteQuot
, quoteRem
, quoteQuotRem
+ , quoteDiv
+ , quoteMod
+ , quoteDivMod
-- * AST
, astQuot
, AST(..)
@@ -31,19 +38,17 @@
, quoteAST
, assumeNonNegArg
, MulHi(..)
+ , Unsigned
) where
-#include "MachDeps.h"
-
-import Prelude
-import Data.Bits
-import Data.Int
-import Data.Word
-import GHC.Exts
-import Language.Haskell.TH.Syntax
+import Data.Bits (shiftL, shiftR, isSigned, FiniteBits, countTrailingZeros,
finiteBitSize)
+import Data.Int (Int8, Int16, Int32, Int64)
+import Data.Word ( Word8, Word16, Word32, Word64 )
+import GHC.Exts (dataToTag#, Int(..), Word(..), timesInt2#, timesWord2#)
+import Language.Haskell.TH.Lift (Lift, Quote, Code)
--- | Quote integer division ('quot') by a compile-time known divisor,
--- which generates source code, employing arithmetic and bitwise operations
only.
+-- | 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 #-}
@@ -79,71 +84,108 @@
-- 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 :: forall a m. (MulHi a, Lift a, Quote m) => a -> Code m (a -> a)
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 :: (MulHi a, Lift a, Quote m) => a -> Code m (a -> a)
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 :: (MulHi a, Lift a, Quote m) => a -> Code m (a -> (a, a))
quoteQuotRem d = [|| \w -> let q = $$(quoteQuot d) w in (q, w - d * q) ||]
+-- | Similar to 'quoteQuot', but for 'div'.
+--
+-- @since 0.2.2.0
+quoteDiv :: forall a m. (MulHi a, Lift a, MulHi (Unsigned a), Lift (Unsigned
a), Quote m) => a -> Code m (a -> a)
+quoteDiv d
+ | isSigned d
+ = [|| \(i :: a') -> let w2i = fromIntegral :: Unsigned a' -> a' in
+ if i < 0
+ then w2i -(1 + $$go (fromIntegral -(i + 1)))
+ else w2i $ $$go (fromIntegral i) ||]
+ | otherwise = quoteQuot d
+ where
+ go :: Code m (Unsigned a -> Unsigned a)
+ go = quoteAST (unsignedQuot (fromIntegral d))
+
+-- | Similar to 'quoteQuot', but for 'mod'.
+--
+-- @since 0.2.2.0
+quoteMod :: (MulHi a, Lift a, MulHi (Unsigned a), Lift (Unsigned a), Quote m)
=> a -> Code m (a -> a)
+quoteMod d = [|| snd . $$(quoteDivMod d) ||]
+
+-- | Similar to 'quoteQuot', but for 'divMod'.
+--
+-- @since 0.2.2.0
+quoteDivMod :: (MulHi a, Lift a, MulHi (Unsigned a), Lift (Unsigned a), Quote
m) => a -> Code m (a -> (a, a))
+quoteDivMod d = [|| \w -> let q = $$(quoteDiv d) w in (q, w - d * q) ||]
+
+-- | Associate the corresponding unsigned type.
+--
+-- @since 0.2.2.0
+type family Unsigned t
+type instance Unsigned Int = Word
+type instance Unsigned Word = Word
+type instance Unsigned Int8 = Word8
+type instance Unsigned Word8 = Word8
+type instance Unsigned Int16 = Word16
+type instance Unsigned Word16 = Word16
+type instance Unsigned Int32 = Word32
+type instance Unsigned Word32 = Word32
+type instance Unsigned Int64 = Word64
+type instance Unsigned Word64 = Word64
+
-- | 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)
+ mulHi x y = fromIntegral ((widen x * widen y) `shiftR` 8)
+ where widen = fromIntegral :: Word8 -> Word16
instance MulHi Word16 where
- mulHi x y = fromIntegral ((fromIntegral x * fromIntegral y :: Word32)
`shiftR` 16)
+ mulHi x y = fromIntegral ((widen x * widen y) `shiftR` 16)
+ where widen = fromIntegral :: Word16 -> Word32
instance MulHi Word32 where
- mulHi x y = fromIntegral ((fromIntegral x * fromIntegral y :: Word64)
`shiftR` 32)
+ mulHi x y = fromIntegral ((widen x * widen y) `shiftR` 32)
+ where widen = fromIntegral :: Word32 -> Word64
-#if WORD_SIZE_IN_BITS == 64
+-- | This instance is not efficient on 32-bit architecture.
instance MulHi Word64 where
- mulHi x y = fromIntegral (fromIntegral x `mulHi` fromIntegral y :: Word)
-#endif
+ mulHi x y
+ | finiteBitSize (0 :: Word) == 64
+ = fromIntegral (fromIntegral x `mulHi` fromIntegral y :: Word)
+ | otherwise
+ = defaultMulHi x y
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)
+ mulHi x y = fromIntegral ((widen x * widen y) `shiftR` 8)
+ where widen = fromIntegral :: Int8 -> Int16
instance MulHi Int16 where
- mulHi x y = fromIntegral ((fromIntegral x * fromIntegral y :: Int32)
`shiftR` 16)
+ mulHi x y = fromIntegral ((widen x * widen y) `shiftR` 16)
+ where widen = fromIntegral :: Int16 -> Int32
instance MulHi Int32 where
- mulHi x y = fromIntegral ((fromIntegral x * fromIntegral y :: Int64)
`shiftR` 32)
+ mulHi x y = fromIntegral ((widen x * widen y) `shiftR` 32)
+ where widen = fromIntegral :: Int32 -> Int64
-#if MIN_VERSION_base(4,15,0)
-#if WORD_SIZE_IN_BITS == 64
+-- | This instance is not efficient on 32-bit architecture.
instance MulHi Int64 where
- mulHi x y = fromIntegral (fromIntegral x `mulHi` fromIntegral y :: Int)
-#endif
+ mulHi x y
+ | finiteBitSize (0 :: Int) == 64
+ = fromIntegral (fromIntegral x `mulHi` fromIntegral y :: Int)
+ | otherwise
+ = defaultMulHi x y
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.
@@ -191,7 +233,7 @@
where
go = \case
Arg -> n
- MulHi x k -> fromInteger $ (toInteger (go x) * toInteger k) `shiftR`
finiteBitSize k
+ MulHi x k -> defaultMulHi (go x) k
MulLo x k -> go x * k
Add x y -> go x + go y
Sub x y -> go x - go y
@@ -200,13 +242,17 @@
CmpGE x k -> if go x >= k then 1 else 0
CmpLT x k -> if go x < k then 1 else 0
+defaultMulHi :: (Integral a, FiniteBits a) => a -> a -> a
+defaultMulHi x y =
+ fromInteger $ (toInteger x * toInteger y) `shiftR` finiteBitSize x
+
+iprop :: Integral a => (a -> Bool) -> a -> a
+iprop p = \i -> fromIntegral (I# (dataToTag# (p i)))
+{-# INLINE iprop #-}
+
+
-- | 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 :: (MulHi a, Lift a, Quote m) => AST a -> Code m (a -> a)
quoteAST = \case
Arg -> [|| id ||]
Shr x k -> [|| (`shiftR` k) . $$(quoteAST x) ||]
@@ -215,8 +261,8 @@
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) ||]
+ CmpGE x k -> [|| iprop (>= k) . $$(quoteAST x) ||]
+ CmpLT x k -> [|| iprop (< k) . $$(quoteAST x) ||]
-- | 'astQuot' @d@ constructs an 'AST' representing
-- a function, equivalent to 'quot' @a@ for positive @a@,
@@ -255,16 +301,17 @@
= CmpGE Arg k'
-- Hacker's Delight, 10-8, Listing 1
| k >= 1 `shiftL` shft
- = shr (MulHi Arg magic) (shft + kZeros)
+ = shr (MulHi Arg magic) shft'
-- Hacker's Delight, 10-8, Listing 3
| otherwise
- = shr (Add (shr (Sub Arg (MulHi Arg magic)) 1) (MulHi Arg magic)) (shft - 1
+ kZeros)
+ = shr (Add (shr (Sub Arg (MulHi Arg magic)) 1) (MulHi Arg magic)) (shft' - 1)
where
fbs = finiteBitSize k'
kZeros = countTrailingZeros k'
k = k' `shiftR` kZeros
r0 = fromInteger ((1 `shiftL` fbs) `rem` toInteger k)
shft = go r0 0
+ shft' = shft + kZeros
magic = fromInteger ((1 `shiftL` (fbs + shft)) `quot` toInteger k + 1)
go r s
@@ -286,16 +333,17 @@
= 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)
+ = Add (shr (MulHi Arg magic) shft') (CmpLT Arg 0)
-- Hacker's Delight, 10-3, Listing 3
| otherwise
- = Add (shr (Add Arg (MulHi Arg magic)) (shft + kZeros)) (CmpLT Arg 0)
+ = Add (shr (Add Arg (MulHi Arg magic)) shft') (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
+ shft' = shft + kZeros
magic = fromInteger ((1 `shiftL` (fbs + shft)) `quot` toInteger k + 1)
go r s
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/quote-quot-0.2.1.0/tests/Test.hs
new/quote-quot-0.2.2.0/tests/Test.hs
--- old/quote-quot-0.2.1.0/tests/Test.hs 2001-09-09 03:46:40.000000000
+0200
+++ new/quote-quot-0.2.2.0/tests/Test.hs 2001-09-09 03:46:40.000000000
+0200
@@ -19,7 +19,6 @@
import Numeric.QuoteQuot
import Test.Tasty
import Test.Tasty.QuickCheck
-import Text.Printf
#ifdef MIN_VERSION_word24
import Data.Int.Int24
@@ -31,7 +30,7 @@
#endif
main :: IO ()
-main = defaultMain $ testGroup "All" [testAst, testQuotes]
+main = defaultMain $ testGroup "All" [testAst, testQuotes, testDivs, testMulHi]
testAst :: TestTree
testAst = testGroup "Ast"
@@ -53,6 +52,7 @@
, testGroup "Word128" (mkTests (Proxy @Word128))
, testGroup "Word256" (mkTests (Proxy @Word256))
, testGroup "Int128" (mkTests (Proxy @Int128))
+ , testGroup "Int256" (mkTests (Proxy @Int256))
#endif
]
@@ -77,24 +77,22 @@
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)
+prop x (Positive y) =
+ (q === qref) .&&. (d === dref)
where
- ref = x `quot` y
- ast = astQuot y
- q = interpretAST ast x
+ qref = x `quot` y
+ dref = x `div` y
+ qast = astQuot y
+ dast = assumeNonNegArg (astQuot y)
+ q = interpretAST qast x
+ d | x < 0 = -(interpretAST dast (-(x + 1)) + 1)
+ | otherwise = q
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)
+propNonNeg (NonNegative x) (Positive y) =
+ q === ref
where
ref = x `quot` y
ast = assumeNonNegArg $ astQuot y
@@ -109,6 +107,7 @@
instance Arbitrary Word128 where arbitrary = arbitrarySizedBoundedIntegral
instance Arbitrary Word256 where arbitrary = arbitrarySizedBoundedIntegral
instance Arbitrary Int128 where arbitrary = arbitrarySizedBoundedIntegral
+instance Arbitrary Int256 where arbitrary = arbitrarySizedBoundedIntegral
#endif
#define testQuotes(ty) \
@@ -124,25 +123,88 @@
, 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) \
- ] \
+ ]
+
+#define testDivs(ty) \
+ [ testProperty "1" $ \x -> $$(quoteDivMod (1 :: ty)) x === x `divMod` 1
\
+ , testProperty "2" $ \x -> $$(quoteDivMod (2 :: ty)) x === x `divMod` 2
\
+ , testProperty "3" $ \x -> $$(quoteDivMod (3 :: ty)) x === x `divMod` 3
\
+ , testProperty "4" $ \x -> $$(quoteDivMod (4 :: ty)) x === x `divMod` 4
\
+ , testProperty "5" $ \x -> $$(quoteDivMod (5 :: ty)) x === x `divMod` 5
\
+ , testProperty "6" $ \x -> $$(quoteDivMod (6 :: ty)) x === x `divMod` 6
\
+ , testProperty "7" $ \x -> $$(quoteDivMod (7 :: ty)) x === x `divMod` 7
\
+ , testProperty "8" $ \x -> $$(quoteDivMod (8 :: ty)) x === x `divMod` 8
\
+ , testProperty "9" $ \x -> $$(quoteDivMod (9 :: ty)) x === x `divMod` 9
\
+ , testProperty "10" $ \x -> $$(quoteDivMod (10 :: ty)) x === x `divMod` 10
\
+ , testProperty "maxBound" $ \x -> $$(quoteDivMod (maxBound :: ty)) x === x
`divMod` maxBound \
+ , testProperty "maxBound - 1" $ \x -> $$(quoteDivMod (maxBound - 1 :: ty))
x === x `divMod` (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
]
+
+testDivs :: TestTree
+testDivs = testGroup "Divs"
+ [ testGroup "Word8" testDivs(Word8)
+ , testGroup "Word16" testDivs(Word16)
+ , testGroup "Word32" testDivs(Word32)
+ , testGroup "Word64" testDivs(Word64)
+ , testGroup "Word" testDivs(Word)
+ , testGroup "Int8" testDivs(Int8)
+ , testGroup "Int16" testDivs(Int16)
+ , testGroup "Int32" testDivs(Int32)
+ , testGroup "Int64" testDivs(Int64)
+ , testGroup "Int" testDivs(Int)
+ ]
+
+testMulHi :: TestTree
+testMulHi = testGroup "MulHi"
+ [ testGroup "Word" (mkTestsMulHi (Proxy @Word))
+ , testGroup "Word8" (mkTestsMulHi (Proxy @Word8))
+ , testGroup "Word16" (mkTestsMulHi (Proxy @Word16))
+ , testGroup "Word32" (mkTestsMulHi (Proxy @Word32))
+ , testGroup "Word64" (mkTestsMulHi (Proxy @Word64))
+ , testGroup "Int" (mkTestsMulHi (Proxy @Int))
+ , testGroup "Int8" (mkTestsMulHi (Proxy @Int8))
+ , testGroup "Int16" (mkTestsMulHi (Proxy @Int16))
+ , testGroup "Int32" (mkTestsMulHi (Proxy @Int32))
+ , testGroup "Int64" (mkTestsMulHi (Proxy @Int64))
+ ]
+
+mkTestsMulHi
+ :: forall a.
+ (MulHi a, Show a, Bounded a, Arbitrary a)
+ => Proxy a -> [TestTree]
+mkTestsMulHi _ = [ combineMods mod1 mod2 | mod1 <- mods, mod2 <- mods]
+ where
+ mods :: [(String, a -> Bool, a -> a)]
+ mods
+ | isSigned (undefined :: a) =
+ [ ("above zero", (>= 0), id)
+ , ("below zero", (>= 0), negate)
+ , ("above minBound", (>= 0), (minBound +))
+ , ("below maxBound", (>= 0), (maxBound -))
+ ]
+ | otherwise =
+ [ ("above zero", const True, id)
+ , ("below maxBound", const True, (maxBound -))
+ ]
+
+ combineMods (name1, pred1, tr1) (name2, pred2, tr2) =
+ testProperty (name1 ++ ", " ++ name2) $
+ \x y -> pred1 x && pred2 y ==> propMulHi (tr1 x) (tr2 y)
+
+propMulHi :: (MulHi a, Show a) => a -> a -> Property
+propMulHi x y = mulHi x y ===
+ fromInteger ((toInteger x * toInteger y) `shiftR` finiteBitSize x)
