Commit 88d61ccd authored by pcapriotti's avatar pcapriotti

Improved checks for "dynamic" and "wrapper" foreign declarations (#5664)

parent e7e5e277
......@@ -219,8 +219,7 @@ tcCheckFIType sig_ty arg_tys res_ty (CImport cconv safety mh CWrapper) = do
case arg_tys of
[arg1_ty] -> do checkForeignArgs isFFIExternalTy arg1_tys
checkForeignRes nonIOok checkSafe isFFIExportResultTy res1_ty
checkForeignRes mustBeIO checkSafe isFFIDynResultTy res_ty
-- ToDo: Why are res1_ty and res_ty not equal?
checkForeignRes mustBeIO checkSafe (isFFIDynTy arg1_ty) res_ty
where
(arg1_tys, res1_ty) = tcSplitFunTys arg1_ty
_ -> addErrTc (illegalForeignTyErr empty sig_ty)
......@@ -235,7 +234,8 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety mh (CFunction ta
check False (illegalForeignTyErr empty sig_ty)
(arg1_ty:arg_tys) -> do
dflags <- getDynFlags
check (isFFIDynArgumentTy arg1_ty)
let curried_res_ty = foldr FunTy res_ty arg_tys
check (isFFIDynTy curried_res_ty arg1_ty)
(illegalForeignTyErr argument arg1_ty)
checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys
checkForeignRes nonIOok checkSafe (isFFIImportResultTy dflags) res_ty
......
......@@ -102,8 +102,7 @@ module TcType (
isFFIImportResultTy, -- :: DynFlags -> Type -> Bool
isFFIExportResultTy, -- :: Type -> Bool
isFFIExternalTy, -- :: Type -> Bool
isFFIDynArgumentTy, -- :: Type -> Bool
isFFIDynResultTy, -- :: Type -> Bool
isFFIDynTy, -- :: Type -> Type -> Bool
isFFIPrimArgumentTy, -- :: DynFlags -> Type -> Bool
isFFIPrimResultTy, -- :: DynFlags -> Type -> Bool
isFFILabelTy, -- :: Type -> Bool
......@@ -1338,15 +1337,22 @@ isFFIImportResultTy dflags ty
isFFIExportResultTy :: Type -> Bool
isFFIExportResultTy ty = checkRepTyCon legalFEResultTyCon ty
isFFIDynArgumentTy :: Type -> Bool
-- The argument type of a foreign import dynamic must be Ptr, FunPtr, Addr,
-- or a newtype of either.
isFFIDynArgumentTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
isFFIDynResultTy :: Type -> Bool
-- The result type of a foreign export dynamic must be Ptr, FunPtr, Addr,
-- or a newtype of either.
isFFIDynResultTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
isFFIDynTy :: Type -> Type -> Bool
-- The type in a foreign import dynamic must be Ptr, FunPtr, Addr,
-- or a newtype of either, and the wrapped function type must be equal
-- to the given type.
-- We assume that all types have been run through normalizeFfiType, so we don't
-- need to worry about expanding newtypes here.
isFFIDynTy expected ty
-- Note [Foreign import dynamic]
-- In the example below, expected would be 'CInt -> IO ()', while ty would
-- be 'FunPtr (CDouble -> IO ())'.
| Just (tc, [ty']) <- splitTyConApp_maybe ty
, tyConUnique tc `elem` [ptrTyConKey, funPtrTyConKey]
, eqType ty' expected
= True
| otherwise
= False
isFFILabelTy :: Type -> Bool
-- The type of a foreign label must be Ptr, FunPtr, Addr,
......@@ -1401,6 +1407,21 @@ checkRepTyConKey keys
= checkRepTyCon (\tc -> tyConUnique tc `elem` keys)
\end{code}
Note [Foreign import dynamic]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A dynamic stub must be of the form 'FunPtr ft -> ft' where ft is any foreign
type. Similarly, a wrapper stub must be of the form 'ft -> IO (FunPtr ft)'.
We use isFFIDynTy to check whether a signature is well-formed. For example,
given a (illegal) declaration like:
foreign import ccall "dynamic"
foo :: FunPtr (CDouble -> IO ()) -> CInt -> IO ()
isFFIDynTy will compare the 'FunPtr' type 'CDouble -> IO ()' with the curried
result type 'CInt -> IO ()', and return False, as they are not equal.
----------------------------------------------
These chaps do the work; they are not exported
----------------------------------------------
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment