change how Integer's are handled in Core

We now treat them as literals until CorePrep, when we finally
convert them into the real Core representation. This makes it a lot
simpler to implement built-in rules on them.

15 files changed, 274 insertions, 93 deletions

diff --git a/compiler/basicTypes/Literal.lhs b/compiler/basicTypes/Literal.lhs
index 21ae638023..ba8bc22a0b 100644
--- a/compiler/basicTypes/Literal.lhs
+++ b/compiler/basicTypes/Literal.lhs
@@ -40,6 +40,7 @@ module Literal
 
 import TysPrim
 import PrelNames
+import TysWiredIn
 import Type
 import TyCon
 import Outputable
@@ -106,6 +107,11 @@ data Literal
                                 --    the label expects. Only applicable with
                                 --    @stdcall@ labels. @Just x@ => @\<x\>@ will
                                 --    be appended to label name when emitting assembly.
+
+  | LitInteger Integer
+   -- ^ We treat @Integer@s as literals, to make it easier to write
+   --   RULEs for them. They only get converted into real Core during
+   --   the CorePrep phase.
   deriving (Data, Typeable)
 \end{code}
 
@@ -127,6 +133,7 @@ instance Binary Literal where
              put_ bh aj
              put_ bh mb
              put_ bh fod
+    put_ bh (LitInteger i) = do putByte bh 10; put_ bh i
     get bh = do
             h <- getByte bh
             case h of
@@ -156,11 +163,14 @@ instance Binary Literal where
               8 -> do
                     ai <- get bh
                     return (MachDouble ai)
-              _ -> do
+              9 -> do
                     aj <- get bh
                     mb <- get bh
                     fod <- get bh
                     return (MachLabel aj mb fod)
+              _ -> do
+                    i <- get bh
+                    return (LitInteger i)
 \end{code}
 
 \begin{code}
@@ -308,15 +318,17 @@ nullAddrLit = MachNullAddr
 -- False principally of strings
 litIsTrivial :: Literal -> Bool
 --      c.f. CoreUtils.exprIsTrivial
-litIsTrivial (MachStr _) = False
-litIsTrivial _           = True
+litIsTrivial (MachStr _)    = False
+litIsTrivial (LitInteger _) = False
+litIsTrivial _              = True
 
 -- | True if code space does not go bad if we duplicate this literal
 -- Currently we treat it just like 'litIsTrivial'
 litIsDupable :: Literal -> Bool
 --      c.f. CoreUtils.exprIsDupable
-litIsDupable (MachStr _) = False
-litIsDupable _           = True
+litIsDupable (MachStr _)    = False
+litIsDupable (LitInteger i) = inIntRange i
+litIsDupable _              = True
 
 litFitsInChar :: Literal -> Bool
 litFitsInChar (MachInt i)
@@ -340,6 +352,7 @@ literalType (MachWord64  _) = word64PrimTy
 literalType (MachFloat _)   = floatPrimTy
 literalType (MachDouble _)  = doublePrimTy
 literalType (MachLabel _ _ _) = addrPrimTy
+literalType (LitInteger _)    = integerTy
 
 absentLiteralOf :: TyCon -> Maybe Literal
 -- Return a literal of the appropriate primtive
@@ -372,6 +385,7 @@ cmpLit (MachWord64    a)   (MachWord64     b)   = a `compare` b
 cmpLit (MachFloat     a)   (MachFloat      b)   = a `compare` b
 cmpLit (MachDouble    a)   (MachDouble     b)   = a `compare` b
 cmpLit (MachLabel     a _ _) (MachLabel      b _ _) = a `compare` b
+cmpLit (LitInteger    a)     (LitInteger     b)     = a `compare` b
 cmpLit lit1                lit2                 | litTag lit1 <# litTag lit2 = LT
                                                 | otherwise                  = GT
 
@@ -386,6 +400,7 @@ litTag (MachWord64    _)   = _ILIT(7)
 litTag (MachFloat     _)   = _ILIT(8)
 litTag (MachDouble    _)   = _ILIT(9)
 litTag (MachLabel _ _ _)   = _ILIT(10)
+litTag (LitInteger    _)   = _ILIT(11)
 \end{code}
 
         Printing
@@ -408,6 +423,7 @@ pprLit (MachLabel l mb fod) = ptext (sLit "__label") <+> b <+> ppr fod
     where b = case mb of
               Nothing -> pprHsString l
               Just x  -> doubleQuotes (text (unpackFS l ++ '@':show x))
+pprLit (LitInteger i)   = ptext (sLit "__integer") <+> integer i
 
 pprIntVal :: Integer -> SDoc
 -- ^ Print negative integers with parens to be sure it's unambiguous
@@ -437,6 +453,7 @@ hashLiteral (MachWord64 i)      = hashInteger i
 hashLiteral (MachFloat r)       = hashRational r
 hashLiteral (MachDouble r)      = hashRational r
 hashLiteral (MachLabel s _ _)     = hashFS s
+hashLiteral (LitInteger i)      = hashInteger i
 
 hashRational :: Rational -> Int
 hashRational r = hashInteger (numerator r)
diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index 5ad9b0ec90..2352518f09 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -28,6 +28,19 @@ module MkId (
         voidArgId, nullAddrId, seqId, lazyId, lazyIdKey,
         coercionTokenId,
 
+        -- integer-gmp only Id:
+        integerGmpSId,
+        -- integer-simple only Id's:
+        integerSimpleNaughtId,
+        integerSimplePositiveId,
+        integerSimpleNegativeId,
+        digitsNoneId,
+        digitsSomeId,
+        -- Common Integer Id's:
+        shiftLIntegerId,
+        negateIntegerId,
+        orIntegerId,
+
 	-- Re-export error Ids
 	module PrelRules
     ) where
@@ -36,7 +49,7 @@ module MkId (
 
 import Rules
 import TysPrim
-import TysWiredIn	( unitTy )
+import TysWiredIn
 import PrelRules
 import Type
 import Coercion
@@ -1045,6 +1058,40 @@ coercionTokenId -- Used to replace Coercion terms when we go to STG
   = pcMiscPrelId coercionTokenName 
                  (mkTyConApp eqPrimTyCon [unitTy, unitTy])
                  noCafIdInfo
+
+-- integer-gmp only Id:
+integerGmpSId :: Id
+integerGmpSId = mkVanillaGlobal integerGmpSDataConName
+                                (mkFunTy intPrimTy integerTy)
+
+-- integer-simple only Id's:
+integerSimpleNaughtId, integerSimplePositiveId, integerSimpleNegativeId,
+    digitsNoneId, digitsSomeId :: Id
+integerSimpleNaughtId = mkVanillaGlobal integerSimpleNaughtDataConName
+                                        integerTy
+integerSimplePositiveId = mkVanillaGlobal integerSimplePositiveDataConName
+                                          (mkFunTy digitsTy integerTy)
+integerSimpleNegativeId = mkVanillaGlobal integerSimpleNegativeDataConName
+                                          (mkFunTy digitsTy integerTy)
+digitsNoneId = mkVanillaGlobal digitsNoneDataConName
+                               digitsTy
+digitsSomeId = mkVanillaGlobal digitsSomeDataConName
+                               (mkFunTy wordPrimTy
+                                        (mkFunTy digitsTy digitsTy))
+
+shiftLIntegerId :: Id
+shiftLIntegerId = mkVanillaGlobal shiftLIntegerName
+                                  (mkFunTy integerTy
+                                           (mkFunTy intPrimTy integerTy))
+
+negateIntegerId :: Id
+negateIntegerId = mkVanillaGlobal negateIntegerName
+                                  (mkFunTy integerTy integerTy)
+
+orIntegerId :: Id
+orIntegerId = mkVanillaGlobal orIntegerName
+                              (mkFunTy integerTy
+                                       (mkFunTy integerTy integerTy))
 \end{code}
 
 
diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index aa86690612..e01457ae99 100644
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -108,6 +108,9 @@ mkSimpleLit (MachLabel fs ms fod)
                 -- TODO: Literal labels might not actually be in the current package...
                 labelSrc = ForeignLabelInThisPackage
 mkSimpleLit (MachStr _) = panic "mkSimpleLit: MachStr"
+-- No LitInteger's should be left by the time this is called. CorePrep
+-- should have converted them all to a real core representation.
+mkSimpleLit (LitInteger _) = panic "mkSimpleLit: LitInteger"
 
 mkLtOp :: Literal -> MachOp
 -- On signed literals we must do a signed comparison
diff --git a/compiler/coreSyn/CoreLint.lhs b/compiler/coreSyn/CoreLint.lhs
index db3a108784..851b84380f 100644
--- a/compiler/coreSyn/CoreLint.lhs
+++ b/compiler/coreSyn/CoreLint.lhs
@@ -511,10 +511,13 @@ lintCoreAlt _ alt_ty (DEFAULT, args, rhs) =
   do { checkL (null args) (mkDefaultArgsMsg args)
      ; checkAltExpr rhs alt_ty }
 
-lintCoreAlt scrut_ty alt_ty (LitAlt lit, args, rhs) = 
-  do { checkL (null args) (mkDefaultArgsMsg args)
-     ; checkTys lit_ty scrut_ty (mkBadPatMsg lit_ty scrut_ty)	
-     ; checkAltExpr rhs alt_ty } 
+lintCoreAlt scrut_ty alt_ty (LitAlt lit, args, rhs)
+  | integerTy `eqType` scrut_ty
+    = failWithL integerScrutinisedMsg
+  | otherwise
+    = do { checkL (null args) (mkDefaultArgsMsg args)
+         ; checkTys lit_ty scrut_ty (mkBadPatMsg lit_ty scrut_ty)
+         ; checkAltExpr rhs alt_ty }
   where
     lit_ty = literalType lit
 
@@ -1070,6 +1073,10 @@ mkBadPatMsg con_result_ty scrut_ty
 	text "Scrutinee type:" <+> ppr scrut_ty
     ]
 
