Improve the handling of Integer literals

LitInteger now carries around the id of mkInteger, which it uses
to construct the core to build Integer literals. This way we don't
have to build in info about lots of Ids.

We also no longer have any special-casing for integer-simple, so
there is less code involved.

15 files changed, 95 insertions, 193 deletions

diff --git a/compiler/basicTypes/Literal.lhs b/compiler/basicTypes/Literal.lhs
index ba8bc22a0b..00b3770704 100644
--- a/compiler/basicTypes/Literal.lhs
+++ b/compiler/basicTypes/Literal.lhs
@@ -17,6 +17,7 @@ module Literal
         , mkMachInt64, mkMachWord64
         , mkMachFloat, mkMachDouble
         , mkMachChar, mkMachString
+        , mkLitInteger
 
         -- ** Operations on Literals
         , literalType
@@ -40,9 +41,10 @@ module Literal
 
 import TysPrim
 import PrelNames
-import TysWiredIn
 import Type
+import TypeRep
 import TyCon
+import Var
 import Outputable
 import FastTypes
 import FastString
@@ -108,10 +110,12 @@ data Literal
                                 --    @stdcall@ labels. @Just x@ => @\<x\>@ will
                                 --    be appended to label name when emitting assembly.
 
-  | LitInteger Integer
+  | LitInteger Integer Id
    -- ^ 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.
+   --   The Id is for mkInteger, which we use when finally creating the
+   --   core.
   deriving (Data, Typeable)
 \end{code}
 
@@ -133,7 +137,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
+    put_ bh (LitInteger i _) = do putByte bh 10; put_ bh i
     get bh = do
             h <- getByte bh
             case h of
@@ -170,7 +174,7 @@ instance Binary Literal where
                     return (MachLabel aj mb fod)
               _ -> do
                     i <- get bh
-                    return (LitInteger i)
+                    return $ mkLitInteger i (panic "Evaluated the place holder for mkInteger")
 \end{code}
 
 \begin{code}
@@ -235,6 +239,9 @@ mkMachChar = MachChar
 mkMachString :: String -> Literal
 mkMachString s = MachStr (mkFastString s) -- stored UTF-8 encoded
 
+mkLitInteger :: Integer -> Id -> Literal
+mkLitInteger = LitInteger
+
 inIntRange, inWordRange :: Integer -> Bool
 inIntRange  x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT
 inWordRange x = x >= 0              && x <= tARGET_MAX_WORD
@@ -318,17 +325,17 @@ nullAddrLit = MachNullAddr
 -- False principally of strings
 litIsTrivial :: Literal -> Bool
 --      c.f. CoreUtils.exprIsTrivial
-litIsTrivial (MachStr _)    = False
-litIsTrivial (LitInteger _) = 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 (LitInteger i) = inIntRange i
-litIsDupable _              = True
+litIsDupable (MachStr _)      = False
+litIsDupable (LitInteger i _) = inIntRange i
+litIsDupable _                = True
 
 litFitsInChar :: Literal -> Bool
 litFitsInChar (MachInt i)
@@ -352,7 +359,12 @@ literalType (MachWord64  _) = word64PrimTy
 literalType (MachFloat _)   = floatPrimTy
 literalType (MachDouble _)  = doublePrimTy
 literalType (MachLabel _ _ _) = addrPrimTy
-literalType (LitInteger _)    = integerTy
+literalType (LitInteger _ mkIntegerId)
+      -- We really mean idType, rather than varType, but importing Id
+      -- causes a module import loop
+    = case varType mkIntegerId of
+      FunTy _ (FunTy _ integerTy) -> integerTy
+      _ -> panic "literalType: mkIntegerId has the wrong type"
 
 absentLiteralOf :: TyCon -> Maybe Literal
 -- Return a literal of the appropriate primtive
@@ -385,7 +397,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 (LitInteger    a _) (LitInteger     b _) = a `compare` b
 cmpLit lit1                lit2                 | litTag lit1 <# litTag lit2 = LT
                                                 | otherwise                  = GT
 
