Commit 2a0cc7c5 authored by qrczak's avatar qrczak

[project @ 2000-08-24 13:32:17 by qrczak]

Let foreign import dynamic accept a newtyped Addr too.
parent 36880fdb
......@@ -62,13 +62,14 @@ module TysWiredIn (
wordTy,
wordTyCon,
isFFIArgumentTy, -- :: Bool -> Type -> Bool
isFFIResultTy, -- :: Type -> Bool
isFFIExternalTy, -- :: Type -> Bool
isFFIDynResultTy, -- :: Type -> Bool
isFFILabelTy, -- :: Type -> Bool
isAddrTy, -- :: Type -> Bool
isForeignObjTy -- :: Type -> Bool
isFFIArgumentTy, -- :: Bool -> Type -> Bool
isFFIResultTy, -- :: Type -> Bool
isFFIExternalTy, -- :: Type -> Bool
isFFIDynArgumentTy, -- :: Type -> Bool
isFFIDynResultTy, -- :: Type -> Bool
isFFILabelTy, -- :: Type -> Bool
isAddrTy, -- :: Type -> Bool
isForeignObjTy -- :: Type -> Bool
) where
......@@ -361,10 +362,17 @@ isFFIResultTy :: Type -> Bool
-- But we allow () as well
isFFIResultTy ty = checkRepTyCon (\tc -> tc == unitTyCon || legalIncomingTyCon tc) ty
isFFIDynArgumentTy :: Type -> Bool
-- The argument type of a foreign import dynamic must be either Addr, or
-- a newtype of Addr.
isFFIDynArgumentTy = checkRepTyCon (== addrTyCon)
isFFIDynResultTy :: Type -> Bool
-- The result type of a foreign export dynamic must be either Addr, or
-- a newtype of Addr.
isFFIDynResultTy = checkRepTyCon (== addrTyCon)
isFFILabelTy :: Type -> Bool
-- The type of a foreign label must be either Addr, or
-- a newtype of Addr.
isFFILabelTy = checkRepTyCon (== addrTyCon)
......
......@@ -42,8 +42,8 @@ import Type ( splitFunTys
, splitForAllTys
)
import TysWiredIn ( isFFIArgumentTy, isFFIResultTy,
isFFIExternalTy, isAddrTy,
isFFIDynResultTy, isFFILabelTy
isFFIExternalTy, isFFIDynArgumentTy, isFFIDynResultTy,
isFFILabelTy
)
import Type ( Type )
import Unique
......@@ -168,7 +168,7 @@ checkForeignImport is_dynamic is_safe ty args res
case args of
[] -> check False (illegalForeignTyErr True{-Arg-} ty)
(x:xs) ->
check (isAddrTy x) (illegalForeignTyErr True{-Arg-} ty) `thenTc_`
check (isFFIDynArgumentTy x) (illegalForeignTyErr True{-Arg-} ty) `thenTc_`
mapTc (checkForeignArg (isFFIArgumentTy is_safe)) xs `thenTc_`
checkForeignRes True {-NonIO ok-} isFFIResultTy res
| otherwise =
......@@ -180,7 +180,7 @@ checkForeignExport is_dynamic ty args res
| is_dynamic =
-- * the first (and only!) arg has got to be a function type
-- and it must return IO t
-- * result type is an Addr or IO Addr
-- * result type is IO Addr
case args of
[arg] ->
case splitFunTys arg of
......
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