quote-quot: Divide without division

[ bsd3, library, math, numerical ] [ Propose Tags ]

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.


[Skip to Readme]

Downloads

Maintainer's Corner

Package maintainers

For package maintainers and hackage trustees

Candidates

  • No Candidates
Versions [RSS] 0.1.0.0, 0.2.0.0, 0.2.1.0
Change log changelog.md
Dependencies base (<5), template-haskell (>=2.16) [details]
License BSD-3-Clause
Copyright 2020-2022 Andrew Lelechenko
Author Andrew Lelechenko
Maintainer andrew.lelechenko@gmail.com
Category Math, Numerical
Home page https://github.com/Bodigrim/quote-quot#readme
Source repo head: git clone https://github.com/Bodigrim/quote-quot
Uploaded by Bodigrim at 2022-04-11T18:57:22Z
Distributions LTSHaskell:0.2.1.0, NixOS:0.2.1.0, Stackage:0.2.1.0, openSUSE:0.2.1.0
Reverse Dependencies 1 direct, 12 indirect [details]
Downloads 777 total (51 in the last 30 days)
Rating (no votes yet) [estimated by Bayesian average]
Your Rating
  • λ
  • λ
  • λ
Status Docs available [build log]
Last success reported on 2022-04-11 [all 1 reports]

Readme for quote-quot-0.2.1.0

[back to package description]

quote-quot Hackage Stackage LTS Stackage Nightly

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 TemplateHaskell #-}
{-# OPTIONS_GHC -ddump-splices -ddump-simpl -dsuppress-all #-}
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):

{-# 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 in unicode-transforms.