- tcInstDecls2 inst_info `thenNF_Tc` \ (lie_instdecls, inst_binds) ->
- tcClassDecls2 cls_decls_bag `thenNF_Tc` \ (lie_clasdecls, cls_binds) ->
- tcGetEnv `thenNF_Tc` \ env ->
- returnTc ( (EmptyBinds, (inst_binds, cls_binds, env)),
- lie_instdecls `plusLIE` lie_clasdecls,
- () ))
-
- `thenTc` \ ((val_binds, (inst_binds, cls_binds, final_env)), lie_alldecls, _) ->
-
- checkTopLevelIds mod_name final_env `thenTc_`
-
- -- 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.)
- tcSimplifyTop lie_alldecls `thenTc` \ const_insts ->
- let
- localids = getEnv_LocalIds final_env
- tycons = getEnv_TyCons final_env
- classes = getEnv_Classes final_env
-
- local_tycons = filter isLocallyDefined tycons
- local_classes = filter isLocallyDefined classes
-
- exported_ids = [v | v <- localids,
- isExported v && not (isDataCon v) && not (isMethodSelId v)]
- in
- -- Backsubstitution. Monomorphic top-level decls may have
- -- been instantiated by subsequent decls, and the final
- -- simplification step may have instantiated some
- -- ambiguous types. So, sadly, we need to back-substitute
- -- over the whole bunch of bindings.
- zonkBinds val_binds `thenNF_Tc` \ val_binds' ->
- zonkBinds inst_binds `thenNF_Tc` \ inst_binds' ->
- zonkBinds cls_binds `thenNF_Tc` \ cls_binds' ->
- mapNF_Tc zonkInst const_insts `thenNF_Tc` \ const_insts' ->
- mapNF_Tc (zonkId.TcId) exported_ids `thenNF_Tc` \ exported_ids' ->
-
- -- FINISHED AT LAST
- returnTc (
- (cls_binds', inst_binds', val_binds', const_insts'),
-
- -- the next collection is just for mkInterface
- (fixities, exported_ids', tycons, classes, inst_info),
-
- (local_tycons, local_classes),
-
- tycon_specs,
-
- ddump_deriv
- )))
- where
- ty_decls_bag = listToBag ty_decls
- cls_decls_bag = listToBag cls_decls
- inst_decls_bag = listToBag inst_decls
-
+ tcInstDecls2 inst_info `thenNF_Tc` \ (lie_instdecls, inst_binds) ->
+ tcClassDecls2 decls `thenNF_Tc` \ (lie_clasdecls, cls_binds) ->
+
+
+ -- 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
+ in
+ tcSimplifyTop lie_alldecls `thenTc` \ const_inst_binds ->
+
+ -- Check that Main defines main
+ (if mod_name == mAIN then
+ tcLookupValueMaybe main_NAME `thenNF_Tc` \ maybe_main ->
+ checkTc (maybeToBool maybe_main) noMainErr
+ else
+ returnTc ()
+ ) `thenTc_`
+
+ -- Backsubstitution. This must be done last.
+ -- Even tcSimplifyTop may do some unification.
+ let
+ all_binds = data_binds `AndMonoBinds`
+ val_binds `AndMonoBinds`
+ inst_binds `AndMonoBinds`
+ cls_binds `AndMonoBinds`
+ const_inst_binds `AndMonoBinds`
+ foe_binds
+ in
+ zonkTopBinds all_binds `thenNF_Tc` \ (all_binds', really_final_env) ->
+ tcSetValueEnv really_final_env $
+ zonkForeignExports foe_decls `thenNF_Tc` \ foe_decls' ->
+
+ let
+ thin_air_ids = map (explicitLookupValueByKey really_final_env . nameUnique) thinAirIdNames
+ -- When looking up the thin-air names we must use
+ -- a global env that includes the zonked locally-defined Ids too
+ -- Hence using really_final_env
+ in
+ returnTc (really_final_env,
+ (all_binds', local_tycons, local_classes, inst_info,
+ (foi_decls ++ foe_decls'),
+ really_final_env,
+ thin_air_ids))
+ )
+
+ -- End of outer fix loop
+ ) `thenTc` \ (final_env, stuff) ->
+ returnTc stuff
+
+get_val_decls decls = foldr ThenBinds EmptyBinds [binds | ValD binds <- decls]