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.9 +Version: 0.1.0 Author: Chetan Taralekar Maintainer: Chetan Taralekar Homepage: https://github.com/chetant/LibClang/issues @@ -32,9 +32,8 @@ location: git://github.com/chetant/LibClang.git Library - build-depends: base < 5, time, ffi, greencard - extensions: TypeSynonymInstances, EmptyDataDecls + build-depends: base < 5, time, greencard hs-source-dirs: src c-sources: src/Clang/FFI_stub_ffi.c exposed-modules: - Clang,Clang.FFI,Clang.Type,Clang.Cursor,Clang.CrossReference,Clang.Source,Clang.Diagnostic,Clang.TranslationUnit,Clang.Token,Clang.Debug,Clang.Completion,Clang.File,Clang.Traversal + Clang,Clang.FFI,Clang.Type,Clang.Cursor,Clang.CrossReference,Clang.Source,Clang.Diagnostic,Clang.TranslationUnit,Clang.Token,Clang.Debug,Clang.Completion,Clang.File,Clang.Traversal,Clang.Alloc,Clang.Alloc.Storable diff --git a/src/Clang/Alloc.hs b/src/Clang/Alloc.hs new file mode 100644 --- /dev/null +++ b/src/Clang/Alloc.hs @@ -0,0 +1,8 @@ +module Clang.Alloc where + +import Foreign.Ptr(Ptr(..)) + +class Alloc a where + alloc :: IO (Ptr a) + allocSet :: a -> IO (Ptr a) + dealloc :: Ptr a -> IO () diff --git a/src/Clang/Alloc/Storable.hs b/src/Clang/Alloc/Storable.hs new file mode 100644 --- /dev/null +++ b/src/Clang/Alloc/Storable.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE FlexibleInstances, UndecidableInstances #-} +module Clang.Alloc.Storable where + +import Foreign.Storable +import Foreign.Marshal.Alloc(malloc, free) +import Foreign.Marshal.Utils(new) + +import Clang.Alloc + +instance (Storable a) => Alloc a where + alloc = malloc + allocSet = new + dealloc = free diff --git a/src/Clang/Cursor.hs b/src/Clang/Cursor.hs --- a/src/Clang/Cursor.hs +++ b/src/Clang/Cursor.hs @@ -32,6 +32,7 @@ ,getCanonicalCursor ,getTemplateKind ,getSpecializedTemplate +,getTypeDeclaration -- attribute function ,getIBOutletCollectionType @@ -92,6 +93,7 @@ getCanonicalCursor = unsafePerformIO . FFI.getCanonicalCursor getTemplateKind = unsafePerformIO . FFI.getTemplateCursorKind getSpecializedTemplate = unsafePerformIO . FFI.getSpecializedCursorTemplate +getTypeDeclaration = unsafePerformIO . FFI.getTypeDeclaration -- attribute function getIBOutletCollectionType = unsafePerformIO . FFI.getIBOutletCollectionType diff --git a/src/Clang/Debug.hs b/src/Clang/Debug.hs --- a/src/Clang/Debug.hs +++ b/src/Clang/Debug.hs @@ -2,7 +2,7 @@ ( enableStackTraces ,getVersion -,toggleCrashRecovery +-- ,toggleCrashRecovery ) where import System.IO.Unsafe(unsafePerformIO) @@ -10,4 +10,4 @@ enableStackTraces = FFI.enableStackTraces getVersion = unsafePerformIO (FFI.getCString =<< FFI.getClangVersion) -toggleCrashRecovery = FFI.toggleCrashRecovery +-- toggleCrashRecovery = FFI.toggleCrashRecovery diff --git a/src/Clang/FFI.gc b/src/Clang/FFI.gc --- a/src/Clang/FFI.gc +++ b/src/Clang/FFI.gc @@ -1,4 +1,4 @@ -{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} module Clang.FFI ( Index @@ -160,7 +160,7 @@ ,codeCompleteGetNumDiagnostics ,codeCompleteGetDiagnostic ,getClangVersion -,toggleCrashRecovery +-- ,toggleCrashRecovery ,InclusionVisitor ,getInclusions ,wrapInclusionVisitor @@ -172,10 +172,13 @@ import Foreign.C import Foreign.ForeignPtr import Foreign.Ptr +import Foreign.Marshal.Utils(new) import System.IO.Unsafe(unsafePerformIO) import Data.Maybe(fromJust) import Control.Monad(when) +import Clang.Alloc + %#include %#include %#include @@ -744,6 +747,34 @@ data Cursor = Cursor CursorKind (Ptr ()) (Ptr ()) (Ptr ()) %dis cursor k p1 p2 p3 = Cursor (cursorKind k) (ptr p1) (ptr p2) (ptr p3) +%C unsigned sizeOfCXCursor() {return sizeof(CXCursor);} +% void * getCXCursorData(CXCursor * p, int i){return p->data[i];} +% enum CXCursorKind getCXCursorKind(CXCursor * p){return p->kind;} +% void setCXCursorData(CXCursor * p, int i, void * ptr){p->data[i] = ptr;} +% void setCXCursorKind(CXCursor * p, unsigned kind){p->kind = kind;} +foreign import ccall unsafe "FFI_stub_ffi.h sizeOfCXCursor" sizeOfCXCursor :: CUInt +foreign import ccall unsafe "FFI_stub_ffi.h getCXCursorData" getCXCursorData :: Ptr () -> CInt -> IO (Ptr ()) +foreign import ccall unsafe "FFI_stub_ffi.h getCXCursorKind" getCXCursorKind :: Ptr () -> IO CUInt +foreign import ccall unsafe "FFI_stub_ffi.h setCXCursorData" setCXCursorData :: Ptr () -> CInt -> Ptr () -> IO () +foreign import ccall unsafe "FFI_stub_ffi.h setCXCursorKind" setCXCursorKind :: Ptr () -> CUInt -> IO () + +instance Storable Cursor where + sizeOf _ = fromIntegral sizeOfCXCursor + alignment _ = 4 + peek p = do + let ptr = castPtr p + k <- (unmarshall_CursorKind . fromIntegral) <$> getCXCursorKind ptr + p1 <- getCXCursorData ptr 0 + p2 <- getCXCursorData ptr 1 + p3 <- getCXCursorData ptr 2 + return $ Cursor k p1 p2 p3 + poke p (Cursor k p1 p2 p3) = do + let ptr = castPtr p + setCXCursorKind ptr $ fromIntegral (marshall_CursorKind k) + setCXCursorData ptr 0 p1 + setCXCursorData ptr 1 p2 + setCXCursorData ptr 2 p3 + -- CXCursor clang_getNullCursor(void); %fun clang_getNullCursor :: IO Cursor %code CXCursor r = clang_getNullCursor(); @@ -1134,7 +1165,6 @@ -- }; %enum ChildVisitResult (Eq) Int [CXChildVisit_Break, CXChildVisit_Continue, CXChildVisit_Recurse] --- TODO: test me -- typedef enum CXChildVisitResult (*CXCursorVisitor)(CXCursor cursor, -- CXCursor parent, -- CXClientData client_data); @@ -1160,14 +1190,14 @@ -- unsigned clang_visitChildren(CXCursor parent, -- CXCursorVisitor visitor, -- CXClientData client_data); -visitChildren :: (Storable a) => Cursor -> ChildVisitor a -> Maybe a -> IO (Maybe a, Bool) +visitChildren :: (Storable a, Alloc a) => Cursor -> ChildVisitor a -> Maybe a -> IO (Maybe a, Bool) visitChildren (Cursor k p1 p2 p3) f d = do fp <- wrapChildVisitorRaw (wrapChildVisitor f) - pd <- maybe (return nullPtr) (\x -> malloc >>= \p -> poke p x >> return p) d + pd <- maybe (return nullPtr) allocSet 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) + else peek pd >>= \d -> dealloc pd >> return (Just d) freeHaskellFunPtr fp return (rData, retVal == 0) @@ -1589,8 +1619,8 @@ %code CXString *r = mkStrObj();*r = clang_getClangVersion(); %result (cxString (ptr r)) --- void clang_toggleCrashRecovery(unsigned isEnabled); -%fun clang_toggleCrashRecovery :: Bool -> IO () +-- -- void clang_toggleCrashRecovery(unsigned isEnabled); +-- %fun clang_toggleCrashRecovery :: Bool -> IO () -- typedef void (*CXInclusionVisitor)(CXFile included_file, -- CXSourceLocation* inclusion_stack, @@ -1607,12 +1637,12 @@ -- %call (ptr t) (inclusionVisitor (ptr f)) (ptr p) -- %code clang_getInclusions(t, f, p); -getInclusions :: (Storable a) => TranslationUnit -> InclusionVisitor a -> Maybe a -> IO () +getInclusions :: (Storable a, Alloc 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 + p <- maybe (return nullPtr) allocSet d prim_getInclusions_ t f (castPtr p) - when (p /= nullPtr) $ free p + when (p /= nullPtr) $ dealloc p freeHaskellFunPtr f %C void prim_getInclusions_(HsPtr t,HsPtr f,HsPtr p){ do { clang_getInclusions(t, f, p);} while(0);} 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 @@ -947,6 +947,11 @@ return((HsInt)(res1));} while(0); } + unsigned sizeOfCXCursor() {return sizeof(CXCursor);} + void * getCXCursorData(CXCursor * p, int i){return p->data[i];} + enum CXCursorKind getCXCursorKind(CXCursor * p){return p->kind;} + void setCXCursorData(CXCursor * p, int i, void * ptr){p->data[i] = ptr;} + void setCXCursorKind(CXCursor * p, unsigned kind){p->kind = kind;} void* prim_getNullCursor() { static struct {HsInt gc_res2;HsPtr gc_res3;HsPtr gc_res4;HsPtr gc_res5;} gc_result; do { CXCursor r = clang_getNullCursor(); @@ -2176,9 +2181,5 @@ do { CXString *r = mkStrObj();*r = clang_getClangVersion(); return((HsPtr)(r));} while(0); -} -void prim_toggleCrashRecovery(HsInt arg1) -{ do {clang_toggleCrashRecovery(arg1); - ;} while(0); } void prim_getInclusions_(HsPtr t,HsPtr f,HsPtr p){ do { clang_getInclusions(t, f, p);} while(0);} diff --git a/test/Test_ChildVisitor.hs b/test/Test_ChildVisitor.hs --- a/test/Test_ChildVisitor.hs +++ b/test/Test_ChildVisitor.hs @@ -1,17 +1,14 @@ import System(getArgs) -import Data.Maybe(maybe) -import Control.Monad((<=<)) import Control.Applicative((<$>)) import Clang.TranslationUnit(withCreateIndex, withParse, TranslationUnitFlags(..), getCursor) import Clang.Traversal(ChildVisitor, visitChildren, ChildVisitResult(..)) -import qualified Clang.FFI as FFI -import Foreign.Ptr(nullPtr) +import qualified Clang.Type as Type +import qualified Clang.Cursor as Cursor +import Clang.Alloc.Storable visitor :: ChildVisitor Int visitor c p d = do - tk <- FFI.getTypeKind <$> FFI.getCursorType c - str <- (FFI.getCString <=< FFI.getTypeKindSpelling) tk - putStrLn $ "Type:" ++ str + putStrLn $ "Type:" ++ show (Type.getTypeKindSpelling . Type.getKind . Cursor.getType $ c) return (d, ChildVisit_Continue) test tu = visitChildren (getCursor tu) visitor Nothing diff --git a/test/Test_InclusionVisitor.hs b/test/Test_InclusionVisitor.hs --- a/test/Test_InclusionVisitor.hs +++ b/test/Test_InclusionVisitor.hs @@ -4,11 +4,12 @@ import Clang.TranslationUnit(withCreateIndex, withParse, TranslationUnitFlags(..)) import qualified Clang.Source as Clang import Clang.Traversal -import Clang.File(getFileName) +import Clang.File(getName) +import Clang.Alloc.Storable printInclusions :: InclusionVisitor Int printInclusions f sls d = do - let name = getFileName f + let name = getName f putStrLn $ "Included:" ++ name return d