- -- The function already returns IO t
- returnDs (\body -> body, orig_res_ty, res_ty)
-
- other -> -- The function returns t, so wrap the call in returnIO
- dsLookupGlobalValue returnIOName `thenDs` \ retIOId ->
- returnDs (\body -> mkApps (Var retIOId) [Type orig_res_ty, body],
- tcFunResultTy (applyTy (idType retIOId) orig_res_ty),
- -- We don't have ioTyCon conveniently to hand
- orig_res_ty)
-
- ) `thenDs` \ (return_io_wrapper, -- Either identity or returnIO
- io_res_ty, -- IO t
- res_ty) -> -- t
-
-
- -- BUILD THE deRefStablePtr WRAPPER, if necessary
- (if isDyn then
- newSysLocalDs stbl_ptr_ty `thenDs` \ stbl_ptr ->
- newSysLocalDs stbl_ptr_to_ty `thenDs` \ stbl_value ->
- dsLookupGlobalValue deRefStablePtrName `thenDs` \ deRefStablePtrId ->
- dsLookupGlobalValue bindIOName `thenDs` \ bindIOId ->
- let
- the_deref_app = mkApps (Var deRefStablePtrId)
- [ Type stbl_ptr_to_ty, Var stbl_ptr ]
-
- stbl_app cont = mkApps (Var bindIOId)
- [ Type stbl_ptr_to_ty
- , Type res_ty
- , the_deref_app
- , mkLams [stbl_value] cont]
- in
- returnDs (stbl_value, stbl_app, stbl_ptr)
- else
- returnDs (fn_id,
- \ body -> body,
- panic "stbl_ptr" -- should never be touched.
- )) `thenDs` \ (i, getFun_wrapper, stbl_ptr) ->
-
-
- -- BUILD THE HELPER
- getModuleDs `thenDs` \ mod ->
- getUniqueDs `thenDs` \ uniq ->
- getSrcLocDs `thenDs` \ src_loc ->
- newSysLocalsDs fe_arg_tys `thenDs` \ fe_args ->
+ -- The function already returns IO t
+ returnDs (res_ty, True)
+
+ other -> -- The function returns t
+ returnDs (orig_res_ty, False)
+ )
+ `thenDs` \ (res_ty, -- t
+ is_IO_res_ty) -> -- Bool