X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcForeign.lhs;h=df3f1ef581046ef2bd1bbc652346ab0be6a42607;hb=c7fa9243867d49177c9ebc7923588488dbd3a369;hp=23756d97c351b99de50b5f66d827140595a3455d;hpb=2da37f4f15790377900fa6c38ff8fdcd394dfaa2;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs
index 23756d9..df3f1ef 100644
--- a/compiler/typecheck/TcForeign.lhs
+++ b/compiler/typecheck/TcForeign.lhs
@@ -35,7 +35,6 @@ import Type
 import SMRep
 #endif
 import Name
-import OccName
 import TcType
 import DynFlags
 import Outputable
@@ -108,7 +107,7 @@ tcCheckFIType _ arg_tys res_ty (DNImport spec) = do
        _ -> return ()
     return (DNImport (withDNTypes spec (map toDNType arg_tys) (toDNType res_ty)))
 
-tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport _ safety _ _ (CLabel _))
+tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport _ safety _ (CLabel _))
   = ASSERT( null arg_tys )
     do { checkCg checkCOrAsm
        ; checkSafety safety
@@ -116,7 +115,7 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport _ safety _ _ (CLabel _))
        ; 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 safety _ _ CWrapper) = do
+tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety _ 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
@@ -135,7 +134,7 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety _ _ CWrapper) =
         _ -> addErrTc (illegalForeignTyErr empty sig_ty)
     return idecl
 
-tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety _ _ (CFunction target))
+tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety _ (CFunction target))
   | isDynamicTarget target = do -- Foreign import dynamic
       checkCg checkCOrAsmOrInterp
       checkCConv cconv
@@ -152,11 +151,13 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety _ _ (CFunction t
           checkForeignRes nonIOok (isFFIImportResultTy dflags) res_ty
           return idecl
   | cconv == PrimCallConv = do
+      dflags <- getDOpts
+      check (dopt Opt_GHCForeignImportPrim dflags)
+            (text "Use -XGHCForeignImportPrim to allow `foreign import prim'.")
       checkCg (checkCOrAsmOrDotNetOrInterp)
       checkCTarget target
-      check (safety == PlayRisky)
-            (text "A `foreign import prim' must always be annotated as `unsafe'")
-      dflags <- getDOpts
+      check (playSafe safety)
+            (text "The safe/unsafe annotation should not be used with `foreign import prim'.")
       checkForeignArgs (isFFIPrimArgumentTy dflags) arg_tys
       -- prim import result is more liberal, allows (#,,#)
       checkForeignRes nonIOok (isFFIPrimResultTy dflags) res_ty