Put the Integer type, rather than the mkIntegerId, inside LitInteger
authorIan Lynagh <igloo@earth.li>
Wed, 6 Jun 2012 19:16:48 +0000 (20:16 +0100)
committerIan Lynagh <igloo@earth.li>
Wed, 6 Jun 2012 19:58:28 +0000 (20:58 +0100)
This will make it possible to write PrelRules that produce an Integer
result without having Integer arguments.

compiler/basicTypes/Literal.lhs
compiler/coreSyn/CorePrep.lhs
compiler/coreSyn/MkCore.lhs
compiler/iface/TcIface.lhs
compiler/main/HscMain.hs
compiler/main/TidyPgm.lhs
compiler/prelude/PrelRules.lhs
compiler/simplCore/CoreMonad.lhs
compiler/typecheck/TcRnMonad.lhs

index e29b49a..fe36b9d 100644 (file)
@@ -52,9 +52,7 @@ module Literal
 import TysPrim
 import PrelNames
 import Type
-import TypeRep
 import TyCon
-import Var
 import Outputable
 import FastTypes
 import FastString
@@ -122,32 +120,27 @@ data Literal
                                 --    @stdcall@ labels. @Just x@ => @\<x\>@ will
                                 --    be appended to label name when emitting assembly.
 
-  | LitInteger Integer Id      --  ^ Integer literals
-                               -- See Note [Integer literals]
+  | LitInteger Integer Type --  ^ Integer literals
+                            -- See Note [Integer literals]
   deriving (Data, Typeable)
 \end{code}
 
 Note [Integer literals]
 ~~~~~~~~~~~~~~~~~~~~~~~
 An Integer literal is represented using, well, an Integer, to make it
-easier to write RULEs for them. 
+easier to write RULEs for them. They also contain the Integer type, so
+that e.g. literalType can return the right Type for them.
 
- * The Id is for mkInteger, which we use when finally creating the core.
+They only get converted into real Core,
+    mkInteger [c1, c2, .., cn]
+during the CorePrep phase, although TidyPgm looks ahead at what the
+core will be, so that it can see whether it involves CAFs.
 
- * They only get converted into real Core,
-      mkInteger [c1, c2, .., cn]
-   during the CorePrep phase.
-
- * When we initally build an Integer literal, notably when
-   deserialising it from an interface file (see the Binary instance
-   below), we don't have convenient access to the mkInteger Id.  So we
-   just use an error thunk, and fill in the real Id when we do tcIfaceLit
-   in TcIface.
-
- * When looking for CAF-hood (in TidyPgm), we must take account of the
-   CAF-hood of the mk_integer field in LitInteger; see TidyPgm.cafRefsL.
-   Indeed this is the only reason we put the mk_integer field in the 
-   literal -- otherwise we could just look it up in CorePrep.
+When we initally build an Integer literal, notably when
+deserialising it from an interface file (see the Binary instance
+below), we don't have convenient access to the mkInteger Id.  So we
+just use an error thunk, and fill in the real Id when we do tcIfaceLit
+in TcIface.
 
 
 Binary instance
@@ -205,8 +198,8 @@ instance Binary Literal where
                     return (MachLabel aj mb fod)
               _ -> do
                     i <- get bh
+                    -- See Note [Integer literals]
                     return $ mkLitInteger i (panic "Evaluated the place holder for mkInteger")
-                          -- See Note [Integer literals] in Literal
 \end{code}
 
 \begin{code}
@@ -267,7 +260,7 @@ mkMachChar = MachChar
 mkMachString :: String -> Literal
 mkMachString s = MachStr (mkFastString s) -- stored UTF-8 encoded
 
-mkLitInteger :: Integer -> Id -> Literal
+mkLitInteger :: Integer -> Type -> Literal
 mkLitInteger = LitInteger
 
 inIntRange, inWordRange :: Integer -> Bool
@@ -391,12 +384,7 @@ literalType (MachWord64  _) = word64PrimTy
 literalType (MachFloat _)   = floatPrimTy
 literalType (MachDouble _)  = doublePrimTy
 literalType (MachLabel _ _ _) = addrPrimTy
-literalType (LitInteger _ mk_integer_id)
-      -- We really mean idType, rather than varType, but importing Id
-      -- causes a module import loop
-    = case varType mk_integer_id of
-        FunTy _ (FunTy _ integerTy) -> integerTy
-        _ -> panic "literalType: mkIntegerId has the wrong type"
+literalType (LitInteger _ t) = t
 
 absentLiteralOf :: TyCon -> Maybe Literal
 -- Return a literal of the appropriate primtive
index 55c78b8..7680bab 100644 (file)
@@ -8,11 +8,12 @@ Core pass to saturate constructors and PrimOps
 {-# LANGUAGE BangPatterns #-}
 
 module CorePrep (
-      corePrepPgm, corePrepExpr
+      corePrepPgm, corePrepExpr, cvtLitInteger
   ) where
 
 #include "HsVersions.h"
 
+import HscTypes
 import PrelNames
 import CoreUtils
 import CoreArity
@@ -24,6 +25,8 @@ import MkCore hiding( FloatBind(..) )   -- We use our own FloatBind here
 import Type
 import Literal
 import Coercion
+import TcEnv
+import TcRnMonad
 import TyCon
 import Demand
 import Var
@@ -43,7 +46,6 @@ import DynFlags
 import Util
 import Pair
 import Outputable
-import MonadUtils
 import FastString
 import Config
 import Data.Bits
@@ -100,8 +102,8 @@ The goal of this pass is to prepare for code generation.
 
 9.  Replace (lazy e) by e.  See Note [lazyId magic] in MkId.lhs
 
-10. Convert (LitInteger i mkInteger) into the core representation
-    for the Integer i. Normally this uses the mkInteger Id, but if
+10. Convert (LitInteger i t) into the core representation
+    for the Integer i. Normally this uses mkInteger, but if
     we are using the integer-gmp implementation then there is a
     special case where we use the S# constructor for Integers that
     are in the range of Int.
@@ -150,35 +152,37 @@ type CpeRhs  = CoreExpr    -- Non-terminal 'rhs'
 %************************************************************************
 
 \begin{code}
-corePrepPgm :: DynFlags -> CoreProgram -> [TyCon] -> IO CoreProgram
-corePrepPgm dflags binds data_tycons = do
+corePrepPgm :: DynFlags -> HscEnv -> CoreProgram -> [TyCon] -> IO CoreProgram
+corePrepPgm dflags hsc_env binds data_tycons = do
     showPass dflags "CorePrep"
     us <- mkSplitUniqSupply 's'
+    initialCorePrepEnv <- mkInitialCorePrepEnv hsc_env
 
     let implicit_binds = mkDataConWorkers data_tycons
             -- NB: we must feed mkImplicitBinds through corePrep too
             -- so that they are suitably cloned and eta-expanded
 
         binds_out = initUs_ us $ do
-                      floats1 <- corePrepTopBinds binds
-                      floats2 <- corePrepTopBinds implicit_binds
+                      floats1 <- corePrepTopBinds initialCorePrepEnv binds
+                      floats2 <- corePrepTopBinds initialCorePrepEnv implicit_binds
                       return (deFloatTop (floats1 `appendFloats` floats2))
 
     endPass dflags CorePrep binds_out []
     return binds_out
 
-corePrepExpr :: DynFlags -> CoreExpr -> IO CoreExpr
-corePrepExpr dflags expr = do
+corePrepExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr
+corePrepExpr dflags hsc_env expr = do
     showPass dflags "CorePrep"
     us <- mkSplitUniqSupply 's'
-    let new_expr = initUs_ us (cpeBodyNF emptyCorePrepEnv expr)
+    initialCorePrepEnv <- mkInitialCorePrepEnv hsc_env
+    let new_expr = initUs_ us (cpeBodyNF initialCorePrepEnv expr)
     dumpIfSet_dyn dflags Opt_D_dump_prep "CorePrep" (ppr new_expr)
     return new_expr
 
-corePrepTopBinds :: [CoreBind] -> UniqSM Floats
+corePrepTopBinds :: CorePrepEnv -> [CoreBind] -> UniqSM Floats
 -- Note [Floating out of top level bindings]
-corePrepTopBinds binds
-  = go emptyCorePrepEnv binds
+corePrepTopBinds initialCorePrepEnv binds
+  = go initialCorePrepEnv binds
   where
     go _   []             = return emptyFloats
     go env (bind : binds) = do (env', bind') <- cpeBind TopLevel env bind
@@ -463,8 +467,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 mk_integer))
-    = cpeRhsE env (cvtLitInteger i mk_integer)
+cpeRhsE env (Lit (LitInteger i _))
+    = cpeRhsE env (cvtLitInteger (getMkIntegerId env) i)
 cpeRhsE _env expr@(Lit {})       = return (emptyFloats, expr)
 cpeRhsE env expr@(Var {})        = cpeApp env expr
 
