quote-quot (empty) → 0.1.0.0

raw patch · 7 files changed

+540/−0 lines, 7 filesdep +basedep +quote-quotdep +tasty

Dependencies added: base, quote-quot, tasty, tasty-quickcheck, template-haskell

Files

• LICENSE +30/−0
• README.md +79/−0
• bench/Bench.hs +25/−0
• changelog.md +3/−0
• quote-quot.cabal +60/−0
• src/Numeric/QuoteQuot.hs +230/−0
• tests/Test.hs +113/−0

@@ -0,0 +1,30 @@+Copyright Andrew Lelechenko (c) 2020++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.

@@ -0,0 +1,79 @@+# 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) [![Hackage CI](https://matrix.hackage.haskell.org/api/v2/packages/quote-quot/badge)](https://matrix.hackage.haskell.org/package/quote-quot) [![GitHub Actions](https://github.com/Bodigrim/quote-quot/workflows/ci/badge.svg)](https://github.com/Bodigrim/quote-quot/actions?query=workflow%3Aci)++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+```++Common 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).

@@ -0,0 +1,25 @@+-- |+-- Copyright:   (c) 2020 Andrew Lelechenko+-- Licence:     BSD3+--++{-# LANGUAGE TemplateHaskell #-}++module Main (main) where++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)

@@ -0,0 +1,3 @@+## 0.1.0.0++* Initial release.

@@ -0,0 +1,60 @@+cabal-version:      >=1.10+name:               quote-quot+version:            0.1.0.0+license:            BSD3+license-file:       LICENSE+copyright:          2020 Andrew Lelechenko+maintainer:         andrew.lelechenko@gmail.com+author:             Andrew Lelechenko+tested-with:        ghc ==8.10.3+homepage:           https://github.com/Bodigrim/divide#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+  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+  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+  build-depends:+    base,+    quote-quot,+    template-haskell

@@ -0,0 +1,230 @@+-- |+-- Module:      Numeric.QuoteQuot+-- Copyright:   (c) 2020 Andrew Lelechenko+-- Licence:     BSD3+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>+--+-- 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 LambdaCase #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE UnboxedTuples #-}++module Numeric.QuoteQuot+  (+  -- * Quasiquoters+    quoteQuot+  , quoteRem+  , quoteQuotRem+  -- * AST+  , astQuot+  , AST(..)+  , interpretAST+  ) where++import Prelude+import Data.Bits+import GHC.Exts+import Language.Haskell.TH++-- | 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)@.+--+-- Note that even while 'astQuot' is polymorphic,+-- 'quoteQuot' is provided for 'Word' arguments only,+-- because other types lack a fast branchless routine for 'MulHi'.+-- For 'Word' such primitive is provided by 'timesWord2#'.+--+quoteQuot :: Word -> Q (TExp (Word -> Word))+quoteQuot d = go (astQuot d)+  where+    go :: AST Word -> Q (TExp (Word -> Word))+    go = \case+      Arg            -> [|| id ||]+      Shr x k        -> [|| (`shiftR` k) . $$(go x) ||]+      Shl x k        -> [|| (`shiftL` k) . $$(go x) ||]+      MulHi x (W# k) -> [|| (\(W# w) -> let !(# hi, _ #) = timesWord2# w k in W# hi) . $$(go x) ||]+      MulLo x k      -> [|| (* k) . $$(go x) ||]+      Add x y        -> [|| \w -> $$(go x) w + $$(go y) w ||]+      Sub x y        -> [|| \w -> $$(go x) w - $$(go y) w ||]+      CmpGE x (W# k) -> [|| (\(W# w) -> W# (int2Word# (w `geWord#` k))) . $$(go x) ||]+      CmpLT x (W# k) -> [|| (\(W# w) -> W# (int2Word# (w `ltWord#` k))) . $$(go x) ||]++-- | Similar to 'quoteQuot', but for 'rem'.+quoteRem :: Word -> Q (TExp (Word -> Word))+quoteRem d = [|| snd . $$(quoteQuotRem d) ||]++-- | Similar to 'quoteQuot', but for 'quotRem'.+quoteQuotRem :: Word -> Q (TExp (Word -> (Word, Word)))+quoteQuotRem d = [|| \w -> let q = $$(quoteQuot d) w in (q, w - d * q) ||]++-- | 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)++-- | 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++-- | '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

@@ -0,0 +1,113 @@+-- |+-- Copyright:   (c) 2020 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 "below zero" (prop @a . negate . getNonNegative)+  , testProperty "above minBound" (prop @a . (minBound +) . getNonNegative)+  , testProperty "below maxBound" (prop @a . (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++#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++testQuotes :: TestTree+testQuotes = testGroup "Quotes"+  [ testProperty  "1" $ \x -> $$(quoteQuotRem  1) x === x `quotRem`  1+  , testProperty  "2" $ \x -> $$(quoteQuotRem  2) x === x `quotRem`  2+  , testProperty  "3" $ \x -> $$(quoteQuotRem  3) x === x `quotRem`  3+  , testProperty  "4" $ \x -> $$(quoteQuotRem  4) x === x `quotRem`  4+  , testProperty  "5" $ \x -> $$(quoteQuotRem  5) x === x `quotRem`  5+  , testProperty  "6" $ \x -> $$(quoteQuotRem  6) x === x `quotRem`  6+  , testProperty  "7" $ \x -> $$(quoteQuotRem  7) x === x `quotRem`  7+  , testProperty  "8" $ \x -> $$(quoteQuotRem  8) x === x `quotRem`  8+  , testProperty  "9" $ \x -> $$(quoteQuotRem  9) x === x `quotRem`  9+  , testProperty "10" $ \x -> $$(quoteQuotRem 10) x === x `quotRem` 10+  , testProperty "maxBound" $ \x -> $$(quoteQuotRem maxBound) x === x `quotRem` maxBound+  , testProperty "maxBound - 1" $ \x -> $$(quoteQuotRem (maxBound - 1)) x === x `quotRem` (maxBound - 1)+  ]