Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/30eee19678455308f6b00a58d8ee4c9790e49502 >--------------------------------------------------------------- commit 30eee19678455308f6b00a58d8ee4c9790e49502 Author: Paolo Capriotti <[email protected]> Date: Wed Apr 4 13:38:07 2012 +0100 Update comments about Addr in foreign declarations. >--------------------------------------------------------------- compiler/typecheck/TcForeign.lhs | 9 ++++----- compiler/typecheck/TcType.lhs | 8 +++----- 2 files changed, 7 insertions(+), 10 deletions(-) diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs index ab86f36..ae8ac26 100644 --- a/compiler/typecheck/TcForeign.lhs +++ b/compiler/typecheck/TcForeign.lhs @@ -210,10 +210,9 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport _ _ _ (CLabel _)) tcCheckFIType sig_ty arg_tys res_ty (CImport cconv safety mh CWrapper) = do -- Foreign wrapper (former f.e.d.) - -- The type must be of the form ft -> IO (FunPtr ft), where ft is a - -- valid foreign type. For legacy reasons ft -> IO (Ptr ft) as well - -- as ft -> IO Addr is accepted, too. The use of the latter two forms - -- is DEPRECATED, though. + -- The type must be of the form ft -> IO (FunPtr ft), where ft is a valid + -- foreign type. For legacy reasons ft -> IO (Ptr ft) is accepted, too. + -- The use of the latter form is DEPRECATED, though. checkCg checkCOrAsmOrLlvmOrInterp cconv' <- checkCConv cconv case arg_tys of @@ -229,7 +228,7 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety mh (CFunction ta | isDynamicTarget target = do -- Foreign import dynamic checkCg checkCOrAsmOrLlvmOrInterp cconv' <- checkCConv cconv - case arg_tys of -- The first arg must be Ptr, FunPtr, or Addr + case arg_tys of -- The first arg must be Ptr or FunPtr [] -> do check False (illegalForeignTyErr empty sig_ty) (arg1_ty:arg_tys) -> do diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs index 2c252e0..fc08bad 100644 --- a/compiler/typecheck/TcType.lhs +++ b/compiler/typecheck/TcType.lhs @@ -1338,9 +1338,8 @@ isFFIExportResultTy :: Type -> Bool isFFIExportResultTy ty = checkRepTyCon legalFEResultTyCon ty 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. +-- The type in a foreign import dynamic must be Ptr, FunPtr, 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 @@ -1355,8 +1354,7 @@ isFFIDynTy expected ty = False isFFILabelTy :: Type -> Bool --- The type of a foreign label must be Ptr, FunPtr, Addr, --- or a newtype of either. +-- The type of a foreign label must be Ptr, FunPtr, or a newtype of either. isFFILabelTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey] isFFIPrimArgumentTy :: DynFlags -> Type -> Bool _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
