summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorIan Lynagh <igloo@earth.li>2012-06-06 20:16:48 +0100
committerIan Lynagh <igloo@earth.li>2012-06-06 20:58:28 +0100
commit2ef5cd26db27543ac8664a3d18f45550d0109a8b (patch)
tree3ce04c70eeba6549c689aad64a649291bf4d00b1 /compiler
parentc7c44288b9c6d9ba311f2b7a09e80882eb93cfc9 (diff)
downloadhaskell-2ef5cd26db27543ac8664a3d18f45550d0109a8b.tar.gz
Put the Integer type, rather than the mkIntegerId, inside LitInteger
This will make it possible to write PrelRules that produce an Integer result without having Integer arguments.
Diffstat (limited to 'compiler')
-rw-r--r--compiler/basicTypes/Literal.lhs44
-rw-r--r--compiler/coreSyn/CorePrep.lhs61
-rw-r--r--compiler/coreSyn/MkCore.lhs4
-rw-r--r--compiler/iface/TcIface.lhs10
-rw-r--r--compiler/main/HscMain.hs9
-rw-r--r--compiler/main/TidyPgm.lhs56
-rw-r--r--compiler/prelude/PrelRules.lhs16
-rw-r--r--compiler/simplCore/CoreMonad.lhs10
-rw-r--r--compiler/typecheck/TcRnMonad.lhs4
9 files changed, 108 insertions, 106 deletions
diff --git a/compiler/basicTypes/Literal.lhs b/compiler/basicTypes/Literal.lhs
index e29b49a9a5..fe36b9d18a 100644
--- a/compiler/basicTypes/Literal.lhs
+++ b/compiler/basicTypes/Literal.lhs
@@ -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
diff --git a/compiler/coreSyn/CorePrep.lhs b/compiler/coreSyn/CorePrep.lhs
index 55c78b8741..7680bab292 100644
--- a/compiler/coreSyn/CorePrep.lhs
+++ b/compiler/coreSyn/CorePrep.lhs
@@ -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
-- ---------------------------------------------------------------------------
diff --git a/compiler/coreSyn/MkCore.lhs b/compiler/coreSyn/MkCore.lhs
index 3597df5b02..25dfaababa 100644
--- a/compiler/coreSyn/MkCore.lhs
+++ b/compiler/coreSyn/MkCore.lhs
@@ -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
diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index e7360dc935..6a5e423477 100644
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -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
-------------------------
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 78e24c9aa9..ba4bfbc7b2 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -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
diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs
index 288ca411c7..6caae2db05 100644
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@ -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
diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs
index 58eefd9e88..9f43f6090c 100644
--- a/compiler/prelude/PrelRules.lhs
+++ b/compiler/prelude/PrelRules.lhs
@@ -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
diff --git a/compiler/simplCore/CoreMonad.lhs b/compiler/simplCore/CoreMonad.lhs
index edc5a65ed9..8c5978f495 100644
--- a/compiler/simplCore/CoreMonad.lhs
+++ b/compiler/simplCore/CoreMonad.lhs
@@ -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}
-
%************************************************************************
%* *
diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index 08c5cdb0ec..bde75027c0 100644
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/compiler/typecheck/TcRnMonad.lhs
@@ -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}
%************************************************************************