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
66b047ee
Commit
66b047ee
authored
Dec 13, 2011
by
Simon Peyton Jones
Browse files
Towards fixing Trac
#5664
This patch makes normaliseFFIType recurse ito the arguments of FunPtr
parent
bb643386
Changes
1
Hide whitespace changes
Inline
Side-by-side
compiler/typecheck/TcForeign.lhs
View file @
66b047ee
...
...
@@ -84,8 +84,9 @@ normaliseFfiType' env ty0 = go [] ty0
go rec_nts ty@(TyConApp tc tys)
-- We don't want to look through the IO newtype, even if it is
-- in scope, so we have a special case for it:
| tc
`hasKey
` ioTyConKey
| tc
_key `elem
`
[
ioTyConKey
, funPtrTyConKey]
= children_only
| isNewTyCon tc -- Expand newtypes
-- We can't just use isRecursiveTyCon here, as we need to allow
-- some recursive types as described below
...
...
@@ -143,7 +144,7 @@ normaliseFfiType' env ty0 = go [] ty0
-- because whether an FFI type is legal or not depends only on
-- the top-level type constructor (e.g. "Ptr a" is valid for all a).
where
tc_key = getUnique tc
children_only = do xs <- mapM (go rec_nts) tys
let (cos, tys') = unzip xs
return (mkTyConAppCo tc cos, mkTyConApp tc tys')
...
...
@@ -230,6 +231,7 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv _ _ CWrapper) = do
[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?
where
(arg1_tys, res1_ty) = tcSplitFunTys arg1_ty
_ -> addErrTc (illegalForeignTyErr empty sig_ty)
...
...
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