+ -> TcM (PersistentCompilerState, TcResults)
+
+tcModule pcs hst get_fixity this_mod decls
+ = fixTc (\ ~(unf_env, _, _) ->
+ -- Loop back the final environment, including the fully zonkec
+ -- versions of bindings from this module. In the presence of mutual
+ -- recursion, interface type signatures may mention variables defined
+ -- in this module, which is why the knot is so big
+
+ -- Type-check the type and class decls, and all imported decls
+ tcImports unf_env pcs hst get_fixity this_mod decls
+ `thenTc` \ (env, new_pcs, local_insts, deriv_binds, local_rules) ->
+
+ tcSetEnv env $
+
+ -- Foreign import declarations next
+ traceTc (text "Tc4") `thenNF_Tc_`
+ tcForeignImports decls `thenTc` \ (fo_ids, foi_decls) ->
+ tcExtendGlobalValEnv fo_ids $
+
+ -- Default declarations
+ tcDefaults decls `thenTc` \ defaulting_tys ->
+ tcSetDefaultTys defaulting_tys $
+
+ -- Value declarations next.
+ -- We also typecheck any extra binds that came out of the "deriving" process
+ traceTc (text "Default types" <+> ppr defaulting_tys) `thenNF_Tc_`
+ traceTc (text "Tc5") `thenNF_Tc_`
+ tcTopBinds (val_binds `ThenBinds` deriv_binds) `thenTc` \ ((val_binds, env), lie_valdecls) ->
+
+ -- Second pass over class and instance declarations,
+ -- plus rules and foreign exports, to generate bindings
+ tcSetEnv env $
+ tcInstDecls2 local_insts `thenNF_Tc` \ (lie_instdecls, inst_binds) ->
+ tcClassDecls2 this_mod tycl_decls `thenNF_Tc` \ (lie_clasdecls, cls_dm_binds) ->
+ tcForeignExports decls `thenTc` \ (lie_fodecls, foe_binds, foe_decls) ->
+ tcSourceRules source_rules `thenNF_Tc` \ (lie_rules, more_local_rules) ->
+
+ -- Deal with constant or ambiguous InstIds. How could
+ -- there be ambiguous ones? They can only arise if a
+ -- top-level decl falls under the monomorphism
+ -- restriction, and no subsequent decl instantiates its
+ -- type. (Usually, ambiguous type variables are resolved
+ -- during the generalisation step.)
+ let
+ lie_alldecls = lie_valdecls `plusLIE`
+ lie_instdecls `plusLIE`
+ lie_clasdecls `plusLIE`
+ lie_fodecls `plusLIE`
+ lie_rules
+ in
+ traceTc (text "Tc6") `thenNF_Tc_`
+ tcSimplifyTop lie_alldecls `thenTc` \ const_inst_binds ->
+
+ -- CHECK THAT main IS DEFINED WITH RIGHT TYPE, IF REQUIRED
+ tcCheckMain this_mod `thenTc_`
+
+ -- Backsubstitution. This must be done last.
+ -- Even tcSimplifyTop may do some unification.
+ let
+ all_binds = val_binds `AndMonoBinds`
+ inst_binds `AndMonoBinds`
+ cls_dm_binds `AndMonoBinds`
+ const_inst_binds `AndMonoBinds`
+ foe_binds
+ in
+ 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_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)
+ -> (SyntaxMap, [RenamedHsDecl])
+ -> IO (Maybe (PersistentCompilerState, TypeEnv, [TypecheckedRuleDecl]))
+ -- The new PCS is Augmented with imported information,
+ -- (but not stuff from this module).
+ -- The TcResults returned contains only the environment
+ -- and rules.
+
+
+typecheckIface dflags pcs hst mod_iface (syn_map, decls)
+ = do { maybe_tc_stuff <- typecheck dflags syn_map 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))
+ local_type_env :: TypeEnv
+ local_type_env = mkTypeEnv local_things
+ in
+
+ -- throw away local_inst_info
+ returnTc (new_pcs, local_type_env, local_rules)
+
+
+tcImports :: RecTcEnv
+ -> PersistentCompilerState
+ -> HomeSymbolTable
+ -> (Name -> Maybe Fixity)
+ -> Module
+ -> [RenamedHsDecl]
+ -> TcM (TcEnv, PersistentCompilerState, [InstInfo],
+ RenamedHsBinds, [TypecheckedRuleDecl])
+
+-- tcImports is a slight mis-nomer.
+-- It deals with everythign that could be an import:
+-- type and class decls
+-- interface signatures
+-- 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 tycl_decls `thenTc` \ env ->