+integerScrutinisedMsg :: Message
+integerScrutinisedMsg
+  = text "In a case alternative, scrutinee type is Integer"
+
 mkBadAltMsg :: Type -> CoreAlt -> Message
 mkBadAltMsg scrut_ty alt
   = vcat [ text "Data alternative when scrutinee is not a tycon application",
diff --git a/compiler/coreSyn/CorePrep.lhs b/compiler/coreSyn/CorePrep.lhs
index fdd92794bb..b480c6bcef 100644
--- a/compiler/coreSyn/CorePrep.lhs
+++ b/compiler/coreSyn/CorePrep.lhs
@@ -11,7 +11,7 @@ module CorePrep (
 
 #include "HsVersions.h"
 
-import PrelNames	( lazyIdKey, hasKey )
+import PrelNames
 import CoreUtils
 import CoreArity
 import CoreFVs
@@ -20,6 +20,7 @@ import CoreSyn
 import CoreSubst
 import OccurAnal        ( occurAnalyseExpr )
 import Type
+import Literal
 import Coercion
 import TyCon
 import Demand
@@ -28,6 +29,7 @@ import VarSet
 import VarEnv
 import Id
 import IdInfo
+import MkId
 import DataCon
 import PrimOp
 import BasicTypes
@@ -41,7 +43,10 @@ import Pair
 import Outputable
 import MonadUtils
 import FastString
+import Config
+import Data.Bits
 import Data.List	( mapAccumL )
+import Data.Word
 import Control.Monad
 \end{code}
 
@@ -446,6 +451,7 @@ cpeRhsE :: CorePrepEnv -> CoreExpr -> UniqSM (Floats, CpeRhs)
 
 cpeRhsE _env expr@(Type {})     = return (emptyFloats, expr)
 cpeRhsE _env expr@(Coercion {}) = return (emptyFloats, expr)
+cpeRhsE env (Lit (LitInteger i)) = cpeInteger env i
 cpeRhsE _env expr@(Lit {})      = return (emptyFloats, expr)
 cpeRhsE env expr@(Var {})       = cpeApp env expr
 
@@ -495,6 +501,41 @@ cpeRhsE env (Case scrut bndr ty alts)
             ; rhs' <- cpeBodyNF env2 rhs
             ; return (con, bs', rhs') }
 
+cpeInteger :: CorePrepEnv -> Integer -> UniqSM (Floats, CpeRhs)
+cpeInteger env i
+    = let expr = case cIntegerLibraryType of
+                  IntegerGMP ->
+                      let mkSmallInteger x = App (Var integerGmpSId)
+                                                 (Lit (mkMachInt x))
+                          negateInteger x = App (Var negateIntegerId) x
+                          f x = let low  = x .&. mask
+                                    high = x `shiftR` bits
+                                    highExpr = mkApps (Var shiftLIntegerId)
+                                                      [f high,
+                                                       Lit (mkMachInt (fromIntegral bits))]
+                                in if high == 0 then mkSmallInteger x
+                                   else if low == 0 then highExpr
+                                   else mkApps (Var orIntegerId)
+                                               [mkSmallInteger low, highExpr]
+                          bits = bitSize (undefined :: Int) - 2
+                          mask = 2 ^ bits - 1
+                      in if inIntRange i then mkSmallInteger i
+                         else if i < 0 then negateInteger (f (negate i))
+                         else f i
+                  IntegerSimple ->
+                      let bits = bitSize (undefined :: Word)
+                          mask = 2 ^ bits - 1
+                          f 0 = Var digitsNoneId
+                          f x = let low  = x .&. mask
+                                    high = x `shiftR` bits
+                                in mkApps (Var digitsSomeId)
+                                          [Lit (mkMachWord low), f high]
+                      in case i `compare` 0 of
+                         EQ -> Var integerSimpleNaughtId
+                         GT -> App (Var integerSimplePositiveId) (f i)
+                         LT -> App (Var integerSimpleNegativeId) (f (negate i))
+      in cpeRhsE env expr
+
 -- ---------------------------------------------------------------------------
 --		CpeBody: produces a result satisfying CpeBody
 -- ---------------------------------------------------------------------------
diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
index bc1e45ee33..be071191a2 100644
--- a/compiler/coreSyn/CoreUtils.lhs
+++ b/compiler/coreSyn/CoreUtils.lhs
@@ -1539,6 +1539,7 @@ rhsIsStatic _is_dynamic_name rhs = is_static False rhs
   is_static in_arg (Note n e) 		= notSccNote n && is_static in_arg e
   is_static in_arg (Cast e _) 		= is_static in_arg e
   is_static _      (Coercion {})	= True   -- Behaves just like a literal
+  is_static _      (Lit (LitInteger _)) = False
   is_static _      (Lit (MachLabel {})) = False
   is_static _      (Lit _)              = True
   	-- A MachLabel (foreign import "&foo") in an argument
diff --git a/compiler/coreSyn/MkCore.lhs b/compiler/coreSyn/MkCore.lhs
index 214615866d..53355910d3 100644
--- a/compiler/coreSyn/MkCore.lhs
+++ b/compiler/coreSyn/MkCore.lhs
@@ -219,39 +219,7 @@ mkWordExprWord w = mkConApp wordDataCon [mkWordLitWord w]
 
 -- | Create a 'CoreExpr' which will evaluate to the given @Integer@
 mkIntegerExpr  :: MonadThings m => Integer    -> m CoreExpr  -- Result :: Integer
-mkIntegerExpr i
-  | inIntRange i        -- Small enough, so start from an Int
-    = do integer_id <- lookupId smallIntegerName
-         return (mkSmallIntegerLit integer_id i)
-
--- Special case for integral literals with a large magnitude:
--- They are transformed into an expression involving only smaller
--- integral literals. This improves constant folding.
-
-  | otherwise = do       -- Big, so start from a string
-      plus_id <- lookupId plusIntegerName
-      times_id <- lookupId timesIntegerName
-      integer_id <- lookupId smallIntegerName
-      let
-           lit i = mkSmallIntegerLit integer_id i
-           plus a b  = Var plus_id  `App` a `App` b
-           times a b = Var times_id `App` a `App` b
-
-           -- Transform i into (x1 + (x2 + (x3 + (...) * b) * b) * b) with abs xi <= b
-           horner :: Integer -> Integer -> CoreExpr
-           horner b i | abs q <= 1 = if r == 0 || r == i 
-                                     then lit i 
-                                     else lit r `plus` lit (i-r)
-                      | r == 0     =               horner b q `times` lit b
-                      | otherwise  = lit r `plus` (horner b q `times` lit b)
-                      where
-                        (q,r) = i `quotRem` b
-
-      return (horner tARGET_MAX_INT i)
-  where
-    mkSmallIntegerLit :: Id -> Integer -> CoreExpr
-    mkSmallIntegerLit small_integer i = mkApps (Var small_integer) [mkIntLit i]
-
+mkIntegerExpr i = return (Lit (LitInteger i))
 
 -- | Create a 'CoreExpr' which will evaluate to the given @Float@
 mkFloatExpr :: Float -> CoreExpr
diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index 1a7fa07219..735d0ec183 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -51,6 +51,8 @@ compiler/stage%/build/Config.hs : mk/config.mk mk/project.mk | $$(dir $$@)/.
 	@echo                                                               >> $@
 	@echo '#include "ghc_boot_platform.h"'                              >> $@
 	@echo                                                               >> $@
+	@echo 'data IntegerLibrary = IntegerGMP | IntegerSimple'            >> $@
+	@echo                                                               >> $@
 	@echo 'cBuildPlatformString :: String'                              >> $@
 	@echo 'cBuildPlatformString = BuildPlatform_NAME'                   >> $@
 	@echo 'cHostPlatformString :: String'                               >> $@
@@ -76,6 +78,14 @@ compiler/stage%/build/Config.hs : mk/config.mk mk/project.mk | $$(dir $$@)/.
 	@echo 'cLdLinkerOpts         = words "$(CONF_LD_LINKER_OPTS_STAGE$*)"'  >> $@
 	@echo 'cIntegerLibrary       :: String'                             >> $@
 	@echo 'cIntegerLibrary       = "$(INTEGER_LIBRARY)"'                >> $@
+	@echo 'cIntegerLibraryType   :: IntegerLibrary'                     >> $@
+ifeq "$(INTEGER_LIBRARY)" "integer-gmp"
+	@echo 'cIntegerLibraryType   = IntegerGMP'                          >> $@
+else ifeq "$(INTEGER_LIBRARY)" "integer-simple"
+	@echo 'cIntegerLibraryType   = IntegerSimple'                       >> $@
+else ifneq "$(CLEANING)" "YES"
+$(error Unknown integer library)
+endif
 	@echo 'cSupportsSplitObjs    :: String'                             >> $@
 	@echo 'cSupportsSplitObjs    = "$(SupportsSplitObjs)"'              >> $@
 	@echo 'cGhcWithInterpreter   :: String'                             >> $@
diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs
index 8cbf5d0310..8778933bdb 100644
--- a/compiler/ghci/ByteCodeGen.lhs
+++ b/compiler/ghci/ByteCodeGen.lhs
@@ -1241,6 +1241,10 @@ pushAtom _ _ (AnnLit lit)
         MachChar _    -> code NonPtrArg
         MachNullAddr  -> code NonPtrArg
         MachStr s     -> pushStr s
+        -- No LitInteger's should be left by the time this is called.
+        -- CorePrep should have converted them all to a real core
+        -- representation.
+        LitInteger _  -> panic "pushAtom: LitInteger"
      where
         code rep
            = let size_host_words = fromIntegral (cgRepSizeW rep)
diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index 467eb3f18e..2334d0519a 100644
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -205,7 +205,7 @@ basicKnownKeyNames
         printName, fstName, sndName,
 
         -- Integer
-        integerTyConName, plusIntegerName, timesIntegerName, smallIntegerName,
+        plusIntegerName, timesIntegerName, smallIntegerName,
         integerToWordName, integerToIntName, minusIntegerName,
         negateIntegerName, eqIntegerName, neqIntegerName,
         absIntegerName, signumIntegerName,
@@ -786,7 +786,7 @@ fromIntegerName   = methName gHC_NUM (fsLit "fromInteger") fromIntegerClassOpKey
 minusName         = methName gHC_NUM (fsLit "-") minusClassOpKey
 negateName        = methName gHC_NUM (fsLit "negate") negateClassOpKey
 
-integerTyConName, plusIntegerName, timesIntegerName, smallIntegerName,
+plusIntegerName, timesIntegerName, smallIntegerName,
     integerToWordName, integerToIntName, minusIntegerName,
     negateIntegerName, eqIntegerName, neqIntegerName,
     absIntegerName, signumIntegerName,
@@ -795,7 +795,6 @@ integerTyConName, plusIntegerName, timesIntegerName, smallIntegerName,
     gcdIntegerName, lcmIntegerName,
     andIntegerName, orIntegerName, xorIntegerName, complementIntegerName,
     shiftLIntegerName, shiftRIntegerName :: Name
-integerTyConName      = tcQual  gHC_INTEGER_TYPE (fsLit "Integer")           integerTyConKey
 plusIntegerName       = varQual gHC_INTEGER_TYPE (fsLit "plusInteger")       plusIntegerIdKey
 timesIntegerName      = varQual gHC_INTEGER_TYPE (fsLit "timesInteger")      timesIntegerIdKey
 smallIntegerName      = varQual gHC_INTEGER_TYPE (fsLit "smallInteger")      smallIntegerIdKey
@@ -1133,7 +1132,8 @@ addrPrimTyConKey, arrayPrimTyConKey, boolTyConKey, byteArrayPrimTyConKey,
     charPrimTyConKey, charTyConKey, doublePrimTyConKey, doubleTyConKey,
     floatPrimTyConKey, floatTyConKey, funTyConKey, intPrimTyConKey,
     intTyConKey, int8TyConKey, int16TyConKey, int32PrimTyConKey,
-    int32TyConKey, int64PrimTyConKey, int64TyConKey, integerTyConKey,
+    int32TyConKey, int64PrimTyConKey, int64TyConKey,
+    integerTyConKey, digitsTyConKey,
     listTyConKey, foreignObjPrimTyConKey, weakPrimTyConKey,
     mutableArrayPrimTyConKey, mutableByteArrayPrimTyConKey,
     orderingTyConKey, mVarPrimTyConKey, ratioTyConKey, rationalTyConKey,
@@ -1159,8 +1159,9 @@ int32TyConKey                           = mkPreludeTyConUnique 19
 int64PrimTyConKey                       = mkPreludeTyConUnique 20
 int64TyConKey                           = mkPreludeTyConUnique 21
 integerTyConKey                         = mkPreludeTyConUnique 22
-listTyConKey                            = mkPreludeTyConUnique 23
-foreignObjPrimTyConKey                  = mkPreludeTyConUnique 24
+digitsTyConKey                          = mkPreludeTyConUnique 23
+listTyConKey                            = mkPreludeTyConUnique 24
+foreignObjPrimTyConKey                  = mkPreludeTyConUnique 25
 weakPrimTyConKey                        = mkPreludeTyConUnique 27
 mutableArrayPrimTyConKey                = mkPreludeTyConUnique 28
 mutableByteArrayPrimTyConKey            = mkPreludeTyConUnique 29
@@ -1349,6 +1350,22 @@ ltDataConKey, eqDataConKey, gtDataConKey :: Unique
 ltDataConKey                            = mkPreludeDataConUnique 27
 eqDataConKey                            = mkPreludeDataConUnique 28
 gtDataConKey                            = mkPreludeDataConUnique 29
+
+-- For integer-gmp only
+integerGmpSDataConKey, integerGmpJDataConKey :: Unique
+integerGmpSDataConKey                   = mkPreludeDataConUnique 30
+integerGmpJDataConKey                   = mkPreludeDataConUnique 31
+
+-- For integer-simple only
+integerSimpleNaughtDataConKey,
+    integerSimplePositiveDataConKey, integerSimpleNegativeDataConKey :: Unique
+integerSimpleNaughtDataConKey           = mkPreludeDataConUnique 32
+integerSimplePositiveDataConKey         = mkPreludeDataConUnique 33
+integerSimpleNegativeDataConKey         = mkPreludeDataConUnique 34
+
+digitsSomeDataConKey, digitsNoneDataConKey :: Unique
+digitsSomeDataConKey                    = mkPreludeDataConUnique 35
+digitsNoneDataConKey                    = mkPreludeDataConUnique 36
 \end{code}
 
 %************************************************************************
diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs
index 9dbc32f4fc..502447d17d 100644
--- a/compiler/prelude/PrelRules.lhs
+++ b/compiler/prelude/PrelRules.lhs
@@ -611,8 +611,6 @@ builtinRules
                     ru_nargs = 2, ru_try = match_eq_string },
       BuiltinRule { ru_name = fsLit "Inline", ru_fn = inlineIdName,
                     ru_nargs = 2, ru_try = match_inline },
