Commit 56a7c604 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Add prelude rules for quotInteger, remInteger

parent 4a0eb925
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment