-zonkBinds :: TyVarEnv Type -> IdEnv Id
- -> TcHsBinds s -> NF_TcM s (TypecheckedHsBinds, IdEnv Id)
-
-zonkBinds te ve EmptyBinds = returnNF_Tc (EmptyBinds, ve)
-
-zonkBinds te ve (ThenBinds binds1 binds2)
- = zonkBinds te ve binds1 `thenNF_Tc` \ (new_binds1, ve1) ->
- zonkBinds te ve1 binds2 `thenNF_Tc` \ (new_binds2, ve2) ->
- returnNF_Tc (ThenBinds new_binds1 new_binds2, ve2)
-
-zonkBinds te ve (SingleBind bind)
- = fixNF_Tc (\ ~(_,new_ve) ->
- zonkBind te new_ve bind `thenNF_Tc` \ (new_bind, new_ids) ->
- returnNF_Tc (SingleBind new_bind, extend_ve ve new_ids)
- )
-
-zonkBinds te ve (AbsBinds tyvars dicts locprs dict_binds val_bind)
- = mapNF_Tc zonkTcTyVarToTyVar tyvars `thenNF_Tc` \ new_tyvars ->
- let
- new_te = extend_te te new_tyvars
- in
- mapNF_Tc (zonkIdBndr new_te) dicts `thenNF_Tc` \ new_dicts ->
- mapNF_Tc (zonkIdBndr new_te) globals `thenNF_Tc` \ new_globals ->
- let
- ve1 = extend_ve ve new_globals
- ve2 = extend_ve ve1 new_dicts
- in
- fixNF_Tc (\ ~(_, ve3) ->
- zonkDictBindsLocal new_te ve3 dict_binds `thenNF_Tc` \ (new_dict_binds, ds) ->
- zonkBind new_te ve3 val_bind `thenNF_Tc` \ (new_val_bind, ls) ->
- let
- new_locprs = zipEqual "zonkBinds" (map (zonkIdOcc ve3) locals) new_globals
- in
- returnNF_Tc (AbsBinds new_tyvars new_dicts new_locprs new_dict_binds new_val_bind,
- extend_ve ve2 (ds++ls))
- ) `thenNF_Tc` \ (binds, _) ->
- returnNF_Tc (binds, ve1) -- Yes, the "ve1" is right (SLPJ)
+zonkTopBinds :: TcMonoBinds s -> NF_TcM s (TypecheckedMonoBinds, TcEnv s)
+zonkTopBinds binds -- Top level is implicitly recursive
+ = fixNF_Tc (\ ~(_, new_ids) ->
+ tcExtendGlobalValEnv (bagToList new_ids) $
+ zonkMonoBinds emptyTyVarEnv binds `thenNF_Tc` \ (binds', new_ids) ->
+ tcGetEnv `thenNF_Tc` \ env ->
+ returnNF_Tc ((binds', env), new_ids)
+ ) `thenNF_Tc` \ (stuff, _) ->
+ returnNF_Tc stuff
+
+
+zonkBinds :: TyVarEnv Type
+ -> TcHsBinds s
+ -> NF_TcM s (TypecheckedHsBinds, TcEnv s)
+
+zonkBinds te binds
+ = go binds (\ binds' -> tcGetEnv `thenNF_Tc` \ env -> returnNF_Tc (binds', env))