-      -- TODO: All the below rules need to handle target platform
-      -- having a different wordsize than the host platform
       rule_Integer_convert    "integerToWord" integerToWordName mkWordLitWord,
       rule_Integer_convert    "integerToInt"  integerToIntName  mkIntLitInt,
       rule_Integer_binop      "plusInteger"   plusIntegerName   (+),
@@ -661,7 +659,6 @@ builtinRules
            = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,
                            ru_try = match_Integer_binop_Ordering op }
 
-
 ---------------------------------------------------
 -- The rule is this:
 --      unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n)
@@ -729,75 +726,48 @@ match_Integer_convert :: Num a
                       -> IdUnfoldingFun
                       -> [Expr CoreBndr]
                       -> Maybe (Expr CoreBndr)
-match_Integer_convert convert _ [x]
- | (Var fx, [Lit (MachInt ix)]) <- collectArgs x,
-   idName fx == smallIntegerName
-    = Just (convert (fromIntegral ix))
+match_Integer_convert convert _ [Lit (LitInteger x)]
+    = Just (convert (fromIntegral x))
 match_Integer_convert _ _ _ = Nothing
 
 match_Integer_unop :: (Integer -> Integer)
                    -> IdUnfoldingFun
                    -> [Expr CoreBndr]
                    -> Maybe (Expr CoreBndr)
-match_Integer_unop unop _ [x]
- | (Var fx, [Lit (MachInt ix)]) <- collectArgs x,
-   idName fx == smallIntegerName,
-   let iz = unop ix,
-   iz >= fromIntegral (minBound :: Int),
-   iz <= fromIntegral (maxBound :: Int)
-    = Just (Var fx `App` Lit (MachInt iz))
+match_Integer_unop unop _ [Lit (LitInteger x)]
+    = Just (Lit (LitInteger (unop x)))
 match_Integer_unop _ _ _ = Nothing
 
 match_Integer_binop :: (Integer -> Integer -> Integer)
                     -> IdUnfoldingFun
                     -> [Expr CoreBndr]
                     -> Maybe (Expr CoreBndr)
-match_Integer_binop binop _ [x, y]
- | (Var fx, [Lit (MachInt ix)]) <- collectArgs x,
-   (Var fy, [Lit (MachInt iy)]) <- collectArgs y,
-   idName fx == smallIntegerName,
-   idName fy == smallIntegerName,
-   let iz = ix `binop` iy,
-   iz >= fromIntegral (minBound :: Int),
-   iz <= fromIntegral (maxBound :: Int)
-    = Just (Var fx `App` Lit (MachInt iz))
+match_Integer_binop binop _ [Lit (LitInteger x), Lit (LitInteger y)]
+    = Just (Lit (LitInteger (x `binop` y)))
 match_Integer_binop _ _ _ = Nothing
 
 match_Integer_Int_binop :: (Integer -> Int -> Integer)
                         -> IdUnfoldingFun
                         -> [Expr CoreBndr]
                         -> Maybe (Expr CoreBndr)
