import StaticFlags
import HsSyn
import RdrHsSyn
-
import PrelNames
import RdrName
import TcHsSyn
import {- Kind parts of -} Type
import BasicTypes
import Foreign.Ptr( Ptr )
+import TidyPgm ( globaliseAndTidyId )
#endif
import FastString
gbl {
tcg_rdr_env = plusOccEnv (tcg_rdr_env gbl) rdr_env,
tcg_imports = tcg_imports gbl `plusImportAvails` imports,
- tcg_rn_imports = fmap (const rn_imports) (tcg_rn_imports gbl),
+ tcg_rn_imports = rn_imports,
tcg_inst_env = extendInstEnvList (tcg_inst_env gbl) home_insts,
tcg_fam_inst_env = extendFamInstEnvList (tcg_fam_inst_env gbl)
home_fam_insts,
-- Typecheck them all together so that
-- any mutually recursive types are done right
- tcg_env <- tcTyAndClassDecls emptyModDetails rn_decls ;
- -- Make the new type env available to stuff slurped from interface files
+ -- 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 ;
setGblEnv tcg_env $ do {
+ -- Make the new type env available to stuff slurped from interface files
-- Now the core bindings
core_binds <- initIfaceExtCore (tcExtCoreBindings src_binds) ;
my_exports = map (Avail . idName) bndrs ;
-- ToDo: export the data types also?
- final_type_env = extendTypeEnvWithIds (tcg_type_env tcg_env) bndrs ;
+ final_type_env =
+ extendTypeEnvWithIds (tcg_type_env tcg_env) bndrs ;
mod_guts = ModGuts { mg_module = this_mod,
mg_boot = False,
-- Typecheck type/class decls
; traceTc (text "Tc2")
- ; tcg_env <- tcTyAndClassDecls emptyModDetails tycl_decls
+ ; (tcg_env, aux_binds) <- tcTyAndClassDecls emptyModDetails tycl_decls
; setGblEnv tcg_env $ do {
-- Typecheck instance decls
-- Make the final type-env
-- Include the dfun_ids so that their type sigs
- -- are written into the interface file
+ -- are written into the interface file.
+ -- And similarly the aux_ids from aux_binds
; let { type_env0 = tcg_type_env gbl_env
; type_env1 = extendTypeEnvWithIds type_env0 val_ids
; type_env2 = extendTypeEnvWithIds type_env1 dfun_ids
- ; dfun_ids = map iDFunId inst_infos }
+ ; type_env3 = extendTypeEnvWithIds type_env1 aux_ids
+ ; dfun_ids = map iDFunId inst_infos
+ ; aux_ids = case aux_binds of
+ ValBindsOut _ sigs -> [id | L _ (IdSig id) <- sigs]
+ _ -> panic "tcRnHsBoodDecls"
+ }
+
; setGlobalTypeEnv gbl_env type_env2
}}}}
-- The latter come in via tycl_decls
traceTc (text "Tc2") ;
- tcg_env <- tcTyAndClassDecls boot_details tycl_decls ;
+ (tcg_env, aux_binds) <- tcTyAndClassDecls boot_details tycl_decls ;
-- If there are any errors, tcTyAndClassDecls fails here
setGblEnv tcg_env $ do {
<- tcInstDecls1 tycl_decls inst_decls deriv_decls;
setGblEnv tcg_env $ do {
- -- Foreign import declarations next. No zonking necessary
- -- here; we can tuck them straight into the global environment.
+ -- Foreign import declarations next.
traceTc (text "Tc4") ;
(fi_ids, fi_decls) <- tcForeignImports foreign_decls ;
tcExtendGlobalValEnv fi_ids $ do {
default_tys <- tcDefaults default_decls ;
updGblEnv (\gbl -> gbl { tcg_default = default_tys }) $ do {
+ -- Now GHC-generated derived bindings, generics, and selectors
+ -- Do not generate warnings from compiler-generated code;
+ -- hence the use of discardWarnings
+ (tc_aux_binds, tcl_env) <- discardWarnings (tcTopBinds aux_binds) ;
+ (tc_deriv_binds, tcl_env) <- setLclTypeEnv tcl_env $
+ discardWarnings (tcTopBinds deriv_binds) ;
+
-- Value declarations next
- -- We also typecheck any extra binds that came out
- -- of the "deriving" process (deriv_binds)
traceTc (text "Tc5") ;
- (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 $
- tcTopBinds deriv_binds ;
+ (tc_val_binds, tcl_env) <- setLclTypeEnv tcl_env $
+ tcTopBinds val_binds;
-- 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") ;
+ (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
-- Foreign exports
- -- They need to be zonked, so we return them
traceTc (text "Tc7") ;
(foe_binds, foe_decls) <- tcForeignExports foreign_decls ;
tcg_env <- getGblEnv ;
let { all_binds = tc_val_binds `unionBags`
tc_deriv_binds `unionBags`
+ tc_aux_binds `unionBags`
inst_binds `unionBags`
foe_binds;
return tcg_env
| otherwise
- = do { mb_main <- lookupSrcOcc_maybe main_fn
+ = do { mb_main <- lookupGlobalOccRn_maybe main_fn
-- Check that 'main' is in scope
-- It might be imported from another module!
; case mb_main of {
pp_main_fn | main_fn == main_RDR_Unqual = ptext (sLit "function") <+> quotes (ppr main_fn)
| otherwise = ptext (sLit "main function") <+> quotes (ppr main_fn)
+-- | Get the unqualified name of the function to use as the \"main\" for the main module.
+-- Either returns the default name or the one configured on the command line with -main-is
+getMainFun :: DynFlags -> RdrName
+getMainFun dflags = case (mainFunIs dflags) of
+ Just fn -> mkRdrUnqual (mkVarOccFS (mkFastString fn))
+ Nothing -> main_RDR_Unqual
\end{code}
Note [Root-main Id]
mapM bad_unboxed (filter (isUnLiftedType . idType) zonked_ids) ;
traceTc (text "tcs 1") ;
- let { global_ids = map globaliseAndTidy zonked_ids } ;
-
+ let { global_ids = map globaliseAndTidyId zonked_ids } ;
+ -- Note [Interactively-bound Ids in GHCi]
+
{- ---------------------------------------------
At one stage I removed any shadowed bindings from the type_env;
they are inaccessible but might, I suppose, cause a space leak if we leave them there.
where
bad_unboxed id = addErr (sep [ptext (sLit "GHCi can't bind a variable of unlifted type:"),
nest 2 (ppr id <+> dcolon <+> ppr (idType id))])
-
-globaliseAndTidy :: Id -> Id
-globaliseAndTidy id -- Note [Interactively-bound Ids in GHCi]
- = Id.setIdType (globaliseId VanillaGlobal id) tidy_type
- where
- tidy_type = tidyTopType (idType id)
\end{code}
Note [Interactively-bound Ids in GHCi]
failIfErrsM ;
-- Now kind-check the type
- (ty', kind) <- kcHsType rn_type ;
+ (ty', kind) <- kcLHsType rn_type ;
return kind
}
where
projects / ghc-hetmet.git / blobdiff