Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)"revert-22043

This reverts commit 4f70a8a0b5db49ff249271faefec14bf1421f365.

9 files changed, 6 insertions, 62 deletions

diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs
index 691f500a77..780c0738b3 100644
--- a/compiler/GHC/Builtin/Names.hs
+++ b/compiler/GHC/Builtin/Names.hs
@@ -350,7 +350,7 @@ basicKnownKeyNames
         zipName, foldrName, buildName, augmentName, appendName,
 
         -- FFI primitive types that are not wired-in.
-        stablePtrTyConName, ptrTyConName, funPtrTyConName, constPtrConName,
+        stablePtrTyConName, ptrTyConName, funPtrTyConName,
         int8TyConName, int16TyConName, int32TyConName, int64TyConName,
         word8TyConName, word16TyConName, word32TyConName, word64TyConName,
 
@@ -557,7 +557,7 @@ gHC_PRIM, gHC_PRIM_PANIC,
     aRROW, gHC_DESUGAR, rANDOM, gHC_EXTS, gHC_IS_LIST,
     cONTROL_EXCEPTION_BASE, gHC_TYPEERROR, gHC_TYPELITS, gHC_TYPELITS_INTERNAL,
     gHC_TYPENATS, gHC_TYPENATS_INTERNAL,
-    dATA_COERCE, dEBUG_TRACE, uNSAFE_COERCE, fOREIGN_C_TYPES :: Module
+    dATA_COERCE, dEBUG_TRACE, uNSAFE_COERCE :: Module
 
 gHC_PRIM        = mkPrimModule (fsLit "GHC.Prim")   -- Primitive types and values
 gHC_PRIM_PANIC  = mkPrimModule (fsLit "GHC.Prim.Panic")
@@ -626,7 +626,6 @@ gHC_TYPENATS_INTERNAL = mkBaseModule (fsLit "GHC.TypeNats.Internal")
 dATA_COERCE     = mkBaseModule (fsLit "Data.Coerce")
 dEBUG_TRACE     = mkBaseModule (fsLit "Debug.Trace")
 uNSAFE_COERCE   = mkBaseModule (fsLit "Unsafe.Coerce")
-fOREIGN_C_TYPES = mkBaseModule (fsLit "Foreign.C.Types")
 
 gHC_SRCLOC :: Module
 gHC_SRCLOC = mkBaseModule (fsLit "GHC.SrcLoc")
@@ -1665,10 +1664,6 @@ fingerprintDataConName :: Name
 fingerprintDataConName =
     dcQual gHC_FINGERPRINT_TYPE (fsLit "Fingerprint") fingerprintDataConKey
 