-match_Integer_Int_binop binop _ [x, Lit (MachInt iy)]
- | (Var fx, [Lit (MachInt ix)]) <- collectArgs x,
-   idName fx == smallIntegerName,
-   let iz = ix `binop` fromIntegral iy,
-   iz >= fromIntegral (minBound :: Int),
-   iz <= fromIntegral (maxBound :: Int)
-    = Just (Var fx `App` Lit (MachInt iz))
+match_Integer_Int_binop binop _ [Lit (LitInteger x), Lit (MachInt y)]
+    = Just (Lit (LitInteger (x `binop` fromIntegral y)))
 match_Integer_Int_binop _ _ _ = Nothing
 
 match_Integer_binop_Bool :: (Integer -> Integer -> Bool)
                          -> IdUnfoldingFun
                          -> [Expr CoreBndr]
                          -> Maybe (Expr CoreBndr)
-match_Integer_binop_Bool binop _ [x, y]
- | (Var fx, [Lit (MachInt ix)]) <- collectArgs x,
-   (Var fy, [Lit (MachInt iy)]) <- collectArgs y,
-   idName fx == smallIntegerName,
-   idName fy == smallIntegerName
-    = Just (if ix `binop` iy then trueVal else falseVal)
+match_Integer_binop_Bool binop _ [Lit (LitInteger x), Lit (LitInteger y)]
+    = Just (if x `binop` y then trueVal else falseVal)
 match_Integer_binop_Bool _ _ _ = Nothing
 
 match_Integer_binop_Ordering :: (Integer -> Integer -> Ordering)
                              -> IdUnfoldingFun
                              -> [Expr CoreBndr]
                              -> Maybe (Expr CoreBndr)
