diff --git a/LibClang.cabal b/LibClang.cabal --- a/LibClang.cabal +++ b/LibClang.cabal @@ -1,6 +1,6 @@ Name: LibClang Cabal-version: >= 1.6 -Version: 0.0.8 +Version: 0.0.9 Author: Chetan Taralekar Maintainer: Chetan Taralekar Homepage: https://github.com/chetant/LibClang/issues @@ -32,7 +32,7 @@ location: git://github.com/chetant/LibClang.git Library - build-depends: base < 5, ffi, greencard + build-depends: base < 5, time, ffi, greencard extensions: TypeSynonymInstances, EmptyDataDecls hs-source-dirs: src c-sources: src/Clang/FFI_stub_ffi.c diff --git a/src/Clang/Cursor.hs b/src/Clang/Cursor.hs --- a/src/Clang/Cursor.hs +++ b/src/Clang/Cursor.hs @@ -32,7 +32,6 @@ ,getCanonicalCursor ,getTemplateKind ,getSpecializedTemplate -,getTranslationUnitCursor -- attribute function ,getIBOutletCollectionType @@ -93,7 +92,6 @@ getCanonicalCursor = unsafePerformIO . FFI.getCanonicalCursor getTemplateKind = unsafePerformIO . FFI.getTemplateCursorKind getSpecializedTemplate = unsafePerformIO . FFI.getSpecializedCursorTemplate -getTranslationUnitCursor = unsafePerformIO . FFI.getTranslationUnitCursor -- attribute function getIBOutletCollectionType = unsafePerformIO . FFI.getIBOutletCollectionType diff --git a/src/Clang/FFI.gc b/src/Clang/FFI.gc --- a/src/Clang/FFI.gc +++ b/src/Clang/FFI.gc @@ -173,6 +173,8 @@ import Foreign.ForeignPtr import Foreign.Ptr import System.IO.Unsafe(unsafePerformIO) +import Data.Maybe(fromJust) +import Control.Monad(when) %#include %#include @@ -222,7 +224,7 @@ -- }; data UnsavedFile = UnsavedFile { unsavedFilename :: FilePath, unsavedContents :: String } -%enum AvailabilityKind Int [CXAvailability_Available, CXAvailability_Deprecated, CXAvailability_NotAvailable] +%enum AvailabilityKind (Eq) Int [CXAvailability_Available, CXAvailability_Deprecated, CXAvailability_NotAvailable] -- enum CXAvailabilityKind { -- CXAvailability_Available, -- CXAvailability_Deprecated, @@ -264,7 +266,9 @@ %result (cxString (ptr r)) -- time_t clang_getFileTime(CXFile SFile); -%fun clang_getFileTime :: File -> IO Word32 +-- %fun clang_getFileTime :: File -> IO CTime +getFileTime (File ptr) = clang_getFileTime ptr +foreign import ccall unsafe "clang-c/Index.h clang_getFileTime" clang_getFileTime :: Ptr () -> IO CTime -- CXFile clang_getFile(CXTranslationUnit tu, const char *file_name); %fun clang_getFile :: TranslationUnit -> String -> IO File @@ -388,7 +392,7 @@ -- CXDiagnostic_Error = 3, -- CXDiagnostic_Fatal = 4 -- }; -%enum DiagnosticSeverity Int [CXDiagnostic_Ignored, CXDiagnostic_Note, CXDiagnostic_Warning, CXDiagnostic_Error, CXDiagnostic_Fatal] +%enum DiagnosticSeverity (Eq) Int [CXDiagnostic_Ignored, CXDiagnostic_Note, CXDiagnostic_Warning, CXDiagnostic_Error, CXDiagnostic_Fatal] -- typedef void *CXDiagnostic; data DiagnosticObj @@ -423,7 +427,7 @@ -- CXDiagnostic_DisplayCategoryId = 0x10, -- CXDiagnostic_DisplayCategoryName = 0x20 -- }; -%enum DiagnosticDisplayOptions Int [CXDiagnostic_DisplaySourceLocation,CXDiagnostic_DisplayColumn,CXDiagnostic_DisplaySourceRanges, CXDiagnostic_DisplayOption, CXDiagnostic_DisplayCategoryId,CXDiagnostic_DisplayCategoryName] +%enum DiagnosticDisplayOptions (Eq) Int [CXDiagnostic_DisplaySourceLocation,CXDiagnostic_DisplayColumn,CXDiagnostic_DisplaySourceRanges, CXDiagnostic_DisplayOption, CXDiagnostic_DisplayCategoryId,CXDiagnostic_DisplayCategoryName] getDiagnosticDispOptSum :: [DiagnosticDisplayOptions] -> Int getDiagnosticDispOptSum = sum . (map toVal_) @@ -533,7 +537,7 @@ -- CXTranslationUnit_CXXPrecompiledPreamble = 0x10, -- CXTranslationUnit_CXXChainedPCH = 0x20 -- }; -%enum TranslationUnitFlags Int [CXTranslationUnit_None, CXTranslationUnit_DetailedPreprocessingRecord, CXTranslationUnit_Incomplete, CXTranslationUnit_PrecompiledPreamble, CXTranslationUnit_CacheCompletionResults, CXTranslationUnit_CXXPrecompiledPreamble, CXTranslationUnit_CXXChainedPCH] +%enum TranslationUnitFlags (Eq) Int [CXTranslationUnit_None, CXTranslationUnit_DetailedPreprocessingRecord, CXTranslationUnit_Incomplete, CXTranslationUnit_PrecompiledPreamble, CXTranslationUnit_CacheCompletionResults, CXTranslationUnit_CXXPrecompiledPreamble, CXTranslationUnit_CXXChainedPCH] getTranslationUnitFlagsSum :: [TranslationUnitFlags] -> Int getTranslationUnitFlagsSum = sum . (map toVal_) @@ -599,7 +603,7 @@ -- enum CXSaveTranslationUnit_Flags { -- CXSaveTranslationUnit_None = 0x0 -- }; -%enum SaveTranslationUnitFlags Int [CXSaveTranslationUnit_None] +%enum SaveTranslationUnitFlags (Eq) Int [CXSaveTranslationUnit_None] getSaveTranslationUnitFlagsSum :: [SaveTranslationUnitFlags] -> Int getSaveTranslationUnitFlagsSum = sum . (map toVal_) @@ -622,7 +626,7 @@ -- enum CXReparse_Flags { -- CXReparse_None = 0x0 -- }; -%enum ReparseFlags Int [CXReparse_None] +%enum ReparseFlags (Eq) Int [CXReparse_None] getReparseFlagsSum :: [ReparseFlags] -> Int getReparseFlagsSum = sum . (map toVal_) @@ -731,7 +735,7 @@ -- CXCursor_FirstPreprocessing = CXCursor_PreprocessingDirective, -- CXCursor_LastPreprocessing = CXCursor_InclusionDirective -- }; -%enum CursorKind Int [CXCursor_UnexposedDecl,CXCursor_StructDecl,CXCursor_UnionDecl,CXCursor_ClassDecl,CXCursor_EnumDecl,CXCursor_FieldDecl,CXCursor_EnumConstantDecl,CXCursor_FunctionDecl,CXCursor_VarDecl,CXCursor_ParmDecl,CXCursor_ObjCInterfaceDecl,CXCursor_ObjCCategoryDecl,CXCursor_ObjCProtocolDecl,CXCursor_ObjCPropertyDecl,CXCursor_ObjCIvarDecl,CXCursor_ObjCInstanceMethodDecl,CXCursor_ObjCClassMethodDecl,CXCursor_ObjCImplementationDecl,CXCursor_ObjCCategoryImplDecl,CXCursor_TypedefDecl,CXCursor_CXXMethod,CXCursor_Namespace,CXCursor_LinkageSpec,CXCursor_Constructor,CXCursor_Destructor,CXCursor_ConversionFunction,CXCursor_TemplateTypeParameter,CXCursor_NonTypeTemplateParameter,CXCursor_TemplateTemplateParameter,CXCursor_FunctionTemplate,CXCursor_ClassTemplate,CXCursor_ClassTemplatePartialSpecialization,CXCursor_NamespaceAlias,CXCursor_UsingDirective,CXCursor_UsingDeclaration,CXCursor_FirstDecl,CXCursor_LastDecl,CXCursor_FirstRef,CXCursor_ObjCSuperClassRef,CXCursor_ObjCProtocolRef,CXCursor_ObjCClassRef,CXCursor_TypeRef,CXCursor_CXXBaseSpecifier,CXCursor_TemplateRef,CXCursor_NamespaceRef,CXCursor_MemberRef,CXCursor_LabelRef, CXCursor_OverloadedDeclRef, CXCursor_LastRef,CXCursor_FirstInvalid,CXCursor_InvalidFile,CXCursor_NoDeclFound,CXCursor_NotImplemented,CXCursor_InvalidCode,CXCursor_LastInvalid,CXCursor_FirstExpr,CXCursor_UnexposedExpr,CXCursor_DeclRefExpr,CXCursor_MemberRefExpr,CXCursor_CallExpr,CXCursor_ObjCMessageExpr,CXCursor_BlockExpr,CXCursor_LastExpr,CXCursor_FirstStmt,CXCursor_UnexposedStmt, CXCursor_LabelStmt, CXCursor_LastStmt,CXCursor_TranslationUnit,CXCursor_FirstAttr,CXCursor_UnexposedAttr,CXCursor_IBActionAttr,CXCursor_IBOutletAttr,CXCursor_IBOutletCollectionAttr,CXCursor_LastAttr, CXCursor_PreprocessingDirective,CXCursor_MacroDefinition,CXCursor_MacroInstantiation,CXCursor_InclusionDirective,CXCursor_FirstPreprocessing,CXCursor_LastPreprocessing] +%enum CursorKind (Eq) Int [CXCursor_UnexposedDecl,CXCursor_StructDecl,CXCursor_UnionDecl,CXCursor_ClassDecl,CXCursor_EnumDecl,CXCursor_FieldDecl,CXCursor_EnumConstantDecl,CXCursor_FunctionDecl,CXCursor_VarDecl,CXCursor_ParmDecl,CXCursor_ObjCInterfaceDecl,CXCursor_ObjCCategoryDecl,CXCursor_ObjCProtocolDecl,CXCursor_ObjCPropertyDecl,CXCursor_ObjCIvarDecl,CXCursor_ObjCInstanceMethodDecl,CXCursor_ObjCClassMethodDecl,CXCursor_ObjCImplementationDecl,CXCursor_ObjCCategoryImplDecl,CXCursor_TypedefDecl,CXCursor_CXXMethod,CXCursor_Namespace,CXCursor_LinkageSpec,CXCursor_Constructor,CXCursor_Destructor,CXCursor_ConversionFunction,CXCursor_TemplateTypeParameter,CXCursor_NonTypeTemplateParameter,CXCursor_TemplateTemplateParameter,CXCursor_FunctionTemplate,CXCursor_ClassTemplate,CXCursor_ClassTemplatePartialSpecialization,CXCursor_NamespaceAlias,CXCursor_UsingDirective,CXCursor_UsingDeclaration,CXCursor_FirstDecl,CXCursor_LastDecl,CXCursor_FirstRef,CXCursor_ObjCSuperClassRef,CXCursor_ObjCProtocolRef,CXCursor_ObjCClassRef,CXCursor_TypeRef,CXCursor_CXXBaseSpecifier,CXCursor_TemplateRef,CXCursor_NamespaceRef,CXCursor_MemberRef,CXCursor_LabelRef, CXCursor_OverloadedDeclRef, CXCursor_LastRef,CXCursor_FirstInvalid,CXCursor_InvalidFile,CXCursor_NoDeclFound,CXCursor_NotImplemented,CXCursor_InvalidCode,CXCursor_LastInvalid,CXCursor_FirstExpr,CXCursor_UnexposedExpr,CXCursor_DeclRefExpr,CXCursor_MemberRefExpr,CXCursor_CallExpr,CXCursor_ObjCMessageExpr,CXCursor_BlockExpr,CXCursor_LastExpr,CXCursor_FirstStmt,CXCursor_UnexposedStmt, CXCursor_LabelStmt, CXCursor_LastStmt,CXCursor_TranslationUnit,CXCursor_FirstAttr,CXCursor_UnexposedAttr,CXCursor_IBActionAttr,CXCursor_IBOutletAttr,CXCursor_IBOutletCollectionAttr,CXCursor_LastAttr, CXCursor_PreprocessingDirective,CXCursor_MacroDefinition,CXCursor_MacroInstantiation,CXCursor_InclusionDirective,CXCursor_FirstPreprocessing,CXCursor_LastPreprocessing] -- typedef struct { -- enum CXCursorKind kind; @@ -797,7 +801,7 @@ -- CXLinkage_UniqueExternal, -- CXLinkage_External -- }; -%enum LinkageKind Int [CXLinkage_Invalid,CXLinkage_NoLinkage,CXLinkage_Internal,CXLinkage_UniqueExternal,CXLinkage_External] +%enum LinkageKind (Eq) Int [CXLinkage_Invalid,CXLinkage_NoLinkage,CXLinkage_Internal,CXLinkage_UniqueExternal,CXLinkage_External] -- enum CXLinkageKind clang_getCursorLinkage(CXCursor cursor); %fun clang_getCursorLinkage :: Cursor -> IO LinkageKind @@ -819,7 +823,7 @@ -- CXLanguage_ObjC, -- CXLanguage_CPlusPlus -- }; -%enum LanguageKind Int [CXLanguage_Invalid,CXLanguage_C,CXLanguage_ObjC,CXLanguage_CPlusPlus] +%enum LanguageKind (Eq) Int [CXLanguage_Invalid,CXLanguage_C,CXLanguage_ObjC,CXLanguage_CPlusPlus] -- enum CXLanguageKind clang_getCursorLanguage(CXCursor cursor); %fun clang_getCursorLanguage :: Cursor -> IO LanguageKind @@ -977,7 +981,7 @@ -- CXType_FunctionProto = 111 -- }; -%enum TypeKind Int [CXType_Invalid,CXType_Unexposed,CXType_Void,CXType_Bool,CXType_Char_U,CXType_UChar,CXType_Char16,CXType_Char32,CXType_UShort,CXType_UInt,CXType_ULong,CXType_ULongLong,CXType_UInt128,CXType_Char_S,CXType_SChar,CXType_WChar,CXType_Short,CXType_Int,CXType_Long,CXType_LongLong,CXType_Int128,CXType_Float,CXType_Double,CXType_LongDouble,CXType_NullPtr,CXType_Overload,CXType_Dependent,CXType_ObjCId,CXType_ObjCClass,CXType_ObjCSel,CXType_FirstBuiltin,CXType_LastBuiltin,CXType_Complex,CXType_Pointer,CXType_BlockPointer,CXType_LValueReference,CXType_RValueReference,CXType_Record,CXType_Enum,CXType_Typedef,CXType_ObjCInterface,CXType_ObjCObjectPointer,CXType_FunctionNoProto,CXType_FunctionProto] +%enum TypeKind (Eq) Int [CXType_Invalid,CXType_Unexposed,CXType_Void,CXType_Bool,CXType_Char_U,CXType_UChar,CXType_Char16,CXType_Char32,CXType_UShort,CXType_UInt,CXType_ULong,CXType_ULongLong,CXType_UInt128,CXType_Char_S,CXType_SChar,CXType_WChar,CXType_Short,CXType_Int,CXType_Long,CXType_LongLong,CXType_Int128,CXType_Float,CXType_Double,CXType_LongDouble,CXType_NullPtr,CXType_Overload,CXType_Dependent,CXType_ObjCId,CXType_ObjCClass,CXType_ObjCSel,CXType_FirstBuiltin,CXType_LastBuiltin,CXType_Complex,CXType_Pointer,CXType_BlockPointer,CXType_LValueReference,CXType_RValueReference,CXType_Record,CXType_Enum,CXType_Typedef,CXType_ObjCInterface,CXType_ObjCObjectPointer,CXType_FunctionNoProto,CXType_FunctionProto] -- typedef struct { -- enum CXTypeKind kind; @@ -1092,7 +1096,7 @@ -- CX_CXXProtected, -- CX_CXXPrivate -- }; -%enum CXXAccessSpecifier Int [CX_CXXInvalidAccessSpecifier, CX_CXXPublic, CX_CXXProtected, CX_CXXPrivate] +%enum CXXAccessSpecifier (Eq) Int [CX_CXXInvalidAccessSpecifier, CX_CXXPublic, CX_CXXProtected, CX_CXXPrivate] -- enum CX_CXXAccessSpecifier clang_getCXXAccessSpecifier(CXCursor); %fun clang_getCXXAccessSpecifier :: Cursor -> IO CXXAccessSpecifier @@ -1128,7 +1132,7 @@ -- CXChildVisit_Continue, -- CXChildVisit_Recurse -- }; -%enum ChildVisitResult Int [CXChildVisit_Break, CXChildVisit_Continue, CXChildVisit_Recurse] +%enum ChildVisitResult (Eq) Int [CXChildVisit_Break, CXChildVisit_Continue, CXChildVisit_Recurse] -- TODO: test me -- typedef enum CXChildVisitResult (*CXCursorVisitor)(CXCursor cursor, @@ -1136,27 +1140,36 @@ -- CXClientData client_data); type ChildVisitorRaw = Int -> Ptr () -> Ptr () -> Ptr () -> Int -> Ptr () -> Ptr () -> Ptr () -> Ptr () -> IO Int -type ChildVisitor = Cursor -- ^ Current cursor - -> Cursor -- ^ Parent cursor - -> Ptr () -- ^ User data - -> IO ChildVisitResult -- ^ Visitor result code indicating direction of visit +type ChildVisitor a = Cursor -- ^ Current cursor + -> Cursor -- ^ Parent cursor + -> Maybe a -- ^ User data + -> IO (Maybe a, ChildVisitResult) -- ^ (user data to pass on, Visitor result code) foreign import ccall "wrapper" wrapChildVisitorRaw :: ChildVisitorRaw -> IO (FunPtr ChildVisitorRaw) -wrapChildVisitor :: ChildVisitor -> ChildVisitorRaw +wrapChildVisitor :: (Storable a) => ChildVisitor a -> ChildVisitorRaw wrapChildVisitor f = \ck cp1 cp2 cp3 - pk pp1 pp2 pp3 pd -> marshall_ChildVisitResult <$> - f (Cursor (unmarshall_CursorKind ck) cp1 cp2 cp3) - (Cursor (unmarshall_CursorKind pk) pp1 pp2 pp3) - pd + pk pp1 pp2 pp3 pd -> do + let child = Cursor (unmarshall_CursorKind ck) cp1 cp2 cp3 + parent = Cursor (unmarshall_CursorKind pk) pp1 pp2 pp3 + dataPtr = castPtr pd + (rData, vRes) <- if dataPtr == nullPtr + then f child parent Nothing + else peek dataPtr >>= \d -> f child parent (Just d) + maybe (return ()) (poke dataPtr) rData + return (marshall_ChildVisitResult vRes) -- unsigned clang_visitChildren(CXCursor parent, -- CXCursorVisitor visitor, -- CXClientData client_data); -visitChildren :: Cursor -> ChildVisitor -> Ptr () -> IO Int -visitChildren (Cursor k p1 p2 p3) f pd = do +visitChildren :: (Storable a) => Cursor -> ChildVisitor a -> Maybe a -> IO (Maybe a, Bool) +visitChildren (Cursor k p1 p2 p3) f d = do fp <- wrapChildVisitorRaw (wrapChildVisitor f) - retVal <- fromIntegral <$> prim_visitChildren_ (marshall_CursorKind k) p1 p2 p3 pd fp + pd <- maybe (return nullPtr) (\x -> malloc >>= \p -> poke p x >> return p) d + retVal <- fromIntegral <$> prim_visitChildren_ (marshall_CursorKind k) p1 p2 p3 (castPtr pd) fp + rData <- if pd == nullPtr + then return Nothing + else peek pd >>= \d -> free pd >> return (Just d) freeHaskellFunPtr fp - return retVal + return (rData, retVal == 0) %C typedef enum CXChildVisitResult (*HSCursorVisitor) % (HsInt ck,HsPtr cp1, HsPtr cp2,HsPtr cp3, @@ -1312,7 +1325,7 @@ -- CXToken_Literal, -- CXToken_Comment -- } CXTokenKind; -%enum TokenKind Int [CXToken_Punctuation, CXToken_Keyword, CXToken_Identifier, CXToken_Literal, CXToken_Comment] +%enum TokenKind (Eq) Int [CXToken_Punctuation, CXToken_Keyword, CXToken_Identifier, CXToken_Literal, CXToken_Comment] -- typedef struct { -- unsigned int_data[4]; @@ -1481,7 +1494,7 @@ -- CXCompletionChunk_HorizontalSpace, -- CXCompletionChunk_VerticalSpace -- }; -%enum CompletionChunkKind Int [CXCompletionChunk_Optional,CXCompletionChunk_TypedText,CXCompletionChunk_Text,CXCompletionChunk_Placeholder,CXCompletionChunk_Informative,CXCompletionChunk_CurrentParameter,CXCompletionChunk_LeftParen,CXCompletionChunk_RightParen,CXCompletionChunk_LeftBracket,CXCompletionChunk_RightBracket,CXCompletionChunk_LeftBrace,CXCompletionChunk_RightBrace,CXCompletionChunk_LeftAngle,CXCompletionChunk_RightAngle,CXCompletionChunk_Comma,CXCompletionChunk_ResultType,CXCompletionChunk_Colon,CXCompletionChunk_SemiColon,CXCompletionChunk_Equal,CXCompletionChunk_HorizontalSpace,CXCompletionChunk_VerticalSpace] +%enum CompletionChunkKind (Eq) Int [CXCompletionChunk_Optional,CXCompletionChunk_TypedText,CXCompletionChunk_Text,CXCompletionChunk_Placeholder,CXCompletionChunk_Informative,CXCompletionChunk_CurrentParameter,CXCompletionChunk_LeftParen,CXCompletionChunk_RightParen,CXCompletionChunk_LeftBracket,CXCompletionChunk_RightBracket,CXCompletionChunk_LeftBrace,CXCompletionChunk_RightBrace,CXCompletionChunk_LeftAngle,CXCompletionChunk_RightAngle,CXCompletionChunk_Comma,CXCompletionChunk_ResultType,CXCompletionChunk_Colon,CXCompletionChunk_SemiColon,CXCompletionChunk_Equal,CXCompletionChunk_HorizontalSpace,CXCompletionChunk_VerticalSpace] -- enum CXCompletionChunkKind -- clang_getCompletionChunkKind(CXCompletionString completion_string, @@ -1517,7 +1530,7 @@ -- CXCodeComplete_IncludeMacros = 0x01, -- CXCodeComplete_IncludeCodePatterns = 0x02 -- }; -%enum CodeCompleteFlags Int [CXCodeComplete_IncludeMacros, CXCodeComplete_IncludeCodePatterns] +%enum CodeCompleteFlags (Eq) Int [CXCodeComplete_IncludeMacros, CXCodeComplete_IncludeCodePatterns] getCodeCompleteFlagsSum :: [CodeCompleteFlags] -> Int getCodeCompleteFlagsSum = sum . (map toVal_) @@ -1588,26 +1601,33 @@ -- CXClientData client_data); type InclusionVisitorRaw = File -> Ptr () -> CUInt -> Ptr () -> IO () -type InclusionVisitor = File -> [SourceLocation] -> Ptr () -> IO () +type InclusionVisitor a = File -> [SourceLocation] -> Maybe a -> IO (Maybe a) -- %fun clang_getInclusions :: TranslationUnit -> InclusionVisitor -> Ptr () -> IO () -- %call (ptr t) (inclusionVisitor (ptr f)) (ptr p) -- %code clang_getInclusions(t, f, p); -getInclusions :: TranslationUnit -> InclusionVisitor -> Ptr () -> IO () -getInclusions t iv p = - (marshall_inclusionVisitor iv) >>= \ (f) -> - prim_getInclusions_ t f p >> freeHaskellFunPtr f +getInclusions :: (Storable a) => TranslationUnit -> InclusionVisitor a -> Maybe a -> IO () +getInclusions t iv d = do + f <- marshall_inclusionVisitor iv + p <- maybe (return nullPtr) (\x -> malloc >>= \p -> poke p x >> return p) d + prim_getInclusions_ t f (castPtr p) + when (p /= nullPtr) $ free p + freeHaskellFunPtr f %C void prim_getInclusions_(HsPtr t,HsPtr f,HsPtr p){ do { clang_getInclusions(t, f, p);} while(0);} foreign import ccall safe "FFI_stub_ffi.h prim_getInclusions_" prim_getInclusions_ :: Ptr a1 -> FunPtr InclusionVisitorRaw -> Ptr a3 -> IO () foreign import ccall "wrapper" wrapInclusionVisitorRaw :: InclusionVisitorRaw -> IO (FunPtr InclusionVisitorRaw) -wrapInclusionVisitor :: InclusionVisitor -> InclusionVisitorRaw +wrapInclusionVisitor :: (Storable a) => InclusionVisitor a -> InclusionVisitorRaw wrapInclusionVisitor f = \file pSrcLoc nSrcLoc pData -> do srcLocs <- unmarshall_SrcLocList pSrcLoc nSrcLoc - f file srcLocs pData + let dataPtr = castPtr pData + rdat <- if dataPtr == nullPtr + then f file srcLocs Nothing + else peek dataPtr >>= \dat -> f file srcLocs (Just dat) + maybe (return ()) (poke dataPtr) rdat -marshall_inclusionVisitor :: InclusionVisitor -> IO (FunPtr InclusionVisitorRaw) +marshall_inclusionVisitor :: (Storable a) => InclusionVisitor a -> IO (FunPtr InclusionVisitorRaw) marshall_inclusionVisitor f = wrapInclusionVisitorRaw (wrapInclusionVisitor f) diff --git a/src/Clang/FFI_stub_ffi.c b/src/Clang/FFI_stub_ffi.c --- a/src/Clang/FFI_stub_ffi.c +++ b/src/Clang/FFI_stub_ffi.c @@ -40,12 +40,6 @@ return((HsPtr)(r));} while(0); } -HsWord32 prim_getFileTime(HsPtr arg1) -{ HsWord32 res1; - do {res1 = clang_getFileTime(arg1); - - return((HsWord32)(res1));} while(0); -} HsPtr prim_getFile(HsPtr t,char * s) { HsPtr r; do { CXFile r = clang_getFile(t, s); diff --git a/src/Clang/File.hs b/src/Clang/File.hs --- a/src/Clang/File.hs +++ b/src/Clang/File.hs @@ -2,15 +2,19 @@ ( FFI.UnsavedFile ,FFI.File -, +,getName +,getTime +,getFile ) where import Control.Monad((>=>)) +import Control.Applicative((<$>)) +import Data.Time.Clock.POSIX(POSIXTime, posixSecondsToUTCTime) import System.IO.Unsafe(unsafePerformIO) import qualified Clang.FFI as FFI -getFileName :: FFI.File -> FilePath -getFileName = unsafePerformIO . (FFI.getFileName >=> FFI.getCString) -getFileTime = unsafePerformIO . FFI.getFileTime +getName :: FFI.File -> FilePath +getName = unsafePerformIO . (FFI.getFileName >=> FFI.getCString) +getTime f = unsafePerformIO $ posixSecondsToUTCTime . realToFrac <$> FFI.getFileTime f getFile :: FFI.TranslationUnit -> FilePath -> FFI.File getFile t f = unsafePerformIO $ FFI.getFile t f diff --git a/src/Clang/TranslationUnit.hs b/src/Clang/TranslationUnit.hs --- a/src/Clang/TranslationUnit.hs +++ b/src/Clang/TranslationUnit.hs @@ -12,6 +12,7 @@ ,save ,defaultReparseOptions ,reparse +,getCursor ) where import System.IO.Unsafe(unsafePerformIO) @@ -63,6 +64,8 @@ -> [FFI.ReparseFlags] -- ^ reparse options -> IO Bool reparse t ufs opts = FFI.reparseTranslationUnit t ufs (FFI.getReparseFlagsSum opts) + +getCursor = unsafePerformIO . FFI.getTranslationUnitCursor -- index functions withCreateIndex i1 i2 f = flip withForeignPtr f =<< FFI.createIndex i1 i2 diff --git a/src/Clang/Traversal.hs b/src/Clang/Traversal.hs --- a/src/Clang/Traversal.hs +++ b/src/Clang/Traversal.hs @@ -4,6 +4,8 @@ ,FFI.ChildVisitor ,FFI.ChildVisitResult(..) ,FFI.visitChildren +,FFI.InclusionVisitor +,FFI.getInclusions ) where import qualified Clang.FFI as FFI diff --git a/test/Test_ChildVisitor.hs b/test/Test_ChildVisitor.hs --- a/test/Test_ChildVisitor.hs +++ b/test/Test_ChildVisitor.hs @@ -2,21 +2,19 @@ import Data.Maybe(maybe) import Control.Monad((<=<)) import Control.Applicative((<$>)) -import Clang.TranslationUnit(withCreateIndex, withParse, TranslationUnitFlags(..)) -import Clang.Traversal(visitChildren, ChildVisitResult(..)) -import Clang.Cursor(getTranslationUnitCursor) -import Clang.Traversal(ChildVisitor, ChildVisitResult(..)) +import Clang.TranslationUnit(withCreateIndex, withParse, TranslationUnitFlags(..), getCursor) +import Clang.Traversal(ChildVisitor, visitChildren, ChildVisitResult(..)) import qualified Clang.FFI as FFI import Foreign.Ptr(nullPtr) -visitor :: ChildVisitor +visitor :: ChildVisitor Int visitor c p d = do tk <- FFI.getTypeKind <$> FFI.getCursorType c str <- (FFI.getCString <=< FFI.getTypeKindSpelling) tk putStrLn $ "Type:" ++ str - return ChildVisit_Continue + return (d, ChildVisit_Continue) -test tu = visitChildren (getTranslationUnitCursor tu) visitor nullPtr +test tu = visitChildren (getCursor tu) visitor Nothing main = do (arg:args) <- getArgs diff --git a/test/Test_InclusionVisitor.hs b/test/Test_InclusionVisitor.hs --- a/test/Test_InclusionVisitor.hs +++ b/test/Test_InclusionVisitor.hs @@ -1,18 +1,20 @@ import System(getArgs) import Control.Monad(when) import Data.Maybe(fromJust, isNothing) -import qualified Clang.FFI as FFI -import qualified Clang.TranslationUnit as Clang +import Clang.TranslationUnit(withCreateIndex, withParse, TranslationUnitFlags(..)) import qualified Clang.Source as Clang -import Foreign.Ptr(nullPtr) +import Clang.Traversal +import Clang.File(getFileName) -printInclusions f sls p = do - name <- FFI.getFileName f - putStrLn $ "Included:" ++ show name +printInclusions :: InclusionVisitor Int +printInclusions f sls d = do + let name = getFileName f + putStrLn $ "Included:" ++ name + return d -test tu = FFI.getInclusions tu printInclusions nullPtr +test tu = getInclusions tu printInclusions Nothing main = do (arg:args) <- getArgs - Clang.withCreateIndex False False $ \index -> - Clang.withParse index (Just arg) args [] [Clang.TranslationUnit_None] test (error "No TXUnit!") + withCreateIndex False False $ \index -> + withParse index (Just arg) args [] [TranslationUnit_None] test (error "No TXUnit!")