\section[TcModule]{Typechecking a whole module}
\begin{code}
--- 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/Commentary/CodingStyle#Warnings
--- for details
-
module TcRnDriver (
#ifdef GHCI
tcRnStmt, tcRnExpr, tcRnType,
tcRnLookupRdrName,
- tcRnLookupName,
- tcRnGetInfo,
getModuleExports,
#endif
+ tcRnLookupName,
+ tcRnGetInfo,
tcRnModule,
tcTopSrcDecls,
tcRnExtCore
import DynFlags
import StaticFlags
import HsSyn
-import RdrHsSyn
import PrelNames
import RdrName
import TcHsSyn
import VarEnv
import Var
import Module
-import LazyUniqFM
+import UniqFM
import Name
import NameEnv
import NameSet
import DataCon
import Type
import Class
+import TcType
import Data.List ( sortBy )
#ifdef GHCI
import MkId
import BasicTypes
import TidyPgm ( globaliseAndTidyId )
-import TcType ( isUnitTy, isTauTy, tyClsNamesOfDFunHead )
import TysWiredIn ( unitTy, mkListTy )
#endif
-- any mutually recursive types are done right
-- Just discard the auxiliary bindings; they are generated
-- only for Haskell source code, and should already be in Core
- (tcg_env, _aux_binds) <- tcTyAndClassDecls emptyModDetails rn_decls ;
+ (tcg_env, _aux_binds, _dm_ids) <- tcTyAndClassDecls emptyModDetails rn_decls ;
setGblEnv tcg_env $ do {
-- Make the new type env available to stuff slurped from interface files
-- Loops around dealing with each top level inter-splice group
-- in turn, until it's dealt with the entire module
tc_rn_src_decls boot_details ds
- = do { let { (first_group, group_tail) = findSplice ds } ;
+ = do { (first_group, group_tail) <- findSplice ds ;
-- If ds is [] we get ([], Nothing)
-- Deal with decls up to, but not including, the first splice
failWithTc (text "Can't do a top-level splice; need a bootstrapped compiler")
#else
-- If there's a splice, we must carry on
- Just (SpliceDecl splice_expr, rest_ds) -> do {
+ Just (SpliceDecl splice_expr _, rest_ds) -> do {
-- Rename the splice expression, and get its supporting decls
(rn_splice_expr, splice_fvs) <- checkNoErrs (rnLExpr splice_expr) ;
\begin{code}
tcRnHsBootDecls :: [LHsDecl RdrName] -> TcM TcGblEnv
tcRnHsBootDecls decls
- = do { let { (first_group, group_tail) = findSplice decls }
+ = do { (first_group, group_tail) <- findSplice decls
-- Rename the declarations
; (tcg_env, HsGroup {
-- Check for illegal declarations
; case group_tail of
- Just (SpliceDecl d, _) -> badBootDecl "splice" d
- Nothing -> return ()
+ Just (SpliceDecl d _, _) -> badBootDecl "splice" d
+ Nothing -> return ()
; mapM_ (badBootDecl "foreign") for_decls
; mapM_ (badBootDecl "default") def_decls
; mapM_ (badBootDecl "rule") rule_decls
-- Typecheck type/class decls
; traceTc (text "Tc2")
- ; (tcg_env, aux_binds) <- tcTyAndClassDecls emptyModDetails tycl_decls
- ; setGblEnv tcg_env $ do {
+ ; (tcg_env, aux_binds, dm_ids)
+ <- tcTyAndClassDecls emptyModDetails tycl_decls
+ ; setGblEnv tcg_env $
+ tcExtendIdEnv dm_ids $ do {
-- Typecheck instance decls
-- Family instance declarations are rejected here
-- Check instance declarations
; mb_dfun_prs <- mapM check_inst boot_insts
- ; let tcg_env' = tcg_env { tcg_binds = binds `unionBags` dfun_binds,
- tcg_type_env = extendTypeEnvWithIds local_type_env boot_dfuns }
- dfun_prs = catMaybes mb_dfun_prs
- boot_dfuns = map fst dfun_prs
- dfun_binds = listToBag [ mkVarBind boot_dfun (nlHsVar dfun)
- | (boot_dfun, dfun) <- dfun_prs ]
+ ; let dfun_prs = catMaybes mb_dfun_prs
+ boot_dfuns = map fst dfun_prs
+ dfun_binds = listToBag [ mkVarBind boot_dfun (nlHsVar dfun)
+ | (boot_dfun, dfun) <- dfun_prs ]
+ type_env' = extendTypeEnvWithIds local_type_env boot_dfuns
+ tcg_env' = tcg_env { tcg_binds = binds `unionBags` dfun_binds }
; failIfErrsM
- ; return tcg_env' }
+ ; setGlobalTypeEnv tcg_env' type_env' }
+ -- Update the global type env *including* the knot-tied one
+ -- so that if the source module reads in an interface unfolding
+ -- mentioning one of the dfuns from the boot module, then it
+ -- can "see" that boot dfun. See Trac #4003
where
check_export boot_avail -- boot_avail is exported by the boot iface
| name `elem` dfun_names = return ()
-- The latter come in via tycl_decls
traceTc (text "Tc2") ;
- (tcg_env, aux_binds) <- tcTyAndClassDecls boot_details tycl_decls ;
+ (tcg_env, aux_binds, dm_ids) <- tcTyAndClassDecls boot_details tycl_decls ;
-- If there are any errors, tcTyAndClassDecls fails here
- setGblEnv tcg_env $ do {
+ setGblEnv tcg_env $
+ tcExtendIdEnv dm_ids $ do {
+
-- Source-language instances, including derivings,
-- and import the supporting declarations
traceTc (text "Tc3") ;
(tc_val_binds, tcl_env) <- setLclTypeEnv tcl_env $
tcTopBinds val_binds;
+ setLclTypeEnv tcl_env $ do { -- Environment doesn't change now
+
-- Second pass over class and instance declarations,
traceTc (text "Tc6") ;
- (inst_binds, tcl_env) <- setLclTypeEnv tcl_env $
- tcInstDecls2 tycl_decls inst_infos ;
- showLIE (text "after instDecls2") ;
-
- setLclTypeEnv tcl_env $ do { -- Environment doesn't change now
+ inst_binds <- tcInstDecls2 tycl_decls inst_infos ;
+ showLIE (text "after instDecls2") ;
-- Foreign exports
traceTc (text "Tc7") ;
%*********************************************************
\begin{code}
-#ifdef GHCI
setInteractiveContext :: HscEnv -> InteractiveContext -> TcRn a -> TcRn a
setInteractiveContext hsc_env icxt thing_inside
= let -- Initialise the tcg_inst_env with instances from all home modules.
\begin{code}
+#ifdef GHCI
tcRnStmt :: HscEnv
-> InteractiveContext
-> LStmt RdrName
]}
mkPlan stmt@(L loc (BindStmt {}))
- | [L _ v] <- collectLStmtBinders stmt -- One binder, for a bind stmt
+ | [v] <- collectLStmtBinders stmt -- One binder, for a bind stmt
= do { let print_v = L loc $ ExprStmt (nlHsApp (nlHsVar printName) (nlHsVar v))
(HsVar thenIOName) placeHolderType
io_ret_ty = mkTyConApp ioTyCon [ret_ty] ;
tc_io_stmts stmts = tcStmts GhciStmt tcDoStmt stmts io_ret_ty ;
- names = map unLoc (collectLStmtsBinders stmts) ;
+ names = collectLStmtsBinders stmts ;
-- mk_return builds the expression
-- returnIO @ [()] [coerce () x, .., coerce () z]
getModuleExports hsc_env mod
= let
ic = hsc_IC hsc_env
- checkMods = ic_toplev_scope ic ++ ic_exports ic
+ checkMods = ic_toplev_scope ic ++ map fst (ic_exports ic)
in
initTc hsc_env HsSrcFile False iNTERACTIVE (tcGetModuleExports mod checkMods)
return good_names
}
+#endif
tcRnLookupName :: HscEnv -> Name -> IO (Messages, Maybe TyThing)
tcRnLookupName hsc_env name
_ -> panic "tcRnLookupName'"
tcRnGetInfo :: HscEnv
- -> Name
- -> IO (Messages, Maybe (TyThing, Fixity, [Instance]))
+ -> Name
+ -> IO (Messages, Maybe (TyThing, Fixity, [Instance]))
-- Used to implement :info in GHCi
--
-- *and* as a type or class constructor;
-- hence the call to dataTcOccs, and we return up to two results
tcRnGetInfo hsc_env name
- = initTcPrintErrors hsc_env iNTERACTIVE $
- let ictxt = hsc_IC hsc_env in
+ = initTcPrintErrors hsc_env iNTERACTIVE $
+ tcRnGetInfo' hsc_env name
+
+tcRnGetInfo' :: HscEnv
+ -> Name
+ -> TcRn (TyThing, Fixity, [Instance])
+tcRnGetInfo' hsc_env name
+ = let ictxt = hsc_IC hsc_env in
setInteractiveContext hsc_env ictxt $ do
-- Load the interface for all unqualified types and classes
isTcOcc (nameOccName name), -- Types and classes only
unQualOK gre ] -- In scope unqualified
doc = ptext (sLit "Need interface for module whose export(s) are in scope unqualified")
-#endif /* GHCI */
\end{code}
%************************************************************************
projects / ghc-hetmet.git / blobdiff