-match_Integer_binop_Ordering binop _ [x, y]
- | (Var fx, [Lit (MachInt ix)]) <- collectArgs x,
-   (Var fy, [Lit (MachInt iy)]) <- collectArgs y,
-   idName fx == smallIntegerName,
-   idName fy == smallIntegerName
-    = Just $ case ix `binop` iy of
+match_Integer_binop_Ordering binop _ [Lit (LitInteger x), Lit (LitInteger y)]
+    = Just $ case x `binop` y of
              LT -> ltVal
              EQ -> eqVal
              GT -> gtVal
diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs
index bad62a599b..8ab7ba478b 100644
--- a/compiler/prelude/TysWiredIn.lhs
+++ b/compiler/prelude/TysWiredIn.lhs
@@ -24,6 +24,15 @@ module TysWiredIn (
 	charTyCon, charDataCon, charTyCon_RDR,
 	charTy, stringTy, charTyConName,
 
+        -- * Integer
+        integerTy, integerTyConName,
+        -- integer-gmp only:
+        integerGmpSDataConName,
+        -- integer-simple only:
+        integerSimpleNaughtDataConName,
+        integerSimplePositiveDataConName, integerSimpleNegativeDataConName,
+        digitsTy, digitsSomeDataConName, digitsNoneDataConName,
+
 	-- * Double
 	doubleTyCon, doubleDataCon, doubleTy, doubleTyConName, 
 	
@@ -88,6 +97,7 @@ import Unique           ( incrUnique, mkTupleTyConUnique,
 import Data.Array
 import FastString
 import Outputable
+import Config
 
 alpha_tyvar :: [TyVar]
 alpha_tyvar = [alphaTyVar]
@@ -132,6 +142,8 @@ wiredInTyCons = [ unitTyCon	-- Not treated like other tuples, because
     	      , doubleTyCon
     	      , floatTyCon
     	      , intTyCon
+    	      , integerTyCon
+    	      , digitsTyCon
     	      , listTyCon
 	      , parrTyCon
               , eqTyCon
@@ -177,6 +189,25 @@ floatDataConName   = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "F#") floa
 doubleTyConName    = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Double") doubleTyConKey doubleTyCon
 doubleDataConName  = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "D#") doubleDataConKey doubleDataCon
 
+-- For all integer implementations:
+integerTyConName :: Name
+integerTyConName    = mkWiredInTyConName   UserSyntax gHC_INTEGER_TYPE (fsLit "Integer") integerTyConKey integerTyCon
+-- For integer-gmp only:
+integerGmpSDataConName, integerGmpJDataConName :: Name
+integerGmpSDataConName = mkWiredInDataConName UserSyntax gHC_INTEGER_TYPE (fsLit "S#") integerGmpSDataConKey integerGmpSDataCon
+integerGmpJDataConName = mkWiredInDataConName UserSyntax gHC_INTEGER_TYPE (fsLit "J#") integerGmpJDataConKey integerGmpJDataCon
+-- For integer-simple only:
+integerSimpleNaughtDataConName,
+    integerSimplePositiveDataConName, integerSimpleNegativeDataConName :: Name
+integerSimpleNaughtDataConName = mkWiredInDataConName UserSyntax gHC_INTEGER_TYPE (fsLit "Naught") integerSimpleNaughtDataConKey integerSimpleNaughtDataCon
+integerSimplePositiveDataConName = mkWiredInDataConName UserSyntax gHC_INTEGER_TYPE (fsLit "Positive") integerSimplePositiveDataConKey integerSimplePositiveDataCon
+integerSimpleNegativeDataConName = mkWiredInDataConName UserSyntax gHC_INTEGER_TYPE (fsLit "Negative") integerSimpleNegativeDataConKey integerSimpleNegativeDataCon
+digitsTyConName :: Name
+digitsTyConName    = mkWiredInTyConName   UserSyntax gHC_INTEGER_TYPE (fsLit "Digits") digitsTyConKey digitsTyCon
+digitsSomeDataConName, digitsNoneDataConName :: Name
+digitsSomeDataConName = mkWiredInDataConName UserSyntax gHC_INTEGER_TYPE (fsLit "Some") digitsSomeDataConKey digitsSomeDataCon
+digitsNoneDataConName = mkWiredInDataConName UserSyntax gHC_INTEGER_TYPE (fsLit "None") digitsNoneDataConKey digitsNoneDataCon
+
 parrTyConName, parrDataConName :: Name
 parrTyConName   = mkWiredInTyConName   BuiltInSyntax 
                     gHC_PARR' (fsLit "[::]") parrTyConKey parrTyCon 
@@ -424,6 +455,66 @@ stringTy = mkListTy charTy -- convenience only
 \end{code}
 
 \begin{code}
+integerTy :: Type
+integerTy = mkTyConTy integerTyCon
+
+integerTyCon :: TyCon
+integerTyCon = case cIntegerLibraryType of
+               IntegerGMP ->
+                   pcNonRecDataTyCon integerTyConName []
+                                     [integerGmpSDataCon, integerGmpJDataCon]
+               IntegerSimple ->
+                   pcNonRecDataTyCon integerTyConName []
+                                     [integerSimplePositiveDataCon,
+                                      integerSimpleNegativeDataCon,
+                                      integerSimpleNaughtDataCon]
+
+integerGmpSDataCon :: DataCon
+integerGmpSDataCon = pcDataCon integerGmpSDataConName []
+                               [intPrimTy]
+                               integerTyCon
+
+-- integerGmpJDataCon isn't exported, but we need to define it to fill
+-- out integerTyCon
+integerGmpJDataCon :: DataCon
+integerGmpJDataCon = pcDataCon integerGmpJDataConName []
+                               [intPrimTy, byteArrayPrimTy]
+                               integerTyCon
+
+integerSimplePositiveDataCon :: DataCon
+integerSimplePositiveDataCon = pcDataCon integerSimplePositiveDataConName []
+                                         [digitsTy]
+                                         integerTyCon
+
+integerSimpleNegativeDataCon :: DataCon
+integerSimpleNegativeDataCon = pcDataCon integerSimpleNegativeDataConName []
+                                         [digitsTy]
+                                         integerTyCon
+
+integerSimpleNaughtDataCon :: DataCon
+integerSimpleNaughtDataCon = pcDataCon integerSimpleNaughtDataConName []
+                                       []
+                                       integerTyCon
+
+digitsTy :: Type
+digitsTy = mkTyConTy digitsTyCon
+
+digitsTyCon :: TyCon
+digitsTyCon = pcNonRecDataTyCon digitsTyConName []
+                                [digitsSomeDataCon, digitsNoneDataCon]
+
+digitsSomeDataCon :: DataCon
+digitsSomeDataCon = pcDataCon digitsSomeDataConName []
+                              [wordPrimTy, digitsTy]
+                              digitsTyCon
+
+digitsNoneDataCon :: DataCon
+digitsNoneDataCon = pcDataCon digitsNoneDataConName []
+                              []
+                              digitsTyCon
+\end{code}
+
+\begin{code}
 intTy :: Type
 intTy = mkTyConTy intTyCon 
 
diff --git a/compiler/simplCore/OccurAnal.lhs b/compiler/simplCore/OccurAnal.lhs
index 2225f39956..8a5327ef5d 100644
--- a/compiler/simplCore/OccurAnal.lhs
+++ b/compiler/simplCore/OccurAnal.lhs
@@ -1052,7 +1052,7 @@ occAnal :: OccEnv
             CoreExpr)
 
 occAnal _   expr@(Type _) = (emptyDetails, 	   expr)
