Turn divInt# and modInt# into bitwise operations when possible

This implements #5615 for divInt# and modInt#.

I also included rules to do constant-folding when the both arguments
are known.

Test Plan: validate

Reviewers: austin, simonmar, bgamari

Reviewed By: bgamari

Subscribers: hvr, thomie

Differential Revision: https://phabricator.haskell.org/D2486

GHC Trac Issues: #5615

5 files changed, 62 insertions, 24 deletions

diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs
index de3061d7d4..8d1641a7d4 100644
--- a/compiler/cmm/CmmOpt.hs
+++ b/compiler/cmm/CmmOpt.hs
@@ -26,6 +26,7 @@ module CmmOpt (
 import CmmUtils
 import Cmm
 import DynFlags
+import Util
 
 import Outputable
 import Platform
@@ -376,26 +377,6 @@ cmmMachOpFoldM dflags mop [x, (CmmLit (CmmInt n _))]
 cmmMachOpFoldM _ _ _ = Nothing
 
 -- -----------------------------------------------------------------------------
--- exactLog2
-
--- This algorithm for determining the $\log_2$ of exact powers of 2 comes
--- from GCC.  It requires bit manipulation primitives, and we use GHC
--- extensions.  Tough.
-
-exactLog2 :: Integer -> Maybe Integer
-exactLog2 x
-  = if (x <= 0 || x >= 2147483648) then
-       Nothing
-    else
-       if (x .&. (-x)) /= x then
-          Nothing
-       else
-          Just (pow2 x)
-  where
-    pow2 x | x == 1 = 0
-           | otherwise = 1 + pow2 (x `shiftR` 1)
-
--- -----------------------------------------------------------------------------
 -- Utils
 
 isLit :: CmmExpr -> Bool
diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs
index 00e9ffed96..558619a9db 100644
--- a/compiler/prelude/PrelNames.hs
+++ b/compiler/prelude/PrelNames.hs
@@ -232,6 +232,9 @@ basicKnownKeyNames
         toIntegerName, toRationalName,
         fromIntegralName, realToFracName,
 
+        -- Int# stuff
+        divIntName, modIntName,
+
         -- String stuff
         fromStringName,
 
@@ -912,6 +915,11 @@ metaDataDataConName  = dcQual gHC_GENERICS (fsLit "MetaData")  metaDataDataConKe
 metaConsDataConName  = dcQual gHC_GENERICS (fsLit "MetaCons")  metaConsDataConKey
 metaSelDataConName   = dcQual gHC_GENERICS (fsLit "MetaSel")   metaSelDataConKey
 
+-- Primitive Int
+divIntName, modIntName :: Name
+divIntName = varQual gHC_CLASSES (fsLit "divInt#") divIntIdKey
+modIntName = varQual gHC_CLASSES (fsLit "modInt#") modIntIdKey
+
 -- Base strings Strings
 unpackCStringName, unpackCStringFoldrName,
     unpackCStringUtf8Name, eqStringName :: Name
@@ -1909,7 +1917,7 @@ wildCardKey, absentErrorIdKey, augmentIdKey, appendIdKey,
     realWorldPrimIdKey, recConErrorIdKey,
     unpackCStringUtf8IdKey, unpackCStringAppendIdKey,
     unpackCStringFoldrIdKey, unpackCStringIdKey,
-    typeErrorIdKey :: Unique
+    typeErrorIdKey, divIntIdKey, modIntIdKey :: Unique
 
 wildCardKey                   = mkPreludeMiscIdUnique  0  -- See Note [WildCard binders]
 absentErrorIdKey              = mkPreludeMiscIdUnique  1
@@ -1934,6 +1942,8 @@ unpackCStringFoldrIdKey       = mkPreludeMiscIdUnique 19
 unpackCStringIdKey            = mkPreludeMiscIdUnique 20
 voidPrimIdKey                 = mkPreludeMiscIdUnique 21
 typeErrorIdKey                = mkPreludeMiscIdUnique 22
+divIntIdKey                   = mkPreludeMiscIdUnique 23
+modIntIdKey                   = mkPreludeMiscIdUnique 24
 
 unsafeCoerceIdKey, concatIdKey, filterIdKey, zipIdKey, bindIOIdKey,
     returnIOIdKey, newStablePtrIdKey,
diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs
index a57609a89d..8868047005 100644
--- a/compiler/prelude/PrelRules.hs
+++ b/compiler/prelude/PrelRules.hs
@@ -988,7 +988,26 @@ builtinRules
      BuiltinRule { ru_name = fsLit "Inline", ru_fn = inlineIdName,
                    ru_nargs = 2, ru_try = \_ _ _ -> match_inline },
      BuiltinRule { ru_name = fsLit "MagicDict", ru_fn = idName magicDictId,
-                   ru_nargs = 4, ru_try = \_ _ _ -> match_magicDict }
+                   ru_nargs = 4, ru_try = \_ _ _ -> match_magicDict },
+     mkBasicRule divIntName 2 $ msum
+        [ nonZeroLit 1 >> binaryLit (intOp2 div)
+        , leftZero zeroi
+        , do
+          [arg, Lit (MachInt d)] <- getArgs
+          Just n <- return $ exactLog2 d
+          dflags <- getDynFlags
+          return $ Var (mkPrimOpId ISraOp) `App` arg `App` mkIntVal dflags n
+        ],
+     mkBasicRule modIntName 2 $ msum
+        [ nonZeroLit 1 >> binaryLit (intOp2 mod)
+        , leftZero zeroi
+        , do
+          [arg, Lit (MachInt d)] <- getArgs
+          Just _ <- return $ exactLog2 d
+          dflags <- getDynFlags
+          return $ Var (mkPrimOpId AndIOp)
+            `App` arg `App` mkIntVal dflags (d - 1)
+        ]
      ]
  ++ builtinIntegerRules
 
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index e948610556..a38dd57755 100644
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -221,12 +221,16 @@ primop   IntMulMayOfloOp  "mulIntMayOflo#"
 
 primop   IntQuotOp    "quotInt#"    Dyadic
    Int# -> Int# -> Int#