@@ -400,7 +412,7 @@ litTag (MachWord64    _)   = _ILIT(7)
 litTag (MachFloat     _)   = _ILIT(8)
 litTag (MachDouble    _)   = _ILIT(9)
 litTag (MachLabel _ _ _)   = _ILIT(10)
-litTag (LitInteger    _)   = _ILIT(11)
+litTag (LitInteger  {})    = _ILIT(11)
 \end{code}
 
         Printing
@@ -423,7 +435,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
+pprLit (LitInteger i _) = ptext (sLit "__integer") <+> integer i
 
 pprIntVal :: Integer -> SDoc
 -- ^ Print negative integers with parens to be sure it's unambiguous
@@ -453,7 +465,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
+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 c8e5ab69e0..a35dbdf8fd 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -28,18 +28,6 @@ module MkId (
         voidArgId, nullAddrId, seqId, lazyId, lazyIdKey,
         coercionTokenId,
 
-        -- integer-simple only Id's:
-        integerSimpleNaughtId,
-        integerSimplePositiveId,
-        integerSimpleNegativeId,
-        digitsNoneId,
-        digitsSomeId,
-
-        -- Common Integer Id's:
-        shiftLIntegerId,
-        negateIntegerId,
-        orIntegerId,
-
 	-- Re-export error Ids
 	module PrelRules
     ) where
@@ -1057,38 +1045,6 @@ coercionTokenId -- Used to replace Coercion terms when we go to STG
   = pcMiscPrelId coercionTokenName 
                  (mkTyConApp eqPrimTyCon [unitTy, unitTy])
                  noCafIdInfo
-
--- 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 = mkVanillaGlobalWithInfo shiftLIntegerName
-                     (mkFunTy integerTy (mkFunTy intPrimTy integerTy))
-	             noCafIdInfo
--- ToDo: we should not really be relying on noCafInfo here.
--- What if it's wrong?!
-
-negateIntegerId :: Id
-negateIntegerId = mkVanillaGlobalWithInfo negateIntegerName
-                     (mkFunTy integerTy integerTy)
-                     noCafIdInfo
-
-orIntegerId :: Id
-orIntegerId = mkVanillaGlobalWithInfo orIntegerName
-                     (mkFunTy integerTy (mkFunTy integerTy integerTy))
-                     noCafIdInfo
 \end{code}
 
 
diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index e01457ae99..a71702cb4c 100644
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -110,7 +110,7 @@ mkSimpleLit (MachLabel fs ms fod)
 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"
+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 851b84380f..4478a18ff1 100644
--- a/compiler/coreSyn/CoreLint.lhs
+++ b/compiler/coreSyn/CoreLint.lhs
@@ -34,6 +34,7 @@ import Kind
 import Type
 import TypeRep
 import TyCon
+import TcType
 import BasicTypes
 import StaticFlags
 import ListSetOps
@@ -512,7 +513,7 @@ lintCoreAlt _ alt_ty (DEFAULT, args, rhs) =
      ; checkAltExpr rhs alt_ty }
 
 lintCoreAlt scrut_ty alt_ty (LitAlt lit, args, rhs)
-  | integerTy `eqType` scrut_ty
+  | isIntegerTy scrut_ty
     = failWithL integerScrutinisedMsg
   | otherwise
     = do { checkL (null args) (mkDefaultArgsMsg args)
diff --git a/compiler/coreSyn/CorePrep.lhs b/compiler/coreSyn/CorePrep.lhs
index 3b21e5f021..e268cc20f5 100644
--- a/compiler/coreSyn/CorePrep.lhs
+++ b/compiler/coreSyn/CorePrep.lhs
@@ -18,6 +18,7 @@ import CoreFVs
 import CoreMonad	( endPass, CoreToDo(..) )
 import CoreSyn
 import CoreSubst
+import MkCore
 import OccurAnal        ( occurAnalyseExpr )
 import Type
 import Literal
@@ -29,7 +30,6 @@ import VarSet
 import VarEnv
 import Id
 import IdInfo
-import MkId
 import TysWiredIn
 import DataCon
 import PrimOp
@@ -47,7 +47,6 @@ import FastString
 import Config
 import Data.Bits
 import Data.List	( mapAccumL )
-import Data.Word
 import Control.Monad
 \end{code}
 
@@ -452,7 +451,8 @@ 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)) = cpeRhsE env (cvtLitInteger i)
+cpeRhsE env (Lit (LitInteger i mkIntegerId))
+    = cpeRhsE env (cvtLitInteger i mkIntegerId)
 cpeRhsE _env expr@(Lit {})       = return (emptyFloats, expr)
 cpeRhsE env expr@(Var {})        = cpeApp env expr
 
