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

Let foreign import dynamic accept a newtyped Addr too.

diff --git a/ghc/compiler/prelude/TysWiredIn.lhs b/ghc/compiler/prelude/TysWiredIn.lhs
index e132166..d9b7e9d 100644 (file)
--- a/ghc/compiler/prelude/TysWiredIn.lhs
+++ b/ghc/compiler/prelude/TysWiredIn.lhs
@@ -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)

diff --git a/ghc/compiler/typecheck/TcForeign.lhs b/ghc/compiler/typecheck/TcForeign.lhs
index c84c3c8..4c00838 100644 (file)
--- a/ghc/compiler/typecheck/TcForeign.lhs
+++ b/ghc/compiler/typecheck/TcForeign.lhs
@@ -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