diff options
| author | Ian Lynagh <igloo@earth.li> | 2012-06-06 20:16:48 +0100 |
|---|---|---|
| committer | Ian Lynagh <igloo@earth.li> | 2012-06-06 20:58:28 +0100 |
| commit | 2ef5cd26db27543ac8664a3d18f45550d0109a8b (patch) | |
| tree | 3ce04c70eeba6549c689aad64a649291bf4d00b1 /compiler | |
| parent | c7c44288b9c6d9ba311f2b7a09e80882eb93cfc9 (diff) | |
| download | haskell-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.lhs | 44 | ||||
| -rw-r--r-- | compiler/coreSyn/CorePrep.lhs | 61 | ||||
| -rw-r--r-- | compiler/coreSyn/MkCore.lhs | 4 | ||||
| -rw-r--r-- | compiler/iface/TcIface.lhs | 10 | ||||
| -rw-r--r-- | compiler/main/HscMain.hs | 9 | ||||
| -rw-r--r-- | compiler/main/TidyPgm.lhs | 56 | ||||
| -rw-r--r-- | compiler/prelude/PrelRules.lhs | 16 | ||||
| -rw-r--r-- | compiler/simplCore/CoreMonad.lhs | 10 | ||||
| -rw-r--r-- | compiler/typecheck/TcRnMonad.lhs | 4 |
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} %************************************************************************ |
