From 2da37f4f15790377900fa6c38ff8fdcd394dfaa2 Mon Sep 17 00:00:00 2001
From: Duncan Coutts <duncan@well-typed.com>
Date: Tue, 9 Jun 2009 10:48:26 +0000
Subject: [PATCH] Typechecking for "foreign import prim" The main restriction
is that all args and results must be unboxed types. In particular we allow
unboxed tuple results (which is a primary motivation for the whole feature).
The normal rules apply about "void rep" result types like State#. We only
allow "prim" calling convention for import, not export. The other forms of
import, "dynamic", "wrapper" and data label are banned as a conseqence of
checking that the imported name is a valid C string. We currently require
prim imports to be marked unsafe, though this is essentially arbitrary as the
safety information is unused.
---
compiler/typecheck/TcForeign.lhs | 11 +++++++++++
compiler/typecheck/TcType.lhs | 34 ++++++++++++++++++++++++++++++++
2 files changed, 45 insertions(+)
diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs
index 35f627e48d37..23756d97c351 100644
--- a/compiler/typecheck/TcForeign.lhs
+++ b/compiler/typecheck/TcForeign.lhs
@@ -151,6 +151,16 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety _ _ (CFunction t
checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys
checkForeignRes nonIOok (isFFIImportResultTy dflags) res_ty
return idecl
+ | cconv == PrimCallConv = do
+ checkCg (checkCOrAsmOrDotNetOrInterp)
+ checkCTarget target
+ check (safety == PlayRisky)
+ (text "A `foreign import prim' must always be annotated as `unsafe'")
+ dflags <- getDOpts
+ checkForeignArgs (isFFIPrimArgumentTy dflags) arg_tys
+ -- prim import result is more liberal, allows (#,,#)
+ checkForeignRes nonIOok (isFFIPrimResultTy dflags) res_ty
+ return idecl
| otherwise = do -- Normal foreign import
checkCg (checkCOrAsmOrDotNetOrInterp)
checkCConv cconv
@@ -348,6 +358,7 @@ checkCConv StdCallConv = return ()
#else
checkCConv StdCallConv = addErrTc (text "calling convention not supported on this platform: stdcall")
#endif
+checkCConv PrimCallConv = addErrTc (text "The `prim' calling convention can only be used with `foreign import'")
checkCConv CmmCallConv = panic "checkCConv CmmCallConv"
\end{code}
diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index 738f1cd009fb..f50b9b085cfb 100644
--- a/compiler/typecheck/TcType.lhs
+++ b/compiler/typecheck/TcType.lhs
@@ -84,6 +84,8 @@ module TcType (
isFFIExternalTy, -- :: Type -> Bool
isFFIDynArgumentTy, -- :: Type -> Bool
isFFIDynResultTy, -- :: Type -> Bool
+ isFFIPrimArgumentTy, -- :: DynFlags -> Type -> Bool
+ isFFIPrimResultTy, -- :: DynFlags -> Type -> Bool
isFFILabelTy, -- :: Type -> Bool
isFFIDotnetTy, -- :: DynFlags -> Type -> Bool
isFFIDotnetObjTy, -- :: Type -> Bool
@@ -1228,6 +1230,18 @@ isFFILabelTy :: Type -> Bool
-- or a newtype of either.
isFFILabelTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
+isFFIPrimArgumentTy :: DynFlags -> Type -> Bool
+-- Checks for valid argument type for a 'foreign import prim'
+-- Currently they must all be simple unlifted types.
+isFFIPrimArgumentTy dflags ty
+ = checkRepTyCon (legalFIPrimArgTyCon dflags) ty
+
+isFFIPrimResultTy :: DynFlags -> Type -> Bool
+-- Checks for valid result type for a 'foreign import prim'
+-- Currently it must be an unlifted type, including unboxed tuples.
+isFFIPrimResultTy dflags ty
+ = checkRepTyCon (legalFIPrimResultTyCon dflags) ty
+
isFFIDotnetTy :: DynFlags -> Type -> Bool
isFFIDotnetTy dflags ty
= checkRepTyCon (\ tc -> (legalFIResultTyCon dflags tc ||
@@ -1353,6 +1367,26 @@ boxedMarshalableTyCon tc
, stablePtrTyConKey
, boolTyConKey
]
+
+legalFIPrimArgTyCon :: DynFlags -> TyCon -> Bool
+-- Check args of 'foreign import prim', only allow simple unlifted types.
+-- Strictly speaking it is unnecessary to ban unboxed tuples here since
+-- currently they're of the wrong kind to use in function args anyway.
+legalFIPrimArgTyCon dflags tc
+ = dopt Opt_UnliftedFFITypes dflags
+ && isUnLiftedTyCon tc
+ && not (isUnboxedTupleTyCon tc)
+
+legalFIPrimResultTyCon :: DynFlags -> TyCon -> Bool
+-- Check result type of 'foreign import prim'. Allow simple unlifted
+-- types and also unboxed tuple result types '... -> (# , , #)'
+legalFIPrimResultTyCon dflags tc
+ = dopt Opt_UnliftedFFITypes dflags
+ && isUnLiftedTyCon tc
+ && (isUnboxedTupleTyCon tc
+ || case tyConPrimRep tc of -- Note [Marshalling VoidRep]
+ VoidRep -> False
+ _ -> True)
\end{code}
Note [Marshalling VoidRep]
--
GitLab