diff --git a/.gitignore b/.gitignore index 9739e331..2c9e4dec 100644 --- a/.gitignore +++ b/.gitignore @@ -2,3 +2,4 @@ dist-newstyle/ unversioned cabal.project.local +.vscode/ diff --git a/hs-bindgen/cbits/clang_wrappers.c b/hs-bindgen/cbits/clang_wrappers.c new file mode 100644 index 00000000..603bac60 --- /dev/null +++ b/hs-bindgen/cbits/clang_wrappers.c @@ -0,0 +1,25 @@ +#include +#include + +#include + +#include "clang_wrappers.h" + +/** + * Cursor manipulations + */ + +CXCursor* wrap_malloc_getTranslationUnitCursor (CXTranslationUnit unit) { + CXCursor result = clang_getTranslationUnitCursor(unit); + CXCursor *wrapped = malloc(sizeof(CXCursor)); + memcpy(wrapped, &result, sizeof(CXCursor)); + return wrapped; +} + +/** + * Traversing the AST with cursors + */ + +unsigned wrap_visitChildren(CXCursor* parent, CXCursorVisitor visitor, CXClientData client_data) { + return clang_visitChildren(*parent, visitor, client_data); +} \ No newline at end of file diff --git a/hs-bindgen/cbits/clang_wrappers.h b/hs-bindgen/cbits/clang_wrappers.h new file mode 100644 index 00000000..7d11b01d --- /dev/null +++ b/hs-bindgen/cbits/clang_wrappers.h @@ -0,0 +1,19 @@ +/** + * Wrappers for clang functions that take structs, or return them, by value. + * + * For functions that return structs by value, we instead allocate memory and + * return a pointer. It is the responsibility of the caller to attach a + * finalizer to these pointers; to remind the caller to do so, these functions + * are prefixed with @wrap_malloc_@; the other functions are prefixed with + * @wrap_@ (in both cases this prefixes replaces the @clang_@ prefix). + */ + +#include + +// Cursor manipulations + +CXCursor* wrap_malloc_getTranslationUnitCursor (CXTranslationUnit unit); + +// Traversing the AST with cursors + +unsigned wrap_visitChildren(CXCursor* parent, CXCursorVisitor visitor, CXClientData); \ No newline at end of file diff --git a/hs-bindgen/hs-bindgen.cabal b/hs-bindgen/hs-bindgen.cabal index 95139dcd..b62beb96 100644 --- a/hs-bindgen/hs-bindgen.cabal +++ b/hs-bindgen/hs-bindgen.cabal @@ -9,6 +9,8 @@ category: Development build-type: Simple synopsis: Generate Haskell bindings from C headers extra-doc-files: CHANGELOG.md +extra-source-files: cbits/*.c + cbits/*.h tested-with: , GHC==9.2.8 , GHC==9.4.8 , GHC==9.6.6 @@ -29,10 +31,14 @@ common lang default-extensions: DerivingStrategies DisambiguateRecordFields + RoleAnnotations + TypeFamilies library import: lang + other-extensions: + CApiFFI exposed-modules: HsBindgen HsBindgen.Preprocessor @@ -42,6 +48,9 @@ library HsBindgen.Annotation HsBindgen.C HsBindgen.Clang + HsBindgen.Clang.LowLevel + HsBindgen.Clang.Tutorial + HsBindgen.Clang.Util HsBindgen.Spec.Resolved hs-source-dirs: src @@ -50,10 +59,19 @@ library , haskell-src-meta >= 0.8 && < 0.9 , template-haskell >= 2.18 && < 2.23 + -- @libclang@ + -- -- TODO: -- It seems @libclang@ does not support @pkg-config@. + extra-libraries: clang + c-sources: + cbits/clang_wrappers.c + include-dirs: + cbits + cc-options: + -Wall executable hs-bindgen import: diff --git a/hs-bindgen/src/HsBindgen/Annotation.hs b/hs-bindgen/src/HsBindgen/Annotation.hs index 9ecae56d..c261ef0e 100644 --- a/hs-bindgen/src/HsBindgen/Annotation.hs +++ b/hs-bindgen/src/HsBindgen/Annotation.hs @@ -21,6 +21,13 @@ module HsBindgen.Annotation ( -------------------------------------------------------------------------------} -- | Syntax tree annotation +-- +-- TODO: +-- We should use this explain tool decisions (when generating high-level API). +-- +-- TODO: +-- We should reference the relevant part of the C header here (including line +-- numbers). data Ann = Ann { } diff --git a/hs-bindgen/src/HsBindgen/Clang.hs b/hs-bindgen/src/HsBindgen/Clang.hs index c4a6a09e..4fb28a69 100644 --- a/hs-bindgen/src/HsBindgen/Clang.hs +++ b/hs-bindgen/src/HsBindgen/Clang.hs @@ -1,7 +1,4 @@ --- | Bindings to @libclang@ --- --- The goal of this module is not to be a complete set of bindings for all of --- @libclang@, but rather only to the parts that we need. +-- | High-level bindings to @libclang@ -- -- Intended for qualified import. -- diff --git a/hs-bindgen/src/HsBindgen/Clang/LowLevel.hsc b/hs-bindgen/src/HsBindgen/Clang/LowLevel.hsc new file mode 100644 index 00000000..56998a79 --- /dev/null +++ b/hs-bindgen/src/HsBindgen/Clang/LowLevel.hsc @@ -0,0 +1,423 @@ +{-# LANGUAGE CApiFFI #-} + +-- | Low-level bindings to @libclang@ +-- +-- Guidelines: +-- +-- * The goal of this module is not to be a complete set of bindings for all of +-- @libclang@, but rather only to the parts that we need. +-- * The bindings we /do/ include are complete; for example, we list all values +-- of enum. +-- * We do include documentation. +-- * Names are chosen to be as close as possible to the C API. Record fields are +-- of a struct @cxFooBar@ are prefixed @cxfb@. +-- * For the specific case of enums that correspond to bitfields, we declare an +-- ADT with a constructor per flag (this also allows us to stay closer to the +-- C names); see 'HsBindgen.Clang.Util.toFlags' for more info. +-- * For functions that take structs or return structs by value, we use our +-- own wrappers from @cbits/clang_wrappers.h@. +-- * In cases where we are responsible for calling @free@ (or some other +-- finalizer), we use 'ForeignPtr' rather than 'Ptr' in argument position. +-- (We have to be careful in doing this: the function must not return the +-- same pointer.) +-- +-- See . +-- +-- TODO: +-- Ideally we would bootstrap this (generate it using @hs-bindgen@ itself). +module HsBindgen.Clang.LowLevel ( + -- * Top-level + CXIndex + , clang_createIndex + -- * Translation unit manipulation + , CXTranslationUnit + , CXUnsavedFile(..) + , CXTranslationUnit_Flags + , CXTranslationUnit_Flag(..) + , clang_parseTranslationUnit + -- * Cursor manipulations + , CXCursor + , clang_getTranslationUnitCursor + -- * Traversing the AST with cursors + , CXChildVisitResult(..) + , CXClientData + ) where + +import Foreign +import Foreign.C + +import HsBindgen.Clang.Util (BitfieldEnum(..)) + +#include + +{------------------------------------------------------------------------------- + Top-level +-------------------------------------------------------------------------------} + +-- | An "index" that consists of a set of translation units that would typically +-- be linked together into an executable or library. +-- +-- +data CXIndex + +-- | Provides a shared context for creating translation units. +-- +-- +foreign import capi unsafe "clang-c/Index.h clang_createIndex" + clang_createIndex :: + CInt + -- ^ @excludeDeclarationsFromPCH@ + -- + -- When non-zero, allows enumeration of "local" declarations (when + -- loading any new translation units). A "local" declaration is one that + -- belongs in the translation unit itself and not in a precompiled header + -- that was used by the translation unit. If zero, all declarations will + -- be enumerated. + -> CInt + -- ^ @displayDiagnostics@ + -> IO (Ptr CXIndex) + +{------------------------------------------------------------------------------- + Definition of 'CXTranslationUnit_Flags' +-------------------------------------------------------------------------------} + +-- | Flags that control the creation of translation units. +-- +-- The enumerators in this enumeration type are meant to be bitwise ORed +-- together to specify which options should be used when constructing the +-- translation unit. +-- +-- +type CXTranslationUnit_Flags = BitfieldEnum CXTranslationUnit_Flag + +{-# DEPRECATED CXTranslationUnit_CXXChainedPCH + "Note: this is a *temporary* option that is available only while we are testing C++ precompiled preamble support." +#-} + +-- | Single flag of 'CXTranslationUnit_Flags' +data CXTranslationUnit_Flag = + -- | Used to indicate that no special translation-unit options are needed. + CXTranslationUnit_None -- = 0x0, + + -- | Used to indicate that the parser should construct a "detailed" + -- preprocessing record, including all macro definitions and instantiations. + -- + -- Constructing a detailed preprocessing record requires more memory and + -- time to parse, since the information contained in the record is usually + -- not retained. However, it can be useful for applications that require + -- more detailed information about the behavior of the preprocessor. + | CXTranslationUnit_DetailedPreprocessingRecord + + -- | Used to indicate that the translation unit is incomplete. + -- + -- When a translation unit is considered "incomplete", semantic analysis + -- that is typically performed at the end of the translation unit will be + -- suppressed. For example, this suppresses the completion of tentative + -- declarations in C and of instantiation of implicitly-instantiation + -- function templates in C++. This option is typically used when parsing a + -- header with the intent of producing a precompiled header. + | CXTranslationUnit_Incomplete + + -- | Used to indicate that the translation unit should be built with an + -- implicit precompiled header for the preamble. + -- + -- An implicit precompiled header is used as an optimization when a + -- particular translation unit is likely to be reparsed many times when the + -- sources aren't changing that often. In this case, an implicit precompiled + -- header will be built containing all of the initial includes at the top of + -- the main file (what we refer to as the "preamble" of the file). In + -- subsequent parses, if the preamble or the files in it have not changed, + -- \c clang_reparseTranslationUnit() will re-use the implicit precompiled + -- header to improve parsing performance. + | CXTranslationUnit_PrecompiledPreamble + + -- | Used to indicate that the translation unit should cache some + -- code-completion results with each reparse of the source file. + -- + -- Caching of code-completion results is a performance optimization that + -- introduces some overhead to reparsing but improves the performance of + -- code-completion operations. + | CXTranslationUnit_CacheCompletionResults + + -- | Used to indicate that the translation unit will be serialized with + -- 'clang_saveTranslationUnit'. + -- + -- This option is typically used when parsing a header with the intent of + -- producing a precompiled header. + | CXTranslationUnit_ForSerialization + + -- | Enabled chained precompiled preambles in C++. + | CXTranslationUnit_CXXChainedPCH + + -- | Used to indicate that function/method bodies should be skipped while + -- parsing. + -- + -- This option can be used to search for declarations/definitions while + -- ignoring the usages. + | CXTranslationUnit_SkipFunctionBodies + + -- | Used to indicate that brief documentation comments should be included + -- into the set of code completions returned from this translation unit. + | CXTranslationUnit_IncludeBriefCommentsInCodeCompletion + + -- | Used to indicate that the precompiled preamble should be created on the + -- first parse. Otherwise it will be created on the first reparse. This + -- trades runtime on the first parse (serializing the preamble takes time) + -- for reduced runtime on the second parse (can now reuse the preamble). + | CXTranslationUnit_CreatePreambleOnFirstParse + + -- | Do not stop processing when fatal errors are encountered. + -- + -- When fatal errors are encountered while parsing a translation unit, + -- semantic analysis is typically stopped early when compiling code. A + -- common source for fatal errors are unresolvable include files. For the + -- purposes of an IDE, this is undesirable behavior and as much information + -- as possible should be reported. Use this flag to enable this behavior. + | CXTranslationUnit_KeepGoing + + -- | Sets the preprocessor in a mode for parsing a single file only. + | CXTranslationUnit_SingleFileParse + + -- | Used in combination with CXTranslationUnit_SkipFunctionBodies to + -- constrain the skipping of function bodies to the preamble. + -- + -- The function bodies of the main file are not skipped. + | CXTranslationUnit_LimitSkipFunctionBodiesToPreamble + + -- | Used to indicate that attributed types should be included in CXType. + | CXTranslationUnit_IncludeAttributedTypes + + -- | Used to indicate that implicit attributes should be visited. + | CXTranslationUnit_VisitImplicitAttributes + + -- | Used to indicate that non-errors from included files should be ignored. + -- + -- If set, 'clang_getDiagnosticSetFromTU' will not report e.g. warnings from + -- included files anymore. This speeds up 'clang_getDiagnosticSetFromTU' for + -- the case where these warnings are not of interest, as for an IDE for + -- example, which typically shows only the diagnostics in the main file. + | CXTranslationUnit_IgnoreNonErrorsFromIncludedFiles + + -- | Tells the preprocessor not to skip excluded conditional blocks. + | CXTranslationUnit_RetainExcludedConditionalBlocks + +instance Enum CXTranslationUnit_Flag where + fromEnum CXTranslationUnit_None = #const CXTranslationUnit_None + fromEnum CXTranslationUnit_DetailedPreprocessingRecord = #const CXTranslationUnit_DetailedPreprocessingRecord + fromEnum CXTranslationUnit_Incomplete = #const CXTranslationUnit_Incomplete + fromEnum CXTranslationUnit_PrecompiledPreamble = #const CXTranslationUnit_PrecompiledPreamble + fromEnum CXTranslationUnit_CacheCompletionResults = #const CXTranslationUnit_CacheCompletionResults + fromEnum CXTranslationUnit_ForSerialization = #const CXTranslationUnit_ForSerialization + fromEnum CXTranslationUnit_CXXChainedPCH = #const CXTranslationUnit_CXXChainedPCH + fromEnum CXTranslationUnit_SkipFunctionBodies = #const CXTranslationUnit_SkipFunctionBodies + fromEnum CXTranslationUnit_IncludeBriefCommentsInCodeCompletion = #const CXTranslationUnit_IncludeBriefCommentsInCodeCompletion + fromEnum CXTranslationUnit_CreatePreambleOnFirstParse = #const CXTranslationUnit_CreatePreambleOnFirstParse + fromEnum CXTranslationUnit_KeepGoing = #const CXTranslationUnit_KeepGoing + fromEnum CXTranslationUnit_SingleFileParse = #const CXTranslationUnit_SingleFileParse + fromEnum CXTranslationUnit_LimitSkipFunctionBodiesToPreamble = #const CXTranslationUnit_LimitSkipFunctionBodiesToPreamble + fromEnum CXTranslationUnit_IncludeAttributedTypes = #const CXTranslationUnit_IncludeAttributedTypes + fromEnum CXTranslationUnit_VisitImplicitAttributes = #const CXTranslationUnit_VisitImplicitAttributes + fromEnum CXTranslationUnit_IgnoreNonErrorsFromIncludedFiles = #const CXTranslationUnit_IgnoreNonErrorsFromIncludedFiles + fromEnum CXTranslationUnit_RetainExcludedConditionalBlocks = #const CXTranslationUnit_RetainExcludedConditionalBlocks + + toEnum (#const CXTranslationUnit_None) = CXTranslationUnit_None + toEnum (#const CXTranslationUnit_DetailedPreprocessingRecord) = CXTranslationUnit_DetailedPreprocessingRecord + toEnum (#const CXTranslationUnit_Incomplete) = CXTranslationUnit_Incomplete + toEnum (#const CXTranslationUnit_PrecompiledPreamble) = CXTranslationUnit_PrecompiledPreamble + toEnum (#const CXTranslationUnit_CacheCompletionResults) = CXTranslationUnit_CacheCompletionResults + toEnum (#const CXTranslationUnit_ForSerialization) = CXTranslationUnit_ForSerialization + toEnum (#const CXTranslationUnit_CXXChainedPCH) = CXTranslationUnit_CXXChainedPCH + toEnum (#const CXTranslationUnit_SkipFunctionBodies) = CXTranslationUnit_SkipFunctionBodies + toEnum (#const CXTranslationUnit_IncludeBriefCommentsInCodeCompletion) = CXTranslationUnit_IncludeBriefCommentsInCodeCompletion + toEnum (#const CXTranslationUnit_CreatePreambleOnFirstParse) = CXTranslationUnit_CreatePreambleOnFirstParse + toEnum (#const CXTranslationUnit_KeepGoing) = CXTranslationUnit_KeepGoing + toEnum (#const CXTranslationUnit_SingleFileParse) = CXTranslationUnit_SingleFileParse + toEnum (#const CXTranslationUnit_LimitSkipFunctionBodiesToPreamble) = CXTranslationUnit_LimitSkipFunctionBodiesToPreamble + toEnum (#const CXTranslationUnit_IncludeAttributedTypes) = CXTranslationUnit_IncludeAttributedTypes + toEnum (#const CXTranslationUnit_VisitImplicitAttributes) = CXTranslationUnit_VisitImplicitAttributes + toEnum (#const CXTranslationUnit_IgnoreNonErrorsFromIncludedFiles) = CXTranslationUnit_IgnoreNonErrorsFromIncludedFiles + toEnum (#const CXTranslationUnit_RetainExcludedConditionalBlocks) = CXTranslationUnit_RetainExcludedConditionalBlocks + + toEnum flag = error $ "Unknown CXTranslationUnit_Flag " ++ show flag + +{------------------------------------------------------------------------------- + Translation unit manipulation +-------------------------------------------------------------------------------} + +-- | A single translation unit, which resides in an index. +-- +-- +data CXTranslationUnit + +-- | Provides the contents of a file that has not yet been saved to disk. +-- +-- Each 'CXUnsavedFile' instance provides the name of a file on the system along +-- with the current contents of that file that have not yet been saved to disk. +-- +-- +data CXUnsavedFile = CXUnsavedFile { + -- | The file whose contents have not yet been saved. + cxufFilename :: CString + + -- | A buffer containing the unsaved contents of this file. + , cxufContents :: CString + + -- | The length of the unsaved contents of this buffer. + , cxufLength :: CULong + } + +-- | Same as 'clang_parseTranslationUnit2', but returns the 'CXTranslationUnit' +-- instead of an error code. +-- +-- In case of an error this routine returns a NULL CXTranslationUnit, without +-- further detailed error codes. +-- +-- We use @ccall@ to avoid problems with the @const char *const *@ type +-- (). +-- +-- +foreign import ccall unsafe "clang-c/Index.h clang_parseTranslationUnit" + clang_parseTranslationUnit :: + Ptr CXIndex + -- ^ @CIdx@ + -> CString + -- ^ @source_filename@ + -> Ptr CString + -- ^ @command_line_args@ + -> CInt + -- ^ @num_command_line_args@ + -> Ptr CXUnsavedFile + -- ^ @unsaved_files@ + -> CUInt + -- ^ @num_unsaved_files@ + -> CXTranslationUnit_Flags + -- ^ @options@ + -> IO (Ptr CXTranslationUnit) + +{------------------------------------------------------------------------------- + Cursor manipulations +-------------------------------------------------------------------------------} + +-- | A cursor representing some element in the abstract syntax tree for a +-- translation unit. +-- +-- The cursor abstraction unifies the different kinds of entities in a +-- program–declaration, statements, expressions, references to declarations, +-- etc.–under a single "cursor" abstraction with a common set of operations. +-- Common operation for a cursor include: getting the physical location in a +-- source file where the cursor points, getting the name associated with a +-- cursor, and retrieving cursors for any child nodes of a particular cursor. +-- +-- Cursors can be produced in two specific ways: +-- +-- * 'clang_getTranslationUnitCursor' produces a cursor for a translation unit, +-- from which one can use 'clang_visitChildren' to explore the rest of the +-- translation unit. +-- * 'clang_getCursor' maps from a physical source location to the entity that +-- resides at that location, allowing one to map from the source code into the +-- AST. +-- +-- For now we keep this type abstract. +-- +-- +data CXCursor + +-- | Retrieve the cursor that represents the given translation unit. +-- +-- The translation unit cursor can be used to start traversing the various +-- declarations within the given translation unit. +-- +-- +foreign import capi unsafe "clang_wrappers.h wrap_malloc_getTranslationUnitCursor" + clang_getTranslationUnitCursor :: + Ptr CXTranslationUnit + -> IO (Ptr CXCursor) + +{------------------------------------------------------------------------------- + Traversing the AST with cursors +-------------------------------------------------------------------------------} + +-- | Describes how the traversal of the children of a particular cursor should +-- proceed after visiting a particular child cursor. +-- +-- A value of this enumeration type should be returned by each 'CXCursorVisitor' +-- to indicate how 'clang_visitChildren' proceed. +data CXChildVisitResult = + -- | Terminates the cursor traversal. + CXChildVisit_Break + + -- | Continues the cursor traversal with the next sibling of the cursor just + -- visited, without visiting its children. + | CXChildVisit_Continue + + -- | Recursively traverse the children of this cursor, using the same + -- visitor and client data. + | CXChildVisit_Recurse + +-- | Opaque pointer representing client data that will be passed through to +-- various callbacks and visitors. +type CXClientData = Ptr () + +-- | Visitor invoked for each cursor found by a traversal. +-- +-- This visitor function will be invoked for each cursor found by +-- 'clang_visitCursorChildren'. Its first argument is the cursor being visited, +-- its second argument is the parent visitor for that cursor, and its third +-- argument is the client data provided to 'clang_visitCursorChildren'. +-- +-- The visitor should return one of the 'CXChildVisitResult' values to direct +-- 'clang_visitCursorChildren'. +-- +-- NEXT UP: This is somewhat tricky, as we will need to wrap the visitor, for +-- access to the cursors. We will probably need ot make a wrapper of the wrapper, +-- which takes its own client data, pointing to the original wrapper. For this +-- reason, we will need to _allocate_ this client data, and hence ForeignPtr +-- rather than Ptr..? +type CXCursorVisitor = Ptr () + + +{- +typedef enum CXChildVisitResult(* CXCursorVisitor) (CXCursor cursor, CXCursor parent, CXClientData client_data) +Visitor invoked for each cursor found by a traversal. + + This visitor function will be invoked for each cursor found by clang_visitCursorChildren(). Its first argument is the cursor being visited, its second argument is the parent visitor for that cursor, and its third argument is the client data provided to clang_visitCursorChildren(). + +The visitor should return one of the CXChildVisitResult values to direct clang_visitCursorChildren(). +-} + +foreign import capi unsafe "clang_wrappers.h wrap_clang_visitChildren" + clang_visitChildren' :: + Ptr CXCursor + -> CXCursorVisitor + -> CXClientData + -> IO CUInt + +-- | Visit the children of a particular cursor. +-- +-- This function visits all the direct children of the given cursor, invoking +-- the given visitor function with the cursors of each visited child. The +-- traversal may be recursive, if the visitor returns 'CXChildVisit_Recurse'. +-- The traversal may also be ended prematurely, if the visitor returns +-- 'CXChildVisit_Break'. +clang_visitChildren :: + ForeignPtr CXCursor + -- ^ @parent@ + -- + -- The cursor whose child may be visited. All kinds of cursors can be + -- visited, including invalid cursors (which, by definition, have no + -- children). + -> CXCursorVisitor + -- ^ @visitor@ + -- + -- The visitor function that will be invoked for each child of parent. + -> CXClientData + -- ^ @client_data@ + -- + -- Pointer data supplied by the client, which will be passed to the + -- visitor each time it is invoked. + -> IO CUInt + -- ^ A non-zero value if the traversal was terminated prematurely by the + -- visitor returning 'CXChildVisit_Break'. +clang_visitChildren parent visitor client_data = + withForeignPtr parent $ \parent' -> + clang_visitChildren' parent' visitor client_data \ No newline at end of file diff --git a/hs-bindgen/src/HsBindgen/Clang/Tutorial.hs b/hs-bindgen/src/HsBindgen/Clang/Tutorial.hs new file mode 100644 index 00000000..142591ca --- /dev/null +++ b/hs-bindgen/src/HsBindgen/Clang/Tutorial.hs @@ -0,0 +1,27 @@ +-- * Haskell translation of the @libclang@ tutorial +-- +-- See +module HsBindgen.Clang.Tutorial where + +import Foreign +import Foreign.C + +import HsBindgen.Clang.LowLevel +import HsBindgen.Clang.Util + +tutorial :: FilePath -> IO () +tutorial fp = withCString fp $ \fp' -> do + -- Obtain cursor + index <- clang_createIndex 0 0 + unit <- clang_parseTranslationUnit + index + fp' + nullPtr + 0 + nullPtr + 0 + (toBitfieldEnum [CXTranslationUnit_None]) + cursur <- clang_getTranslationUnitCursor unit + + -- Visiting elements of an AST + undefined diff --git a/hs-bindgen/src/HsBindgen/Clang/Util.hs b/hs-bindgen/src/HsBindgen/Clang/Util.hs new file mode 100644 index 00000000..1aebbe45 --- /dev/null +++ b/hs-bindgen/src/HsBindgen/Clang/Util.hs @@ -0,0 +1,33 @@ +-- | Utilities for working with low-level @libclang@ API +module HsBindgen.Clang.Util ( + -- * Simple C enums + CEnum(..) + -- * Flag bitfields + , BitfieldEnum(..) + , toBitfieldEnum + ) where + +import Data.Bits +import Data.List (foldl') +import Foreign.C + +{------------------------------------------------------------------------------- + Simple C enums +-------------------------------------------------------------------------------} + +-- | C-declared @enum@, with corresponding Haskell ADT @a@ +newtype CEnum a = CEnum CInt + +{------------------------------------------------------------------------------- + Flag bitfields +-------------------------------------------------------------------------------} + +newtype BitfieldEnum flag = BitfieldEnum CUInt + +-- | Construct flags +-- +-- Some @libclang@ functions take a set of flags as a bitfield. We construct +-- these flags by defining an ADT with a constructor for each single flag, +-- give it an 'Enum' instance, and then use 'toFlags' to construct the bitfield. +toBitfieldEnum :: Enum flag => [flag] -> BitfieldEnum flag +toBitfieldEnum = BitfieldEnum . fromIntegral . foldl' (.|.) 0 . map fromEnum