diff options
| -rw-r--r-- | compiler/coreSyn/CoreLint.hs | 358 | ||||
| -rw-r--r-- | compiler/coreSyn/CorePrep.hs | 3 | ||||
| -rw-r--r-- | compiler/deSugar/Desugar.hs | 3 | ||||
| -rw-r--r-- | compiler/iface/LoadIface.hs | 156 | ||||
| -rw-r--r-- | compiler/iface/TcIface.hs | 149 | ||||
| -rw-r--r-- | compiler/main/HscMain.hs | 2 | ||||
| -rw-r--r-- | compiler/main/TidyPgm.hs | 7 | ||||
| -rw-r--r-- | compiler/simplCore/CoreMonad.hs | 205 | ||||
| -rw-r--r-- | compiler/simplCore/SimplCore.hs | 1 | ||||
| -rw-r--r-- | compiler/typecheck/TcEnv.hs | 2 |
10 files changed, 470 insertions, 416 deletions
diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 26519cc928..6befb80840 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -9,13 +9,22 @@ A ``lint'' pass to check for Core correctness {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fprof-auto #-} -module CoreLint ( lintCoreBindings, lintUnfolding, lintExpr ) where +module CoreLint ( + lintCoreBindings, lintUnfolding, + lintPassResult, lintInteractiveExpr, lintExpr, + + -- ** Debug output + CoreLint.showPass, showPassIO, endPass, endPassIO, + dumpPassResult, + CoreLint.dumpIfSet, + ) where #include "HsVersions.h" import CoreSyn import CoreFVs import CoreUtils +import CoreMonad import Bag import Literal import DataCon @@ -36,13 +45,18 @@ import TypeRep import TyCon import CoAxiom import BasicTypes +import ErrUtils as Err import StaticFlags import ListSetOps import PrelNames import Outputable import FastString import Util +import InstEnv ( instanceDFunId ) import OptCoercion ( checkAxInstCo ) + +import HscTypes +import DynFlags import Control.Monad import MonadUtils import Data.Maybe @@ -61,12 +75,8 @@ just about anything in this file or you change other types/functions throughout the Core language (all signposted to this note), you should update that formalism. See docs/core-spec/README for more info about how to do so. -************************************************************************ -* * -\subsection[lintCoreBindings]{@lintCoreBindings@: Top-level interface} -* * -************************************************************************ - +Summary of checks +~~~~~~~~~~~~~~~~~ Checks that a set of core bindings is well-formed. The PprStyle and String just control what we print in the event of an error. The Bool value indicates whether we have done any specialisation yet (in which case we do @@ -83,7 +93,6 @@ If we have done specialisation the we check that there are Outstanding issues: - -- -- Things are *not* OK if: -- -- * Unsaturated type app before specialisation has been done; @@ -110,14 +119,212 @@ to the type of the binding variable. lintBinders does this. For Ids, the type-substituted Id is added to the in_scope set (which itself is part of the TvSubst we are carrying down), and when we find an occurrence of an Id, we fetch it from the in-scope set. + +************************************************************************ +* * + Beginning and ending passes +* * +************************************************************************ + +These functions are not CoreM monad stuff, but they probably ought to +be, and it makes a conveneint place. place for them. They print out +stuff before and after core passes, and do Core Lint when necessary. -} -lintCoreBindings :: [Var] -> CoreProgram -> (Bag MsgDoc, Bag MsgDoc) +showPass :: CoreToDo -> CoreM () +showPass pass = do { dflags <- getDynFlags + ; liftIO $ showPassIO dflags pass } + +showPassIO :: DynFlags -> CoreToDo -> IO () +showPassIO dflags pass = Err.showPass dflags (showPpr dflags pass) + +endPass :: CoreToDo -> CoreProgram -> [CoreRule] -> CoreM () +endPass pass binds rules + = do { hsc_env <- getHscEnv + ; print_unqual <- getPrintUnqualified + ; liftIO $ endPassIO hsc_env print_unqual pass binds rules } + +endPassIO :: HscEnv -> PrintUnqualified + -> CoreToDo -> CoreProgram -> [CoreRule] -> IO () +-- Used by the IO-is CorePrep too +endPassIO hsc_env print_unqual pass binds rules + = do { dumpPassResult dflags print_unqual mb_flag + (ppr pass) (pprPassDetails pass) binds rules + ; lintPassResult hsc_env pass binds } + where + dflags = hsc_dflags hsc_env + mb_flag = case coreDumpFlag pass of + Just flag | dopt flag dflags -> Just flag + | dopt Opt_D_verbose_core2core dflags -> Just flag + _ -> Nothing + +dumpIfSet :: DynFlags -> Bool -> CoreToDo -> SDoc -> SDoc -> IO () +dumpIfSet dflags dump_me pass extra_info doc + = Err.dumpIfSet dflags dump_me (showSDoc dflags (ppr pass <+> extra_info)) doc + +dumpPassResult :: DynFlags + -> PrintUnqualified + -> Maybe DumpFlag -- Just df => show details in a file whose + -- name is specified by df + -> SDoc -- Header + -> SDoc -- Extra info to appear after header + -> CoreProgram -> [CoreRule] + -> IO () +dumpPassResult dflags unqual mb_flag hdr extra_info binds rules + | Just flag <- mb_flag + = Err.dumpSDoc dflags unqual flag (showSDoc dflags hdr) dump_doc + + | otherwise + = Err.debugTraceMsg dflags 2 size_doc + -- Report result size + -- This has the side effect of forcing the intermediate to be evaluated + + where + size_doc = sep [text "Result size of" <+> hdr, nest 2 (equals <+> ppr (coreBindsStats binds))] + + dump_doc = vcat [ nest 2 extra_info + , size_doc + , blankLine + , pprCoreBindings binds + , ppUnless (null rules) pp_rules ] + pp_rules = vcat [ blankLine + , ptext (sLit "------ Local rules for imported ids --------") + , pprRules rules ] + +coreDumpFlag :: CoreToDo -> Maybe DumpFlag +coreDumpFlag (CoreDoSimplify {}) = Just Opt_D_verbose_core2core +coreDumpFlag (CoreDoPluginPass {}) = Just Opt_D_verbose_core2core +coreDumpFlag CoreDoFloatInwards = Just Opt_D_verbose_core2core +coreDumpFlag (CoreDoFloatOutwards {}) = Just Opt_D_verbose_core2core +coreDumpFlag CoreLiberateCase = Just Opt_D_verbose_core2core +coreDumpFlag CoreDoStaticArgs = Just Opt_D_verbose_core2core +coreDumpFlag CoreDoCallArity = Just Opt_D_dump_call_arity +coreDumpFlag CoreDoStrictness = Just Opt_D_dump_stranal +coreDumpFlag CoreDoWorkerWrapper = Just Opt_D_dump_worker_wrapper +coreDumpFlag CoreDoSpecialising = Just Opt_D_dump_spec +coreDumpFlag CoreDoSpecConstr = Just Opt_D_dump_spec +coreDumpFlag CoreCSE = Just Opt_D_dump_cse +coreDumpFlag CoreDoVectorisation = Just Opt_D_dump_vect +coreDumpFlag CoreDesugar = Just Opt_D_dump_ds +coreDumpFlag CoreDesugarOpt = Just Opt_D_dump_ds +coreDumpFlag CoreTidy = Just Opt_D_dump_simpl +coreDumpFlag CorePrep = Just Opt_D_dump_prep + +coreDumpFlag CoreDoPrintCore = Nothing +coreDumpFlag (CoreDoRuleCheck {}) = Nothing +coreDumpFlag CoreDoNothing = Nothing +coreDumpFlag (CoreDoPasses {}) = Nothing + +{- +************************************************************************ +* * + Top-level interfaces +* * +************************************************************************ +-} + +lintPassResult :: HscEnv -> CoreToDo -> CoreProgram -> IO () +lintPassResult hsc_env pass binds + | not (gopt Opt_DoCoreLinting dflags) + = return () + | otherwise + = do { let (warns, errs) = lintCoreBindings pass (interactiveInScope hsc_env) binds + ; Err.showPass dflags ("Core Linted result of " ++ showPpr dflags pass) + ; displayLintResults dflags pass warns errs binds } + where + dflags = hsc_dflags hsc_env + +displayLintResults :: DynFlags -> CoreToDo + -> Bag Err.MsgDoc -> Bag Err.MsgDoc -> CoreProgram + -> IO () +displayLintResults dflags pass warns errs binds + | not (isEmptyBag errs) + = do { log_action dflags dflags Err.SevDump noSrcSpan defaultDumpStyle + (vcat [ lint_banner "errors" (ppr pass), Err.pprMessageBag errs + , ptext (sLit "*** Offending Program ***") + , pprCoreBindings binds + , ptext (sLit "*** End of Offense ***") ]) + ; Err.ghcExit dflags 1 } + + | not (isEmptyBag warns) + , not (case pass of { CoreDesugar -> True; _ -> False }) + -- Suppress warnings after desugaring pass because some + -- are legitimate. Notably, the desugarer generates instance + -- methods with INLINE pragmas that form a mutually recursive + -- group. Only afer a round of simplification are they unravelled. + , not opt_NoDebugOutput + , showLintWarnings pass + = log_action dflags dflags Err.SevDump noSrcSpan defaultDumpStyle + (lint_banner "warnings" (ppr pass) $$ Err.pprMessageBag warns) + + | otherwise = return () + where + +lint_banner :: String -> SDoc -> SDoc +lint_banner string pass = ptext (sLit "*** Core Lint") <+> text string + <+> ptext (sLit ": in result of") <+> pass + <+> ptext (sLit "***") + +showLintWarnings :: CoreToDo -> Bool +-- Disable Lint warnings on the first simplifier pass, because +-- there may be some INLINE knots still tied, which is tiresomely noisy +showLintWarnings (CoreDoSimplify _ (SimplMode { sm_phase = InitialPhase })) = False +showLintWarnings _ = True + +lintInteractiveExpr :: String -> HscEnv -> CoreExpr -> IO () +lintInteractiveExpr what hsc_env expr + | not (gopt Opt_DoCoreLinting dflags) + = return () + | Just err <- lintExpr (interactiveInScope hsc_env) expr + = do { display_lint_err err + ; Err.ghcExit dflags 1 } + | otherwise + = return () + where + dflags = hsc_dflags hsc_env + + display_lint_err err + = do { log_action dflags dflags Err.SevDump noSrcSpan defaultDumpStyle + (vcat [ lint_banner "errors" (text what) + , err + , ptext (sLit "*** Offending Program ***") + , pprCoreExpr expr + , ptext (sLit "*** End of Offense ***") ]) + ; Err.ghcExit dflags 1 } + +interactiveInScope :: HscEnv -> [Var] +-- In GHCi we may lint expressions, or bindings arising from 'deriving' +-- clauses, that mention variables bound in the interactive context. +-- These are Local things (see Note [Interactively-bound Ids in GHCi] in HscTypes). +-- So we have to tell Lint about them, lest it reports them as out of scope. +-- +-- We do this by find local-named things that may appear free in interactive +-- context. This function is pretty revolting and quite possibly not quite right. +-- When we are not in GHCi, the interactive context (hsc_IC hsc_env) is empty +-- so this is a (cheap) no-op. +-- +-- See Trac #8215 for an example +interactiveInScope hsc_env + = varSetElems tyvars ++ ids + where + -- C.f. TcRnDriver.setInteractiveContext, Desugar.deSugarExpr + ictxt = hsc_IC hsc_env + (cls_insts, _fam_insts) = ic_instances ictxt + te1 = mkTypeEnvWithImplicits (ic_tythings ictxt) + te = extendTypeEnvWithIds te1 (map instanceDFunId cls_insts) + ids = typeEnvIds te + tyvars = mapUnionVarSet (tyVarsOfType . idType) ids + -- Why the type variables? How can the top level envt have free tyvars? + -- I think it's because of the GHCi debugger, which can bind variables + -- f :: [t] -> [t] + -- where t is a RuntimeUnk (see TcType) + +lintCoreBindings :: CoreToDo -> [Var] -> CoreProgram -> (Bag MsgDoc, Bag MsgDoc) -- Returns (warnings, errors) -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] -lintCoreBindings local_in_scope binds - = initL $ +lintCoreBindings pass local_in_scope binds + = initL flags $ addLoc TopLevelBindings $ addInScopeVars local_in_scope $ addInScopeVars binders $ @@ -128,6 +335,14 @@ lintCoreBindings local_in_scope binds ; checkL (null ext_dups) (dupExtVars ext_dups) ; mapM lint_bind binds } where + flags = LF { lf_check_global_ids = check_globals } + + -- See Note [Checking for global Ids] + check_globals = case pass of + CoreTidy -> False + CorePrep -> False + _ -> True + binders = bindersOfBinds binds (_, dups) = removeDups compare binders @@ -168,9 +383,10 @@ lintUnfolding locn vars expr | isEmptyBag errs = Nothing | otherwise = Just (pprMessageBag errs) where - (_warns, errs) = initL (addLoc (ImportedUnfolding locn) $ - addInScopeVars vars $ - lintCoreExpr expr) + (_warns, errs) = initL defaultLintFlags linter + linter = addLoc (ImportedUnfolding locn) $ + addInScopeVars vars $ + lintCoreExpr expr lintExpr :: [Var] -- Treat these as in scope -> CoreExpr @@ -180,9 +396,10 @@ lintExpr vars expr | isEmptyBag errs = Nothing | otherwise = Just (pprMessageBag errs) where - (_warns, errs) = initL (addLoc TopLevelBindings $ - addInScopeVars vars $ - lintCoreExpr expr) + (_warns, errs) = initL defaultLintFlags linter + linter = addLoc TopLevelBindings $ + addInScopeVars vars $ + lintCoreExpr expr {- ************************************************************************ @@ -664,7 +881,11 @@ lintAndScopeIds ids linterF lintAndScopeId :: InVar -> (OutVar -> LintM a) -> LintM a lintAndScopeId id linterF - = do { ty <- lintInTy (idType id) + = do { flags <- getLintFlags + ; checkL (not (lf_check_global_ids flags) || isLocalId id) + (ptext (sLit "Non-local Id binder") <+> ppr id) + -- See Note [Checking for global Ids] + ; ty <- lintInTy (idType id) ; let id' = setIdType id ty ; addInScopeVar id' $ (linterF id') } @@ -1047,19 +1268,35 @@ lintCoercion this@(AxiomRuleCo co ts cs) -- If you edit this type, you may need to update the GHC formalism -- See Note [GHC Formalism] +data LintEnv + = LE { le_flags :: LintFlags -- Linting the result of this pass + , le_loc :: [LintLocInfo] -- Locations + , le_subst :: TvSubst -- Current type substitution; we also use this + } -- to keep track of all the variables in scope, + -- both Ids and TyVars + +newtype LintFlags -- Currently only one flag + = LF { lf_check_global_ids :: Bool -- See Note [Checking for global Ids] + } + +defaultLintFlags :: LintFlags +defaultLintFlags = LF { lf_check_global_ids = False } + newtype LintM a = LintM { unLintM :: - [LintLocInfo] -> -- Locations - TvSubst -> -- Current type substitution; we also use this - -- to keep track of all the variables in scope, - -- both Ids and TyVars + LintEnv -> WarnsAndErrs -> -- Error and warning messages so far (Maybe a, WarnsAndErrs) } -- Result and messages (if any) type WarnsAndErrs = (Bag MsgDoc, Bag MsgDoc) -{- Note [Type substitution] - ~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Checking for global Ids] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Before CoreTidy, all locally-bound Ids must be LocalIds, even +top-level ones. See Note [Exported LocalIds] and Trac #9857. + +Note [Type substitution] +~~~~~~~~~~~~~~~~~~~~~~~~ Why do we need a type substitution? Consider /\(a:*). \(x:a). /\(a:*). id a x This is ill typed, because (renaming variables) it is really @@ -1081,12 +1318,12 @@ instance Applicative LintM where (<*>) = ap instance Monad LintM where - return x = LintM (\ _ _ errs -> (Just x, errs)) + return x = LintM (\ _ errs -> (Just x, errs)) fail err = failWithL (text err) - m >>= k = LintM (\ loc subst errs -> - let (res, errs') = unLintM m loc subst errs in + m >>= k = LintM (\ env errs -> + let (res, errs') = unLintM m env errs in case res of - Just r -> unLintM (k r) loc subst errs' + Just r -> unLintM (k r) env errs' Nothing -> (Nothing, errs')) data LintLocInfo @@ -1101,67 +1338,82 @@ data LintLocInfo | InType Type -- Inside a type | InCo Coercion -- Inside a coercion -initL :: LintM a -> WarnsAndErrs -- Errors and warnings -initL m - = case unLintM m [] emptyTvSubst (emptyBag, emptyBag) of +initL :: LintFlags -> LintM a -> WarnsAndErrs -- Errors and warnings +initL flags m + = case unLintM m env (emptyBag, emptyBag) of (_, errs) -> errs + where + env = LE { le_flags = flags, le_subst = emptyTvSubst, le_loc = [] } + +getLintFlags :: LintM LintFlags +getLintFlags = LintM $ \ env errs -> (Just (le_flags env), errs) checkL :: Bool -> MsgDoc -> LintM () checkL True _ = return () checkL False msg = failWithL msg failWithL :: MsgDoc -> LintM a -failWithL msg = LintM $ \ loc subst (warns,errs) -> - (Nothing, (warns, addMsg subst errs msg loc)) +failWithL msg = LintM $ \ env (warns,errs) -> + (Nothing, (warns, addMsg env errs msg)) addErrL :: MsgDoc -> LintM () -addErrL msg = LintM $ \ loc subst (warns,errs) -> - (Just (), (warns, addMsg subst errs msg loc)) +addErrL msg = LintM $ \ env (warns,errs) -> + (Just (), (warns, addMsg env errs msg)) addWarnL :: MsgDoc -> LintM () -addWarnL msg = LintM $ \ loc subst (warns,errs) -> - (Just (), (addMsg subst warns msg loc, errs)) +addWarnL msg = LintM $ \ env (warns,errs) -> + (Just (), (addMsg env warns msg, errs)) -addMsg :: TvSubst -> Bag MsgDoc -> MsgDoc -> [LintLocInfo] -> Bag MsgDoc -addMsg subst msgs msg locs +addMsg :: LintEnv -> Bag MsgDoc -> MsgDoc -> Bag MsgDoc +addMsg env msgs msg = ASSERT( notNull locs ) msgs `snocBag` mk_msg msg where + locs = le_loc env (loc, cxt1) = dumpLoc (head locs) cxts = [snd (dumpLoc loc) | loc <- locs] context | opt_PprStyle_Debug = vcat (reverse cxts) $$ cxt1 $$ - ptext (sLit "Substitution:") <+> ppr subst + ptext (sLit "Substitution:") <+> ppr (le_subst env) | otherwise = cxt1 mk_msg msg = mkLocMessage SevWarning (mkSrcSpan loc loc) (context $$ msg) addLoc :: LintLocInfo -> LintM a -> LintM a -addLoc extra_loc m = - LintM (\ loc subst errs -> unLintM m (extra_loc:loc) subst errs) +addLoc extra_loc m + = LintM $ \ env errs -> + unLintM m (env { le_loc = extra_loc : le_loc env }) errs inCasePat :: LintM Bool -- A slight hack; see the unique call site -inCasePat = LintM $ \ loc _ errs -> (Just (is_case_pat loc), errs) +inCasePat = LintM $ \ env errs -> (Just (is_case_pat env), errs) where - is_case_pat (CasePat {} : _) = True - is_case_pat _other = False + is_case_pat (LE { le_loc = CasePat {} : _ }) = True + is_case_pat _other = False addInScopeVars :: [Var] -> LintM a -> LintM a addInScopeVars vars m - = LintM (\ loc subst errs -> unLintM m loc (extendTvInScopeList subst vars) errs) + = LintM $ \ env errs -> + unLintM m (env { le_subst = extendTvInScopeList (le_subst env) vars }) + errs addInScopeVar :: Var -> LintM a -> LintM a addInScopeVar var m - = LintM (\ loc subst errs -> unLintM m loc (extendTvInScope subst var) errs) + = LintM $ \ env errs -> + unLintM m (env { le_subst = extendTvInScope (le_subst env) var }) errs + +extendSubstL :: TyVar -> Type -> LintM a -> LintM a +extendSubstL tv ty m + = LintM $ \ env errs -> + unLintM m (env { le_subst = Type.extendTvSubst (le_subst env) tv ty }) errs updateTvSubst :: TvSubst -> LintM a -> LintM a -updateTvSubst subst' m = - LintM (\ loc _ errs -> unLintM m loc subst' errs) +updateTvSubst subst' m + = LintM $ \ env errs -> unLintM m (env { le_subst = subst' }) errs getTvSubst :: LintM TvSubst -getTvSubst = LintM (\ _ subst errs -> (Just subst, errs)) +getTvSubst = LintM (\ env errs -> (Just (le_subst env), errs)) getInScope :: LintM InScopeSet -getInScope = LintM (\ _ subst errs -> (Just (getTvInScope subst), errs)) +getInScope = LintM (\ env errs -> (Just (getTvInScope (le_subst env)), errs)) applySubstTy :: InType -> LintM OutType applySubstTy ty = do { subst <- getTvSubst; return (Type.substTy subst ty) } @@ -1169,10 +1421,6 @@ applySubstTy ty = do { subst <- getTvSubst; return (Type.substTy subst ty) } applySubstCo :: InCoercion -> LintM OutCoercion applySubstCo co = do { subst <- getTvSubst; return (substCo (tvCvSubst subst) co) } -extendSubstL :: TyVar -> Type -> LintM a -> LintM a -extendSubstL tv ty m - = LintM (\ loc subst errs -> unLintM m loc (Type.extendTvSubst subst tv ty) errs) - lookupIdInScope :: Id -> LintM Id lookupIdInScope id | not (mustHaveLocalBinding id) diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs index 9037fcb126..62efae2919 100644 --- a/compiler/coreSyn/CorePrep.hs +++ b/compiler/coreSyn/CorePrep.hs @@ -21,7 +21,8 @@ import PrelNames import CoreUtils import CoreArity import CoreFVs -import CoreMonad ( endPassIO, CoreToDo(..) ) +import CoreMonad ( CoreToDo(..) ) +import CoreLint ( endPassIO ) import CoreSyn import CoreSubst import MkCore hiding( FloatBind(..) ) -- We use our own FloatBind here diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs index d6ccdaf359..9f6748b882 100644 --- a/compiler/deSugar/Desugar.hs +++ b/compiler/deSugar/Desugar.hs @@ -39,7 +39,8 @@ import Rules import TysPrim (eqReprPrimTyCon) import TysWiredIn (coercibleTyCon ) import BasicTypes ( Activation(.. ) ) -import CoreMonad ( endPassIO, CoreToDo(..) ) +import CoreMonad ( CoreToDo(..) ) +import CoreLint ( endPassIO ) import MkCore import FastString import ErrUtils diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs index 34ae3d507f..6fe805dad6 100644 --- a/compiler/iface/LoadIface.hs +++ b/compiler/iface/LoadIface.hs @@ -9,6 +9,10 @@ Loading interface files {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module LoadIface ( + -- Importing one thing + tcLookupImported_maybe, importDecl, + checkWiredInTyCon, ifCheckWiredInThing, + -- RnM/TcM functions loadModuleInterface, loadModuleInterfaces, loadSrcInterface, loadSrcInterface_maybe, @@ -43,6 +47,7 @@ import PrelInfo import PrimOp ( allThePrimOps, primOpFixity, primOpOcc ) import MkId ( seqId ) import Rules +import TyCon import Annotations import InstEnv import FamInstEnv @@ -70,6 +75,157 @@ import System.FilePath {- ************************************************************************ * * +* tcImportDecl is the key function for "faulting in" * +* imported things +* * +************************************************************************ + +The main idea is this. We are chugging along type-checking source code, and +find a reference to GHC.Base.map. We call tcLookupGlobal, which doesn't find +it in the EPS type envt. So it + 1 loads GHC.Base.hi + 2 gets the decl for GHC.Base.map + 3 typechecks it via tcIfaceDecl + 4 and adds it to the type env in the EPS + +Note that DURING STEP 4, we may find that map's type mentions a type +constructor that also + +Notice that for imported things we read the current version from the EPS +mutable variable. This is important in situations like + ...$(e1)...$(e2)... +where the code that e1 expands to might import some defns that +also turn out to be needed by the code that e2 expands to. +-} + +tcLookupImported_maybe :: Name -> TcM (MaybeErr MsgDoc TyThing) +-- Returns (Failed err) if we can't find the interface file for the thing +tcLookupImported_maybe name + = do { hsc_env <- getTopEnv + ; mb_thing <- liftIO (lookupTypeHscEnv hsc_env name) + ; case mb_thing of + Just thing -> return (Succeeded thing) + Nothing -> tcImportDecl_maybe name } + +tcImportDecl_maybe :: Name -> TcM (MaybeErr MsgDoc TyThing) +-- Entry point for *source-code* uses of importDecl +tcImportDecl_maybe name + | Just thing <- wiredInNameTyThing_maybe name + = do { when (needWiredInHomeIface thing) + (initIfaceTcRn (loadWiredInHomeIface name)) + -- See Note [Loading instances for wired-in things] + ; return (Succeeded thing) } + | otherwise + = initIfaceTcRn (importDecl name) + +importDecl :: Name -> IfM lcl (MaybeErr MsgDoc TyThing) +-- Get the TyThing for this Name from an interface file +-- It's not a wired-in thing -- the caller caught that +importDecl name + = ASSERT( not (isWiredInName name) ) + do { traceIf nd_doc + + -- Load the interface, which should populate the PTE + ; mb_iface <- ASSERT2( isExternalName name, ppr name ) + loadInterface nd_doc (nameModule name) ImportBySystem + ; case mb_iface of { + Failed err_msg -> return (Failed err_msg) ; + Succeeded _ -> do + + -- Now look it up again; this time we should find it + { eps <- getEps + ; case lookupTypeEnv (eps_PTE eps) name of + Just thing -> return (Succeeded thing) + Nothing -> return (Failed not_found_msg) + }}} + where + nd_doc = ptext (sLit "Need decl for") <+> ppr name + not_found_msg = hang (ptext (sLit "Can't find interface-file declaration for") <+> + pprNameSpace (occNameSpace (nameOccName name)) <+> ppr name) + 2 (vcat [ptext (sLit "Probable cause: bug in .hi-boot file, or inconsistent .hi file"), + ptext (sLit "Use -ddump-if-trace to get an idea of which file caused the error")]) + + +{- +************************************************************************ +* * + Checks for wired-in things +* * +************************************************************************ + +Note [Loading instances for wired-in things] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We need to make sure that we have at least *read* the interface files +for any module with an instance decl or RULE that we might want. + +* If the instance decl is an orphan, we have a whole separate mechanism + (loadOrphanModules) + +* If the instance decl is not an orphan, then the act of looking at the + TyCon or Class will force in the defining module for the + TyCon/Class, and hence the instance decl + +* BUT, if the TyCon is a wired-in TyCon, we don't really need its interface; + but we must make sure we read its interface in case it has instances or + rules. That is what LoadIface.loadWiredInHomeInterface does. It's called + from TcIface.{tcImportDecl, checkWiredInTyCon, ifCheckWiredInThing} + +* HOWEVER, only do this for TyCons. There are no wired-in Classes. There + are some wired-in Ids, but we don't want to load their interfaces. For + example, Control.Exception.Base.recSelError is wired in, but that module + is compiled late in the base library, and we don't want to force it to + load before it's been compiled! + +All of this is done by the type checker. The renamer plays no role. +(It used to, but no longer.) +-} + +checkWiredInTyCon :: TyCon -> TcM () +-- Ensure that the home module of the TyCon (and hence its instances) +-- are loaded. See Note [Loading instances for wired-in things] +-- It might not be a wired-in tycon (see the calls in TcUnify), +-- in which case this is a no-op. +checkWiredInTyCon tc + | not (isWiredInName tc_name) + = return () + | otherwise + = do { mod <- getModule + ; ASSERT( isExternalName tc_name ) + when (mod /= nameModule tc_name) + (initIfaceTcRn (loadWiredInHomeIface tc_name)) + -- Don't look for (non-existent) Float.hi when + -- compiling Float.lhs, which mentions Float of course + -- A bit yukky to call initIfaceTcRn here + } + where + tc_name = tyConName tc + +ifCheckWiredInThing :: TyThing -> IfL () +-- Even though we are in an interface file, we want to make +-- sure the instances of a wired-in thing are loaded (imagine f :: Double -> Double) +-- Ditto want to ensure that RULES are loaded too +-- See Note [Loading instances for wired-in things] +ifCheckWiredInThing thing + = do { mod <- getIfModule + -- Check whether we are typechecking the interface for this + -- very module. E.g when compiling the base library in --make mode + -- we may typecheck GHC.Base.hi. At that point, GHC.Base is not in + -- the HPT, so without the test we'll demand-load it into the PIT! + -- C.f. the same test in checkWiredInTyCon above + ; let name = getName thing + ; ASSERT2( isExternalName name, ppr name ) + when (needWiredInHomeIface thing && mod /= nameModule name) + (loadWiredInHomeIface name) } + +needWiredInHomeIface :: TyThing -> Bool +-- Only for TyCons; see Note [Loading instances for wired-in things] +needWiredInHomeIface (ATyCon {}) = True +needWiredInHomeIface _ = False + + +{- +************************************************************************ +* * loadSrcInterface, loadOrphanModules, loadInterfaceForName These three are called from TcM-land diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs index 692bfad534..9864364b89 100644 --- a/compiler/iface/TcIface.hs +++ b/compiler/iface/TcIface.hs @@ -63,7 +63,6 @@ import Module import UniqFM import UniqSupply import Outputable -import ErrUtils import Maybes import SrcLoc import DynFlags @@ -96,155 +95,7 @@ Names before typechecking, because there should be no scope errors etc. -- bound in this module (and hence not yet processed). -- The discarding happens when forkM finds a type error. -************************************************************************ -* * -* tcImportDecl is the key function for "faulting in" * -* imported things -* * -************************************************************************ - -The main idea is this. We are chugging along type-checking source code, and -find a reference to GHC.Base.map. We call tcLookupGlobal, which doesn't find -it in the EPS type envt. So it - 1 loads GHC.Base.hi - 2 gets the decl for GHC.Base.map - 3 typechecks it via tcIfaceDecl - 4 and adds it to the type env in the EPS - -Note that DURING STEP 4, we may find that map's type mentions a type -constructor that also - -Notice that for imported things we read the current version from the EPS -mutable variable. This is important in situations like - ...$(e1)...$(e2)... -where the code that e1 expands to might import some defns that -also turn out to be needed by the code that e2 expands to. --} - -tcLookupImported_maybe :: Name -> TcM (MaybeErr MsgDoc TyThing) --- Returns (Failed err) if we can't find the interface file for the thing -tcLookupImported_maybe name - = do { hsc_env <- getTopEnv - ; mb_thing <- liftIO (lookupTypeHscEnv hsc_env name) - ; case mb_thing of - Just thing -> return (Succeeded thing) - Nothing -> tcImportDecl_maybe name } - -tcImportDecl_maybe :: Name -> TcM (MaybeErr MsgDoc TyThing) --- Entry point for *source-code* uses of importDecl -tcImportDecl_maybe name - | Just thing <- wiredInNameTyThing_maybe name - = do { when (needWiredInHomeIface thing) - (initIfaceTcRn (loadWiredInHomeIface name)) - -- See Note [Loading instances for wired-in things] - ; return (Succeeded thing) } - | otherwise - = initIfaceTcRn (importDecl name) - -importDecl :: Name -> IfM lcl (MaybeErr MsgDoc TyThing) --- Get the TyThing for this Name from an interface file --- It's not a wired-in thing -- the caller caught that -importDecl name - = ASSERT( not (isWiredInName name) ) - do { traceIf nd_doc - - -- Load the interface, which should populate the PTE - ; mb_iface <- ASSERT2( isExternalName name, ppr name ) - loadInterface nd_doc (nameModule name) ImportBySystem - ; case mb_iface of { - Failed err_msg -> return (Failed err_msg) ; - Succeeded _ -> do - - -- Now look it up again; this time we should find it - { eps <- getEps - ; case lookupTypeEnv (eps_PTE eps) name of - Just thing -> return (Succeeded thing) - Nothing -> return (Failed not_found_msg) - }}} - where - nd_doc = ptext (sLit "Need decl for") <+> ppr name - not_found_msg = hang (ptext (sLit "Can't find interface-file declaration for") <+> - pprNameSpace (occNameSpace (nameOccName name)) <+> ppr name) - 2 (vcat [ptext (sLit "Probable cause: bug in .hi-boot file, or inconsistent .hi file"), - ptext (sLit "Use -ddump-if-trace to get an idea of which file caused the error")]) -{- -************************************************************************ -* * - Checks for wired-in things -* * -************************************************************************ - -Note [Loading instances for wired-in things] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We need to make sure that we have at least *read* the interface files -for any module with an instance decl or RULE that we might want. - -* If the instance decl is an orphan, we have a whole separate mechanism - (loadOrphanModules) - -* If the instance decl is not an orphan, then the act of looking at the - TyCon or Class will force in the defining module for the - TyCon/Class, and hence the instance decl - -* BUT, if the TyCon is a wired-in TyCon, we don't really need its interface; - but we must make sure we read its interface in case it has instances or - rules. That is what LoadIface.loadWiredInHomeInterface does. It's called - from TcIface.{tcImportDecl, checkWiredInTyCon, ifCheckWiredInThing} - -* HOWEVER, only do this for TyCons. There are no wired-in Classes. There - are some wired-in Ids, but we don't want to load their interfaces. For - example, Control.Exception.Base.recSelError is wired in, but that module - is compiled late in the base library, and we don't want to force it to - load before it's been compiled! - -All of this is done by the type checker. The renamer plays no role. -(It used to, but no longer.) --} - -checkWiredInTyCon :: TyCon -> TcM () --- Ensure that the home module of the TyCon (and hence its instances) --- are loaded. See Note [Loading instances for wired-in things] --- It might not be a wired-in tycon (see the calls in TcUnify), --- in which case this is a no-op. -checkWiredInTyCon tc - | not (isWiredInName tc_name) - = return () - | otherwise - = do { mod <- getModule - ; ASSERT( isExternalName tc_name ) - when (mod /= nameModule tc_name) - (initIfaceTcRn (loadWiredInHomeIface tc_name)) - -- Don't look for (non-existent) Float.hi when - -- compiling Float.lhs, which mentions Float of course - -- A bit yukky to call initIfaceTcRn here - } - where - tc_name = tyConName tc - -ifCheckWiredInThing :: TyThing -> IfL () --- Even though we are in an interface file, we want to make --- sure the instances of a wired-in thing are loaded (imagine f :: Double -> Double) --- Ditto want to ensure that RULES are loaded too --- See Note [Loading instances for wired-in things] -ifCheckWiredInThing thing - = do { mod <- getIfModule - -- Check whether we are typechecking the interface for this - -- very module. E.g when compiling the base library in --make mode - -- we may typecheck GHC.Base.hi. At that point, GHC.Base is not in - -- the HPT, so without the test we'll demand-load it into the PIT! - -- C.f. the same test in checkWiredInTyCon above - ; let name = getName thing - ; ASSERT2( isExternalName name, ppr name ) - when (needWiredInHomeIface thing && mod /= nameModule name) - (loadWiredInHomeIface name) } - -needWiredInHomeIface :: TyThing -> Bool --- Only for TyCons; see Note [Loading instances for wired-in things] -needWiredInHomeIface (ATyCon {}) = True -needWiredInHomeIface _ = False - -{- ************************************************************************ * * Type-checking a complete interface diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 8f8da0266b..c00663b6ab 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -93,7 +93,7 @@ import CoreTidy ( tidyExpr ) import Type ( Type ) import PrelNames import {- Kind parts of -} Type ( Kind ) -import CoreMonad ( lintInteractiveExpr ) +import CoreLint ( lintInteractiveExpr ) import DsMeta ( templateHaskellNames ) import VarEnv ( emptyTidyEnv ) import Panic diff --git a/compiler/main/TidyPgm.hs b/compiler/main/TidyPgm.hs index ed37225219..a32f206273 100644 --- a/compiler/main/TidyPgm.hs +++ b/compiler/main/TidyPgm.hs @@ -21,6 +21,7 @@ import CoreTidy import CoreMonad import CorePrep import CoreUtils +import CoreLint import Literal import Rules import PatSyn @@ -142,12 +143,12 @@ mkBootModDetailsTc hsc_env = do { let dflags = hsc_dflags hsc_env ; showPassIO dflags CoreTidy - ; let { insts' = map (tidyClsInstDFun globaliseAndTidyId) insts + ; let { insts' = map (tidyClsInstDFun globaliseAndTidyId) insts ; type_env1 = mkBootTypeEnv (availsToNameSet exports) (typeEnvIds type_env) tcs fam_insts - ; pat_syns' = map (tidyPatSynIds globaliseAndTidyId) pat_syns + ; pat_syns' = map (tidyPatSynIds globaliseAndTidyId) pat_syns ; type_env2 = extendTypeEnvWithPatSyns pat_syns' type_env1 - ; dfun_ids = map instanceDFunId insts' + ; dfun_ids = map instanceDFunId insts' ; type_env' = extendTypeEnvWithIds type_env2 dfun_ids } ; return (ModDetails { md_types = type_env' diff --git a/compiler/simplCore/CoreMonad.hs b/compiler/simplCore/CoreMonad.hs index d50027c6ea..e9c828da6a 100644 --- a/compiler/simplCore/CoreMonad.hs +++ b/compiler/simplCore/CoreMonad.hs @@ -42,10 +42,6 @@ module CoreMonad ( -- ** Dealing with annotations getAnnotations, getFirstAnnotations, - -- ** Debug output - showPass, showPassIO, endPass, endPassIO, dumpPassResult, lintPassResult, - lintInteractiveExpr, dumpIfSet, - -- ** Screen output putMsg, putMsgS, errorMsg, errorMsgS, fatalErrorMsg, fatalErrorMsgS, @@ -62,9 +58,6 @@ module CoreMonad ( import Name( Name ) #endif import CoreSyn -import PprCore -import CoreUtils -import CoreLint ( lintCoreBindings, lintExpr ) import HscTypes import Module import DynFlags @@ -77,18 +70,11 @@ import IOEnv hiding ( liftIO, failM, failWithM ) import qualified IOEnv ( liftIO ) import TcEnv ( tcLookupGlobal ) import TcRnMonad ( initTcForLookup ) -import InstEnv ( instanceDFunId ) -import Type ( tyVarsOfType ) -import Id ( idType ) import Var -import VarSet - import Outputable import FastString import qualified ErrUtils as Err -import Bag import Maybes -import SrcLoc import UniqSupply import UniqFM ( UniqFM, mapUFM, filterUFM ) import MonadUtils @@ -119,173 +105,6 @@ restoreLinkerGlobals :: () -> IO () restoreLinkerGlobals () = return () #endif -{- -************************************************************************ -* * - Debug output -* * -************************************************************************ - -These functions are not CoreM monad stuff, but they probably ought to -be, and it makes a conveneint place. place for them. They print out -stuff before and after core passes, and do Core Lint when necessary. --} - -showPass :: CoreToDo -> CoreM () -showPass pass = do { dflags <- getDynFlags - ; liftIO $ showPassIO dflags pass } - -showPassIO :: DynFlags -> CoreToDo -> IO () -showPassIO dflags pass = Err.showPass dflags (showPpr dflags pass) - -endPass :: CoreToDo -> CoreProgram -> [CoreRule] -> CoreM () -endPass pass binds rules - = do { hsc_env <- getHscEnv - ; print_unqual <- getPrintUnqualified - ; liftIO $ endPassIO hsc_env print_unqual pass binds rules } - -endPassIO :: HscEnv -> PrintUnqualified - -> CoreToDo -> CoreProgram -> [CoreRule] -> IO () --- Used by the IO-is CorePrep too -endPassIO hsc_env print_unqual pass binds rules - = do { dumpPassResult dflags print_unqual mb_flag - (ppr pass) (pprPassDetails pass) binds rules - ; lintPassResult hsc_env pass binds } - where - dflags = hsc_dflags hsc_env - mb_flag = case coreDumpFlag pass of - Just flag | dopt flag dflags -> Just flag - | dopt Opt_D_verbose_core2core dflags -> Just flag - _ -> Nothing - -dumpIfSet :: DynFlags -> Bool -> CoreToDo -> SDoc -> SDoc -> IO () -dumpIfSet dflags dump_me pass extra_info doc - = Err.dumpIfSet dflags dump_me (showSDoc dflags (ppr pass <+> extra_info)) doc - -dumpPassResult :: DynFlags - -> PrintUnqualified - -> Maybe DumpFlag -- Just df => show details in a file whose - -- name is specified by df - -> SDoc -- Header - -> SDoc -- Extra info to appear after header - -> CoreProgram -> [CoreRule] - -> IO () -dumpPassResult dflags unqual mb_flag hdr extra_info binds rules - | Just flag <- mb_flag - = Err.dumpSDoc dflags unqual flag (showSDoc dflags hdr) dump_doc - - | otherwise - = Err.debugTraceMsg dflags 2 size_doc - -- Report result size - -- This has the side effect of forcing the intermediate to be evaluated - - where - size_doc = sep [text "Result size of" <+> hdr, nest 2 (equals <+> ppr (coreBindsStats binds))] - - dump_doc = vcat [ nest 2 extra_info - , size_doc - , blankLine - , pprCoreBindings binds - , ppUnless (null rules) pp_rules ] - pp_rules = vcat [ blankLine - , ptext (sLit "------ Local rules for imported ids --------") - , pprRules rules ] - -lintPassResult :: HscEnv -> CoreToDo -> CoreProgram -> IO () -lintPassResult hsc_env pass binds - | not (gopt Opt_DoCoreLinting dflags) - = return () - | otherwise - = do { let (warns, errs) = lintCoreBindings (interactiveInScope hsc_env) binds - ; Err.showPass dflags ("Core Linted result of " ++ showPpr dflags pass) - ; displayLintResults dflags pass warns errs binds } - where - dflags = hsc_dflags hsc_env - -displayLintResults :: DynFlags -> CoreToDo - -> Bag Err.MsgDoc -> Bag Err.MsgDoc -> CoreProgram - -> IO () -displayLintResults dflags pass warns errs binds - | not (isEmptyBag errs) - = do { log_action dflags dflags Err.SevDump noSrcSpan defaultDumpStyle - (vcat [ lint_banner "errors" (ppr pass), Err.pprMessageBag errs - , ptext (sLit "*** Offending Program ***") - , pprCoreBindings binds - , ptext (sLit "*** End of Offense ***") ]) - ; Err.ghcExit dflags 1 } - - | not (isEmptyBag warns) - , not (case pass of { CoreDesugar -> True; _ -> False }) - -- Suppress warnings after desugaring pass because some - -- are legitimate. Notably, the desugarer generates instance - -- methods with INLINE pragmas that form a mutually recursive - -- group. Only afer a round of simplification are they unravelled. - , not opt_NoDebugOutput - , showLintWarnings pass - = log_action dflags dflags Err.SevDump noSrcSpan defaultDumpStyle - (lint_banner "warnings" (ppr pass) $$ Err.pprMessageBag warns) - - | otherwise = return () - where - -lint_banner :: String -> SDoc -> SDoc -lint_banner string pass = ptext (sLit "*** Core Lint") <+> text string - <+> ptext (sLit ": in result of") <+> pass - <+> ptext (sLit "***") - -showLintWarnings :: CoreToDo -> Bool --- Disable Lint warnings on the first simplifier pass, because --- there may be some INLINE knots still tied, which is tiresomely noisy -showLintWarnings (CoreDoSimplify _ (SimplMode { sm_phase = InitialPhase })) = False -showLintWarnings _ = True - -lintInteractiveExpr :: String -> HscEnv -> CoreExpr -> IO () -lintInteractiveExpr what hsc_env expr - | not (gopt Opt_DoCoreLinting dflags) - = return () - | Just err <- lintExpr (interactiveInScope hsc_env) expr - = do { display_lint_err err - ; Err.ghcExit dflags 1 } - | otherwise - = return () - where - dflags = hsc_dflags hsc_env - - display_lint_err err - = do { log_action dflags dflags Err.SevDump noSrcSpan defaultDumpStyle - (vcat [ lint_banner "errors" (text what) - , err - , ptext (sLit "*** Offending Program ***") - , pprCoreExpr expr - , ptext (sLit "*** End of Offense ***") ]) - ; Err.ghcExit dflags 1 } - -interactiveInScope :: HscEnv -> [Var] --- In GHCi we may lint expressions, or bindings arising from 'deriving' --- clauses, that mention variables bound in the interactive context. --- These are Local things (see Note [Interactively-bound Ids in GHCi] in HscTypes). --- So we have to tell Lint about them, lest it reports them as out of scope. --- --- We do this by find local-named things that may appear free in interactive --- context. This function is pretty revolting and quite possibly not quite right. --- When we are not in GHCi, the interactive context (hsc_IC hsc_env) is empty --- so this is a (cheap) no-op. --- --- See Trac #8215 for an example -interactiveInScope hsc_env - = varSetElems tyvars ++ ids - where - -- C.f. TcRnDriver.setInteractiveContext, Desugar.deSugarExpr - ictxt = hsc_IC hsc_env - (cls_insts, _fam_insts) = ic_instances ictxt - te1 = mkTypeEnvWithImplicits (ic_tythings ictxt) - te = extendTypeEnvWithIds te1 (map instanceDFunId cls_insts) - ids = typeEnvIds te - tyvars = mapUnionVarSet (tyVarsOfType . idType) ids - -- Why the type variables? How can the top level envt have free tyvars? - -- I think it's because of the GHCi debugger, which can bind variables - -- f :: [t] -> [t] - -- where t is a RuntimeUnk (see TcType) {- ************************************************************************ @@ -328,30 +147,6 @@ data CoreToDo -- These are diff core-to-core passes, | CoreTidy | CorePrep -coreDumpFlag :: CoreToDo -> Maybe DumpFlag -coreDumpFlag (CoreDoSimplify {}) = Just Opt_D_verbose_core2core -coreDumpFlag (CoreDoPluginPass {}) = Just Opt_D_verbose_core2core -coreDumpFlag CoreDoFloatInwards = Just Opt_D_verbose_core2core -coreDumpFlag (CoreDoFloatOutwards {}) = Just Opt_D_verbose_core2core -coreDumpFlag CoreLiberateCase = Just Opt_D_verbose_core2core -coreDumpFlag CoreDoStaticArgs = Just Opt_D_verbose_core2core -coreDumpFlag CoreDoCallArity = Just Opt_D_dump_call_arity -coreDumpFlag CoreDoStrictness = Just Opt_D_dump_stranal -coreDumpFlag CoreDoWorkerWrapper = Just Opt_D_dump_worker_wrapper -coreDumpFlag CoreDoSpecialising = Just Opt_D_dump_spec -coreDumpFlag CoreDoSpecConstr = Just Opt_D_dump_spec -coreDumpFlag CoreCSE = Just Opt_D_dump_cse -coreDumpFlag CoreDoVectorisation = Just Opt_D_dump_vect -coreDumpFlag CoreDesugar = Just Opt_D_dump_ds -coreDumpFlag CoreDesugarOpt = Just Opt_D_dump_ds -coreDumpFlag CoreTidy = Just Opt_D_dump_simpl -coreDumpFlag CorePrep = Just Opt_D_dump_prep - -coreDumpFlag CoreDoPrintCore = Nothing -coreDumpFlag (CoreDoRuleCheck {}) = Nothing -coreDumpFlag CoreDoNothing = Nothing -coreDumpFlag (CoreDoPasses {}) = Nothing - instance Outputable CoreToDo where ppr (CoreDoSimplify _ _) = ptext (sLit "Simplifier") ppr (CoreDoPluginPass s _) = ptext (sLit "Core plugin: ") <+> text s diff --git a/compiler/simplCore/SimplCore.hs b/compiler/simplCore/SimplCore.hs index 75766e8ef2..bdb21987b8 100644 --- a/compiler/simplCore/SimplCore.hs +++ b/compiler/simplCore/SimplCore.hs @@ -21,6 +21,7 @@ import PprCore ( pprCoreBindings, pprCoreExpr ) import OccurAnal ( occurAnalysePgm, occurAnalyseExpr ) import IdInfo import CoreUtils ( coreBindsSize, coreBindsStats, exprSize ) +import CoreLint ( showPass, endPass, lintPassResult, dumpPassResult ) import Simplify ( simplTopBinds, simplExpr ) import SimplUtils ( simplEnvForGHCi, activeRule ) import SimplEnv diff --git a/compiler/typecheck/TcEnv.hs b/compiler/typecheck/TcEnv.hs index 9414dcb5fb..f9e27fcf90 100644 --- a/compiler/typecheck/TcEnv.hs +++ b/compiler/typecheck/TcEnv.hs @@ -64,7 +64,7 @@ import IfaceEnv import TcRnMonad import TcMType import TcType -import TcIface +import LoadIface import PrelNames import TysWiredIn import Id |