more

well-typed · Dec 10, 2024 · dd903e3 · dd903e3
1 parent 77fa735
commit dd903e3
Show file tree

Hide file tree

Showing 6 changed files with 219 additions and 34 deletions.
diff --git a/hs-bindgen-bootstrap/src/hs-bindgen-bootstrap.hs b/hs-bindgen-bootstrap/src/hs-bindgen-bootstrap.hs
@@ -122,22 +122,37 @@ ffiDecl (Comment comment) =
 ffiDecl (FunDecl (Var rtype name) args)
     | isStruct rtype
     =
-    [ "foreign import capi unsafe \"clang_wrappers.h\""
+    [ "foreign import capi unsafe \"clang_wrappers.h" ++ ffiName ++ "\""
     , "  " ++ name' ++ " :: " ++ foldr argumentTy (toHaskellType Res rtype) args ++ " -> IO ()"
     , ""
     ]
 
     | otherwise
     =
-    [ "foreign import capi unsafe \"clang_wrappers.h\""
+    [ "foreign import capi unsafe \"clang_wrappers.h" ++ ffiName ++ "\""
     , "  " ++ name' ++ " :: " ++ foldr argumentTy (ioType (toHaskellType Res rtype)) args
     , ""
     ]
   where
-    -- TODO: we don't mangle names if there aren't struct resutls args
-    name' = case stripPrefix "clang_" name of
-        Nothing  -> error $ name ++ " doesn't start with clang_"
-        Just sfx -> "wrap_" ++ sfx
+    -- name in C
+    ffiName
+        | isStruct rtype || any isStructVar args
+        = ""
+
+        | otherwise
+        = " " ++ name
+
+    -- name in Haskell
+    name'
+        | isStruct rtype || any isStructVar args
+        = case stripPrefix "clang_" name of
+            Nothing  -> error $ name ++ " doesn't start with clang_"
+            Just sfx -> "wrap_" ++ sfx
+
+        | otherwise
+        =  case stripPrefix "clang_" name of
+            Nothing  -> error $ name ++ " doesn't start with clang_"
+            Just sfx -> "nowrapper_" ++ sfx
 
     argumentTy :: Var -> String -> String
     argumentTy (Var ty _) rest = toHaskellType Arg ty ++ " -> " ++ rest
@@ -164,7 +179,7 @@ wrapDecl (Comment comment) =
     [ "/*" ++ comment ++ " */"
     , ""
     ]
-wrapDecl decl@(FunDecl (Var rtype rname) args)
+wrapDecl (FunDecl (Var rtype rname) args)
     | isStruct rtype
     =
     [ "static inline void " ++ rname' ++ "(" ++ foldr argumentTy (toCType Res rtype ++ " result") args ++ ") {"
@@ -183,9 +198,7 @@ wrapDecl decl@(FunDecl (Var rtype rname) args)
 
     | otherwise
     =
-    [ "/* " ++ show decl ++ " */"
-    , ""
-    ]
+    []
   where
     rname' = case stripPrefix "clang_" rname of
         Nothing  -> error $ rname ++ " doesn't start with clang_"

diff --git a/hs-bindgen-libclang/cbits/clang_wrappers.h b/hs-bindgen-libclang/cbits/clang_wrappers.h
@@ -158,18 +158,6 @@ static inline void wrap_getTranslationUnitCursor (CXTranslationUnit unit, CXCurs
     *result = clang_getTranslationUnitCursor(unit);
 }
 
-static inline void wrap_getCursorSemanticParent(const CXCursor* cursor, CXCursor* result) {
-    *result = clang_getCursorSemanticParent(*cursor);
-}
-
-static inline void wrap_getCursorLexicalParent(const CXCursor* cursor, CXCursor* result) {
-    *result = clang_getCursorLexicalParent(*cursor);
-}
-
-static inline void wrap_getCursorKindSpelling(enum CXCursorKind Kind, CXString* result) {
-    *result = clang_getCursorKindSpelling(Kind);
-}
-
 static inline CXTranslationUnit wrap_Cursor_getTranslationUnit(const CXCursor* cursor) {
     return clang_Cursor_getTranslationUnit(*cursor);
 }

diff --git a/hs-bindgen-libclang/cbits/clang_wrappers_ffi.h b/hs-bindgen-libclang/cbits/clang_wrappers_ffi.h
@@ -267,3 +267,73 @@ static inline enum CXCursorKind wrap_getCursorKind(const CXCursor* cursor) {
   return clang_getCursorKind(*cursor);
 }
 
+static inline unsigned wrap_isInvalidDeclaration(const CXCursor* cursor) {
+  return clang_isInvalidDeclaration(*cursor);
+}
+
+static inline unsigned wrap_Cursor_hasAttrs(const CXCursor* C) {
+  return clang_Cursor_hasAttrs(*C);
+}
+
+/* enum CXLinkageKind clang_getCursorLinkage (CXCursor cursor); // no enum */
+
+/* enum CXVisibilityKind clang_getCursorVisibility (CXCursor cursor); // no enum */
+
+/* enum CXAvailabilityKind clang_getCursorAvailability (CXCursor cursor); // no enum */
+
+/* int clang_getCursorPlatformAvailability (CXCursor cursor, int *always_deprecated, CXString *deprecated_message, int *always_unavailable, CXString *unavailable_message, CXPlatformAvailability *availability, int availability_size); */
+
+/* void clang_disposeCXPlatformAvailability (CXPlatformAvailability *availability); */
+
+static inline void wrap_Cursor_getVarDeclInitializer(const CXCursor* cursor, CXCursor* result) {
+  *result = clang_Cursor_getVarDeclInitializer(*cursor);
+}
+
+static inline int wrap_Cursor_hasVarDeclGlobalStorage(const CXCursor* cursor) {
+  return clang_Cursor_hasVarDeclGlobalStorage(*cursor);
+}
+
+static inline int wrap_Cursor_hasVarDeclExternalStorage(const CXCursor* cursor) {
+  return clang_Cursor_hasVarDeclExternalStorage(*cursor);
+}
+
+/* enum CXLanguageKind clang_getCursorLanguage (CXCursor cursor); // no enum */
+
+/* enum CXTLSKind clang_getCursorTLSKind (CXCursor cursor); // no enum */
+
+/* CXTranslationUnit clang_Cursor_getTranslationUnit (CXCursor cursor); CXTranslationUnit is defined in LowLevel.Core */
+
+/* CXCursorSet clang_createCXCursorSet (void); // no cursor set */
+
+/* void clang_disposeCXCursorSet (CXCursorSet cset); // no cursor set */
+
+/* unsigned clang_CXCursorSet_contains (CXCursorSet cset, CXCursor cursor); // no cursor set */
+
+/* unsigned clang_CXCursorSet_insert (CXCursorSet cset, CXCursor cursor); // no cursor set */
+
+static inline void wrap_getCursorSemanticParent(const CXCursor* cursor, CXCursor* result) {
+  *result = clang_getCursorSemanticParent(*cursor);
+}
+
+static inline void wrap_getCursorLexicalParent(const CXCursor* cursor, CXCursor* result) {
+  *result = clang_getCursorLexicalParent(*cursor);
+}
+
+/* void clang_getOverriddenCursors (CXCursor cursor, CXCursor **overridden, unsigned *num_overridden); // C++? */
+
+/* void clang_disposeOverriddenCursors (CXCursor *overridden); // C++? */
+
+/* CXFile clang_getIncludedFile (CXCursor cursor); // CXFile is defined in LowLevel.Core */
+
+/* Debugging facilities https://clang.llvm.org/doxygen/group__CINDEX__DEBUG.html */
+
+static inline void wrap_getCursorKindSpelling(enum CXCursorKind Kind, CXString* result) {
+  *result = clang_getCursorKindSpelling(Kind);
+}
+
+/* void clang_getDefinitionSpellingAndExtent (CXCursor, const char **startBuf, const char **endBuf, unsigned *startLine, unsigned *startColumn, unsigned *endLine, unsigned *endColumn); */
+
+/* void clang_enableStackTraces (void); */
+
+/* void clang_executeOnThread (void(*fn)(void *), void *user_data, unsigned stack_size); */
+
diff --git a/hs-bindgen-libclang/src/HsBindgen/Clang/LowLevel/Core.hs b/hs-bindgen-libclang/src/HsBindgen/Clang/LowLevel/Core.hs
@@ -628,21 +628,9 @@ instance Eq CXCursor where
 foreign import capi unsafe "clang_wrappers.h wrap_getTranslationUnitCursor"
   wrap_getTranslationUnitCursor :: CXTranslationUnit -> W CXCursor_ -> IO ()
 
-foreign import capi unsafe "clang_wrappers.h wrap_getCursorSemanticParent"
-  wrap_getCursorSemanticParent :: R CXCursor_ -> W CXCursor_ -> IO ()
-
-foreign import capi unsafe "clang_wrappers.h wrap_getCursorLexicalParent"
-  wrap_getCursorLexicalParent :: R CXCursor_ -> W CXCursor_ -> IO ()
-
-foreign import capi unsafe "clang_wrappers.h wrap_getCursorKindSpelling"
-  wrap_getCursorKindSpelling :: SimpleEnum CXCursorKind -> W CXString_ -> IO ()
-
 foreign import capi unsafe "wrap_Cursor_getTranslationUnit"
   wrap_Cursor_getTranslationUnit :: R CXCursor_ -> IO CXTranslationUnit
 
-foreign import capi unsafe "clang-c/Index.h clang_isDeclaration"
-  nowrapper_isDeclaration :: SimpleEnum CXCursorKind -> IO CUInt
-
 -- | Retrieve the cursor that represents the given translation unit.
 --
 -- The translation unit cursor can be used to start traversing the various

diff --git a/hs-bindgen-libclang/src/HsBindgen/Clang/LowLevel/FFI.hs b/hs-bindgen-libclang/src/HsBindgen/Clang/LowLevel/FFI.hs
@@ -220,3 +220,92 @@ foreign import capi unsafe "clang_wrappers.h"
 foreign import capi unsafe "clang_wrappers.h"
   wrap_getCursorKind :: R CXCursor_ -> IO (SimpleEnum CXCursorKind)
 
+foreign import capi unsafe "clang_wrappers.h clang_isDeclaration"
+  nowrapper_isDeclaration :: SimpleEnum CXCursorKind -> IO CUInt
+
+foreign import capi unsafe "clang_wrappers.h"
+  wrap_isInvalidDeclaration :: R CXCursor_ -> IO CUInt
+
+foreign import capi unsafe "clang_wrappers.h clang_isReference"
+  nowrapper_isReference :: SimpleEnum CXCursorKind -> IO CUInt
+
+foreign import capi unsafe "clang_wrappers.h clang_isExpression"
+  nowrapper_isExpression :: SimpleEnum CXCursorKind -> IO CUInt
+
+foreign import capi unsafe "clang_wrappers.h clang_isStatement"
+  nowrapper_isStatement :: SimpleEnum CXCursorKind -> IO CUInt
+
+foreign import capi unsafe "clang_wrappers.h clang_isAttribute"
+  nowrapper_isAttribute :: SimpleEnum CXCursorKind -> IO CUInt
+
+foreign import capi unsafe "clang_wrappers.h"
+  wrap_Cursor_hasAttrs :: R CXCursor_ -> IO CUInt
+
+foreign import capi unsafe "clang_wrappers.h clang_isInvalid"
+  nowrapper_isInvalid :: SimpleEnum CXCursorKind -> IO CUInt
+
+foreign import capi unsafe "clang_wrappers.h clang_isTranslationUnit"
+  nowrapper_isTranslationUnit :: SimpleEnum CXCursorKind -> IO CUInt
+
+foreign import capi unsafe "clang_wrappers.h clang_isPreprocessing"
+  nowrapper_isPreprocessing :: SimpleEnum CXCursorKind -> IO CUInt
+
+foreign import capi unsafe "clang_wrappers.h clang_isUnexposed"
+  nowrapper_isUnexposed :: SimpleEnum CXCursorKind -> IO CUInt
+
+-- enum CXLinkageKind clang_getCursorLinkage (CXCursor cursor); // no enum
+
+-- enum CXVisibilityKind clang_getCursorVisibility (CXCursor cursor); // no enum
+
+-- enum CXAvailabilityKind clang_getCursorAvailability (CXCursor cursor); // no enum
+
+-- int clang_getCursorPlatformAvailability (CXCursor cursor, int *always_deprecated, CXString *deprecated_message, int *always_unavailable, CXString *unavailable_message, CXPlatformAvailability *availability, int availability_size);
+
+-- void clang_disposeCXPlatformAvailability (CXPlatformAvailability *availability);
+
+foreign import capi unsafe "clang_wrappers.h"
+  wrap_Cursor_getVarDeclInitializer :: R CXCursor_ -> W CXCursor_ -> IO ()
+
+foreign import capi unsafe "clang_wrappers.h"
+  wrap_Cursor_hasVarDeclGlobalStorage :: R CXCursor_ -> IO CInt
+
+foreign import capi unsafe "clang_wrappers.h"
+  wrap_Cursor_hasVarDeclExternalStorage :: R CXCursor_ -> IO CInt
+
+-- enum CXLanguageKind clang_getCursorLanguage (CXCursor cursor); // no enum
+
+-- enum CXTLSKind clang_getCursorTLSKind (CXCursor cursor); // no enum
+
+-- CXTranslationUnit clang_Cursor_getTranslationUnit (CXCursor cursor); CXTranslationUnit is defined in LowLevel.Core
+
+-- CXCursorSet clang_createCXCursorSet (void); // no cursor set
+
+-- void clang_disposeCXCursorSet (CXCursorSet cset); // no cursor set
+
+-- unsigned clang_CXCursorSet_contains (CXCursorSet cset, CXCursor cursor); // no cursor set
+
+-- unsigned clang_CXCursorSet_insert (CXCursorSet cset, CXCursor cursor); // no cursor set
+
+foreign import capi unsafe "clang_wrappers.h"
+  wrap_getCursorSemanticParent :: R CXCursor_ -> W CXCursor_ -> IO ()
+
+foreign import capi unsafe "clang_wrappers.h"
+  wrap_getCursorLexicalParent :: R CXCursor_ -> W CXCursor_ -> IO ()
+
+-- void clang_getOverriddenCursors (CXCursor cursor, CXCursor **overridden, unsigned *num_overridden); // C++?
+
+-- void clang_disposeOverriddenCursors (CXCursor *overridden); // C++?
+
+-- CXFile clang_getIncludedFile (CXCursor cursor); // CXFile is defined in LowLevel.Core
+
+-- Debugging facilities https://clang.llvm.org/doxygen/group__CINDEX__DEBUG.html
+
+foreign import capi unsafe "clang_wrappers.h"
+  wrap_getCursorKindSpelling :: SimpleEnum CXCursorKind -> W CXString_ -> IO ()
+
+-- void clang_getDefinitionSpellingAndExtent (CXCursor, const char **startBuf, const char **endBuf, unsigned *startLine, unsigned *startColumn, unsigned *endLine, unsigned *endColumn);
+
+-- void clang_enableStackTraces (void);
+
+-- void clang_executeOnThread (void(*fn)(void *), void *user_data, unsigned stack_size);
+
diff --git a/imports.h b/imports.h
@@ -80,3 +80,40 @@ unsigned clang_equalCursors (CXCursor A, CXCursor B);
 int clang_Cursor_isNull (CXCursor cursor);
 unsigned clang_hashCursor (CXCursor cursor);
 enum CXCursorKind clang_getCursorKind (CXCursor cursor);
+unsigned clang_isDeclaration (enum CXCursorKind k);
+unsigned clang_isInvalidDeclaration (CXCursor cursor);
+unsigned clang_isReference (enum CXCursorKind k);
+unsigned clang_isExpression (enum CXCursorKind k);
+unsigned clang_isStatement (enum CXCursorKind k);
+unsigned clang_isAttribute (enum CXCursorKind k);
+unsigned clang_Cursor_hasAttrs (CXCursor C);
+unsigned clang_isInvalid (enum CXCursorKind k);
+unsigned clang_isTranslationUnit (enum CXCursorKind k);
+unsigned clang_isPreprocessing (enum CXCursorKind k);
+unsigned clang_isUnexposed (enum CXCursorKind k);
+// enum CXLinkageKind clang_getCursorLinkage (CXCursor cursor); // no enum
+// enum CXVisibilityKind clang_getCursorVisibility (CXCursor cursor); // no enum
+// enum CXAvailabilityKind clang_getCursorAvailability (CXCursor cursor); // no enum
+// int clang_getCursorPlatformAvailability (CXCursor cursor, int *always_deprecated, CXString *deprecated_message, int *always_unavailable, CXString *unavailable_message, CXPlatformAvailability *availability, int availability_size);
+// void clang_disposeCXPlatformAvailability (CXPlatformAvailability *availability);
+CXCursor clang_Cursor_getVarDeclInitializer (CXCursor cursor);
+int clang_Cursor_hasVarDeclGlobalStorage (CXCursor cursor);
+ int clang_Cursor_hasVarDeclExternalStorage (CXCursor cursor);
+// enum CXLanguageKind clang_getCursorLanguage (CXCursor cursor); // no enum
+// enum CXTLSKind clang_getCursorTLSKind (CXCursor cursor); // no enum
+// CXTranslationUnit clang_Cursor_getTranslationUnit (CXCursor cursor); CXTranslationUnit is defined in LowLevel.Core
+// CXCursorSet clang_createCXCursorSet (void); // no cursor set
+// void clang_disposeCXCursorSet (CXCursorSet cset); // no cursor set
+// unsigned clang_CXCursorSet_contains (CXCursorSet cset, CXCursor cursor); // no cursor set
+// unsigned clang_CXCursorSet_insert (CXCursorSet cset, CXCursor cursor); // no cursor set
+CXCursor clang_getCursorSemanticParent (CXCursor cursor);
+CXCursor clang_getCursorLexicalParent (CXCursor cursor);
+// void clang_getOverriddenCursors (CXCursor cursor, CXCursor **overridden, unsigned *num_overridden); // C++?
+// void clang_disposeOverriddenCursors (CXCursor *overridden); // C++?
+// CXFile clang_getIncludedFile (CXCursor cursor); // CXFile is defined in LowLevel.Core
+
+// Debugging facilities https://clang.llvm.org/doxygen/group__CINDEX__DEBUG.html
+CXString clang_getCursorKindSpelling (enum CXCursorKind Kind);
+// void clang_getDefinitionSpellingAndExtent (CXCursor, const char **startBuf, const char **endBuf, unsigned *startLine, unsigned *startColumn, unsigned *endLine, unsigned *endColumn);
+// void clang_enableStackTraces (void);
+// void clang_executeOnThread (void(*fn)(void *), void *user_data, unsigned stack_size);