Improve the handling of Integer literals
authorIan Lynagh <igloo@earth.li>
Sat, 17 Sep 2011 17:29:12 +0000 (18:29 +0100)
committerIan Lynagh <igloo@earth.li>
Sat, 17 Sep 2011 19:42:53 +0000 (20:42 +0100)
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:
compiler/basicTypes/Literal.lhs
compiler/basicTypes/MkId.lhs
compiler/codeGen/CgUtils.hs
compiler/coreSyn/CoreLint.lhs
compiler/coreSyn/CorePrep.lhs
compiler/coreSyn/CoreUtils.lhs
compiler/coreSyn/MkCore.lhs
compiler/ghc.mk
compiler/ghci/ByteCodeGen.lhs
compiler/iface/TcIface.lhs
compiler/prelude/PrelNames.lhs
compiler/prelude/PrelRules.lhs
compiler/prelude/TysWiredIn.lhs
compiler/stgSyn/CoreToStg.lhs
compiler/typecheck/Inst.lhs

index ba8bc22..00b3770 100644 (file)
@@ -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)
index c8e5ab6..a35dbdf 100644 (file)
@@ -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}
 
 
index e01457a..a71702c 100644 (file)
@@ -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
index 851b843..4478a18 100644 (file)
@@ -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)
index 3b21e5f..e268cc2 100644 (file)
@@ -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
index be07119..221546d 100644 (file)
@@ -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
index 5335591..4375dd9 100644 (file)
@@ -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
index 735d0ec..24d14e7 100644 (file)
@@ -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'                   >> $@
index 8778933..66ad5a6 100644 (file)
@@ -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)
index bdf5838..fc0e257 100644 (file)
@@ -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
index 2334d05..0606c59 100644 (file)
@@ -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
index 502447d..e8467aa 100644 (file)
@@ -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
index 0fdc668..6b64ae7 100644 (file)
@@ -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}
index d55943c..1ebb564 100644 (file)
@@ -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 []
index 66402b8..1690079 100644 (file)
@@ -54,7 +54,6 @@ import Var      ( Var, EvVar, varType, setVarType )
 import VarEnv
 import VarSet
 import PrelNames
-import TysWiredIn
 import SrcLoc
 import DynFlags
 import Bag