[Git][ghc/ghc][wip/T24598] compiler: Allow more types in GHCForeignImportPrim

[Ben Gamari (@bgamari)]

Ben Gamari pushed to branch wip/T24598 at Glasgow Haskell Compiler / GHC


Commits:
67dd5635 by Ben Gamari at 2024-03-26T23:07:21-04:00
compiler: Allow more types in GHCForeignImportPrim

For many, many years `GHCForeignImportPrim` has suffered from the rather
restrictive limitation of not allowing any non-trivial types in arguments
or results. This limitation was justified by the code generator allegely
barfing in the presence of such types.

However, this restriction appears to originate well before the NCG
rewrite and the new NCG does not appear to have any trouble with such
types (see the added `T24598` test). Lift this restriction.

Fixes #24598.

- - - - -


10 changed files:

- compiler/GHC/Tc/Gen/Foreign.hs
- + testsuite/tests/ffi/should_run/T24598.hs
- + testsuite/tests/ffi/should_run/T24598.stdout
- + testsuite/tests/ffi/should_run/T24598_cmm.cmm
- + testsuite/tests/ffi/should_run/T24598b.hs
- + testsuite/tests/ffi/should_run/T24598b.stdout
- + testsuite/tests/ffi/should_run/T24598b_cmm.cmm
- + testsuite/tests/ffi/should_run/T24598c.hs
- + testsuite/tests/ffi/should_run/T24598c_cmm.cmm
- testsuite/tests/ffi/should_run/all.T


Changes:

=====================================
compiler/GHC/Tc/Gen/Foreign.hs
=====================================
@@ -84,7 +84,6 @@ import Control.Monad.Trans.Writer.CPS
 import Control.Monad.Trans.Class
   ( lift )
 import Data.Maybe (isJust)
-import GHC.Types.RepType (tyConPrimRep)
 import GHC.Builtin.Types (unitTyCon)
 
 -- Defines a binding
@@ -737,7 +736,6 @@ marshalablePrimTyCon tc = isPrimTyCon tc && not (isLiftedTypeKind (tyConResKind
 marshalableTyCon :: DynFlags -> TyCon -> Validity' TypeCannotBeMarshaledReason
 marshalableTyCon dflags tc
   | marshalablePrimTyCon tc
-  , not (null (tyConPrimRep tc)) -- Note [Marshalling void]
   = validIfUnliftedFFITypes dflags
   | otherwise
   = boxedMarshalableTyCon tc
@@ -772,7 +770,6 @@ legalFIPrimResultTyCon :: DynFlags -> TyCon -> Validity' TypeCannotBeMarshaledRe
 -- types and also unboxed tuple and sum result types.
 legalFIPrimResultTyCon dflags tc
   | marshalablePrimTyCon tc
-  , not (null (tyConPrimRep tc))   -- Note [Marshalling void]
   = validIfUnliftedFFITypes dflags
 
   | isUnboxedTupleTyCon tc || isUnboxedSumTyCon tc
@@ -786,13 +783,3 @@ validIfUnliftedFFITypes dflags
   | xopt LangExt.UnliftedFFITypes dflags =  IsValid
   | otherwise = NotValid UnliftedFFITypesNeeded
 
-{-
-Note [Marshalling void]
-~~~~~~~~~~~~~~~~~~~~~~~
-We don't treat State# (whose PrimRep is VoidRep) as marshalable.
-In turn that means you can't write
-        foreign import foo :: Int -> State# RealWorld
-
-Reason: the back end falls over with panic "primRepHint:VoidRep";
-        and there is no compelling reason to permit it
--}


=====================================
testsuite/tests/ffi/should_run/T24598.hs
=====================================
@@ -0,0 +1,20 @@
+{-# LANGUAGE GHCForeignImportPrim #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+{-# LANGUAGE MagicHash #-}
+
+-- | Test that `foreign import prim` imports handle `State#` in results correctly.
+module Main where
+
+import GHC.IO
+import GHC.Int
+import GHC.Exts
+
+foreign import prim "hello"
+  hello# :: State# RealWorld -> (# State# RealWorld, Int# #)
+
+main :: IO ()
+main = hello >>= print
+
+hello :: IO Int
+hello = IO $ \s -> case hello# s of (# s', n# #) -> (# s', I# n# #)


=====================================
testsuite/tests/ffi/should_run/T24598.stdout
=====================================
@@ -0,0 +1 @@
+42


=====================================
testsuite/tests/ffi/should_run/T24598_cmm.cmm
=====================================
@@ -0,0 +1,5 @@
+#include "Cmm.h"
+
+hello() {
+    return (42);
+}


=====================================
testsuite/tests/ffi/should_run/T24598b.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.Int
+import GHC.Exts
+
+foreign import prim "hello"
+  hello# :: Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
+
+main :: IO ()
+main = hello 21 >>= print
+
+hello :: Int -> IO Int
+hello (I# n#) = IO $ \s ->
+  case hello# n# s of (# s', n# #) -> (# s', I# n# #)
+


=====================================
testsuite/tests/ffi/should_run/T24598b.stdout
=====================================
@@ -0,0 +1 @@
+42


=====================================
testsuite/tests/ffi/should_run/T24598b_cmm.cmm
=====================================
@@ -0,0 +1,5 @@
+#include "Cmm.h"
+
+hello(W_ n) {
+    return (2*n);
+}


=====================================
testsuite/tests/ffi/should_run/T24598c.hs
=====================================
@@ -0,0 +1,21 @@
+{-# 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
+
+foreign import prim "hello"
+  hello# :: State# RealWorld -> State# RealWorld
+
+main :: IO ()
+main = hello
+
+hello :: IO ()
+hello = IO $ \s ->
+  case hello# s of s' -> (# s', () #)
+


=====================================
testsuite/tests/ffi/should_run/T24598c_cmm.cmm
=====================================
@@ -0,0 +1,11 @@
+#include "Cmm.h"
+
+section "data" {
+  test_str: bits8[] "hello";
+}
+
+hello() {
+    ccall puts(test_str);
+    return ();
+}
+


=====================================
testsuite/tests/ffi/should_run/all.T
=====================================
@@ -268,3 +268,7 @@ test('T24314',
       # libffi-wasm doesn't support more than 4 args yet
       when(arch('wasm32'), skip)],
      compile_and_run, ['T24314_c.c'])
+
+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'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/67dd56359afd4c575d733269189b7bb5a9127946

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/67dd56359afd4c575d733269189b7bb5a9127946
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/20240326/41f08f5c/attachment-0001.html>