Define prelude rules for floatFromInteger and doubleFromInteger
authorIan Lynagh <igloo@earth.li>
Sat, 7 Jan 2012 23:03:08 +0000 (23:03 +0000)
committerIan Lynagh <igloo@earth.li>
Sat, 7 Jan 2012 23:03:08 +0000 (23:03 +0000)
compiler/prelude/PrelNames.lhs
compiler/prelude/PrelRules.lhs

index f95b21d..a88e536 100644 (file)
@@ -259,6 +259,7 @@ basicKnownKeyNames
         absIntegerName, signumIntegerName,
         leIntegerName, gtIntegerName, ltIntegerName, geIntegerName,
         compareIntegerName, quotRemIntegerName, divModIntegerName,
+        floatFromIntegerName, doubleFromIntegerName,
         gcdIntegerName, lcmIntegerName,
         andIntegerName, orIntegerName, xorIntegerName, complementIntegerName,
         shiftLIntegerName, shiftRIntegerName,
@@ -826,6 +827,7 @@ integerTyConName, mkIntegerName,
     absIntegerName, signumIntegerName,
     leIntegerName, gtIntegerName, ltIntegerName, geIntegerName,
     compareIntegerName, quotRemIntegerName, divModIntegerName,
+    floatFromIntegerName, doubleFromIntegerName,
     gcdIntegerName, lcmIntegerName,
     andIntegerName, orIntegerName, xorIntegerName, complementIntegerName,
     shiftLIntegerName, shiftRIntegerName :: Name
@@ -849,6 +851,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
+floatFromIntegerName  = varQual gHC_INTEGER_TYPE (fsLit "floatFromIntegerName")     floatFromIntegerIdKey
+doubleFromIntegerName = varQual gHC_INTEGER_TYPE (fsLit "doubleFromIntegerName")    doubleFromIntegerIdKey
 gcdIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "gcdInteger")        gcdIntegerIdKey
 lcmIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "lcmInteger")        lcmIntegerIdKey
 andIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "andInteger")        andIntegerIdKey
@@ -1442,6 +1446,7 @@ mkIntegerIdKey, smallIntegerIdKey, integerToWordIdKey, integerToIntIdKey,
     eqIntegerIdKey, neqIntegerIdKey, absIntegerIdKey, signumIntegerIdKey,
     leIntegerIdKey, gtIntegerIdKey, ltIntegerIdKey, geIntegerIdKey,
     compareIntegerIdKey, quotRemIntegerIdKey, divModIntegerIdKey,
+    floatFromIntegerIdKey, doubleFromIntegerIdKey,
     gcdIntegerIdKey, lcmIntegerIdKey,
     andIntegerIdKey, orIntegerIdKey, xorIntegerIdKey, complementIntegerIdKey,
     shiftLIntegerIdKey, shiftRIntegerIdKey :: Unique
@@ -1464,14 +1469,16 @@ geIntegerIdKey                = mkPreludeMiscIdUnique 75
 compareIntegerIdKey           = mkPreludeMiscIdUnique 76
 quotRemIntegerIdKey           = mkPreludeMiscIdUnique 77
 divModIntegerIdKey            = mkPreludeMiscIdUnique 78
-gcdIntegerIdKey               = mkPreludeMiscIdUnique 79
-lcmIntegerIdKey               = mkPreludeMiscIdUnique 80
-andIntegerIdKey               = mkPreludeMiscIdUnique 81
-orIntegerIdKey                = mkPreludeMiscIdUnique 82
-xorIntegerIdKey               = mkPreludeMiscIdUnique 83
-complementIntegerIdKey        = mkPreludeMiscIdUnique 84
-shiftLIntegerIdKey            = mkPreludeMiscIdUnique 85
-shiftRIntegerIdKey            = mkPreludeMiscIdUnique 86
+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
 
 rootMainKey, runMainKey :: Unique
 rootMainKey                   = mkPreludeMiscIdUnique 100
index 21ba258..59142da 100644 (file)
@@ -647,10 +647,10 @@ builtinIntegerRules =
   -- TODO: quotInteger rule
   -- TODO: remInteger rule
   -- TODO: encodeFloatInteger rule
-  -- TODO: floatFromInteger rule
+  rule_convert        "floatFromInteger"  floatFromIntegerName  mkFloatLitFloat,
   -- TODO: encodeDoubleInteger rule
   -- TODO: decodeDoubleInteger rule
-  -- TODO: doubleFromInteger rule
+  rule_convert        "doubleFromInteger" doubleFromIntegerName mkDoubleLitDouble,
   rule_binop          "gcdInteger"        gcdIntegerName        gcd,
   rule_binop          "lcmInteger"        lcmIntegerName        lcm,
   rule_binop          "andInteger"        andIntegerName        (.&.),
@@ -750,7 +750,7 @@ match_Integer_convert :: Num a
                       -> Maybe (Expr CoreBndr)
 match_Integer_convert convert id_unf [xl]
   | Just (LitInteger x _) <- exprIsLiteral_maybe id_unf xl
-  = Just (convert (fromIntegral x))
+  = Just (convert (fromInteger x))
 match_Integer_convert _ _ _ = Nothing
 
 match_Integer_unop :: (Integer -> Integer)