LibClang 0.0.2 → 0.0.6
raw patch · 14 files changed
+1129/−112 lines, 14 files
Files
- LibClang.cabal +17/−8
- configure +233/−51
- src/Clang.hs +35/−0
- src/Clang/Completion.hs +50/−0
- src/Clang/CrossReference.hs +25/−0
- src/Clang/Cursor.hs +122/−0
- src/Clang/Debug.hs +13/−0
- src/Clang/Diagnostic.hs +65/−0
- src/Clang/FFI.gc +358/−45
- src/Clang/FFI_stub_ffi.c +42/−8
- src/Clang/Source.hs +43/−0
- src/Clang/Token.hs +22/−0
- src/Clang/TranslationUnit.hs +63/−0
- src/Clang/Type.hs +41/−0
LibClang.cabal view
@@ -1,6 +1,6 @@ Name: LibClang Cabal-version: >= 1.6-Version: 0.0.2+Version: 0.0.6 Author: Chetan Taralekar <chetant@gmail.com> Maintainer: Chetan Taralekar <chetant@gmail.com> Homepage: https://github.com/chetant/LibClang/issues@@ -9,13 +9,21 @@ Synopsis: Haskell bindings for libclang (a C++ parsing library) Description: LibClang package provides direct bindings to libclang.+ . This should be enough for parsing C/C++ code, walking the AST and querying nodes and completion queries.+ .+ * NOTE: When configuring, please ensure llvm-config is in path or provide the location of libclang and llvm includes if not in the default locations using + .+ @ --configure-option=-I... @+ .+ You can also use + .+ @--configure-option=--enable-llvm-shared=LLVMSHAREDLIB@+ .+ if you'd like to link to the shared library+ .+ Also use <https://github.com/chetant/LibClang/issues> to report bugs - NOTE .. When configuring, please ensure llvm-config is in path- .. or provide the location of libclang and llvm includes- .. if not in the default locations using --configure-option=-I... - .. You can also use --configure-option=--enable-llvm-shared=LLVMSHAREDLIB_PREFIX- .. if you'd like to link to the shared library Category: Language Build-type: Configure Extra-Source-Files: configure, LibClang.buildinfo.in@@ -24,9 +32,10 @@ location: git://github.com/chetant/LibClang.git Library- hs-source-dirs: src build-depends: base < 5, ffi, greencard build-tools: greencard+ extensions: TypeSynonymInstances, EmptyDataDecls+ hs-source-dirs: src c-sources: src/Clang/FFI_stub_ffi.c exposed-modules:- Clang, Clang.FFI+ Clang,Clang.FFI,Clang.Type,Clang.Cursor,Clang.CrossReference,Clang.Source,Clang.Diagnostic,Clang.TranslationUnit,Clang.Token,Clang.Debug,Clang.Completion
configure view
@@ -1405,6 +1405,94 @@ } # ac_fn_c_try_compile +# ac_fn_c_try_link LINENO+# -----------------------+# Try to link conftest.$ac_ext, and return whether this succeeded.+ac_fn_c_try_link ()+{+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+ rm -f conftest.$ac_objext conftest$ac_exeext+ if { { ac_try="$ac_link"+case "(($ac_try" in+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+ *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+ (eval "$ac_link") 2>conftest.err+ ac_status=$?+ if test -s conftest.err; then+ grep -v '^ *+' conftest.err >conftest.er1+ cat conftest.er1 >&5+ mv -f conftest.er1 conftest.err+ fi+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+ test $ac_status = 0; } && {+ test -z "$ac_c_werror_flag" ||+ test ! -s conftest.err+ } && test -s conftest$ac_exeext && {+ test "$cross_compiling" = yes ||+ $as_test_x conftest$ac_exeext+ }; then :+ ac_retval=0+else+ $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++ ac_retval=1+fi+ # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information+ # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would+ # interfere with the next link command; also delete a directory that is+ # left behind by Apple's compiler. We do this before executing the actions.+ rm -rf conftest.dSYM conftest_ipa8_conftest.oo+ eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}+ as_fn_set_status $ac_retval++} # ac_fn_c_try_link++# ac_fn_c_try_run LINENO+# ----------------------+# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes+# that executables *can* be run.+ac_fn_c_try_run ()+{+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+ if { { ac_try="$ac_link"+case "(($ac_try" in+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+ *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+ (eval "$ac_link") 2>&5+ ac_status=$?+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+ test $ac_status = 0; } && { ac_try='./conftest$ac_exeext'+ { { case "(($ac_try" in+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+ *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+ (eval "$ac_try") 2>&5+ ac_status=$?+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+ test $ac_status = 0; }; }; then :+ ac_retval=0+else+ $as_echo "$as_me: program exited with status $ac_status" >&5+ $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++ ac_retval=$ac_status+fi+ rm -rf conftest.dSYM conftest_ipa8_conftest.oo+ eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}+ as_fn_set_status $ac_retval++} # ac_fn_c_try_run+ # ac_fn_c_try_cpp LINENO # ---------------------- # Try to preprocess conftest.$ac_ext, and return whether this succeeded.@@ -1529,48 +1617,6 @@ } # ac_fn_c_check_header_mongrel -# ac_fn_c_try_run LINENO-# -----------------------# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes-# that executables *can* be run.-ac_fn_c_try_run ()-{- as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack- if { { ac_try="$ac_link"-case "(($ac_try" in- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;- *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""-$as_echo "$ac_try_echo"; } >&5- (eval "$ac_link") 2>&5- ac_status=$?- $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5- test $ac_status = 0; } && { ac_try='./conftest$ac_exeext'- { { case "(($ac_try" in- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;- *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""-$as_echo "$ac_try_echo"; } >&5- (eval "$ac_try") 2>&5- ac_status=$?- $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5- test $ac_status = 0; }; }; then :- ac_retval=0-else- $as_echo "$as_me: program exited with status $ac_status" >&5- $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5-- ac_retval=$ac_status-fi- rm -rf conftest.dSYM conftest_ipa8_conftest.oo- eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}- as_fn_set_status $ac_retval--} # ac_fn_c_try_run- # ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES # ------------------------------------------------------- # Tests whether HEADER exists and can be compiled using the include files in@@ -2029,15 +2075,7 @@ if test "$llvm_shared" != "" then- LDFLAGS="$LDFLAGS -l${llvm_shared}"-else- if test "$llvm_config_found" = yes- then- LDFLAGS="$LDFLAGS `llvm-config --libs`"- fi-fi--ac_ext=c+ ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'@@ -2828,6 +2866,96 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu +as_ac_Lib=`$as_echo "ac_cv_lib_${llvm_shared}''_LLVMContextCreate" | $as_tr_sh`+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for LLVMContextCreate in -l${llvm_shared}" >&5+$as_echo_n "checking for LLVMContextCreate in -l${llvm_shared}... " >&6; }+if eval "test \"\${$as_ac_Lib+set}\"" = set; then :+ $as_echo_n "(cached) " >&6+else+ ac_check_lib_save_LIBS=$LIBS+LIBS="-l${llvm_shared} $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h. */++/* Override any GCC internal prototype to avoid an error.+ Use char because int might match the return type of a GCC+ builtin and then its argument prototype would still apply. */+#ifdef __cplusplus+extern "C"+#endif+char LLVMContextCreate ();+int+main ()+{+return LLVMContextCreate ();+ ;+ return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+ eval "$as_ac_Lib=yes"+else+ eval "$as_ac_Lib=no"+fi+rm -f core conftest.err conftest.$ac_objext \+ conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+eval ac_res=\$$as_ac_Lib+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then :+ llvm_shared_lib_found=yes+else+ llvm_shared_lib_found=no+fi++ if test "$llvm_shared_lib_found" = no+ then+ as_fn_error $? "+ -------------------------------------------------+ llvm shared library ${llvm_shared} not found.+ if the library is present, ensure it is available+ on the lib search path (export LDFLAGS=...)+ -------------------------------------------------" "$LINENO" 5+ else+ LDFLAGS="$LDFLAGS -l${llvm_shared}"+ if test "$cross_compiling" = yes; then :+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}+as_fn_error $? "cannot run test program while cross compiling+See \`config.log' for more details" "$LINENO" 5 ; }+else+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h. */+int main(int argc, int argv[]){LLVMContextCreate();return 0;}+_ACEOF+if ac_fn_c_try_run "$LINENO"; then :+ llvm_shared_lib_present=yes+else+ llvm_shared_lib_present=no+fi+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \+ conftest.$ac_objext conftest.beam conftest.$ac_ext+fi++ if test "$llvm_shared_lib_present" = no+ then+ as_fn_error $? "+ -------------------------------------------------------+ specified llvm shared library ${llvm_shared} not found.+ if the library is present, ensure it is available+ on the lib search path (export LID_LIBRARY_PATH=...)+ -------------------------------------------------------" "$LINENO" 5+ fi+ fi+else+ if test "$llvm_config_found" = yes+ then+ LDFLAGS="$LDFLAGS `llvm-config --libs`"+ fi+fi+ ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'@@ -3251,6 +3379,60 @@ \"runhaskell Setup.hs build -vv\" to get the exact commands run -------------------------------------------------" "$LINENO" 5+fi++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for clang_getClangVersion in -lclang" >&5+$as_echo_n "checking for clang_getClangVersion in -lclang... " >&6; }+if test "${ac_cv_lib_clang_clang_getClangVersion+set}" = set; then :+ $as_echo_n "(cached) " >&6+else+ ac_check_lib_save_LIBS=$LIBS+LIBS="-lclang $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h. */++/* Override any GCC internal prototype to avoid an error.+ Use char because int might match the return type of a GCC+ builtin and then its argument prototype would still apply. */+#ifdef __cplusplus+extern "C"+#endif+char clang_getClangVersion ();+int+main ()+{+return clang_getClangVersion ();+ ;+ return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+ ac_cv_lib_clang_clang_getClangVersion=yes+else+ ac_cv_lib_clang_clang_getClangVersion=no+fi+rm -f core conftest.err conftest.$ac_objext \+ conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_clang_clang_getClangVersion" >&5+$as_echo "$ac_cv_lib_clang_clang_getClangVersion" >&6; }+if test "x$ac_cv_lib_clang_clang_getClangVersion" = x""yes; then :+ clang_lib_found=yes+else+ clang_lib_found=no+fi++if test "$clang_lib_found" = no+then+ as_fn_error $? "+-------------------------------------------------+clang library not found.+if the library is present, ensure it is available+on the lib search path (export LDFLAGS=...)+-------------------------------------------------" "$LINENO" 5+else+ LDFLAGS="$LDFLAGS -lclang" fi # Check for stdlib.h and inttypes
src/Clang.hs view
@@ -1,2 +1,37 @@+-- | This module basically imports all identifiers from the following modules+--+-- * "Clang.Type"+--+-- * "Clang.Cursor"+--+-- * "Clang.CrossReference"+--+-- * "Clang.Source"+--+-- * "Clang.Diagnostic"+--+-- * "Clang.TranslationUnit"+--+-- * "Clang.Token"+--+-- * "Clang.Debug"+--+-- * "Clang.Completion"+--+-- * "Clang.Traversal"+--+-- * "Clang.File"+ module Clang where +import Clang.Type+import Clang.Cursor+import Clang.CrossReference+import Clang.Source+import Clang.Diagnostic+import Clang.TranslationUnit+import Clang.Token+import Clang.Debug+import Clang.Completion+import Clang.Traversal+import Clang.File
+ src/Clang/Completion.hs view
@@ -0,0 +1,50 @@+module Clang.Completion+(+ FFI.CompletionString+,FFI.CompletionResult+,FFI.CompletionChunkKind+,FFI.CodeCompleteFlags(..)+,FFI.CodeCompleteResults+,getChunkKind+,getChunkText+,getChunkCompletionString+,getNumChunks+,getPriority+,getAvailability+,defaultCodeCompleteOptions+,codeCompleteAt+) where++import System.IO.Unsafe(unsafePerformIO)+import Data.Bits((.&.))+import Data.Maybe(catMaybes)+import Control.Monad(mzero)++import Clang.Type+import Clang.Source+import qualified Clang.FFI as FFI++getChunkKind cs i = unsafePerformIO (FFI.getCompletionChunkKind cs i)+getChunkText cs i = unsafePerformIO (FFI.getCompletionChunkText cs i)+getChunkCompletionString cs i = unsafePerformIO (FFI.getCompletionChunkCompletionString cs i)+getNumChunks = unsafePerformIO . FFI.getNumCompletionChunks+getPriority = unsafePerformIO . FFI.getCompletionPriority+getAvailability = unsafePerformIO . FFI.getCompletionAvailability++defaultCodeCompleteOptions = catMaybes [val1 defVal, val2 defVal]+ where defVal = unsafePerformIO FFI.defaultCodeCompleteOptions+ val1 v = if (v .&. 0x01) == 0x01 then return FFI.CodeComplete_IncludeMacros else mzero+ val2 v = if (v .&. 0x02) == 0x02 then return FFI.CodeComplete_IncludeCodePatterns else mzero++codeCompleteAt :: FFI.TranslationUnit+ -> FilePath -- ^ Filename of the source file+ -> Int -- ^ Line in the source file+ -> Int -- ^ Column on the line+ -> [FFI.UnsavedFile] -- ^ Unsaved files so far+ -> [FFI.CodeCompleteFlags]+ -> IO FFI.CodeCompleteResults+codeCompleteAt t fname l c ufs opts = FFI.codeCompleteAt t fname l c ufs (FFI.getCodeCompleteFlagsSum opts)+sortResults = FFI.sortCodeCompletionResults+getDiagnostics c = unsafePerformIO $ do+ numD <- FFI.codeCompleteGetNumDiagnostics c+ mapM (FFI.codeCompleteGetDiagnostic c) [0..(numD-1)]
+ src/Clang/CrossReference.hs view
@@ -0,0 +1,25 @@+module Clang.CrossReference+(+ getUSR+,constructUSR_ObjCClass+,constructUSR_ObjCCategory+,constructUSR_ObjCProtocol+,constructUSR_ObjCIvar+,constructUSR_ObjCMethod+,constructUSR_ObjCProperty+) where++import System.IO.Unsafe(unsafePerformIO)++import qualified Clang.FFI as FFI+import Clang.Type+import Clang.Cursor++-- constructUSR_ObjCCategory+getUSR = unsafePerformIO . FFI.getCursorUSR+constructUSR_ObjCClass = FFI.constructUSR_ObjCClass+constructUSR_ObjCCategory = FFI.constructUSR_ObjCCategory+constructUSR_ObjCProtocol = FFI.constructUSR_ObjCProtocol+constructUSR_ObjCIvar = FFI.constructUSR_ObjCIvar+constructUSR_ObjCMethod = FFI.constructUSR_ObjCMethod+constructUSR_ObjCProperty = FFI.constructUSR_ObjCProperty
+ src/Clang/Cursor.hs view
@@ -0,0 +1,122 @@+{-|+ The Cursor is an easy way to reference something in code and query its properties and relationships+ This is the primary way of traversing and querying code+-}+module Clang.Cursor+(+ FFI.CursorKind(..)+,FFI.LinkageKind(..)+,FFI.LanguageKind(..)+,FFI.Cursor+,FFI.CursorSet++,nullCursor+,getHash+,getKind+,getLinkage+,getAvailability+,getLanguage+,getSemanticParent+,getLexicalParent+,getOverriddenCursors+,getIncludedFile+,Clang.Cursor.getLocation+,getExtent+,getType+,Clang.Cursor.getResultType+,getDeclObjCTypeEncoding+,getSpelling+,getDisplayName+,getReferenced+,getDefinition+,getCanonicalCursor+,getTemplateKind+,getSpecializedTemplate++-- attribute function+,getIBOutletCollectionType++,isDefinition+,isDeclaration+,isReference+,isExpression+,isStatement+,isInvalid+,isTranslationUnit+,isPreprocessing+,isUnexposed+,Clang.Cursor.isVirtualBase+,isStaticCppMethod++-- CursorSet functions+,createSet+,setContains+,setInsert++,getCXXAccessSpecifier+,getOverloadedDecls++--CursorKind functions+,getCursorKindSpelling+) where++import System.IO.Unsafe(unsafePerformIO)++import Clang.Type+import Clang.Source+import qualified Clang.FFI as FFI++instance Eq FFI.Cursor where+ a == b = unsafePerformIO (FFI.equalCursors a b)++nullCursor = unsafePerformIO FFI.getNullCursor+getHash = unsafePerformIO . FFI.hashCursor+getKind = unsafePerformIO . FFI.getCursorKind+getLinkage = unsafePerformIO . FFI.getCursorLinkage+getAvailability = unsafePerformIO . FFI.getCursorAvailability+getLanguage = unsafePerformIO . FFI.getCursorLanguage+getSemanticParent = unsafePerformIO . FFI.getCursorSemanticParent+getLexicalParent = unsafePerformIO . FFI.getCursorLexicalParent+getOverriddenCursors :: FFI.Cursor -> [FFI.Cursor]+getOverriddenCursors = unsafePerformIO . FFI.getOverriddenCursors+getIncludedFile = unsafePerformIO . FFI.getIncludedFile+getLocation = unsafePerformIO . FFI.getCursorLocation+getExtent = unsafePerformIO . FFI.getCursorExtent+getType = unsafePerformIO . FFI.getCursorType+getResultType = unsafePerformIO . FFI.getCursorResultType+getDeclObjCTypeEncoding = unsafePerformIO . FFI.getDeclObjCTypeEncoding+getSpelling = unsafePerformIO . FFI.getCursorSpelling+getDisplayName = unsafePerformIO . FFI.getCursorDisplayName+getReferenced = unsafePerformIO . FFI.getCursorReferenced+getDefinition = unsafePerformIO . FFI.getCursorDefinition+getCanonicalCursor = unsafePerformIO . FFI.getCanonicalCursor+getTemplateKind = unsafePerformIO . FFI.getTemplateCursorKind+getSpecializedTemplate = unsafePerformIO . FFI.getSpecializedCursorTemplate++-- attribute function+getIBOutletCollectionType = unsafePerformIO . FFI.getIBOutletCollectionType++isDefinition = unsafePerformIO . FFI.isCursorDefinition+isDeclaration = unsafePerformIO . FFI.isDeclaration+isReference = unsafePerformIO . FFI.isReference+isExpression = unsafePerformIO . FFI.isExpression+isStatement = unsafePerformIO . FFI.isStatement+isInvalid = unsafePerformIO . FFI.isInvalid+isTranslationUnit = unsafePerformIO . FFI.isTranslationUnit+isPreprocessing = unsafePerformIO . FFI.isPreprocessing+isUnexposed = unsafePerformIO . FFI.isUnexposed+isVirtualBase = unsafePerformIO . FFI.isVirtualBase+isStaticCppMethod = unsafePerformIO . FFI.cXXMethod_isStatic++-- CursorSet functions+createSet = FFI.createCXCursorSet+setContains = FFI.cXCursorSet_contains+setInsert = FFI.cXCursorSet_insert++getCXXAccessSpecifier = unsafePerformIO . FFI.getCXXAccessSpecifier+getOverloadedDecls c = unsafePerformIO $ do+ numDecls <- FFI.getNumOverloadedDecls c+ mapM (FFI.getOverloadedDecl c) [0..(numDecls-1)]++--CursorKind functions+getCursorKindSpelling = unsafePerformIO . FFI.getCursorKindSpelling
+ src/Clang/Debug.hs view
@@ -0,0 +1,13 @@+module Clang.Debug+(+ enableStackTraces+,getVersion+,toggleCrashRecovery+) where++import System.IO.Unsafe(unsafePerformIO)+import qualified Clang.FFI as FFI++enableStackTraces = FFI.enableStackTraces+getVersion = unsafePerformIO (FFI.getCString =<< FFI.getClangVersion)+toggleCrashRecovery = FFI.toggleCrashRecovery
+ src/Clang/Diagnostic.hs view
@@ -0,0 +1,65 @@+module Clang.Diagnostic+(+ FFI.DiagnosticSeverity(..)+,FFI.DiagnosticDisplayOptions(..)+,FFI.Diagnostic++,getDiagnostics+,getDefaultDisplayOptions+,formatDiagnostic++,getSeverity+,getSpelling+,getOptions+,getCategory++,getRanges+,getFixIts++,getCategoryName+) where++import System.IO.Unsafe(unsafePerformIO)+import Data.Bits((.&.))+import Data.Maybe(catMaybes)+import Control.Monad(mzero)++import Clang.Type+import Clang.Source+import qualified Clang.FFI as FFI++getDiagnostics :: FFI.TranslationUnit -> [FFI.Diagnostic]+getDiagnostics t = unsafePerformIO $ do+ numDiags <- FFI.getNumDiagnostics t+ mapM (FFI.getDiagnostic t) [0..(numDiags-1)]++formatDiagnostic :: [FFI.DiagnosticDisplayOptions] -> FFI.Diagnostic -> IO String+formatDiagnostic [] diag = FFI.getCString =<< FFI.formatDiagnostic diag =<< FFI.defaultDiagnosticDisplayOptions+formatDiagnostic opts diag = FFI.getCString =<< FFI.formatDiagnostic diag (FFI.getDiagnosticDispOptSum opts)++getSeverity = unsafePerformIO . FFI.getDiagnosticSeverity+getSpelling = unsafePerformIO . FFI.getDiagnosticSpelling+getOptions = unsafePerformIO . FFI.getDiagnosticOption++getDefaultDisplayOptions = catMaybes [val1 defVal, val2 defVal, val3 defVal, val4 defVal, val5 defVal, val6 defVal]+ where defVal = unsafePerformIO FFI.defaultDiagnosticDisplayOptions+ val1 v = if (v .&. 0x1) == 0x1 then return FFI.Diagnostic_DisplaySourceLocation else mzero+ val2 v = if (v .&. 0x2) == 0x2 then return FFI.Diagnostic_DisplayColumn else mzero+ val3 v = if (v .&. 0x4) == 0x4 then return FFI.Diagnostic_DisplaySourceRanges else mzero+ val4 v = if (v .&. 0x8) == 0x8 then return FFI.Diagnostic_DisplayOption else mzero+ val5 v = if (v .&. 0x10) == 0x10 then return FFI.Diagnostic_DisplayCategoryId else mzero+ val6 v = if (v .&. 0x20) == 0x20 then return FFI.Diagnostic_DisplayCategoryName else mzero++getCategory = unsafePerformIO . FFI.getDiagnosticCategory++getRanges :: FFI.Diagnostic -> [FFI.SourceRange]+getRanges d = unsafePerformIO $ do+ numRanges <- FFI.getDiagnosticNumRanges d+ mapM (FFI.getDiagnosticRange d) [0..(numRanges-1)]+getFixIts :: FFI.Diagnostic -> [(FFI.SourceRange, FFI.CXString)]+getFixIts d = unsafePerformIO $ do+ numFixes <- FFI.getDiagnosticNumFixIts d+ mapM (FFI.getDiagnosticFixIt d) [0..(numFixes-1)]++-- Category functions+getCategoryName = unsafePerformIO . FFI.getDiagnosticCategoryName
src/Clang/FFI.gc view
@@ -1,5 +1,169 @@-{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}-module Clang.FFI where+{-# LANGUAGE ForeignFunctionInterface #-}+module Clang.FFI+(+ Index+,createIndex+,TranslationUnit+,ClientData+,UnsavedFile+,AvailabilityKind(..)+,CXString+,getCString+,File+,getFileName+,getFileTime+,getFile+,SourceLocation+,getNullLocation+,equalLocations+,getLocation+,getLocationForOffset+,SourceRange+,getNullRange+,getRange+,getInstantiationLocation+,getSpellingLocation+,getRangeStart+,getRangeEnd+,DiagnosticSeverity(..)+,Diagnostic+,getNumDiagnostics+,getDiagnostic+,DiagnosticDisplayOptions(..)+,getDiagnosticDispOptSum+,formatDiagnostic+,defaultDiagnosticDisplayOptions+,getDiagnosticSeverity+,getDiagnosticLocation+,getDiagnosticSpelling+,getDiagnosticOption+,getDiagnosticCategory+,getDiagnosticCategoryName+,getDiagnosticNumRanges+,getDiagnosticRange+,getDiagnosticNumFixIts+,getDiagnosticFixIt+,getTranslationUnitSpelling+,createTranslationUnitFromSourceFile+,createTranslationUnit+,TranslationUnitFlags(..)+,getTranslationUnitFlagsSum+,defaultEditingTranslationUnitOptions+,parseTranslationUnit+,unsavedFileSize+,setCXUnsavedFile+,SaveTranslationUnitFlags(..)+,getSaveTranslationUnitFlagsSum+,defaultSaveOptions+,saveTranslationUnit+,ReparseFlags(..)+,getReparseFlagsSum+,defaultReparseOptions+,reparseTranslationUnit+,CursorKind(..)+,Cursor+,getNullCursor+,getTranslationUnitCursor+,equalCursors+,hashCursor+,getCursorKind+,isDeclaration+,isReference+,isExpression+,isStatement+,isInvalid+,isTranslationUnit+,isPreprocessing+,isUnexposed+,LinkageKind(..)+,getCursorLinkage+,getCursorAvailability+,LanguageKind(..)+,getCursorLanguage+,CursorSet+,createCXCursorSet+,cXCursorSet_contains+,cXCursorSet_insert+,getCursorSemanticParent+,getCursorLexicalParent+,getOverriddenCursors+,getIncludedFile+,getCursor+,getCursorLocation+,getCursorExtent+,TypeKind(..)+,Type+,getCursorType+,equalTypes+,getCanonicalType+,isConstQualifiedType+,isVolatileQualifiedType+,isRestrictQualifiedType+,getPointeeType+,getTypeDeclaration+,getDeclObjCTypeEncoding+,getTypeKindSpelling+,getResultType+,getCursorResultType+,isPODType+,isVirtualBase+,CXXAccessSpecifier(..)+,getCXXAccessSpecifier+,getNumOverloadedDecls+,getOverloadedDecl+,getIBOutletCollectionType+,ChildVisitResult(..)+,ChildVisitor+,visitChildren+,getCursorUSR+,constructUSR_ObjCClass+,constructUSR_ObjCCategory+,constructUSR_ObjCProtocol+,constructUSR_ObjCIvar+,constructUSR_ObjCMethod+,constructUSR_ObjCProperty+,getCursorSpelling+,getCursorDisplayName+,getCursorReferenced+,getCursorDefinition+,isCursorDefinition+,getCanonicalCursor+,cXXMethod_isStatic+,getTemplateCursorKind+,getSpecializedCursorTemplate+,TokenKind(..)+,Token+,getTokenKind+,getTokenSpelling+,getTokenLocation+,getTokenExtent+,tokenize+,annotateTokens+,getCursorKindSpelling+,enableStackTraces+,CompletionString+,CompletionResult+,CompletionChunkKind(..)+,getCompletionChunkKind+,getCompletionChunkText+,getCompletionChunkCompletionString+,getNumCompletionChunks+,getCompletionPriority+,getCompletionAvailability+,CodeCompleteFlags(..)+,getCodeCompleteFlagsSum+,defaultCodeCompleteOptions+,CodeCompleteResults+,codeCompleteAt+,sortCodeCompletionResults+,codeCompleteGetNumDiagnostics+,codeCompleteGetDiagnostic+,getClangVersion+,toggleCrashRecovery+,InclusionVisitor+,getInclusions+,wrapInclusionVisitor+) where import Data.Word import Control.Applicative((<$>))@@ -7,6 +171,7 @@ import Foreign.C import Foreign.ForeignPtr import Foreign.Ptr+import System.IO.Unsafe(unsafePerformIO) %#include <inttypes.h> %#include <stdlib.h>@@ -54,7 +219,7 @@ -- const char *Contents; -- unsigned long Length; -- };-data UnsavedFile = UnsavedFile { usf_filename :: String, usf_contents :: String }+data UnsavedFile = UnsavedFile { unsavedFilename :: FilePath, unsavedContents :: String } %enum AvailabilityKind Int [CXAvailability_Available, CXAvailability_Deprecated, CXAvailability_NotAvailable] -- enum CXAvailabilityKind {@@ -68,19 +233,22 @@ -- unsigned private_flags; -- } CXString; data StringObj-type CXString = ForeignPtr StringObj+newtype CXString = CXString (ForeignPtr StringObj) %C CXString * mkStrObj() { return malloc(sizeof(CXString)); } % void freeStrObj(CXString * str) { clang_disposeString(*str);free(str); } foreign import ccall unsafe "FFI_stub_ffi.h mkStrObj" mkStrObj :: IO (Ptr StringObj) foreign import ccall unsafe "FFI_stub_ffi.h &freeStrObj" freeStrObj :: FunPtr (Ptr StringObj -> IO ()) -unmarshall_cxString :: Ptr StringObj -> IO (ForeignPtr StringObj)-unmarshall_cxString = newForeignPtr freeStrObj+unmarshall_cxString :: Ptr StringObj -> IO CXString+unmarshall_cxString p = CXString <$> (newForeignPtr freeStrObj p) +marshall_cxString :: CXString -> IO (ForeignPtr StringObj)+marshall_cxString (CXString a) = return a+ -- const char *clang_getCString(CXString string); %fun clang_getCString :: CXString -> IO String-%call (fptr (ptr d))+%call (cxString (fptr (ptr d))) %code r = clang_getCString(*(CXString*)d); %result (string r) @@ -95,7 +263,7 @@ %result (cxString (ptr r)) -- time_t clang_getFileTime(CXFile SFile);-%fun clang_getFileTime :: File -> IO Word64+%fun clang_getFileTime :: File -> IO Word32 -- CXFile clang_getFile(CXTranslationUnit tu, const char *file_name); %fun clang_getFile :: TranslationUnit -> String -> IO File@@ -110,6 +278,21 @@ data SourceLocation = SourceLocation (Ptr ()) (Ptr ()) Int %dis sourceLocation p1 p2 d = SourceLocation (ptr p1) (ptr p2) (int d) +%C void * srcLocListGetPtr(CXSourceLocation * s, int i, int pi) {return s[i].ptr_data[pi];}+% unsigned srcLocListGetData(CXSourceLocation * s, int i) {return s[i].int_data;}++foreign import ccall safe "FFI_stub_ffi.h srcLocListGetPtr" srcLocListGetPtr_ :: Ptr () -> CInt -> CInt -> IO (Ptr ())+foreign import ccall safe "FFI_stub_ffi.h srcLocListGetData" srcLocListGetData_ :: Ptr () -> CInt -> IO CInt++unmarshall_SrcLocList :: Ptr () -> CUInt -> IO [SourceLocation]+unmarshall_SrcLocList sls 0 = return []+unmarshall_SrcLocList sls nsl = mapM getSrcList_ [0..(nsl-1)]+ where getSrcList_ i = do+ p1 <- srcLocListGetPtr_ sls (fromIntegral i) 0+ p2 <- srcLocListGetPtr_ sls (fromIntegral i) 1+ i <- fromIntegral <$> srcLocListGetData_ sls (fromIntegral i)+ return $ SourceLocation p1 p2 i+ -- typedef struct { -- void *ptr_data[2]; -- unsigned begin_int_data;@@ -136,7 +319,7 @@ -- unsigned column); %fun clang_getLocation :: TranslationUnit -> File -> Int -> Int -> IO SourceLocation %call (fptr (ptr t)) (file f) (int i) (int j)-%code CXSourceLocation r = clang_getLocation(*(CXTranslationUnit*)t, f, i, j);+%code CXSourceLocation r = clang_getLocation((CXTranslationUnit)t, f, i, j); %result (sourceLocation {r.ptr_data[0]} {r.ptr_data[1]} {r.int_data}) -- CXSourceLocation clang_getLocationForOffset(CXTranslationUnit tu,@@ -144,7 +327,7 @@ -- unsigned offset); %fun clang_getLocationForOffset :: TranslationUnit -> File -> Int -> IO SourceLocation %call (fptr (ptr t)) (file f) (int i)-%code CXSourceLocation r = clang_getLocationForOffset(*(CXTranslationUnit*)t, f, i);+%code CXSourceLocation r = clang_getLocationForOffset((CXTranslationUnit)t, f, i); %result (sourceLocation {r.ptr_data[0]} {r.ptr_data[1]} {r.int_data}) -- CXSourceRange clang_getNullRange();@@ -220,13 +403,13 @@ -- unsigned clang_getNumDiagnostics(CXTranslationUnit Unit); %fun clang_getNumDiagnostics :: TranslationUnit -> IO Int %call (fptr (ptr t))-%code unsigned r = clang_getNumDiagnostics(*(CXTranslationUnit*)t);+%code unsigned r = clang_getNumDiagnostics((CXTranslationUnit)t); %result (int r) -- CXDiagnostic clang_getDiagnostic(CXTranslationUnit Unit, unsigned Index); %fun clang_getDiagnostic :: TranslationUnit -> Int -> IO Diagnostic %call (fptr (ptr t)) (int i)-%code CXDiagnostic r = clang_getDiagnostic(*(CXTranslationUnit*)t, i);+%code CXDiagnostic r = clang_getDiagnostic((CXTranslationUnit)t, i); %result (diag (ptr r)) -- enum CXDiagnosticDisplayOptions {@@ -241,7 +424,15 @@ -- }; %enum DiagnosticDisplayOptions Int [CXDiagnostic_DisplaySourceLocation,CXDiagnostic_DisplayColumn,CXDiagnostic_DisplaySourceRanges, CXDiagnostic_DisplayOption, CXDiagnostic_DisplayCategoryId,CXDiagnostic_DisplayCategoryName] --- TODO: make options composable via the enum+getDiagnosticDispOptSum :: [DiagnosticDisplayOptions] -> Int+getDiagnosticDispOptSum = sum . (map toVal_)+ where toVal_ Diagnostic_DisplaySourceLocation = 0x1+ toVal_ Diagnostic_DisplayColumn = 0x2+ toVal_ Diagnostic_DisplaySourceRanges = 0x4+ toVal_ Diagnostic_DisplayOption = 0x8+ toVal_ Diagnostic_DisplayCategoryId = 0x10+ toVal_ Diagnostic_DisplayCategoryName = 0x20+ -- CXString clang_formatDiagnostic(CXDiagnostic Diagnostic, unsigned Options); %fun clang_formatDiagnostic :: Diagnostic -> Int -> IO CXString %call (fptr (ptr d)) (int i)@@ -288,7 +479,7 @@ -- CXSourceRange clang_getDiagnosticRange(CXDiagnostic Diagnostic, -- unsigned Range);-%fun clang_getDiagnosticRange :: Diagnostic -> Int -> SourceRange+%fun clang_getDiagnosticRange :: Diagnostic -> Int -> IO SourceRange %call (fptr (ptr d)) (int i) %code CXSourceRange r = clang_getDiagnosticRange(d, i); %result (sourceRange {r.ptr_data[0]} {r.ptr_data[1]} {r.begin_int_data} {r.end_int_data})@@ -341,11 +532,21 @@ -- CXTranslationUnit_CXXPrecompiledPreamble = 0x10, -- CXTranslationUnit_CXXChainedPCH = 0x20 -- };-%enum TranslationUnit_Flags Int [CXTranslationUnit_None, CXTranslationUnit_DetailedPreprocessingRecord, CXTranslationUnit_Incomplete, CXTranslationUnit_PrecompiledPreamble, CXTranslationUnit_CacheCompletionResults, CXTranslationUnit_CXXPrecompiledPreamble, CXTranslationUnit_CXXChainedPCH]+%enum TranslationUnitFlags Int [CXTranslationUnit_None, CXTranslationUnit_DetailedPreprocessingRecord, CXTranslationUnit_Incomplete, CXTranslationUnit_PrecompiledPreamble, CXTranslationUnit_CacheCompletionResults, CXTranslationUnit_CXXPrecompiledPreamble, CXTranslationUnit_CXXChainedPCH] +getTranslationUnitFlagsSum :: [TranslationUnitFlags] -> Int+getTranslationUnitFlagsSum = sum . (map toVal_)+ where toVal_ TranslationUnit_None = 0x0+ toVal_ TranslationUnit_DetailedPreprocessingRecord = 0x01+ toVal_ TranslationUnit_Incomplete = 0x02+ toVal_ TranslationUnit_PrecompiledPreamble = 0x04+ toVal_ TranslationUnit_CacheCompletionResults = 0x08+ toVal_ TranslationUnit_CXXPrecompiledPreamble = 0x10+ toVal_ TranslationUnit_CXXChainedPCH = 0x20+ -- unsigned clang_defaultEditingTranslationUnitOptions(void); %fun clang_defaultEditingTranslationUnitOptions :: IO Int- + -- CXTranslationUnit clang_parseTranslationUnit(CXIndex CIdx, -- const char *source_filename, -- const char * const *command_line_args,@@ -353,8 +554,8 @@ -- struct CXUnsavedFile *unsaved_files, -- unsigned num_unsaved_files, -- unsigned options);-%fun clang_parseTranslationUnit :: Index -> Maybe String -> [String] -> [UnsavedFile] -> TranslationUnit_Flags -> IO (Maybe TranslationUnit)-%call (fptr (ptr i)) (maybeT {nullPtr} (string s)) (listLenString ((fptr (ptr ss)), (int ns))) (listLenUnsavedFile ((fptr (ptr ufs)), (int nufs))) (translationUnit_Flags i2)+%fun clang_parseTranslationUnit :: Index -> Maybe String -> [String] -> [UnsavedFile] -> Int -> IO (Maybe TranslationUnit)+%call (fptr (ptr i)) (maybeT {nullPtr} (string s)) (listLenString ((fptr (ptr ss)), (int ns))) (listLenUnsavedFile ((fptr (ptr ufs)), (int nufs))) (int i2) %code r = clang_parseTranslationUnit(i,s,ss,ns,ufs,nufs,i2); %result (maybeT {nullPtr} (translationUnit (ptr r))) @@ -386,9 +587,9 @@ ufsDataSize = fromIntegral unsavedFileSize arr_ <- mallocBytes (numUFs * ufsDataSize) :: IO (Ptr ()) let setUF (i, uf) = do- fname <- newCString $ usf_filename uf- contents <- newCString $ usf_contents uf- let len = (fromIntegral . length) (usf_contents uf) :: CULong+ fname <- newCString $ unsavedFilename uf+ contents <- newCString $ unsavedContents uf+ let len = (fromIntegral . length) (unsavedContents uf) :: CULong setCXUnsavedFile fname contents len arr_ (fromIntegral i) mapM_ setUF (zip [0..(numUFs-1)] ufs) arr <- newForeignPtr finalizerFree arr_@@ -399,6 +600,10 @@ -- }; %enum SaveTranslationUnitFlags Int [CXSaveTranslationUnit_None] +getSaveTranslationUnitFlagsSum :: [SaveTranslationUnitFlags] -> Int+getSaveTranslationUnitFlagsSum = sum . (map toVal_)+ where toVal_ SaveTranslationUnit_None = 0+ -- unsigned clang_defaultSaveOptions(CXTranslationUnit TU); %fun clang_defaultSaveOptions :: TranslationUnit -> IO Int %call (fptr (ptr t))@@ -417,7 +622,11 @@ -- CXReparse_None = 0x0 -- }; %enum ReparseFlags Int [CXReparse_None]- ++getReparseFlagsSum :: [ReparseFlags] -> Int+getReparseFlagsSum = sum . (map toVal_)+ where toVal_ Reparse_None = 0+ -- unsigned clang_defaultReparseOptions(CXTranslationUnit TU); %fun clang_defaultReparseOptions :: TranslationUnit -> IO Int %call (fptr (ptr t))@@ -428,10 +637,10 @@ -- unsigned num_unsaved_files, -- struct CXUnsavedFile *unsaved_files, -- unsigned options);-%fun clang_reparseTranslationUnit :: TranslationUnit -> [UnsavedFile] -> Int -> IO Int+%fun clang_reparseTranslationUnit :: TranslationUnit -> [UnsavedFile] -> Int -> IO Bool %call (fptr (ptr t)) (listLenUnsavedFile ((fptr (ptr ufs)), (int nufs))) (int i) %code r = clang_reparseTranslationUnit(t, nufs, ufs, i);-%result (int r)+%result (bool r) -- enum CXCursorKind { -- CXCursor_UnexposedDecl = 1,@@ -880,14 +1089,14 @@ -- CX_CXXProtected, -- CX_CXXPrivate -- };-%enum CppAccessSpecifier Int [CX_CXXInvalidAccessSpecifier, CX_CXXPublic, CX_CXXProtected, CX_CXXPrivate]+%enum CXXAccessSpecifier Int [CX_CXXInvalidAccessSpecifier, CX_CXXPublic, CX_CXXProtected, CX_CXXPrivate] -- enum CX_CXXAccessSpecifier clang_getCXXAccessSpecifier(CXCursor);-%fun clang_getCXXAccessSpecifier :: Cursor -> IO CppAccessSpecifier+%fun clang_getCXXAccessSpecifier :: Cursor -> IO CXXAccessSpecifier %call (cursor k p1 p2 p3) %code CXCursor a = {k, {p1, p2, p3}}; % r = clang_getCXXAccessSpecifier(a);-%result (cppAccessSpecifier r)+%result (cXXAccessSpecifier r) -- unsigned clang_getNumOverloadedDecls(CXCursor cursor); %fun clang_getNumOverloadedDecls :: Cursor -> IO Int@@ -903,7 +1112,7 @@ %code CXCursor a = {k, {p1, p2, p3}}; % CXCursor r = clang_getOverloadedDecl(a, i); %result (cursor {r.kind} {r.data[0]} {r.data[1]} {r.data[2]})- + -- CXType clang_getIBOutletCollectionType(CXCursor); %fun clang_getIBOutletCollectionType :: Cursor -> IO Type %call (cursor k p1 p2 p3)@@ -918,13 +1127,58 @@ -- }; %enum ChildVisitResult Int [CXChildVisit_Break, CXChildVisit_Continue, CXChildVisit_Recurse] --- TODO: finish me+-- TODO: test me -- typedef enum CXChildVisitResult (*CXCursorVisitor)(CXCursor cursor, -- CXCursor parent, -- 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+foreign import ccall "wrapper" wrapChildVisitorRaw :: ChildVisitorRaw -> IO (FunPtr ChildVisitorRaw)+wrapChildVisitor :: ChildVisitor -> 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+ -- 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+ fp <- wrapChildVisitorRaw (wrapChildVisitor f)+ retVal <- fromIntegral <$> prim_visitChildren_ (marshall_CursorKind k) p1 p2 p3 pd fp+ freeHaskellFunPtr fp+ return retVal++%C typedef enum CXChildVisitResult (*HSCursorVisitor)+% (HsInt ck,HsPtr cp1, HsPtr cp2,HsPtr cp3,+% HsInt pk,HsPtr pp1, HsPtr pp2,HsPtr pp3, CXClientData data);+% typedef struct {+% HSCursorVisitor visitor;+% CXClientData data;+% } HSChildVisitorData;+%+% enum CXChildVisitResult primChildVisitor(CXCursor c, CXCursor p, CXClientData d)+% {+% HSChildVisitorData *hsdata = (HSChildVisitorData *)d;+% return hsdata->visitor(c.kind,c.data[0],c.data[1],c.data[2], +% p.kind,p.data[0],p.data[1],p.data[2], hsdata->data);+% }+%+% unsigned prim_visitChildren_(HsInt ck,HsPtr p1,HsPtr p2,HsPtr p3,HsPtr pd,HsPtr fp)+% {+% CXCursor p = {ck, {p1,p2,p3}};+% HSChildVisitorData hsdata = {(HSCursorVisitor)fp,pd};+% return clang_visitChildren(p, primChildVisitor, (CXClientData)&hsdata);+% }++foreign import ccall safe "FFI_stub_ffi.h prim_visitChildren_" prim_visitChildren_ :: Int -> Ptr () -> Ptr () -> Ptr () -> Ptr () -> FunPtr ChildVisitorRaw -> IO CUInt+ -- #ifdef __has_feature -- # if __has_feature(blocks) -- typedef enum CXChildVisitResult @@ -966,7 +1220,7 @@ -- CXString clang_constructUSR_ObjCIvar(const char *name, -- CXString classUSR); %fun clang_constructUSR_ObjCIvar :: String -> CXString -> IO CXString-%call (string s) (fptr (ptr x))+%call (string s) (cxString (fptr (ptr x))) %code CXString *r = mkStrObj();*r = clang_constructUSR_ObjCIvar(s, *(CXString *)x); %result (cxString (ptr r)) @@ -974,14 +1228,14 @@ -- unsigned isInstanceMethod, -- CXString classUSR); %fun clang_constructUSR_ObjCMethod :: String -> Bool -> CXString -> IO CXString-%call (string s) (bool b) (fptr (ptr x))+%call (string s) (bool b) (cxString (fptr (ptr x))) %code CXString *r = mkStrObj();*r = clang_constructUSR_ObjCMethod(s, b, *(CXString *)x); %result (cxString (ptr r)) -- CXString clang_constructUSR_ObjCProperty(const char *property, -- CXString classUSR); %fun clang_constructUSR_ObjCProperty :: String -> CXString -> IO CXString-%call (string s) (fptr (ptr x))+%call (string s) (cxString (fptr (ptr x))) %code CXString *r = mkStrObj();*r = clang_constructUSR_ObjCProperty(s, *(CXString *)x); %result (cxString (ptr r)) @@ -1028,7 +1282,7 @@ %result (cursor {r.kind} {r.data[0]} {r.data[1]} {r.data[2]}) -- unsigned clang_CXXMethod_isStatic(CXCursor C);-%fun clang_CppMethod_isStatic :: Cursor -> IO Bool+%fun clang_CXXMethod_isStatic :: Cursor -> IO Bool %call (cursor k p1 p2 p3) %code CXCursor a = {k, {p1, p2, p3}}; % r = clang_CXXMethod_isStatic(a);@@ -1039,7 +1293,7 @@ %call (cursor k p1 p2 p3) %code CXCursor a = {k, {p1, p2, p3}}; % r = clang_getTemplateCursorKind(a);-%result (cursorKind r) +%result (cursorKind r) -- CXCursor clang_getSpecializedCursorTemplate(CXCursor C); %fun clang_getSpecializedCursorTemplate :: Cursor -> IO Cursor@@ -1098,14 +1352,21 @@ %C unsigned tokenListGetInt(CXToken *tlist, int i, int pi) {return tlist[i].int_data[pi];} % void * tokenListGetPtr(CXToken *tlist, int i) {return tlist[i].ptr_data;}+% void * makeTokens(int n) { return malloc(n * sizeof(CXToken)); }+% void freeTokens(void * tlist) { free(tlist); }+% void setTokenList(CXToken *tlist,int i,int w,int x,int y,int z,void *p) {CXToken a = {{w, x, y, z}, p};tlist[i]=a;} -foreign import ccall unsafe "FFI_stub_ffi.h tokenListGetInt" tokenListGetInt_ :: Ptr () -> CInt -> CInt -> IO Int+foreign import ccall unsafe "FFI_stub_ffi.h tokenListGetInt" tokenListGetInt_ :: Ptr () -> CInt -> CInt -> IO CInt foreign import ccall unsafe "FFI_stub_ffi.h tokenListGetPtr" tokenListGetPtr_ :: Ptr () -> CInt -> IO (Ptr ())+foreign import ccall unsafe "FFI_stub_ffi.h makeTokens" makeTokens_ :: CInt -> IO (Ptr ())+foreign import ccall unsafe "FFI_stub_ffi.h &freeTokens" freeTokens_ :: FunPtr (Ptr () -> IO ())+foreign import ccall unsafe "FFI_stub_ffi.h setTokenList" setTokenList_ :: + Ptr () -> CInt -> CInt -> CInt -> CInt -> CInt -> Ptr () -> IO () -- void clang_disposeTokens(CXTranslationUnit TU, CXToken *Tokens, unsigned NumTokens); foreign import ccall unsafe "FFI_stub_ffi.h clang_disposeTokens" clang_disposeTokens :: Ptr TranslationUnitObj -> Ptr () -> CUInt -> IO () -unmarshall_tokenList :: Ptr TranslationUnitObj -> Int -> Ptr () -> IO TokenList+unmarshall_tokenList :: Ptr TranslationUnitObj -> Int -> Ptr () -> IO TokenList unmarshall_tokenList t numO os = do tokens <- mapM getToken_ [0..nO] clang_disposeTokens t os (fromIntegral numO)@@ -1119,8 +1380,15 @@ p <- tokenListGetPtr_ os i return $ Token i1 i2 i3 i4 p --- marshall_tokenList :: TokenList -> IO (Int, Ptr ())--- marshall_tokenList (TokenList p ts)= return (length ts, p)+marshall_tokenList :: TokenList -> IO (Int, ForeignPtr ())+marshall_tokenList ts = do+ let numTs = length ts+ ci = fromIntegral+ setToken tptr ((Token w x y z p), i) = setTokenList_ tptr (ci i) (ci w) (ci x) (ci y) (ci z) p+ fillTokens p = mapM_ (setToken p) $ zip ts [0..(numTs-1)]+ tlist <- newForeignPtr freeTokens_ =<< makeTokens_ (ci numTs)+ withForeignPtr tlist fillTokens+ return (numTs, tlist) -- void clang_tokenize(CXTranslationUnit TU, CXSourceRange Range, -- CXToken **Tokens, unsigned *NumTokens);@@ -1131,13 +1399,28 @@ % clang_tokenize(t, a, &tokens, &numTokens); %result (tokenList t (int numTokens) (ptr tokens)) +unmarshall_cursorListExt :: Int -> Ptr () -> IO CursorList+unmarshall_cursorListExt numO os = do+ cursors <- mapM getCursor_ [0..nO]+ clang_disposeOverriddenCursors os+ return cursors+ where nO = fromIntegral (numO-1)+ getCursor_ i = do+ kind <- unmarshall_CursorKind <$> (cursorListGetKind_ os i)+ p1 <- cursorListGetPtr_ os i 0+ p2 <- cursorListGetPtr_ os i 1+ p3 <- cursorListGetPtr_ os i 2+ return $ Cursor kind p1 p2 p3++-- TODO: test me -- void clang_annotateTokens(CXTranslationUnit TU, -- CXToken *Tokens, unsigned NumTokens, -- CXCursor *Cursors);--- TODO: implement me--- %fun clang_annotateTokens :: TranslationUnit -> TokenList -> IO CursorList--- %call (fptr (ptr t)) (tokenList((int nts), (ptr ts)))--- %code clang_annotateTokens(t, ts, nts, +%fun clang_annotateTokens :: TranslationUnit -> TokenList -> IO CursorList+%call (fptr (ptr t)) (tokenList ((int nts), (fptr (ptr ts))))+%code CXCursor * cs = (CXCursor *)malloc(sizeof(CXCursor)*nts);+% clang_annotateTokens(t, ts, nts, cs);+%result (cursorListExt nts (ptr cs)) -- CXString clang_getCursorKindSpelling(enum CXCursorKind Kind); %fun clang_getCursorKindSpelling :: CursorKind -> IO CXString@@ -1157,7 +1440,7 @@ -- void clang_enableStackTraces(void); foreign import ccall unsafe "clang-c/Index.h clang_enableStackTraces" enableStackTraces :: IO () --- TODO: implement me+-- TODO: implement me after figuring out what this function really does -- void clang_executeOnThread(void (*fn)(void*), void *user_data, -- unsigned stack_size); @@ -1233,8 +1516,13 @@ -- }; %enum CodeCompleteFlags Int [CXCodeComplete_IncludeMacros, CXCodeComplete_IncludeCodePatterns] +getCodeCompleteFlagsSum :: [CodeCompleteFlags] -> Int+getCodeCompleteFlagsSum = sum . (map toVal_)+ where toVal_ CodeComplete_IncludeMacros = 0x01+ toVal_ CodeComplete_IncludeCodePatterns = 0x02+ -- unsigned clang_defaultCodeCompleteOptions(void);-foreign import ccall unsafe "clang-c/Index.h clang_defaultCodeCompleteOptions" defaultCodeCompleteOptions :: IO ()+foreign import ccall unsafe "clang-c/Index.h clang_defaultCodeCompleteOptions" defaultCodeCompleteOptions :: IO CInt -- typedef struct { -- CXCompletionResult *Results;@@ -1288,7 +1576,6 @@ -- void clang_toggleCrashRecovery(unsigned isEnabled); %fun clang_toggleCrashRecovery :: Bool -> IO () --- TODO: implement me -- typedef void (*CXInclusionVisitor)(CXFile included_file, -- CXSourceLocation* inclusion_stack, -- unsigned include_len,@@ -1296,3 +1583,29 @@ -- void clang_getInclusions(CXTranslationUnit tu, -- CXInclusionVisitor visitor, -- CXClientData client_data);++type InclusionVisitorRaw = File -> Ptr () -> CUInt -> Ptr () -> IO ()+type InclusionVisitor = File -> [SourceLocation] -> Ptr () -> IO ()++-- %fun clang_getInclusions :: TranslationUnit -> InclusionVisitor -> Ptr () -> IO ()+-- %call (fptr (ptr t)) (inclusionVisitor (ptr f)) (ptr p)+-- %code clang_getInclusions(t, f, p);++getInclusions :: TranslationUnit -> InclusionVisitor -> Ptr () -> IO ()+getInclusions tu iv p =+ (marshall_fptr tu) >>= \ (t) ->+ (marshall_inclusionVisitor iv) >>= \ (f) ->+ prim_getInclusions_ t f 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 f = \file pSrcLoc nSrcLoc pData -> do+ srcLocs <- unmarshall_SrcLocList pSrcLoc nSrcLoc+ f file srcLocs pData++marshall_inclusionVisitor :: InclusionVisitor -> IO (FunPtr InclusionVisitorRaw)+marshall_inclusionVisitor f = wrapInclusionVisitorRaw (wrapInclusionVisitor f)
src/Clang/FFI_stub_ffi.c view
@@ -40,11 +40,11 @@ return((HsPtr)(r));} while(0); }-HsWord64 prim_getFileTime(HsPtr arg1)-{ HsWord64 res1;+HsWord32 prim_getFileTime(HsPtr arg1)+{ HsWord32 res1; do {res1 = clang_getFileTime(arg1); - return((HsWord64)(res1));} while(0);+ return((HsWord32)(res1));} while(0); } HsPtr prim_getFile(HsPtr t,char * s) { HsPtr r;@@ -52,6 +52,8 @@ return((HsPtr)(r));} while(0); }+ void * srcLocListGetPtr(CXSourceLocation * s, int i, int pi) {return s[i].ptr_data[pi];}+ unsigned srcLocListGetData(CXSourceLocation * s, int i) {return s[i].int_data;} void* prim_getNullLocation() { static struct {HsPtr gc_res1;HsPtr gc_res2;HsInt gc_res3;} gc_result; do { CXSourceLocation r = clang_getNullLocation();@@ -72,7 +74,7 @@ } void* prim_getLocation(HsPtr t,HsPtr f,HsInt i,HsInt j) { static struct {HsPtr gc_res1;HsPtr gc_res2;HsInt gc_res3;} gc_result;- do { CXSourceLocation r = clang_getLocation(*(CXTranslationUnit*)t, f, i, j);+ do { CXSourceLocation r = clang_getLocation((CXTranslationUnit)t, f, i, j); gc_result.gc_res1 = (HsPtr)(r.ptr_data[0]); gc_result.gc_res2 = (HsPtr)(r.ptr_data[1]); gc_result.gc_res3 = (HsInt)(r.int_data);@@ -84,7 +86,7 @@ HsInt access_prim_getLocation_gc_res3(void *ptr){ return(((struct {HsPtr gc_res1;HsPtr gc_res2;HsInt gc_res3;}*) ptr)->gc_res3);} void* prim_getLocationForOffset(HsPtr t,HsPtr f,HsInt i) { static struct {HsPtr gc_res1;HsPtr gc_res2;HsInt gc_res3;} gc_result;- do { CXSourceLocation r = clang_getLocationForOffset(*(CXTranslationUnit*)t, f, i);+ do { CXSourceLocation r = clang_getLocationForOffset((CXTranslationUnit)t, f, i); gc_result.gc_res1 = (HsPtr)(r.ptr_data[0]); gc_result.gc_res2 = (HsPtr)(r.ptr_data[1]); gc_result.gc_res3 = (HsInt)(r.int_data);@@ -214,13 +216,13 @@ } HsInt prim_getNumDiagnostics(HsPtr t) { HsInt r;- do { unsigned r = clang_getNumDiagnostics(*(CXTranslationUnit*)t);+ do { unsigned r = clang_getNumDiagnostics((CXTranslationUnit)t); return((HsInt)(r));} while(0); } HsPtr prim_getDiagnostic(HsPtr t,HsInt i) { HsPtr r;- do { CXDiagnostic r = clang_getDiagnostic(*(CXTranslationUnit*)t, i);+ do { CXDiagnostic r = clang_getDiagnostic((CXTranslationUnit)t, i); return((HsPtr)(r));} while(0); }@@ -1717,6 +1719,27 @@ return((HsInt)(res1));} while(0); }+ typedef enum CXChildVisitResult (*HSCursorVisitor)+ (HsInt ck,HsPtr cp1, HsPtr cp2,HsPtr cp3,+ HsInt pk,HsPtr pp1, HsPtr pp2,HsPtr pp3, CXClientData data);+ typedef struct {+ HSCursorVisitor visitor;+ CXClientData data;+ } HSChildVisitorData;++ enum CXChildVisitResult primChildVisitor(CXCursor c, CXCursor p, CXClientData d)+ {+ HSChildVisitorData *hsdata = (HSChildVisitorData *)d;+ return hsdata->visitor(c.kind,c.data[0],c.data[1],c.data[2], + p.kind,p.data[0],p.data[1],p.data[2], hsdata->data);+ }++ unsigned prim_visitChildren_(HsInt ck,HsPtr p1,HsPtr p2,HsPtr p3,HsPtr pd,HsPtr fp)+ {+ CXCursor p = {ck, {p1,p2,p3}};+ HSChildVisitorData hsdata = {(HSCursorVisitor)fp,pd};+ return clang_visitChildren(p, primChildVisitor, (CXClientData)&hsdata);+ } HsPtr prim_getCursorUSR(HsInt k,HsPtr p1,HsPtr p2,HsPtr p3) { HsPtr r; do { CXCursor a = {k, {p1, p2, p3}};@@ -1826,7 +1849,7 @@ HsPtr access_prim_getCanonicalCursor_gc_res3(void *ptr){ return(((struct {HsInt gc_res2;HsPtr gc_res3;HsPtr gc_res4;HsPtr gc_res5;}*) ptr)->gc_res3);} HsPtr access_prim_getCanonicalCursor_gc_res4(void *ptr){ return(((struct {HsInt gc_res2;HsPtr gc_res3;HsPtr gc_res4;HsPtr gc_res5;}*) ptr)->gc_res4);} HsPtr access_prim_getCanonicalCursor_gc_res5(void *ptr){ return(((struct {HsInt gc_res2;HsPtr gc_res3;HsPtr gc_res4;HsPtr gc_res5;}*) ptr)->gc_res5);}-HsInt prim_cppMethod_isStatic(HsInt k,HsPtr p1,HsPtr p2,HsPtr p3)+HsInt prim_cXXMethod_isStatic(HsInt k,HsPtr p1,HsPtr p2,HsPtr p3) { HsInt r; do { CXCursor a = {k, {p1, p2, p3}}; r = clang_CXXMethod_isStatic(a);@@ -1929,6 +1952,9 @@ HsInt access_prim_getTokenExtent_gc_res4(void *ptr){ return(((struct {HsPtr gc_res1;HsPtr gc_res2;HsInt gc_res3;HsInt gc_res4;}*) ptr)->gc_res4);} unsigned tokenListGetInt(CXToken *tlist, int i, int pi) {return tlist[i].int_data[pi];} void * tokenListGetPtr(CXToken *tlist, int i) {return tlist[i].ptr_data;}+ void * makeTokens(int n) { return malloc(n * sizeof(CXToken)); }+ void freeTokens(void * tlist) { free(tlist); }+ void setTokenList(CXToken *tlist,int i,int w,int x,int y,int z,void *p) {CXToken a = {{w, x, y, z}, p};tlist[i]=a;} void* prim_tokenize(HsPtr t,HsPtr p1,HsPtr p2,HsInt d1,HsInt d2) { static struct {HsInt numTokens;HsPtr tokens;} gc_result; HsInt numTokens; HsPtr tokens;@@ -1942,6 +1968,13 @@ } HsInt access_prim_tokenize_numTokens(void *ptr){ return(((struct {HsInt numTokens;HsPtr tokens;}*) ptr)->numTokens);} HsPtr access_prim_tokenize_tokens(void *ptr){ return(((struct {HsInt numTokens;HsPtr tokens;}*) ptr)->tokens);}+HsPtr prim_annotateTokens(HsPtr t,HsInt nts,HsPtr ts)+{ HsPtr cs;+ do { CXCursor * cs = (CXCursor *)malloc(sizeof(CXCursor)*nts);+ clang_annotateTokens(t, ts, nts, cs);+ + return((HsPtr)(cs));} while(0);+} HsPtr prim_getCursorKindSpelling(HsInt k) { HsPtr r; do { CXString *r = mkStrObj();*r = clang_getCursorKindSpelling(k);@@ -2154,3 +2187,4 @@ { do {clang_toggleCrashRecovery(arg1); ;} while(0); }+ void prim_getInclusions_(HsPtr t,HsPtr f,HsPtr p){ do { clang_getInclusions(t, f, p);} while(0);}
+ src/Clang/Source.hs view
@@ -0,0 +1,43 @@+module Clang.Source+(+ FFI.File+,getFilename+,getFileTime+,FFI.SourceLocation+,nullLocation+,getLocation+,getLocationForOffset+,FFI.SourceRange+,nullRange+,getRange+,getInstantiationLocation+,getSpellingLocation+,getStart+,getEnd+) where++import System.IO.Unsafe(unsafePerformIO)++import qualified Clang.FFI as FFI++getFilename = unsafePerformIO . FFI.getFileName+getFileTime = unsafePerformIO . FFI.getFileTime+++-- Location functions+nullLocation = unsafePerformIO FFI.getNullLocation++instance Eq FFI.SourceLocation where+ a == b = unsafePerformIO (FFI.equalLocations a b)++getLocation tu f line col = unsafePerformIO (FFI.getLocation tu f line col)+getLocationForOffset tu f off = unsafePerformIO (FFI.getLocationForOffset tu f off)+++-- Range functions+nullRange = unsafePerformIO FFI.getNullRange+getRange from to = unsafePerformIO (FFI.getRange from to)+getInstantiationLocation = unsafePerformIO . FFI.getInstantiationLocation+getSpellingLocation = unsafePerformIO . FFI.getSpellingLocation+getStart = unsafePerformIO . FFI.getRangeStart+getEnd = unsafePerformIO . FFI.getRangeEnd
+ src/Clang/Token.hs view
@@ -0,0 +1,22 @@+module Clang.Token+(+ FFI.Token+,getKind+,getSpelling+,Clang.Token.getLocation+,getExtent+,tokenize+) where++import System.IO.Unsafe(unsafePerformIO)++import Clang.Type+import Clang.Source+import qualified Clang.FFI as FFI++getKind = unsafePerformIO . FFI.getTokenKind+getSpelling t tk = unsafePerformIO (FFI.getTokenSpelling t tk)+getLocation t tk = unsafePerformIO (FFI.getTokenLocation t tk)+getExtent t tk = unsafePerformIO (FFI.getTokenExtent t tk)+tokenize :: FFI.TranslationUnit -> FFI.SourceRange -> [FFI.Token]+tokenize t sr = unsafePerformIO (FFI.tokenize t sr)
+ src/Clang/TranslationUnit.hs view
@@ -0,0 +1,63 @@+module Clang.TranslationUnit+(+ FFI.Index+,FFI.TranslationUnitFlags(..)+,FFI.SaveTranslationUnitFlags(..)+,create+,createIndex+,getSpelling+,createFromSourceFile+,parse+,defaultSaveOptions+,save+,defaultReparseOptions+,reparse+) where++import System.IO.Unsafe(unsafePerformIO)+import Data.Bits((.&.))+import Data.Maybe(catMaybes)+import Control.Monad(mzero)++import Clang.Type+import Clang.Source+import qualified Clang.FFI as FFI++getSpelling = unsafePerformIO . FFI.getTranslationUnitSpelling+create = FFI.createTranslationUnit+createFromSourceFile :: FFI.Index -- ^ Index for the source+ -> FilePath -- ^ Source filename+ -> [String] -- ^ Command line arguments ( this can include all clang compatible flags)+ -> [FFI.UnsavedFile] -- ^ Unsaved files+ -> IO FFI.TranslationUnit+createFromSourceFile = FFI.createTranslationUnitFromSourceFile+parse :: FFI.Index -- ^ Index for the source+ -> Maybe FilePath -- ^ Source filename+ -> [String] -- ^ Command line arguments ( this can include all clang compatible flags)+ -> [FFI.UnsavedFile] -- ^ Unsaved files+ -> [FFI.TranslationUnitFlags] -- ^ TranslationUnit flags+ -> IO (Maybe FFI.TranslationUnit)+parse i ms ss ufs opts = FFI.parseTranslationUnit i ms ss ufs (FFI.getTranslationUnitFlagsSum opts)++-- No other option right now+defaultSaveOptions = [FFI.SaveTranslationUnit_None]++save :: FFI.TranslationUnit -- ^ TranslationUnit to save+ -> FilePath -- ^ Filename to save to+ -> [FFI.SaveTranslationUnitFlags] -- ^ Saving Flags+ -> IO Bool+save t fname opts = FFI.saveTranslationUnit t fname (FFI.getSaveTranslationUnitFlagsSum opts)++-- No other option right now+defaultReparseOptions = [FFI.Reparse_None]+ -- where defVal = unsafePerformIO . FFI.defaultReparseOptions+ -- val1 v = if (v .&. 0x1) == 0x1 then return FFI.Diagnostic_DisplaySourceLocation else mzero++reparse :: FFI.TranslationUnit -- ^ TranslationUnit to save+ -> [FFI.UnsavedFile] -- ^ All the unsaved files+ -> [FFI.ReparseFlags] -- ^ reparse options+ -> IO Bool+reparse t ufs opts = FFI.reparseTranslationUnit t ufs (FFI.getReparseFlagsSum opts)++-- index functions+createIndex = FFI.createIndex
+ src/Clang/Type.hs view
@@ -0,0 +1,41 @@+module Clang.Type+(+ FFI.Type+,FFI.CXString+,FFI.TypeKind(..)+,FFI.CXXAccessSpecifier(..)++,getCanonicalType+,getPointeeType+,getResultType++,isConstQualifiedType+,isVolatileQualifiedType+,isRestrictQualifiedType+,isPODType+,isVirtualBase+)+where++import System.IO.Unsafe(unsafePerformIO)+import qualified Clang.FFI as FFI++instance Show FFI.CXString where+ show = unsafePerformIO . FFI.getCString++instance Eq FFI.Type where+ a == b = unsafePerformIO (FFI.equalTypes a b)++getCanonicalType = unsafePerformIO . FFI.getCanonicalType+getPointeeType = unsafePerformIO . FFI.getPointeeType+getResultType = unsafePerformIO . FFI.getResultType++isConstQualifiedType = unsafePerformIO . FFI.isConstQualifiedType+isVolatileQualifiedType = unsafePerformIO . FFI.isVolatileQualifiedType+isRestrictQualifiedType = unsafePerformIO . FFI.isRestrictQualifiedType+isPODType = unsafePerformIO . FFI.isPODType+isVirtualBase = unsafePerformIO . FFI.isVirtualBase+++-- Typekind functions+getTypeKindSpelling = unsafePerformIO . FFI.getTypeKindSpelling