1
1
mirror of https://github.com/github/semantic.git synced 2024-12-26 00:12:29 +03:00

Merge branch 'master' into grpc-server

This commit is contained in:
Josh Vera 2018-05-22 12:53:04 -04:00 committed by GitHub
commit df7f14fb04
2 changed files with 13 additions and 11 deletions

View File

@ -12,29 +12,31 @@ import Data.Source
import Data.Span import Data.Span
import Data.Term import Data.Term
import Foreign import Foreign
import Foreign.C.Types (CBool(..))
import Foreign.Marshal.Array (allocaArray) import Foreign.Marshal.Array (allocaArray)
import qualified TreeSitter.Document as TS import qualified TreeSitter.Tree as TS
import qualified TreeSitter.Parser as TS
import qualified TreeSitter.Node as TS import qualified TreeSitter.Node as TS
import qualified TreeSitter.Language as TS import qualified TreeSitter.Language as TS
-- | Parse 'Source' with the given 'TS.Language' and return its AST. -- | Parse 'Source' with the given 'TS.Language' and return its AST.
parseToAST :: (Bounded grammar, Enum grammar) => Ptr TS.Language -> Blob -> IO (AST [] grammar) parseToAST :: (Bounded grammar, Enum grammar) => Ptr TS.Language -> Blob -> IO (AST [] grammar)
parseToAST language Blob{..} = bracket TS.ts_document_new TS.ts_document_free $ \ document -> do parseToAST language Blob{..} = bracket TS.ts_parser_new TS.ts_parser_delete $ \ parser -> do
TS.ts_document_set_language document language TS.ts_parser_halt_on_error parser (CBool 1)
root <- unsafeUseAsCStringLen (sourceBytes blobSource) $ \ (source, len) -> do TS.ts_parser_set_language parser language
TS.ts_document_set_input_string_with_length document source len unsafeUseAsCStringLen (sourceBytes blobSource) $ \ (source, len) -> do
TS.ts_document_parse_halt_on_error document
alloca (\ rootPtr -> do alloca (\ rootPtr -> do
TS.ts_document_root_node_p document rootPtr bracket (TS.ts_parser_parse_string parser nullPtr source len) TS.ts_tree_delete $ \ tree -> do
peek rootPtr) TS.ts_tree_root_node_p tree rootPtr
peek rootPtr >>= anaM toAST
)
anaM toAST root
toAST :: forall grammar . (Bounded grammar, Enum grammar) => TS.Node -> IO (Base (AST [] grammar) TS.Node) toAST :: forall grammar . (Bounded grammar, Enum grammar) => TS.Node -> IO (Base (AST [] grammar) TS.Node)
toAST node@TS.Node{..} = do toAST node@TS.Node{..} = do
let count = fromIntegral nodeChildCount let count = fromIntegral nodeChildCount
children <- allocaArray count $ \ childNodesPtr -> do children <- allocaArray count $ \ childNodesPtr -> do
_ <- with nodeTSNode (\ nodePtr -> TS.ts_node_copy_child_nodes nullPtr nodePtr childNodesPtr (fromIntegral count)) _ <- with nodeTSNode (\ nodePtr -> TS.ts_node_copy_child_nodes nodePtr childNodesPtr (fromIntegral count))
peekArray count childNodesPtr peekArray count childNodesPtr
pure $! In (Node (toEnum (min (fromIntegral nodeSymbol) (fromEnum (maxBound :: grammar)))) (nodeRange node) (nodeSpan node)) children pure $! In (Node (toEnum (min (fromIntegral nodeSymbol) (fromEnum (maxBound :: grammar)))) (nodeRange node) (nodeSpan node)) children

@ -1 +1 @@
Subproject commit 81d266c8d46609fb6c9e69c610121be6d97612a6 Subproject commit 897785918ce87f51e541777978f33de09619dcc7