Reject nested foralls in foreign imports (#16702)

This replaces a panic observed in #16702 with a simple error message
stating that nested `forall`s simply aren't allowed in the type
signature of a `foreign import` (at least, not at present).

Fixes #16702.

5 files changed, 85 insertions, 9 deletions

diff --git a/compiler/typecheck/TcForeign.hs b/compiler/typecheck/TcForeign.hs
index 877ba805f2..61c35e7e5d 100644
--- a/compiler/typecheck/TcForeign.hs
+++ b/compiler/typecheck/TcForeign.hs
@@ -64,7 +64,6 @@ import Hooks
 import qualified GHC.LanguageExtensions as LangExt
 
 import Control.Monad
-import Data.Maybe
 
 -- Defines a binding
 isForeignImport :: LForeignDecl name -> Bool
@@ -251,8 +250,7 @@ tcFImport (L dloc fo@(ForeignImport { fd_name = L nloc nm, fd_sig_ty = hs_ty
        ; let
            -- Drop the foralls before inspecting the
            -- structure of the foreign type.
-             (bndrs, res_ty)   = tcSplitPiTys norm_sig_ty
-             arg_tys           = mapMaybe binderRelevantType_maybe bndrs
+             (arg_tys, res_ty) = tcSplitFunTys (dropForAlls norm_sig_ty)
              id                = mkLocalId nm sig_ty
                  -- Use a LocalId to obey the invariant that locally-defined
                  -- things are LocalIds.  However, it does not need zonking,
@@ -424,10 +422,9 @@ tcCheckFEType sig_ty (CExport (L l (CExportStatic esrc str cconv)) src) = do
     checkForeignRes nonIOok noCheckSafe isFFIExportResultTy res_ty
     return (CExport (L l (CExportStatic esrc str cconv')) src)
   where
-      -- Drop the foralls before inspecting n
+      -- Drop the foralls before inspecting
       -- the structure of the foreign type.
-    (bndrs, res_ty) = tcSplitPiTys sig_ty
-    arg_tys         = mapMaybe binderRelevantType_maybe bndrs
+    (arg_tys, res_ty) = tcSplitFunTys (dropForAlls sig_ty)
 
 {-
 ************************************************************************
@@ -458,6 +455,11 @@ checkForeignRes non_io_result_ok check_safe pred_res_ty ty
   =     -- Got an IO result type, that's always fine!
      check (pred_res_ty res_ty) (illegalForeignTyErr result)
 
+  -- We disallow nested foralls in foreign types
+  -- (at least, for the time being). See #16702.
+  | tcIsForAllTy ty
+  = addErrTc $ illegalForeignTyErr result (text "Unexpected nested forall")
+
   -- Case for non-IO result type with FFI Import
   | not non_io_result_ok
   = addErrTc $ illegalForeignTyErr result (text "IO result type expected")
diff --git a/docs/users_guide/ffi-chap.rst b/docs/users_guide/ffi-chap.rst
index b90b48a672..13ea352c8d 100644
--- a/docs/users_guide/ffi-chap.rst
+++ b/docs/users_guide/ffi-chap.rst
@@ -14,9 +14,10 @@ Foreign function interface (FFI)
 
     Allow use of the Haskell foreign function interface.
 
-GHC (mostly) conforms to the Haskell Foreign Function Interface, whose
-definition is part of the Haskell Report on
-`http://www.haskell.org/ <http://www.haskell.org/>`__.
+GHC (mostly) conforms to the Haskell Foreign Function Interface as specified
+in the Haskell Report. Refer to the `relevant chapter
+<https://www.haskell.org/onlinereport/haskell2010/haskellch8.html>_`
+of the Haskell Report for more details.
 
 FFI support is enabled by default, but can be enabled or disabled
 explicitly with the :extension:`ForeignFunctionInterface` flag.
@@ -102,6 +103,25 @@ OK: ::
        foreign import foo :: Int -> MyIO Int
        foreign import "dynamic" baz :: (Int -> MyIO Int) -> CInt -> MyIO Int
 
+.. _ffi-foralls:
+
+Explicit ``forall``s in foreign types
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+The type variables in the type of a foreign declaration may be quantified with
+an explicit ``forall`` by using the :extension:`ExplicitForAll` language
+extension, as in the following example: ::
+
+    {-# LANGUAGE ExplicitForAll #-}
+    foreign import ccall "mmap" c_mmap :: forall a. CSize -> IO (Ptr a)
+
+Note that an explicit ``forall`` must appear at the front of the type signature
+and is not permitted to appear nested within the type, as in the following
+(erroneous) examples: ::
+
+    foreign import ccall "mmap" c_mmap' :: CSize -> forall a. IO (Ptr a)
+    foreign import ccall quux :: (forall a. Ptr a) -> IO ()
+
 .. _ffi-prim:
 
 Primitive imports
diff --git a/testsuite/tests/ffi/should_fail/T16702.hs b/testsuite/tests/ffi/should_fail/T16702.hs
new file mode 100644
index 0000000000..bad07c7120
--- /dev/null
+++ b/testsuite/tests/ffi/should_fail/T16702.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+{-# LANGUAGE RankNTypes #-}
+
+module T16702 where
+
+import Foreign.C.Types
+import Foreign.Ptr
+import Data.Kind (Type)
+
+foreign import ccall "math.h pow"
+  c_pow :: CDouble
+        -> forall (a :: Type). CDouble
+        -> forall (b :: Type). CDouble
+
+foreign import ccall "malloc"
+  malloc1 :: CSize -> forall a. IO (Ptr a)
+
+foreign import ccall "malloc"
+  malloc2 :: Show a => CSize -> IO (Ptr a)
+
+foreign import ccall "malloc"
+  malloc3 :: CSize -> Show a => IO (Ptr a)
diff --git a/testsuite/tests/ffi/should_fail/T16702.stderr b/testsuite/tests/ffi/should_fail/T16702.stderr
new file mode 100644
index 0000000000..2ab7c751d0
--- /dev/null
+++ b/testsuite/tests/ffi/should_fail/T16702.stderr
@@ -0,0 +1,29 @@
+
+T16702.hs:12:1: error:
+    • Unacceptable result type in foreign declaration:
+        Unexpected nested forall
+    • When checking declaration:
+        foreign import ccall safe "math.h pow" c_pow
+          :: CDouble
+             -> forall (a :: Type). CDouble -> forall (b :: Type). CDouble
+
+T16702.hs:17:1: error:
+    • Unacceptable result type in foreign declaration:
+        Unexpected nested forall
+    • When checking declaration:
+        foreign import ccall safe "malloc" malloc1
+          :: CSize -> forall a. IO (Ptr a)
+
+T16702.hs:20:1: error:
+    • Unacceptable argument type in foreign declaration:
+        ‘Show a’ cannot be marshalled in a foreign call
+    • When checking declaration:
+        foreign import ccall safe "malloc" malloc2
+          :: Show a => CSize -> IO (Ptr a)
+
+T16702.hs:23:1: error:
+    • Unacceptable argument type in foreign declaration:
+        ‘Show a’ cannot be marshalled in a foreign call
+    • When checking declaration:
+        foreign import ccall safe "malloc" malloc3
+          :: CSize -> Show a => IO (Ptr a)
diff --git a/testsuite/tests/ffi/should_fail/all.T b/testsuite/tests/ffi/should_fail/all.T
index 3bd7b5d909..38273db314 100644
--- a/testsuite/tests/ffi/should_fail/all.T
+++ b/testsuite/tests/ffi/should_fail/all.T
@@ -14,6 +14,7 @@ test('T5664', normal, compile_fail, ['-v0'])
 test('T7506', normal, compile_fail, [''])
 test('T7243', normal, compile_fail, [''])
 test('T10461', normal, compile_fail, [''])
+test('T16702', normal, compile_fail, [''])
 
 # UnsafeReenter tests implementation of an undefined behavior (calling Haskell
 # from an unsafe foreign function) and only makes sense in non-threaded way