quote-quot 0.1.0.0 → 0.2.0.0

raw patch · 6 files changed

+142/−43 lines, 6 filesdep +tasty-benchdep ~template-haskellPVP ok

version bump matches the API change (PVP)

Dependencies added: tasty-bench

Dependency ranges changed: template-haskell

API changes (from Hackage documentation)

Files

• README.md +2/−2
• bench/Bench.hs +46/−12
• changelog.md +6/−0
• quote-quot.cabal +5/−4
• src/Numeric/QuoteQuot.hs +51/−13
• tests/Test.hs +32/−12

@@ -1,4 +1,4 @@-# 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)+# 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__@@ -72,7 +72,7 @@ $$(quoteQuot 10)  89 ms ``` -Common wisdom is that such microoptimizations are negligible in practice,+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)

@@ -3,23 +3,57 @@ -- Licence:     BSD3 -- +{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-} {-# LANGUAGE TemplateHaskell #-}  module Main (main) where -import Data.List+import GHC.Exts import Numeric.QuoteQuot-import System.CPUTime+import Test.Tasty.Bench -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 #-}+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)) \+    , measureWord "quoteQuot" $$(quoteQuot (n :: Word)) \+    ]++#define benchInt(n) \+  bgroup (show (n :: Int)) \+    [ measureInt "quot" (`quot` (n :: Int)) \+    , measureInt "quoteQuot" $$(quoteQuot (n :: Int)) \+    ]+ main :: IO ()-main = do-  measure "     (`quot` 10)"      (`quot` 10)-  measure "$$(quoteQuot 10)" $$(quoteQuot 10)+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+  ]

@@ -1,3 +1,9 @@+## 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.

@@ -1,13 +1,13 @@ cabal-version:      >=1.10 name:               quote-quot-version:            0.1.0.0+version:            0.2.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+tested-with:        ghc ==8.10.3, ghc ==9.0.1+homepage:           https://github.com/Bodigrim/quote-quot#readme synopsis:           Divide without division description:   Generate routines for integer division, employing arithmetic@@ -53,8 +53,9 @@   main-is:          Bench.hs   hs-source-dirs:   bench   default-language: Haskell2010-  ghc-options:      -Wall+  ghc-options:      -Wall -O2   build-depends:     base,     quote-quot,+    tasty-bench,     template-haskell

@@ -10,11 +10,14 @@ --  {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE UnboxedTuples #-} +{-# OPTIONS_GHC -Wno-missing-signatures #-}+ module Numeric.QuoteQuot   (   -- * Quasiquoters@@ -25,12 +28,16 @@   , astQuot   , AST(..)   , interpretAST+  , MulHi(..)   ) where +#include "MachDeps.h"+ import Prelude import Data.Bits+import Data.Int+import Data.Word 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.@@ -69,33 +76,64 @@ -- 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) ||]+      MulHi x k      -> [|| (`mulHi` k) . $$(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) ||]+      CmpGE x k      -> [|| (\w -> fromIntegral (I# (dataToTag# (w >= k)))) . $$(go x) ||]+      CmpLT x k      -> [|| (\w -> fromIntegral (I# (dataToTag# (w <  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) ||]++-- | 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.

@@ -96,18 +96,38 @@ 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"-  [ 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)+  [ 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   ]