[Git][ghc/ghc][wip/andreask/ffi_marshall_tuple] UnliftedFFITypes: Allow `(# #)` as argument when it's the only argument.
Andreas Klebinger (@AndreasK)
gitlab at gitlab.haskell.org
Thu May 16 08:01:24 UTC 2024
Andreas Klebinger pushed to branch wip/andreask/ffi_marshall_tuple at Glasgow Haskell Compiler / GHC
Commits:
5f7f6e35 by Andreas Klebinger at 2024-05-16T09:45:48+02:00
UnliftedFFITypes: Allow `(# #)` as argument when it's the only argument.
This allows representing functions like:
int foo(void);
to be imported like this:
foreign import ccall "a_number_c"
c_number :: (# #) -> Int64#
Which can be useful when the imported function isn't implicitly
stateful.
- - - - -
10 changed files:
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/HsToCore/Foreign/Call.hs
- compiler/GHC/Tc/Gen/Foreign.hs
- docs/users_guide/9.12.1-notes.rst
- docs/users_guide/exts/ffi.rst
- + testsuite/tests/ffi/should_run/T24818.hs
- + testsuite/tests/ffi/should_run/T24818.stdout
- + testsuite/tests/ffi/should_run/T24818_c.c
- + testsuite/tests/ffi/should_run/T24818_cmm.cmm
- testsuite/tests/ffi/should_run/all.T
Changes:
=====================================
compiler/GHC/Core/TyCon.hs
=====================================
@@ -1564,6 +1564,7 @@ data PrimRep
data PrimOrVoidRep = VoidRep | NVRep PrimRep
-- See Note [VoidRep] in GHC.Types.RepType
+ deriving (Data.Data, Eq, Ord, Show)
data PrimElemRep
= Int8ElemRep
=====================================
compiler/GHC/HsToCore/Foreign/Call.hs
=====================================
@@ -47,6 +47,7 @@ import GHC.Utils.Outputable
import GHC.Utils.Panic
import Data.Maybe
+import GHC.Types.RepType (typePrimRep1)
{-
Desugaring of @ccall at s consists of adding some state manipulation,
@@ -137,7 +138,9 @@ unboxArg :: CoreExpr -- The supplied argument, not representa
unboxArg arg
-- Primitive types: nothing to unbox
- | isPrimitiveType arg_ty
+ | isPrimitiveType arg_ty ||
+ -- Same for (# #)
+ (isUnboxedTupleType arg_ty && typePrimRep1 arg_ty == VoidRep)
= return (arg, \body -> body)
-- Recursive newtypes
=====================================
compiler/GHC/Tc/Gen/Foreign.hs
=====================================
@@ -85,6 +85,7 @@ import Control.Monad.Trans.Class
( lift )
import Data.Maybe (isJust)
import GHC.Builtin.Types (unitTyCon)
+import GHC.Types.RepType (typePrimRep1)
-- Defines a binding
isForeignImport :: forall name. UnXRec name => LForeignDecl name -> Bool
@@ -297,7 +298,7 @@ tcCheckFIType arg_tys res_ty idecl@(CImport src (L lc cconv) safety mh l@(CLabel
return (CImport src (L lc cconv') safety mh l)
tcCheckFIType arg_tys res_ty idecl@(CImport src (L lc cconv) safety mh CWrapper) = do
- -- Foreign wrapper (former f.e.d.)
+ -- Foreign wrapper (former foreign export dynamic)
-- 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) is accepted, too.
-- The use of the latter form is DEPRECATED, though.
@@ -463,6 +464,21 @@ tcCheckFEType sig_ty edecl@(CExport src (L l (CExportStatic esrc str cconv))) =
------------ Checking argument types for foreign import ----------------------
checkForeignArgs :: (Type -> Validity' IllegalForeignTypeReason) -> [Scaled Type] -> TcM ()
+checkForeignArgs _pred [(Scaled mult ty)]
+ -- If there is a single argument allow:
+ -- foo :: (# #) -> T
+ | isUnboxedTupleType ty
+ , VoidRep <- typePrimRep1 ty
+ = do
+ checkNoLinearFFI mult
+ dflags <- getDynFlags
+ case (validIfUnliftedFFITypes dflags) of
+ IsValid -> checkNoLinearFFI mult
+ NotValid needs_uffi -> addErrTc $
+ TcRnIllegalForeignType
+ (Just Arg)
+ (TypeCannotBeMarshaled ty needs_uffi)
+ -- = check (validIfUnliftedFFITypes dflags) (TypeCannotBeMarshaled (Just Arg)) >> checkNoLinearFFI mult
checkForeignArgs pred tys = mapM_ go tys
where
go (Scaled mult ty) = checkNoLinearFFI mult >>
=====================================
docs/users_guide/9.12.1-notes.rst
=====================================
@@ -23,6 +23,9 @@ Language
This change is backwards-incompatible, although in practice we don't expect it
to cause significant disruption.
+- UnliftedFFITypes: GHC will now accept types like: ``(# #) -> T`` where ``(# #)``
+ is used as the one and only function argument.
+
Compiler
~~~~~~~~
=====================================
docs/users_guide/exts/ffi.rst
=====================================
@@ -121,9 +121,13 @@ Unlifted FFI Types
The following unlifted unboxed types may be used as basic foreign
types (see FFI Chapter, Section 8.6) for both ``safe`` and
``unsafe`` foreign calls: ``Int#``, ``Word#``, ``Char#``, ``Float#``,
-``Double#``, ``Addr#``, and ``StablePtr# a``. Several unlifted boxed
-types may be used as arguments to FFI calls, subject to these
-restrictions:
+``Double#``, ``Addr#``, and ``StablePtr# a``.
+Additionally ``(# #)`` can be used if it's the first and only function argument.
+This allows more flexible importing of functions which don't require ordering
+through IO.
+
+Several unlifted boxed types may be used as arguments to FFI calls,
+subject to these restrictions:
* Valid arguments for ``foreign import unsafe`` FFI calls: ``Array#``,
``SmallArray#``, ``ByteArray#``, and the mutable
=====================================
testsuite/tests/ffi/should_run/T24818.hs
=====================================
@@ -0,0 +1,22 @@
+{-# LANGUAGE GHCForeignImportPrim #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+{-# LANGUAGE MagicHash #-}
+
+-- | Test that `foreign import prim` imports handle `State#` in arguments correctly.
+module Main where
+
+-- import GHC.IO
+import GHC.Exts
+import GHC.Int
+
+foreign import prim "a_number_cmm"
+ cmm_number :: (# #) -> Int#
+
+foreign import ccall "a_number_c"
+ c_number :: (# #) -> Int64#
+
+main :: IO ()
+main = do
+ print $ I# (cmm_number (# #))
+ print $ I64# (c_number (# #))
=====================================
testsuite/tests/ffi/should_run/T24818.stdout
=====================================
@@ -0,0 +1,2 @@
+37
+38
=====================================
testsuite/tests/ffi/should_run/T24818_c.c
=====================================
@@ -0,0 +1,8 @@
+#include <stddef.h>
+#include <stdint.h>
+
+int64_t a_number_c(void)
+{
+ return 38;
+}
+
=====================================
testsuite/tests/ffi/should_run/T24818_cmm.cmm
=====================================
@@ -0,0 +1,5 @@
+#include "Cmm.h"
+
+a_number_cmm() {
+ return (37);
+}
=====================================
testsuite/tests/ffi/should_run/all.T
=====================================
@@ -272,3 +272,4 @@ test('T24314',
test('T24598', req_cmm, compile_and_run, ['T24598_cmm.cmm'])
test('T24598b', req_cmm, compile_and_run, ['T24598b_cmm.cmm'])
test('T24598c', req_cmm, compile_and_run, ['T24598c_cmm.cmm'])
+test('T24818', [req_cmm, req_c], compile_and_run, ['-XUnliftedFFITypes T24818_cmm.cmm T24818_c.c'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5f7f6e35ee841df7b0155d86aa0c1c99e3b462b5
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5f7f6e35ee841df7b0155d86aa0c1c99e3b462b5
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240516/6d154db0/attachment-0001.html>
More information about the ghc-commits
mailing list