Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
30eee196
Commit
30eee196
authored
Apr 04, 2012
by
pcapriotti
Browse files
Update comments about Addr in foreign declarations.
parent
88d61ccd
Changes
2
Hide whitespace changes
Inline
Side-by-side
compiler/typecheck/TcForeign.lhs
View file @
30eee196
...
...
@@ -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
...
...
compiler/typecheck/TcType.lhs
View file @
30eee196
...
...
@@ -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
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment