{-# LINE 1 "src/Language/C/Clang/Internal/FFI.hsc" #-} {- {-# LINE 2 "src/Language/C/Clang/Internal/FFI.hsc" #-} Copyright 2014 Google Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. -} {-# OPTIONS_GHC -fno-warn-orphans #-} module Language.C.Clang.Internal.FFI where import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Control.Exception import Control.Monad import Data.Foldable import Data.Functor.Contravariant import Data.IORef import qualified Data.Vector.Storable as VS import Foreign import Foreign.C import qualified Language.C.Inline as C hiding (exp, block) import qualified Language.C.Inline as CSafe import qualified Language.C.Inline.Unsafe as C import System.IO.Unsafe import Language.C.Clang.Internal.Context import Language.C.Clang.Internal.Refs import Language.C.Clang.Internal.Types C.context clangCtx C.include "stdlib.h" {-# LINE 43 "src/Language/C/Clang/Internal/FFI.hsc" #-} C.include "clang-c/Index.h" C.include "utils.h" foreign import ccall "clang_disposeIndex" clang_disposeIndex :: Ptr CXIndexImpl -> Finalizer createIndex :: IO ClangIndex createIndex = do idxp <- [C.exp| CXIndex { clang_createIndex(0, 1) } |] ClangIndex <$> newRoot idxp (clang_disposeIndex idxp) foreign import ccall "clang_disposeTranslationUnit" clang_disposeTranslationUnit :: Ptr CXTranslationUnitImpl -> Finalizer data ClangError = Success | Failure | Crashed | InvalidArguments | ASTReadError deriving (Eq, Ord, Show) parseClangError :: CInt -> ClangError parseClangError = \case 0 -> Success {-# LINE 68 "src/Language/C/Clang/Internal/FFI.hsc" #-} 1 -> Failure {-# LINE 69 "src/Language/C/Clang/Internal/FFI.hsc" #-} 2 -> Crashed {-# LINE 70 "src/Language/C/Clang/Internal/FFI.hsc" #-} 3 -> InvalidArguments {-# LINE 71 "src/Language/C/Clang/Internal/FFI.hsc" #-} 4 -> ASTReadError {-# LINE 72 "src/Language/C/Clang/Internal/FFI.hsc" #-} _ -> Failure -- unrecognized enum value instance Exception ClangError parseTranslationUnit :: ClangIndex -> FilePath -> [ String ] -> IO TranslationUnit parseTranslationUnit idx path args = do tun <- newNode idx $ \idxp -> withCString path $ \cPath -> do cArgs <- VS.fromList <$> traverse newCString args ( tup, cres ) <- C.withPtr $ \tupp -> [C.exp| int { clang_parseTranslationUnit2( $(CXIndex idxp), $(char* cPath), $vec-ptr:(const char * const * cArgs), $vec-len:cArgs, NULL, 0, 0, $(CXTranslationUnit *tupp)) } |] traverse_ free $ VS.toList cArgs let res = parseClangError cres when (res /= Success) $ throwIO res return ( tup, clang_disposeTranslationUnit tup ) return $ TranslationUnitRef tun translationUnitCursor :: TranslationUnit -> Cursor translationUnitCursor tu = unsafePerformIO $ do cn <- newLeaf tu $ \tup -> do cp <- [C.exp| CXCursor* { ALLOC( clang_getTranslationUnitCursor($(CXTranslationUnit tup)) )} |] return ( cp, free cp ) return $ Cursor cn cursorTranslationUnit :: Cursor -> TranslationUnit cursorTranslationUnit (Cursor c) = parent c cursorKind :: Cursor -> CursorKind cursorKind c = uderef c $ fmap parseCursorKind . (\hsc_ptr -> peekByteOff hsc_ptr 0) {-# LINE 110 "src/Language/C/Clang/Internal/FFI.hsc" #-} -- | Fold over the children of a cursor in the `lens` sense. cursorChildrenF :: (Applicative f, Contravariant f) => (Cursor -> f Cursor) -> (Cursor -> f Cursor) cursorChildrenF f c = uderef c $ \cp -> do -- initialize the "Fold state" with no effect fRef <- newIORef $ phantom $ pure () let visitChild chp = do ch <- newLeaf (cursorTranslationUnit c) $ \_ -> return ( chp, free chp ) -- fold over the new cursor and update the "Fold state" modifyIORef' fRef (*> f (Cursor ch)) [CSafe.exp| void { clang_visitChildren( *$(CXCursor *cp), visit_haskell, $fun:(void (*visitChild)(CXCursor*))) } |] readIORef fRef withCXString :: (Ptr CXString -> IO ()) -> IO ByteString withCXString f = allocaBytes ((16)) $ \cxsp -> do {-# LINE 132 "src/Language/C/Clang/Internal/FFI.hsc" #-} f cxsp cs <- [C.exp| const char * { clang_getCString(*$(CXString *cxsp)) } |] s <- BS.packCString cs [C.exp| void { clang_disposeString(*$(CXString *cxsp)) } |] return s cursorSpelling :: Cursor -> ByteString cursorSpelling c = uderef c $ \cp -> withCXString $ \cxsp -> [C.block| void { *$(CXString *cxsp) = clang_getCursorSpelling(*$(CXCursor *cp)); } |] cursorExtent :: Cursor -> Maybe SourceRange cursorExtent c = uderef c $ \cp -> do srp <- [C.block| CXSourceRange* { CXSourceRange sr = clang_getCursorExtent(*$(CXCursor *cp)); if (clang_Range_isNull(sr)) { return NULL; } return ALLOC(sr); } |] if srp == nullPtr then return Nothing else do srn <- newLeaf (cursorTranslationUnit c) $ \_ -> return ( srp, free srp ) return $ Just $ SourceRange srn cursorUSR :: Cursor -> ByteString cursorUSR c = uderef c $ \cp -> withCXString $ \cxsp -> [C.block| void { *$(CXString *cxsp) = clang_getCursorUSR(*$(CXCursor *cp)); } |] cursorReferenced :: Cursor -> Maybe Cursor cursorReferenced c = uderef c $ \cp -> do rcp <- [C.block| CXCursor* { CXCursor ref = clang_getCursorReferenced(*$(CXCursor *cp)); if (clang_Cursor_isNull(ref)) { return NULL; } return ALLOC(ref); } |] if rcp /= nullPtr then (Just . Cursor) <$> newLeaf (parent c) (\_ -> return ( rcp, free rcp )) else return Nothing rangeStart, rangeEnd :: SourceRange -> SourceLocation rangeStart sr = uderef sr $ \srp -> do slp <- [C.exp| CXSourceLocation* { ALLOC( clang_getRangeStart(*$(CXSourceRange *srp)) )} |] sln <- newLeaf (parent sr) $ \_ -> return ( slp, free slp ) return $ SourceLocation sln rangeEnd sr = uderef sr $ \srp -> do slp <- [C.exp| CXSourceLocation* { ALLOC( clang_getRangeEnd(*$(CXSourceRange *srp)) )} |] sln <- newLeaf (parent sr) $ \_ -> return ( slp, free slp ) return $ SourceLocation sln spellingLocation :: SourceLocation -> Location spellingLocation sl = uderef sl $ \slp -> do ( f, l, c, o ) <- C.withPtrs_ $ \( fp, lp, cp, offp ) -> [C.exp| void { clang_getSpellingLocation( *$(CXSourceLocation *slp), $(CXFile *fp), $(unsigned int *lp), $(unsigned int *cp), $(unsigned int *offp)) } |] fn <- newLeaf (parent sl) $ \_ -> return ( f, return () ) return $ Location { file = File fn , line = fromIntegral l , column = fromIntegral c , offset = fromIntegral o } getFile :: TranslationUnit -> FilePath -> Maybe File getFile tu p = uderef tu $ \tup -> withCString p $ \fn -> do fp <- [C.exp| CXFile { clang_getFile($(CXTranslationUnit tup), $(const char *fn)) } |] if fp == nullPtr then return Nothing else (Just . File) <$> newLeaf tu (\_ -> return ( fp, return () )) fileName :: File -> ByteString fileName f = uderef f $ \fp -> withCXString $ \cxsp -> [C.block| void { *$(CXString *cxsp) = clang_getFileName($(CXFile fp)); } |] instance Eq Cursor where (==) = defaultEq $ \lp rp -> [C.exp| int { clang_equalCursors(*$(CXCursor *lp), *$(CXCursor *rp)) } |] instance Eq SourceRange where (==) = defaultEq $ \lp rp -> [C.exp| int { clang_equalRanges(*$(CXSourceRange *lp), *$(CXSourceRange *rp)) } |] instance Eq SourceLocation where (==) = defaultEq $ \lp rp -> [C.exp| int { clang_equalLocations(*$(CXSourceLocation *lp), *$(CXSourceLocation *rp)) } |] instance Eq Type where (==) = defaultEq $ \lp rp -> [C.exp| int { clang_equalTypes(*$(CXType *lp), *$(CXType *rp)) } |] -- Checks for pointer equality, alternatively checks for structural equality with the given function. defaultEq :: (Clang r, RefOf r ~ a) => (Ptr a -> Ptr a -> IO CInt) -> r -> r -> Bool defaultEq ne l r = l `pointerEq` r || structEq where structEq = unsafePerformIO $ deref l $ \p -> deref r $ \p' -> (/=0) <$> ne p p' parseCursorKind :: CInt -> CursorKind parseCursorKind = \case 1 -> UnexposedDecl {-# LINE 262 "src/Language/C/Clang/Internal/FFI.hsc" #-} 2 -> StructDecl {-# LINE 263 "src/Language/C/Clang/Internal/FFI.hsc" #-} 3 -> UnionDecl {-# LINE 264 "src/Language/C/Clang/Internal/FFI.hsc" #-} 4 -> ClassDecl {-# LINE 265 "src/Language/C/Clang/Internal/FFI.hsc" #-} 5 -> EnumDecl {-# LINE 266 "src/Language/C/Clang/Internal/FFI.hsc" #-} 6 -> FieldDecl {-# LINE 267 "src/Language/C/Clang/Internal/FFI.hsc" #-} 7 -> EnumConstantDecl {-# LINE 268 "src/Language/C/Clang/Internal/FFI.hsc" #-} 8 -> FunctionDecl {-# LINE 269 "src/Language/C/Clang/Internal/FFI.hsc" #-} 9 -> VarDecl {-# LINE 270 "src/Language/C/Clang/Internal/FFI.hsc" #-} 10 -> ParmDecl {-# LINE 271 "src/Language/C/Clang/Internal/FFI.hsc" #-} 11 -> ObjCInterfaceDecl {-# LINE 272 "src/Language/C/Clang/Internal/FFI.hsc" #-} 12 -> ObjCCategoryDecl {-# LINE 273 "src/Language/C/Clang/Internal/FFI.hsc" #-} 13 -> ObjCProtocolDecl {-# LINE 274 "src/Language/C/Clang/Internal/FFI.hsc" #-} 14 -> ObjCPropertyDecl {-# LINE 275 "src/Language/C/Clang/Internal/FFI.hsc" #-} 15 -> ObjCIvarDecl {-# LINE 276 "src/Language/C/Clang/Internal/FFI.hsc" #-} 16 -> ObjCInstanceMethodDecl {-# LINE 277 "src/Language/C/Clang/Internal/FFI.hsc" #-} 17 -> ObjCClassMethodDecl {-# LINE 278 "src/Language/C/Clang/Internal/FFI.hsc" #-} 18 -> ObjCImplementationDecl {-# LINE 279 "src/Language/C/Clang/Internal/FFI.hsc" #-} 19 -> ObjCCategoryImplDecl {-# LINE 280 "src/Language/C/Clang/Internal/FFI.hsc" #-} 20 -> TypedefDecl {-# LINE 281 "src/Language/C/Clang/Internal/FFI.hsc" #-} 21 -> CXXMethod {-# LINE 282 "src/Language/C/Clang/Internal/FFI.hsc" #-} 22 -> Namespace {-# LINE 283 "src/Language/C/Clang/Internal/FFI.hsc" #-} 23 -> LinkageSpec {-# LINE 284 "src/Language/C/Clang/Internal/FFI.hsc" #-} 24 -> Constructor {-# LINE 285 "src/Language/C/Clang/Internal/FFI.hsc" #-} 25 -> Destructor {-# LINE 286 "src/Language/C/Clang/Internal/FFI.hsc" #-} 26 -> ConversionFunction {-# LINE 287 "src/Language/C/Clang/Internal/FFI.hsc" #-} 27 -> TemplateTypeParameter {-# LINE 288 "src/Language/C/Clang/Internal/FFI.hsc" #-} 28 -> NonTypeTemplateParameter {-# LINE 289 "src/Language/C/Clang/Internal/FFI.hsc" #-} 29 -> TemplateTemplateParameter {-# LINE 290 "src/Language/C/Clang/Internal/FFI.hsc" #-} 30 -> FunctionTemplate {-# LINE 291 "src/Language/C/Clang/Internal/FFI.hsc" #-} 31 -> ClassTemplate {-# LINE 292 "src/Language/C/Clang/Internal/FFI.hsc" #-} 32 -> ClassTemplatePartialSpecialization {-# LINE 293 "src/Language/C/Clang/Internal/FFI.hsc" #-} 33 -> NamespaceAlias {-# LINE 294 "src/Language/C/Clang/Internal/FFI.hsc" #-} 34 -> UsingDirective {-# LINE 295 "src/Language/C/Clang/Internal/FFI.hsc" #-} 35 -> UsingDeclaration {-# LINE 296 "src/Language/C/Clang/Internal/FFI.hsc" #-} 36 -> TypeAliasDecl {-# LINE 297 "src/Language/C/Clang/Internal/FFI.hsc" #-} 37 -> ObjCSynthesizeDecl {-# LINE 298 "src/Language/C/Clang/Internal/FFI.hsc" #-} 38 -> ObjCDynamicDecl {-# LINE 299 "src/Language/C/Clang/Internal/FFI.hsc" #-} 39 -> CXXAccessSpecifier {-# LINE 300 "src/Language/C/Clang/Internal/FFI.hsc" #-} 1 -> FirstDecl {-# LINE 301 "src/Language/C/Clang/Internal/FFI.hsc" #-} 39 -> LastDecl {-# LINE 302 "src/Language/C/Clang/Internal/FFI.hsc" #-} 40 -> FirstRef {-# LINE 303 "src/Language/C/Clang/Internal/FFI.hsc" #-} 40 -> ObjCSuperClassRef {-# LINE 304 "src/Language/C/Clang/Internal/FFI.hsc" #-} 41 -> ObjCProtocolRef {-# LINE 305 "src/Language/C/Clang/Internal/FFI.hsc" #-} 42 -> ObjCClassRef {-# LINE 306 "src/Language/C/Clang/Internal/FFI.hsc" #-} 43 -> TypeRef {-# LINE 307 "src/Language/C/Clang/Internal/FFI.hsc" #-} 44 -> CXXBaseSpecifier {-# LINE 308 "src/Language/C/Clang/Internal/FFI.hsc" #-} 45 -> TemplateRef {-# LINE 309 "src/Language/C/Clang/Internal/FFI.hsc" #-} 46 -> NamespaceRef {-# LINE 310 "src/Language/C/Clang/Internal/FFI.hsc" #-} 47 -> MemberRef {-# LINE 311 "src/Language/C/Clang/Internal/FFI.hsc" #-} 48 -> LabelRef {-# LINE 312 "src/Language/C/Clang/Internal/FFI.hsc" #-} 49 -> OverloadedDeclRef {-# LINE 313 "src/Language/C/Clang/Internal/FFI.hsc" #-} 50 -> VariableRef {-# LINE 314 "src/Language/C/Clang/Internal/FFI.hsc" #-} 50 -> LastRef {-# LINE 315 "src/Language/C/Clang/Internal/FFI.hsc" #-} 70 -> FirstInvalid {-# LINE 316 "src/Language/C/Clang/Internal/FFI.hsc" #-} 70 -> InvalidFile {-# LINE 317 "src/Language/C/Clang/Internal/FFI.hsc" #-} 71 -> NoDeclFound {-# LINE 318 "src/Language/C/Clang/Internal/FFI.hsc" #-} 72 -> NotImplemented {-# LINE 319 "src/Language/C/Clang/Internal/FFI.hsc" #-} 73 -> InvalidCode {-# LINE 320 "src/Language/C/Clang/Internal/FFI.hsc" #-} 73 -> LastInvalid {-# LINE 321 "src/Language/C/Clang/Internal/FFI.hsc" #-} 100 -> FirstExpr {-# LINE 322 "src/Language/C/Clang/Internal/FFI.hsc" #-} 100 -> UnexposedExpr {-# LINE 323 "src/Language/C/Clang/Internal/FFI.hsc" #-} 101 -> DeclRefExpr {-# LINE 324 "src/Language/C/Clang/Internal/FFI.hsc" #-} 102 -> MemberRefExpr {-# LINE 325 "src/Language/C/Clang/Internal/FFI.hsc" #-} 103 -> CallExpr {-# LINE 326 "src/Language/C/Clang/Internal/FFI.hsc" #-} 104 -> ObjCMessageExpr {-# LINE 327 "src/Language/C/Clang/Internal/FFI.hsc" #-} 105 -> BlockExpr {-# LINE 328 "src/Language/C/Clang/Internal/FFI.hsc" #-} 106 -> IntegerLiteral {-# LINE 329 "src/Language/C/Clang/Internal/FFI.hsc" #-} 107 -> FloatingLiteral {-# LINE 330 "src/Language/C/Clang/Internal/FFI.hsc" #-} 108 -> ImaginaryLiteral {-# LINE 331 "src/Language/C/Clang/Internal/FFI.hsc" #-} 109 -> StringLiteral {-# LINE 332 "src/Language/C/Clang/Internal/FFI.hsc" #-} 110 -> CharacterLiteral {-# LINE 333 "src/Language/C/Clang/Internal/FFI.hsc" #-} 111 -> ParenExpr {-# LINE 334 "src/Language/C/Clang/Internal/FFI.hsc" #-} 112 -> UnaryOperator {-# LINE 335 "src/Language/C/Clang/Internal/FFI.hsc" #-} 113 -> ArraySubscriptExpr {-# LINE 336 "src/Language/C/Clang/Internal/FFI.hsc" #-} 114 -> BinaryOperator {-# LINE 337 "src/Language/C/Clang/Internal/FFI.hsc" #-} 115 -> CompoundAssignOperator {-# LINE 338 "src/Language/C/Clang/Internal/FFI.hsc" #-} 116 -> ConditionalOperator {-# LINE 339 "src/Language/C/Clang/Internal/FFI.hsc" #-} 117 -> CStyleCastExpr {-# LINE 340 "src/Language/C/Clang/Internal/FFI.hsc" #-} 118 -> CompoundLiteralExpr {-# LINE 341 "src/Language/C/Clang/Internal/FFI.hsc" #-} 119 -> InitListExpr {-# LINE 342 "src/Language/C/Clang/Internal/FFI.hsc" #-} 120 -> AddrLabelExpr {-# LINE 343 "src/Language/C/Clang/Internal/FFI.hsc" #-} 121 -> StmtExpr {-# LINE 344 "src/Language/C/Clang/Internal/FFI.hsc" #-} 122 -> GenericSelectionExpr {-# LINE 345 "src/Language/C/Clang/Internal/FFI.hsc" #-} 123 -> GNUNullExpr {-# LINE 346 "src/Language/C/Clang/Internal/FFI.hsc" #-} 124 -> CXXStaticCastExpr {-# LINE 347 "src/Language/C/Clang/Internal/FFI.hsc" #-} 125 -> CXXDynamicCastExpr {-# LINE 348 "src/Language/C/Clang/Internal/FFI.hsc" #-} 126 -> CXXReinterpretCastExpr {-# LINE 349 "src/Language/C/Clang/Internal/FFI.hsc" #-} 127 -> CXXConstCastExpr {-# LINE 350 "src/Language/C/Clang/Internal/FFI.hsc" #-} 128 -> CXXFunctionalCastExpr {-# LINE 351 "src/Language/C/Clang/Internal/FFI.hsc" #-} 129 -> CXXTypeidExpr {-# LINE 352 "src/Language/C/Clang/Internal/FFI.hsc" #-} 130 -> CXXBoolLiteralExpr {-# LINE 353 "src/Language/C/Clang/Internal/FFI.hsc" #-} 131 -> CXXNullPtrLiteralExpr {-# LINE 354 "src/Language/C/Clang/Internal/FFI.hsc" #-} 132 -> CXXThisExpr {-# LINE 355 "src/Language/C/Clang/Internal/FFI.hsc" #-} 133 -> CXXThrowExpr {-# LINE 356 "src/Language/C/Clang/Internal/FFI.hsc" #-} 134 -> CXXNewExpr {-# LINE 357 "src/Language/C/Clang/Internal/FFI.hsc" #-} 135 -> CXXDeleteExpr {-# LINE 358 "src/Language/C/Clang/Internal/FFI.hsc" #-} 136 -> UnaryExpr {-# LINE 359 "src/Language/C/Clang/Internal/FFI.hsc" #-} 137 -> ObjCStringLiteral {-# LINE 360 "src/Language/C/Clang/Internal/FFI.hsc" #-} 138 -> ObjCEncodeExpr {-# LINE 361 "src/Language/C/Clang/Internal/FFI.hsc" #-} 139 -> ObjCSelectorExpr {-# LINE 362 "src/Language/C/Clang/Internal/FFI.hsc" #-} 140 -> ObjCProtocolExpr {-# LINE 363 "src/Language/C/Clang/Internal/FFI.hsc" #-} 141 -> ObjCBridgedCastExpr {-# LINE 364 "src/Language/C/Clang/Internal/FFI.hsc" #-} 142 -> PackExpansionExpr {-# LINE 365 "src/Language/C/Clang/Internal/FFI.hsc" #-} 143 -> SizeOfPackExpr {-# LINE 366 "src/Language/C/Clang/Internal/FFI.hsc" #-} 144 -> LambdaExpr {-# LINE 367 "src/Language/C/Clang/Internal/FFI.hsc" #-} 145 -> ObjCBoolLiteralExpr {-# LINE 368 "src/Language/C/Clang/Internal/FFI.hsc" #-} 146 -> ObjCSelfExpr {-# LINE 369 "src/Language/C/Clang/Internal/FFI.hsc" #-} 147 -> LastExpr {-# LINE 370 "src/Language/C/Clang/Internal/FFI.hsc" #-} 200 -> FirstStmt {-# LINE 371 "src/Language/C/Clang/Internal/FFI.hsc" #-} 200 -> UnexposedStmt {-# LINE 372 "src/Language/C/Clang/Internal/FFI.hsc" #-} 201 -> LabelStmt {-# LINE 373 "src/Language/C/Clang/Internal/FFI.hsc" #-} 202 -> CompoundStmt {-# LINE 374 "src/Language/C/Clang/Internal/FFI.hsc" #-} 203 -> CaseStmt {-# LINE 375 "src/Language/C/Clang/Internal/FFI.hsc" #-} 204 -> DefaultStmt {-# LINE 376 "src/Language/C/Clang/Internal/FFI.hsc" #-} 205 -> IfStmt {-# LINE 377 "src/Language/C/Clang/Internal/FFI.hsc" #-} 206 -> SwitchStmt {-# LINE 378 "src/Language/C/Clang/Internal/FFI.hsc" #-} 207 -> WhileStmt {-# LINE 379 "src/Language/C/Clang/Internal/FFI.hsc" #-} 208 -> DoStmt {-# LINE 380 "src/Language/C/Clang/Internal/FFI.hsc" #-} 209 -> ForStmt {-# LINE 381 "src/Language/C/Clang/Internal/FFI.hsc" #-} 210 -> GotoStmt {-# LINE 382 "src/Language/C/Clang/Internal/FFI.hsc" #-} 211 -> IndirectGotoStmt {-# LINE 383 "src/Language/C/Clang/Internal/FFI.hsc" #-} 212 -> ContinueStmt {-# LINE 384 "src/Language/C/Clang/Internal/FFI.hsc" #-} 213 -> BreakStmt {-# LINE 385 "src/Language/C/Clang/Internal/FFI.hsc" #-} 214 -> ReturnStmt {-# LINE 386 "src/Language/C/Clang/Internal/FFI.hsc" #-} 215 -> GCCAsmStmt {-# LINE 387 "src/Language/C/Clang/Internal/FFI.hsc" #-} 215 -> AsmStmt {-# LINE 388 "src/Language/C/Clang/Internal/FFI.hsc" #-} 216 -> ObjCAtTryStmt {-# LINE 389 "src/Language/C/Clang/Internal/FFI.hsc" #-} 217 -> ObjCAtCatchStmt {-# LINE 390 "src/Language/C/Clang/Internal/FFI.hsc" #-} 218 -> ObjCAtFinallyStmt {-# LINE 391 "src/Language/C/Clang/Internal/FFI.hsc" #-} 219 -> ObjCAtThrowStmt {-# LINE 392 "src/Language/C/Clang/Internal/FFI.hsc" #-} 220 -> ObjCAtSynchronizedStmt {-# LINE 393 "src/Language/C/Clang/Internal/FFI.hsc" #-} 221 -> ObjCAutoreleasePoolStmt {-# LINE 394 "src/Language/C/Clang/Internal/FFI.hsc" #-} 222 -> ObjCForCollectionStmt {-# LINE 395 "src/Language/C/Clang/Internal/FFI.hsc" #-} 223 -> CXXCatchStmt {-# LINE 396 "src/Language/C/Clang/Internal/FFI.hsc" #-} 224 -> CXXTryStmt {-# LINE 397 "src/Language/C/Clang/Internal/FFI.hsc" #-} 225 -> CXXForRangeStmt {-# LINE 398 "src/Language/C/Clang/Internal/FFI.hsc" #-} 226 -> SEHTryStmt {-# LINE 399 "src/Language/C/Clang/Internal/FFI.hsc" #-} 227 -> SEHExceptStmt {-# LINE 400 "src/Language/C/Clang/Internal/FFI.hsc" #-} 228 -> SEHFinallyStmt {-# LINE 401 "src/Language/C/Clang/Internal/FFI.hsc" #-} 229 -> MSAsmStmt {-# LINE 402 "src/Language/C/Clang/Internal/FFI.hsc" #-} 230 -> NullStmt {-# LINE 403 "src/Language/C/Clang/Internal/FFI.hsc" #-} 231 -> DeclStmt {-# LINE 404 "src/Language/C/Clang/Internal/FFI.hsc" #-} 232 -> OMPParallelDirective {-# LINE 405 "src/Language/C/Clang/Internal/FFI.hsc" #-} 233 -> OMPSimdDirective {-# LINE 406 "src/Language/C/Clang/Internal/FFI.hsc" #-} 234 -> OMPForDirective {-# LINE 407 "src/Language/C/Clang/Internal/FFI.hsc" #-} 235 -> OMPSectionsDirective {-# LINE 408 "src/Language/C/Clang/Internal/FFI.hsc" #-} 236 -> OMPSectionDirective {-# LINE 409 "src/Language/C/Clang/Internal/FFI.hsc" #-} 237 -> OMPSingleDirective {-# LINE 410 "src/Language/C/Clang/Internal/FFI.hsc" #-} 238 -> OMPParallelForDirective {-# LINE 411 "src/Language/C/Clang/Internal/FFI.hsc" #-} 239 -> OMPParallelSectionsDirective {-# LINE 412 "src/Language/C/Clang/Internal/FFI.hsc" #-} 240 -> OMPTaskDirective {-# LINE 413 "src/Language/C/Clang/Internal/FFI.hsc" #-} 241 -> OMPMasterDirective {-# LINE 414 "src/Language/C/Clang/Internal/FFI.hsc" #-} 242 -> OMPCriticalDirective {-# LINE 415 "src/Language/C/Clang/Internal/FFI.hsc" #-} 243 -> OMPTaskyieldDirective {-# LINE 416 "src/Language/C/Clang/Internal/FFI.hsc" #-} 244 -> OMPBarrierDirective {-# LINE 417 "src/Language/C/Clang/Internal/FFI.hsc" #-} 245 -> OMPTaskwaitDirective {-# LINE 418 "src/Language/C/Clang/Internal/FFI.hsc" #-} 246 -> OMPFlushDirective {-# LINE 419 "src/Language/C/Clang/Internal/FFI.hsc" #-} 247 -> SEHLeaveStmt {-# LINE 420 "src/Language/C/Clang/Internal/FFI.hsc" #-} 260 -> LastStmt {-# LINE 421 "src/Language/C/Clang/Internal/FFI.hsc" #-} 300 -> TranslationUnit {-# LINE 422 "src/Language/C/Clang/Internal/FFI.hsc" #-} 400 -> FirstAttr {-# LINE 423 "src/Language/C/Clang/Internal/FFI.hsc" #-} 400 -> UnexposedAttr {-# LINE 424 "src/Language/C/Clang/Internal/FFI.hsc" #-} 401 -> IBActionAttr {-# LINE 425 "src/Language/C/Clang/Internal/FFI.hsc" #-} 402 -> IBOutletAttr {-# LINE 426 "src/Language/C/Clang/Internal/FFI.hsc" #-} 403 -> IBOutletCollectionAttr {-# LINE 427 "src/Language/C/Clang/Internal/FFI.hsc" #-} 404 -> CXXFinalAttr {-# LINE 428 "src/Language/C/Clang/Internal/FFI.hsc" #-} 405 -> CXXOverrideAttr {-# LINE 429 "src/Language/C/Clang/Internal/FFI.hsc" #-} 406 -> AnnotateAttr {-# LINE 430 "src/Language/C/Clang/Internal/FFI.hsc" #-} 407 -> AsmLabelAttr {-# LINE 431 "src/Language/C/Clang/Internal/FFI.hsc" #-} 408 -> PackedAttr {-# LINE 432 "src/Language/C/Clang/Internal/FFI.hsc" #-} 409 -> PureAttr {-# LINE 433 "src/Language/C/Clang/Internal/FFI.hsc" #-} 410 -> ConstAttr {-# LINE 434 "src/Language/C/Clang/Internal/FFI.hsc" #-} 411 -> NoDuplicateAttr {-# LINE 435 "src/Language/C/Clang/Internal/FFI.hsc" #-} 412 -> CUDAConstantAttr {-# LINE 436 "src/Language/C/Clang/Internal/FFI.hsc" #-} 413 -> CUDADeviceAttr {-# LINE 437 "src/Language/C/Clang/Internal/FFI.hsc" #-} 414 -> CUDAGlobalAttr {-# LINE 438 "src/Language/C/Clang/Internal/FFI.hsc" #-} 415 -> CUDAHostAttr {-# LINE 439 "src/Language/C/Clang/Internal/FFI.hsc" #-} 419 -> LastAttr {-# LINE 440 "src/Language/C/Clang/Internal/FFI.hsc" #-} 500 -> PreprocessingDirective {-# LINE 441 "src/Language/C/Clang/Internal/FFI.hsc" #-} 501 -> MacroDefinition {-# LINE 442 "src/Language/C/Clang/Internal/FFI.hsc" #-} 502 -> MacroExpansion {-# LINE 443 "src/Language/C/Clang/Internal/FFI.hsc" #-} 502 -> MacroInstantiation {-# LINE 444 "src/Language/C/Clang/Internal/FFI.hsc" #-} 503 -> InclusionDirective {-# LINE 445 "src/Language/C/Clang/Internal/FFI.hsc" #-} 500 -> FirstPreprocessing {-# LINE 446 "src/Language/C/Clang/Internal/FFI.hsc" #-} 503 -> LastPreprocessing {-# LINE 447 "src/Language/C/Clang/Internal/FFI.hsc" #-} 600 -> ModuleImportDecl {-# LINE 448 "src/Language/C/Clang/Internal/FFI.hsc" #-} 600 -> FirstExtraDecl {-# LINE 449 "src/Language/C/Clang/Internal/FFI.hsc" #-} 601 -> LastExtraDecl {-# LINE 450 "src/Language/C/Clang/Internal/FFI.hsc" #-} _ -> UnexposedDecl -- unrecognized enum value cursorType :: Cursor -> Maybe Type cursorType c = uderef c $ \cp -> do tp <- [C.block| CXType* { CXType type = clang_getCursorType(*$(CXCursor *cp)); if (type.kind == CXType_Invalid) { return NULL; } return ALLOC(type); } |] if tp == nullPtr then return Nothing else (Just . Type) <$> newLeaf (parent c) (\_ -> return ( tp, free tp )) typeKind :: Type -> TypeKind typeKind t = uderef t $ fmap parseTypeKind . (\hsc_ptr -> peekByteOff hsc_ptr 0) {-# LINE 469 "src/Language/C/Clang/Internal/FFI.hsc" #-} parseTypeKind :: CInt -> TypeKind parseTypeKind = \case 0 -> Invalid {-# LINE 473 "src/Language/C/Clang/Internal/FFI.hsc" #-} 1 -> Unexposed {-# LINE 474 "src/Language/C/Clang/Internal/FFI.hsc" #-} 2 -> Void {-# LINE 475 "src/Language/C/Clang/Internal/FFI.hsc" #-} 3 -> Bool {-# LINE 476 "src/Language/C/Clang/Internal/FFI.hsc" #-} 4 -> Char_U {-# LINE 477 "src/Language/C/Clang/Internal/FFI.hsc" #-} 5 -> UChar {-# LINE 478 "src/Language/C/Clang/Internal/FFI.hsc" #-} 6 -> Char16 {-# LINE 479 "src/Language/C/Clang/Internal/FFI.hsc" #-} 7 -> Char32 {-# LINE 480 "src/Language/C/Clang/Internal/FFI.hsc" #-} 8 -> UShort {-# LINE 481 "src/Language/C/Clang/Internal/FFI.hsc" #-} 9 -> UInt {-# LINE 482 "src/Language/C/Clang/Internal/FFI.hsc" #-} 10 -> ULong {-# LINE 483 "src/Language/C/Clang/Internal/FFI.hsc" #-} 11 -> ULongLong {-# LINE 484 "src/Language/C/Clang/Internal/FFI.hsc" #-} 12 -> UInt128 {-# LINE 485 "src/Language/C/Clang/Internal/FFI.hsc" #-} 13 -> Char_S {-# LINE 486 "src/Language/C/Clang/Internal/FFI.hsc" #-} 14 -> SChar {-# LINE 487 "src/Language/C/Clang/Internal/FFI.hsc" #-} 15 -> WChar {-# LINE 488 "src/Language/C/Clang/Internal/FFI.hsc" #-} 16 -> Short {-# LINE 489 "src/Language/C/Clang/Internal/FFI.hsc" #-} 17 -> Int {-# LINE 490 "src/Language/C/Clang/Internal/FFI.hsc" #-} 18 -> Long {-# LINE 491 "src/Language/C/Clang/Internal/FFI.hsc" #-} 19 -> LongLong {-# LINE 492 "src/Language/C/Clang/Internal/FFI.hsc" #-} 20 -> Int128 {-# LINE 493 "src/Language/C/Clang/Internal/FFI.hsc" #-} 21 -> Float {-# LINE 494 "src/Language/C/Clang/Internal/FFI.hsc" #-} 22 -> Double {-# LINE 495 "src/Language/C/Clang/Internal/FFI.hsc" #-} 23 -> LongDouble {-# LINE 496 "src/Language/C/Clang/Internal/FFI.hsc" #-} 24 -> NullPtr {-# LINE 497 "src/Language/C/Clang/Internal/FFI.hsc" #-} 25 -> Overload {-# LINE 498 "src/Language/C/Clang/Internal/FFI.hsc" #-} 26 -> Dependent {-# LINE 499 "src/Language/C/Clang/Internal/FFI.hsc" #-} 27 -> ObjCId {-# LINE 500 "src/Language/C/Clang/Internal/FFI.hsc" #-} 28 -> ObjCClass {-# LINE 501 "src/Language/C/Clang/Internal/FFI.hsc" #-} 29 -> ObjCSel {-# LINE 502 "src/Language/C/Clang/Internal/FFI.hsc" #-} 2 -> FirstBuiltin {-# LINE 503 "src/Language/C/Clang/Internal/FFI.hsc" #-} 29 -> LastBuiltin {-# LINE 504 "src/Language/C/Clang/Internal/FFI.hsc" #-} 100 -> Complex {-# LINE 505 "src/Language/C/Clang/Internal/FFI.hsc" #-} 101 -> Pointer {-# LINE 506 "src/Language/C/Clang/Internal/FFI.hsc" #-} 102 -> BlockPointer {-# LINE 507 "src/Language/C/Clang/Internal/FFI.hsc" #-} 103 -> LValueReference {-# LINE 508 "src/Language/C/Clang/Internal/FFI.hsc" #-} 104 -> RValueReference {-# LINE 509 "src/Language/C/Clang/Internal/FFI.hsc" #-} 105 -> Record {-# LINE 510 "src/Language/C/Clang/Internal/FFI.hsc" #-} 106 -> Enum {-# LINE 511 "src/Language/C/Clang/Internal/FFI.hsc" #-} 107 -> Typedef {-# LINE 512 "src/Language/C/Clang/Internal/FFI.hsc" #-} 108 -> ObjCInterface {-# LINE 513 "src/Language/C/Clang/Internal/FFI.hsc" #-} 109 -> ObjCObjectPointer {-# LINE 514 "src/Language/C/Clang/Internal/FFI.hsc" #-} 110 -> FunctionNoProto {-# LINE 515 "src/Language/C/Clang/Internal/FFI.hsc" #-} 111 -> FunctionProto {-# LINE 516 "src/Language/C/Clang/Internal/FFI.hsc" #-} 112 -> ConstantArray {-# LINE 517 "src/Language/C/Clang/Internal/FFI.hsc" #-} 113 -> Vector {-# LINE 518 "src/Language/C/Clang/Internal/FFI.hsc" #-} 114 -> IncompleteArray {-# LINE 519 "src/Language/C/Clang/Internal/FFI.hsc" #-} 115 -> VariableArray {-# LINE 520 "src/Language/C/Clang/Internal/FFI.hsc" #-} 116 -> DependentSizedArray {-# LINE 521 "src/Language/C/Clang/Internal/FFI.hsc" #-} 117 -> MemberPointer {-# LINE 522 "src/Language/C/Clang/Internal/FFI.hsc" #-} _ -> Unexposed typeSpelling :: Type -> ByteString typeSpelling t = uderef t $ \tp -> withCXString $ \cxsp -> [C.exp| void { *$(CXString *cxsp) = clang_getTypeSpelling(*$(CXType *tp)); } |] instance Clang Token where deref (Token ts i) f = deref (tokenSetRef ts) $ f . (`plusPtr` (i * ((24)))) {-# LINE 532 "src/Language/C/Clang/Internal/FFI.hsc" #-} unsafeToPtr (Token ts i) = unsafeToPtr (tokenSetRef ts) `plusPtr` (i * ((24))) {-# LINE 534 "src/Language/C/Clang/Internal/FFI.hsc" #-} instance Child Token where parent (Token ts _) = parent (tokenSetRef ts) foreign import ccall "clang_disposeTokens" clang_disposeTokens :: CXTranslationUnit -> Ptr CXToken -> CUInt -> Finalizer tokenize :: SourceRange -> TokenSet tokenize sr = unsafePerformIO $ deref (parent sr) $ \tup -> deref sr $ \srp -> do ( tsp, tn ) <- C.withPtrs_ $ \( tspp, tnp ) -> [C.exp| void { clang_tokenize( $(CXTranslationUnit tup), *$(CXSourceRange *srp), $(CXToken **tspp), $(unsigned int *tnp)); } |] tsn <- newLeaf (parent sr) $ \_ -> return ( tsp, clang_disposeTokens tup tsp tn ) return $ TokenSet tsn (fromIntegral tn) tokenSetTokens :: TokenSet -> [ Token ] tokenSetTokens ts = map (Token ts) [0..tokenSetSize ts - 1] indexTokenSet :: TokenSet -> Int -> Token indexTokenSet ts i | 0 <= i && i < tokenSetSize ts = Token ts i | otherwise = error "Token index out of bounds." tokenSpelling :: Token -> ByteString tokenSpelling t = unsafePerformIO $ deref (parent t) $ \tup -> deref t $ \tp -> withCXString $ \cxsp -> do [C.block| void { *$(CXString *cxsp) = clang_getTokenSpelling( $(CXTranslationUnit tup), *$(CXToken *tp)); } |] isInSystemHeader :: SourceLocation -> Bool isInSystemHeader l = uderef l $ \lp -> toBool <$> [C.exp| int { clang_Location_isInSystemHeader(*$(CXSourceLocation *lp)) } |] isFromMainFile :: SourceLocation -> Bool isFromMainFile l = uderef l $ \lp -> toBool <$> [C.exp| int { clang_Location_isFromMainFile(*$(CXSourceLocation *lp)) } |] instance Show Cursor where show c = "Cursor { cursorKind = " ++ show (cursorKind c) ++ ", cursorSpelling = " ++ show (cursorSpelling c) ++ "}" instance Show Type where show t = "Type { typeKind = " ++ show (typeKind t) ++ ", typeSpelling = " ++ show (typeSpelling t) ++ "}" instance Show File where show f = "File { fileName = " ++ show (fileName f) ++ "}"