- tcBindWithSigs top_lvl bind tc_ty_sigs
- sigs is_rec `thenTc` \ (poly_binds, poly_lie, poly_ids) ->
-
- -- Extend the environment to bind the new polymorphic Ids
- tcExtendLocalValEnv poly_ids $
-
- -- Build bindings and IdInfos corresponding to user pragmas
- tcSpecSigs sigs `thenTc` \ (prag_binds, prag_lie) ->
-
- -- Now do whatever happens next, in the augmented envt
- do_next `thenTc` \ (thing, thing_lie) ->
-
- -- Create specialisations of functions bound here
- -- We want to keep non-recursive things non-recursive
- -- so that we desugar unlifted bindings correctly
- case (top_lvl, is_rec) of
-
- -- For the top level don't bother will all this bindInstsOfLocalFuns stuff
- -- All the top level things are rec'd together anyway, so it's fine to
- -- leave them to the tcSimplifyTop, and quite a bit faster too
- (TopLevel, _)
- -> returnTc (combiner Recursive (poly_binds `andMonoBinds` prag_binds) thing,
- thing_lie `plusLIE` prag_lie `plusLIE` poly_lie)
-
- (NotTopLevel, NonRecursive)
- -> bindInstsOfLocalFuns
- (thing_lie `plusLIE` prag_lie)
- poly_ids `thenTc` \ (thing_lie', lie_binds) ->
-
- returnTc (
- combiner NonRecursive poly_binds $
- combiner NonRecursive prag_binds $
- combiner Recursive lie_binds $
+ case top_lvl of
+ TopLevel -- For the top level don't bother will all this
+ -- bindInstsOfLocalFuns stuff. All the top level
+ -- things are rec'd together anyway, so it's fine to
+ -- leave them to the tcSimplifyTop, and quite a bit faster too
+ --
+ -- Subtle (and ugly) point: furthermore at top level we
+ -- return the TcLclEnv, which contains the LIE var; we
+ -- don't want to return the wrong one!
+ -> tc_body poly_ids `thenM` \ (prag_binds, thing) ->
+ returnM (combiner (mkMonoBind Recursive (poly_binds `andMonoBinds` prag_binds))
+ thing)
+
+ NotTopLevel -- For nested bindings we must
+ -> getLIE (tc_body poly_ids) `thenM` \ ((prag_binds, thing), lie) ->
+
+ -- Create specialisations of functions bound here
+ bindInstsOfLocalFuns lie poly_ids `thenM` \ lie_binds ->
+
+ -- We want to keep non-recursive things non-recursive
+ -- so that we desugar unlifted bindings correctly
+ if isRec is_rec then
+ returnM (
+ combiner (mkMonoBind Recursive (
+ poly_binds `andMonoBinds`
+ lie_binds `andMonoBinds`
+ prag_binds)) thing
+ )
+ else
+ returnM (
+ combiner (mkMonoBind NonRecursive poly_binds) $
+ combiner (mkMonoBind NonRecursive prag_binds) $
+ combiner (mkMonoBind Recursive lie_binds) $