diff options
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} %************************************************************************ |