@@ -514,13 +518,13 @@ cpeRhsE env (Case scrut bndr ty alts)
             ; rhs' <- cpeBodyNF env2 rhs
             ; return (con, bs', rhs') }
 
-cvtLitInteger :: Integer -> Id -> CoreExpr
+cvtLitInteger :: Id -> Integer -> 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.
 -- See Note [Integer literals] in Literal
-cvtLitInteger i mk_integer
+cvtLitInteger mk_integer i
   | cIntegerLibraryType == IntegerGMP
   , inIntRange i       -- Special case for small integers in GMP
     = mkConApp integerGmpSDataCon [Lit (mkMachInt i)]
@@ -1144,23 +1148,32 @@ allLazyNested is_rec (Floats IfUnboxedOk _) = isNonRec is_rec
 --                      The environment
 -- ---------------------------------------------------------------------------
 
-data CorePrepEnv = CPE (IdEnv Id)       -- Clone local Ids
+data CorePrepEnv = CPE (IdEnv Id) -- Clone local Ids
+                       Id         -- mkIntegerId
 
-emptyCorePrepEnv :: CorePrepEnv
-emptyCorePrepEnv = CPE emptyVarEnv
+mkInitialCorePrepEnv :: HscEnv -> IO CorePrepEnv
+mkInitialCorePrepEnv hsc_env
+    = do mkIntegerId <- liftM tyThingId
+                      $ initTcForLookup hsc_env (tcLookupGlobal mkIntegerName)
+         return $ CPE emptyVarEnv mkIntegerId
 
 extendCorePrepEnv :: CorePrepEnv -> Id -> Id -> CorePrepEnv
