Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/88d61ccd9450ed41b99136269a97b2c118462fa4 >--------------------------------------------------------------- commit 88d61ccd9450ed41b99136269a97b2c118462fa4 Author: Paolo Capriotti <[email protected]> Date: Tue Apr 3 10:41:52 2012 +0100 Improved checks for "dynamic" and "wrapper" foreign declarations (#5664) >--------------------------------------------------------------- compiler/typecheck/TcForeign.lhs | 6 ++-- compiler/typecheck/TcType.lhs | 43 ++++++++++++++++++++++++++++--------- 2 files changed, 35 insertions(+), 14 deletions(-) diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs index 7bda323..ab86f36 100644 --- a/compiler/typecheck/TcForeign.lhs +++ b/compiler/typecheck/TcForeign.lhs @@ -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 diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs index e9af201..2c252e0 100644 --- a/compiler/typecheck/TcType.lhs +++ b/compiler/typecheck/TcType.lhs @@ -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 ---------------------------------------------- _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
