quot
rounds towards zero, div
rounds towards negative infinity:
div (-3) 2 == (-2)
quot (-3) 2 == (-1)
As to the overhead of div
, quot
has a corresponding primitive GHC operation, while div
does some extra work:
quotRemInt :: Int -> Int -> (Int, Int)
(I# x) `quotRemInt` (I# y) = case x `quotRemInt#` y of
(# q, r #) ->
(I# q, I# r)
divModInt# :: Int# -> Int# -> (# Int#, Int# #)
x# `divModInt#` y#
| (x# ># 0#) && (y# <# 0#) = case (x# -# 1#) `quotRemInt#` y# of
(# q, r #) -> (# q -# 1#, r +# y# +# 1# #)
| (x# <# 0#) && (y# ># 0#) = case (x# +# 1#) `quotRemInt#` y# of
(# q, r #) -> (# q -# 1#, r +# y# -# 1# #)
| otherwise = x# `quotRemInt#` y#
In their final forms, both functions have some error handling checks on them:
a `quot` b
| b == 0 = divZeroError
| b == (-1) && a == minBound = overflowError -- Note [Order of tests]
-- in GHC.Int
| otherwise = a `quotInt` b
a `div` b
| b == 0 = divZeroError
| b == (-1) && a == minBound = overflowError -- Note [Order of tests]
-- in GHC.Int
| otherwise = a `divInt` b
I also did a very small bit of microbenchmarking, but it should be taken with a hefty amount of salt, because GHC and LLVM optimize tight numeric code away like there's no tomorrow. I tried to thwart them, and the results seem to be realistic: 14,67 ms for div
and 13,37 ms for quot
. Also, it's GHC 7.8.2 with -O2 and -fllvm. Here's the code:
{-# LANGUAGE BangPatterns #-}
import Criterion.Main
import System.Random
benchOp :: (Int -> Int) -> Int -> ()
benchOp f = go 0 0 where
go !i !acc !limit | i < limit = go (i + 1) (f i) limit
| otherwise = ()
main = do
limit1 <- randomRIO (1000000, 1000000 :: Int)
limit2 <- randomRIO (1000000, 1000000 :: Int)
n <- randomRIO (100, 100 :: Int)
defaultMain [
bench "div" $ whnf (benchOp (`div` n)) limit1,
bench "quot" $ whnf (benchOp (`quot` n)) limit2]