@@ -502,45 +502,25 @@ cpeRhsE env (Case scrut bndr ty alts)
             ; rhs' <- cpeBodyNF env2 rhs
             ; return (con, bs', rhs') }
 
-cvtLitInteger :: Integer -> CoreExpr
+cvtLitInteger :: Integer -> Id -> CoreExpr
 -- Here we convert a literal Integer to the low-level
 -- represenation. Exactly how we do this depends on the
 -- library that implements Integer.  If it's GMP we 
 -- use the S# data constructor for small literals.  
-cvtLitInteger i
-  = case cIntegerLibraryType of
-      IntegerGMP 
-        | inIntRange i -> mkSmallInteger i
-        | i < 0        -> negateInteger (f (negate i))
-        | otherwise    -> f i
-        where
-          mkSmallInteger x = mkConApp integerGmpSDataCon [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
-
-      IntegerSimple
-        -> case i `compare` 0 of
-             EQ -> Var integerSimpleNaughtId
-             GT -> App (Var integerSimplePositiveId) (f i)
-             LT -> App (Var integerSimpleNegativeId) (f (negate i))
-        where
-          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]
+cvtLitInteger i mkIntegerId
+  | cIntegerLibraryType == IntegerGMP && inIntRange i
+    = mkConApp integerGmpSDataCon [Lit (mkMachInt i)]
+  | otherwise
+    = mkApps (Var mkIntegerId) [isNonNegative, ints]
+  where isNonNegative = if i < 0 then mkConApp falseDataCon []
+                                 else mkConApp trueDataCon  []
+        ints = mkListExpr intTy (f (abs i))
+        f 0 = []
+        f x = let low  = x .&. mask
+                  high = x `shiftR` bits
+              in mkConApp intDataCon [Lit (mkMachInt low)] : f high
+        bits = 31
+        mask = 2 ^ bits - 1
 
 -- ---------------------------------------------------------------------------
 --		CpeBody: produces a result satisfying CpeBody
diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
index be071191a2..221546d291 100644
--- a/compiler/coreSyn/CoreUtils.lhs
+++ b/compiler/coreSyn/CoreUtils.lhs
@@ -1539,7 +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 (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 53355910d3..4375dd9b97 100644
--- a/compiler/coreSyn/MkCore.lhs
+++ b/compiler/coreSyn/MkCore.lhs
@@ -218,8 +218,9 @@ mkWordExprWord :: Word       -> CoreExpr
 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 = return (Lit (LitInteger i))
+mkIntegerExpr  :: MonadThings m => Integer -> m CoreExpr  -- Result :: Integer
+mkIntegerExpr i = do mkIntegerId <- lookupId mkIntegerName
+                     return (Lit (mkLitInteger i mkIntegerId))
 
 -- | Create a 'CoreExpr' which will evaluate to the given @Float@
 mkFloatExpr :: Float -> CoreExpr
diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index 735d0ec183..24d14e7846 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -52,6 +52,7 @@ compiler/stage%/build/Config.hs : mk/config.mk mk/project.mk | $$(dir $$@)/.
 	@echo '#include "ghc_boot_platform.h"'                              >> $@
 	@echo                                                               >> $@
 	@echo 'data IntegerLibrary = IntegerGMP | IntegerSimple'            >> $@
+	@echo '    deriving Eq'                                             >> $@
 	@echo                                                               >> $@
 	@echo 'cBuildPlatformString :: String'                              >> $@
 	@echo 'cBuildPlatformString = BuildPlatform_NAME'                   >> $@
diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs
index 8778933bdb..66ad5a636c 100644
--- a/compiler/ghci/ByteCodeGen.lhs
+++ b/compiler/ghci/ByteCodeGen.lhs
@@ -1244,7 +1244,7 @@ pushAtom _ _ (AnnLit lit)
         -- 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"
+        LitInteger {} -> panic "pushAtom: LitInteger"
      where
         code rep
            = let size_host_words = fromIntegral (cgRepSizeW rep)
diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index bdf5838ff5..fc0e2573bb 100644
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -39,9 +39,11 @@ import Class
 import IParam
 import TyCon
 import DataCon
+import PrelNames
 import TysWiredIn
 import TysPrim          ( anyTyConOfKind )
 import BasicTypes       ( Arity, strongLoopBreaker )
+import Literal
 import qualified Var
 import VarEnv
 import VarSet
@@ -895,6 +897,10 @@ tcIfaceExpr (IfaceExt gbl)
 tcIfaceExpr (IfaceTupId boxity arity)
   = return $ Var (dataConWorkId (tupleCon boxity arity))
 
+tcIfaceExpr (IfaceLit (LitInteger i _))
+  = do mkIntegerId <- tcIfaceExtId mkIntegerName
+       return (Lit (mkLitInteger i mkIntegerId))
+
 tcIfaceExpr (IfaceLit lit)
   = return (Lit lit)
 
@@ -981,8 +987,14 @@ tcIfaceAlt _ _ (IfaceDefault, names, rhs)
   
 tcIfaceAlt _ _ (IfaceLitAlt lit, names, rhs)
   = ASSERT( null names ) do
+    lit' <- case lit of
+            LitInteger i _ ->
+                do mkIntegerId <- tcIfaceExtId mkIntegerName
+                   return (mkLitInteger i mkIntegerId)
+            _ ->
+                return lit
     rhs' <- tcIfaceExpr rhs
-    return (LitAlt lit, [], rhs')
+    return (LitAlt lit', [], rhs')
 
 -- A case alternative is made quite a bit more complicated
 -- by the fact that we omit type annotations because we can
diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index 2334d0519a..0606c59673 100644
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -117,6 +117,7 @@ basicKnownKeyNames
         stringTyConName,
         ratioDataConName,
         ratioTyConName,
+        integerTyConName,
 
         --  Classes.  *Must* include:
         --      classes that are grabbed by key (e.g., eqClassKey)
@@ -205,6 +206,7 @@ basicKnownKeyNames
         printName, fstName, sndName,
 
         -- Integer
+        integerTyConName, mkIntegerName,
         plusIntegerName, timesIntegerName, smallIntegerName,
         integerToWordName, integerToIntName, minusIntegerName,
         negateIntegerName, eqIntegerName, neqIntegerName,
@@ -786,7 +788,8 @@ fromIntegerName   = methName gHC_NUM (fsLit "fromInteger") fromIntegerClassOpKey
 minusName         = methName gHC_NUM (fsLit "-") minusClassOpKey
 negateName        = methName gHC_NUM (fsLit "negate") negateClassOpKey
 
-plusIntegerName, timesIntegerName, smallIntegerName,
+integerTyConName, mkIntegerName,
+    plusIntegerName, timesIntegerName, smallIntegerName,
     integerToWordName, integerToIntName, minusIntegerName,
     negateIntegerName, eqIntegerName, neqIntegerName,
     absIntegerName, signumIntegerName,
@@ -795,6 +798,8 @@ plusIntegerName, timesIntegerName, smallIntegerName,
     gcdIntegerName, lcmIntegerName,
     andIntegerName, orIntegerName, xorIntegerName, complementIntegerName,
     shiftLIntegerName, shiftRIntegerName :: Name
+integerTyConName      = tcQual  gHC_INTEGER_TYPE (fsLit "Integer")           integerTyConKey
+mkIntegerName         = varQual gHC_INTEGER_TYPE (fsLit "mkInteger")         mkIntegerIdKey
 plusIntegerName       = varQual gHC_INTEGER_TYPE (fsLit "plusInteger")       plusIntegerIdKey
 timesIntegerName      = varQual gHC_INTEGER_TYPE (fsLit "timesInteger")      timesIntegerIdKey
 smallIntegerName      = varQual gHC_INTEGER_TYPE (fsLit "smallInteger")      smallIntegerIdKey
@@ -1355,17 +1360,6 @@ gtDataConKey                            = mkPreludeDataConUnique 29
 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}
 
 %************************************************************************
@@ -1434,7 +1428,7 @@ smallIntegerIdKey, integerToWordIdKey, integerToIntIdKey,
     compareIntegerIdKey,
     gcdIntegerIdKey, lcmIntegerIdKey,
     andIntegerIdKey, orIntegerIdKey, xorIntegerIdKey, complementIntegerIdKey,
-    shiftLIntegerIdKey, shiftRIntegerIdKey :: Unique
+    shiftLIntegerIdKey, shiftRIntegerIdKey, mkIntegerIdKey :: Unique
 smallIntegerIdKey             = mkPreludeMiscIdUnique 60
 integerToWordIdKey            = mkPreludeMiscIdUnique 61
 integerToIntIdKey             = mkPreludeMiscIdUnique 62
@@ -1459,6 +1453,7 @@ xorIntegerIdKey               = mkPreludeMiscIdUnique 89
 complementIntegerIdKey        = mkPreludeMiscIdUnique 90
 shiftLIntegerIdKey            = mkPreludeMiscIdUnique 91
 shiftRIntegerIdKey            = mkPreludeMiscIdUnique 92
+mkIntegerIdKey                = mkPreludeMiscIdUnique 93
 
 rootMainKey, runMainKey :: Unique
 rootMainKey                   = mkPreludeMiscIdUnique 100
diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs
index 502447d17d..e8467aa27d 100644
--- a/compiler/prelude/PrelRules.lhs
+++ b/compiler/prelude/PrelRules.lhs
@@ -726,7 +726,7 @@ match_Integer_convert :: Num a
                       -> IdUnfoldingFun
                       -> [Expr CoreBndr]
                       -> Maybe (Expr CoreBndr)
-match_Integer_convert convert _ [Lit (LitInteger x)]
+match_Integer_convert convert _ [Lit (LitInteger x _)]
     = Just (convert (fromIntegral x))
 match_Integer_convert _ _ _ = Nothing
 
@@ -734,31 +734,31 @@ match_Integer_unop :: (Integer -> Integer)
                    -> IdUnfoldingFun
                    -> [Expr CoreBndr]
                    -> Maybe (Expr CoreBndr)
-match_Integer_unop unop _ [Lit (LitInteger x)]
-    = Just (Lit (LitInteger (unop x)))
+match_Integer_unop unop _ [Lit (LitInteger x i)]
+    = Just (Lit (LitInteger (unop x) i))
 match_Integer_unop _ _ _ = Nothing
 
 match_Integer_binop :: (Integer -> Integer -> Integer)
                     -> IdUnfoldingFun
                     -> [Expr CoreBndr]
                     -> Maybe (Expr CoreBndr)
-match_Integer_binop binop _ [Lit (LitInteger x), Lit (LitInteger y)]
-    = Just (Lit (LitInteger (x `binop` y)))
+match_Integer_binop binop _ [Lit (LitInteger x i), Lit (LitInteger y _)]
+    = Just (Lit (LitInteger (x `binop` y) i))
 match_Integer_binop _ _ _ = Nothing
 
 match_Integer_Int_binop :: (Integer -> Int -> Integer)
                         -> IdUnfoldingFun
                         -> [Expr CoreBndr]
                         -> Maybe (Expr CoreBndr)
-match_Integer_Int_binop binop _ [Lit (LitInteger x), Lit (MachInt y)]
-    = Just (Lit (LitInteger (x `binop` fromIntegral y)))
+match_Integer_Int_binop binop _ [Lit (LitInteger x i), Lit (MachInt y)]
+    = Just (Lit (LitInteger (x `binop` fromIntegral y) i))
 match_Integer_Int_binop _ _ _ = Nothing
 
 match_Integer_binop_Bool :: (Integer -> Integer -> Bool)
                          -> IdUnfoldingFun
                          -> [Expr CoreBndr]
                          -> Maybe (Expr CoreBndr)
-match_Integer_binop_Bool binop _ [Lit (LitInteger x), Lit (LitInteger y)]
+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
 
@@ -766,7 +766,7 @@ match_Integer_binop_Ordering :: (Integer -> Integer -> Ordering)
                              -> IdUnfoldingFun
                              -> [Expr CoreBndr]
                              -> Maybe (Expr CoreBndr)
-match_Integer_binop_Ordering binop _ [Lit (LitInteger x), Lit (LitInteger y)]
+match_Integer_binop_Ordering binop _ [Lit (LitInteger x _), Lit (LitInteger y _)]
     = Just $ case x `binop` y of
              LT -> ltVal
              EQ -> eqVal
diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs
index 0fdc66839b..6b64ae7f7d 100644
--- a/compiler/prelude/TysWiredIn.lhs
+++ b/compiler/prelude/TysWiredIn.lhs
@@ -24,17 +24,9 @@ module TysWiredIn (
 	charTyCon, charDataCon, charTyCon_RDR,
 	charTy, stringTy, charTyConName,
 
-        -- * Integer
-        integerTy, integerTyConName,
-
         -- integer-gmp only:
         integerGmpSDataCon,
 
-        -- integer-simple only:
-        integerSimpleNaughtDataConName,
-        integerSimplePositiveDataConName, integerSimpleNegativeDataConName,
-        digitsTy, digitsSomeDataConName, digitsNoneDataConName,
-
 	-- * Double
 	doubleTyCon, doubleDataCon, doubleTy, doubleTyConName, 
 	
@@ -144,12 +136,13 @@ wiredInTyCons = [ unitTyCon	-- Not treated like other tuples, because
     	      , doubleTyCon
     	      , floatTyCon
     	      , intTyCon
-    	      , integerTyCon
-    	      , digitsTyCon
     	      , listTyCon
 	      , parrTyCon
               , eqTyCon
     	      ]
+           ++ (case cIntegerLibraryType of
+               IntegerGMP -> [integerTyCon]
+               _ -> [])
 \end{code}
 
 \begin{code}
@@ -191,24 +184,14 @@ 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:
+integerRealTyConName :: Name
+integerRealTyConName    = case cIntegerLibraryType of
+                          IntegerGMP -> mkWiredInTyConName   UserSyntax gHC_INTEGER_TYPE (fsLit "Integer") integerTyConKey integerTyCon
+                          _ ->          panic "integerRealTyConName evaluated, but not integer-gmp"
 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 
@@ -457,19 +440,13 @@ stringTy = mkListTy charTy -- convenience only
 \end{code}
 
 \begin{code}
-integerTy :: Type
-integerTy = mkTyConTy integerTyCon
-
 integerTyCon :: TyCon
 integerTyCon = case cIntegerLibraryType of
                IntegerGMP ->
-                   pcNonRecDataTyCon integerTyConName []
+                   pcNonRecDataTyCon integerRealTyConName []
                                      [integerGmpSDataCon, integerGmpJDataCon]
-               IntegerSimple ->
-                   pcNonRecDataTyCon integerTyConName []
-                                     [integerSimplePositiveDataCon,
-                                      integerSimpleNegativeDataCon,
-                                      integerSimpleNaughtDataCon]
+               _ ->
+                   panic "Evaluated integerTyCon, but not using IntegerGMP"
 
 integerGmpSDataCon :: DataCon
 integerGmpSDataCon = pcDataCon integerGmpSDataConName []
@@ -482,38 +459,6 @@ 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}
diff --git a/compiler/stgSyn/CoreToStg.lhs b/compiler/stgSyn/CoreToStg.lhs
index d55943c1d5..1ebb564928 100644
--- a/compiler/stgSyn/CoreToStg.lhs
+++ b/compiler/stgSyn/CoreToStg.lhs
@@ -315,7 +315,7 @@ 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 (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 66402b8976..1690079bba 100644
--- a/compiler/typecheck/Inst.lhs
+++ b/compiler/typecheck/Inst.lhs
@@ -54,7 +54,6 @@ import Var      ( Var, EvVar, varType, setVarType )
 import VarEnv
 import VarSet
 import PrelNames
-import TysWiredIn
 import SrcLoc
 import DynFlags
 import Bag