#if alpha_TARGET_ARCH
import Type
import SMRep
-import MachOp
#endif
import Name
import OccName
tcFImport :: ForeignDecl Name -> TcM (Id, ForeignDecl Id)
tcFImport fo@(ForeignImport (L loc nm) hs_ty imp_decl)
- = addErrCtxt (foreignDeclCtxt fo) $ do
- sig_ty <- tcHsSigType (ForSigCtxt nm) hs_ty
- let
- -- drop the foralls before inspecting the structure
- -- of the foreign type.
- (_, t_ty) = tcSplitForAllTys sig_ty
- (arg_tys, res_ty) = tcSplitFunTys t_ty
- id = mkLocalId nm sig_ty
+ = addErrCtxt (foreignDeclCtxt fo) $
+ do { sig_ty <- tcHsSigType (ForSigCtxt nm) hs_ty
+ ; let
+ -- Drop the foralls before inspecting the
+ -- structure of the foreign type.
+ (_, t_ty) = tcSplitForAllTys sig_ty
+ (arg_tys, res_ty) = tcSplitFunTys t_ty
+ id = mkLocalId nm sig_ty
-- Use a LocalId to obey the invariant that locally-defined
-- things are LocalIds. However, it does not need zonking,
-- (so TcHsSyn.zonkForeignExports ignores it).
- imp_decl' <- tcCheckFIType sig_ty arg_tys res_ty imp_decl
- -- can't use sig_ty here because it :: Type and we need HsType Id
- -- hence the undefined
- return (id, ForeignImport (L loc id) undefined imp_decl')
+ ; imp_decl' <- tcCheckFIType sig_ty arg_tys res_ty imp_decl
+ -- Can't use sig_ty here because sig_ty :: Type and
+ -- we need HsType Id hence the undefined
+ ; return (id, ForeignImport (L loc id) undefined imp_decl') }
tcFImport d = pprPanic "tcFImport" (ppr d)
\end{code}
checkCg checkDotnet
dflags <- getDOpts
checkForeignArgs (isFFIDotnetTy dflags) arg_tys
- checkForeignRes True{-non IO ok-} (isFFIDotnetTy dflags) res_ty
+ checkForeignRes nonIOok (isFFIDotnetTy dflags) res_ty
let (DNCallSpec isStatic kind _ _ _ _) = spec
case kind of
DNMethod | not isStatic ->
_ -> return ()
return (DNImport (withDNTypes spec (map toDNType arg_tys) (toDNType res_ty)))
-tcCheckFIType sig_ty _ _ idecl@(CImport _ _ _ _ (CLabel _)) = do
- checkCg checkCOrAsm
- check (isFFILabelTy sig_ty) (illegalForeignTyErr empty sig_ty)
- return idecl
+tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport _ _ _ _ (CLabel _))
+ = ASSERT( null arg_tys )
+ do { checkCg checkCOrAsm
+ ; check (isFFILabelTy res_ty) (illegalForeignTyErr empty sig_ty)
+ ; return idecl } -- NB check res_ty not sig_ty!
+ -- In case sig_ty is (forall a. ForeignPtr a)
tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv _ _ _ CWrapper) = do
-- Foreign wrapper (former f.e.d.)
checkFEDArgs arg_tys
= check (integral_args <= 32) err
where
- integral_args = sum [ (machRepByteWidth . argMachRep . primRepToCgRep) prim_rep
+ integral_args = sum [ (widthInBytes . argMachRep . primRepToCgRep) prim_rep
| prim_rep <- map typePrimRep arg_tys,
primRepHint prim_rep /= FloatHint ]
err = ptext (sLit "On Alpha, I can only handle 32 bytes of non-floating-point arguments to foreign export dynamic")