\section[TcModule]{Typechecking a whole module}
\begin{code}
+{-# OPTIONS_GHC -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
+-- for details
+
module TcRnDriver (
#ifdef GHCI
tcRnStmt, tcRnExpr, tcRnType,
tcRnLookupName,
tcRnGetInfo,
getModuleExports,
- tcRnRecoverDataCon,
#endif
tcRnModule,
tcTopSrcDecls,
\begin{code}
tcRnImports :: HscEnv -> Module -> [LImportDecl RdrName] -> TcM TcGblEnv
tcRnImports hsc_env this_mod import_decls
- = do { (rn_imports, rdr_env, imports) <- rnImports import_decls ;
+ = do { (rn_imports, rdr_env, imports,hpc_info) <- rnImports import_decls ;
; let { dep_mods :: ModuleNameEnv (ModuleName, IsBootInterface)
; dep_mods = imp_dep_mods imports
tcg_rn_imports = fmap (const rn_imports) (tcg_rn_imports gbl),
tcg_inst_env = extendInstEnvList (tcg_inst_env gbl) home_insts,
tcg_fam_inst_env = extendFamInstEnvList (tcg_fam_inst_env gbl)
- home_fam_insts
+ home_fam_insts,
+ tcg_hpc = hpc_info
}) $ do {
; traceRn (text "rn1" <+> ppr (imp_dep_mods imports))
-- Check type-familily consistency
; traceRn (text "rn1: checking family instance consistency")
- ; let { dir_imp_mods = map (\ (mod, _, _) -> mod)
+ ; let { dir_imp_mods = map (\ (mod, _) -> mod)
. moduleEnvElts
. imp_mods
$ imports }
mg_types = final_type_env,
mg_insts = tcg_insts tcg_env,
mg_fam_insts = tcg_fam_insts tcg_env,
+ mg_inst_env = tcg_inst_env tcg_env,
mg_fam_inst_env = tcg_fam_inst_env tcg_env,
mg_rules = [],
mg_binds = core_binds,
mg_fix_env = emptyFixityEnv,
mg_deprecs = NoDeprecs,
mg_foreign = NoStubs,
- mg_hpc_info = noHpcInfo,
+ mg_hpc_info = emptyHpcInfo False,
mg_modBreaks = emptyModBreaks,
mg_vect_info = noVectInfo
} } ;
(tc_val_binds, tcl_env) <- tcTopBinds val_binds ;
setLclTypeEnv tcl_env $ do {
- -- Now GHC-generated derived bindings and generics
- -- Do not generate warnings from compiler-generated code
- (tc_deriv_binds, tcl_env) <- discardWarnings $ setOptM Opt_GlasgowExts $
- tcTopBinds deriv_binds ;
+ -- Now GHC-generated derived bindings and generics.
+ -- Do not generate warnings from compiler-generated code.
+ (tc_deriv_binds, tcl_env) <- discardWarnings $
+ tcTopBinds deriv_binds ;
-- Second pass over class and instance declarations,
traceTc (text "Tc6") ;
(([rn_stmt], _), fvs) <- rnStmts DoExpr [rdr_stmt] (return ((), emptyFVs)) ;
traceRn (text "tcRnStmt" <+> vcat [ppr rdr_stmt, ppr rn_stmt, ppr fvs]) ;
failIfErrsM ;
+ rnDump (ppr rn_stmt) ;
-- The real work is done here
(bound_ids, tc_expr) <- mkPlan rn_stmt ;
} ;
-- OK, we're ready to typecheck the stmts
- traceTc (text "tcs 2") ;
+ traceTc (text "TcRnDriver.tcGhciStmts: tc stmts") ;
((tc_stmts, ids), lie) <- getLIE $ tc_io_stmts stmts $ \ _ ->
mappM tcLookupId names ;
-- Look up the names right in the middle,
-- where they will all be in scope
-- Simplify the context
+ traceTc (text "TcRnDriver.tcGhciStmts: simplify ctxt") ;
const_binds <- checkNoErrs (tcSimplifyInteractive lie) ;
-- checkNoErrs ensures that the plan fails if context redn fails
+ traceTc (text "TcRnDriver.tcGhciStmts: done") ;
return (ids, mkHsDictLet const_binds $
noLoc (HsDo DoExpr tc_stmts (mk_return ids) io_ret_ty))
}
return good_names
}
-tcRnRecoverDataCon :: HscEnv -> Ptr () -> IO (Maybe DataCon)
-tcRnRecoverDataCon hsc_env ptr
- = initTcPrintErrors hsc_env iNTERACTIVE $
- setInteractiveContext hsc_env (hsc_IC hsc_env) $ do
- name <- dataConInfoPtrToName ptr
- tcLookupDataCon name
-
tcRnLookupName :: HscEnv -> Name -> IO (Maybe TyThing)
tcRnLookupName hsc_env name
= initTcPrintErrors hsc_env iNTERACTIVE $
-- in the home package all relevant modules are loaded.)
loadUnqualIfaces ictxt
- thing <- tcRnLookupName' name
+ thing <- tcRnLookupName' name
fixity <- lookupFixityRn name
- ispecs <- lookupInsts (icPrintUnqual ictxt) thing
+ ispecs <- lookupInsts thing
return (thing, fixity, ispecs)
-lookupInsts :: PrintUnqualified -> TyThing -> TcM [Instance]
--- Filter the instances by the ones whose tycons (or clases resp)
--- are in scope unqualified. Otherwise we list a whole lot too many!
-lookupInsts print_unqual (AClass cls)
+lookupInsts :: TyThing -> TcM [Instance]
+lookupInsts (AClass cls)
= do { inst_envs <- tcGetInstEnvs
- ; return [ ispec
- | ispec <- classInstances inst_envs cls
- , plausibleDFun print_unqual (instanceDFunId ispec) ] }
+ ; return (classInstances inst_envs cls) }
-lookupInsts print_unqual (ATyCon tc)
+lookupInsts (ATyCon tc)
= do { eps <- getEps -- Load all instances for all classes that are
-- in the type environment (which are all the ones
-- we've seen in any interface file so far)
; return [ ispec
| ispec <- instEnvElts home_ie ++ instEnvElts pkg_ie
, let dfun = instanceDFunId ispec
- , relevant dfun
- , plausibleDFun print_unqual dfun ] }
+ , relevant dfun ] }
where
relevant df = tc_name `elemNameSet` tyClsNamesOfDFunHead (idType df)
tc_name = tyConName tc
-lookupInsts print_unqual other = return []
-
-plausibleDFun print_unqual dfun -- Dfun involving only names that print unqualified
- = all ok (nameSetToList (tyClsNamesOfType (idType dfun)))
- where
- ok name | isBuiltInSyntax name = True
- | isExternalName name =
- isNothing $ fst print_unqual (nameModule name)
- (nameOccName name)
- | otherwise = True
+lookupInsts other = return []
loadUnqualIfaces :: InteractiveContext -> TcM ()
-- Load the home module for everything that is in scope unqualified