{-# LINE 1 "src/Language/C/Clang/Internal/FFI.hsc" #-}
{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-overlapping-patterns #-}
module Language.C.Clang.Internal.FFI where
import Data.Bits
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BS
import Control.Exception
import Control.Monad
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 Lens.Micro.Contra
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"
C.include "clang-c/Index.h"
C.include "clang-pure-utils.h"
foreign import ccall "clang_disposeIndex"
clang_disposeIndex :: Ptr CXIndexImpl -> Finalizer
createIndex :: IO ClangIndex
createIndex = createIndexWithOptions [ DisplayDiagnostics ]
createIndexWithOptions :: [ ClangIndexOption ] -> IO ClangIndex
createIndexWithOptions opts = do
let excludeDecl = fromBool $ ExcludeDeclarationsFromPCH `elem` opts
displayDiag = fromBool $ DisplayDiagnostics `elem` opts
idxp <- [C.exp| CXIndex {
clang_createIndex($(int excludeDecl), $(int displayDiag))
} |]
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 77 "src/Language/C/Clang/Internal/FFI.hsc" #-}
1 -> Failure
{-# LINE 78 "src/Language/C/Clang/Internal/FFI.hsc" #-}
2 -> Crashed
{-# LINE 79 "src/Language/C/Clang/Internal/FFI.hsc" #-}
3 -> InvalidArguments
{-# LINE 80 "src/Language/C/Clang/Internal/FFI.hsc" #-}
4 -> ASTReadError
{-# LINE 81 "src/Language/C/Clang/Internal/FFI.hsc" #-}
_ -> Failure
instance Exception ClangError
withCXUnsavedFile :: UnsavedFile -> (CXUnsavedFile -> IO a) -> IO a
withCXUnsavedFile ( path, contents ) f =
withCString path $ \cPath ->
BS.unsafeUseAsCStringLen contents $ \( cContents, cLength ) ->
f $ CXUnsavedFile cPath cContents (fromIntegral cLength)
instance Storable CXUnsavedFile where
sizeOf _ = (24)
{-# LINE 93 "src/Language/C/Clang/Internal/FFI.hsc" #-}
alignment _ = 8
{-# LINE 95 "src/Language/C/Clang/Internal/FFI.hsc" #-}
peek ptr = do
cFileName <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 98 "src/Language/C/Clang/Internal/FFI.hsc" #-}
cContents <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 99 "src/Language/C/Clang/Internal/FFI.hsc" #-}
cLength <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 100 "src/Language/C/Clang/Internal/FFI.hsc" #-}
return $ CXUnsavedFile cFileName cContents cLength
poke ptr (CXUnsavedFile cFileName cContents cLength) = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr cFileName
{-# LINE 104 "src/Language/C/Clang/Internal/FFI.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr cContents
{-# LINE 105 "src/Language/C/Clang/Internal/FFI.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr cLength
{-# LINE 106 "src/Language/C/Clang/Internal/FFI.hsc" #-}
toTranslationUnitFlag :: TranslationUnitOption -> CUInt
toTranslationUnitFlag = \case
DetailedPreprocessingRecord -> 1
{-# LINE 110 "src/Language/C/Clang/Internal/FFI.hsc" #-}
Incomplete -> 2
{-# LINE 111 "src/Language/C/Clang/Internal/FFI.hsc" #-}
PrecompiledPreamble -> 4
{-# LINE 112 "src/Language/C/Clang/Internal/FFI.hsc" #-}
CacheCompletionResults -> 8
{-# LINE 113 "src/Language/C/Clang/Internal/FFI.hsc" #-}
ForSerialization -> 16
{-# LINE 114 "src/Language/C/Clang/Internal/FFI.hsc" #-}
CXXChainedPCH -> 32
{-# LINE 115 "src/Language/C/Clang/Internal/FFI.hsc" #-}
SkipFunctionBodies -> 64
{-# LINE 116 "src/Language/C/Clang/Internal/FFI.hsc" #-}
IncludeBriefCommentsInCodeCompletion -> 128
{-# LINE 117 "src/Language/C/Clang/Internal/FFI.hsc" #-}
CreatePreambleOnFirstParse -> 256
{-# LINE 118 "src/Language/C/Clang/Internal/FFI.hsc" #-}
parseTranslationUnit :: ClangIndex -> FilePath -> [ String ] -> IO TranslationUnit
parseTranslationUnit idx path args = parseTranslationUnitWithOptions idx path args [] []
parseTranslationUnitWithOptions
:: ClangIndex
-> FilePath
-> [ String ]
-> [ UnsavedFile ]
-> [ TranslationUnitOption ]
-> IO TranslationUnit
parseTranslationUnitWithOptions idx path args unsavedFiles opts = do
tun <- newNode idx $ \idxp ->
withCString path $ \cPath ->
withMany withCString args $ \cArgList ->
withMany withCXUnsavedFile unsavedFiles $ \cUnsavedFileList -> do
let cArgs = VS.fromList cArgList
cUnsavedFiles = VS.fromList cUnsavedFileList
cFlags = foldr (.|.) 0 (map toTranslationUnitFlag opts)
( tup, cres ) <- C.withPtr $ \tupp -> [C.exp| int {
clang_parseTranslationUnit2(
$(CXIndex idxp),
$(const char *cPath),
$vec-ptr:(const char * const * cArgs), $vec-len:cArgs,
$vec-ptr:(struct CXUnsavedFile *cUnsavedFiles), $vec-len:cUnsavedFiles,
$(unsigned int cFlags),
$(CXTranslationUnit *tupp))
} |]
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 165 "src/Language/C/Clang/Internal/FFI.hsc" #-}
cursorChildrenF :: Fold Cursor Cursor
cursorChildrenF f c = uderef c $ \cp -> do
fRef <- newIORef $ phantom $ pure ()
let
visitChild chp = do
ch <- newLeaf (cursorTranslationUnit c) $ \_ ->
return ( chp, free chp )
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 187 "src/Language/C/Clang/Internal/FFI.hsc" #-}
f cxsp
bracket
[C.exp| const char * { clang_getCString(*$(CXString *cxsp)) } |]
(\_ -> [C.exp| void { clang_disposeString(*$(CXString *cxsp)) } |]) $
\cs -> BS.packCString cs
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)) } |]
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 317 "src/Language/C/Clang/Internal/FFI.hsc" #-}
2 -> StructDecl
{-# LINE 318 "src/Language/C/Clang/Internal/FFI.hsc" #-}
3 -> UnionDecl
{-# LINE 319 "src/Language/C/Clang/Internal/FFI.hsc" #-}
4 -> ClassDecl
{-# LINE 320 "src/Language/C/Clang/Internal/FFI.hsc" #-}
5 -> EnumDecl
{-# LINE 321 "src/Language/C/Clang/Internal/FFI.hsc" #-}
6 -> FieldDecl
{-# LINE 322 "src/Language/C/Clang/Internal/FFI.hsc" #-}
7 -> EnumConstantDecl
{-# LINE 323 "src/Language/C/Clang/Internal/FFI.hsc" #-}
8 -> FunctionDecl
{-# LINE 324 "src/Language/C/Clang/Internal/FFI.hsc" #-}
9 -> VarDecl
{-# LINE 325 "src/Language/C/Clang/Internal/FFI.hsc" #-}
10 -> ParmDecl
{-# LINE 326 "src/Language/C/Clang/Internal/FFI.hsc" #-}
11 -> ObjCInterfaceDecl
{-# LINE 327 "src/Language/C/Clang/Internal/FFI.hsc" #-}
12 -> ObjCCategoryDecl
{-# LINE 328 "src/Language/C/Clang/Internal/FFI.hsc" #-}
13 -> ObjCProtocolDecl
{-# LINE 329 "src/Language/C/Clang/Internal/FFI.hsc" #-}
14 -> ObjCPropertyDecl
{-# LINE 330 "src/Language/C/Clang/Internal/FFI.hsc" #-}
15 -> ObjCIvarDecl
{-# LINE 331 "src/Language/C/Clang/Internal/FFI.hsc" #-}
16 -> ObjCInstanceMethodDecl
{-# LINE 332 "src/Language/C/Clang/Internal/FFI.hsc" #-}
17 -> ObjCClassMethodDecl
{-# LINE 333 "src/Language/C/Clang/Internal/FFI.hsc" #-}
18 -> ObjCImplementationDecl
{-# LINE 334 "src/Language/C/Clang/Internal/FFI.hsc" #-}
19 -> ObjCCategoryImplDecl
{-# LINE 335 "src/Language/C/Clang/Internal/FFI.hsc" #-}
20 -> TypedefDecl
{-# LINE 336 "src/Language/C/Clang/Internal/FFI.hsc" #-}
21 -> CXXMethod
{-# LINE 337 "src/Language/C/Clang/Internal/FFI.hsc" #-}
22 -> Namespace
{-# LINE 338 "src/Language/C/Clang/Internal/FFI.hsc" #-}
23 -> LinkageSpec
{-# LINE 339 "src/Language/C/Clang/Internal/FFI.hsc" #-}
24 -> Constructor
{-# LINE 340 "src/Language/C/Clang/Internal/FFI.hsc" #-}
25 -> Destructor
{-# LINE 341 "src/Language/C/Clang/Internal/FFI.hsc" #-}
26 -> ConversionFunction
{-# LINE 342 "src/Language/C/Clang/Internal/FFI.hsc" #-}
27 -> TemplateTypeParameter
{-# LINE 343 "src/Language/C/Clang/Internal/FFI.hsc" #-}
28 -> NonTypeTemplateParameter
{-# LINE 344 "src/Language/C/Clang/Internal/FFI.hsc" #-}
29 -> TemplateTemplateParameter
{-# LINE 345 "src/Language/C/Clang/Internal/FFI.hsc" #-}
30 -> FunctionTemplate
{-# LINE 346 "src/Language/C/Clang/Internal/FFI.hsc" #-}
31 -> ClassTemplate
{-# LINE 347 "src/Language/C/Clang/Internal/FFI.hsc" #-}
32 -> ClassTemplatePartialSpecialization
{-# LINE 348 "src/Language/C/Clang/Internal/FFI.hsc" #-}
33 -> NamespaceAlias
{-# LINE 349 "src/Language/C/Clang/Internal/FFI.hsc" #-}
34 -> UsingDirective
{-# LINE 350 "src/Language/C/Clang/Internal/FFI.hsc" #-}
35 -> UsingDeclaration
{-# LINE 351 "src/Language/C/Clang/Internal/FFI.hsc" #-}
36 -> TypeAliasDecl
{-# LINE 352 "src/Language/C/Clang/Internal/FFI.hsc" #-}
37 -> ObjCSynthesizeDecl
{-# LINE 353 "src/Language/C/Clang/Internal/FFI.hsc" #-}
38 -> ObjCDynamicDecl
{-# LINE 354 "src/Language/C/Clang/Internal/FFI.hsc" #-}
39 -> CXXAccessSpecifier
{-# LINE 355 "src/Language/C/Clang/Internal/FFI.hsc" #-}
1 -> FirstDecl
{-# LINE 356 "src/Language/C/Clang/Internal/FFI.hsc" #-}
39 -> LastDecl
{-# LINE 357 "src/Language/C/Clang/Internal/FFI.hsc" #-}
40 -> FirstRef
{-# LINE 358 "src/Language/C/Clang/Internal/FFI.hsc" #-}
40 -> ObjCSuperClassRef
{-# LINE 359 "src/Language/C/Clang/Internal/FFI.hsc" #-}
41 -> ObjCProtocolRef
{-# LINE 360 "src/Language/C/Clang/Internal/FFI.hsc" #-}
42 -> ObjCClassRef
{-# LINE 361 "src/Language/C/Clang/Internal/FFI.hsc" #-}
43 -> TypeRef
{-# LINE 362 "src/Language/C/Clang/Internal/FFI.hsc" #-}
44 -> CXXBaseSpecifier
{-# LINE 363 "src/Language/C/Clang/Internal/FFI.hsc" #-}
45 -> TemplateRef
{-# LINE 364 "src/Language/C/Clang/Internal/FFI.hsc" #-}
46 -> NamespaceRef
{-# LINE 365 "src/Language/C/Clang/Internal/FFI.hsc" #-}
47 -> MemberRef
{-# LINE 366 "src/Language/C/Clang/Internal/FFI.hsc" #-}
48 -> LabelRef
{-# LINE 367 "src/Language/C/Clang/Internal/FFI.hsc" #-}
49 -> OverloadedDeclRef
{-# LINE 368 "src/Language/C/Clang/Internal/FFI.hsc" #-}
50 -> VariableRef
{-# LINE 369 "src/Language/C/Clang/Internal/FFI.hsc" #-}
50 -> LastRef
{-# LINE 370 "src/Language/C/Clang/Internal/FFI.hsc" #-}
70 -> FirstInvalid
{-# LINE 371 "src/Language/C/Clang/Internal/FFI.hsc" #-}
70 -> InvalidFile
{-# LINE 372 "src/Language/C/Clang/Internal/FFI.hsc" #-}
71 -> NoDeclFound
{-# LINE 373 "src/Language/C/Clang/Internal/FFI.hsc" #-}
72 -> NotImplemented
{-# LINE 374 "src/Language/C/Clang/Internal/FFI.hsc" #-}
73 -> InvalidCode
{-# LINE 375 "src/Language/C/Clang/Internal/FFI.hsc" #-}
73 -> LastInvalid
{-# LINE 376 "src/Language/C/Clang/Internal/FFI.hsc" #-}
100 -> FirstExpr
{-# LINE 377 "src/Language/C/Clang/Internal/FFI.hsc" #-}
100 -> UnexposedExpr
{-# LINE 378 "src/Language/C/Clang/Internal/FFI.hsc" #-}
101 -> DeclRefExpr
{-# LINE 379 "src/Language/C/Clang/Internal/FFI.hsc" #-}
102 -> MemberRefExpr
{-# LINE 380 "src/Language/C/Clang/Internal/FFI.hsc" #-}
103 -> CallExpr
{-# LINE 381 "src/Language/C/Clang/Internal/FFI.hsc" #-}
104 -> ObjCMessageExpr
{-# LINE 382 "src/Language/C/Clang/Internal/FFI.hsc" #-}
105 -> BlockExpr
{-# LINE 383 "src/Language/C/Clang/Internal/FFI.hsc" #-}
106 -> IntegerLiteral
{-# LINE 384 "src/Language/C/Clang/Internal/FFI.hsc" #-}
107 -> FloatingLiteral
{-# LINE 385 "src/Language/C/Clang/Internal/FFI.hsc" #-}
108 -> ImaginaryLiteral
{-# LINE 386 "src/Language/C/Clang/Internal/FFI.hsc" #-}
109 -> StringLiteral
{-# LINE 387 "src/Language/C/Clang/Internal/FFI.hsc" #-}
110 -> CharacterLiteral
{-# LINE 388 "src/Language/C/Clang/Internal/FFI.hsc" #-}
111 -> ParenExpr
{-# LINE 389 "src/Language/C/Clang/Internal/FFI.hsc" #-}
112 -> UnaryOperator
{-# LINE 390 "src/Language/C/Clang/Internal/FFI.hsc" #-}
113 -> ArraySubscriptExpr
{-# LINE 391 "src/Language/C/Clang/Internal/FFI.hsc" #-}
114 -> BinaryOperator
{-# LINE 392 "src/Language/C/Clang/Internal/FFI.hsc" #-}
115 -> CompoundAssignOperator
{-# LINE 393 "src/Language/C/Clang/Internal/FFI.hsc" #-}
116 -> ConditionalOperator
{-# LINE 394 "src/Language/C/Clang/Internal/FFI.hsc" #-}
117 -> CStyleCastExpr
{-# LINE 395 "src/Language/C/Clang/Internal/FFI.hsc" #-}
118 -> CompoundLiteralExpr
{-# LINE 396 "src/Language/C/Clang/Internal/FFI.hsc" #-}
119 -> InitListExpr
{-# LINE 397 "src/Language/C/Clang/Internal/FFI.hsc" #-}
120 -> AddrLabelExpr
{-# LINE 398 "src/Language/C/Clang/Internal/FFI.hsc" #-}
121 -> StmtExpr
{-# LINE 399 "src/Language/C/Clang/Internal/FFI.hsc" #-}
122 -> GenericSelectionExpr
{-# LINE 400 "src/Language/C/Clang/Internal/FFI.hsc" #-}
123 -> GNUNullExpr
{-# LINE 401 "src/Language/C/Clang/Internal/FFI.hsc" #-}
124 -> CXXStaticCastExpr
{-# LINE 402 "src/Language/C/Clang/Internal/FFI.hsc" #-}
125 -> CXXDynamicCastExpr
{-# LINE 403 "src/Language/C/Clang/Internal/FFI.hsc" #-}
126 -> CXXReinterpretCastExpr
{-# LINE 404 "src/Language/C/Clang/Internal/FFI.hsc" #-}
127 -> CXXConstCastExpr
{-# LINE 405 "src/Language/C/Clang/Internal/FFI.hsc" #-}
128 -> CXXFunctionalCastExpr
{-# LINE 406 "src/Language/C/Clang/Internal/FFI.hsc" #-}
129 -> CXXTypeidExpr
{-# LINE 407 "src/Language/C/Clang/Internal/FFI.hsc" #-}
130 -> CXXBoolLiteralExpr
{-# LINE 408 "src/Language/C/Clang/Internal/FFI.hsc" #-}
131 -> CXXNullPtrLiteralExpr
{-# LINE 409 "src/Language/C/Clang/Internal/FFI.hsc" #-}
132 -> CXXThisExpr
{-# LINE 410 "src/Language/C/Clang/Internal/FFI.hsc" #-}
133 -> CXXThrowExpr
{-# LINE 411 "src/Language/C/Clang/Internal/FFI.hsc" #-}
134 -> CXXNewExpr
{-# LINE 412 "src/Language/C/Clang/Internal/FFI.hsc" #-}
135 -> CXXDeleteExpr
{-# LINE 413 "src/Language/C/Clang/Internal/FFI.hsc" #-}
136 -> UnaryExpr
{-# LINE 414 "src/Language/C/Clang/Internal/FFI.hsc" #-}
137 -> ObjCStringLiteral
{-# LINE 415 "src/Language/C/Clang/Internal/FFI.hsc" #-}
138 -> ObjCEncodeExpr
{-# LINE 416 "src/Language/C/Clang/Internal/FFI.hsc" #-}
139 -> ObjCSelectorExpr
{-# LINE 417 "src/Language/C/Clang/Internal/FFI.hsc" #-}
140 -> ObjCProtocolExpr
{-# LINE 418 "src/Language/C/Clang/Internal/FFI.hsc" #-}
141 -> ObjCBridgedCastExpr
{-# LINE 419 "src/Language/C/Clang/Internal/FFI.hsc" #-}
142 -> PackExpansionExpr
{-# LINE 420 "src/Language/C/Clang/Internal/FFI.hsc" #-}
143 -> SizeOfPackExpr
{-# LINE 421 "src/Language/C/Clang/Internal/FFI.hsc" #-}
144 -> LambdaExpr
{-# LINE 422 "src/Language/C/Clang/Internal/FFI.hsc" #-}
145 -> ObjCBoolLiteralExpr
{-# LINE 423 "src/Language/C/Clang/Internal/FFI.hsc" #-}
146 -> ObjCSelfExpr
{-# LINE 424 "src/Language/C/Clang/Internal/FFI.hsc" #-}
148 -> LastExpr
{-# LINE 425 "src/Language/C/Clang/Internal/FFI.hsc" #-}
200 -> FirstStmt
{-# LINE 426 "src/Language/C/Clang/Internal/FFI.hsc" #-}
200 -> UnexposedStmt
{-# LINE 427 "src/Language/C/Clang/Internal/FFI.hsc" #-}
201 -> LabelStmt
{-# LINE 428 "src/Language/C/Clang/Internal/FFI.hsc" #-}
202 -> CompoundStmt
{-# LINE 429 "src/Language/C/Clang/Internal/FFI.hsc" #-}
203 -> CaseStmt
{-# LINE 430 "src/Language/C/Clang/Internal/FFI.hsc" #-}
204 -> DefaultStmt
{-# LINE 431 "src/Language/C/Clang/Internal/FFI.hsc" #-}
205 -> IfStmt
{-# LINE 432 "src/Language/C/Clang/Internal/FFI.hsc" #-}
206 -> SwitchStmt
{-# LINE 433 "src/Language/C/Clang/Internal/FFI.hsc" #-}
207 -> WhileStmt
{-# LINE 434 "src/Language/C/Clang/Internal/FFI.hsc" #-}
208 -> DoStmt
{-# LINE 435 "src/Language/C/Clang/Internal/FFI.hsc" #-}
209 -> ForStmt
{-# LINE 436 "src/Language/C/Clang/Internal/FFI.hsc" #-}
210 -> GotoStmt
{-# LINE 437 "src/Language/C/Clang/Internal/FFI.hsc" #-}
211 -> IndirectGotoStmt
{-# LINE 438 "src/Language/C/Clang/Internal/FFI.hsc" #-}
212 -> ContinueStmt
{-# LINE 439 "src/Language/C/Clang/Internal/FFI.hsc" #-}
213 -> BreakStmt
{-# LINE 440 "src/Language/C/Clang/Internal/FFI.hsc" #-}
214 -> ReturnStmt
{-# LINE 441 "src/Language/C/Clang/Internal/FFI.hsc" #-}
215 -> GCCAsmStmt
{-# LINE 442 "src/Language/C/Clang/Internal/FFI.hsc" #-}
215 -> AsmStmt
{-# LINE 443 "src/Language/C/Clang/Internal/FFI.hsc" #-}
216 -> ObjCAtTryStmt
{-# LINE 444 "src/Language/C/Clang/Internal/FFI.hsc" #-}
217 -> ObjCAtCatchStmt
{-# LINE 445 "src/Language/C/Clang/Internal/FFI.hsc" #-}
218 -> ObjCAtFinallyStmt
{-# LINE 446 "src/Language/C/Clang/Internal/FFI.hsc" #-}
219 -> ObjCAtThrowStmt
{-# LINE 447 "src/Language/C/Clang/Internal/FFI.hsc" #-}
220 -> ObjCAtSynchronizedStmt
{-# LINE 448 "src/Language/C/Clang/Internal/FFI.hsc" #-}
221 -> ObjCAutoreleasePoolStmt
{-# LINE 449 "src/Language/C/Clang/Internal/FFI.hsc" #-}
222 -> ObjCForCollectionStmt
{-# LINE 450 "src/Language/C/Clang/Internal/FFI.hsc" #-}
223 -> CXXCatchStmt
{-# LINE 451 "src/Language/C/Clang/Internal/FFI.hsc" #-}
224 -> CXXTryStmt
{-# LINE 452 "src/Language/C/Clang/Internal/FFI.hsc" #-}
225 -> CXXForRangeStmt
{-# LINE 453 "src/Language/C/Clang/Internal/FFI.hsc" #-}
226 -> SEHTryStmt
{-# LINE 454 "src/Language/C/Clang/Internal/FFI.hsc" #-}
227 -> SEHExceptStmt
{-# LINE 455 "src/Language/C/Clang/Internal/FFI.hsc" #-}
228 -> SEHFinallyStmt
{-# LINE 456 "src/Language/C/Clang/Internal/FFI.hsc" #-}
229 -> MSAsmStmt
{-# LINE 457 "src/Language/C/Clang/Internal/FFI.hsc" #-}
230 -> NullStmt
{-# LINE 458 "src/Language/C/Clang/Internal/FFI.hsc" #-}
231 -> DeclStmt
{-# LINE 459 "src/Language/C/Clang/Internal/FFI.hsc" #-}
232 -> OMPParallelDirective
{-# LINE 460 "src/Language/C/Clang/Internal/FFI.hsc" #-}
233 -> OMPSimdDirective
{-# LINE 461 "src/Language/C/Clang/Internal/FFI.hsc" #-}
234 -> OMPForDirective
{-# LINE 462 "src/Language/C/Clang/Internal/FFI.hsc" #-}
235 -> OMPSectionsDirective
{-# LINE 463 "src/Language/C/Clang/Internal/FFI.hsc" #-}
236 -> OMPSectionDirective
{-# LINE 464 "src/Language/C/Clang/Internal/FFI.hsc" #-}
237 -> OMPSingleDirective
{-# LINE 465 "src/Language/C/Clang/Internal/FFI.hsc" #-}
238 -> OMPParallelForDirective
{-# LINE 466 "src/Language/C/Clang/Internal/FFI.hsc" #-}
239 -> OMPParallelSectionsDirective
{-# LINE 467 "src/Language/C/Clang/Internal/FFI.hsc" #-}
240 -> OMPTaskDirective
{-# LINE 468 "src/Language/C/Clang/Internal/FFI.hsc" #-}
241 -> OMPMasterDirective
{-# LINE 469 "src/Language/C/Clang/Internal/FFI.hsc" #-}
242 -> OMPCriticalDirective
{-# LINE 470 "src/Language/C/Clang/Internal/FFI.hsc" #-}
243 -> OMPTaskyieldDirective
{-# LINE 471 "src/Language/C/Clang/Internal/FFI.hsc" #-}
244 -> OMPBarrierDirective
{-# LINE 472 "src/Language/C/Clang/Internal/FFI.hsc" #-}
245 -> OMPTaskwaitDirective
{-# LINE 473 "src/Language/C/Clang/Internal/FFI.hsc" #-}
246 -> OMPFlushDirective
{-# LINE 474 "src/Language/C/Clang/Internal/FFI.hsc" #-}
247 -> SEHLeaveStmt
{-# LINE 475 "src/Language/C/Clang/Internal/FFI.hsc" #-}
279 -> LastStmt
{-# LINE 476 "src/Language/C/Clang/Internal/FFI.hsc" #-}
300 -> TranslationUnit
{-# LINE 477 "src/Language/C/Clang/Internal/FFI.hsc" #-}
400 -> FirstAttr
{-# LINE 478 "src/Language/C/Clang/Internal/FFI.hsc" #-}
400 -> UnexposedAttr
{-# LINE 479 "src/Language/C/Clang/Internal/FFI.hsc" #-}
401 -> IBActionAttr
{-# LINE 480 "src/Language/C/Clang/Internal/FFI.hsc" #-}
402 -> IBOutletAttr
{-# LINE 481 "src/Language/C/Clang/Internal/FFI.hsc" #-}
403 -> IBOutletCollectionAttr
{-# LINE 482 "src/Language/C/Clang/Internal/FFI.hsc" #-}
404 -> CXXFinalAttr
{-# LINE 483 "src/Language/C/Clang/Internal/FFI.hsc" #-}
405 -> CXXOverrideAttr
{-# LINE 484 "src/Language/C/Clang/Internal/FFI.hsc" #-}
406 -> AnnotateAttr
{-# LINE 485 "src/Language/C/Clang/Internal/FFI.hsc" #-}
407 -> AsmLabelAttr
{-# LINE 486 "src/Language/C/Clang/Internal/FFI.hsc" #-}
408 -> PackedAttr
{-# LINE 487 "src/Language/C/Clang/Internal/FFI.hsc" #-}
409 -> PureAttr
{-# LINE 488 "src/Language/C/Clang/Internal/FFI.hsc" #-}
410 -> ConstAttr
{-# LINE 489 "src/Language/C/Clang/Internal/FFI.hsc" #-}
411 -> NoDuplicateAttr
{-# LINE 490 "src/Language/C/Clang/Internal/FFI.hsc" #-}
412 -> CUDAConstantAttr
{-# LINE 491 "src/Language/C/Clang/Internal/FFI.hsc" #-}
413 -> CUDADeviceAttr
{-# LINE 492 "src/Language/C/Clang/Internal/FFI.hsc" #-}
414 -> CUDAGlobalAttr
{-# LINE 493 "src/Language/C/Clang/Internal/FFI.hsc" #-}
415 -> CUDAHostAttr
{-# LINE 494 "src/Language/C/Clang/Internal/FFI.hsc" #-}
419 -> LastAttr
{-# LINE 495 "src/Language/C/Clang/Internal/FFI.hsc" #-}
500 -> PreprocessingDirective
{-# LINE 496 "src/Language/C/Clang/Internal/FFI.hsc" #-}
501 -> MacroDefinition
{-# LINE 497 "src/Language/C/Clang/Internal/FFI.hsc" #-}
502 -> MacroExpansion
{-# LINE 498 "src/Language/C/Clang/Internal/FFI.hsc" #-}
502 -> MacroInstantiation
{-# LINE 499 "src/Language/C/Clang/Internal/FFI.hsc" #-}
503 -> InclusionDirective
{-# LINE 500 "src/Language/C/Clang/Internal/FFI.hsc" #-}
500 -> FirstPreprocessing
{-# LINE 501 "src/Language/C/Clang/Internal/FFI.hsc" #-}
503 -> LastPreprocessing
{-# LINE 502 "src/Language/C/Clang/Internal/FFI.hsc" #-}
600 -> ModuleImportDecl
{-# LINE 503 "src/Language/C/Clang/Internal/FFI.hsc" #-}
600 -> FirstExtraDecl
{-# LINE 504 "src/Language/C/Clang/Internal/FFI.hsc" #-}
603 -> LastExtraDecl
{-# LINE 505 "src/Language/C/Clang/Internal/FFI.hsc" #-}
_ -> UnexposedDecl
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 ))
typeArraySize :: Type -> Maybe Word64
typeArraySize t = uderef t $ \tp -> do
as <- [C.exp| long long { clang_getArraySize(*$(CXType *tp)) } |]
return $ if as == -1 then Nothing else Just (fromIntegral as)
typeCanonicalType :: Type -> Type
typeCanonicalType t = uderef t $ \tp -> do
ctp <- [C.exp| CXType* { ALLOC(clang_getCanonicalType(*$(CXType *tp))) } |]
Type <$> newLeaf (parent t) (\_ -> pure (ctp, free ctp))
typeElementType :: Type -> Maybe Type
typeElementType t = uderef t $ \tp -> do
etp <- [C.block| CXType* {
CXType type = clang_getElementType(*$(CXType *tp));
if (type.kind == CXType_Invalid) {
return NULL;
}
return ALLOC(type);
} |]
if etp == nullPtr
then return Nothing
else (Just . Type) <$> newLeaf (parent t) (\_ -> return ( etp, free etp ))
typePointeeType :: Type -> Maybe Type
typePointeeType t = uderef t $ \tp -> do
etp <- [C.block| CXType* {
CXType type = clang_getPointeeType(*$(CXType *tp));
if (type.kind == CXType_Invalid) {
return NULL;
}
return ALLOC(type);
} |]
if etp == nullPtr
then return Nothing
else (Just . Type) <$> newLeaf (parent t) (\_ -> return ( etp, free etp ))
typeKind :: Type -> TypeKind
typeKind t = uderef t $ fmap parseTypeKind . (\hsc_ptr -> peekByteOff hsc_ptr 0)
{-# LINE 564 "src/Language/C/Clang/Internal/FFI.hsc" #-}
parseTypeKind :: CInt -> TypeKind
parseTypeKind = \case
0 -> Invalid
{-# LINE 568 "src/Language/C/Clang/Internal/FFI.hsc" #-}
1 -> Unexposed
{-# LINE 569 "src/Language/C/Clang/Internal/FFI.hsc" #-}
2 -> Void
{-# LINE 570 "src/Language/C/Clang/Internal/FFI.hsc" #-}
3 -> Bool
{-# LINE 571 "src/Language/C/Clang/Internal/FFI.hsc" #-}
4 -> Char_U
{-# LINE 572 "src/Language/C/Clang/Internal/FFI.hsc" #-}
5 -> UChar
{-# LINE 573 "src/Language/C/Clang/Internal/FFI.hsc" #-}
6 -> Char16
{-# LINE 574 "src/Language/C/Clang/Internal/FFI.hsc" #-}
7 -> Char32
{-# LINE 575 "src/Language/C/Clang/Internal/FFI.hsc" #-}
8 -> UShort
{-# LINE 576 "src/Language/C/Clang/Internal/FFI.hsc" #-}
9 -> UInt
{-# LINE 577 "src/Language/C/Clang/Internal/FFI.hsc" #-}
10 -> ULong
{-# LINE 578 "src/Language/C/Clang/Internal/FFI.hsc" #-}
11 -> ULongLong
{-# LINE 579 "src/Language/C/Clang/Internal/FFI.hsc" #-}
12 -> UInt128
{-# LINE 580 "src/Language/C/Clang/Internal/FFI.hsc" #-}
13 -> Char_S
{-# LINE 581 "src/Language/C/Clang/Internal/FFI.hsc" #-}
14 -> SChar
{-# LINE 582 "src/Language/C/Clang/Internal/FFI.hsc" #-}
15 -> WChar
{-# LINE 583 "src/Language/C/Clang/Internal/FFI.hsc" #-}
16 -> Short
{-# LINE 584 "src/Language/C/Clang/Internal/FFI.hsc" #-}
17 -> Int
{-# LINE 585 "src/Language/C/Clang/Internal/FFI.hsc" #-}
18 -> Long
{-# LINE 586 "src/Language/C/Clang/Internal/FFI.hsc" #-}
19 -> LongLong
{-# LINE 587 "src/Language/C/Clang/Internal/FFI.hsc" #-}
20 -> Int128
{-# LINE 588 "src/Language/C/Clang/Internal/FFI.hsc" #-}
21 -> Float
{-# LINE 589 "src/Language/C/Clang/Internal/FFI.hsc" #-}
22 -> Double
{-# LINE 590 "src/Language/C/Clang/Internal/FFI.hsc" #-}
23 -> LongDouble
{-# LINE 591 "src/Language/C/Clang/Internal/FFI.hsc" #-}
24 -> NullPtr
{-# LINE 592 "src/Language/C/Clang/Internal/FFI.hsc" #-}
25 -> Overload
{-# LINE 593 "src/Language/C/Clang/Internal/FFI.hsc" #-}
26 -> Dependent
{-# LINE 594 "src/Language/C/Clang/Internal/FFI.hsc" #-}
27 -> ObjCId
{-# LINE 595 "src/Language/C/Clang/Internal/FFI.hsc" #-}
28 -> ObjCClass
{-# LINE 596 "src/Language/C/Clang/Internal/FFI.hsc" #-}
29 -> ObjCSel
{-# LINE 597 "src/Language/C/Clang/Internal/FFI.hsc" #-}
2 -> FirstBuiltin
{-# LINE 598 "src/Language/C/Clang/Internal/FFI.hsc" #-}
31 -> LastBuiltin
{-# LINE 599 "src/Language/C/Clang/Internal/FFI.hsc" #-}
100 -> Complex
{-# LINE 600 "src/Language/C/Clang/Internal/FFI.hsc" #-}
101 -> Pointer
{-# LINE 601 "src/Language/C/Clang/Internal/FFI.hsc" #-}
102 -> BlockPointer
{-# LINE 602 "src/Language/C/Clang/Internal/FFI.hsc" #-}
103 -> LValueReference
{-# LINE 603 "src/Language/C/Clang/Internal/FFI.hsc" #-}
104 -> RValueReference
{-# LINE 604 "src/Language/C/Clang/Internal/FFI.hsc" #-}
105 -> Record
{-# LINE 605 "src/Language/C/Clang/Internal/FFI.hsc" #-}
106 -> Enum
{-# LINE 606 "src/Language/C/Clang/Internal/FFI.hsc" #-}
107 -> Typedef
{-# LINE 607 "src/Language/C/Clang/Internal/FFI.hsc" #-}
108 -> ObjCInterface
{-# LINE 608 "src/Language/C/Clang/Internal/FFI.hsc" #-}
109 -> ObjCObjectPointer
{-# LINE 609 "src/Language/C/Clang/Internal/FFI.hsc" #-}
110 -> FunctionNoProto
{-# LINE 610 "src/Language/C/Clang/Internal/FFI.hsc" #-}
111 -> FunctionProto
{-# LINE 611 "src/Language/C/Clang/Internal/FFI.hsc" #-}
112 -> ConstantArray
{-# LINE 612 "src/Language/C/Clang/Internal/FFI.hsc" #-}
113 -> Vector
{-# LINE 613 "src/Language/C/Clang/Internal/FFI.hsc" #-}
114 -> IncompleteArray
{-# LINE 614 "src/Language/C/Clang/Internal/FFI.hsc" #-}
115 -> VariableArray
{-# LINE 615 "src/Language/C/Clang/Internal/FFI.hsc" #-}
116 -> DependentSizedArray
{-# LINE 616 "src/Language/C/Clang/Internal/FFI.hsc" #-}
117 -> MemberPointer
{-# LINE 617 "src/Language/C/Clang/Internal/FFI.hsc" #-}
_ -> Unexposed
eitherTypeLayoutErrorOrWord64 :: CLLong -> Either TypeLayoutError Word64
eitherTypeLayoutErrorOrWord64 n = case n of
-1 -> Left TypeLayoutErrorInvalid
{-# LINE 622 "src/Language/C/Clang/Internal/FFI.hsc" #-}
-2 -> Left TypeLayoutErrorIncomplete
{-# LINE 623 "src/Language/C/Clang/Internal/FFI.hsc" #-}
-3 -> Left TypeLayoutErrorDependent
{-# LINE 624 "src/Language/C/Clang/Internal/FFI.hsc" #-}
_ -> Right $ fromIntegral n
typeSizeOf :: Type -> Either TypeLayoutError Word64
typeSizeOf t = uderef t $ \tp ->
eitherTypeLayoutErrorOrWord64 <$>
[C.exp| long long { clang_Type_getSizeOf(*$(CXType *tp)) } |]
offsetOfField :: Cursor -> Either TypeLayoutError Word64
offsetOfField c = uderef c $ \cp ->
eitherTypeLayoutErrorOrWord64 <$>
[C.exp| long long { clang_Cursor_getOffsetOfField(*$(CXCursor* cp)) } |]
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 644 "src/Language/C/Clang/Internal/FFI.hsc" #-}
unsafeToPtr (Token ts i)
= unsafeToPtr (tokenSetRef ts) `plusPtr` (i * ((24)))
{-# LINE 646 "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)
++ "}"