import TcRnMonad
import Type ( Kind, openTypeKind, liftedTypeKind,
unliftedTypeKind, mkArrowKind, splitTyConApp,
- mkTyVarTys, mkGenTyConApp, mkTyVarTys, ThetaType )
+ mkTyVarTys, mkGenTyConApp, mkTyVarTys, ThetaType, pprClassPred )
import TypeRep ( Type(..), PredType(..) )
import TyCon ( TyCon, tyConName )
import HscTypes ( ExternalPackageState(..), PackageInstEnv, PackageRuleBase,
import UniqSupply ( initUs_ )
import Outputable
import SrcLoc ( noSrcLoc )
-import Util ( zipWithEqual, dropList, equalLength )
+import Util ( zipWithEqual, dropList, equalLength, zipLazy )
import Maybes ( expectJust )
import CmdLineOpts ( DynFlag(..) )
\end{code}
| otherwise = do -- The normal case, not wired in
{ -- Get the decl from the pool
- decl <- updateEps (\ eps ->
- let
- (decls', decl) = selectDecl (eps_decls eps) name
- in
- (eps { eps_decls = decls' }, decl))
-
- -- Typecheck it
- -- Side-effects EPS by faulting in any needed decls
- -- (via nested calls to tcImportDecl)
- ; initIfaceLcl (nameModuleName name) (tcIfaceDecl decl) }
-
+ mb_decl <- updateEps (\ eps -> selectDecl eps name)
+
+ ; case mb_decl of
+ Just decl -> initIfaceLcl (nameModuleName name) (tcIfaceDecl decl)
+ -- Typecheck it
+ -- Side-effects EPS by faulting in any needed decls
+ -- (via nested calls to tcImportDecl)
+
+
+ Nothing -> do { ioToIOEnv (printErrs (msg defaultErrStyle)); failM }
+ -- Declaration not found
+ -- No errors-var to accumulate errors in, so just
+ -- print out the error right now
+
+ }
+ where
+ msg = hang (ptext SLIT("Can't find interface-file declaration for") <+> ppr (nameParent 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")])
-selectDecl :: DeclPool -> Name -> (DeclPool, IfaceDecl)
+selectDecl :: ExternalPackageState -> Name -> (ExternalPackageState, Maybe IfaceDecl)
-- Use nameParent to get the parent name of the thing
-selectDecl (Pool decls_map n_in n_out) name
- = (Pool decls' n_in (n_out+1), decl)
+selectDecl eps@(EPS { eps_decls = Pool decls_map n_in n_out}) name
+ = case lookupNameEnv decls_map main_name of
+ Nothing -> (eps, Nothing)
+ Just decl -> (eps {eps_decls = Pool decls' n_in (n_out+1)}, Just decl)
where
main_name = nameParent name
- decl = case lookupNameEnv decls_map main_name of
- Nothing -> pprPanic "selectDecl" (ppr main_name <+> ppr name) ;
- Just decl -> decl
-
- decls' = delFromNameEnv decls_map main_name
+ decls' = delFromNameEnv decls_map main_name
\end{code}
%************************************************************************
%* *
- Other interfaces
+ Type-checking a complete interface
%* *
%************************************************************************
+Suppose we discover we don't need to recompile. Then we must type
+check the old interface file. This is a bit different to the
+incremental type checking we do as we suck in interface files. Instead
+we do things similarly as when we are typechecking source decls: we
+bring into scope the type envt for the interface all at once, using a
+knot. Remember, the decls aren't necessarily in dependency order --
+and even if they were, the type decls might be mutually recursive.
+
\begin{code}
-typecheckIface :: ModIface -> IfG ModDetails
--- Used when we decide not to recompile, but intead to use the
--- interface to construct the type environment for the module
-typecheckIface iface
- = initIfaceLcl (moduleName (mi_module iface)) $
- do { ty_things <- mapM (tcIfaceDecl . snd) (mi_decls iface)
- ; rules <- mapM tcIfaceRule (mi_rules iface)
+typecheckIface :: HscEnv
+ -> ModIface -- Get the decls from here
+ -> IO ModDetails
+typecheckIface hsc_env iface@(ModIface { mi_module = mod, mi_decls = ver_decls,
+ mi_rules = rules, mi_insts = dfuns })
+ = initIfaceTc hsc_env iface $ \ tc_env_var -> do
+ { -- Typecheck the decls
+ names <- mappM (lookupOrig (moduleName mod) . ifName) decls
+ ; ty_things <- fixM (\ rec_ty_things -> do
+ { writeMutVar tc_env_var (mkNameEnv (names `zipLazy` rec_ty_things))
+ -- This only makes available the "main" things,
+ -- but that's enough for the strictly-checked part
+ ; mapM tcIfaceDecl decls })
+
+ -- Now augment the type envt with all the implicit things
+ -- These will be needed when type-checking the unfoldings for
+ -- the IfaceIds, but this is done lazily, so writing the thing
+ -- now is sufficient
+ ; let { add_implicits main_thing = main_thing : implicitTyThings main_thing
+ ; type_env = mkTypeEnv (concatMap add_implicits ty_things) }
+ ; writeMutVar tc_env_var type_env
+
+ -- Now do those rules and instances
; dfuns <- mapM tcIfaceInst (mi_insts iface)
- ; return (ModDetails { md_types = mkTypeEnv ty_things,
- md_insts = dfuns,
- md_rules = rules }) }
+ ; rules <- mapM tcIfaceRule (mi_rules iface)
+
+ -- Finished
+ ; return (ModDetails { md_types = type_env, md_insts = dfuns, md_rules = rules })
+ }
+ where
+ decls = map snd ver_decls
\end{code}
else do
{ writeMutVar eps_var (eps {eps_insts = inst_pool'})
+ ; traceIf (sep [ptext SLIT("Importing instances for") <+> pprClassPred cls tys,
+ nest 2 (vcat (map ppr iface_insts))])
+
-- Typecheck the new instances
; dfuns <- initIfaceTcRn (mappM tc_inst iface_insts)