import TyCon
import Coercion
import TcType
-import Var
import CmmExpr
+import qualified Var
import CmmUtils
import HscTypes
import ForeignCall
IsFunction
_ -> IsData
(resTy, foRhs) <- resultWrapper ty
- ASSERT(fromJust resTy `coreEqType` addrPrimTy) -- typechecker ensures this
+ ASSERT(fromJust resTy `eqType` addrPrimTy) -- typechecker ensures this
let
rhs = foRhs (Lit (MachLabel cid stdcall_info fod))
stdcall_info = fun_type_arg_stdcall_info cconv ty
ccall_adj <- dsCCall adjustor adj_args PlayRisky (mkTyConApp io_tc [res_ty])
-- PlayRisky: the adjustor doesn't allocate in the Haskell heap or do a callback
- let io_app = mkLams tvs $
- Lam cback $
- mkCoerceI (mkSymCoI co) $
+ let io_app = mkLams tvs $
+ Lam cback $
+ mkCoerce (mkSymCo co) $
mkApps (Var bindIOId)
[ Type stable_ptr_ty
, Type res_ty
typeCmmType (mkStablePtrPrimTy alphaTy))
-- stuff to do with the return type of the C function
- res_hty_is_unit = res_hty `coreEqType` unitTy -- Look through any newtypes
+ res_hty_is_unit = res_hty `eqType` unitTy -- Look through any newtypes
cResType | res_hty_is_unit = text "void"
| otherwise = showStgType res_hty
the_cfun
= case maybe_target of
Nothing -> text "(StgClosure*)deRefStablePtr(the_stableptr)"
- Just hs_fn -> char '&' <> ppr hs_fn <> text "_closure"
+ Just hs_fn -> char '&' <> ppr hs_fn <> text (closureSuffix hs_fn)
cap = text "cap" <> comma
extern_decl
= case maybe_target of
Nothing -> empty
- Just hs_fn -> text "extern StgClosure " <> ppr hs_fn <> text "_closure" <> semi
+ Just hs_fn -> text "extern StgClosure " <> ppr hs_fn <> text (closureSuffix hs_fn) <> semi
-
-- finally, the whole darn thing
c_bits =
space $$
, rbrace
]
+closureSuffix :: Id -> String
+closureSuffix hs_fn =
+ if depth==0 then "_closure" else "_"++(show depth)++"closure"
+ where depth = getNameDepth (Var.varName hs_fn)
foreignExportInitialiser :: Id -> SDoc
foreignExportInitialiser hs_fn =
<> text "() __attribute__((constructor));"
, text "static void stginit_export_" <> ppr hs_fn <> text "()"
, braces (text "getStablePtr"
- <> parens (text "(StgPtr) &" <> ppr hs_fn <> text "_closure")
+ <> parens (text "(StgPtr) &" <> ppr hs_fn <> text (closureSuffix hs_fn))
<> semi)
]
-
mkHObj :: Type -> SDoc
mkHObj t = text "rts_mk" <> text (showFFIType t)
-- e.g. 'W' is a signed 32-bit integer.
primTyDescChar :: Type -> Char
primTyDescChar ty
- | ty `coreEqType` unitTy = 'v'
+ | ty `eqType` unitTy = 'v'
| otherwise
= case typePrimRep (getPrimTyOf ty) of
IntRep -> signed_word