github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-05 14:11:33 +03:00
Code Issues Projects Releases Wiki Activity

Pre-slice the source passed to toTerm.

Browse Source
This commit is contained in:
Rob Rix 2017-02-10 12:26:02 -05:00
parent 9bcabf21b7
commit 5688c2b447
1 changed files with 7 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
src/TreeSitter.hs
View File

@ -43,30 +43,29 @@ treeSitterParser language grammar blob = do
documentToTerm :: Language -> Ptr Document -> Parser (Syntax.Syntax Text) (Record '[Range, Category, SourceSpan]) documentToTerm :: Language -> Ptr Document -> Parser (Syntax.Syntax Text) (Record '[Range, Category, SourceSpan])
documentToTerm language document SourceBlob{..} = alloca $ \ root -> do documentToTerm language document SourceBlob{..} = alloca $ \ root -> do
ts_document_root_node_p document root ts_document_root_node_p document root
toTerm root toTerm root source
where toTerm node = do where toTerm node source = do
name <- ts_node_p_name node document name <- ts_node_p_name node document
name <- peekCString name name <- peekCString name
count <- ts_node_p_named_child_count node count <- ts_node_p_named_child_count node
children <- filter isNonEmpty <$> traverse (alloca . getChild node) (take (fromIntegral count) [0..])
let range = nodeRange node let range = nodeRange node
children <- filter isNonEmpty <$> traverse (alloca . getChild (start range) node) (take (fromIntegral count) [0..])
let startPos = SourcePos (1 + (fromIntegral $! ts_node_p_start_point_row node)) (1 + (fromIntegral $! ts_node_p_start_point_column node)) let startPos = SourcePos (1 + (fromIntegral $! ts_node_p_start_point_row node)) (1 + (fromIntegral $! ts_node_p_start_point_column node))
let endPos = SourcePos (1 + (fromIntegral $! ts_node_p_end_point_row node)) (1 + (fromIntegral $! ts_node_p_end_point_column node)) let endPos = SourcePos (1 + (fromIntegral $! ts_node_p_end_point_row node)) (1 + (fromIntegral $! ts_node_p_end_point_column node))
let sourceSpan = SourceSpan { spanStart = startPos , spanEnd = endPos } let sourceSpan = SourceSpan { spanStart = startPos , spanEnd = endPos }
allChildrenCount <- ts_node_p_child_count node allChildrenCount <- ts_node_p_child_count node
let allChildren = filter isNonEmpty <$> traverse (alloca . getUnnamedChild node) (take (fromIntegral allChildrenCount) [0..]) let allChildren = filter isNonEmpty <$> traverse (alloca . getUnnamedChild (start range) node) (take (fromIntegral allChildrenCount) [0..])
-- Note: The strict application here is semantically important. -- Note: The strict application here is semantically important.
-- Without it, we may not evaluate the value until after we’ve exited -- Without it, we may not evaluate the value until after we’ve exited
-- the scope that `node` was allocated within, meaning `alloca` will -- the scope that `node` was allocated within, meaning `alloca` will
-- free it & other stack data may overwrite it. -- free it & other stack data may overwrite it.
range `seq` sourceSpan `seq` assignTerm language (slice range source) (range :. categoryForLanguageProductionName language (toS name) :. sourceSpan :. Nil) children allChildren range `seq` sourceSpan `seq` assignTerm language source (range :. categoryForLanguageProductionName language (toS name) :. sourceSpan :. Nil) children allChildren
getChild node n out = ts_node_p_named_child node n out >> toTerm out getChild start node n out = ts_node_p_named_child node n out >> toTerm out (slice (offsetRange (nodeRange node) (negate start)) source)
{-# INLINE getChild #-} {-# INLINE getChild #-}
getUnnamedChild node n out = ts_node_p_child node n out >> toTerm out getUnnamedChild start node n out = ts_node_p_child node n out >> toTerm out (slice (offsetRange (nodeRange node) (negate start)) source)
{-# INLINE getUnnamedChild #-} {-# INLINE getUnnamedChild #-}
isNonEmpty child = category (extract child) /= Empty isNonEmpty child = category (extract child) /= Empty