packages feed

LibClang 0.0.9 → 0.1.0

raw patch · 9 files changed

+81/−30 lines, 9 filesdep −ffi

Dependencies removed: ffi

Files

LibClang.cabal view
@@ -1,6 +1,6 @@ Name: LibClang Cabal-version: >= 1.6-Version: 0.0.9+Version: 0.1.0 Author: Chetan Taralekar <chetant@gmail.com> Maintainer: Chetan Taralekar <chetant@gmail.com> 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
+ src/Clang/Alloc.hs view
@@ -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 ()
+ src/Clang/Alloc/Storable.hs view
@@ -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
src/Clang/Cursor.hs view
@@ -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
src/Clang/Debug.hs view
@@ -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
src/Clang/FFI.gc view
@@ -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 <inttypes.h> %#include <stdlib.h> %#include <clang-c/Index.h>@@ -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);}
src/Clang/FFI_stub_ffi.c view
@@ -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);}
test/Test_ChildVisitor.hs view
@@ -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
test/Test_InclusionVisitor.hs view
@@ -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