-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 (MonoBind bind sigs is_rec)
- = ASSERT( null sigs )
- fixNF_Tc (\ ~(_,new_ve) ->
- zonkMonoBinds te new_ve bind `thenNF_Tc` \ (new_bind, new_ids) ->
- returnNF_Tc (MonoBind new_bind [] is_rec, extend_ve ve new_ids)
- )
+zonkTopBinds :: TcMonoBinds -> NF_TcM s (TypecheckedMonoBinds, ValueEnv)
+zonkTopBinds binds -- Top level is implicitly recursive
+ = fixNF_Tc (\ ~(_, new_ids) ->
+ tcExtendGlobalValEnv (bagToList new_ids) $
+ zonkMonoBinds binds `thenNF_Tc` \ (binds', new_ids) ->
+ tcGetValueEnv `thenNF_Tc` \ env ->
+ returnNF_Tc ((binds', env), new_ids)
+ ) `thenNF_Tc` \ (stuff, _) ->
+ returnNF_Tc stuff
+
+zonkBinds :: TcHsBinds -> NF_TcM s (TypecheckedHsBinds, TcEnv)
+
+zonkBinds binds
+ = go binds (\ binds' -> tcGetEnv `thenNF_Tc` \ env ->
+ returnNF_Tc (binds', env))
+ where
+ -- go :: TcHsBinds
+ -- -> (TypecheckedHsBinds
+ -- -> NF_TcM s (TypecheckedHsBinds, TcEnv)
+ -- )
+ -- -> NF_TcM s (TypecheckedHsBinds, TcEnv)
+
+ go (ThenBinds b1 b2) thing_inside = go b1 $ \ b1' ->
+ go b2 $ \ b2' ->
+ thing_inside (b1' `ThenBinds` b2')
+
+ go EmptyBinds thing_inside = thing_inside EmptyBinds
+
+ go (MonoBind bind sigs is_rec) thing_inside
+ = ASSERT( null sigs )
+ fixNF_Tc (\ ~(_, new_ids) ->
+ tcExtendGlobalValEnv (bagToList new_ids) $
+ zonkMonoBinds bind `thenNF_Tc` \ (new_bind, new_ids) ->
+ thing_inside (mkMonoBind new_bind [] is_rec) `thenNF_Tc` \ stuff ->
+ returnNF_Tc (stuff, new_ids)
+ ) `thenNF_Tc` \ (stuff, _) ->
+ returnNF_Tc stuff