quote-quot 0.2.0.0 → 0.2.1.0

raw patch · 6 files changed

+85/−25 lines, 6 filesdep ~tasty-benchPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: tasty-bench

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• bench/Bench.hs +5/−3
• changelog.md +4/−0
• quote-quot.cabal +7/−7
• src/Numeric/QuoteQuot.hs +52/−13
• tests/Test.hs +16/−1

@@ -1,4 +1,4 @@-Copyright Andrew Lelechenko (c) 2020+Copyright Andrew Lelechenko (c) 2020-2022  All rights reserved. 

@@ -1,5 +1,5 @@ -- |--- Copyright:   (c) 2020 Andrew Lelechenko+-- Copyright:   (c) 2020-2022 Andrew Lelechenko -- Licence:     BSD3 -- @@ -33,13 +33,15 @@ #define benchWord(n) \   bgroup (show (n :: Word)) \     [ measureWord "quot" (`quot` (n :: Word)) \-    , measureWord "quoteQuot" $$(quoteQuot (n :: Word)) \+    , bcompare ("$NF == \"quot\" && $(NF-1) == \"" ++ show (n :: Word) ++ "\" && $(NF-2) == \"Word\"") \+    $ measureWord "quoteQuot" $$(quoteQuot (n :: Word)) \     ]  #define benchInt(n) \   bgroup (show (n :: Int)) \     [ measureInt "quot" (`quot` (n :: Int)) \-    , measureInt "quoteQuot" $$(quoteQuot (n :: Int)) \+    , bcompare ("$NF == \"quot\" && $(NF-1) == \"" ++ show (n :: Int) ++ "\" && $(NF-2) == \"Int\"") \+    $ measureInt "quoteQuot" $$(quoteQuot (n :: Int)) \     ]  main :: IO ()

@@ -1,3 +1,7 @@+## 0.2.1.0++* Add `quoteAST` and `assumeNonNegArg`.+ ## 0.2.0.0  * Make `quoteQuot` polymorphic.

@@ -1,12 +1,12 @@ cabal-version:      >=1.10 name:               quote-quot-version:            0.2.0.0+version:            0.2.1.0 license:            BSD3 license-file:       LICENSE-copyright:          2020 Andrew Lelechenko+copyright:          2020-2022 Andrew Lelechenko maintainer:         andrew.lelechenko@gmail.com author:             Andrew Lelechenko-tested-with:        ghc ==8.10.3, ghc ==9.0.1+tested-with:        ghc ==8.10.7, ghc ==9.0.2, ghc ==9.2.2 homepage:           https://github.com/Bodigrim/quote-quot#readme synopsis:           Divide without division description:@@ -28,7 +28,7 @@   exposed-modules:  Numeric.QuoteQuot   hs-source-dirs:   src   default-language: Haskell2010-  ghc-options:      -Wall+  ghc-options:      -Wall -Wcompat   build-depends:     base < 5,     template-haskell >=2.16@@ -38,7 +38,7 @@   main-is:          Test.hs   hs-source-dirs:   tests   default-language: Haskell2010-  ghc-options:      -Wall -threaded -rtsopts+  ghc-options:      -Wall -threaded -rtsopts -Wcompat   build-depends:     base,     quote-quot,@@ -53,9 +53,9 @@   main-is:          Bench.hs   hs-source-dirs:   bench   default-language: Haskell2010-  ghc-options:      -Wall -O2+  ghc-options:      -Wall -O2 -Wcompat   build-depends:     base,     quote-quot,-    tasty-bench,+    tasty-bench >= 0.3,     template-haskell

@@ -1,6 +1,6 @@ -- | -- Module:      Numeric.QuoteQuot--- Copyright:   (c) 2020 Andrew Lelechenko+-- Copyright:   (c) 2020-2022 Andrew Lelechenko -- Licence:     BSD3 -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com> --@@ -28,6 +28,8 @@   , astQuot   , AST(..)   , interpretAST+  , quoteAST+  , assumeNonNegArg   , MulHi(..)   ) where @@ -38,6 +40,7 @@ import Data.Int import Data.Word import GHC.Exts+import Language.Haskell.TH.Syntax  -- | Quote integer division ('quot') by a compile-time known divisor, -- which generates source code, employing arithmetic and bitwise operations only.@@ -76,23 +79,30 @@ -- Benchmarks show that this implementation is __3.5x faster__ -- than @(`@'quot'@` 10)@. ---quoteQuot d = go (astQuot d)-  where-    go = \case-      Arg            -> [|| id ||]-      Shr x k        -> [|| (`shiftR` k) . $$(go x) ||]-      Shl x k        -> [|| (`shiftL` k) . $$(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 k      -> [|| (\w -> fromIntegral (I# (dataToTag# (w >= k)))) . $$(go x) ||]-      CmpLT x k      -> [|| (\w -> fromIntegral (I# (dataToTag# (w <  k)))) . $$(go x) ||]+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 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 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 d = [|| \w -> let q = $$(quoteQuot d) w in (q, w - d * q) ||]  -- | Types allowing to multiply wide and return the high word of result.@@ -158,6 +168,17 @@   -- ^ 1 if less than, 0 otherwise   deriving (Show) +-- | Optimize 'AST', assuming that 'Arg' is non-negative.+assumeNonNegArg :: (Ord a, Num a) => AST a -> AST a+assumeNonNegArg = \case+  Add x (CmpLT Arg n)+    | n <= 0 -> x+  Sub x (CmpLT Arg n)+    | n <= 0 -> x+  Add x (MulLo (CmpLT Arg n) _)+    | n <= 0 -> x+  e -> e+ -- | Reference (but slow) interpreter of 'AST'. -- It is not meant to be used in production -- and is provided primarily for testing purposes.@@ -178,6 +199,24 @@       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++-- | 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 = \case+  Arg            -> [|| id ||]+  Shr x k        -> [|| (`shiftR` k) . $$(quoteAST x) ||]+  Shl x k        -> [|| (`shiftL` k) . $$(quoteAST x) ||]+  MulHi x k      -> [|| (`mulHi` k) . $$(quoteAST x) ||]+  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) ||]  -- | 'astQuot' @d@ constructs an 'AST' representing -- a function, equivalent to 'quot' @a@ for positive @a@,

@@ -1,5 +1,5 @@ -- |--- Copyright:   (c) 2020 Andrew Lelechenko+-- Copyright:   (c) 2020-2022 Andrew Lelechenko -- Licence:     BSD3 -- @@ -63,9 +63,11 @@ mkTests _   | isSigned (undefined :: a) =   [ testProperty "above zero" (prop @a . getNonNegative)+  , testProperty "above zero assumeNonNegArg" (propNonNeg @a)   , testProperty "below zero" (prop @a . negate . getNonNegative)   , testProperty "above minBound" (prop @a . (minBound +) . getNonNegative)   , testProperty "below maxBound" (prop @a . (maxBound -) . getNonNegative)+  , testProperty "below maxBound assumeNonNegArg" (propNonNeg @a . NonNegative . (maxBound -) . getNonNegative)   ]   | otherwise =   [ testProperty "above zero" (prop @a)@@ -83,6 +85,19 @@   where     ref = x `quot` y     ast = astQuot y+    q   = interpretAST ast x++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)+  where+    ref = x `quot` y+    ast = assumeNonNegArg $ astQuot y     q   = interpretAST ast x  #ifdef MIN_VERSION_word24