-occAnal _   expr@(Lit _)  = (emptyDetails, 	   expr)   
+occAnal _   expr@(Lit _)  = (emptyDetails, 	   expr)
 occAnal env expr@(Var v)  = (mkOneOcc env v False, expr)
     -- At one stage, I gathered the idRuleVars for v here too,
     -- which in a way is the right thing to do.
diff --git a/compiler/stgSyn/CoreToStg.lhs b/compiler/stgSyn/CoreToStg.lhs
index bd4e0ae6bd..d55943c1d5 100644
--- a/compiler/stgSyn/CoreToStg.lhs
+++ b/compiler/stgSyn/CoreToStg.lhs
@@ -29,6 +29,7 @@ import Maybes           ( maybeToBool )
 import Name             ( getOccName, isExternalName, nameOccName )
 import OccName          ( occNameString, occNameFS )
 import BasicTypes       ( Arity )
+import Literal
 import Module
 import Outputable
 import MonadUtils
@@ -312,6 +313,9 @@ on these components, but it in turn is not scrutinised as the basis for any
 decisions.  Hence no black holes.
 
 \begin{code}
+-- No LitInteger's should be left by the time this is called. CorePrep
+-- should have converted them all to a real core representation.
+coreToStgExpr (Lit (LitInteger _)) = panic "coreToStgExpr: LitInteger"
 coreToStgExpr (Lit l)      = return (StgLit l, emptyFVInfo, emptyVarSet)
 coreToStgExpr (Var v)      = coreToStgApp Nothing v               []
 coreToStgExpr (Coercion _) = coreToStgApp Nothing coercionTokenId []
diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs
index 1690079bba..66402b8976 100644
--- a/compiler/typecheck/Inst.lhs
+++ b/compiler/typecheck/Inst.lhs
@@ -54,6 +54,7 @@ import Var      ( Var, EvVar, varType, setVarType )
 import VarEnv
 import VarSet
 import PrelNames
+import TysWiredIn
 import SrcLoc
 import DynFlags
 import Bag