-   {Rounds towards zero.}
+   {Rounds towards zero. The behavior is undefined if the second argument is
+    zero.
+   }
    with can_fail = True
 
 primop   IntRemOp    "remInt#"    Dyadic
    Int# -> Int# -> Int#
-   {Satisfies \texttt{(quotInt\# x y) *\# y +\# (remInt\# x y) == x}.}
+   {Satisfies \texttt{(quotInt\# x y) *\# y +\# (remInt\# x y) == x}. The
+    behavior is undefined if the second argument is zero.
+   }
    with can_fail = True
 
 primop   IntQuotRemOp "quotRemInt#"    GenPrimOp
diff --git a/compiler/utils/Util.hs b/compiler/utils/Util.hs
index 121fdbbf6f..0b16fba72d 100644
--- a/compiler/utils/Util.hs
+++ b/compiler/utils/Util.hs
@@ -78,6 +78,9 @@ module Util (
         -- * Argument processing
         getCmd, toCmdArgs, toArgs,
 
+        -- * Integers
+        exactLog2,
+
         -- * Floating point
         readRational,
 
@@ -985,6 +988,27 @@ toArgs str
                     Right (arg, rest)
                 _ ->
                     Left ("Couldn't read " ++ show s ++ " as String")
+-----------------------------------------------------------------------------
+-- Integers
+
+-- This algorithm for determining the $\log_2$ of exact powers of 2 comes
+-- from GCC.  It requires bit manipulation primitives, and we use GHC
+-- extensions.  Tough.
+
+exactLog2 :: Integer -> Maybe Integer
+exactLog2 x
+  = if (x <= 0 || x >= 2147483648) then
+       Nothing
+    else
+       if (x .&. (-x)) /= x then
+          Nothing
+       else
+          Just (pow2 x)
+  where
+    pow2 x | x == 1 = 0
+           | otherwise = 1 + pow2 (x `shiftR` 1)
+
+
 {-
 -- -----------------------------------------------------------------------------
 -- Floats