[Git][ghc/ghc][master] UnliftedFFITypes: Allow `(# #)` as argument when it's the only argument.

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Thu May 30 06:58:28 UTC 2024



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
e0029e3d by Andreas Klebinger at 2024-05-30T02:57:43-04: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
=====================================
@@ -32,6 +32,9 @@ Language
 - Unboxed Float#/Double# literals now support the HexFloatLiterals extension
   (`#22155 <https://gitlab.haskell.org/ghc/ghc/-/issues/22155>`_).
 
+- UnliftedFFITypes: GHC will now accept ffi 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/e0029e3d14b5dd0fccff38da0fab3afb1fe82ec9

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e0029e3d14b5dd0fccff38da0fab3afb1fe82ec9
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/20240530/427d66aa/attachment-0001.html>


More information about the ghc-commits mailing list