quote-quot 0.2.1.0 → 0.2.2.0

raw patch · 5 files changed

+227/−95 lines, 5 filesdep +template-haskell-liftdep −template-haskelldep ~basedep ~tasty-benchPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: template-haskell-lift

Dependencies removed: template-haskell

Dependency ranges changed: base, tasty-bench

API changes (from Hackage documentation)

Files

• bench/Bench.hs +16/−0
• changelog.md +5/−0
• quote-quot.cabal +14/−13
• src/Numeric/QuoteQuot.hs +107/−59
• tests/Test.hs +85/−23

@@ -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   ]

@@ -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`.

@@ -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:         andrew.lelechenko@gmail.com 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

@@ -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

@@ -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)