Require GHCForeignImportPrim for "foreign import prim"

In practise currently you also need UnliftedFFITypes, however
the restriction to just unlifted types may be lifted in future.

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index d8b2e78..f4971cd 100644 (file)
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -203,6 +203,7 @@ data DynFlag
    | Opt_ExtendedDefaultRules           -- Use GHC's extended rules for defaulting
    | Opt_ForeignFunctionInterface
    | Opt_UnliftedFFITypes
    | Opt_ExtendedDefaultRules           -- Use GHC's extended rules for defaulting
    | Opt_ForeignFunctionInterface
    | Opt_UnliftedFFITypes

+   | Opt_GHCForeignImportPrim

    | Opt_PArr                           -- Syntactic support for parallel arrays
    | Opt_Arrows                         -- Arrow-notation syntax
    | Opt_TemplateHaskell
    | Opt_PArr                           -- Syntactic support for parallel arrays
    | Opt_Arrows                         -- Arrow-notation syntax
    | Opt_TemplateHaskell

@@ -1759,6 +1760,7 @@ xFlags = [
   ( "TransformListComp",                Opt_TransformListComp, const Supported ),
   ( "ForeignFunctionInterface",         Opt_ForeignFunctionInterface, const Supported ),
   ( "UnliftedFFITypes",                 Opt_UnliftedFFITypes, const Supported ),
   ( "TransformListComp",                Opt_TransformListComp, const Supported ),
   ( "ForeignFunctionInterface",         Opt_ForeignFunctionInterface, const Supported ),
   ( "UnliftedFFITypes",                 Opt_UnliftedFFITypes, const Supported ),

+  ( "GHCForeignImportPrim",             Opt_GHCForeignImportPrim, const Supported ),

   ( "LiberalTypeSynonyms",              Opt_LiberalTypeSynonyms, const Supported ),
   ( "Rank2Types",                       Opt_Rank2Types, const Supported ),
   ( "RankNTypes",                       Opt_RankNTypes, const Supported ),
   ( "LiberalTypeSynonyms",              Opt_LiberalTypeSynonyms, const Supported ),
   ( "Rank2Types",                       Opt_Rank2Types, const Supported ),
   ( "RankNTypes",                       Opt_RankNTypes, const Supported ),

diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs
index 1a8a3f3..52b1ec6 100644 (file)
--- a/compiler/typecheck/TcForeign.lhs
+++ b/compiler/typecheck/TcForeign.lhs
@@ -152,11 +152,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
           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 (playSafe safety)
             (text "The safe/unsafe annotation should not be used with `foreign import prim'.")
       checkCg (checkCOrAsmOrDotNetOrInterp)
       checkCTarget target
       check (playSafe safety)
             (text "The safe/unsafe annotation should not be used with `foreign import prim'.")

-      dflags <- getDOpts

       checkForeignArgs (isFFIPrimArgumentTy dflags) arg_tys
       -- prim import result is more liberal, allows (#,,#)
       checkForeignRes nonIOok (isFFIPrimResultTy dflags) res_ty
       checkForeignArgs (isFFIPrimArgumentTy dflags) arg_tys
       -- prim import result is more liberal, allows (#,,#)
       checkForeignRes nonIOok (isFFIPrimResultTy dflags) res_ty