+ traceTc (text "Tc7") `thenNF_Tc_`
+ zonkTopBinds all_binds `thenNF_Tc` \ (all_binds', final_env) ->
+ tcSetEnv final_env $
+ -- zonkTopBinds puts all the top-level Ids into the tcGEnv
+ traceTc (text "Tc8") `thenNF_Tc_`
+ zonkForeignExports foe_decls `thenNF_Tc` \ foe_decls' ->
+ traceTc (text "Tc9") `thenNF_Tc_`
+ zonkRules more_local_rules `thenNF_Tc` \ more_local_rules' ->
+
+
+ let local_things = filter (isLocalThing this_mod) (nameEnvElts (getTcGEnv final_env))
+
+ -- Create any necessary "implicit" bindings (data constructors etc)
+ -- Should we create bindings for dictionary constructors?
+ -- They are always fully applied, and the bindings are just there
+ -- to support partial applications. But it's easier to let them through.
+ implicit_binds = andMonoBindList [ CoreMonoBind id (unfoldingTemplate unf)
+ | id <- implicitTyThingIds local_things
+ , let unf = idUnfolding id
+ , hasUnfolding unf
+ ]
+
+ local_type_env :: TypeEnv
+ local_type_env = mkTypeEnv local_things
+
+ all_local_rules = local_rules ++ more_local_rules'
+ in
+ traceTc (text "Tc10") `thenNF_Tc_`
+ returnTc (final_env,
+ new_pcs,
+ TcResults { tc_env = local_type_env,
+ tc_insts = map iDFunId local_insts,
+ tc_binds = implicit_binds `AndMonoBinds` all_binds',
+ tc_fords = foi_decls ++ foe_decls',
+ tc_rules = all_local_rules
+ }
+ )
+ ) `thenTc` \ (_, pcs, tc_result) ->
+ returnTc (pcs, tc_result)
+ where
+ tycl_decls = [d | TyClD d <- decls]
+ val_binds = foldr ThenBinds EmptyBinds [binds | ValD binds <- decls]
+ source_rules = [d | RuleD d <- decls, not (isIfaceRuleDecl d)]
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Typechecking interface decls}
+%* *
+%************************************************************************
+
+\begin{code}
+typecheckIface
+ :: DynFlags
+ -> PersistentCompilerState
+ -> HomeSymbolTable
+ -> ModIface -- Iface for this module (just module & fixities)
+ -> [RenamedHsDecl]
+ -> IO (Maybe (PersistentCompilerState, ModDetails))
+ -- The new PCS is Augmented with imported information,
+ -- (but not stuff from this module).
+
+typecheckIface dflags pcs hst mod_iface decls
+ = do { maybe_tc_stuff <- typecheck dflags pcs hst alwaysQualify $
+ tcIfaceImports pcs hst get_fixity this_mod decls
+ ; printIfaceDump dflags maybe_tc_stuff
+ ; return maybe_tc_stuff }
+ where
+ this_mod = mi_module mod_iface
+ fixity_env = mi_fixities mod_iface
+
+ get_fixity :: Name -> Maybe Fixity
+ get_fixity nm = lookupNameEnv fixity_env nm
+
+ tcIfaceImports pcs hst get_fixity this_mod decls
+ = fixTc (\ ~(unf_env, _, _, _, _) ->
+ tcImports unf_env pcs hst get_fixity this_mod decls
+ ) `thenTc` \ (env, new_pcs, local_inst_info,
+ deriv_binds, local_rules) ->
+ ASSERT(nullBinds deriv_binds)
+ let
+ local_things = filter (isLocalThing this_mod) (nameEnvElts (getTcGEnv env))
+
+ mod_details = ModDetails { md_types = mkTypeEnv local_things,
+ md_insts = map iDFunId local_inst_info,
+ md_rules = [(id,rule) | IfaceRuleOut id rule <- local_rules],
+ md_binds = [] }
+ -- All the rules from an interface are of the IfaceRuleOut form
+ in
+ returnTc (new_pcs, mod_details)
+
+tcImports :: RecTcEnv
+ -> PersistentCompilerState
+ -> HomeSymbolTable
+ -> (Name -> Maybe Fixity)
+ -> Module
+ -> [RenamedHsDecl]
+ -> TcM (TcEnv, PersistentCompilerState, [InstInfo],
+ RenamedHsBinds, [TypecheckedRuleDecl])
+
+-- tcImports is a slight mis-nomer.
+-- It deals with everything that could be an import:
+-- type and class decls
+-- interface signatures (checked lazily)
+-- instance decls
+-- rule decls
+-- These can occur in source code too, of course
+
+tcImports unf_env pcs hst get_fixity this_mod decls
+ -- (unf_env :: RecTcEnv) is used for type-checking interface pragmas
+ -- which is done lazily [ie failure just drops the pragma
+ -- without having any global-failure effect].
+ --
+ -- unf_env is also used to get the pragama info
+ -- for imported dfuns and default methods
+
+ = checkNoErrsTc $
+ -- tcImports recovers internally, but if anything gave rise to
+ -- an error we'd better stop now, to avoid a cascade
+
+ traceTc (text "Tc1") `thenNF_Tc_`
+ tcTyAndClassDecls unf_env this_mod tycl_decls `thenTc` \ env ->
+ tcSetEnv env $
+
+ -- Typecheck the instance decls, includes deriving
+ traceTc (text "Tc2") `thenNF_Tc_`
+ tcInstDecls1 (pcs_insts pcs) (pcs_PRS pcs)
+ hst unf_env get_fixity this_mod
+ decls `thenTc` \ (new_pcs_insts, inst_env, local_insts, deriv_binds) ->
+ tcSetInstEnv inst_env $
+
+ -- Interface type signatures
+ -- We tie a knot so that the Ids read out of interfaces are in scope
+ -- when we read their pragmas.
+ -- What we rely on is that pragmas are typechecked lazily; if
+ -- any type errors are found (ie there's an inconsistency)
+ -- we silently discard the pragma
+ traceTc (text "Tc3") `thenNF_Tc_`
+ tcInterfaceSigs unf_env this_mod tycl_decls `thenTc` \ sig_ids ->
+ tcExtendGlobalValEnv sig_ids $
+
+
+ tcIfaceRules (pcs_rules pcs) this_mod iface_rules `thenNF_Tc` \ (new_pcs_rules, local_rules) ->
+ -- When relinking this module from its interface-file decls
+ -- we'll have IfaceRules that are in fact local to this module
+ -- That's the reason we we get any local_rules out here
+
+ tcGetEnv `thenTc` \ unf_env ->
+ let
+ all_things = nameEnvElts (getTcGEnv unf_env)
+
+ -- sometimes we're compiling in the context of a package module
+ -- (on the GHCi command line, for example). In this case, we
+ -- want to treat everything we pulled in as an imported thing.
+ imported_things
+ = filter (not . isLocalThing this_mod) all_things
+
+ new_pte :: PackageTypeEnv
+ new_pte = extendTypeEnvList (pcs_PTE pcs) imported_things
+
+ new_pcs :: PersistentCompilerState
+ new_pcs = pcs { pcs_PTE = new_pte,
+ pcs_insts = new_pcs_insts,
+ pcs_rules = new_pcs_rules
+ }
+ in
+ returnTc (unf_env, new_pcs, local_insts, deriv_binds, local_rules)
+ where
+ tycl_decls = [d | TyClD d <- decls]
+ iface_rules = [d | RuleD d <- decls, isIfaceRuleDecl d]
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Checking the type of main}
+%* *
+%************************************************************************
+
+We must check that in module Main,
+ a) main is defined
+ b) main :: forall a1...an. IO t, for some type t
+
+If we have
+ main = error "Urk"
+then the type of main will be
+ main :: forall a. a
+and that should pass the test too.
+
+So we just instantiate the type and unify with IO t, and declare
+victory if doing so succeeds.
+
+\begin{code}
+tcCheckMain :: Module -> TcM ()
+tcCheckMain this_mod
+ | not (moduleName this_mod == mAIN_Name )
+ = returnTc ()
+
+ | otherwise
+ = -- First unify the main_id with IO t, for any old t
+ tcLookup_maybe mainName `thenNF_Tc` \ maybe_thing ->
+ case maybe_thing of
+ Just (ATcId main_id) -> check_main_ty (idType main_id)
+ other -> addErrTc noMainErr
+ where
+ check_main_ty main_ty
+ = tcInstType main_ty `thenNF_Tc` \ (tvs, theta, main_tau) ->
+ newTyVarTy liftedTypeKind `thenNF_Tc` \ arg_ty ->
+ tcLookupTyCon ioTyConName `thenNF_Tc` \ ioTyCon ->
+ tcAddErrCtxtM (mainTypeCtxt main_ty) $
+ if not (null theta) then
+ failWithTc empty -- Context has the error message
+ else
+ unifyTauTy main_tau (mkTyConApp ioTyCon [arg_ty])
+
+mainTypeCtxt main_ty tidy_env
+ = zonkTcType main_ty `thenNF_Tc` \ main_ty' ->
+ returnNF_Tc (tidy_env, ptext SLIT("`main' has the illegal type") <+>
+ quotes (ppr (tidyType tidy_env main_ty')))
+
+noMainErr = hsep [ptext SLIT("Module") <+> quotes (ppr mAIN_Name),
+ ptext SLIT("must include a definition for") <+> quotes (ptext SLIT("main"))]