import CoreUtils ( exprType, mkInlineMe )
import Id ( Id, idType, idName, mkSysLocal, setInlinePragma )
import Literal ( Literal(..), mkStringLit )
import CoreUtils ( exprType, mkInlineMe )
import Id ( Id, idType, idName, mkSysLocal, setInlinePragma )
import Literal ( Literal(..), mkStringLit )
import Type ( repType, coreEqType )
import TcType ( Type, mkFunTys, mkForAllTys, mkTyConApp,
mkFunTy, tcSplitTyConApp_maybe,
import Type ( repType, coreEqType )
import TcType ( Type, mkFunTys, mkForAllTys, mkTyConApp,
mkFunTy, tcSplitTyConApp_maybe,
= dsCImport id spec cconv safety no_hdrs `thenDs` \(ids, h, c) ->
returnDs (ids, h, c, if no_hdrs then Nothing else Just header)
where
= dsCImport id spec cconv safety no_hdrs `thenDs` \(ids, h, c) ->
returnDs (ids, h, c, if no_hdrs then Nothing else Just header)
where
-- FIXME: the `lib' field is needed for .NET ILX generation when invoking
-- routines that are external to the .NET runtime, but GHC doesn't
-- FIXME: the `lib' field is needed for .NET ILX generation when invoking
-- routines that are external to the .NET runtime, but GHC doesn't
- -- These are the ids we pass to boxResult, which are used to decide
- -- whether to touch# an argument after the call (used to keep
- -- ForeignObj#s live across a 'safe' foreign import).
- maybe_arg_ids | unsafe_call fcall = work_arg_ids
- | otherwise = []
-
the_ccall_app = mkFCall ccall_uniq fcall val_args ccall_result_ty
work_rhs = mkLams tvs (mkLams work_arg_ids the_ccall_app)
work_id = setImpInline no_hdrs $ -- See comments with setImpInline
the_ccall_app = mkFCall ccall_uniq fcall val_args ccall_result_ty
work_rhs = mkLams tvs (mkLams work_arg_ids the_ccall_app)
work_id = setImpInline no_hdrs $ -- See comments with setImpInline
getModuleDs `thenDs` \ mod_name ->
let
-- hack: need to get at the name of the C stub we're about to generate.
getModuleDs `thenDs` \ mod_name ->
let
-- hack: need to get at the name of the C stub we're about to generate.
in
newSysLocalDs arg_ty `thenDs` \ cback ->
dsLookupGlobalId newStablePtrName `thenDs` \ newStablePtrId ->
in
newSysLocalDs arg_ty `thenDs` \ cback ->
dsLookupGlobalId newStablePtrName `thenDs` \ newStablePtrId ->
Nothing -> text "(StgClosure*)deRefStablePtr(the_stableptr)"
Just hs_fn -> char '&' <> ppr hs_fn <> text "_closure"
Nothing -> text "(StgClosure*)deRefStablePtr(the_stableptr)"
Just hs_fn -> char '&' <> ppr hs_fn <> text "_closure"
-- the expression we give to rts_evalIO
expr_to_run
= foldl appArg the_cfun arg_info -- NOT aug_arg_info
where
appArg acc (arg_cname, _, arg_hty, _)
= text "rts_apply"
-- the expression we give to rts_evalIO
expr_to_run
= foldl appArg the_cfun arg_info -- NOT aug_arg_info
where
appArg acc (arg_cname, _, arg_hty, _)
= text "rts_apply"