X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcForeign.lhs;fp=compiler%2Ftypecheck%2FTcForeign.lhs;h=5e877bb36e53f20c8efa91250fa9de15f30a2c43;hb=25a327cfe5f619a7923d268a7c68f197922f95a0;hp=d3a24a0630612c1be4a226a7540016204bcb8800;hpb=43213e90f8f17b0fd55f030aac64453249a3af16;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs
index d3a24a0..5e877bb 100644
--- a/compiler/typecheck/TcForeign.lhs
+++ b/compiler/typecheck/TcForeign.lhs
@@ -108,10 +108,12 @@ tcCheckFIType _ arg_tys res_ty (DNImport spec) = do
        _ -> return ()
     return (DNImport (withDNTypes spec (map toDNType arg_tys) (toDNType res_ty)))
 
-tcCheckFIType sig_ty _ _ idecl@(CImport _ _ _ _ (CLabel _)) = do
-    checkCg checkCOrAsm
-    check (isFFILabelTy sig_ty) (illegalForeignTyErr empty sig_ty)
-    return idecl
+tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport _ _ _ _ (CLabel _)) 
+  = ASSERT( null arg_tys )
+    do { checkCg checkCOrAsm
+       ; check (isFFILabelTy res_ty) (illegalForeignTyErr empty sig_ty)
+       ; return idecl }	     -- NB check res_ty not sig_ty!
+       	 	      	     --    In case sig_ty is (forall a. ForeignPtr a)
 
 tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv _ _ _ CWrapper) = do
    	-- Foreign wrapper (former f.e.d.)