Skip to content

Commit f2be590

Browse files
jorisdraljorisdral
authored
Merge pull request #37 from well-typed/jdral/type_getoffsetof
Add a binding for the `clang_Type_getOffsetOf` function
2 parents dcfd24a + 2c8f84d commit f2be590

8 files changed

Lines changed: 104 additions & 9 deletions

File tree

‎CHANGELOG.md‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6,10 +6,14 @@
66

77
### New features
88

9+
* Add a binding for the `clang_Type_getOffsetOf` function. See [PR #37][pr-37].
10+
911
### Minor changes
1012

1113
### Bug fixes
1214

15+
[pr-37]: https://github.com/well-typed/libclang/pull/37
16+
1317
## 0.1.0-alpha -- 2026-02-06
1418

1519
* First version. Released on an unsuspecting world.

‎bootstrap/clang-bootstrap.hs‎

Lines changed: 16 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -61,15 +61,21 @@ cident = lexeme $ do
6161
t <- many $ P.satisfy $ \c -> c == '_' || isLetter c -- or num
6262
return (h : t)
6363

64-
-- we cheat a bit, we don't recognise *.
64+
-- pointers are only recognised when they are surrounded by whitespace
65+
pointer :: Parser Char
66+
pointer = lexeme (P.char '*')
67+
68+
pointerS :: Parser String
69+
pointerS = (:[]) <$> pointer
70+
6571
varDecl :: Parser Var
6672
varDecl = do
67-
x <- cident
68-
y <- cident
73+
x <- cident <|> pointerS
74+
y <- cident <|> pointerS
6975
go (x :) y
7076
where
7177
go :: ([String] -> [String]) -> String -> Parser Var
72-
go xs y = (cident >>= \z -> go (xs . (y : )) z) <|> return (Var (xs []) y)
78+
go xs y = ((cident <|> pointerS) >>= \z -> go (xs . (y : )) z) <|> return (Var (xs []) y)
7379

7480
funDeclP :: Parser Decl
7581
funDeclP = do
@@ -106,12 +112,15 @@ ffiModule ds = unlines $
106112
header =
107113
[ "{-| this module is autogenerated with cabal run clang-bootstrap -}"
108114
, "module Clang.LowLevel.FFI (module Clang.LowLevel.FFI) where"
109-
, "import Foreign.C.Types"
115+
, ""
110116
, "import Clang.Enum.Simple"
111117
, "import Clang.Internal.ByValue"
118+
, "import Clang.Internal.ConstPtr"
112119
, "import Clang.LowLevel.Core.Enums"
113120
, "import Clang.LowLevel.Core.Pointers"
114121
, "import Clang.LowLevel.Core.Structs"
122+
, "import Foreign.C.Types"
123+
, ""
115124
]
116125

117126
ffiDecl :: Decl -> [String]
@@ -256,6 +265,7 @@ toHaskellType _ ["unsigned","long","long"] = "CULLong"
256265
toHaskellType _ ["unsigned"] = "CUInt"
257266
toHaskellType _ ["int"] = "CInt"
258267
toHaskellType _ ["void"] = "()"
268+
toHaskellType _ ["const", "char", "*"] = "ConstPtr CChar"
259269
toHaskellType _ ty = error $ "Unknown type " ++ unwords ty
260270

261271
cRA :: RA -> String
@@ -282,4 +292,5 @@ toCType _ ["unsigned","long","long"] = "unsigned long long"
282292
toCType _ ["unsigned"] = "unsigned"
283293
toCType _ ["int"] = "int"
284294
toCType _ ["void"] = "void"
295+
toCType _ ["const", "char", "*"] = "const char *"
285296
toCType _ ty = error $ "Unknown type " ++ unwords ty

‎bootstrap/imports.h‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -55,7 +55,7 @@ unsigned clang_Type_isTransparentTagTypedef (CXType T);
5555
long long clang_Type_getAlignOf (CXType T);
5656
// CXType clang_Type_getClassType (CXType T); // C++
5757
long long clang_Type_getSizeOf (CXType T);
58-
// long long clang_Type_getOffsetOf (CXType T, const char *S) // TODO: generator doesn't know * yet
58+
long long clang_Type_getOffsetOf (CXType T, const char * S);
5959
CXType clang_Type_getModifiedType (CXType T);
6060
CXType clang_Type_getValueType (CXType CT);
6161
long long clang_Cursor_getOffsetOfField (CXCursor C);

‎cbits/clang_wrappers_ffi.h‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -199,7 +199,9 @@ static inline long long wrap_Type_getSizeOf(const CXType* T) {
199199
return clang_Type_getSizeOf(*T);
200200
}
201201

202-
/* long long clang_Type_getOffsetOf (CXType T, const char *S) // TODO: generator doesn't know * yet */
202+
static inline long long wrap_Type_getOffsetOf(const CXType* T, const char * S) {
203+
return clang_Type_getOffsetOf(*T, S);
204+
}
203205

204206
static inline void wrap_Type_getModifiedType(const CXType* T, CXType* result) {
205207
*result = clang_Type_getModifiedType(*T);

‎libclang-bindings.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -98,6 +98,7 @@ library
9898
Clang.HighLevel.SourceLoc
9999
Clang.HighLevel.Tokens
100100
Clang.HighLevel.Wrappers
101+
Clang.Internal.ConstPtr
101102
Clang.Internal.CXString
102103
Clang.Internal.FFI
103104
Clang.Internal.Results

‎src/Clang/Internal/ConstPtr.hs‎

Lines changed: 60 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,60 @@
1+
{-# LANGUAGE RoleAnnotations #-}
2+
{-# LANGUAGE StandaloneKindSignatures #-}
3+
{-# LANGUAGE Trustworthy #-}
4+
{-# LANGUAGE CPP #-}
5+
6+
-----------------------------------------------------------------------------
7+
-- |
8+
-- Module : GHC.Internal.Foreign.C.ConstPtr
9+
-- Copyright : (c) GHC Developers
10+
-- License : BSD-style (see the file libraries/base/LICENSE)
11+
--
12+
-- Maintainer : ffi@haskell.org
13+
-- Stability : provisional
14+
-- Portability : portable
15+
--
16+
-- This module provides typed @const@ pointers to foreign data. It is part
17+
-- of the Foreign Function Interface (FFI).
18+
--
19+
-- NOTE: this is a copy of the "Foreign.C.ConstPtr" module from the @base@
20+
-- package, added here because versions of @base@ before @4.18@ do not provide a
21+
-- 'ConstPtr' type. When the @base@ version is @4.18@ or higher, the
22+
-- "Foreign.C.ConstPtr" is re-exported instead. Licenses and copyrights for the
23+
-- "Foreign.C.ConstPtr" module apply to the current module.
24+
--
25+
-----------------------------------------------------------------------------
26+
27+
module Clang.Internal.ConstPtr (
28+
ConstPtr(..)
29+
) where
30+
31+
#if MIN_VERSION_base(4,18,0)
32+
33+
import Foreign.C.ConstPtr (ConstPtr (..))
34+
35+
#else
36+
37+
import Data.Kind (Type)
38+
import Foreign.Ptr (Ptr)
39+
import Foreign.Storable (Storable)
40+
41+
-- | A pointer with the C @const@ qualifier. For instance, an argument of type
42+
-- @ConstPtr CInt@ would be marshalled as @const int*@.
43+
--
44+
-- While @const@-ness generally does not matter for @ccall@ imports (since
45+
-- @const@ and non-@const@ pointers typically have equivalent calling
46+
-- conventions), it does matter for @capi@ imports. See GHC #22043.
47+
--
48+
-- @since base-4.18.0.0
49+
--
50+
type ConstPtr :: Type -> Type
51+
type role ConstPtr phantom
52+
newtype ConstPtr a = ConstPtr { unConstPtr :: Ptr a }
53+
deriving stock (Eq, Ord)
54+
deriving newtype Storable
55+
56+
-- doesn't use record syntax
57+
instance Show (ConstPtr a) where
58+
showsPrec d (ConstPtr p) = showParen (d > 10) $ showString "ConstPtr " . showsPrec 11 p
59+
60+
#endif

‎src/Clang/LowLevel/Core.hs‎

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -145,6 +145,7 @@ module Clang.LowLevel.Core (
145145
, clang_getArraySize
146146
, clang_Type_getSizeOf
147147
, clang_Type_getAlignOf
148+
, clang_Type_getOffsetOf
148149
, clang_Type_isTransparentTagTypedef
149150
, clang_Cursor_getOffsetOfField
150151
, clang_Cursor_getStorageClass
@@ -239,6 +240,7 @@ import Clang.Args
239240
import Clang.Enum.Bitfield
240241
import Clang.Enum.Simple
241242
import Clang.Internal.ByValue
243+
import Clang.Internal.ConstPtr (ConstPtr (ConstPtr))
242244
import Clang.Internal.CXString ()
243245
import Clang.Internal.FFI
244246
import Clang.Internal.Results
@@ -1424,6 +1426,18 @@ clang_Type_getAlignOf typ = liftIO $
14241426
onHaskellHeap typ $ \typ' -> ensureNotInRange @CXTypeLayoutError $
14251427
wrap_Type_getAlignOf typ'
14261428

1429+
-- | Return the offset of a field named S in a record of type T in bits as it
1430+
-- would be returned by offsetof as per C++11[18.2p4].
1431+
--
1432+
-- Throws 'CallFailed' with 'CXTypeLayoutError' on error.
1433+
--
1434+
-- <https://clang.llvm.org/doxygen/group__CINDEX__TYPES.html#gab543536d5c18efb3e23a1b7903fb494d>
1435+
clang_Type_getOffsetOf :: (MonadIO m, HasCallStack) => CXType -> String -> m CLLong
1436+
clang_Type_getOffsetOf typ fieldName = liftIO $
1437+
onHaskellHeap typ $ \typ' -> ensureNotInRange @CXTypeLayoutError $
1438+
withCString fieldName $ \fieldName' ->
1439+
wrap_Type_getOffsetOf typ' (ConstPtr fieldName')
1440+
14271441
-- | Determine if a typedef is 'transparent' tag.
14281442
--
14291443
-- A typedef is considered 'transparent' if it shares a name and spelling

‎src/Clang/LowLevel/FFI.hs‎

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,14 @@
11
{-| this module is autogenerated with cabal run clang-bootstrap -}
22
module Clang.LowLevel.FFI (module Clang.LowLevel.FFI) where
3-
import Foreign.C.Types
43

54
import Clang.Enum.Simple
65
import Clang.Internal.ByValue
6+
import Clang.Internal.ConstPtr
77
import Clang.LowLevel.Core.Enums
88
import Clang.LowLevel.Core.Pointers
99
import Clang.LowLevel.Core.Structs
10+
import Foreign.C.Types
11+
1012
-- Type information for CXCursors https://clang.llvm.org/doxygen/group__CINDEX__TYPES.html
1113

1214
foreign import capi unsafe "clang_wrappers.h"
@@ -164,7 +166,8 @@ foreign import capi unsafe "clang_wrappers.h"
164166
foreign import capi unsafe "clang_wrappers.h"
165167
wrap_Type_getSizeOf :: R CXType_ -> IO CLLong
166168

167-
-- long long clang_Type_getOffsetOf (CXType T, const char *S) // TODO: generator doesn't know * yet
169+
foreign import capi unsafe "clang_wrappers.h"
170+
wrap_Type_getOffsetOf :: R CXType_ -> ConstPtr CChar -> IO CLLong
168171

169172
foreign import capi unsafe "clang_wrappers.h"
170173
wrap_Type_getModifiedType :: R CXType_ -> W CXType_ -> IO ()

0 commit comments

Comments
 (0)