Add prelude rules for quotInteger, remInteger

2 files changed, 44 insertions, 23 deletions

diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index a88e536eb2..98460561c8 100644
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -259,6 +259,7 @@ basicKnownKeyNames
         absIntegerName, signumIntegerName,
         leIntegerName, gtIntegerName, ltIntegerName, geIntegerName,
         compareIntegerName, quotRemIntegerName, divModIntegerName,
+        quotIntegerName, remIntegerName,
         floatFromIntegerName, doubleFromIntegerName,
         gcdIntegerName, lcmIntegerName,
         andIntegerName, orIntegerName, xorIntegerName, complementIntegerName,
@@ -827,6 +828,7 @@ integerTyConName, mkIntegerName,
     absIntegerName, signumIntegerName,
     leIntegerName, gtIntegerName, ltIntegerName, geIntegerName,
     compareIntegerName, quotRemIntegerName, divModIntegerName,
+    quotIntegerName, remIntegerName,
     floatFromIntegerName, doubleFromIntegerName,
     gcdIntegerName, lcmIntegerName,
     andIntegerName, orIntegerName, xorIntegerName, complementIntegerName,
@@ -851,6 +853,8 @@ geIntegerName         = varQual gHC_INTEGER_TYPE (fsLit "geInteger")         geI
 compareIntegerName    = varQual gHC_INTEGER_TYPE (fsLit "compareInteger")    compareIntegerIdKey
 quotRemIntegerName    = varQual gHC_INTEGER_TYPE (fsLit "quotRemInteger")    quotRemIntegerIdKey
 divModIntegerName     = varQual gHC_INTEGER_TYPE (fsLit "divModInteger")     divModIntegerIdKey
+quotIntegerName       = varQual gHC_INTEGER_TYPE (fsLit "quotInteger")       quotIntegerIdKey
+remIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "remInteger")        remIntegerIdKey
 floatFromIntegerName  = varQual gHC_INTEGER_TYPE (fsLit "floatFromIntegerName")     floatFromIntegerIdKey
 doubleFromIntegerName = varQual gHC_INTEGER_TYPE (fsLit "doubleFromIntegerName")    doubleFromIntegerIdKey
 gcdIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "gcdInteger")        gcdIntegerIdKey
@@ -1446,6 +1450,7 @@ mkIntegerIdKey, smallIntegerIdKey, integerToWordIdKey, integerToIntIdKey,
     eqIntegerIdKey, neqIntegerIdKey, absIntegerIdKey, signumIntegerIdKey,
     leIntegerIdKey, gtIntegerIdKey, ltIntegerIdKey, geIntegerIdKey,
     compareIntegerIdKey, quotRemIntegerIdKey, divModIntegerIdKey,
+    quotIntegerIdKey, remIntegerIdKey,
     floatFromIntegerIdKey, doubleFromIntegerIdKey,
     gcdIntegerIdKey, lcmIntegerIdKey,
     andIntegerIdKey, orIntegerIdKey, xorIntegerIdKey, complementIntegerIdKey,
@@ -1469,16 +1474,18 @@ geIntegerIdKey                = mkPreludeMiscIdUnique 75
 compareIntegerIdKey           = mkPreludeMiscIdUnique 76
 quotRemIntegerIdKey           = mkPreludeMiscIdUnique 77
 divModIntegerIdKey            = mkPreludeMiscIdUnique 78
-floatFromIntegerIdKey         = mkPreludeMiscIdUnique 79
-doubleFromIntegerIdKey        = mkPreludeMiscIdUnique 80
-gcdIntegerIdKey               = mkPreludeMiscIdUnique 81
-lcmIntegerIdKey               = mkPreludeMiscIdUnique 82
-andIntegerIdKey               = mkPreludeMiscIdUnique 83
-orIntegerIdKey                = mkPreludeMiscIdUnique 84
-xorIntegerIdKey               = mkPreludeMiscIdUnique 85
-complementIntegerIdKey        = mkPreludeMiscIdUnique 86
-shiftLIntegerIdKey            = mkPreludeMiscIdUnique 87
-shiftRIntegerIdKey            = mkPreludeMiscIdUnique 88
+quotIntegerIdKey              = mkPreludeMiscIdUnique 79
+remIntegerIdKey               = mkPreludeMiscIdUnique 80
+floatFromIntegerIdKey         = mkPreludeMiscIdUnique 81
+doubleFromIntegerIdKey        = mkPreludeMiscIdUnique 82
+gcdIntegerIdKey               = mkPreludeMiscIdUnique 83
+lcmIntegerIdKey               = mkPreludeMiscIdUnique 84
+andIntegerIdKey               = mkPreludeMiscIdUnique 85
+orIntegerIdKey                = mkPreludeMiscIdUnique 86
+xorIntegerIdKey               = mkPreludeMiscIdUnique 87
+complementIntegerIdKey        = mkPreludeMiscIdUnique 88
+shiftLIntegerIdKey            = mkPreludeMiscIdUnique 89
+shiftRIntegerIdKey            = mkPreludeMiscIdUnique 90
 
 rootMainKey, runMainKey :: Unique
 rootMainKey                   = mkPreludeMiscIdUnique 100
diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs
index 59142da106..6a3d90a218 100644
--- a/compiler/prelude/PrelRules.lhs
+++ b/compiler/prelude/PrelRules.lhs
@@ -642,10 +642,10 @@ builtinIntegerRules =
   rule_binop_Bool     "ltInteger"         ltIntegerName         (<),
   rule_binop_Bool     "geInteger"         geIntegerName         (>=),
   rule_binop_Ordering "compareInteger"    compareIntegerName    compare,
-  rule_divop          "divModInteger"     divModIntegerName     divMod,
-  rule_divop          "quotRemInteger"    quotRemIntegerName    quotRem,
-  -- TODO: quotInteger rule
-  -- TODO: remInteger rule
+  rule_divop_both     "divModInteger"     divModIntegerName     divMod,
+  rule_divop_both     "quotRemInteger"    quotRemIntegerName    quotRem,
+  rule_divop_one      "quotInteger"       quotIntegerName       quot,
+  rule_divop_one      "remInteger"        remIntegerName        rem,
   -- TODO: encodeFloatInteger rule
   rule_convert        "floatFromInteger"  floatFromIntegerName  mkFloatLitFloat,
   -- TODO: encodeDoubleInteger rule
@@ -668,9 +668,12 @@ builtinIntegerRules =
           rule_binop str name op
            = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,
                            ru_try = match_Integer_binop op }
-          rule_divop str name op
+          rule_divop_both str name op
            = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,
-                           ru_try = match_Integer_divop op }
+                           ru_try = match_Integer_divop_both op }
+          rule_divop_one str name op
+           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,
+                           ru_try = match_Integer_divop_one op }
           rule_Int_binop str name op
            = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,
                            ru_try = match_Integer_Int_binop op }
@@ -773,11 +776,11 @@ match_Integer_binop binop id_unf [xl,yl]
 match_Integer_binop _ _ _ = Nothing
 
 -- This helper is used for the quotRem and divMod functions
-match_Integer_divop :: (Integer -> Integer -> (Integer, Integer))
-                    -> IdUnfoldingFun
-                    -> [Expr CoreBndr]
-                    -> Maybe (Expr CoreBndr)
-match_Integer_divop divop id_unf [xl,yl]
+match_Integer_divop_both :: (Integer -> Integer -> (Integer, Integer))
+                         -> IdUnfoldingFun
+                         -> [Expr CoreBndr]
+                         -> Maybe (Expr CoreBndr)
+match_Integer_divop_both divop id_unf [xl,yl]
   | Just (LitInteger x i) <- exprIsLiteral_maybe id_unf xl
   , Just (LitInteger y _) <- exprIsLiteral_maybe id_unf yl
   , y /= 0
@@ -789,9 +792,20 @@ match_Integer_divop divop id_unf [xl,yl]
                                Type integerTy,
                                Lit (LitInteger r i),
                                Lit (LitInteger s i)]
-      _ -> panic "match_Integer_divop: mkIntegerId has the wrong type"
+      _ -> panic "match_Integer_divop_both: mkIntegerId has the wrong type"
+match_Integer_divop_both _ _ _ = Nothing
 
-match_Integer_divop _ _ _ = Nothing
+-- This helper is used for the quotRem and divMod functions
+match_Integer_divop_one :: (Integer -> Integer -> Integer)
+                        -> IdUnfoldingFun
+                        -> [Expr CoreBndr]
+                        -> Maybe (Expr CoreBndr)
+match_Integer_divop_one divop id_unf [xl,yl]
+  | Just (LitInteger x i) <- exprIsLiteral_maybe id_unf xl
+  , Just (LitInteger y _) <- exprIsLiteral_maybe id_unf yl
+  , y /= 0
+  = Just (Lit (LitInteger (x `divop` y) i))
+match_Integer_divop_one _ _ _ = Nothing
 
 match_Integer_Int_binop :: (Integer -> Int -> Integer)
                         -> IdUnfoldingFun