-constPtrConName :: Name
-constPtrConName =
-    tcQual fOREIGN_C_TYPES (fsLit "ConstPtr") constPtrTyConKey
-
 {-
 ************************************************************************
 *                                                                      *
@@ -1870,7 +1865,7 @@ statePrimTyConKey, stableNamePrimTyConKey, stableNameTyConKey,
     funPtrTyConKey, tVarPrimTyConKey, eqPrimTyConKey,
     eqReprPrimTyConKey, eqPhantPrimTyConKey,
     compactPrimTyConKey, stackSnapshotPrimTyConKey,
-    promptTagPrimTyConKey, constPtrTyConKey :: Unique
+    promptTagPrimTyConKey :: Unique
 statePrimTyConKey                       = mkPreludeTyConUnique 50
 stableNamePrimTyConKey                  = mkPreludeTyConUnique 51
 stableNameTyConKey                      = mkPreludeTyConUnique 52
@@ -2081,7 +2076,6 @@ typeConsSymbolTyFamNameKey = mkPreludeTyConUnique 413
 typeUnconsSymbolTyFamNameKey = mkPreludeTyConUnique 414
 typeCharToNatTyFamNameKey = mkPreludeTyConUnique 415
 typeNatToCharTyFamNameKey = mkPreludeTyConUnique 416
-constPtrTyConKey = mkPreludeTyConUnique 417
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/HsToCore/Foreign/C.hs b/compiler/GHC/HsToCore/Foreign/C.hs
index 28ef42e2b9..160e9acc97 100644
--- a/compiler/GHC/HsToCore/Foreign/C.hs
+++ b/compiler/GHC/HsToCore/Foreign/C.hs
@@ -246,18 +246,10 @@ dsFCall :: Id -> Coercion -> ForeignCall -> Maybe Header
         -> DsM ([(Id, Expr TyVar)], CHeader, CStub)
 dsFCall fn_id co fcall mDeclHeader = do
     let
-        (ty,ty1)             = (coercionLKind co, coercionRKind co)
+        ty                   = coercionLKind co
         (tv_bndrs, rho)      = tcSplitForAllTyVarBinders ty
         (arg_tys, io_res_ty) = tcSplitFunTys rho
 
-    let constQual -- provide 'const' qualifier (#22034)
-          | (_, res_ty1) <- tcSplitFunTys ty1
-          , newty <- maybe res_ty1 snd (tcSplitIOType_maybe res_ty1)
-          , Just (ptr, _) <- splitTyConApp_maybe newty
-          , tyConName ptr `elem` [constPtrConName]
-          = text "const"
-          | otherwise = empty
-
     args <- newSysLocalsDs arg_tys  -- no FFI representation polymorphism
     (val_args, arg_wrappers) <- mapAndUnzipM unboxArg (map Var args)
 
@@ -285,7 +277,7 @@ dsFCall fn_id co fcall mDeclHeader = do
                       includes = vcat [ text "#include \"" <> ftext h
                                         <> text "\""
                                       | Header _ h <- nub headers ]
-                      fun_proto = constQual <+> cResType <+> pprCconv <+> ppr wrapperName <> parens argTypes
+                      fun_proto = cResType <+> pprCconv <+> ppr wrapperName <> parens argTypes
                       cRet
                        | isVoidRes =                   cCall
                        | otherwise = text "return" <+> cCall
diff --git a/docs/users_guide/9.6.1-notes.rst b/docs/users_guide/9.6.1-notes.rst
index 9fd0ca2d75..fc57fa8822 100644
--- a/docs/users_guide/9.6.1-notes.rst
+++ b/docs/users_guide/9.6.1-notes.rst
@@ -163,9 +163,6 @@ Runtime system
 ``ghc`` library
 ~~~~~~~~~~~~~~~
 
-- Add `Foreign.C.Types.ConstPtr` was added to encode ``const``-qualified pointer return
-  types in foreign declarations when using ``CApiFFI`` extension.
-
 ``ghc-heap`` library
 ~~~~~~~~~~~~~~~~~~~~
 
diff --git a/docs/users_guide/exts/ffi.rst b/docs/users_guide/exts/ffi.rst
index f23c223279..b490ac662d 100644
--- a/docs/users_guide/exts/ffi.rst
+++ b/docs/users_guide/exts/ffi.rst
@@ -437,18 +437,6 @@ specified. The syntax looks like: ::
     data    {-# CTYPE "unistd.h" "useconds_t" #-} T = ...
     newtype {-# CTYPE            "useconds_t" #-} T = ...
 
-In case foreign declarations contain ``const``-qualified pointer return
-type, `ConstPtr` from :base-ref:`Foreign.C.Types` may be used to
-encode this, e.g. ::
-
-    foreign import capi "header.h f" f :: CInt -> ConstPtr CInt
-
-which corresponds to
-
-.. code-block:: c
-
-    const *int f(int);
-
 ``hs_thread_done()``
 ~~~~~~~~~~~~~~~~~~~~
 
diff --git a/libraries/base/Foreign/C/Types.hs b/libraries/base/Foreign/C/Types.hs
index 7f74a07bc8..b14118095e 100644
--- a/libraries/base/Foreign/C/Types.hs
+++ b/libraries/base/Foreign/C/Types.hs
@@ -86,11 +86,8 @@ module Foreign.C.Types
 
           -- Instances of: Eq and Storable
         , CFile,        CFpos,     CJmpBuf
-
-        , ConstPtr(..)
         ) where
 
-import Foreign.Ptr      ( Ptr )
 import Foreign.Storable
 import Data.Bits        ( Bits(..), FiniteBits(..) )
 import Data.Int         ( Int8,  Int16,  Int32,  Int64  )
@@ -226,9 +223,6 @@ INTEGRAL_TYPE(CUIntPtr,"uintptr_t",HTYPE_UINTPTR_T)
 INTEGRAL_TYPE(CIntMax,"intmax_t",HTYPE_INTMAX_T)
 INTEGRAL_TYPE(CUIntMax,"uintmax_t",HTYPE_UINTMAX_T)
 
--- | Used to produce 'const' qualifier in C code generator
-newtype ConstPtr a = ConstPtr { unConstPtr :: Ptr a } deriving newtype (Show, Eq, Storable)
-
 -- C99 types which are still missing include:
 -- wint_t, wctrans_t, wctype_t
 
@@ -274,3 +268,4 @@ representing a C type @t@:
   corresponding bitwise operation in C on @t@.
 
 -}
+
diff --git a/testsuite/tests/ffi/should_compile/T22034.h b/testsuite/tests/ffi/should_compile/T22034.h
deleted file mode 100644
index 26c49d3a38..0000000000
--- a/testsuite/tests/ffi/should_compile/T22034.h
+++ /dev/null
@@ -1,2 +0,0 @@
-const int *foo();
-const double *bar;
diff --git a/testsuite/tests/ffi/should_compile/T22034.hs b/testsuite/tests/ffi/should_compile/T22034.hs
deleted file mode 100644
index 8c065c3ea1..0000000000
--- a/testsuite/tests/ffi/should_compile/T22034.hs
+++ /dev/null
@@ -1,10 +0,0 @@
-{-# LANGUAGE CApiFFI #-}
-module T22034 where
-
-import Foreign.C.Types
-
-foreign import capi "T22034.h foo"
-    c_foo :: IO (ConstPtr CInt)
-
-foreign import capi "T22034.h value bar"
-    c_bar :: ConstPtr CDouble
diff --git a/testsuite/tests/ffi/should_compile/T22034_c.c b/testsuite/tests/ffi/should_compile/T22034_c.c
deleted file mode 100644
index e70b5a978f..0000000000
--- a/testsuite/tests/ffi/should_compile/T22034_c.c
+++ /dev/null
@@ -1,9 +0,0 @@
-#include <stdlib.h>
-
-const int * foo() {
-    int *x = malloc(sizeof(int));
-    *x = 42;
-    return x;
-}
-
-const int *bar = 0;
diff --git a/testsuite/tests/ffi/should_compile/all.T b/testsuite/tests/ffi/should_compile/all.T
index 532f5c3854..d8afeb9f7b 100644
--- a/testsuite/tests/ffi/should_compile/all.T
+++ b/testsuite/tests/ffi/should_compile/all.T
@@ -43,4 +43,3 @@ test(
     ],
 )
 test('T15531', normal, compile, ['-Wall'])
-test('T22034', [omit_ways(['ghci'])], compile, [''])