Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 80e2dd4f by Zubin Duggal at 2026-03-20T12:23:33-04:00 compiler/ffi: Collapse void pointer chains in capi wrappers New gcc/clang treat -Wincompatible-pointer-types as an error by default. Since C only allows implicit conversion from void*, not void**, capi wrappers for functions taking e.g. abstract** would fail to compile when the Haskell type Ptr (Ptr Abstract) was naively translated to void**. Collapse nested void pointers to a single void* when the pointee type has no known C representation. Fixes #26852 - - - - - 5 changed files: - compiler/GHC/HsToCore/Foreign/C.hs - + testsuite/tests/ffi/should_compile/T26852.h - + testsuite/tests/ffi/should_compile/T26852.hs - + testsuite/tests/ffi/should_compile/T26852.stderr - testsuite/tests/ffi/should_compile/all.T Changes: ===================================== compiler/GHC/HsToCore/Foreign/C.hs ===================================== @@ -328,37 +328,68 @@ dsFCall fn_id co fcall mDeclHeader = do toCName :: Id -> String toCName i = showSDocOneLine defaultSDocContext (pprCode (ppr (idName i))) +{- Note [Collapsing void pointer chains] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When translating Haskell types like (Ptr (Ptr Abstract)) to C types for capi +wrappers, where Abstract has no CType annotation, naively we would produce +"void**". This is problematic because in C, only void* has implicit conversion +to any pointer type. +Modern compilers (gcc, clang) treat -Wincompatible-pointer-types as an error +by default (#26852), causing compilation failures for capi wrappers. + +The fix is to collapse void pointer chains: whenever the inner type of a +Ptr/FunPtr resolves to void (i.e. the Haskell type has no known C +representation), we return void* instead of void**, void***, etc. +This works because void* implicitly converts to any pointer type in C. + +Examples: + Ptr Abstract => void* + Ptr (Ptr Abstract) => void* (used to be void**) + Ptr (Ptr (Ptr Abstract)) => void* + Ptr (Ptr CInt) => int** (CInt has CType "int", don't collapse) +-} + +-- | See Note [Collapsing void pointer chains] toCType :: Type -> (Maybe (Header GhcTc), SDoc) -toCType = f False - where f voidOK t - -- First, if we have (Ptr t) of (FunPtr t), then we need to +toCType t = case f False t of + (mh, _, cType) -> (mh, cType) + where + -- The Bool in the return type indicates whether the C type is + -- "void" due to an unknown Haskell type (True = void-based). + f :: Bool -> Type -> (Maybe (Header GhcTc), Bool, SDoc) + f voidOK t + -- First, if we have (Ptr t) or (FunPtr t), then we need to -- convert t to a C type and put a * after it. If we don't -- know a type for t, then "void" is fine, though. + -- If the inner type is void-based, we collapse the pointer + -- chain to just "void*". See Note [Collapsing void pointer chains]. | Just (ptr, [t']) <- splitTyConApp_maybe t , tyConName ptr `elem` [ptrTyConName, funPtrTyConName] = case f True t' of - (mh, cType') -> - (mh, cType' <> char '*') + (mh, True, _) -> + (mh, True, text "void*") + (mh, False, cType') -> + (mh, False, cType' <> char '*') -- Otherwise, if we have a type constructor application, then -- see if there is a C type associated with that constructor. -- Note that we aren't looking through type synonyms or -- anything, as it may be the synonym that is annotated. | Just tycon <- tyConAppTyConPicky_maybe t , Just (CType _ mHeader cType) <- tyConCType_maybe tycon - = (mHeader, ftext cType) + = (mHeader, False, ftext cType) -- If we don't know a C type for this type, then try looking -- through one layer of type synonym etc. | Just t' <- coreView t = f voidOK t' - -- Handle 'UnliftedFFITypes' argument + -- Handle 'UnliftedFFITypes' argument | Just tyCon <- tyConAppTyConPicky_maybe t , isPrimTyCon tyCon , Just cType <- ppPrimTyConStgType tyCon - = (Nothing, text cType) + = (Nothing, False, text cType) -- Otherwise we don't know the C type. If we are allowing -- void then return that; otherwise something has gone wrong. - | voidOK = (Nothing, text "void") + | voidOK = (Nothing, True, text "void") | otherwise = pprPanic "toCType" (ppr t) ===================================== testsuite/tests/ffi/should_compile/T26852.h ===================================== @@ -0,0 +1,7 @@ +typedef struct abstract abstract; + +void blah(abstract** x); +abstract** get_abstract(void); +abstract*** get_abstract3(void); +abstract* get_simple(void); +int** get_int_pp(void); ===================================== testsuite/tests/ffi/should_compile/T26852.hs ===================================== @@ -0,0 +1,22 @@ +{-# LANGUAGE CApiFFI #-} +module T26852 where + +import Foreign.Ptr +import Foreign.C.Types + +data Abstract + +foreign import capi "T26852.h blah" + c_blah :: Ptr (Ptr Abstract) -> IO () + +foreign import capi "T26852.h get_abstract" + c_get_abstract :: IO (Ptr (Ptr Abstract)) + +foreign import capi "T26852.h get_abstract3" + c_get_abstract3 :: IO (Ptr (Ptr (Ptr Abstract))) + +foreign import capi "T26852.h get_simple" + c_get_simple :: IO (Ptr Abstract) + +foreign import capi "T26852.h get_int_pp" + c_get_int_pp :: IO (Ptr (Ptr CInt)) ===================================== testsuite/tests/ffi/should_compile/T26852.stderr ===================================== @@ -0,0 +1,18 @@ + +==================== Foreign export header file ==================== + + + +==================== Foreign export stubs ==================== +#include "T26852.h" +int** ghczuwrapperZC0ZCmainZCT26852ZCgetzuintzupp(void) {return get_int_pp();} +#include "T26852.h" +void* ghczuwrapperZC1ZCmainZCT26852ZCgetzusimple(void) {return get_simple();} +#include "T26852.h" +void* ghczuwrapperZC2ZCmainZCT26852ZCgetzuabstract3(void) {return get_abstract3();} +#include "T26852.h" +void* ghczuwrapperZC3ZCmainZCT26852ZCgetzuabstract(void) {return get_abstract();} +#include "T26852.h" +void ghczuwrapperZC4ZCmainZCT26852ZCblah(void* a1) {blah(a1);} + + ===================================== testsuite/tests/ffi/should_compile/all.T ===================================== @@ -44,3 +44,4 @@ test('T22774', [unless(js_arch() or arch('wasm32'), expect_fail)], compile, [''] test('T24034', normal, compile, ['']) test('T25255', normal, compile, ['-dppr-debug']) +test('T26852', [when(js_arch(), skip), filter_stdout_lines(r'.*ghczuwrapper.*')], compile, ['-ddump-foreign']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/80e2dd4f084eff9cc857b31daf9ea2e9... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/80e2dd4f084eff9cc857b31daf9ea2e9... You're receiving this email because of your account on gitlab.haskell.org.