-extendCorePrepEnv (CPE env) id id' = CPE (extendVarEnv env id id')
+extendCorePrepEnv (CPE env mkIntegerId) id id'
+    = CPE (extendVarEnv env id id') mkIntegerId
 
 extendCorePrepEnvList :: CorePrepEnv -> [(Id,Id)] -> CorePrepEnv
-extendCorePrepEnvList (CPE env) prs = CPE (extendVarEnvList env prs)
+extendCorePrepEnvList (CPE env mkIntegerId) prs
+    = CPE (extendVarEnvList env prs) mkIntegerId
 
 lookupCorePrepEnv :: CorePrepEnv -> Id -> Id
-lookupCorePrepEnv (CPE env) id
+lookupCorePrepEnv (CPE env _) id
   = case lookupVarEnv env id of
         Nothing  -> id
         Just id' -> id'
 
+getMkIntegerId :: CorePrepEnv -> Id
+getMkIntegerId (CPE _ mkIntegerId) = mkIntegerId
+
 ------------------------------------------------------------------------------
 -- Cloning binders
 -- ---------------------------------------------------------------------------
index 3597df5..25dfaab 100644 (file)
@@ -257,8 +257,8 @@ 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 = do mkIntegerId <- lookupId mkIntegerName
-                     return (Lit (mkLitInteger i mkIntegerId))
+mkIntegerExpr i = do t <- lookupTyCon integerTyConName
+                     return (Lit (mkLitInteger i (mkTyConTy t)))
 
 -- | Create a 'CoreExpr' which will evaluate to the given @Float@
 mkFloatExpr :: Float -> CoreExpr
index e7360dc..6a5e423 100644 (file)
@@ -997,7 +997,7 @@ tcIfaceExpr (IfaceExt gbl)
 tcIfaceExpr (IfaceLit lit)
   = do lit' <- tcIfaceLit lit
        return (Lit lit')
-
 tcIfaceExpr (IfaceFCall cc ty) = do
     ty' <- tcIfaceType ty
     u <- newUnique
@@ -1081,12 +1081,12 @@ tcIfaceTickish (IfaceSCC  cc tick push) = return (ProfNote cc tick push)
 
 -------------------------
 tcIfaceLit :: Literal -> IfL Literal
--- Integer literals deserialise to (LitInteeger i <error thunk>) 
--- so tcIfaceLit just fills in the mkInteger Id 
+-- Integer literals deserialise to (LitInteger i <error thunk>) 
+-- so tcIfaceLit just fills in the type.
 -- See Note [Integer literals] in Literal
 tcIfaceLit (LitInteger i _)
-  = do mkIntegerId <- tcIfaceExtId mkIntegerName
-       return (mkLitInteger i mkIntegerId)
+  = do t <- tcIfaceTyCon (IfaceTc integerTyConName)
+       return (mkLitInteger i (mkTyConTy t))
 tcIfaceLit lit = return lit
 
 -------------------------
index 78e24c9..ba4bfbc 100644 (file)
@@ -1259,7 +1259,7 @@ hscGenHardCode cgguts mod_summary = do
         -- PREPARE FOR CODE GENERATION
         -- Do saturation and convert to A-normal form
         prepd_binds <- {-# SCC "CorePrep" #-}
-                       corePrepPgm dflags core_binds data_tycons ;
+                       corePrepPgm dflags hsc_env core_binds data_tycons ;
         -----------------  Convert to STG ------------------
         (stg_binds, cost_centre_info)
             <- {-# SCC "CoreToStg" #-}
@@ -1312,8 +1312,9 @@ hscInteractive (iface, details, cgguts) mod_summary = do
     -------------------
     -- PREPARE FOR CODE GENERATION
     -- Do saturation and convert to A-normal form
+    hsc_env <- getHscEnv
     prepd_binds <- {-# SCC "CorePrep" #-}
-                   liftIO $ corePrepPgm dflags core_binds data_tycons ;
+                   liftIO $ corePrepPgm dflags hsc_env core_binds data_tycons
     -----------------  Generate byte code ------------------
     comp_bc <- liftIO $ byteCodeGen dflags this_mod prepd_binds
                                     data_tycons mod_breaks
@@ -1498,7 +1499,7 @@ hscDeclsWithLocation hsc_env0 str source linenumber =
     {- Prepare For Code Generation -}
     -- Do saturation and convert to A-normal form
     prepd_binds <- {-# SCC "CorePrep" #-}
-                    liftIO $ corePrepPgm dflags core_binds data_tycons
+                    liftIO $ corePrepPgm dflags hsc_env core_binds data_tycons
 
     {- Generate byte code -}
     cbc <- liftIO $ byteCodeGen dflags this_mod
@@ -1675,7 +1676,7 @@ hscCompileCoreExpr hsc_env srcspan ds_expr
         let tidy_expr = tidyExpr emptyTidyEnv simpl_expr
 
         {- Prepare for codegen -}
-        prepd_expr <- corePrepExpr dflags tidy_expr
+        prepd_expr <- corePrepExpr dflags hsc_env tidy_expr
 
         {- Lint if necessary -}
         -- ToDo: improve SrcLoc
index 288ca41..6caae2d 100644 (file)
@@ -17,6 +17,7 @@ import CoreUnfold
 import CoreFVs
 import CoreTidy
 import CoreMonad
+import CorePrep
 import CoreUtils
 import Literal
 import Rules
@@ -34,7 +35,10 @@ import Name hiding (varName)
 import NameSet
 import NameEnv
 import Avail
+import PrelNames
 import IfaceEnv
+import TcEnv
+import TcRnMonad
 import TcType
 import DataCon
 import TyCon
@@ -51,9 +55,9 @@ import SrcLoc
 import Util
 import FastString
 
-import Control.Monad    ( when )
+import Control.Monad
 import Data.List        ( sortBy )
-import Data.IORef       ( IORef, readIORef, writeIORef )
+import Data.IORef       ( readIORef, writeIORef )
 \end{code}
 
 
@@ -325,8 +329,8 @@ tidyProgram hsc_env  (ModGuts { mg_module    = mod
                 -- Then pick just the ones we need to expose
                 -- See Note [Which rules to expose]
 
-        ; let { (tidy_env, tidy_binds)
-                 = tidyTopBinds hsc_env unfold_env tidy_occ_env binds }
+        ; (tidy_env, tidy_binds)
+                 <- tidyTopBinds hsc_env unfold_env tidy_occ_env binds
 
         ; let { export_set = availsToNameSet exports
               ; final_ids  = [ id | id <- bindersOfBinds tidy_binds,
@@ -1036,38 +1040,41 @@ tidyTopBinds :: HscEnv
              -> UnfoldEnv
              -> TidyOccEnv
              -> CoreProgram
-             -> (TidyEnv, CoreProgram)
+             -> IO (TidyEnv, CoreProgram)
 
 tidyTopBinds hsc_env unfold_env init_occ_env binds
-  = tidy init_env binds
+  = do mkIntegerId <- liftM tyThingId
+                    $ initTcForLookup hsc_env (tcLookupGlobal mkIntegerName)
+       return $ tidy mkIntegerId init_env binds
   where
     init_env = (init_occ_env, emptyVarEnv)
 
     this_pkg = thisPackage (hsc_dflags hsc_env)
 
-    tidy env []     = (env, [])
-    tidy env (b:bs) = let (env1, b')  = tidyTopBind this_pkg unfold_env env b
-                          (env2, bs') = tidy env1 bs
-                      in
-                          (env2, b':bs')
+    tidy _           env []     = (env, [])
+    tidy mkIntegerId env (b:bs) = let (env1, b')  = tidyTopBind this_pkg mkIntegerId unfold_env env b
+                                      (env2, bs') = tidy mkIntegerId env1 bs
+                                  in
+                                      (env2, b':bs')
 
 ------------------------
 tidyTopBind  :: PackageId
+             -> Id
              -> UnfoldEnv
              -> TidyEnv
              -> CoreBind
              -> (TidyEnv, CoreBind)
 
-tidyTopBind this_pkg unfold_env (occ_env,subst1) (NonRec bndr rhs)
+tidyTopBind this_pkg mkIntegerId unfold_env (occ_env,subst1) (NonRec bndr rhs)
   = (tidy_env2,  NonRec bndr' rhs')
   where
     Just (name',show_unfold) = lookupVarEnv unfold_env bndr
-    caf_info      = hasCafRefs this_pkg subst1 (idArity bndr) rhs
+    caf_info      = hasCafRefs this_pkg (mkIntegerId, subst1) (idArity bndr) rhs
     (bndr', rhs') = tidyTopPair show_unfold tidy_env2 caf_info name' (bndr, rhs)
     subst2        = extendVarEnv subst1 bndr bndr'
     tidy_env2     = (occ_env, subst2)
 
-tidyTopBind this_pkg unfold_env (occ_env,subst1) (Rec prs)
+tidyTopBind this_pkg mkIntegerId unfold_env (occ_env,subst1) (Rec prs)
   = (tidy_env2, Rec prs')
   where
     prs' = [ tidyTopPair show_unfold tidy_env2 caf_info name' (id,rhs)
@@ -1084,7 +1091,7 @@ tidyTopBind this_pkg unfold_env (occ_env,subst1) (Rec prs)
         -- the CafInfo for a recursive group says whether *any* rhs in
         -- the group may refer indirectly to a CAF (because then, they all do).
     caf_info
-        | or [ mayHaveCafRefs (hasCafRefs this_pkg subst1 (idArity bndr) rhs)
+        | or [ mayHaveCafRefs (hasCafRefs this_pkg (mkIntegerId, subst1) (idArity bndr) rhs)
              | (bndr,rhs) <- prs ] = MayHaveCafRefs
         | otherwise                = NoCafRefs
 
@@ -1221,7 +1228,7 @@ it as a CAF.  In these cases however, we would need to use an additional
 CAF list to keep track of non-collectable CAFs.
 
 \begin{code}
-hasCafRefs  :: PackageId -> VarEnv Var -> Arity -> CoreExpr -> CafInfo
+hasCafRefs  :: PackageId -> (Id, VarEnv Var) -> Arity -> CoreExpr -> CafInfo
 hasCafRefs this_pkg p arity expr
   | is_caf || mentions_cafs = MayHaveCafRefs
   | otherwise               = NoCafRefs
@@ -1236,7 +1243,7 @@ hasCafRefs this_pkg p arity expr
   -- CorePrep later on, and we don't want to duplicate that
   -- knowledge in rhsIsStatic below.
 
-cafRefsE :: VarEnv Id -> Expr a -> FastBool
+cafRefsE :: (Id, VarEnv Id) -> Expr a -> FastBool
 cafRefsE p (Var id)            = cafRefsV p id
 cafRefsE p (Lit lit)           = cafRefsL p lit
 cafRefsE p (App f a)           = fastOr (cafRefsE p f) (cafRefsE p) a
@@ -1248,18 +1255,19 @@ cafRefsE p (Cast e _co)        = cafRefsE p e
 cafRefsE _ (Type _)            = fastBool False
 cafRefsE _ (Coercion _)        = fastBool False
 
-cafRefsEs :: VarEnv Id -> [Expr a] -> FastBool
+cafRefsEs :: (Id, VarEnv Id) -> [Expr a] -> FastBool
 cafRefsEs _ []    = fastBool False
 cafRefsEs p (e:es) = fastOr (cafRefsE p e) (cafRefsEs p) es
 
-cafRefsL :: VarEnv Id -> Literal -> FastBool
--- Don't forget that the embeded mk_integer id might have Caf refs!
--- See Note [Integer literals] in Literal
-cafRefsL p (LitInteger _ mk_integer) = cafRefsV p mk_integer
+cafRefsL :: (Id, VarEnv Id) -> Literal -> FastBool
+-- Don't forget that mk_integer id might have Caf refs!
+-- We first need to convert the Integer into its final form, to
+-- see whether mkInteger is used.
+cafRefsL p@(mk_integer, _) (LitInteger i _) = cafRefsE p (cvtLitInteger mk_integer i)
 cafRefsL _ _                         = fastBool False
 
-cafRefsV :: VarEnv Id -> Id -> FastBool
-cafRefsV p id
+cafRefsV :: (Id, VarEnv Id) -> Id -> FastBool
+cafRefsV (_, p) id
   | not (isLocalId id)            = fastBool (mayHaveCafRefs (idCafInfo id))
   | Just id' <- lookupVarEnv p id = fastBool (mayHaveCafRefs (idCafInfo id'))
   | otherwise                     = fastBool False
index 58eefd9..9f43f60 100644 (file)
@@ -31,7 +31,6 @@ import DataCon     ( dataConTag, dataConTyCon, dataConWorkId, fIRST_TAG )
 import CoreUtils   ( cheapEqExpr, exprIsHNF )
 import CoreUnfold  ( exprIsConApp_maybe )
 import Type
-import TypeRep
 import OccName     ( occNameFS )
 import PrelNames
 import Maybes      ( orElse )
@@ -789,18 +788,15 @@ match_Integer_divop_both :: (Integer -> Integer -> (Integer, Integer))
                          -> [Expr CoreBndr]
                          -> Maybe (Expr CoreBndr)
 match_Integer_divop_both divop _ id_unf [xl,yl]
-  | Just (LitInteger x i) <- exprIsLiteral_maybe id_unf xl
+  | Just (LitInteger x t) <- exprIsLiteral_maybe id_unf xl
   , Just (LitInteger y _) <- exprIsLiteral_maybe id_unf yl
   , y /= 0
   , (r,s) <- x `divop` y
-  = case idType i of
-      FunTy _ (FunTy _ integerTy) ->
-              Just $ mkConApp (tupleCon UnboxedTuple 2)
-                              [Type integerTy,
-                               Type integerTy,
-                               Lit (LitInteger r i),
-                               Lit (LitInteger s i)]
-      _ -> panic "match_Integer_divop_both: mkIntegerId has the wrong type"
+  = Just $ mkConApp (tupleCon UnboxedTuple 2)
+                    [Type t,
+                     Type t,
+                     Lit (LitInteger r t),
+                     Lit (LitInteger s t)]
 match_Integer_divop_both _ _ _ _ = Nothing
 
 -- This helper is used for the quotRem and divMod functions
index edc5a65..8c5978f 100644 (file)
@@ -71,7 +71,6 @@ import CoreSyn
 import PprCore
 import CoreUtils
 import CoreLint                ( lintCoreBindings )
-import PrelNames        ( iNTERACTIVE )
 import HscTypes
 import Module           ( Module )
 import DynFlags
@@ -84,7 +83,7 @@ import Id             ( Id )
 import IOEnv hiding     ( liftIO, failM, failWithM )
 import qualified IOEnv  ( liftIO )
 import TcEnv            ( tcLookupGlobal )
-import TcRnMonad        ( TcM, initTc )
+import TcRnMonad        ( initTcForLookup )
 
 import Outputable
 import FastString
@@ -1022,13 +1021,6 @@ dumpIfSet_dyn :: DynFlag -> String -> SDoc -> CoreM ()
 dumpIfSet_dyn flag str = msg (\dflags -> Err.dumpIfSet_dyn dflags flag str)
 \end{code}
 
-\begin{code}
-
-initTcForLookup :: HscEnv -> TcM a -> IO a
-initTcForLookup hsc_env = liftM (expectJust "initTcInteractive" . snd) . initTc hsc_env HsSrcFile False iNTERACTIVE
-
-\end{code}
-
 
 %************************************************************************
 %*                                                                     *
index 08c5cdb..bde7502 100644 (file)
@@ -44,6 +44,7 @@ import UniqSupply
 import Unique
 import UniqFM
 import DynFlags
+import Maybes
 import StaticFlags
 import FastString
 import Panic
@@ -185,6 +186,9 @@ initTcPrintErrors       -- Used from the interactive loop only
        -> IO (Messages, Maybe r)
 
 initTcPrintErrors env mod todo = initTc env HsSrcFile False mod todo
+
+initTcForLookup :: HscEnv -> TcM a -> IO a
+initTcForLookup hsc_env = liftM (expectJust "initTcInteractive" . snd) . initTc hsc_env HsSrcFile False iNTERACTIVE
 \end{code}
 
 %************************************************************************